//{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1} //{$MINSTACKSIZE $00004000} //{$MAXSTACKSIZE $00100000} //{$IMAGEBASE $00400000} //{$APPTYPE GUI} unit USCS_Main; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, ToolWin, ActnMan, ActnCtrls, ActnMenus, ActnList, Menus, ComCtrls, ExtCtrls, StdCtrls, StdActns, ExtActns, cxControls, cxContainer, cxEdit, cxTextEdit, cxMaskEdit, cxButtonEdit, ImgList, Buttons, PDF, Math, /// PowerCad PCPanel, PCDrawBox, PCDrawing, PowerCad, pcMsbar, {XP_Panel,} PCTypesUtils, DrawObjects, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings, DrawEngine, U_ESCadClasess, ColorGrd, Mask, RzCmboBx, RzLstBox, RzEdit, RzButton, RzSpnEdt, RzBorder, RzCommon, AppEvnts, cxLookAndFeelPainters, cxButtons, RzShellDialogs, Clipbrd, cxDropDownEdit, RzPanel, RzPopups, Shellapi, Contnrs, siComp, siLngLnk, RzLabel, RzDBLbl, DCPcrypt2, DCPblockciphers, DCPcast256, DCPripemd128, DCPmd4, IsPlugEdit, exgrid, ISCalendar, cxLabel, RzRadChk, RzListVw, Printers, FPlan, LibJpeg, U_ArchCommon, KeyBoard, RzSplit, FR_Class, FR_DSet, FR_DBSet, FR_View, U_Common_Classes, FR_Desgn, FR_PrDlg, FR_Prntr, FastStrings, //Tolik U_ReindexMaster, GLObjects, cxGraphics, cxLookAndFeels, PlatformDefaultStyleActnCtrls, {DBTables, SQLMemMain}{Tolik}GLKeyBoard, U_SelLists, DockTabSet, XPMenu; //TODO XPMenu, чтобы юзался тот, что возле файла USCS_Main в оригинальной папке компонента переименовать пасочку и дку-шку type TSurfaceWin = class(TWinControl); TMyLoglist = class(TMyObject) private StrList: TStringList; FFileName: string; public constructor Create(aFName: string); destructor Destroy; override; procedure Add(aStr: string); end; {TSplitter = class(ExtCtrls.TSplitter) private FOnMouseDown: TMouseEvent; FOnMouseUp: TMouseEvent; FOldMouseMoveTick: Cardinal; protected procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; procedure MouseMove(Shift: TShiftState; X, Y: Integer); override; procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override; published property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown; property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; end;} TFSCS_Main = class(TForm) ActionManager: TActionManager; aSaveAsSubstrate: TAction; aExport: TAction; aImport: TAction; aPrevView: TAction; aPrint: TAction; aExit: TAction; aClose: TAction; aUndo: TAction; aRedo: TAction; aCopy: TAction; aCut: TAction; aPaste: TAction; aSelectAll: TAction; aAllScreen: TAction; a50: TAction; a75: TAction; a100: TAction; a150: TAction; a200: TAction; aInc: TAction; aInc1pt: TAction; aDec1pt: TAction; aShowRuler: TAction; aShowGrid: TAction; aViewBtnPanel: TAction; aViewNormBase: TAction; aViewLayers: TAction; aViewCADObjectsProp: TAction; aViewNavigator: TAction; aRotate: TAction; aBackwards: TAction; aForward: TAction; aGrouping: TAction; aUngrouping: TAction; aLock: TAction; aUnlock: TAction; aObjProperties: TAction; aScale: TAction; aNewWindow: TAction; aCloseAllWindows: TAction; aHelp: TAction; aPresentation: TAction; aInteractive: TAction; aWizards: TAction; aTechDoc: TAction; aToAuthors: TAction; aBuy: TAction; aAbout: TAction; aNew: TAction; aLoadSubstrate: TAction; PrintDialog: TPrintDialog; pmObject: TPopupMenu; MainMenu: TMainMenu; mainFile: TMenuItem; mainEdit: TMenuItem; mainView: TMenuItem; mainObject: TMenuItem; mainFormat: TMenuItem; mainSCS: TMenuItem; mainWindow: TMenuItem; mainHelp: TMenuItem; N135: TMenuItem; N136: TMenuItem; N137: TMenuItem; N140: TMenuItem; N141: TMenuItem; N142: TMenuItem; N143: TMenuItem; N145: TMenuItem; N146: TMenuItem; N147: TMenuItem; N148: TMenuItem; N151: TMenuItem; N152: TMenuItem; N153: TMenuItem; N154: TMenuItem; N155: TMenuItem; N156: TMenuItem; N157: TMenuItem; N158: TMenuItem; N159: TMenuItem; N160: TMenuItem; N161: TMenuItem; N162: TMenuItem; N163: TMenuItem; N501: TMenuItem; N751: TMenuItem; N1001: TMenuItem; N1501: TMenuItem; N2001: TMenuItem; N164: TMenuItem; N165: TMenuItem; N166: TMenuItem; N168: TMenuItem; N173: TMenuItem; N174: TMenuItem; N175: TMenuItem; N178: TMenuItem; N179: TMenuItem; N181: TMenuItem; N182: TMenuItem; N183: TMenuItem; N184: TMenuItem; N185: TMenuItem; N186: TMenuItem; N190: TMenuItem; N191: TMenuItem; N192: TMenuItem; N204: TMenuItem; N206: TMenuItem; N216: TMenuItem; N217: TMenuItem; N219: TMenuItem; N220: TMenuItem; N221: TMenuItem; Wizards2: TMenuItem; N222: TMenuItem; N223: TMenuItem; N224: TMenuItem; Online2: TMenuItem; N225: TMenuItem; N226: TMenuItem; pmList: TPopupMenu; pmText: TPopupMenu; pmiObjectProps: TMenuItem; N227: TMenuItem; N229: TMenuItem; N230: TMenuItem; N231: TMenuItem; N232: TMenuItem; N233: TMenuItem; pmiListAllScreen: TMenuItem; pmiList50: TMenuItem; pmiList75: TMenuItem; pmiList100: TMenuItem; pmiList150: TMenuItem; pmiList200: TMenuItem; pmiListInc: TMenuItem; pmiListInc1pt: TMenuItem; pmiListDec1pt: TMenuItem; pmiListBackgroundColor: TMenuItem; N239: TMenuItem; N240: TMenuItem; N241: TMenuItem; N242: TMenuItem; N243: TMenuItem; aViewProjectManager: TAction; N1: TMenuItem; aNewList: TAction; PDock1: TPanel; sDiv1: TSplitter; sDiv2: TSplitter; pDock2: TPanel; pCADList: TPanel; pageCADList: TPageControl; aDelete: TAction; aDeleteAll: TAction; aDeSelectAll: TAction; N2: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem; N7: TMenuItem; aInsertText: TAction; aInsertBitmap: TAction; aPenStyle: TAction; aPenColor: TAction; aPenWidth: TAction; aRowStyle: TAction; aBrushStyle: TAction; aTextCharset: TAction; aFontStyle: TAction; mPenStyle: TMenuItem; mPenColor: TMenuItem; mPenw: TMenuItem; mRowstyle: TMenuItem; N26: TMenuItem; mBrushStyle: TMenuItem; mBrushColor: TMenuItem; N29: TMenuItem; mTextColor: TMenuItem; N31: TMenuItem; N32: TMenuItem; N33: TMenuItem; N34: TMenuItem; N35: TMenuItem; N36: TMenuItem; aFormatOrder: TAction; aFormatAlign: TAction; N1191: TMenuItem; N1192: TMenuItem; N37: TMenuItem; N1193: TMenuItem; N1194: TMenuItem; N1195: TMenuItem; mainOptions: TMenuItem; aGridType: TAction; aShowCenterGuides: TAction; aShowGuideLines: TAction; aSnaptoGrid: TAction; aSnaptoGuides: TAction; aSnaptoNearObject: TAction; aGridColor: TAction; aGuideColor: TAction; aBackgroundColor: TAction; aPageColor: TAction; aAngularGuides: TAction; aRulerSystem: TAction; aRulerMode: TAction; aPageLayout: TAction; aPageOrientation: TAction; aGridStep: TAction; ShowRulers1: TMenuItem; ShowGrids1: TMenuItem; GridType1: TMenuItem; ShowCenterGuides1: TMenuItem; ShowGuideLines1: TMenuItem; SnaptoGrid1: TMenuItem; SnaptoGuides1: TMenuItem; SnaptoNearObject1: TMenuItem; GridColor1: TMenuItem; GuideColor1: TMenuItem; BackgroundColor1: TMenuItem; PageColor1: TMenuItem; AngularGuides1: TMenuItem; RulerSystem1: TMenuItem; RulerMode1: TMenuItem; PageLayout1: TMenuItem; PageOrientation1: TMenuItem; GridStep1: TMenuItem; N39: TMenuItem; PageWidth1: TMenuItem; PageHeight1: TMenuItem; N40: TMenuItem; N41: TMenuItem; aSendtoBack: TAction; aBringtoFront: TAction; aSendBackwards: TAction; aBringForwards: TAction; aalTop: TAction; aalBottom: TAction; aalXcenter: TAction; aalLeft: TAction; aalRight: TAction; aalYCenter: TAction; apsClear: TAction; apsDash: TAction; apsDashDot: TAction; apsDashDotDot: TAction; apsDot: TAction; apsSolid: TAction; mpsSolid: TMenuItem; mpsDash: TMenuItem; mpsDot: TMenuItem; mpsDashDot: TMenuItem; mpsDashDotDot: TMenuItem; mpsClear: TMenuItem; aPenw1: TAction; aPenw2: TAction; aPenw3: TAction; aPenw4: TAction; aPenw5: TAction; aPenw6: TAction; aPenw7: TAction; mPenw1: TMenuItem; mPenw2: TMenuItem; mPenw3: TMenuItem; mPenw4: TMenuItem; mPenw5: TMenuItem; mPenw6: TMenuItem; mPenw7: TMenuItem; arsBothLight: TAction; arsBothSolid: TAction; arsLeftLight: TAction; arsLeftSolid: TAction; arsNone: TAction; arsRightLight: TAction; arsRightSolid: TAction; mrsBothLight: TMenuItem; mrsBothSolid: TMenuItem; mrsLeftLight: TMenuItem; mrsLeftSolid: TMenuItem; mrsNone: TMenuItem; mrsRightLight: TMenuItem; mrsRightSolid: TMenuItem; absBDiagonal: TAction; absClear: TAction; absCross: TAction; absDiagCross: TAction; absFDiagonal: TAction; absHorizontal: TAction; absSolid: TAction; absVertical: TAction; mbsSolid: TMenuItem; mbsClear: TMenuItem; mbsHorizontal: TMenuItem; mbsVertical: TMenuItem; mbsFDiagonal: TMenuItem; mbsBDiagonal: TMenuItem; mbsCross: TMenuItem; mbsDiagCross: TMenuItem; aTextBold: TAction; aTextItalic: TAction; aTextUnderLine: TAction; aTextStrikeThrough: TAction; extBold1: TMenuItem; extItalic1: TMenuItem; extUnderLine1: TMenuItem; extStrikeThrough1: TMenuItem; aANSI_CHARSET: TAction; aDEFAULT_CHARSET: TAction; aRUSSIAN_CHARSET: TAction; ANSICHARSET1: TMenuItem; DEFAULTCHARSET1: TMenuItem; RUSSIANCHARSET1: TMenuItem; aLineGrid: TAction; aPointGrid: TAction; aCrossGrid: TAction; N43: TMenuItem; N44: TMenuItem; N45: TMenuItem; aAngularNone: TAction; aAngular90: TAction; aAngular30: TAction; aAngular60: TAction; aAngular45: TAction; None1: TMenuItem; N90Degrees1: TMenuItem; N30Degrees1: TMenuItem; N45Degrees1: TMenuItem; N60Degrees1: TMenuItem; aMetric: TAction; aWitworth: TAction; aPageMode: TAction; aWorldMode: TAction; aLandscape: TAction; aPortrait: TAction; N46: TMenuItem; N47: TMenuItem; N48: TMenuItem; N49: TMenuItem; N50: TMenuItem; N52: TMenuItem; aA0: TAction; aA1: TAction; aA2: TAction; aA3: TAction; aA4: TAction; aA5: TAction; aA6: TAction; aB4: TAction; aB5: TAction; aTabloid: TAction; aLetter: TAction; aCustom: TAction; A01: TMenuItem; A11: TMenuItem; A21: TMenuItem; A31: TMenuItem; A41: TMenuItem; A51: TMenuItem; A61: TMenuItem; B41: TMenuItem; B51: TMenuItem; N53: TMenuItem; N54: TMenuItem; N55: TMenuItem; cbMainPanel: TControlBar; tbFile: TToolBar; tbNew: TToolButton; tbNewList: TToolButton; tbPrevView: TToolButton; tbPrint: TToolButton; tbObject: TToolBar; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton9: TToolButton; ToolButton10: TToolButton; ToolButton12: TToolButton; ToolButton15: TToolButton; pmOrderSelection: TPopupMenu; N56: TMenuItem; N57: TMenuItem; N58: TMenuItem; N59: TMenuItem; aMoveSelection: TAction; aRotateSelection: TAction; aDuplicateSelection: TAction; aMirrorSelection: TAction; aToolSelect: TAction; aToolLine: TAction; aToolRectangle: TAction; aToolEllipse: TAction; aToolCircle: TAction; aToolArc: TAction; aToolElipticArc: TAction; aToolPolyLine: TAction; aToolPoint: TAction; aToolRichText: TAction; aToolKnife: TAction; aToolHDimLine: TAction; aToolVDimLine: TAction; pmPenStyle: TPopupMenu; pmPenWidth: TPopupMenu; pmRowStyle: TPopupMenu; pmBrushStyle: TPopupMenu; ppsClear: TMenuItem; ppsDash: TMenuItem; ppsDashDot: TMenuItem; ppsDashDotDot: TMenuItem; ppsDot: TMenuItem; ppsSolid: TMenuItem; pPenw1: TMenuItem; pPenw2: TMenuItem; pPenw3: TMenuItem; pPenw4: TMenuItem; pPenw5: TMenuItem; pPenw6: TMenuItem; pPenw7: TMenuItem; prsBothLight: TMenuItem; prsBothSolid: TMenuItem; prsLeftLight: TMenuItem; prsLeftSolid: TMenuItem; prsNone: TMenuItem; prsRightLight: TMenuItem; prsRightSolid: TMenuItem; pbsBDiagonal: TMenuItem; pbsClear: TMenuItem; pbsCross: TMenuItem; pbsDiagCross: TMenuItem; pbsFDiagonal: TMenuItem; pbsHorizontal: TMenuItem; pbsSolid: TMenuItem; pbsVertical: TMenuItem; imagePanel: TImageList; aTextFont: TAction; aTextSize: TAction; ImageStyles: TImageList; aNewLayer: TAction; aDeleteLayer: TAction; aMergeVisible: TAction; aMergeAll: TAction; aFlueInactives: TAction; aHideInactives: TAction; aShowAllLayers: TAction; N11: TMenuItem; aToolMultiLine: TAction; aDisconnect: TAction; aDivideLine: TAction; aToolOrthoLine: TAction; tbLayers: TToolBar; ToolButton47: TToolButton; ToolButton53: TToolButton; ToolButton55: TToolButton; aSetSubstrateLayer: TAction; aSetSCSLayer: TAction; pmiListPageColor: TMenuItem; pmiObjectSplit0: TMenuItem; pmiObjectSplit1: TMenuItem; aSetDefaultColors: TAction; pmSCSObject: TPopupMenu; pmiSCSObjProperties: TMenuItem; aFreeRotate: TAction; pmiListGridStep: TMenuItem; aRegHotKeys: TAction; aUnregHotKeys: TAction; N30: TMenuItem; N42: TMenuItem; aAutoSelectTrace: TAction; aServerAsDefault: TAction; tbLoadSubstrate: TToolButton; aOpenProject: TAction; aRealignLine: TAction; pmiSCSObjRealignLine: TMenuItem; ApplicationEvents1: TApplicationEvents; pmiSCSObjServerAsDefault: TMenuItem; aNotAsServerDefault: TAction; pmiSCSObjNotAsServerDefault: TMenuItem; pmiSCSObjDivideLine: TMenuItem; pmiSCSObjDisconnect: TMenuItem; aSelectTracetoServer: TAction; pmiSCSObjSelectTracetoServer: TMenuItem; aToolText: TAction; aMakeCabling: TAction; pmiSCSObjMakeCabling: TMenuItem; N65: TMenuItem; aViewSCSObjectsProp: TAction; aViewSCS: TMenuItem; aCreateRaise: TAction; pmiSCSObjCreateRaise: TMenuItem; aDestroyRaise: TAction; pmiSCSObjDestroyRaise: TMenuItem; aMasterAutoTrace: TAction; N68: TMenuItem; pmFiguresByLevel: TPopupMenu; aListProperties: TAction; N71: TMenuItem; pmiListProperties: TMenuItem; aRaiseLine: TAction; pmiSCSObjRaiseLine: TMenuItem; aCreateObjectOnClick: TAction; aDeleteSCSObject: TAction; pmiSCSObjDeleteSCSObject: TMenuItem; aShowConnFullness: TAction; aShowCableFullness: TAction; aShowCableChannelFullness: TAction; aCreateObjectOnClickTool: TAction; aCreateFloorRaiseUp: TAction; aCreateFloorRaiseDown: TAction; aTileWindows: TAction; pmiSCSObjCreateFloorRaiseUp: TMenuItem; pmiSCSObjCreateFloorRaiseDown: TMenuItem; aOrderWindow1: TMenuItem; N75: TMenuItem; aCascadeWindows: TAction; aCreateBlockToNB: TAction; aInsertBlock: TAction; aBlocksEditor: TAction; aRotatePointObject90: TAction; aRotatePointObject270: TAction; aRotatePointObject180: TAction; aShiftUpObject: TAction; aShiftDownObject: TAction; aShiftLeftObject: TAction; aShiftRightObject: TAction; aProjectProperties: TAction; aOpenProjectAtCurrNode: TAction; aCloseCurrProject: TAction; aLoadNewProjectFromFile: TAction; aSaveAsSCSProject: TAction; aComponProperties: TAction; aToolPan: TAction; a400: TAction; aDisconnectPointObject: TAction; aRepWizard: TAction; aSaveAsBMP: TAction; aDesignBox: TAction; aShowTracesLengthLimit: TAction; aSaveProject: TAction; aCurrProjectProperties: TAction; aManual_Currency: TAction; aManual_Nettypes: TAction; aManual_Producers: TAction; aManual_Interfaces: TAction; aManual_ObjProp: TAction; aManual_Legends: TAction; aManual_ComponTypes: TAction; aManual_Norms: TAction; aManual_Resources: TAction; aManual_NDS: TAction; pmiObjectSplit2: TMenuItem; N83: TMenuItem; N84: TMenuItem; pmiSCSObjRotatePointObject90: TMenuItem; pmiSCSObjRotatePointObject270: TMenuItem; pmiSCSObjRotatePointObject180: TMenuItem; ImageArrows: TImageList; N86: TMenuItem; N87: TMenuItem; N88: TMenuItem; N89: TMenuItem; N91: TMenuItem; pmiSCSObjComponProperties: TMenuItem; N4001: TMenuItem; pmiSCSObjDisconnectPointObject: TMenuItem; cbLayers: TcxComboBox; N94: TMenuItem; nSave: TMenuItem; pmiSCSObjDesignBox: TMenuItem; N51: TMenuItem; N60: TMenuItem; N61: TMenuItem; nManuals: TMenuItem; N63: TMenuItem; N64: TMenuItem; N66: TMenuItem; N67: TMenuItem; N69: TMenuItem; N72: TMenuItem; N73: TMenuItem; N74: TMenuItem; N92: TMenuItem; N93: TMenuItem; aChoiceNBPath: TAction; aChoicePMPath: TAction; aChoiceBaseOptions: TAction; nSettings: TMenuItem; N97: TMenuItem; N98: TMenuItem; N99: TMenuItem; N19: TMenuItem; N76: TMenuItem; aRegistration: TAction; mRegister: TMenuItem; aUpdateNormBase: TAction; N77: TMenuItem; tbSCSToolsExpert: TToolBar; tbBlkUpExpert: TToolButton; tbBlkDownExpert: TToolButton; tbBlkLeftExpert: TToolButton; tbBlkRightExpert: TToolButton; aHistory: TAction; N78: TMenuItem; pmiList400: TMenuItem; aConnectionsConfigurator: TAction; N12: TMenuItem; aNoMoveConnectedObjects: TAction; TimerProcessMessages: TTimer; aRealignObject: TAction; pmiSCSObjRealignLine2: TMenuItem; pmiSCSObjRealignObject: TMenuItem; TimerOpenStart: TTimer; TimerRefresh: TTimer; aClearGuides: TAction; pmiListClearGuides: TMenuItem; aSaveToIBD: TAction; N80: TMenuItem; aToolSCSHDimLine: TAction; aToolSCSVDimLine: TAction; aToolWallRect: TAction; aToolWallPath: TAction; aDeleteWallPath: TAction; aDeleteWallRect: TAction; aDivSelPath: TAction; aSetWallPathWidth: TAction; aSetAllWallPathWidth: TAction; aAddWindow: TAction; aAddDoor: TAction; aDeleteWindowDoor: TAction; aSetSizeWindowDoor: TAction; pmArchDesign: TPopupMenu; N81: TMenuItem; N85: TMenuItem; N100: TMenuItem; N101: TMenuItem; N102: TMenuItem; N103: TMenuItem; N104: TMenuItem; N105: TMenuItem; N106: TMenuItem; aLoadStamp: TAction; aSaveStamp: TAction; N107: TMenuItem; N108: TMenuItem; aWallPathShowLength: TAction; N109: TMenuItem; aLoadFPlan: TAction; aSaveFPlan: TAction; N110: TMenuItem; N111: TMenuItem; nOpen: TMenuItem; ToolButton35: TToolButton; tbSaveProject: TToolButton; N113: TMenuItem; aAddColumn: TAction; N114: TMenuItem; aDeleteColumn: TAction; aSetColumnAngle: TAction; aSetColumnHeight: TAction; aSetColumnWidth: TAction; N115: TMenuItem; N116: TMenuItem; N117: TMenuItem; N118: TMenuItem; aDesignBoxCaptionHeight: TAction; aDesignBoxCaptionWidth: TAction; pmiObjectSplit3: TMenuItem; N120: TMenuItem; N121: TMenuItem; aSetPathLineWidth: TAction; aSetPathLineStyle: TAction; N122: TMenuItem; N123: TMenuItem; aSetAllPathLineWidth: TAction; aSetAllPathLineStyle: TAction; N124: TMenuItem; N125: TMenuItem; aManual_SuppliesKinds: TAction; N126: TMenuItem; aMasterCableChannel: TAction; N127: TMenuItem; aMasterCableTracing: TAction; N128: TMenuItem; aCreateBlockToFile: TAction; N129: TMenuItem; aChangeRaiseHeight: TAction; pmiSCSObjChangeRaiseHeight: TMenuItem; aCreateProjectPlan: TAction; N131: TMenuItem; aDisconnectFromRM: TAction; aDisconnectAllConnectors: TAction; pmiSCSObjDisconnectAllConnectors: TMenuItem; pmiSCSObjDisconnectFromRM: TMenuItem; aRemoveObjectOnHeight: TAction; pmiSCSObjRemoveObjectOnHeight: TMenuItem; FloatPanel1: TMenuItem; aToolCabinet: TAction; aSaveAsWMF: TAction; aShowConfigurator: TAction; pmiSCSObjShowConfigurator: TMenuItem; aShowRepResources: TAction; N138: TMenuItem; aCreateNormsOnCad: TAction; CAD1: TMenuItem; pmCadNorms: TPopupMenu; aNormsEdit: TAction; aNormsProp: TAction; pmiCNNormsEdit: TMenuItem; pmiCNNormsProp: TMenuItem; aMirrorView: TAction; pmiSCSObjMirrorView: TMenuItem; aCreateDuplicates: TAction; pmiSCSObjCreateDuplicates: TMenuItem; lng_Forms: TsiLangLinked; aCHM: TAction; CHM1: TMenuItem; aDisconnectTraces: TAction; pmiSCSObjDisconnectTraces: TMenuItem; aRotateTraceDrawFigure180: TAction; pmiSCSObjRotateTraceDrawFigure180: TMenuItem; aDesignBoxParams: TAction; pmiListDesignBoxParams: TMenuItem; aPackNormBase: TAction; aPackProjMan: TAction; nServices: TMenuItem; N172: TMenuItem; N176: TMenuItem; aMirrorBlock: TAction; pmiSCSObjMirrorBlock: TMenuItem; aMarkForTracing: TAction; pmiSCSObjMarkForTracing: TMenuItem; pmiObjectSplit4: TMenuItem; aBlockParams: TAction; pmiBlockParams: TMenuItem; aCabinetFalseFloor: TAction; N130: TMenuItem; aLicenceType: TAction; N132: TMenuItem; aShowDisconnectedObjects: TAction; aMasterUpdateComponPriceFromXF: TAction; Excel1: TMenuItem; aRefreshDesignList: TAction; pmiListRefreshDesignList: TMenuItem; aToolOrtholineExt: TAction; aBackUpBase: TAction; aRestoreBase: TAction; N134: TMenuItem; N144: TMenuItem; N167: TMenuItem; N169: TMenuItem; tbCADToolsNoob: TToolBar; tbCADToolsNoob2: TToolBar; tbSelectNoob: TToolButton; tbCabinetNoob: TToolButton; tbWallRectNoob: TToolButton; tbWallPathNoob: TToolButton; cbScaleNoob: TcxComboBox; Label2: TLabel; tbSCSToolsNoob: TToolBar; tbBlkUpNoob: TToolButton; tbBlkDownNoob: TToolButton; tbBlkLeftNoob: TToolButton; tbBlkRightNoob: TToolButton; tbSCSHDimLineNoob: TToolButton; tbSCSVDimLineNoob: TToolButton; aExpertMode: TAction; N177: TMenuItem; cxLabel1: TcxLabel; mainTools: TMenuItem; N180: TMenuItem; N187: TMenuItem; N188: TMenuItem; N193: TMenuItem; N194: TMenuItem; N195: TMenuItem; N196: TMenuItem; N197: TMenuItem; N198: TMenuItem; RTF1: TMenuItem; N199: TMenuItem; N200: TMenuItem; N201: TMenuItem; aShowPMUsers: TAction; aLoginUserToProMan: TAction; aShowCurrUserInfo: TAction; nUsers: TMenuItem; Userloggin1: TMenuItem; Currentuserinfo1: TMenuItem; Addedituser1: TMenuItem; tbCADToolsExpert: TToolBar; tbSelectExpert: TToolButton; tbPanExpert: TToolButton; tbSCSHDimLineExpert: TToolButton; tbSCSVDimLineExpert: TToolButton; tbsToolsExpert: TToolButton; tbLineExpert: TToolButton; tbRectangleExpert: TToolButton; tbEllipseExpert: TToolButton; tbCircleExpert: TToolButton; tbArcExpert: TToolButton; tbElipticArcExpert: TToolButton; tbPolyLineExpert: TToolButton; tbPointExpert: TToolButton; tbTextExpert: TToolButton; tbRichTextExpert: TToolButton; tbKnifeExpert: TToolButton; tbHDimLineExpert: TToolButton; tbVDimLineExpert: TToolButton; ToolButton26: TToolButton; tbCabinetExpert: TToolButton; tbWallRectExpert: TToolButton; tbWallPathExpert: TToolButton; cbScaleExpert: TcxComboBox; aExpertNews: TAction; N202: TMenuItem; TimerNews: TTimer; tbOther: TToolBar; aMarkingPages: TAction; N203: TMenuItem; aMarkForDisableTracing: TAction; pmiSCSObjMarkForDisableTracing: TMenuItem; aMasterAutoTraceElectric: TAction; N205: TMenuItem; ExpertPresentation1: TMenuItem; //pmiSCSObjRotatePointObject270: TMenuItem; aCreateTrunk: TAction; pmiSCSObjCreateTrunk: TMenuItem; pmConnectedPoints: TPopupMenu; miShowConnectedConnCompons: TMenuItem; pmConnectedLines: TPopupMenu; miShowConnectedLineCompons: TMenuItem; // 2011-05-10 n3DModelForList: TMenuItem; tbHouseExpert: TToolButton; tbHouseNoob: TToolButton; ToolButton16: TToolButton; aToolHouse: TAction; pmHouseDesign: TPopupMenu; aAddApproach: TAction; aDeleteHouse: TAction; pmiHDAddApproach: TMenuItem; pmiHDDeleteHouse: TMenuItem; aInsertKnotForHouse: TAction; aDeleteKnotForHouse: TAction; pmiHDInsertKnotForHouse: TMenuItem; pmiHDDeleteKnotForHouse: TMenuItem; aEditApproach: TAction; aRotateApproach: TAction; pmiHDEditApproach: TMenuItem; pmiHDRotateApproach: TMenuItem; aModApproach: TAction; pmiHDModApproach: TMenuItem; pmiHDServerAsDefault: TMenuItem; pmiHDNotAsServerDefault: TMenuItem; tbCabinetExtExpert: TToolButton; aToolCabinetExt: TAction; aConvertSegmentToArc: TAction; aInsertKnotForCabinet: TAction; aDeleteKnotForCabinet: TAction; N214: TMenuItem; N215: TMenuItem; N234: TMenuItem; aShowDefectObjects: TAction; OpenDialog1: TOpenDialog; aInvertArcSegment: TAction; N244: TMenuItem; tbCabinetExtNoob: TToolButton; tbPanNoob: TToolButton; ToolButton3: TToolButton; tbCreateOnClickModeExpert: TToolButton; tbToolOrtholineExtExpert: TToolButton; tbToolOrtholineExpert: TToolButton; ToolButton20: TToolButton; ToolButton18: TToolButton; tbCreateOnClickModeNoob: TToolButton; tbToolOrtholineExtNoob: TToolButton; tbToolOrtholineNoob: TToolButton; ToolButton21: TToolButton; aToolSCSHDimLine1: TMenuItem; aToolSCSVDimLine1: TMenuItem; aOpenVectorDrawing: TAction; aOpenRasterDrawing: TAction; aSaveVectorDrawing: TAction; aSaveRasterDrawing: TAction; N3: TMenuItem; N8: TMenuItem; N9: TMenuItem; N10: TMenuItem; tbCHM: TToolButton; aCreateVertical: TAction; pmiSCSObjCreateVertical: TMenuItem; tbArch: TToolBar; ToolButton1: TToolButton; aNetPathToArc: TAction; N13: TMenuItem; aInvertNetPathArc: TAction; N14: TMenuItem; n3DModelForProject: TMenuItem; aAutoCreateTraces: TAction; pmiSCSObjAutoCreateTraces: TMenuItem; aDivTracesOnRoowWalls: TAction; pmiSCSObjDivTracesOnRoowWalls: TMenuItem; pmShowPathLengthType: TPopupMenu; N17: TMenuItem; N18: TMenuItem; N22: TMenuItem; aPathLengthTypePoints: TAction; aPathLengthTypeInner: TAction; aPathLengthTypeOuter: TAction; aPathTraceLengthTypePoints: TAction; aPathTraceLengthTypeInner: TAction; aPathTraceLengthTypeOuter: TAction; pmShowPathTraceLengthType: TPopupMenu; MenuItem1: TMenuItem; MenuItem2: TMenuItem; MenuItem3: TMenuItem; pmiArchDesignSplit2: TMenuItem; N24: TMenuItem; N901: TMenuItem; N25: TMenuItem; N2701: TMenuItem; N902: TMenuItem; N2702: TMenuItem; N2703: TMenuItem; N27: TMenuItem; aMirrorFigure: TAction; N38: TMenuItem; N62: TMenuItem; aNetProps: TAction; pmiNetProps: TMenuItem; aConvertToPolygon: TAction; N23: TMenuItem; N82: TMenuItem; tbSCSArcDimLineExpert: TToolButton; aToolSCSArcDimLine: TAction; tbSCSArcDimLineNoob: TToolButton; tbPrintRect: TToolButton; aPrintRect: TAction; tbCalc: TToolButton; tb3D: TToolButton; tbExtProtocol: TToolButton; tbConnectionsConfigurator: TToolButton; tbRepWizard: TToolButton; aSegCurveAll: TAction; aSegLineAll: TAction; aSegClose: TAction; aSegOpen: TAction; aSegInsertKnot: TAction; aSegDeleteKnot: TAction; aSegLine: TAction; aSegCurve: TAction; aSegArc: TAction; aSegDimLine: TAction; aSegDivTo3: TAction; aSegInverArc: TAction; aSegRoundCornerByArc: TAction; aSegPenNone: TAction; aSegPenZigZag: TAction; aSegPenFlower: TAction; aSegPenSinus: TAction; aSegPenButtons: TAction; aSegPenSquare: TAction; aSegPenMiniSinus: TAction; pmiObjectSplitPoly: TMenuItem; N90: TMenuItem; N95: TMenuItem; N96: TMenuItem; N112: TMenuItem; pmiObjSegment: TMenuItem; N119: TMenuItem; N139: TMenuItem; N171: TMenuItem; N245: TMenuItem; N246: TMenuItem; N247: TMenuItem; N310: TMenuItem; N248: TMenuItem; pmiSegPenPattern: TMenuItem; N249: TMenuItem; N250: TMenuItem; N251: TMenuItem; N252: TMenuItem; N253: TMenuItem; N254: TMenuItem; N255: TMenuItem; aSaveProjectToPDF: TAction; PDF1: TMenuItem; pmiSCSObjFreeRotate: TMenuItem; aLinesToTraces: TAction; N257: TMenuItem; pmiArchTurn: TMenuItem; aTurnObject: TAction; tbShowRepResources: TToolButton; aLoadSubstrateFromPDF: TAction; PDF2: TMenuItem; TimerInteractive: TTimer; tbInteractive: TToolBar; tbInteractiveNextStep: TToolButton; aInteractiveNextStep: TAction; aInteractiveStop: TAction; ToolButton2: TToolButton; aTransparentFigure: TAction; N15: TMenuItem; pnHintBar: TRzSizePanel; aExportDWG: TAction; DWG1: TMenuItem; aSaveRevision: TAction; aViewRevs: TAction; aProjectSchedule: TAction; N16: TMenuItem; N20: TMenuItem; N21: TMenuItem; aBillWork: TAction; N28: TMenuItem; aShowCableRule: TMenuItem; aAutoDiv: TAction; pmiSCSObjAutoDivideLine: TMenuItem; N70: TMenuItem; Act_ConnectSelectedPoints: TAction; Act_ReindexMaster: TAction; N79: TMenuItem; N133: TMenuItem; N149: TMenuItem; N150: TMenuItem; N170: TMenuItem; EmptyConnSelect: TAction; N207: TMenuItem; SelectAllLineObjs: TAction; SelectAllPointObjects: TAction; N208: TMenuItem; N209: TMenuItem; Act_Magistral_Channel_Index: TAction; N210: TMenuItem; N211: TMenuItem; actLoadPictasRastr: TAction; Act_AlignSelection: TAction; N212: TMenuItem; N1100: TMenuItem; N213: TMenuItem; N311: TMenuItem; N410: TMenuItem; N235: TMenuItem; aToolPie: TAction; tbPieExpert: TToolButton; SetSefaultAllowTransparensy: TAction; SetNetDoorType: TMenuItem; N237: TMenuItem; N256: TMenuItem; N258: TMenuItem; aSetDoubleDoor: TAction; aSetMirroredDoor: TAction; aSetLeftRightDoor: TAction; N236: TMenuItem; N259: TMenuItem; aSetOpenedDoor: TAction; aSetHalfOpenedDoor: TAction; aSetCornHeight: TAction; N260: TMenuItem; aSetDoorWndH: TAction; N261: TMenuItem; aSetDoorWindowPllacementHeight: TAction; N263: TMenuItem; aSetAllListDoorsPlacementHeight: TAction; N262: TMenuItem; N264: TMenuItem; aSetAllListWndPlacement: TAction; aSetAllListDoorsHeight: TAction; aSetAllListWndHeight: TAction; B1: TMenuItem; N265: TMenuItem; N266: TMenuItem; DCP_md41: TDCP_md4; pmiOneLineCheme: TMenuItem; aOneLineCheme: TAction; pmELObjMenu: TPopupMenu; mnuRot90: TMenuItem; mnuRot180: TMenuItem; mnuRot270: TMenuItem; Act_SelectCableToTrace: TAction; mnuSelTraceCable: TMenuItem; mnuAsServer: TMenuItem; mnuAsNoServer: TMenuItem; Act_ConnectByCable: TAction; mnuConnectByCable: TMenuItem; Act_ConnectByCableAll: TAction; Act_ConnectByCableOnEnds: TAction; mnuConnectByCableEnds: TMenuItem; mnuOnLineSC: TMenuItem; mnuRotObj: TMenuItem; N268: TMenuItem; N269: TMenuItem; EmptyTracesSelect: TAction; EmptyRaiseVertSelect: TAction; Pmi_CopyCurrList: TMenuItem; Pmi_CopyCurrListWCompon: TMenuItem; CopyList_All: TAction; CopyList_WCompon: TAction; pmSCSRack: TPopupMenu; pmiAsDefaultServer: TMenuItem; Act_SelectFiberCableToTrace: TAction; Act_ConnectToAnotherRack: TAction; pmiSelectFiberCableToTrace: TMenuItem; pmiConnectToAnotherRack: TMenuItem; Act_SetAsEndObject: TAction; pmi_SelectFiberCableToTrace: TMenuItem; pmi_ConnectToAnotherRack: TMenuItem; cxLabel2: TcxLabel; XPMenu1: TXPMenu; G1: TMenuItem; N218: TMenuItem; N267: TMenuItem; N270: TMenuItem; N271: TMenuItem; N272: TMenuItem; N273: TMenuItem; N274: TMenuItem; ToolButton4: TToolButton; N275: TMenuItem; mnuInstRaspredBox: TMenuItem; aInstRaspredBox: TAction; mnuShieldAssemblySH: TMenuItem; aShieldAssemblyScheme: TAction; TimerTracingInterval: TTimer; mnuReserv: TMenuItem; pmCreateBFMagistral: TMenuItem; aCreateBFMagistral: TAction; pmCreateBFMagistralDown: TMenuItem; pmCreateBFMagistralUp: TMenuItem; aCreateBFMagistralDown: TAction; aCreateBFMagistralUp: TAction; ACreateFloorV: TAction; pmCreateFloorV: TMenuItem; // ACTIONs // создать новый проект procedure aNewExecute(Sender: TObject); // загрузить подложку procedure aLoadSubstrateExecute(Sender: TObject); // закрыть лист procedure aCloseExecute(Sender: TObject); // сохранить подложку procedure aSaveSubstrateExecute(Sender: TObject); // сохранить подложку как... procedure aSaveAsSubstrateExecute(Sender: TObject); // Экспорт в DXF procedure aExportExecute(Sender: TObject); // Импорт в DXF procedure aImportExecute(Sender: TObject); // Предварительный просмотр procedure aPrevViewExecute(Sender: TObject); // Печать procedure aPrintExecute(Sender: TObject); // Выход из программы procedure aExitExecute(Sender: TObject); // Undo procedure aUndoExecute(Sender: TObject); // Redo procedure aRedoExecute(Sender: TObject); // Вырезать в буффер procedure aCutExecute(Sender: TObject); // Копировать в буффер procedure aCopyExecute(Sender: TObject); // Вставить из буффера procedure aPasteExecute(Sender: TObject); // Выделить все procedure aSelectAllExecute(Sender: TObject); // поиск (не работает) procedure aFindExecute(Sender: TObject); // поиск следующего (не работает) procedure aFindNextExecute(Sender: TObject); // Во весь экран procedure aAllScreenExecute(Sender: TObject); // масштаб 50% procedure a50Execute(Sender: TObject); // масштаб 75% procedure a75Execute(Sender: TObject); // масштаб 100% procedure a100Execute(Sender: TObject); // масштаб 150% procedure a150Execute(Sender: TObject); // масштаб 200% procedure a200Execute(Sender: TObject); // увеличить масштаб на... procedure aIncExecute(Sender: TObject); // увеличить масштаб на 5% procedure aInc1ptExecute(Sender: TObject); // уменьшить масштаб на 5% procedure aDec1ptExecute(Sender: TObject); // цвет фона КАДа procedure aBackgroundColorExecute(Sender: TObject); // показывать линийку на КАДе procedure aShowRulerExecute(Sender: TObject); // показывать сетку на КАДе procedure aShowGridExecute(Sender: TObject); // показывать панель инструментов procedure aViewBtnPanelExecute(Sender: TObject); // показывать окно нормативной базы procedure aViewNormBaseExecute(Sender: TObject); // показывать свойства КАД объектов procedure aViewCADObjectsPropExecute(Sender: TObject); // показывать навигатор procedure aViewNavigatorExecute(Sender: TObject); // показывать свойства СКС объектов procedure aObjPropertiesExecute(Sender: TObject); // свободное вращение procedure aRotateExecute(Sender: TObject); // на задний план procedure aBackwardsExecute(Sender: TObject); // на передний план procedure aForwardExecute(Sender: TObject); // сгруппировать procedure aGroupingExecute(Sender: TObject); // разгруппировать procedure aUngroupingExecute(Sender: TObject); // заблочить procedure aLockExecute(Sender: TObject); // разблочить procedure aUnlockExecute(Sender: TObject); // изменить шрифт procedure aTextFontExecute(Sender: TObject); // изменить MapScale procedure aScaleExecute(Sender: TObject); // создать новый лист procedure aNewWindowExecute(Sender: TObject); // закрыть все окна procedure aCloseAllWindowsExecute(Sender: TObject); // вызвать Хелп procedure aHelpExecute(Sender: TObject); // Презентация procedure aPresentationExecute(Sender: TObject); // Интерактивное обучение (не работает) procedure aInteractiveExecute(Sender: TObject); // не работает procedure aWizardsExecute(Sender: TObject); // не работает procedure aTechDocExecute(Sender: TObject); // не работает procedure aToAuthorsExecute(Sender: TObject); procedure aBuyExecute(Sender: TObject); // О программе procedure aAboutExecute(Sender: TObject); // показывать Менеджер проектов procedure aViewProjectManagerExecute(Sender: TObject); // создание нового листа procedure aNewListExecute(Sender: TObject); // вставка текста procedure aInsertTextExecute(Sender: TObject); // вставка картинки procedure aInsertBitmapExecute(Sender: TObject); // Удалить procedure aDeleteExecute(Sender: TObject); // удалить все procedure aDeleteAllExecute(Sender: TObject); // убрать выделение со всех объектов procedure aDeSelectAllExecute(Sender: TObject); // стиль линии procedure aPenStyleExecute(Sender: TObject); // цвет линии procedure aPenColorExecute(Sender: TObject); // ширина линии procedure aPenWidthExecute(Sender: TObject); // стиль стрелки линии procedure aRowStyleExecute(Sender: TObject); // стиль заливки procedure aBrushStyleExecute(Sender: TObject); // кодировка procedure aTextCharsetExecute(Sender: TObject); // шрифт procedure aFontStyleExecute(Sender: TObject); // перемещение на задний/передний план procedure aFormatOrderExecute(Sender: TObject); // тип сетки procedure aGridTypeExecute(Sender: TObject); // показывать центральные направляющие procedure aShowCenterGuidesExecute(Sender: TObject); // показывать направляющие procedure aShowGuideLinesExecute(Sender: TObject); // привязка к сетке procedure aSnaptoGridExecute(Sender: TObject); // привязка к направляющим procedure aSnaptoGuidesExecute(Sender: TObject); // привязка к ближнему объекту procedure aSnaptoNearObjectExecute(Sender: TObject); // цвет сетки procedure aGridColorExecute(Sender: TObject); // цвет направляющих procedure aGuideColorExecute(Sender: TObject); // цвет страницы procedure aPageColorExecute(Sender: TObject); // направляющие под углом procedure aAngularGuidesExecute(Sender: TObject); // система линейки: см, м procedure aRulerSystemExecute(Sender: TObject); // тип линейки: страничная, глобальная procedure aRulerModeExecute(Sender: TObject); // формат листа procedure aPageLayoutExecute(Sender: TObject); // ориентация листа procedure aPageOrientationExecute(Sender: TObject); // шаг сетки procedure aGridStepExecute(Sender: TObject); // план назад procedure aSendtoBackExecute(Sender: TObject); // план вперед procedure aBringtoFrontExecute(Sender: TObject); // на задний план procedure aSendBackwardsExecute(Sender: TObject); // на передний план procedure aBringForwardsExecute(Sender: TObject); // выравнивания procedure aalTopExecute(Sender: TObject); procedure aalBottomExecute(Sender: TObject); procedure aalXcenterExecute(Sender: TObject); procedure aalLeftExecute(Sender: TObject); procedure aalRightExecute(Sender: TObject); procedure aalYCenterExecute(Sender: TObject); procedure aFormatAlignExecute(Sender: TObject); // стили линий procedure apsClearExecute(Sender: TObject); procedure apsDashExecute(Sender: TObject); procedure apsDashDotExecute(Sender: TObject); procedure apsDashDotDotExecute(Sender: TObject); procedure apsDotExecute(Sender: TObject); procedure apsSolidExecute(Sender: TObject); // ширини линий procedure aPenw1Execute(Sender: TObject); procedure aPenw2Execute(Sender: TObject); procedure aPenw3Execute(Sender: TObject); procedure aPenw4Execute(Sender: TObject); procedure aPenw5Execute(Sender: TObject); procedure aPenw6Execute(Sender: TObject); procedure aPenw7Execute(Sender: TObject); // стили стрелок линий procedure arsBothLightExecute(Sender: TObject); procedure arsBothSolidExecute(Sender: TObject); procedure arsLeftLightExecute(Sender: TObject); procedure arsLeftSolidExecute(Sender: TObject); procedure arsNoneExecute(Sender: TObject); procedure arsRightLightExecute(Sender: TObject); procedure arsRightSolidExecute(Sender: TObject); // стили заливок procedure absBDiagonalExecute(Sender: TObject); procedure absClearExecute(Sender: TObject); procedure absCrossExecute(Sender: TObject); procedure absDiagCrossExecute(Sender: TObject); procedure absFDiagonalExecute(Sender: TObject); procedure absHorizontalExecute(Sender: TObject); procedure absSolidExecute(Sender: TObject); procedure absVerticalExecute(Sender: TObject); // стили шрифта procedure aTextBoldExecute(Sender: TObject); procedure aTextItalicExecute(Sender: TObject); procedure aTextUnderLineExecute(Sender: TObject); procedure aTextStrikeThroughExecute(Sender: TObject); // кодировки шрифта procedure aANSI_CHARSETExecute(Sender: TObject); procedure aDEFAULT_CHARSETExecute(Sender: TObject); procedure aRUSSIAN_CHARSETExecute(Sender: TObject); // цвет заливки procedure aBrushColorExecute(Sender: TObject); // цвет текста procedure aTextColorExecute(Sender: TObject); // виды сетки procedure aLineGridExecute(Sender: TObject); procedure aPointGridExecute(Sender: TObject); procedure aCrossGridExecute(Sender: TObject); // виды направляющих под углом procedure aAngularNoneExecute(Sender: TObject); procedure aAngular90Execute(Sender: TObject); procedure aAngular30Execute(Sender: TObject); procedure aAngular60Execute(Sender: TObject); procedure aAngular45Execute(Sender: TObject); // виды системы линейки procedure aMetricExecute(Sender: TObject); procedure aWitworthExecute(Sender: TObject); // виды режима линейки procedure aPageModeExecute(Sender: TObject); procedure aWorldModeExecute(Sender: TObject); // виды ориентации листа procedure aLandscaleExecute(Sender: TObject); procedure aPortraitExecute(Sender: TObject); // виды формата листа procedure aA0Execute(Sender: TObject); procedure aA1Execute(Sender: TObject); procedure aA2Execute(Sender: TObject); procedure aA3Execute(Sender: TObject); procedure aA4Execute(Sender: TObject); procedure aA5Execute(Sender: TObject); procedure aA6Execute(Sender: TObject); procedure aB4Execute(Sender: TObject); procedure aB5Execute(Sender: TObject); procedure aLetterExecute(Sender: TObject); procedure aTabloidExecute(Sender: TObject); procedure aCustomExecute(Sender: TObject); // дублировать выделенные (КАД объекты) procedure aDuplicateSelectionExecute(Sender: TObject); // вращение выбранного (КАД объекты) procedure aRotateSelectionExecute(Sender: TObject); // перемещение выбранного (КАД объекты) procedure aMoveSelectionExecute(Sender: TObject); // зеркальное отображение выбранного (КАД объекты) procedure aMirrorSelectionExecute(Sender: TObject); // тулса - выборка procedure aToolSelectExecute(Sender: TObject); // тулса - линия procedure aToolLineExecute(Sender: TObject); // тулса - прямоуголник procedure aToolRectangleExecute(Sender: TObject); // тулса - эллипс procedure aToolEllipseExecute(Sender: TObject); // тулса - окружность procedure aToolCircleExecute(Sender: TObject); // тулса - дуга procedure aToolArcExecute(Sender: TObject); // тулса - эллипсическая дуга procedure aToolElipticArcExecute(Sender: TObject); // тулса - полилиния procedure aToolPolyLineExecute(Sender: TObject); // тулса - точка procedure aToolPointExecute(Sender: TObject); // тулса - РТФ текст procedure aToolRichTextExecute(Sender: TObject); // тулса - разрезка procedure aToolKnifeExecute(Sender: TObject); // тулса - горизонтальная измерительная линия procedure aToolHDimLineExecute(Sender: TObject); // тулса - вертикальная измерительная линия procedure aToolVDimLineExecute(Sender: TObject); // размер текста procedure aTextSizeExecute(Sender: TObject); // менеджер слоев procedure aViewLayersExecute(Sender: TObject); // добавление нового слоя procedure aNewLayerExecute(Sender: TObject); // удаление слоя procedure aDeleteLayerExecute(Sender: TObject); // слияние всех видимых слоев procedure aMergeVisibleExecute(Sender: TObject); // слияние всех слоев procedure aMergeAllExecute(Sender: TObject); // все неактивные слои как подложка procedure aFlueInactivesExecute(Sender: TObject); // скрыть все неактивнвые слои procedure aHideInactivesExecute(Sender: TObject); // показать все слои procedure aShowAllLayersExecute(Sender: TObject); // удалить соединитель - слияние трасс procedure aDisconnectExecute(Sender: TObject); // разделение трассы procedure aDivideLineExecute(Sender: TObject); // тулса - ортолиния procedure aToolOrthoLineExecute(Sender: TObject); // установить слой подложка procedure aSetSubstrateLayerExecute(Sender: TObject); // установить слой СКС procedure aSetSCSLayerExecute(Sender: TObject); // установка цветов по умолчанию procedure aSetDefaultColorsExecute(Sender: TObject); // изменить параметров ортолинии procedure aChangeOrtoParamsExecute(Sender: TObject); // свободное вращение (КАД объекты) procedure aFreeRotateExecute(Sender: TObject); // регистрация горячих клавиш procedure aRegHotKeysExecute(Sender: TObject); // отрегистрация горячих клавиш procedure aUnregHotKeysExecute(Sender: TObject); // автовыделять трассу до конечного объекта procedure aAutoSelectTraceExecute(Sender: TObject); // установить как КО procedure aServerAsDefaultExecute(Sender: TObject); // открыть проект procedure aOpenProjectExecute(Sender: TObject); // выравнивание линии по сетке procedure aRealignLineExecute(Sender: TObject); // убрать установку как КО procedure aNotAsServerDefaultExecute(Sender: TObject); // выделить трассу до КО procedure aSelectTracetoServerExecute(Sender: TObject); // тулса - текст procedure aToolTextExecute(Sender: TObject); // сделать скрутку кабелей (для электрики) procedure aMakeCablingExecute(Sender: TObject); // свойство СКС объектов procedure aViewSCSObjectsPropExecute(Sender: TObject); // создание с-п procedure aCreateRaiseExecute(Sender: TObject); // удаление с-п procedure aDestroyRaiseExecute(Sender: TObject); // мастер автотрассировки procedure aMasterAutoTraceExecute(Sender: TObject); // свойства листа procedure aListPropertiesExecute(Sender: TObject); // отчет Ведомость объектов procedure aReport_ListObjectsExecute(Sender: TObject); // отчет Ведомость ресурсов procedure aReport_ResorcesExecute(Sender: TObject); // отчет Ведомость кабелей procedure aReport_CablesExecute(Sender: TObject); // отчет Кабели с превышающей длиной procedure aReport_CablesWithLimitLengthExecute(Sender: TObject); // отчет Кабельные каналы procedure aReport_CableChannelsExecute(Sender: TObject); // отчет Подключения по цветам procedure aReport_ConnectByColorsExecute(Sender: TObject); // отчет Подключения по производителям procedure aReport_ConnectByProducerExecute(Sender: TObject); // отчет Кабельный журнал procedure aReport_ConnectionsExecute(Sender: TObject); // отчет Спецификация procedure aReport_SpecificationExecute(Sender: TObject); // поднять/опустить трассу // Tolik -- 01/08/2016 -- Procedure aRaiseLineExecute(Sender: TObject); procedure RaiseSelectedLine(aToHeight: Double = -1); // создавать объекты по клику на КАД procedure aCreateObjectOnClickExecute(Sender: TObject); // удалить СКС объект procedure aDeleteSCSObjectExecute(Sender: TObject); // показывать заполненность объектов procedure aShowConnFullnessExecute(Sender: TObject); // показывать заполненность кабелей procedure aShowCableFullnessExecute(Sender: TObject); // показывать заполненность кабельных каналов procedure aShowCableChannelFullnessExecute(Sender: TObject); // тулса - создавать объекты при клике на КАД procedure aCreateObjectOnClickToolExecute(Sender: TObject); // создать межэтажный подьем procedure aCreateFloorRaiseUpExecute(Sender: TObject); // создать межэтажный спуск procedure aCreateFloorRaiseDownExecute(Sender: TObject); // расположить окна КАДов по порядку procedure aTileWindowsExecute(Sender: TObject); // расположить окна КАДов каскадом procedure aCascadeWindowsExecute(Sender: TObject); // вставить блок procedure aInsertBlockExecute(Sender: TObject); // создать УГО в НБ procedure aCreateBlockToNBExecute(Sender: TObject); // запуск редактора экспорта УГО procedure aBlocksEditorExecute(Sender: TObject); // вращать УГО объекта на 90 градусов procedure aRotatePointObject90Execute(Sender: TObject); // вращать УГО объекта на 180 градусов procedure aRotatePointObject180Execute(Sender: TObject); // сдвиг УГО объектов вверх procedure aShiftUpObjectExecute(Sender: TObject); // сдвиг УГО объектов вниз procedure aShiftDownObjectExecute(Sender: TObject); // сдвиг УГО объектов влево procedure aShiftLeftObjectExecute(Sender: TObject); // сдвиг УГО объектов вправо procedure aShiftRightObjectExecute(Sender: TObject); // отчет Расширенный кабельный журнал procedure aReport_CableJournalExtExecute(Sender: TObject); // свойства проекта procedure aProjectPropertiesExecute(Sender: TObject); // открыть проект из файла procedure aOpenProjectAtCurrNodeExecute(Sender: TObject); // закрыть текущий проект procedure aCloseCurrProjectExecute(Sender: TObject); // загрузка проекта из файла procedure aLoadNewProjectFromFileExecute(Sender: TObject); // Сохранить проект как procedure aSaveAsSCSProjectExecute(Sender: TObject); // свойства компоненты в объекте procedure aComponPropertiesExecute(Sender: TObject); // тулса - панаромирование procedure aToolPanExecute(Sender: TObject); // масштаб 400% procedure a400Execute(Sender: TObject); // отсоединить ТО procedure aDisconnectPointObjectExecute(Sender: TObject); // Мастер отчетов procedure aRepWizardExecute(Sender: TObject); // сохранить КАД как БМП procedure aSaveAsBMPExecute(Sender: TObject); // показывать трассы с превышающей длиной procedure aShowTracesLengthLimitExecute(Sender: TObject); // сохранить проект в МП procedure aSaveProjectExecute(Sender: TObject); // свойства текущего проекта procedure aCurrProjectPropertiesExecute(Sender: TObject); // справочник Валюты procedure aManual_CurrencyExecute(Sender: TObject); // справочник Типы сетей procedure aManual_NettypesExecute(Sender: TObject); // справочник По производителю procedure aManual_ProducersExecute(Sender: TObject); // справочник Интерфейсы procedure aManual_InterfacesExecute(Sender: TObject); // справочник Свойства объектов procedure aManual_ObjPropExecute(Sender: TObject); // справочник УГО procedure aManual_LegendsExecute(Sender: TObject); // справочник Типы компонент procedure aManual_ComponTypesExecute(Sender: TObject); // справочник Нормы procedure aManual_NormsExecute(Sender: TObject); // справочник Ресурсы procedure aManual_ResourcesExecute(Sender: TObject); // справочник НДС procedure aManual_NDSExecute(Sender: TObject); // Дизайн шкафа procedure aDesignBoxExecute(Sender: TObject); // выбор пути к НБ procedure aChoiceNBPathExecute(Sender: TObject); // выбор пути к МП procedure aChoicePMPathExecute(Sender: TObject); // Настройки программы procedure aChoiceBaseOptionsExecute(Sender: TObject); // Регистрация procedure aRegistrationExecute(Sender: TObject); // Обновление НБ procedure aUpdateNormBaseExecute(Sender: TObject); // Хистори procedure aHistoryExecute(Sender: TObject); // конфигуратор соединений procedure aConnectionsConfiguratorExecute(Sender: TObject); // не перемещать присоединенные объекты procedure aNoMoveConnectedObjectsExecute(Sender: TObject); // выровнять Объект по сетке procedure aRealignObjectExecute(Sender: TObject); // Очистить направляющие procedure aClearGuidesExecute(Sender: TObject); // Сохранить в ИБД procedure aSaveToIBDExecute(Sender: TObject); // тулса - горизонтальная измерительная линия СКС procedure aToolSCSHDimLineExecute(Sender: TObject); // тулса - вертикальная измерительная линия СКС procedure aToolSCSVDimLineExecute(Sender: TObject); // тулса - план procedure aToolWallRectExecute(Sender: TObject); // тулса - сегмент плана procedure aToolWallPathExecute(Sender: TObject); // удалить сегмент procedure aDeleteWallPathExecute(Sender: TObject); // удалить план procedure aDeleteWallRectExecute(Sender: TObject); // разделить сегмент procedure aDivSelPathExecute(Sender: TObject); // установить ширину сегмента procedure aSetWallPathWidthExecute(Sender: TObject); // установить ширину всех сегментов плана procedure aSetAllWallPathWidthExecute(Sender: TObject); // добавить окно на сегмент procedure aAddWindowExecute(Sender: TObject); // добавить дверь на сегмент procedure aAddDoorExecute(Sender: TObject); // удалить дверь/окно с сегмента procedure aDeleteWindowDoorExecute(Sender: TObject); // установить размер окна/двери procedure aSetSizeWindowDoorExecute(Sender: TObject); // загрузить подложку procedure aLoadStampExecute(Sender: TObject); // сохранить подложку procedure aSaveStampExecute(Sender: TObject); // показывать длину сегментов procedure aWallPathShowLengthExecute(Sender: TObject); // сохранить архитектурный план procedure aSaveFPlanExecute(Sender: TObject); // загрузить архитектурный план procedure aLoadFPlanExecute(Sender: TObject); // добавить колонну на сегмент procedure aAddColumnExecute(Sender: TObject); // удалить колонну с сегмента procedure aDeleteColumnExecute(Sender: TObject); // установить угол колонны сегмента procedure aSetColumnAngleExecute(Sender: TObject); // установить высоту колонны сегмента procedure aSetColumnHeightExecute(Sender: TObject); // установить ширину колонны сегмента procedure aSetColumnWidthExecute(Sender: TObject); // высота подписей к Дизайну шкафа procedure aDesignBoxCaptionHeightExecute(Sender: TObject); // ширина подписей к Дизайну шкафа procedure aDesignBoxCaptionWidthExecute(Sender: TObject); // ширина линии сегмента procedure aSetPathLineWidthExecute(Sender: TObject); // стиль линии сегмента procedure aSetPathLineStyleExecute(Sender: TObject); // ширина линий всех сегментов procedure aSetAllPathLineWidthExecute(Sender: TObject); // стиль линий всех сегментов procedure aSetAllPathLineStyleExecute(Sender: TObject); // справочник Типы поставок procedure aManual_SuppliesKindsExecute(Sender: TObject); // мастер прокладки кабельных каналов procedure aMasterCableChannelExecute(Sender: TObject); // мастер трассировки кабеля procedure aMasterCableTracingExecute(Sender: TObject); // сохранение УГО в файл procedure aCreateBlockToFileExecute(Sender: TObject); // изменить высоту с-п procedure aChangeRaiseHeightExecute(Sender: TObject); // создать лист схемы проекта procedure aCreateProjectPlanExecute(Sender: TObject); // отсоединить от РМ procedure aDisconnectFromRMExecute(Sender: TObject); // отсоединить все соединители от РМ procedure aDisconnectAllConnectorsExecute(Sender: TObject); // переместить объект на высоту procedure aRemoveObjectOnHeightExecute(Sender: TObject); // тулса - кабинет procedure aToolCabinetExecute(Sender: TObject); // сохранить КАД как WMF procedure aSaveAsWMFExecute(Sender: TObject); // показать конфигуратор procedure aShowConfiguratorExecute(Sender: TObject); // показать отчет Ведомость ресурсов procedure aShowRepResourcesExecute(Sender: TObject); // создание Ведомости норм на КАД procedure aCreateNormsOnCadExecute(Sender: TObject); // редактирование Ведомости норм на КАД procedure aNormsEditExecute(Sender: TObject); // свойства Ведомости норм на КАД procedure aNormsPropExecute(Sender: TObject); // зеркальное отображение кроссов procedure aMirrorViewExecute(Sender: TObject); // создание дубликатор procedure aCreateDuplicatesExecute(Sender: TObject); // Хелп в виде CHM procedure aCHMExecute(Sender: TObject); // Отсоединить все трассы от коннектора procedure aDisconnectTracesExecute(Sender: TObject); // Повернуть УГО трассы на 180 градусов procedure aRotateTraceDrawFigure180Execute(Sender: TObject); // параметры Дизайна шкафа procedure aDesignBoxParamsExecute(Sender: TObject); // упаковка НБ procedure aPackNormBaseExecute(Sender: TObject); // упаковка МП procedure aPackProjManExecute(Sender: TObject); // зеркальное отображение УГО procedure aMirrorBlockExecute(Sender: TObject); // установка пометки трассы для трассировки procedure aMarkForTracingExecute(Sender: TObject); // обработчик закрытия формы procedure FormClose(Sender: TObject; var Action: TCloseAction); // событие на минимизации procedure AppMinima(Sender: TObject); // передвижение сплитеров procedure sDiv1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure sDiv2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); procedure sDiv1Moved(Sender: TObject); procedure sDiv2Moved(Sender: TObject); // переключение окон/листов procedure SwitchWindow(Sender: TObject); procedure PDock1DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure PDock1UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean); procedure PDock1DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer); procedure FormCreate(Sender: TObject); procedure pageCADListChange(Sender: TObject); procedure fcbTextFontChange(Sender: TObject); procedure fcbTextSizeChange(Sender: TObject); procedure cbMainPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure tbEditStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbEditEndDock(Sender, Target: TObject; X, Y: Integer); procedure tbFileStartDock(Sender: TObject; var DragObject: TDragObject); procedure tbFileEndDock(Sender, Target: TObject; X, Y: Integer); procedure tbFormatStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbFormatEndDock(Sender, Target: TObject; X, Y: Integer); procedure tbObjectStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbObjectEndDock(Sender, Target: TObject; X, Y: Integer); procedure tbSelectOptionsStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbSelectOptionsEndDock(Sender, Target: TObject; X, Y: Integer); procedure tbCADToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbCADToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer); procedure mpsDashAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure mPenw1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure mrsBothLightAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure mbsVerticalAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure cbScalePropertiesCloseUp(Sender: TObject); procedure cbScaleExpertKeyPress(Sender: TObject; var Key: Char); procedure cbLayersPropertiesCloseUp(Sender: TObject); procedure cbLayersCloseUp(Sender: TObject); procedure cxComboBox1Enter(Sender: TObject); procedure mRegisterClick(Sender: TObject); procedure FormResize(Sender: TObject); procedure tbSCSToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure tbSCSToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer); procedure ApplicationEvents1Exception(Sender: TObject; E: Exception); procedure TimerProcessMessagesTimer(Sender: TObject); procedure FormShow(Sender: TObject); procedure TimerOpenStartTimer(Sender: TObject); procedure TimerRefreshTimer(Sender: TObject); procedure FOnAppActivate(Sender: TObject); procedure tbExtProtocolClick(Sender: TObject); procedure N113Click(Sender: TObject); procedure FloatPanel1Click(Sender: TObject); procedure PDock1Resize(Sender: TObject); // регистрация горячих клавиш procedure RegisteredHotKeys; // отрегистрация горячих клавиш procedure UnRegisteredHotKeys; // регистрация горячих клавиш на КАДе procedure RegisteredCADHotKeys; // отрегистрация горячих клавиш на КАДе procedure UnRegisteredCADHotKeys; procedure aBlockParamsExecute(Sender: TObject); procedure aCabinetFalseFloorExecute(Sender: TObject); procedure aLicenceTypeExecute(Sender: TObject); procedure aToolMultiLineExecute(Sender: TObject); procedure aShowDisconnectedObjectsExecute(Sender: TObject); procedure aMasterUpdateComponPriceFromXFExecute(Sender: TObject); procedure aRefreshDesignListExecute(Sender: TObject); procedure aToolOrtholineExtExecute(Sender: TObject); procedure aBackUpBaseExecute(Sender: TObject); procedure aRestoreBaseExecute(Sender: TObject); procedure aExpertModeExecute(Sender: TObject); procedure cbLayersPropertiesInitPopup(Sender: TObject); procedure aShowPMUsersExecute(Sender: TObject); procedure aLoginUserToProManExecute(Sender: TObject); procedure aShowCurrUserInfoExecute(Sender: TObject); procedure aExpertNewsExecute(Sender: TObject); procedure TimerNewsTimer(Sender: TObject); procedure tbCalcClick(Sender: TObject); procedure aMarkingPagesExecute(Sender: TObject); procedure aMarkForDisableTracingExecute(Sender: TObject); procedure aMasterAutoTraceElectricExecute(Sender: TObject); procedure ExpertPresentation1Click(Sender: TObject); procedure aRotatePointObject270Execute(Sender: TObject); procedure aCreateTrunkExecute(Sender: TObject); procedure miShowConnectedConnComponsClick(Sender: TObject); procedure miShowConnectedLineComponsClick(Sender: TObject); procedure pmConnectedPointsPopup(Sender: TObject); procedure pmConnectedLinesPopup(Sender: TObject); procedure tb3DClick(Sender: TObject); procedure aToolHouseExecute(Sender: TObject); procedure aAddApproachExecute(Sender: TObject); procedure aDeleteHouseExecute(Sender: TObject); procedure aInsertKnotForHouseExecute(Sender: TObject); procedure aDeleteKnotForHouseExecute(Sender: TObject); procedure aEditApproachExecute(Sender: TObject); procedure aRotateApproachExecute(Sender: TObject); procedure aModApproachExecute(Sender: TObject); procedure aToolCabinetExtExecute(Sender: TObject); procedure aConvertSegmentToArcExecute(Sender: TObject); procedure aInsertKnotForCabinetExecute(Sender: TObject); procedure aDeleteKnotForCabinetExecute(Sender: TObject); procedure aShowDefectObjectsExecute(Sender: TObject); procedure aInvertArcSegmentExecute(Sender: TObject); procedure aOpenVectorDrawingExecute(Sender: TObject); procedure aOpenRasterDrawingExecute(Sender: TObject); procedure aSaveVectorDrawingExecute(Sender: TObject); procedure aSaveRasterDrawingExecute(Sender: TObject); procedure aCreateVerticalExecute(Sender: TObject); procedure TimerFindSnapTimer(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure aNetPathToArcExecute(Sender: TObject); procedure aInvertNetPathArcExecute(Sender: TObject); procedure n3DModelForProjectClick(Sender: TObject); procedure aAutoCreateTracesExecute(Sender: TObject); procedure aDivTracesOnRoowWallsExecute(Sender: TObject); procedure aPathLengthTypePointsExecute(Sender: TObject); procedure aPathLengthTypeInnerExecute(Sender: TObject); procedure aPathLengthTypeOuterExecute(Sender: TObject); procedure aPathTraceLengthTypePointsExecute(Sender: TObject); procedure aPathTraceLengthTypeInnerExecute(Sender: TObject); procedure aPathTraceLengthTypeOuterExecute(Sender: TObject); procedure aMirrorFigureExecute(Sender: TObject); procedure aNetPropsExecute(Sender: TObject); procedure aConvertToPolygonExecute(Sender: TObject); procedure aToolSCSArcDimLineExecute(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure aPrintRectExecute(Sender: TObject); procedure aSegActionExecute(Sender: TObject); procedure aSaveProjectToPDFExecute(Sender: TObject); procedure aLinesToTracesExecute(Sender: TObject); procedure aTurnObjectExecute(Sender: TObject); procedure aLoadSubstrateFromPDFExecute(Sender: TObject); procedure TimerInteractiveTimer(Sender: TObject); procedure aInteractiveNextStepExecute(Sender: TObject); procedure aInteractiveStopExecute(Sender: TObject); procedure aTransparentFigureExecute(Sender: TObject); procedure pnHintBarPaint(Sender: TObject); procedure pmListPopup(Sender: TObject); procedure aExportDWGExecute(Sender: TObject); procedure aSaveRevisionExecute(Sender: TObject); procedure aViewRevsExecute(Sender: TObject); procedure aProjectScheduleExecute(Sender: TObject); procedure aBillWorkExecute(Sender: TObject); procedure aShowCableRuleClick(Sender: TObject); procedure aAutoDivExecute(Sender: TObject); procedure N70Click(Sender: TObject); procedure Act_ConnectSelectedPointsExecute(Sender: TObject); procedure Act_ReindexMasterExecute(Sender: TObject); procedure N150Click(Sender: TObject); procedure EmptyConnSelectExecute(Sender: TObject); procedure SelectAllPointObjectsExecute(Sender: TObject); procedure SelectAllLineObjsExecute(Sender: TObject); procedure Act_Magistral_Channel_IndexExecute(Sender: TObject); procedure actLoadPictasRastrExecute(Sender: TObject); procedure Act_AlignSelectionExecute(Sender: TObject); procedure aToolPieExecute(Sender: TObject); procedure SetSefaultAllowTransparensyExecute(Sender: TObject); procedure aSetDoubleDoorExecute(Sender: TObject); procedure aSetMirroredDoorExecute(Sender: TObject); procedure aSetLeftRightDoorExecute(Sender: TObject); procedure aSetOpenedDoorExecute(Sender: TObject); procedure aSetHalfOpenedDoorExecute(Sender: TObject); procedure aSetCornHeightExecute(Sender: TObject); procedure aSetDoorWndHExecute(Sender: TObject); procedure aSetDoorWindowPllacementHeightExecute(Sender: TObject); procedure aSetAllListDoorsPlacementHeightExecute(Sender: TObject); procedure aSetAllListWndPlacementExecute(Sender: TObject); procedure aSetAllListDoorsHeightExecute(Sender: TObject); procedure aSetAllListWndHeightExecute(Sender: TObject); procedure pnHintBarHotSpotClick(Sender: TObject); procedure C1Click(Sender: TObject); procedure aOneLineChemeExecute(Sender: TObject); procedure Act_SelectCableToTraceExecute(Sender: TObject); procedure Act_ConnectByCableExecute(Sender: TObject); procedure Act_ConnectByCableAllExecute(Sender: TObject); procedure Act_ConnectByCableOnEndsExecute(Sender: TObject); procedure cbMainPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure mainFileClick(Sender: TObject); procedure MainMenuChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); procedure tbCADToolsExpertMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure EmptyTracesSelectExecute(Sender: TObject); procedure EmptyRaiseVertSelectExecute(Sender: TObject); procedure CopyList_AllExecute(Sender: TObject); procedure CopyList_WComponExecute(Sender: TObject); procedure pmiSCSObjAutoCreateTracesAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure Act_SetAsEndObjectExecute(Sender: TObject); procedure Act_SelectFiberCableToTraceExecute(Sender: TObject); procedure Act_ConnectToAnotherRackExecute(Sender: TObject); procedure cbMainPanelBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); procedure ToolButton4Click(Sender: TObject); procedure N272AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure aInstRaspredBoxExecute(Sender: TObject); procedure aShieldAssemblySchemeExecute(Sender: TObject); procedure TimerTracingIntervalTimer(Sender: TObject); procedure mnuReservClick(Sender: TObject); procedure aCreateBFMagistralExecute(Sender: TObject); procedure aCreateBFMagistralDownExecute(Sender: TObject); procedure aCreateBFMagistralUpExecute(Sender: TObject); procedure ACreateFloorVExecute(Sender: TObject); { procedure SelectAllLineObjsHint(var HintStr: String; var CanShow: Boolean); procedure N209DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; Selected: Boolean); } private //Tolik 30/04/2021 -- tbCADToolsNoob_oldProc: TWndMethod; tbCADToolsNoob2_oldProc: TWndMethod; tbCADToolsExpert_oldProc: TWndMethod; tbOther_oldProc: TWndMethod; tbFile_oldProc: TWndMethod; tbObject_oldProc: TWndMethod; tbLayers_oldProc: TWndMethod; tbSCSToolsExpert_oldProc: TWndMethod; cbMainPanel_oldProc: TWndMethod; // procedure WMAct(var msg: TMessage); message WM_ACTIVATE; procedure SaveProjectForSC; { Private declarations } // Tolik 30/04/2021 -- Procedure tbCADToolsNoob_NewProc(var message: TMessage); Procedure tbCADToolsNoob2_NewProc(var message: TMessage); Procedure tbCADToolsExpert_NewProc(var message: TMessage); Procedure tbOther_NewProc(var message: TMessage); Procedure tbFile_NewProc(var message: TMessage); Procedure tbObject_NewProc(var message: TMessage); Procedure tbLayers_NewProc(var message: TMessage); Procedure tbSCSToolsExpert_NewProc(var message: TMessage); Procedure cbMainPanel_NewProc(var message: TMessage); // protected procedure FInteractiveMsg(var Msg: TMsg; var Handled: boolean); procedure RunInteractive(aScene: Integer); function CanResizePanelForm(AForm: TForm; ADeltaSize: Integer): Boolean; //26.12.2011 - Перехват событий старта сплиттера и отпускания procedure OnSplitterMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure OnSplitterMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); public // для Docking`а окон МП и НБ CountDock1: integer; CountDock2: integer; // переменные для определения Docking`а FlightBar`ов tbEditDocking: boolean; tbFileDocking: boolean; tbFormatDocking: boolean; tbObjectDocking: boolean; tbSelectOptionsDocking: boolean; tbCADToolsDocking: boolean; tbSCSToolsDocking: boolean; OldApplicationEventsMessage: TMessageEvent; FPMItemsRoofHipTypes: TList; // Элементы к.м. с типами ребер крыши FCADsInProgress: TList; FOldOnActionExecute: TActionEvent; //03.05.2013 FInteractiveActions: TList; //03.05.2013 FInteractiveControlHandler: HWnd; FInteractiveStep: Integer; //06.05.2013 FInteractiveStepCount: Integer; //06.05.2013 FInteractiveStepHitsCount: Integer; //09.05.2013 - количество заходов за один шаг FInteractiveScene: Integer; //06.05.2013 FInteractiveMsgOrig: TMessageEvent; FInteractiveStepShowed: Boolean; FInteractiveWorkColorSet: Boolean; FInteractiveRackColorSet: Boolean; //FInteractiveTimerExecution: Boolean; //11.05.2013 procedure StepInteractive; procedure SetCursors; // сохранить подложку procedure SaveSubstrate(aFName: string); // загрузить подложку procedure LoadSubstrate(aFName: string); // сохранить план procedure SaveFPlan(aFName: string); // загрузить план procedure LoadFPlan(aFName: string); // сохранить рамку листа procedure SaveStamp(aFName: string); // загрузить рамку листа procedure LoadStamp(aFName: string); // сброс панели инструментов КАД procedure SkipCADPanelChecked; // закрытие всех окон (проекта) procedure CloseAll; { Public declarations } // отлавливание Exception, если флаг закрытия программы поднят - выгрузить программу procedure AppException(Sender: TObject; E: Exception); // проверка на закрытие программы procedure CheckClose; // событие, на нем восстановление программы после сворачивания procedure WMUser(var msg: TMessage); message wm_user; procedure ReceiveMessage (var Msg: TMessage); message WM_COPYDATA; procedure WMGetSysCommand(var msg: TMessage); message WM_SYSCOMMAND; procedure AddDoorObj(aDoorObjType: TDoorObjType); procedure AddDoorEmbrasure; procedure AddDoorNiche; procedure SetLayerForDraw; procedure SetMenuStatus(aStatus: Boolean); procedure SetShowPathLengthType(aPathLengthType: TShowPathLengthType); procedure SetShowPathTraceLengthType(aPathLengthType: TShowPathLengthType); procedure SetToolArch(const aTool: string; aToolData: Integer=0); procedure ShiftObjects(AShiftDirection: Integer); procedure LoadSubstrateEx(aReplace: Boolean); procedure SetFigureAsEndObject(aCad: TForm; aFigure: TFigure); procedure CustomizeNewList; //27.06.2013 // 2011-05-10 function isMapScaleDifferent: Boolean; //12.08.2011 procedure DefinePMItemsRoofHipTypes; procedure OnPMItemsRoofHipTypeClick(Sender: TObject); procedure SDCreateBlockToFileCanClose(Sender: TObject; var CanClose: Boolean); //11.03.2012 procedure ShowBlockParamsForPopupFigure(aAllowPersent: Boolean=true; aAllowProportion: Boolean=true); procedure RecreateHandle; procedure SetHints; procedure InteractiveTest; procedure InteractiveActionExecute(Action: TBasicAction; var Handled: Boolean); end; procedure SetDefaultActiveLayer; procedure AutoFitBitMap(Bmp: TBMPObject); const // константы курсоров crHandAni = 1; crNewHand = 2; crNewMove = 3; crNewMoveCross = 4; //Tolik // допустимая разница координат коннекторов в одной точке ConnectorDifference = 5; var phandle: THandle; SetHook: procedure(); stdcall; DropHook: procedure(); stdcall; is_hook: boolean; FSCS_Main: TFSCS_Main; // флаг закрытия программы GExitProgEx: Boolean = False; // сохр. номер слоя с которого было копирование/вырезка в буфер обмена GCurrLayerBuffer: integer; // свойства обьекта GObjectProperty: boolean = False; // Имя нового Листа и ИД GCurrentCADListID: integer; GExportUSeScale: boolean = False; hints_prog_id: string = ''; stat_prog_id: string = ''; implementation uses U_Cad, U_Main, U_IncOn, U_Navigator, U_Scale, U_GridStep, U_Common, {Tolik 15/02/2021 -- } U_ELCommon, U_BaseCommon, U_BaseConstants, Unit_DM_SCS, U_SCSComponent, U_ObjsProp, Types, U_Layers, U_NewLayer, U_SizePos, U_OrtholineParams, U_LoadColor, U_SCSObjectsProp, U_InterfacesAutoTrace, U_MasterNewList, U_MasterNewListLite, U_RaiseHeight, U_AutoTraceType, cxCheckBox, U_BlockEditor, U_Progress, U_ImportDXF, U_ExportDXF, U_ProtectionCommon, U_Protection, U_ProtectionBase, U_Registration, U_ComponDesignWizard, U_SmetaExport, U_SCSLists, U_ChooseComponTypes, U_ChooseComponTypesForReport, U_FloatPanel, U_EndPoints, U_CadNormsProp, U_CadNormsList, U_TrunkSCS, U_Constants, RichEdit2, U_ChooseDesignBoxParams, U_ChooseSCSObjectsProp, U_ReportForm, U_CreateRaiseQuery, U_PrintLists, U_BlockParams, U_ChooseListForTrunk, U_HouseClasses, U_ResourceReport, // 2011-05-10 U_BaseSettings, PrvForm, {U_Arch3D}U_Arch3DNew, form3D, U_PDFView, U_HintBar, U_HintW, {$IF Defined (SCS_RF)} U_AboutRF, U_InputBox {$ELSE} U_About {$IFEND} // Tolik 16/05/2016 -- , U_SCSClasses // Tolik 28/03/2017 -- , U_Master_compl , U_PortsReIndex, U_PEGetBox, U_Reserv; //Tolik 11/12/2024 --управление резервными копиями {$R *.dfm} {$R Cursors.res} {$R font.rc} {$R hand.rc} // Procedure TFSCS_Main.tbCADToolsNoob_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbCADToolsNoob.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbCADToolsNoob_OldProc(message); end; Procedure TFSCS_Main.tbCADToolsNoob2_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbCADToolsNoob2.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbCADToolsNoob2_OldProc(message); end; Procedure TFSCS_Main.tbCADToolsExpert_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbCADToolsExpert.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbCADToolsExpert_OldProc(message); end; Procedure TFSCS_Main.tbOther_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbOther.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbOther_OldProc(message); end; Procedure TFSCS_Main.tbFile_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbFile.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbFile_OldProc(message); end; Procedure TFSCS_Main.tbObject_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbObject.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbObject_OldProc(message); end; Procedure TFSCS_Main.tbLayers_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbLayers.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbLayers_OldProc(message); end; Procedure TFSCS_Main.tbSCSToolsExpert_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := tbSCSToolsExpert.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; tbSCSToolsExpert_OldProc(message); end; Procedure TFSCS_Main.cbMainPanel_NewProc(var message: TMessage); var Control: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin Control := cbMainPanel.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(Control) then if Control is TToolButton then CheckCloseReportForm; end; end; cbMainPanel_OldProc(message); end; // procedure ExtractExe(Instance: THandle; ResID: Integer; FileName: string); var ResStream: TResourceStream; // Объект - поток ресурсов FileStream: TFileStream; begin try try ResStream := TResourceStream.CreateFromID(Instance, Resid, RT_RCDATA); FileStream := TFileStream.Create(FileName, fmCreate); try FileStream.CopyFrom(ResStream, 0); finally FreeAndNil(FileStream); end; finally FreeAndNil(ResStream); end; except on E:Exception do begin DeleteFile(FileName); end; end; end; { TSplitter } {procedure TSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin FOldMouseMoveTick := 0; if Assigned(FOnMouseDown) then FOnMouseDown(Self, Button, Shift, X, Y); inherited; end; procedure TSplitter.MouseMove(Shift: TShiftState; X, Y: Integer); var SavedResizeStyle: TResizeStyle; begin SavedResizeStyle := ResizeStyle; //if ResizeStyle = rsUpdate then // begin // // Если резайз был не так давно, то // if (GetTickCount - FOldMouseMoveTick) < 40 then // ResizeStyle := ExtCtrls.rsNone // else // FOldMouseMoveTick := GetTickCount; // end; inherited; ResizeStyle := SavedResizeStyle; end; procedure TSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; if Assigned(FOnMouseUp) then FOnMouseUp(Self, Button, Shift, X, Y); end; } procedure TFSCS_Main.SetCursors; begin //11.07.2013 - moved from TFSCS_Main.FormCreate Screen.Cursors[crNewHand] := LoadCursor(HInstance, 'CUR_HAND1'); Screen.Cursors[crNewMove] := LoadCursor(HInstance, 'CUR_MOVE1'); Screen.Cursors[crNewMoveCross] := LoadCursor(HInstance, 'CUR_MOVE2'); end; // СОЗДАНИЕ ГЛАВНОЙ ФОРМЫ procedure TFSCS_Main.FormCreate(Sender: TObject); var buff: PChar; i: integer; RemoveStatus: boolean; LastError: DWORD; begin DisableAlign; self.Color := clBtnFace; try {$IF Defined(TRIAL_SCS)} Self.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ' Trial)'; {$ELSE} Self.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ')'; {$IFEND} {$if Defined(ES_GRAPH_SC)} pnHintBar.Visible := False; {$ifend} CountDock1 := 0; CountDock2 := 0; GRefreshCad := nil; GCurrentCADListID := 0; GexitProg := True; Self.SetCursors; //11.07.2013 ExtractExe(HInstance, $2, 'handa.ani'); try ExtractExe(HInstance, $3, 'gost.ttf'); except end; try GetMem(buff, 256*2); GetWindowsDirectory(buff, 255); // DeleteFile(PChar(buff + '\Fonts\' + 'gost.ttf')); if Not FileExists(buff + '\Fonts\' + 'gost.ttf') then begin try CopyFile(PChar(ExeDir + '\gost.ttf'), PChar(buff + '\Fonts\' + 'gost.ttf'), False); except end; end; if AddFontResource(PChar(buff + '\Fonts\' + 'gost.ttf')) = 0 then LastError := GetLastError; FreeMem(Buff); except end; PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0); Screen.Cursors[crHandAni] := LoadCursorFromFile('handa.ani'); Application.HelpFile := ExeDir + '\HELP\HELP.HLP'; // Задать Captions на панелях tbSCSHDimLineNoob.Caption := cMain_Mes104; tbSCSVDimLineNoob.Caption := cMain_Mes105; tbCabinetNoob.Caption := cMain_Mes106; tbCabinetExtNoob.Caption := cMain_Mes117; tbWallRectNoob.Caption := cMain_Mes107; tbWallPathNoob.Caption := cMain_Mes108; tbToolOrtholineExtNoob.Caption := cMain_Mes109; tbToolOrtholineNoob.Caption := cMain_Mes110; tbHouseNoob.Caption := cMain_Mes114; tbPanNoob.Caption := cMain_Mes118; {$IF DEFINED(SCS_PE) or DEFINED(SCS_SPA)} {$IF Defined(SCS_PANDUIT) or DEFINED(SCS_PE)} N221.Enabled := True; aInteractive.Visible := True; aInteractive.Enabled := true; {$ELSE} aInteractive.Visible := False; {$IFEND} // Tolik --24/01/2017 - - //tbSCSToolsNoob.Width := cSCSNoob_PE; tbSCSToolsNoob.Width := cSCSNoob_PE + 20; // aSaveToIBD.Visible := False; //aCreateNormsOnCad.Visible := False; aCreateNormsOnCad.Visible := True; aWizards.Visible := False; aTechDoc.Visible := True; aBuy.Visible := False; aPresentation.Visible := False; aShowDefectObjects.Visible := False; //aManual_Norms.Visible := False; aManual_Norms.Visible := True; aHelp.Visible := False; aCHM.Visible := False; ExpertPresentation1.Visible := False; {$ELSE} {$IF Defined(SCS_PANDUIT)} N221.Enabled := True; aInteractive.Visible := True; aInteractive.Enabled := true; // Tolik -- 24/01/2017 -- //tbSCSToolsNoob.Width := cSCSNoob_PE; tbSCSToolsNoob.Width := cSCSNoob_PE + 20; // aSaveToIBD.Visible := False; //aCreateNormsOnCad.Visible := False; aCreateNormsOnCad.Visible := True; aWizards.Visible := False; aTechDoc.Visible := True; aBuy.Visible := False; aPresentation.Visible := False; aShowDefectObjects.Visible := False; //aManual_Norms.Visible := False; aManual_Norms.Visible := True; aHelp.Visible := False; aCHM.Visible := False; ExpertPresentation1.Visible := False; {$ELSE} // Tolik -- // tbSCSToolsNoob.Width := cSCSNoob_SCS; tbSCSToolsNoob.Width := cSCSNoob_SCS + 20; // aSaveToIBD.Visible := True; aCreateNormsOnCad.Visible := True; aInteractive.Visible := false; aWizards.Visible := True; aTechDoc.Visible := True; aBuy.Visible := True; aPresentation.Visible := True; aShowDefectObjects.Visible := True; aManual_Norms.Visible := True; {$IFEND} {$IFEND} //07.10.2011 - перенесено на FormShow, так как на этот момент размеры формы не под экран, // что не дает некоторым панелем выставить ширину, так как она больше ширины формы на тек. момент //{$IF Defined(SCS_PE) or DEFINED(SCS_SPA)} // aToolHouse.Visible := False; // tbCADToolsNoob.Width := cCADNoob_PE; // {$ELSEIF Defined(TELECOM)} // aToolHouse.Visible := False; // tbCADToolsNoob.Width := cCADNoob_TEL; // {$ELSE} // aToolHouse.Visible := True; // tbCADToolsNoob.Width := cCADNoob_SCS; // {$IFEND} {$IF DEFINED(SCS_SPA)} ExpertPresentation1.Visible := false; {$IFEND} // Режим Эксперта if GSCSIni.Controls.F_SCSMain_IsPanelExpertMode then begin aExpertMode.Checked := True; tbCADToolsExpert.Visible := True; // Tolik 24/01/2017 -- tbCADToolsNoob2.Visible := False; // tbCADToolsNoob.Visible := False; tbSCSToolsExpert.Visible := True; tbSCSToolsNoob.Visible := False; end else begin aExpertMode.Checked := False; tbCADToolsExpert.Visible := False; {$if Defined(ES_GRAPH_SC)} tbSCSToolsExpert.Visible := True; {$else} tbSCSToolsExpert.Visible := False; {$ifend} tbCADToolsNoob2.Visible := False; tbCADToolsNoob.Visible := False; tbCADToolsNoob.Visible := True; tbCADToolsNoob2.Visible := True; {$if Defined(ES_GRAPH_SC)} tbSCSToolsNoob.Visible := False; {$else} // //tbSCSToolsNoob.Visible := True; {$ifend} end; if tbCADToolsNoob.Visible then begin tbCADToolsNoob.Top := tbCADToolsExpert.Top; tbCADToolsNoob.Left := tbCADToolsExpert.Left; // Tolik -- 01/02/2017 -- {$if Defined(ES_GRAPH_SC)} tbCADToolsNoob2.Top := tbCADToolsExpert.Top; tbCADToolsNoob2.Left := tbCADToolsNoob.Left + tbCADToolsNoob.width + 10; {$else} tbCADToolsNoob2.Top := tbCADToolsExpert.Top + 30; tbCADToolsNoob2.Left := tbCADToolsExpert.Left; {$ifend} // end; if tbSCSToolsNoob.Visible then begin tbSCSToolsNoob.Top := tbSCSToolsExpert.Top; end; if tbCADToolsExpert.Visible then begin tbSelectExpert.Down := True; tbSelectNoob.Down := False; end else begin tbSelectExpert.Down := False; tbSelectNoob.Down := True; end; if Assigned(cbScaleExpert) then begin cbScaleExpert.Properties.Items.Clear; cbScaleExpert.Properties.Items.Add('50%'); cbScaleExpert.Properties.Items.Add('75%'); cbScaleExpert.Properties.Items.Add('100%'); cbScaleExpert.Properties.Items.Add('150%'); cbScaleExpert.Properties.Items.Add('200%'); cbScaleExpert.Properties.Items.Add('400%'); cbScaleExpert.Properties.Items.Add(cMain_Mes111); end; if Assigned(cbScaleNoob) then begin cbScaleNoob.Properties.Items.Clear; cbScaleNoob.Properties.Items.Add('50%'); cbScaleNoob.Properties.Items.Add('75%'); cbScaleNoob.Properties.Items.Add('100%'); cbScaleNoob.Properties.Items.Add('150%'); cbScaleNoob.Properties.Items.Add('200%'); cbScaleNoob.Properties.Items.Add('400%'); cbScaleNoob.Properties.Items.Add(cMain_Mes111); end; if PROG_NEWSID = '-1' then aExpertNews.Visible := False; if GLiteVersion then begin mainFormat.Visible := False; mainTools.Visible := False; tbSelectExpert.Visible := True; tbPanExpert.Visible := True; tbsToolsExpert.Visible := False; //29.12.2011 tbLineExpert.Visible := False; //Tolik 23/07/2017 -- tbPieExpert.Visible := False; // tbRectangleExpert.Visible := False; tbEllipseExpert.Visible := False; tbCircleExpert.Visible := False; tbArcExpert.Visible := False; tbElipticArcExpert.Visible := False; tbPolyLineExpert.Visible := False; tbPointExpert.Visible := False; tbTextExpert.Visible := False; tbRichTextExpert.Visible := False; tbKnifeExpert.Visible := False; tbHDimLineExpert.Visible := False; tbVDimLineExpert.Visible := False; tbSCSHDimLineExpert.Visible := True; tbSCSVDimLineExpert.Visible := True; tbSCSArcDimLineExpert.Visible := True; tbCabinetExpert.Visible := True; tbCabinetExtExpert.Visible := True; //29.03.2012 tbWallRectExpert.Visible := False; //29.03.2012 tbWallPathExpert.Visible := False; tbHouseExpert.Visible := False; //Tolik 18/02/2022 -- //tbCreateOnClickModeExpert.Down := True; //tbToolOrtholineExpert.Down := True; //tbToolOrtholineExtExpert.Down := True; tbToolOrtholineExpert.Down := False; tbToolOrtholineExtExpert.Down := False; tbCreateOnClickModeExpert.Down := False; // tbSelectNoob.Visible := True; tbSCSHDimLineNoob.Visible := True; tbSCSVDimLineNoob.Visible := True; tbSCSArcDimLineNoob.Visible := True; tbCabinetNoob.Visible := True; tbCabinetExtNoob.Visible := True; //29.03.2012 tbWallRectNoob.Visible := False; //29.03.2012 tbWallPathNoob.Visible := False; tbHouseNoob.Visible := False; //Tolik 18/02/2022 -- //tbCreateOnClickModeNoob.Down := True; //tbToolOrtholineNoob.Down := True; //tbToolOrtholineExtNoob.Down := True; tbCreateOnClickModeNoob.Down := False; tbToolOrtholineNoob.Down := False; tbToolOrtholineExtNoob.Down := False; // aMasterAutoTrace.Visible := False; aMasterAutoTraceElectric.Visible := False; aCreateNormsOnCad.Visible := False; aManual_Interfaces.Visible := False; end; GFtpConnectStr := ReadSetting(fnSCSIniFile, dtString, scReservFtp, idtConnectString, ''); mnuReserv.Enabled := GFtpConnectStr <> ''; //#From Oleg# //XPMenu.Active := false; //XPMenu.Active := True; FCADsInProgress := TList.Create; //07.11.2011 //sDiv1.OnMouseDown := OnSplitterMouseDown; //sDiv1.OnMouseUp := OnSplitterMouseUp; //sDiv2.OnMouseDown := OnSplitterMouseDown; //sDiv2.OnMouseUp := OnSplitterMouseUp; SetHints; //pnHintBar except on E: Exception do addExceptionToLogEx('TFSCS_Main.FormCreate', E.Message); end; // Tolik 05/05/2021 -- tbCADToolsNoob_OldProc := tbCADToolsNoob.WindowProc; tbCADToolsNoob.WindowProc := tbCADToolsNoob_newProc; tbCADToolsNoob2_OldProc := tbCADToolsNoob2.WindowProc; tbCADToolsNoob2.WindowProc := tbCADToolsNoob2_newProc; tbCADToolsExpert_OldProc := tbCADToolsExpert.WindowProc; tbCADToolsExpert.WindowProc := tbCADToolsExpert_newProc; tbOther_OldProc := tbOther.WindowProc; tbOther.WindowProc := tbOther_newProc; tbFile_OldProc := tbFile.WindowProc; tbFile.WindowProc := tbFile_newProc; tbObject_OldProc := tbObject.WindowProc; tbObject.WindowProc := tbObject_newProc; tbLayers_OldProc := tbLayers.WindowProc; tbLayers.WindowProc := tbLayers_newProc; tbSCSToolsExpert_OldProc := tbSCSToolsExpert.WindowProc; tbSCSToolsExpert.WindowProc := tbSCSToolsExpert_newProc; cbMainPanel_OldProc := cbMainPanel.WindowProc; cbMainPanel.WindowProc := cbMainPanel_newProc; // EnableAlign; end; // СОЗДАТЬ ПРОЕКТ procedure TFSCS_Main.aNewExecute(Sender: TObject); var i: integer; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if Not IsVista then begin BuildFHash; GetLic; for i := 0 to 15 do begin if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) <> 0 then begin exit; end; end; end; {$IFEND} // Tolik 30/04/2021 -- { tbCADToolsNoob_OldProc := tbCADToolsNoob.WindowProc; tbCADToolsNoob.WindowProc := tbCADToolsNoob_newProc; tbCADToolsNoob2_OldProc := tbCADToolsNoob2.WindowProc; tbCADToolsNoob2.WindowProc := tbCADToolsNoob2_newProc; tbCADToolsExpert_OldProc := tbCADToolsExpert.WindowProc; tbCADToolsExpert.WindowProc := tbCADToolsExpert_newProc; tbOther_OldProc := tbOther.WindowProc; tbOther.WindowProc := tbOther_newProc; tbFile_OldProc := tbFile.WindowProc; tbFile.WindowProc := tbFile_newProc; tbObject_OldProc := tbObject.WindowProc; tbObject.WindowProc := tbObject_newProc; tbLayers_OldProc := tbLayers.WindowProc; tbLayers.WindowProc := tbLayers_newProc; cbMainPanel_OldProc := cbMainPanel.WindowProc; cbMainPanel.WindowProc := cbMainPanel_newProc; } // try MakeProject; // SetMenuStatus(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewExecute', E.Message); end; end; // СОЗДАТЬ НОВЫЙ ЛИСТ procedure TFSCS_Main.aNewListExecute(Sender: TObject); var ListParams: TListParams; Res: Boolean; //IDFloor: Integer; // ListForPassage: TF_CAD; // SavedCAD: TF_CAD; begin try ListParams := GetListParamsForNewList; F_MasterNewList.Tag := 0; Res := MakeEditList(meMake, ListParams, True); if (GCadForm <> nil) and (GCadForm.PCad <> nil) then GCadForm.FListType := lt_Normal; //24.06.2013 - создание м-э перехода if Res then begin CustomizeNewList; // //27.06.2013 - подгрузка подложки с заменой существующей, сохраняя размеры/позиции // Application.ProcessMessages; // LoadSubstrateEx(true); // //25.06.2013 - выбор места для м-э на новом листе // IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1); // ListForPassage := nil; // // if IDFloor > 0 then // begin // ListForPassage := GetListByID(IDFloor); // if ListForPassage <> nil then // begin // // Тулза создания м-э перехода // if MessageQuastYN(cMain_Mes139) = IDYES then // begin // Application.ProcessMessages; // if GCadForm.CurrentLayer <> lnSCSCommon then // GCadForm.CurrentLayer := lnSCSCommon; // GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName); // end; // end; // end; ////25.06.2013 - выбор места для м-э на листе ниже // IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1); // ListForPassage := nil; // if IDFloor > 0 then // begin // ListForPassage := GetListByID(IDFloor); // if ListForPassage <> nil then // begin // // Тулза создания м-э перехода // if MessageQuastYN(cMain_Mes139) = IDYES then // begin // Application.ProcessMessages; // SavedCAD := GCADForm; // try // GCADForm := ListForPassage; // GCadForm.BringToFront; // // if GCadForm.CurrentLayer <> lnSCSCommon then // GCadForm.CurrentLayer := lnSCSCommon; // GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName); // finally // //GCADForm := SavedCAD; // //GCadForm.BringToFront; // end; // end; // end; // end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewListExecute', E.Message); end; end; // ОКРЫТЬ ПРОЕКТ procedure TFSCS_Main.aOpenProjectExecute(Sender: TObject); begin try // подвязать к форме проекта if F_ProjMan <> nil then begin F_ProjMan.Position := poDesigned; F_ProjMan.Show; aViewProjectManager.Checked := True; F_ProjMan.ManualDock(FSCS_Main.pDock1, nil, alNone); FSCS_Main.pDock1.Width := 200; end else aViewProjectManager.Checked := False; if F_NormBase <> nil then begin F_NormBase.Position := poDesigned; F_NormBase.Show; aViewNormBase.Checked := True; F_NormBase.ManualDock(FSCS_Main.pDock2, nil, alNone); FSCS_Main.pDock2.Width := 200; end else aViewNormBase.Checked := False; if F_HintBar = nil then begin F_HintBar := TF_HintBar.Create(Application); F_HintBar.Parent := pnHintBar; F_HintBar.Align := alClient; F_HintBar.Show; F_HintBar.StartWizard; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aOpenProjectExecute', E.Message); end; end; // Загрузить подложку procedure TFSCS_Main.aLoadSubstrateExecute(Sender: TObject); var FName, FExt: string; i: integer; FDir: string; OpenDialog: TOpenDialog; Jpeg: TJpegImage; Bmp: TBMPObject; Bitmp: TBitmap; Fig: TFigure; begin GisUserDimLine := True;//Tolik 11/08/2021 -- //if ActiveMDIChild <> nil then // begin // OpenDialog := TOpenDialog.Create(Self); // {$if Defined(ES_GRAPH_SC)} // FDir := ExeDir; // {$else} // FDir := ExtractFileDir(Application.ExeName); // {$ifend} // if DirectoryExists(FDir + '\.Makets') then // FDir := FDir + '\.Makets'; // OpenDialog.Title := cMain_Mes4; // OpenDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers);//ExtractSaveDirForCategory('.Makets'); //FDir; // OpenDialog.DefaultExt := 'scb'; // OpenDialog.Filter := cMain_Mes5; // if OpenDialog.Execute then // begin // try // FName := OpenDialog.FileName; // LoadSubstrate(FName); // GCadForm.PCad.DeselectAll(0); // except // ShowMessage(cMain_Mes6); // end; // RefreshCAD(GCadForm.PCad); // end; // OpenDialog.Free; // end // else // MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); LoadSubstrateEx(false); //Tolik 11/08/2021 -- if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // end; // ЗАКРЫТЬ ПРОЕКТ procedure TFSCS_Main.aCloseExecute(Sender: TObject); begin try if FSCS_Main.MDIChildCount > 0 then begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin // GNotNeedCheckRaisesBeforeClose := True; GCadForm.Close; // GNotNeedCheckRaisesBeforeClose := False; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCloseExecute', E.Message); end; end; // сохранение подложек procedure TFSCS_Main.SaveSubstrate(aFName: string); var TempCad: TPowerCad; begin TempCad := TPowerCad.create(FSCS_Main); try TempCad.Parent := FSCS_Main; TempCad.NewLayer(cCad_Mes1); GCadForm.PCad.DeselectAll(0); GCadForm.PCad.ActiveLayer := 1; GCadForm.PCad.SelectAll(1); Clipboard.Clear; GCadForm.PCad.CopyToClipBoard; TempCad.PasteFromClipBoard(1); TempCad.SaveToFile(1, aFName); Clipboard.Clear; finally try FreeAndNil(TempCad); except end; end; end; // загрузка подложек procedure TFSCS_Main.LoadSubstrate(aFName: string); var TempCad: TPowerCad; i: integer; begin TempCad := TPowerCad.create(FSCS_Main); try TempCad.Parent := FSCS_Main; TempCad.LoadFromFile(aFName); TempCad.SelectAll(1); Clipboard.Clear; TempCad.ActiveLayer := 1; GCadForm.CurrentLayer := 1; TempCad.CopyToClipBoard; GCadForm.PCad.OnObjectInserted := nil; GCadForm.PCad.PasteFromClipBoard(1); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; Clipboard.Clear; finally try FreeAndNil(TempCad); except end; end; end; procedure TFSCS_Main.SaveFPlan(aFName: string); var TempCad: TPowerCad; begin TempCad := TPowerCad.create(FSCS_Main); try TempCad.Parent := FSCS_Main; TempCad.NewLayer(cCad_Mes8); GCadForm.PCad.DeselectAll(0); GCadForm.PCad.ActiveLayer := 8; GCadForm.PCad.SelectAll(8); Clipboard.Clear; GCadForm.PCad.CopyToClipBoard; TempCad.PasteFromClipBoard(1); TempCad.SaveToFile(1, aFName); Clipboard.Clear; finally try FreeAndNil(TempCad); except end; end; end; procedure TFSCS_Main.LoadFPlan(aFName: string); var TempCad: TPowerCad; i: integer; begin TempCad := TPowerCad.create(FSCS_Main); try TempCad.Parent := FSCS_Main; TempCad.LoadFromFile(aFName); TempCad.SelectAll(1); Clipboard.Clear; TempCad.ActiveLayer := 1; GCadForm.CurrentLayer := 8; TempCad.CopyToClipBoard; GCadForm.PCad.OnObjectInserted := nil; GCadForm.PCad.PasteFromClipBoard(8); GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted; Clipboard.Clear; finally try FreeAndNil(TempCad); except end; end; end; // СОХРАНИТЬ Подложку procedure TFSCS_Main.aSaveSubstrateExecute(Sender: TObject); var FName: string; FDir: string; SaveDialog: TSaveDialog; begin if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.Makets') then FDir := FDir + '\.Makets'; SaveDialog.Title := cMain_Mes7; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'scb'; SaveDialog.Filter := cMain_Mes5; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; if SaveDialog.Execute then begin try FName := SaveDialog.FileName; SaveSubstrate(FName); except ShowMessage(cMain_Mes6); end; end; SaveDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СОХРАНИТЬ подложку КАК ... procedure TFSCS_Main.aSaveAsSubstrateExecute(Sender: TObject); var FName: string; FDir: string; SaveDialog: TSaveDialog; PDFDoc: TPDFDocument; begin if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.Makets') then FDir := FDir + '\.Makets'; SaveDialog.Title := cMain_Mes7; SaveDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers);//ExtractSaveDirForCategory('.Makets');//FDir; SaveDialog.DefaultExt := 'scb'; SaveDialog.Filter := cMain_Mes5 + '|'+ cProgressExp_Msg9_1; //29.02.2012 cMain_Mes5; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; if SaveDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctBackgLayers, ExtractFileDir(SaveDialog.FileName)); // FName := SaveDialog.FileName; if ExtractFileExt(SaveDialog.FileName) = '.scb' then SaveSubstrate(FName) else begin PDFDoc := CreatePDFObject(Self, cCad_Mes1 +' '+ GetListParams(GCadForm.FCADListID).Caption, SaveDialog.FileName, nil); PDFDoc.BeginDoc; SetCADPageParamsToPDF(GCadForm, PDFDoc, true); PDFDoc.EndDoc; PDFDoc.Free; end; except ShowMessage(cMain_Mes8); end; end; SaveDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЭКСПОРТИРОВАТЬ ИЗ ПРОЕКТА procedure TFSCS_Main.aExportExecute(Sender: TObject); var FName: string; begin if ActiveMDIChild <> nil then begin SaveDXFFile(GCadForm.PCad, cExport_Mes1, cImport_Mes12); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ИМПОРТИРОВАТЬ В ПРОЕКТ procedure TFSCS_Main.aImportExecute(Sender: TObject); var FName: string; begin if ActiveMDIChild <> nil then begin // LoadDXFFile(GCadForm.PCad); LoadDXFFileNew(GCadForm.PCad, cImport_Mes4, cImport_Mes5); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПРЕДВАРИТЕЛЬНЫЙ ПРОСМОТР ЛИСТА procedure TFSCS_Main.aPrevViewExecute(Sender: TObject); var i: integer; SelCheck: integer; prnW,prnH: Integer; resX,resY: Integer; pw, ph: integer; dev, driv, port: array[0..80] of Char; deviceMode: THandle; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} SelCheck := 0; if Not IsVista then begin GetLic; BuildFHash; SelCheck := 0; for i := 0 to 35 do begin SelCheck := SelCheck + ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) end; end; {$ELSE} SelCheck := 0; {$IFEND} {$if Not Defined(ES_GRAPH_SC)} if SelCheck > 0 then ExitProcess(0); {$ifend} {$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)} ShowMessage(cMain_Mes9); {$ELSE} {$if Defined(ES_GRAPH_SC_EXE)} // ShowMessage('Print...'); {$ifend} try if ActiveMDIChild <> nil then begin // SetupPrinter(round(GCadForm.PCad.WorkHeight), round(GCadForm.PCad.WorkWidth), integer(GCadForm.PCad.PageOrient) + 1); // GCadForm.PCad.AutoTilePrint := False; try Printer.GetPrinter(dev, driv, port, deviceMode); Printer.SetPrinter(dev, driv, port, 0) except on E: Exception do ShowMessage('Printer.GetPrinter - ' + E.Message); end; try // Portrait if GCadForm.PCad.PageOrient = TPageOrient(1) then begin Printer.Orientation := TPrinterOrientation(0); end else // Landscape begin Printer.Orientation := TPrinterOrientation(1); end; except on E: Exception do ShowMessage('Printer.Orientation - ' + E.Message); end; try prnW := GetDeviceCaps(printer.Handle, PHYSICALWIDTH); prnH := GetDeviceCaps(printer.Handle, PHYSICALHEIGHT); resX := GetDeviceCaps(printer.Handle, LOGPIXELSX); resY := GetDeviceCaps(printer.Handle, LOGPIXELSY); except on E: Exception do ShowMessage('GetDeviceCaps - ' + E.Message); end; pw := round(prnW / (resX / 25.4)); ph := round(prnH / (resY / 25.4)); try GPreview := True; Init_prnW := round(prnW * (GCadForm.PCad.WorkWidth / pw)); Init_prnH := round(prnH * (GCadForm.PCad.WorkHeight / ph)); try GCadForm.PCad.PrintPreview; except on E: Exception do ShowMessage('PCad.PrintPreview - ' + E.Message); end; finally GPreview := False; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do ShowMessage(E.Message); end; {$IFEND} end; // ПЕЧАТЬ ЛИСТА procedure TFSCS_Main.aPrintExecute(Sender: TObject); var i: integer; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if Not IsVista then begin BuildFHash; GetLic; for i := 0 to 15 do begin if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then Close; end; end; {$IFEND} {$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)} ShowMessage(cMain_Mes9); {$ELSE} if ActiveMDIChild <> nil then FSCS_Main.aPrevViewExecute(Sender) else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); {$IFEND} end; // ВЫХОД ИЗ ПРОЕКТА procedure TFSCS_Main.aExitExecute(Sender: TObject); begin GNotNeedCheckRaisesBeforeClose := True; FSCS_Main.Close; end; // ОТМЕНИТЬ procedure TFSCS_Main.aUndoExecute(Sender: TObject); var a: Integer; figstream: TMemoryStream; FileStream: Tstream; Figure: TFigure; xSize: Integer; begin (*try // Tolik 18/11/2020 -- Это "Вылетит" на пустом проекте (если, например, все листы удалить !!!, там GCadForm не будет!!!) if Assigned(GCadForm) then begin // FileStream := TStream.Create; //FileStream := SafeOpenFileStream('c:\Figstream.txt', fmCreate, 'TPCDrawing.SaveSCSFiguresToFile', cSCSComponent_Msg22_7); For a := 0 to GCadForm.PCad.Figures.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Figures[a]); //if Figure.Classname <> 'TFigureGrpNotMod' then //if Figure.Classname = 'TFigureGrp' then begin figStream := TMemoryStream.Create; Figure.WriteToStream(figStream); xSize := figStream.Size; figStream.Seek(0, soFromBeginning); FileStream.Write(xSize, 4); StreamToStream(figStream, FileStream, xSize); FreeAndNil(figStream); end; end; FreeAndNil(FileStream); end; Except On E:Exception do ShowMessage('Write Figures to Stream ERROR !!! ' + Figure.Cname); end; *) if ActiveMDIChild <> nil then begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin // CTRL + Z для слоя СКС if (GCadForm.FListType = lt_Normal) and ((GCadForm.PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer)) then begin GCadForm.SCSUndoNormalList; SetProjectChanged(True); end else if (GCadForm.FListType = lt_ProjectPlan) then begin GCadForm.SCSUndoProjectPlan; SetProjectChanged(True); end else if (GCadForm.FListType = lt_DesignBox) then begin GCadForm.SCSUndoDesignList; SetProjectChanged(True); end // Tolik 12/02/2021 -- else if (GCadForm.FListType = lt_ElScheme) then begin GCadForm.SCSUndoElScheme; SetProjectChanged(True); end //Tolik 06/02/2023 -- else if (GCadForm.FListType = lt_AScheme) then begin GCadForm.SCSUndoElScheme; SetProjectChanged(True); end // else if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then begin GCadForm.PCad.UnDo; SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aUndoExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОВТОРИТЬ procedure TFSCS_Main.aRedoExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin // CTRL + Y для слоя СКС if (GCadForm.FListType = lt_Normal) and ((GCadForm.PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer)) then begin GCadForm.SCSRedoNormalList; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (GCadForm.FListType = lt_ProjectPlan) then begin GCadForm.SCSRedoProjectPlan; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (GCadForm.FListType = lt_DesignBox) then begin GCadForm.SCSRedoDesignList; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end // Tolik 12/02/2021 -- если тип листа - схема электрическая else if ((GCadForm.FListType = lt_ElScheme) or (GCadForm.FListType = lt_AScheme)) then begin //GCadForm.SCSRedoElScheme; GCadForm.PCad.ReDo; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end // else if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then begin GCadForm.PCad.ReDo; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRedoExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРЕЗАТЬ ВЫДЕЛЕННОЕ procedure TFSCS_Main.aCutExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if GCadForm.PCad.Selection.Count > 0 then begin try if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then begin GCadForm.PCad.CutToClipBoard; GCurrLayerBuffer := GCadForm.PCad.ActiveLayer; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCutExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // КОПИРОВАТЬ ВЫДЕЛЕННОЕ procedure TFSCS_Main.aCopyExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if GCadForm.PCad.Selection.Count > 0 then begin try if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then begin GCadForm.PCad.CopyToClipBoard; GCurrLayerBuffer := GCadForm.PCad.ActiveLayer; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCopyExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВСТАВИТЬ ВЫДЕЛЕННОЕ procedure TFSCS_Main.aPasteExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if (GCadForm.PCad.ActiveLayer <> 1) and (GCadForm.PCad.ActiveLayer <> 8) and (GCadForm.PCad.ActiveLayer <> 7) then begin GCadForm.CurrentLayer := 1; end; if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then GCadForm.PCad.PasteFromClipBoard(GCadForm.PCad.ActiveLayer); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPasteExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫДЕЛИТЬ ВСЕ procedure TFSCS_Main.aSelectAllExecute(Sender: TObject); var ActLayer: integer; begin if ActiveMDIChild <> nil then begin try ActLayer := GCadForm.PCad.ActiveLayer; if ActLayer = lnSCSCommon then begin // c Shift но без ALT - выделить все трассы и с/п // c Shift и c ALT - выделить трассы без с/п (только с/п можно будет выделить так: вначале просто Ctrl-A - выделится все, // а затем инвертируем выделение - выделятся только с/п // с ALT но без Shift - инвертировать выбор if ((GetKeyState(VK_SHIFT) and 128) = 128) and ((GetKeyState(VK_MENU) and 128) = 0) then //Если нажата VK_SHIFT и не нажат ALT begin GCadForm.SelectTracesAndRaisers; end else if ((GetKeyState(VK_SHIFT) and 128) = 128) and ((GetKeyState(VK_MENU) and 128) = 128) then //Если нажата ALT и Shift (что бы работало с меню - вначале нажимать пункт не отпуская мышу нажать Alt) begin GCadForm.SelectTraces; end else if ((GetKeyState(VK_SHIFT) and 128) = 0) and ((GetKeyState(VK_MENU) and 128) = 128) then //Если нажата ALT но без Shift (что бы работало с меню - вначале нажимать пункт не отпуская мышу нажать Alt) begin GCadForm.InvertSCSSelection; end else GCadForm.PCad.SelectAll(ActLayer); end else begin if ((GetKeyState(VK_MENU) and 128) = 128) then //Если нажата ALT но без Shift (что бы работало с меню - вначале нажимать пункт не отпуская мышу нажать Alt) GCadForm.InvertAllSelection else GCadForm.PCad.SelectAll(ActLayer); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectAllExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // НАЙТИ ОБЬЕКТ procedure TFSCS_Main.aFindExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); end; // НАЙТИ ДАЛЕЕ... procedure TFSCS_Main.aFindNextExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); end; // ЛИСТ ВО ВЕСЬ ЭКРАН procedure TFSCS_Main.aAllScreenExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.FitToWindow; // if GCadForm.PCad.ZoomScale < 50 then // GCadForm.SetZoomScale(50); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAllScreenExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЛИСТ НА 50% procedure TFSCS_Main.a50Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(50); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a50Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЛИСТ НА 75% procedure TFSCS_Main.a75Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(75); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a75Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЛИСТ НА 100% procedure TFSCS_Main.a100Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(100); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a100Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЛИСТ НА 150% procedure TFSCS_Main.a150Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(150); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a150Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЛИСТ НА 200% procedure TFSCS_Main.a200Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(200); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a200Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.a400Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(400); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a400Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УВЕЛИЧИТЬ МАСШТАБ НА... procedure TFSCS_Main.aIncExecute(Sender: TObject); begin if ActiveMDIChild <> nil then F_IncOn.ShowModal else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УВЕЛИЧИТЬ МАСШТАБ procedure TFSCS_Main.aInc1ptExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.SetZoomScale(GCadForm.PCad.ZoomScale + 5); if GCadForm.PCad.AutoRefresh then RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aInc1ptExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УМЕНЬШИТЬ МАСШТАБ procedure TFSCS_Main.aDec1ptExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if (GCadForm.PCad.ZoomScale - 5) >= 10 then begin GCadForm.SetZoomScale(GCadForm.PCad.ZoomScale - 5); if GCadForm.PCad.AutoRefresh then RefreshCAD(GCadForm.PCad); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDec1ptExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ ФОНА procedure TFSCS_Main.aBackgroundColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clGray; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.BackGround; F_LoadColor.ShowModal; GCadForm.PCad.BackGround := F_LoadColor.ColorPicker.SelectedColor; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBackgroundColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ ЛИНЕЙКУ procedure TFSCS_Main.aShowRulerExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aShowRuler.Checked then GCadForm.PCad.RulerVisible := true else GCadForm.PCad.RulerVisible := false; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADShowRuler := GCadForm.PCad.RulerVisible; SaveCADListParams(GCadForm.FCADListID, CurListParams); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ СЕТКУ procedure TFSCS_Main.aShowGridExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aShowGrid.Checked then GCadForm.PCad.Grids := true else GCadForm.PCad.Grids := false; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADShowGrid := GCadForm.PCad.Grids; SaveCADListParams(GCadForm.FCADListID, CurListParams); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ ПАНЕЛЬ ИНСТРУМЕНТОВ procedure TFSCS_Main.aViewBtnPanelExecute(Sender: TObject); begin if aViewBtnPanel.Checked then cbMainPanel.Visible := true else cbMainPanel.Visible := false; end; // ПОКАЗЫВАТЬ НОРМАТИВНУЮ БАЗУ procedure TFSCS_Main.aViewNormBaseExecute(Sender: TObject); var ParentPanel: TComponent; begin if F_NormBase <> nil then begin try if aViewNormBase.Checked then begin FSCS_Main.sDiv2.Visible := False; FSCS_Main.pDock2.Visible := True; FSCS_Main.sDiv2.Visible := True; end else begin FSCS_Main.pDock2.Visible := False; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aViewNormBaseExecute', E.Message); end; end else begin aViewNormBase.Checked := False; MessageBox(Application.Handle, cMain_Mes10, cMain_Mes1, MB_OK); end; end; // ПОКАЗЫВАТЬ МЕНЕДЖЕР ПРОЕКТОВ procedure TFSCS_Main.aViewProjectManagerExecute(Sender: TObject); var ParentPanel: TComponent; begin if F_ProjMan <> nil then begin try if aViewProjectManager.Checked then begin FSCS_Main.PDock1.Visible := True; end else begin FSCS_Main.PDock1.Visible := False; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aViewProjectManagerExecute', E.Message); end; end else begin aViewProjectManager.Checked := False; MessageBox(Application.Handle, cMain_Mes11, cMain_Mes1, MB_OK); end; end; // ПОКАЗЫВАТЬ СВОЙСТВА CAD-ОБЬЕКТОВ procedure TFSCS_Main.aViewCADObjectsPropExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aViewCADObjectsProp.Checked then begin F_SizePos.Caption := cMain_Mes12; F_SizePos.Show; end else F_SizePos.Close; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ СВОЙСТВА СКС-ОБЬЕКТОВ procedure TFSCS_Main.aViewSCSObjectsPropExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aViewSCSObjectsProp.Checked then begin F_SCSObjectsProp.Caption := cMain_Mes12; F_SCSObjectsProp.Show; end else F_SCSObjectsProp.Close; end else begin MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); aViewSCSObjectsProp.Checked := False; end; end; // ПОКАЗАТЬ МЕНЕДЖЕР СЛОЕВ procedure TFSCS_Main.aViewLayersExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aViewLayers.Checked then F_LayersDialog.Show else F_LayersDialog.Close; end else begin MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); aViewLayers.Checked := False; end; end; // ПОКАЗАТЬ НАВИГАТОР procedure TFSCS_Main.aViewNavigatorExecute(Sender: TObject); var MainRight: integer; begin if aViewNavigator.Checked then begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin if F_Navigator = nil then begin F_Navigator := TF_Navigator.Create(nil); GSaveNavigatorFigures := F_Navigator.PCadNavigator.Figures; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then F_Navigator.PCadNavigator.Figures := GCadForm.PCad.Figures; MainRight := FSCS_Main.Left + FSCS_Main.Width; F_Navigator.Top := FSCS_Main.Top + 45; F_Navigator.Left := MainRight - F_Navigator.Width - 5; if not F_Navigator.Showing then F_Navigator.Show; end; end else aViewNavigator.Checked := False; end else begin if F_Navigator <> nil then begin F_Navigator.PCadNavigator.Figures := GSaveNavigatorFigures; FreeAndNil(F_Navigator); end; end; end; // СВОЙСТВА ОБЬЕКТА procedure TFSCS_Main.aObjPropertiesExecute(Sender: TObject); var ClickFigure: TFigure; SelCount: Integer; SelCheck: integer; i: integer; begin if ActiveMDIChild <> nil then begin try {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} SelCheck := 0; if Not IsVista then begin for i := 0 to 15 do begin SelCheck := SelCheck + ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) end; end; {$ELSE} SelCheck := 0; {$IFEND} if GCadForm.PCad.SelectedCount > SelCheck then begin if GPopupFigure = Nil then begin SelCount := GCadForm.PCad.SelectedCount; GPopupFigure := TFigure(GCadForm.PCad.Selection[SelCount - 1]); end; ClickFigure := TFigure(GPopupFigure); if Assigned(ClickFigure) then begin if CheckFigureByClassName(ClickFigure, cTConnectorObject) or CheckFigureByClassName(ClickFigure, cTOrthoLine) then //09.04.2012 begin // FSCS_Main.aViewSCSObjectsProp.Checked := True; if F_SCSObjectsProp.FormStyle <> fsStayOnTop then F_SCSObjectsProp.FormStyle := fsStayOnTop; // if F_SCSObjectsProp.Showing then SetForegroundWindow(F_SCSObjectsProp.Handle); // Вызвать обработку группы выделенных объектов F_SCSObjectsProp.Execute(ClickFigure); end else if CheckFigureByClassName(ClickFigure, TSCSFigureGrp.ClassName) or CheckFigureByClassName(ClickFigure, TFigureGrp.ClassName) or CheckFigureByClassName(ClickFigure, TBlock.ClassName) or CheckFigureByClassName(ClickFigure, TPolyline.ClassName) // Tolik 18/10/2017 -- or CheckFigureByClassName(ClickFigure, TPie.ClassName) // сектор // then aBlockParams.Execute else ClickFigure.Edit; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aObjPropertiesExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aOneLineChemeExecute(Sender: TObject); var i: integer; LineList, PointList, ShieldList, AutoSwitchList, JoinedSwitchCompons, CableList: TSCSComponents; ShieldCompon, AVR_Compon, SwitchCompon: TSCSComponent; ShieldLines, Switch_List: TList; PassedComponList, EndCompons: TSCSComponents; CableComponent: TSCSComponent; ShieldFigure: TConnectorObject; ShieldCatalog: TSCSCatalog; AllConnectedTrace: TList; AllConnectedCables: TSCSComponents; Procedure GetSwitchList(var aList: TSCSComponents; aLookList: TSCSComponents); var i: Integer; ChildCompon: TSCSComponent; begin for i := 0 to aLookList.Count - 1 do begin ChildCompon := aLookList[i]; if ChildCompon.ComponentType.SysName = ctsnAutoSwitch then if aList.IndexOf(childCompon) = -1 then aList.Add(ChildCompon); end; end; Procedure CollectConnections(aCompon: TSCSComponent; var aList: TSCSComponents; aCypher: string); var i, j, k: integer; ParentCompon, ChildCompon, JoinedCompon: TSCSComponent; begin if aList.IndexOf(aCompon) = -1 then aList.Add(aCompon); if isCableComponent(aCompon) then if AllConnectedCables.IndexOf(aCompon) = -1 then AllConnectedCables.Add(aCompon); if PassedComponList.IndexOf(aCompon) = -1 then begin PassedComponList.Add(aCompon); for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if aCompon.JoinedComponents[i].IsLine = biTrue then // Подключен кабель begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].Cypher = aCypher then begin if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then CollectConnections(aCompon.JoinedComponents[i], aList, aCypher); end; end else begin // Point Connection if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then begin PassedComponList.Add(aCompon.JoinedComponents[i]); if aList.IndexOf(aCompon.JoinedComponents[i]) = -1 then // тут дополнительну проверку воткнуть, начиная с парента донизу на вхождение begin ParentCompon := aCompon.JoinedComponents[i].GetTopComponent; if ParentCompon <> nil then begin if aList.IndexOf(ParentCompon) = -1 then aList.Add(ParentCompon); if ParentCompon.ComponentType.SysName <> ctsnTerminalBox then if EndCompons.IndexOf(ParentCompon) = -1 then EndCompons.Add(ParentCompon); for j := 0 to ParentCompon.JoinedComponents.Count - 1 do begin JoinedCompon := ParentCompon.JoinedComponents[j]; if PassedComponList.IndexOf(JoinedCompon) = -1 then if JoinedCompon.IsLine = biTrue then if isCableComponent(JoinedCompon) then if JoinedCompon.Cypher = aCypher then CollectConnections(JoinedCompon, aList, aCypher); end; for j := 0 to ParentCompon.ChildReferences.Count - 1 do begin ChildCompon := ParentCompon.ChildReferences[j]; if PassedComponList.IndexOf(ChildCompon) = -1 then PassedComponList.Add(ChildCompon); for k := 0 to ChildCompon.JoinedComponents.Count - 1 do begin JoinedCompon := ChildCompon.JoinedComponents[k]; if PassedComponList.IndexOf(JoinedCompon) = -1 then if JoinedCompon.IsLine = biTrue then if isCableComponent(JoinedCompon) then if JoinedCompon.Cypher = aCypher then CollectConnections(JoinedCompon, aList, aCypher); end; end; end; end; end; end; end; end; end; function GetConnectedToSwitch(aCompon: TSCSComponent): TSCSComponents; var i: integer; JoinedCompon: TSCSComponent; HasNoCableConnection: Boolean; HasPointConnections: Boolean; begin Result := nil; HasNoCableConnection := true; HasPointConnections := False; for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].IDNetType = 3 then HasNoCableConnection := false; end; if HasNoCableConnection then exit; Result := TSCSComponents.Create(false); if PassedComponList.IndexOf(aCompon) = -1 then PassedComponList.Add(aCompon); AllConnectedCables.Add(aCompon); for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].IDNetType = 3 then begin CollectConnections(aCompon.JoinedComponents[i], Result, aCompon.JoinedComponents[i].Cypher); if CableComponent = nil then CableComponent := aCompon.JoinedComponents[i]; end; end; end; Procedure RemovePlugSwithes(aList: TSCSComponents); var i: integer; begin for i := aList.Count - 1 downto 0 do begin if aList[i].ComponentType.SysName = ctsnPlugSwitch then aList.delete(i); end; end; begin ShieldFigure := nil; if GPopupFigure <> nil then if GPopupFigure is TConnectorObject then if TConnectorObject(GPopupFigure).ConnectorType = ct_NB then ShieldFigure := TConnectorObject(GPopupFigure); if ShieldFigure = nil then exit; ShieldCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ShieldFigure.ID); if ShieldCatalog = nil then exit; PointList := TSCSComponents.Create(false); // точки LineList := TSCSComponents.Create(false); // кабель AllConnectedTrace := nil; AVR_Compon := nil; ShieldList := nil; AutoSwitchList := Nil; ShieldLines := Nil; Switch_List := Nil; CableList := TSCSComponents.Create(False); for i := 0 to ShieldCatalog.ComponentReferences.Count - 1 do begin if ShieldCatalog.ComponentReferences[i].isTop then PointList.Add(ShieldCatalog.ComponentReferences[i]); end; if PointList.Count > 0 then begin //построить список щитов ShieldList := TSCSComponents.Create(false); for i := 0 to PointList.Count - 1 do begin if PointList[i].ComponentType.SysName = ctsnShield then // щиток if PointList[i].IdNetType = 3 then // электрическая сеть if ShieldList.IndexOf(PointList[i]) = -1 then ShieldList.Add(PointList[i]); break; // только один end; end; if ShieldList.Count > 0 then begin ShieldCompon := ShieldList[0]; // построить список автоматов щитка if ShieldCompon.ChildReferences.Count > 0 then begin AutoSwitchList := TSCSComponents.Create(false); GetSwitchList(AutoSwitchList, ShieldCompon.ChildReferences); end; end else begin CableList.Free; PointList.Free; ShieldList.Free; LineList.Free; exit; // не обнаружено ни одного щитка .... end; ShieldLines := TList.Create; AllConnectedTrace := TList.Create; if AutoSwitchList.Count > 0 then begin // построить списки подключений на каждый автомат PassedComponList := TSCSComponents.Create(false); PassedComponList.Add(ShieldCompon); for i := AutoSwitchList.Count - 1 downto 0 do begin AllConnectedCables := TSCSComponents.Create(false); SwitchCompon := AutoSwitchList[i]; PassedComponList.Add(SwitchCompon); EndCompons := TSCSComponents.Create(false); CableComponent := nil; JoinedSwitchCompons := GetConnectedToSwitch(SwitchCompon); //PassedComponList.Clear; if EndCompons.Count > 0 then begin RemovePlugSwithes(EndCompons); if EndCompons.Count > 0 then begin if CableComponent <> nil then begin ShieldLines.Insert(0, EndCompons); ////20/06/2022 -- { CableList.Add(CableComponent); AllConnectedTrace.Add(AllConnectedCables); } CableList.Insert(0, CableComponent); AllConnectedTrace.Insert(0, AllConnectedCables); end; end; end else begin AutoSwitchList.delete(i); EndCompons.Free; AllConnectedCables.Free; end; end; if Switch_List = nil then Switch_List := TList.Create; if AutoSwitchList.Count > 0 then Switch_List.Add(AutoSwitchList); end else begin // не обнаружено автоматов в щитке!!! -- може сообщение какое выдать тут..... end; if ShieldLines.Count > 0 then // BuildElectricianChemeList(AVR_Compon, ShieldList, Switch_List, ShieldLines, CableList, AllConnectedTrace) else ShowMessage(EL_Mess29); if PassedComponList <> nil then PassedComponList.free; if LineList <> nil then LineList.Free; if PointList <> nil then PointList.Free; if ShieldList <> nil then ShieldList.Free; if AutoSwitchList <> nil then AutoSwitchList.free; FreeList(ShieldLines); CableList.Free; if AllConnectedTrace <> nil then begin for i := 0 to AllConnectedTrace.Count - 1 do TSCSComponents(AllConnectedTrace[i]).free; AllConnectedTrace.free; end; end; // ВРАЩАТЬ ВЫДЕЛЕННЫЙ ОБЬЕКТ procedure TFSCS_Main.aRotateExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then if GCadForm.PCad.ActiveLayer = 1 then GCadForm.PCad.SetTool(toOperation, 'TRotate'); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ЗАДНИЙ ПЛАН procedure TFSCS_Main.aBackwardsExecute(Sender: TObject); var i: integer; FFigure: TFigure; begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osBack); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBackwardsExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ПЕРЕДНИЙ ПЛАН procedure TFSCS_Main.aForwardExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osFront); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aForwardExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СГРУППИРОВАТЬ ОБЬЕКТЫ procedure TFSCS_Main.aGroupingExecute(Sender: TObject); var i: Integer; ActLayer: Integer; FFigure: TFigure; // Tolik 03/10/2016-- SavedUndoFlag : Boolean; // begin if ActiveMDIChild <> nil then begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GCadForm.PCad.Selection.Count > 1 then begin ActLayer := GCadForm.PCad.ActiveLayer; if (ActLayer = lnSubstrate) {or (ActLayer > 8)} or (ActLayer = lnArch) then begin if ActLayer = lnArch then GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet); GCadForm.PCad.GroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (ActLayer = 7) then begin // Stamp !!! {//17.11.2011 if GCadForm.FFrameProjectName <> nil then if GCadForm.FFrameProjectName.Selected then GCadForm.FFrameProjectName.Deselect; if GCadForm.FFrameListName <> nil then if GCadForm.FFrameListName.Selected then GCadForm.FFrameListName.Deselect; if GCadForm.FFrameCodeName <> nil then if GCadForm.FFrameCodeName.Selected then GCadForm.FFrameCodeName.Deselect; if GCadForm.FFrameIndexName <> nil then if GCadForm.FFrameIndexName.Selected then GCadForm.FFrameIndexName.Deselect;} for i := 0 to GCadForm.FFrameObjects.Count - 1 do begin FFigure := TFigure(GCadForm.FFrameObjects.Objects[i]); if FFigure <> nil then if FFigure.Selected then FFigure.Deselect; end; RefreshCAD(GCadForm.PCad); GCadForm.PCad.GroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (ActLayer = 2) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; SCSGroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end else begin MessageBox(Application.Handle, cMain_Mes13, cMain_Mes1, MB_OK); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aGroupingExecute', E.Message); end; // GCadForm.FCanSaveForUndo := SavedUndoFlag; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗГРУППИРОВАТЬ ОБЬЕКТЫ procedure TFSCS_Main.aUngroupingExecute(Sender: TObject); var ActLayer: Integer; // Tolik 03/10/2016-- SavedUndoFlag: Boolean; // begin if ActiveMDIChild <> nil then begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GCadForm.PCad.Selection.Count > 0 then begin ActLayer := GCadForm.PCad.ActiveLayer; if (ActLayer = 1) {or (ActLayer > 8)} or (ActLayer = 8) then begin GCadForm.PCad.UnGroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (ActLayer = 7) then begin GCadForm.PCad.UnGroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else if (ActLayer = 2) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; SCSUngroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; RefreshCAD(GCadForm.PCad); end else begin MessageBox(Application.Handle, cMain_Mes13_1, cMain_Mes1, MB_OK); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aUngroupingExecute', E.Message); end; // GCadForm.FCanSaveForUndo := SavedUndoFlag; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЗАБЛОКИРОВАТЬ ОБЬЕКТ procedure TFSCS_Main.aLockExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin if (GCadForm.PCad.ActiveLayer = 1) then begin GCadForm.PCad.LockSelectionToModify(True); GCadForm.PCad.LockSelectionToMove(True); GCadForm.PCad.OrderSelection(osBack); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aLockExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗБЛОКИРОВАТЬ ОБЬЕКТ procedure TFSCS_Main.aUnlockExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin if GCadForm.PCad.ActiveLayer = 1 then begin GCadForm.PCad.LockSelectionToModify(False); GCadForm.PCad.LockSelectionToMove(False); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aUnlockExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ИЗМЕНИТЬ ШРИФТ procedure TFSCS_Main.aTextFontExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try except on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextFontExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УСТАНОВИТЬ МАСШТАБ procedure TFSCS_Main.aScaleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if GCadForm.PCad.RulerMode = rmWorld then F_Scale.ShowModal else MessageBox(Application.Handle, cMain_Mes14, cMain_Mes15, MB_OK); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // НОВОЕ ОКНО (ЛИСТ) procedure TFSCS_Main.aNewWindowExecute(Sender: TObject); begin try aNewList.Execute; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewWindowExecute', E.Message); end; end; // ЗАКРЫТЬ ВСЕ ОКНА (ПРОЕКТ) procedure TFSCS_Main.aCloseAllWindowsExecute(Sender: TObject); begin CloseAll; end; // СПРАВКА procedure TFSCS_Main.aHelpExecute(Sender: TObject); var FileName: string; begin try Application.HelpCommand(HELP_FORCEFILE, 0); // Application.HelpCommand(HELP_FINDER, 0); { FileName := ExeDir + '\Docs\HELP_CKC.HLP'; if FileExists(FileName) then begin ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0); end else ShowMessage('Файл справки не найден!'); } except on E: Exception do addExceptionToLogEx('TFSCS_Main.aHelpExecute', E.Message); end; end; // ПРЕЗЕНТАЦИЯ procedure TFSCS_Main.aPresentationExecute(Sender: TObject); var FileName: string; begin try FileName := ExeDir + '\presentation.exe'; if FileExists(FileName) then begin ShellExecute(0, PChar('open'), PChar(FileName), 0, 0, SW_MAXIMIZE); end else ShowMessage(cMain_Mes16); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPresentationExecute', E.Message); end; end; // ИНТЕРАКТИВНОЕ ОБУЧЕНИЕ procedure TFSCS_Main.aInteractiveExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); InteractiveTest; end; // ПОМОЩНИКИ procedure TFSCS_Main.aWizardsExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); end; // ТЕХ.ПОДДЕРЖКА procedure TFSCS_Main.aTechDocExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); OpenURL(urlSupport); end; procedure OpenMail(s: string=''); var SHI : TShellExecuteInfo; tmpstr: string; begin try ZeroMemory(@SHI, sizeof(SHI)); SHI.cbSize := sizeof(SHI); SHI.fMask := SEE_MASK_NOCLOSEPROCESS; SHI.Wnd := Application.Handle; SHI.lpVerb := PChar('Open'); if s = '' then SHI.lpFile := PChar('mailto:' + 'office@expertsoft.com.ua') else begin tmpstr := 'mailto:' + s; SHI.lpFile := PChar(tmpstr); end; SHI.lpParameters := nil; SHI.lpDirectory := nil; ShellExecuteEx(@SHI); except end; end; // НАПИСАТЬ РАЗРОБОТЧИКУ procedure TFSCS_Main.aToAuthorsExecute(Sender: TObject); begin {$IF Defined(SCS_PE)} {$IF Defined(SCS_PANDUIT)} MessageInfo(cActionNoRealized); {$ELSE} OpenMail('office@cableproject.net'); {$IFEND} {$ELSEIF Defined(SCS_SPA)} OpenMail('office@telcocad.net'); {$ELSEIF Defined(SCS_RF)} {$IF Defined(SCS_PANDUIT)} MessageInfo(cActionNoRealized); {$ELSE} OpenMail('info@expertsoft.ru'); {$IFEND} {$ELSE} OpenMail('office@expertsoft.com.ua'); {$IFEND} end; // КУПИТЬ ПРОДУКТ procedure TFSCS_Main.aBuyExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); CheckAndShowHint('http://admin.cableproject.net/hints/' + hints_prog_id + '/index.html', hints_prog_id, FSCS_Main, 0, True); end; // О ПРОГРАММЕ... procedure TFSCS_Main.aAboutExecute(Sender: TObject); begin (* tbCADToolsExpert.AutoSize := false; tbCADToolsExpert.Realign; tbCADToolsExpert.Refresh; tbCADToolsExpert.Repaint; tbCADToolsExpert.Show; *) try F_About := TF_About.Create(Application); F_About.ShowModal; finally FreeAndNil(F_About); end; end; //////////////////////////////////////////////////// // РАБОТА С ОКНАМИ ПАНЕЛЯМИ //////////////////////// //////////////////////////////////////////////////// // ПЕРЕКЛЮЧЕНИЕ МЕЖДУ ОКНАМИ procedure TFSCS_Main.SwitchWindow(Sender: TObject); var i: integer; PageIndex: integer; begin try TMenuItem(Sender).Checked := True; i := TMenuItem(Sender).MenuIndex - 5; FSCS_Main.pageCADList.ActivePageIndex := i; PageIndex := pageCADList.ActivePageIndex; for i := 0 to MDIChildCount - 1 do begin if MDIChildren[i].Tag = pageCADList.ActivePage.Tag then begin MDIChildren[i].BringToFront; Exit; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.SwitchWindow', E.Message); end; end; // ОБЬЕКТ НАД ПАНЕЛЬЮ procedure TFSCS_Main.PDock1DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var DockForm: TForm; begin try DockForm := nil; //#From Oleg# //14.09.2010 // если больше одной формы на панель if (Sender = PDock1) And (CountDock1 > 0) then begin PDock1.DockSite := false; Exit; end; if (Sender = PDock2) And (CountDock2 > 0) then begin PDock2.DockSite := false; Exit; end; // если докается один из флайтбаров if FSCS_Main.tbEditDocking Or FSCS_Main.tbFileDocking Or FSCS_Main.tbFormatDocking Or FSCS_Main.tbObjectDocking Or FSCS_Main.tbSelectOptionsDocking Or FSCS_Main.tbCADToolsDocking Or FSCS_Main.tbSCSToolsDocking then begin PDock1.DockSite := false; pDock2.DockSite := false; Exit; end; if F_ProjMan <> nil then if F_ProjMan.Docking then DockForm := F_ProjMan; if F_NormBase <> nil then if F_NormBase.Docking then DockForm := F_NormBase; if TPanel(Sender) = PDock1 then Source.DockRect := Rect(Source.DockRect.Left, Source.DockRect.Top, Source.DockRect.Left + DockForm.Width, Source.DockRect.Bottom) else if TPanel(Sender) = PDock2 then Source.DockRect := Rect(Source.DockRect.Right - DockForm.Width, Source.DockRect.Top, Source.DockRect.Right, Source.DockRect.Bottom); except on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1DockOver', E.Message); end; end; // ОТВЯЗКА ОБЬЕКТА ОТ ПАНЕЛИ procedure TFSCS_Main.PDock1UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean); begin try Allow := False; except on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1UnDock', E.Message); end; end; // ОБЬЕКТ В ПАНЕЛИ procedure TFSCS_Main.PDock1DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer); var ParentPanel: TComponent; begin try if Sender = PDock1 then CountDock1 := CountDock1 + 1; if Sender = PDock2 then CountDock2 := CountDock2 + 1; if (Sender = PDock1) And (CountDock1 = 1) then begin sDiv1.Visible := True; TPanel(Sender).Width := Source.DockRect.Right - Source.DockRect.Left; end; if (Sender = PDock2) And (CountDock2 = 1) then begin sDiv2.Visible := True; TPanel(Sender).Width := Source.DockRect.Right - Source.DockRect.Left; end; if F_NormBase <> nil then begin ParentPanel := TForm(F_NormBase).GetParentComponent; if ParentPanel = nil then begin F_NormBase.Panel_Addition.DragKind := dkDock; F_NormBase.Panel_Tree.DragKind := dkDock; end else begin F_NormBase.Panel_Addition.DragKind := dkDrag; F_NormBase.Panel_Tree.DragKind := dkDrag; end; end; if F_ProjMan <> nil then begin ParentPanel := TForm(F_ProjMan).GetParentComponent; if ParentPanel = nil then begin F_ProjMan.Panel_Addition.DragKind := dkDock; F_ProjMan.Panel_Tree.DragKind := dkDock; end else begin F_ProjMan.Panel_Addition.DragKind := dkDrag; F_ProjMan.Panel_Tree.DragKind := dkDrag; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1DockDrop', E.Message); end; end; // ПРИ ПЕРЕКЛЮЧЕНИИ МЕЖДУ ЛИСТАМИ В PAGECONTROL procedure TFSCS_Main.pageCADListChange(Sender: TObject); var PageIndex: integer; i: integer; begin try PageIndex := pageCADList.ActivePageIndex; FSCS_Main.mainWindow[PageIndex + 5].Checked := true; for i := 0 to MDIChildCount - 1 do begin if MDIChildren[i].Tag = pageCADList.ActivePage.Tag then begin if MDIChildren[i] is TF_CAD then SwitchListInCAD(TF_CAD(MDIChildren[i]).FCADListID, '') else MDIChildren[i].BringToFront; Exit; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.pageCADListChange', E.Message); end; end; // ПРОЦЕДУРА ДЛЯ ЗАКРЫТИЯ ПРОЕКТА procedure TFSCS_Main.CloseAll; var Count: integer; i, j: integer; PageIndex: integer; MenuItem : TMenuItem; ChildForm: TF_CAD; //ATable: TSQLMemTable; // Tolik -- 09/03/2017 -- RefreshFlag: Boolean; ChildFormName: string; // begin // Tolik 15/08/2019 -- if GExitProgEX then Application.OnIdle := nil; // // Tolik 09/02/2017 -- на всякий, чтобы не обновился Кад при удалении RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; // try // закрыть предыдущий проект if ActiveMDIChild <> nil then begin // закрыть все окна предыдущего проекта Count := 0; GNotNeedCheckRaisesBeforeClose := True; // while Count < MDIChildCount do begin ChildForm := TF_CAD(MDIChildren[Count]); // Tolik 02/08/2017 -- GCadForm := ChildForm; // ChildFormName := ChildForm.Name; ChildForm.Close; try // Tolik --30/01/2017 -- ChildForm.FCadClose := True; // ChildForm.Free; except // Tolik 29/09/2016 -- //on E: Exception do addExceptionToLogEx('TFSCS_Main.CloseAll on ChilFormClose ', E.Message); on E: Exception do // Tolik - -27/01/2017 -- пока не поймали, где падает -- хоть костыль.... begin try {for i := 0 to ChildForm.ControlCount - 1 do begin if TControl(ChildForm.Controls[i]).ClassName = 'TPowerCad' then begin ChildForm.RemoveControl(TControl(ChildForm.Controls[i])); Break; //// BREAK ////; end; end;} for i := 0 to FSCS_Main.ComponentCount - 1 do begin if TComponent(FSCS_Main.Components[i]).Name = ChildFormName then begin FSCS_Main.RemoveComponent(TComponent(FSCS_Main.Components[i])); break; end; end; ChildForm.Free; except addExceptionToLogEx('TFSCS_Main.CloseAll on ChilFormClose ', E.Message); end; end; // end; end; GNotNeedCheckRaisesBeforeClose := False; // удалить PageControl count := pageCADList.PageCount - 1; for i := 0 to count do pageCADList.ActivePage.Free; // удалить Листы в главное меню for i := 0 to mainWindow.Count - 1 do if mainWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while mainWindow.Count > i do begin MenuItem := mainWindow.Items[mainWindow.Count - 1]; mainWindow.Delete(mainWindow.Count - 1); MenuItem.Free; end; GCadForm := nil; // Tolik 09/03/2017 -- //GCanRefreshCad := RefreshFlag; // end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.CloseAll', E.Message); end; GCanRefreshCad := RefreshFlag; end; procedure TFSCS_Main.CopyList_AllExecute(Sender: TObject); begin if Assigned(F_ProjMan) then F_ProjMan.Act_CopyCurrList.Execute; end; procedure TFSCS_Main.CopyList_WComponExecute(Sender: TObject); begin if Assigned(F_ProjMan) then F_ProjMan.Act_CopyCurrListWithoutCompons.Execute; end; // ВСТАВИТЬ ТЕКСТ procedure TFSCS_Main.aInsertTextExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.CurrentLayer := 1; GCadForm.PCad.SetTool(toFigure, 'TRichText'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aInstRaspredBoxExecute(Sender: TObject); var RaspredBox: TSCSComponent; begin try //Application.ProcessMessages; //FSCS_Main.pmELObjMenu.CloseMenu; if GPlugSwitch <> nil then begin F_PEGetBox.SetNBToForm; //FSCS_Main.pmELObjMenu.CloseMenu; if F_PEGetBox.ShowModal = mrOk then begin if GCadForm <> nil then begin RaspredBox := F_PEGetBox.GetCompon; if RaspredBox <> nil then begin GDropComponent := RaspredBox; //GFigureSnap := GPlugSwitch; GCadForm.DoDragDrop(TConnectorObject(GPlugSwitch).ap1.x, TconnectorObject(GPlugSwitch).ap1.y); end; end; end; end; finally GPlugSwitch := nil; end; end; // ВСТАВИТЬ КАРТИНКУ procedure TFSCS_Main.aInsertBitmapExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.CurrentLayer := 1; GCadForm.PCad.SetTool(toFigure, 'TBMPObject'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УДАЛИТЬ ВЫДЕЛЕННЫЙ procedure TFSCS_Main.aDeleteExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin GCadForm.PCad.RemoveSelection; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УДАЛИТЬ ВСЕ ОБЬЕКТЫ procedure TFSCS_Main.aDeleteAllExecute(Sender: TObject); var ActLayer: integer; begin if ActiveMDIChild <> nil then begin try ActLayer := GCadForm.PCad.ActiveLayer; GCadForm.PCad.DeselectAll(0); GCadForm.PCad.SelectAll(ActLayer); if GCadForm.PCad.SelectedCount > 0 then begin GCadForm.PCad.RemoveSelection; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteAllExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // УБРАТЬ ВЫДЕЛЕНИЕ ВСЕХ ОБЬЕКТОВ procedure TFSCS_Main.aDeSelectAllExecute(Sender: TObject); var ActLayer: integer; begin if ActiveMDIChild <> nil then begin try ActLayer := GCadForm.PCad.ActiveLayer; GCadForm.PCad.DeselectAll(ActLayer); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeSelectAllExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СТИЛЬ ЛИНИИ procedure TFSCS_Main.aPenStyleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'apsSolid' then apsSolidExecute(Sender); if TAction(Sender).Name = 'apsDash' then apsDashExecute(Sender); if TAction(Sender).Name = 'apsDashDot' then apsDashDotExecute(Sender); if TAction(Sender).Name = 'apsDashDotDot' then apsDashDotDotExecute(Sender); if TAction(Sender).Name = 'apsDot' then apsDotExecute(Sender); if TAction(Sender).Name = 'apsClear' then apsClearExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenStyleExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ ЛИНИИ procedure TFSCS_Main.aPenColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clBlack; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.DefaultPenColor; F_LoadColor.ShowModal; GCadForm.PCad.DefaultPenColor := F_LoadColor.ColorPicker.SelectedColor; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗМЕР ЛИНИИ procedure TFSCS_Main.aPenWidthExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aPenw1' then aPenw1Execute(sender); if TAction(Sender).Name = 'aPenw2' then aPenw2Execute(sender); if TAction(Sender).Name = 'aPenw3' then aPenw3Execute(sender); if TAction(Sender).Name = 'aPenw4' then aPenw4Execute(sender); if TAction(Sender).Name = 'aPenw5' then aPenw5Execute(sender); if TAction(Sender).Name = 'aPenw6' then aPenw6Execute(sender); if TAction(Sender).Name = 'aPenw7' then aPenw7Execute(sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenWidthExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СТИЛЬ СТРЕЛКИ procedure TFSCS_Main.aRowStyleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'arsBothLight' then arsBothLightExecute(Sender); if TAction(Sender).Name = 'arsBothSolid' then arsBothSolidExecute(Sender); if TAction(Sender).Name = 'arsLeftLight' then arsLeftLightExecute(Sender); if TAction(Sender).Name = 'arsLeftSolid' then arsLeftSolidExecute(Sender); if TAction(Sender).Name = 'arsNone' then arsNoneExecute(Sender); if TAction(Sender).Name = 'arsRightLight' then arsRightLightExecute(Sender); if TAction(Sender).Name = 'arsRightSolid' then arsRightSolidExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRowStyleExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СТИЛЬ ЗАЛИВКИ procedure TFSCS_Main.aBrushStyleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'absBDiagonal' then absBDiagonalExecute(Sender); if TAction(Sender).Name = 'absClear' then absClearExecute(Sender); if TAction(Sender).Name = 'absCross' then absCrossExecute(Sender); if TAction(Sender).Name = 'absDiagCross' then absDiagCrossExecute(Sender); if TAction(Sender).Name = 'absFDiagonal' then absFDiagonalExecute(Sender); if TAction(Sender).Name = 'absHorizontal' then absHorizontalExecute(Sender); if TAction(Sender).Name = 'absSolid' then absSolidExecute(Sender); if TAction(Sender).Name = 'absVertical' then absVerticalExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBrushStyleExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ШРИФТ ТЕКСТА procedure TFSCS_Main.aTextCharsetExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aANSI_CHARSET' then aANSI_CHARSETExecute(Sender); if TAction(Sender).Name = 'aDEFAULT_CHARSET' then aDEFAULT_CHARSETExecute(Sender); if TAction(Sender).Name = 'aRUSSIAN_CHARSET' then aRUSSIAN_CHARSETExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextCharsetExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // НАЧЕРТАНИЕ ТЕКСТА procedure TFSCS_Main.aFontStyleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aTextBold' then aTextBoldExecute(Sender); if TAction(Sender).Name = 'aTextItalic' then aTextItalicExecute(Sender); if TAction(Sender).Name = 'aTextUnderLine' then aTextUnderLineExecute(Sender); if TAction(Sender).Name = 'aTextStrikeThrough' then aTextStrikeThroughExecute(Sender); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aFontStyleExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАСПОЛОЖЕНИЕ ОБЬЕКТОВ procedure TFSCS_Main.aFormatOrderExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin //if GCadForm.PCad.Selection.Count = 1 then if GCadForm.PCad.Selection.Count >= 1 then begin try if TAction(Sender).Name = 'aSendtoBack' then aSendtoBackExecute(Sender); if TAction(Sender).Name = 'aBringtoFront' then aBringtoFrontExecute(Sender); if TAction(Sender).Name = 'aSendBackwards' then aSendBackwardsExecute(Sender); if TAction(Sender).Name = 'aBringForwards' then aBringForwardsExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aFormatOrderExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ТИП СЕТКИ procedure TFSCS_Main.aGridTypeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aLineGrid' then aLineGridExecute(Sender); if TAction(Sender).Name = 'aPointGrid' then aPointGridExecute(Sender); if TAction(Sender).Name = 'aCrossGrid' then aCrossGridExecute(Sender); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aGridTypeExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ ЦЕНТРАЛЬНЫЕ НАПРВЛЯЮЩИЕ procedure TFSCS_Main.aShowCenterGuidesExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aShowCenterGuides.Checked then GCadForm.PCad.CenterGuide := true else GCadForm.PCad.CenterGuide := false; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПОКАЗЫВАТЬ НАПРАВЛЯЮЩИЕ procedure TFSCS_Main.aShowGuideLinesExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aShowGuideLines.Checked then GCadForm.PCad.GuidesVisible := true else GCadForm.PCad.GuidesVisible := false; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADShowGuides := GCadForm.PCad.GuidesVisible; SaveCADListParams(GCadForm.FCADListID, CurListParams); GCadForm.PCad.Refresh; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПРИВЯЗКА К СЕТКЕ procedure TFSCS_Main.aSnaptoGridExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aSnaptoGrid.Checked then GCadForm.PCad.SnapToGrids := true else GCadForm.PCad.SnapToGrids := false; GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADSnapGrid := GCadForm.PCad.SnapToGrids; SaveCADListParams(GCadForm.FCADListID, CurListParams); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПРИВЯЗКА К НАПРАВЛЯЮЩИМ procedure TFSCS_Main.aSnaptoGuidesExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aSnaptoGuides.Checked then GCadForm.PCad.SnapToGuides := true else GCadForm.PCad.SnapToGuides := false; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADSnapGuides := GCadForm.PCad.SnapToGuides; SaveCADListParams(GCadForm.FCADListID, CurListParams); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПРИВЯЗКА К БЛИЖНЕМУ ОБЬЕКТУ procedure TFSCS_Main.aSnaptoNearObjectExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin if aSnaptoNearObject.Checked then GCadForm.PCad.SnapToNearPoint := true else GCadForm.PCad.SnapToNearPoint := false; CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADSnapNearObject := GCadForm.PCad.SnapToNearPoint; SaveCADListParams(GCadForm.FCADListID, CurListParams); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ СЕТКИ procedure TFSCS_Main.aGridColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clSilver; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.GridColor; F_LoadColor.ShowModal; GCadForm.PCad.GridColor := F_LoadColor.ColorPicker.SelectedColor; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aGridColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ НАПРАВЛЯЮЩИХ procedure TFSCS_Main.aGuideColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clGreen; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.GuideColor; F_LoadColor.ShowModal; GCadForm.PCad.GuideColor := F_LoadColor.ColorPicker.SelectedColor; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aGuideColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ СТРАНИЦЫ procedure TFSCS_Main.aPageColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clWhite; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.PageColor; F_LoadColor.ShowModal; GCadForm.PCad.PageColor := F_LoadColor.ColorPicker.SelectedColor; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // НАПРАВЛЯЮЩИЕ ПОД УГЛОМ procedure TFSCS_Main.aAngularGuidesExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aAngularNone' then aAngularNoneExecute(Sender); if TAction(Sender).Name = 'aAngular90' then aAngular90Execute(Sender); if TAction(Sender).Name = 'aAngular30' then aAngular30Execute(Sender); if TAction(Sender).Name = 'aAngular45' then aAngular45Execute(Sender); if TAction(Sender).Name = 'aAngular60' then aAngular60Execute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAngularGuidesExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // СИСТЕМА ЛИНЕЙКИ procedure TFSCS_Main.aRulerSystemExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if TAction(Sender).Name = 'aMetric' then aMetricExecute(Sender); if TAction(Sender).Name = 'aWitworth' then aWitworthExecute(Sender); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РЕЖИМ ЛИНЕЙКИ procedure TFSCS_Main.aRulerModeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if TAction(Sender).Name = 'aPageMode' then aPageModeExecute(Sender); if TAction(Sender).Name = 'aWorldMode' then aWorldModeExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗМЕР СТРАНИЦЫ procedure TFSCS_Main.aPageLayoutExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aA0' then aA0Execute(Sender); if TAction(Sender).Name = 'aA1' then aA1Execute(Sender); if TAction(Sender).Name = 'aA2' then aA2Execute(Sender); if TAction(Sender).Name = 'aA3' then aA3Execute(Sender); if TAction(Sender).Name = 'aA4' then aA4Execute(Sender); if TAction(Sender).Name = 'aA5' then aA5Execute(Sender); if TAction(Sender).Name = 'aA6' then aA6Execute(Sender); if TAction(Sender).Name = 'aB4' then aB4Execute(Sender); if TAction(Sender).Name = 'aB5' then aB5Execute(Sender); if TAction(Sender).Name = 'aLetter' then aLetterExecute(Sender); if TAction(Sender).Name = 'aTabloid' then aTabloidExecute(Sender); if TAction(Sender).Name = 'aCustom' then aCustomExecute(Sender); // обновить скроллы GCadForm.ChangeScrollsOnChangeListSize; // обновить навигатор if F_Navigator <> nil then begin RefreshCAD(F_Navigator.PCadNavigator); ReAssignNavigatorParams; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageLayoutExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОРИЕНТАЦИЯ СТРАНИЦЫ procedure TFSCS_Main.aPageOrientationExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if TAction(Sender).Name = 'aLandscape' then aLandscaleExecute(Sender); if TAction(Sender).Name = 'aPortrait' then aPortraitExecute(Sender); // обновить скроллы GCadForm.ChangeScrollsOnChangeListSize; // обновить навигатор if F_Navigator <> nil then begin RefreshCAD(F_Navigator.PCadNavigator); ReAssignNavigatorParams; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageOrientationExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ШАГ СЕТКИ procedure TFSCS_Main.aGridStepExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin F_GridStep.ShowModal; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ЗАДНИЙ ПЛАН procedure TFSCS_Main.aSendtoBackExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osBward{osBack}); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSendtoBackExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ПЕРЕДНИЙ ПЛАН procedure TFSCS_Main.aBringtoFrontExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osFWard{osFront}); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBringtoFrontExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ЗАДНИЙ ПЛАН procedure TFSCS_Main.aSendBackwardsExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osBack{osBward}); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSendBackwardsExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ОБЬЕКТ НА ПЕРЕДНИЙ ПЛАН procedure TFSCS_Main.aBringForwardsExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.PCad.OrderSelection(osFront{osFWard}); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBringForwardsExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАВНИВАНИЕ ПО ВЕРХНЕМУ КРАЮ procedure TFSCS_Main.aalTopExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin // Tolik -- 07/02/2017 -- //if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then // begin GCadForm.PCad.AlignSelection(haTop, vaNoChange); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАНИВАНИЕ ПО НИЖНЕМУ КРАЮ procedure TFSCS_Main.aalBottomExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin // Tolik -- 07/02/2017 -- //if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then // begin GCadForm.PCad.AlignSelection(haBottom, vaNoChange); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАВНИВАНИЕ ПО X procedure TFSCS_Main.aalXcenterExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then begin GCadForm.PCad.AlignSelection(haCenter, vaNoChange); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАВНИВАНИЕ ПО ЛЕВОМУ КРАЮ procedure TFSCS_Main.aalLeftExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin // Tolik -- 06/02/2017 -- //if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then begin GCadForm.PCad.AlignSelection(haNoChange, vaLeft); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАВНИВАНИЕ ПО ПРАВОМУ КРАЮ procedure TFSCS_Main.aalRightExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin // Tolik -- 07/02/2017 -- //if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then begin GCadForm.PCad.AlignSelection(haNoChange, vaRight); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАВНИВАНИЕ ПО Y procedure TFSCS_Main.aalYCenterExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then begin GCadForm.PCad.AlignSelection(haNoChange, vaCenter); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВЫРАНИВАНИЕ ОБЬЕКТА ПО ... procedure TFSCS_Main.aFormatAlignExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if GCadForm.PCad.Selection.Count > 1 then begin try if TAction(Sender).Name = 'aalTop' then aalTopExecute(Sender); if TAction(Sender).Name = 'aalBottom' then aalBottomExecute(Sender); if TAction(Sender).Name = 'aalXcenter' then aalXcenterExecute(Sender); if TAction(Sender).Name = 'aalLeft' then aalLeftExecute(Sender); if TAction(Sender).Name = 'aalRight' then aalRightExecute(Sender); if TAction(Sender).Name = 'aalYCenter' then aalYCenterExecute(Sender); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aFormatAlignExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //--------------------------------------------------- // ТИПЫ СТИЛЯ ЛИНИИ procedure TFSCS_Main.apsClearExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psClear; apsClear.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(5, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.apsDashExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psDash; apsDash.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(1, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.apsDashDotExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psDashDot; apsDashDot.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(3, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.apsDashDotDotExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psDashDotDot; apsDashDotDot.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(4, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.apsDotExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psDot; apsDot.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(2, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.apsSolidExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenStyle := psSolid; apsSolid.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(0, ImageLoad); mPenStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //-------------------------------------------------- // ТИПЫ РАЗМЕРА ЛИНИИ procedure TFSCS_Main.aPenw1Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 1; aPenw1.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(6, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw2Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 2; aPenw2.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(7, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw3Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 3; aPenw3.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(8, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw4Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 4; aPenw4.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(9, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw5Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 5; aPenw5.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(10, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw6Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 6; aPenw6.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(11, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPenw7Execute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultPenWidth := 7; aPenw7.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(12, ImageLoad); mPenw.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //-------------------------------------------------------- // ТИПЫ СТИЛЯ СТРЕЛКИ procedure TFSCS_Main.arsBothLightExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsBothLight; arsBothLight.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(14, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsBothSolidExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsBothSolid; arsBothSolid.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(15, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsLeftLightExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsLeftLight; arsLeftLight.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(16, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsLeftSolidExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsLeftSolid; arsLeftSolid.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(17, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsNoneExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsNone; arsNone.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(18, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsRightLightExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsRightLight; arsRightLight.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(19, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.arsRightSolidExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultRowStyle := rsRightSolid; arsRightSolid.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(20, ImageLoad); mRowstyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //------------------------------------------------------- // ТИПЫ СТИЛЯ ЗАЛИВКИ procedure TFSCS_Main.absBDiagonalExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsBDiagonal; absBDiagonal.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(26, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absClearExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsClear; absClear.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(22, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absCrossExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsCross; absCross.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(27, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absDiagCrossExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsDiagCross; absDiagCross.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(28, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absFDiagonalExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsFDiagonal; absFDiagonal.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(25, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absHorizontalExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsHorizontal; absHorizontal.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(23, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absSolidExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsSolid; absSolid.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(21, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.absVerticalExecute(Sender: TObject); var ImageLoad: TBitmap; begin if ActiveMDIChild <> nil then begin GCadForm.PCad.DefaultBrushStyle := bsVertical; absVertical.Checked := true; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(24, ImageLoad); mBrushStyle.Bitmap := ImageLoad; FreeAndNil(ImageLoad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //----------------------------------------------------- // ТИПЫ НАЧЕРТАНИЯ ТЕКСТА procedure TFSCS_Main.aTextBoldExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aTextBold.Checked then GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsBold] else GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsBold]; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aTextItalicExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aTextItalic.Checked then GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsItalic] else GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsItalic]; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aTextUnderLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aTextUnderLine.Checked then GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsUnderLine] else GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsUnderLine]; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aTextStrikeThroughExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin if aTextStrikeThrough.Checked then GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsStrikeOut] else GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsStrikeOut]; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //--------------------------------------------------------- // ТИПЫ ШРИФТОВ ТЕКСТА procedure TFSCS_Main.aANSI_CHARSETExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.Font.Charset := ANSI_CHARSET; aANSI_CHARSET.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aDEFAULT_CHARSETExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.Font.Charset := DEFAULT_CHARSET; aDEFAULT_CHARSET.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aRUSSIAN_CHARSETExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.Font.Charset := RUSSIAN_CHARSET; aRUSSIAN_CHARSET.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ ЗАЛИВКИ procedure TFSCS_Main.aBrushColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clBlack; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.DefaultBrushColor; F_LoadColor.ShowModal; GCadForm.PCad.DefaultBrushColor := F_LoadColor.ColorPicker.SelectedColor; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBrushColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЦВЕТ ТЕКСТА //Tolik 01/11/2021 -- старая закомменчена - см. ниже procedure TFSCS_Main.aTextColorExecute(Sender: TObject); var i: Integer; TextList: TList; begin if ActiveMDIChild <> nil then begin try TextList := TList.Create; for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin if TFigure(GCadForm.PCad.Selection[i]).ClassName = 'TText' then TextList.Add(TFigure(GCadForm.PCad.Selection[i])); end; F_LoadColor.ColorPicker.DefaultColor := clBlack; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.Font.Color; F_LoadColor.ShowModal; if TextList.Count > 0 then begin for i := 0 to TextList.Count - 1 do begin //TText(TextList[i]).Font.Color := F_LoadColor.ColorPicker.SelectedColor; TText(TextList[i]).Color := F_LoadColor.ColorPicker.SelectedColor; end; GCadForm.PCad.Refresh; end else GCadForm.PCad.Font.Color := F_LoadColor.ColorPicker.SelectedColor; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); TextList.free; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; { procedure TFSCS_Main.aTextColorExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try F_LoadColor.ColorPicker.DefaultColor := clBlack; F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.Font.Color; F_LoadColor.ShowModal; GCadForm.PCad.Font.Color := F_LoadColor.ColorPicker.SelectedColor; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextColorExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; } //----------------------------------------------------- // ТИПЫ ТИПОВ СЕТКИ procedure TFSCS_Main.aLineGridExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GridType := grtLine; aLineGrid.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPointGridExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GridType := grtPoint; aPointGrid.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aCrossGridExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GridType := grtCross; aCrossGrid.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //-------------------------------------------------------- // ТИПЫ НАПРАВЛЯЮЩИХ ПОД УГЛОМ procedure TFSCS_Main.aAngularNoneExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GuideTrace := gtNone; aAngularNone.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aAngular90Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GuideTrace := gtNinty; aAngular90.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aAngular30Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GuideTrace := gtThirty; aAngular30.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aAngular60Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GuideTrace := gtSixty; aAngular60.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aAngular45Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.GuideTrace := gtFortyFive; aAngular45.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //--------------------------------------------------- // ТИПЫ СИСТЕМЫ ЛИНЕЙКИ procedure TFSCS_Main.aMetricExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.RulerSystem := rsMetric; aMetric.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aWitworthExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.RulerSystem := rsWhitworth; aWitworth.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //---------------------------------------------------- // ТИПЫ РЕЖИМА ЛИНЕЙКИ procedure TFSCS_Main.aPageModeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.RulerMode := rmPage; aPageMode.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aWorldModeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.RulerMode := rmWorld; aWorldMode.Checked := true; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //------------------------------------------------------ // ТИПЫ ОРИЕНТАЦИИ СТРАНИЦЫ procedure TFSCS_Main.aLandscaleExecute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin try { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; GCadForm.PCad.PageOrient := poLandscape; aLandscape.Checked := true; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // // выставить рамку if GCadForm.PCad.PageLayout = plA0 then LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA1 then LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA2 then LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA3 then LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA4 then LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout <> plCustom then LoadFrameToList(GCadForm, ''); } except on E: Exception do addExceptionToLogEx('TFSCS_Main.aLandscaleExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aPortraitExecute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin try { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; GCadForm.PCad.PageOrient := poPortrait; aPortrait.Checked := true; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // // выставить рамку if GCadForm.PCad.PageLayout = plA0 then LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA1 then LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA2 then LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA3 then LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch') else if GCadForm.PCad.PageLayout = plA4 then LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch') else if GCadForm.pcad.PageLayout <> plCustom then LoadFrameToList(GCadForm, ''); } except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPortraitExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; //----------------------------------------------- // ТИПЫ РАЗМЕРА СТРАНИЦЫ procedure TFSCS_Main.aA0Execute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // GCadForm.PCad.PageLayout := plA0; if GCadForm.PCad.PageOrient = poLandscape then LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageOrient = poPortrait then LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch'); aA0.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA1Execute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // GCadForm.PCad.PageLayout := plA1; if GCadForm.PCad.PageOrient = poLandscape then LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageOrient = poPortrait then LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch'); aA1.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA2Execute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // GCadForm.PCad.PageLayout := plA2; if GCadForm.PCad.PageOrient = poLandscape then LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageOrient = poPortrait then LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch'); aA2.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA3Execute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // GCadForm.PCad.PageLayout := plA3; if GCadForm.PCad.PageOrient = poLandscape then LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageOrient = poPortrait then LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch'); aA3.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA4Execute(Sender: TObject); var StampTypeStr: string; StampLangStr: string; FullPathName: string; begin if ActiveMDIChild <> nil then begin { FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\'; // if GCadForm.FCadStampType = stt_simple then StampTypeStr := 'Small'; if GCadForm.FCadStampType = stt_extended then StampTypeStr := 'Big'; if GCadForm.FCadStampType = stt_detailed then StampTypeStr := 'ExtBig'; // if GCadForm.FCadStampLang = stl_ukr then StampLangStr := 'ukr'; if GCadForm.FCadStampLang = stl_rus then StampLangStr := 'rus'; // GCadForm.PCad.PageLayout := plA4; if GCadForm.PCad.PageOrient = poLandscape then LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch') else if GCadForm.PCad.PageOrient = poPortrait then LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch'); aA4.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA5Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plA5; LoadFrameToList(GCadForm, ''); aa5.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aA6Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plA6; LoadFrameToList(GCadForm, ''); aa6.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aB4Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plB4; LoadFrameToList(GCadForm, ''); ab4.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aB5Execute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plB5; LoadFrameToList(GCadForm, ''); ab5.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aLetterExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plLetter; LoadFrameToList(GCadForm, ''); aLetter.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aTabloidExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plTabloid; LoadFrameToList(GCadForm, ''); aTabloid.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aCustomExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin { GCadForm.PCad.PageLayout := plCustom; LoadFrameToList(GCadForm, ''); aCustom.Checked := true; } end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ДУБЛИКАТ ВЫДЕЛЕННОГО ОБЬЕКТА procedure TFSCS_Main.aDuplicateSelectionExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin GCadForm.PCad.SetTool(toOperation, 'TMirror'); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDuplicateSelectionExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ВРАЩЕНИЕ ВЫДЕЛЕННОГО ОБЬЕКТА procedure TFSCS_Main.aRotateSelectionExecute(Sender: TObject); var Point: TDoublePoint; i: integer; SelFigure: TFigure; begin if ActiveMDIChild <> nil then begin if GCadForm.PCad.Selection.Count > 0 then begin try for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin SelFigure := TFigure(GCadForm.PCad.Selection[i]); Point := TFigure(SelFigure).CenterPoint; GCadForm.PCad.RotateSelection(100, DoublePoint(Point.X, Point.Y)); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateSelectionExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПЕРЕМЕЩЕНИЕ ВЫДЕЛЕННОГО ОБЬЕКТА procedure TFSCS_Main.aMoveSelectionExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin GCadForm.PCad.SetTool(toOperation, 'TMove'); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMoveSelectionExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ЗЕРКАЛЬНОЕ ОТОБРАЖЕНИЕ ВЫДЕЛЕННОГО ОБЬЕКТА procedure TFSCS_Main.aMirrorSelectionExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin GCadForm.PCad.SetTool(toOperation, 'TMirror'); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorSelectionExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ------- СПИСОК ИНСТРУМЕНТОВ CAD---------------------- // SELECT procedure TFSCS_Main.aToolSelectExecute(Sender: TObject); var SCSList: TSCSList; begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 if GCadForm <> nil then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID); if SCSList <> nil then SCSList.FNewComponNameMark := ''; end; //GNewComponNameMark := ''; GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- try if GCadForm.PCad.TraceFigure <> nil then begin if GCadForm.PCad.TraceFigure is TOrthoLine then // если не проверять и делать EndTrace для всех абсолютно - будет хрень на автосоздании МЄ после копирования листа begin // Tolik --18/11/2015 // GCadForm.PCad.EndTrace([ssRight]); -- EndTrace сделаем только если мы что-то рисовали, // а если не рисовали или поставили только один конец трассы и вышли за границы КАДа - просто // шлепнем TraceFigure if (GCadForm.PCad.ToolInfo = 'TOrthoLine') and (GCadForm.PCad.TraceFigure <> nil) and (GClickIndex > 1) then begin if GCadForm.FAutoCadMouse then // Tolik -- если в настройках листа - Автокадовская мышка Inc(GClickIndex); // иначе поимеем еще один баг (а так и было!!!) - потерю последней обозначенной трассы !!! // при выходе курсора за границы КАДа GCadForm.PCad.EndTrace([ssRight]); end else GCadForm.PCad.KillTraceFig; // ш-л-е-п! end; end; // except end; GCadForm.PCad.SetTool(toSelect, 'TSelected'); tbCreateOnClickModeExpert.Down := False; tbCreateOnClickModeNoob.Down := False; tbSelectExpert.Down := True; tbSelectNoob.Down := True; GCurrShadowTraceX := -1; GCurrShadowTraceY := -1; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // LINE procedure TFSCS_Main.aToolLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // RECTANGLE procedure TFSCS_Main.aToolRectangleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TRectangle'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ELLIPSE procedure TFSCS_Main.aToolEllipseExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TEllipse'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // CIRCLE procedure TFSCS_Main.aToolCircleExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TCircle'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ARC procedure TFSCS_Main.aToolArcExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TArc'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ELIPTIC ARC procedure TFSCS_Main.aToolElipticArcExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TElpArc'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // POLYLINE procedure TFSCS_Main.aToolPolyLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TPolyLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // POINT (VERTEX) procedure TFSCS_Main.aToolPointExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TVertex'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // TEXT procedure TFSCS_Main.aToolTextExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TText'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // RICHTEXT procedure TFSCS_Main.aToolRichTextExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TRichText'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // KNIFE procedure TFSCS_Main.aToolKnifeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TKnife'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // HDIMLINE procedure TFSCS_Main.aToolHDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'THDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // VDIMLINE procedure TFSCS_Main.aToolVDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayerExecute(Sender); GCadForm.PCad.SetTool(toFigure, 'TVDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗМЕР ТЕКСТА procedure TFSCS_Main.aTextSizeExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ИЗМЕНЕИЕ ШРИФТА procedure TFSCS_Main.fcbTextFontChange(Sender: TObject); begin aTextFontExecute(Sender); end; // ИЗМЕНЕНИЕ РАЗМЕРА ШРИФТА procedure TFSCS_Main.fcbTextSizeChange(Sender: TObject); begin aTextSizeExecute(Sender); end; // ПОПЫТКА ДОКА К ПАНЕЛИ ИНСТРУМЕНТОВ procedure TFSCS_Main.cbMainPanelBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); begin Options := []; end; procedure TFSCS_Main.cbMainPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin if (F_NormBase.Docking or F_ProjMan.Docking) then cbMainPanel.DockSite := false; end; end; procedure TFSCS_Main.cbMainPanelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin end; // -------------------------------------------------- // ПОПЫТКА ДОКА ФЛАЙТБАРОВ К ПАНЕЛИ ИНСТРУМЕНТОВ procedure TFSCS_Main.tbEditStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbEditDocking := true; end; procedure TFSCS_Main.tbEditEndDock(Sender, Target: TObject; X, Y: Integer); begin tbEditDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbFileStartDock(Sender: TObject; var DragObject: TDragObject); begin tbFileDocking := true; end; procedure TFSCS_Main.tbFileEndDock(Sender, Target: TObject; X, Y: Integer); begin tbFileDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbFormatStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbFormatDocking := true; end; procedure TFSCS_Main.tbFormatEndDock(Sender, Target: TObject; X, Y: Integer); begin tbFormatDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbObjectStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbObjectDocking := true; end; procedure TFSCS_Main.tbObjectEndDock(Sender, Target: TObject; X, Y: Integer); begin tbObjectDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbSelectOptionsStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbSelectOptionsDocking := true; end; procedure TFSCS_Main.tbSelectOptionsEndDock(Sender, Target: TObject; X, Y: Integer); begin tbSelectOptionsDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbCADToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbCADToolsDocking := true; end; procedure TFSCS_Main.tbCADToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer); begin tbCADToolsDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.tbCADToolsExpertMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin end; // ЗАГРУЗКА РИСУНКОВ В СТИЛЬ ЛИНИИ procedure TFSCS_Main.mpsDashAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: Trect; ImIndex: integer; begin try ImIndex := 0; //#From Oleg# //14.09.2010 // проверка на загрузку рисунков if (TMainMenu(Sender).Name = 'mpsSolid') or (TPopupMenu(Sender).Name = 'ppsSolid') then ImIndex := 0; if (TMainMenu(Sender).Name = 'mpsDash') or (TPopupMenu(Sender).Name = 'ppsDash') then ImIndex := 1; if (TMainMenu(Sender).Name = 'mpsDot') or (TPopupMenu(Sender).Name = 'ppsDot') then ImIndex := 2; if (TMainMenu(Sender).Name = 'mpsDashDot') or (TPopupMenu(Sender).Name = 'ppsDashDot') then ImIndex := 3; if (TMainMenu(Sender).Name = 'mpsDashDotDot') or (TPopupMenu(Sender).Name = 'ppsDashDotDot') then ImIndex := 4; if (TMainMenu(Sender).Name = 'mpsClear') or (TPopupMenu(Sender).Name = 'ppsClear') then ImIndex := 5; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(ImIndex, ImageLoad); DestRect := ARect; DestRect.Top := DestRect.Top + 2; DestRect.Left := DestRect.Left + 30; DestRect.Bottom := DestRect.Top + 16; DestRect.Right := DestRect.Left + 32; ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16)); ACanvas.Refresh; FreeAndNil(ImageLoad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.mpsClearAdvancedDrawItem', E.Message); end; end; // ЗАГРУЗКА РИСУНКОВ В РАЗМЕР ЛИНИИ procedure TFSCS_Main.mPenw1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: Trect; ImIndex: integer; begin try ImIndex := 0; //#From Oleg# //14.09.2010 // проверка на загрузку рисунков if (TMainMenu(Sender).Name = 'mPenw1') or (TPopupMenu(Sender).Name = 'pPenw1') then ImIndex := 6; if (TMainMenu(Sender).Name = 'mPenw2') or (TPopupMenu(Sender).Name = 'pPenw2') then ImIndex := 7; if (TMainMenu(Sender).Name = 'mPenw3') or (TPopupMenu(Sender).Name = 'pPenw3') then ImIndex := 8; if (TMainMenu(Sender).Name = 'mPenw4') or (TPopupMenu(Sender).Name = 'pPenw4') then ImIndex := 9; if (TMainMenu(Sender).Name = 'mPenw5') or (TPopupMenu(Sender).Name = 'pPenw5') then ImIndex := 10; if (TMainMenu(Sender).Name = 'mPenw6') or (TPopupMenu(Sender).Name = 'pPenw6') then ImIndex := 11; if (TMainMenu(Sender).Name = 'mPenw7') or (TPopupMenu(Sender).Name = 'pPenw7') then ImIndex := 12; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(ImIndex, ImageLoad); DestRect := ARect; DestRect.Top := DestRect.Top + 2; DestRect.Left := DestRect.Left + 30; DestRect.Bottom := DestRect.Top + 16; DestRect.Right := DestRect.Left + 32; ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16)); ACanvas.Refresh; FreeAndNil(ImageLoad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.mPenw1AdvancedDrawItem', E.Message); end; end; // ЗАГРУЗКА РИСУНКОВ В СТИЛЬ СТРЕЛКИ procedure TFSCS_Main.mrsBothLightAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: TRect; ImIndex: integer; begin try ImIndex := 0; //#From Oleg# //14.09.2010 // проверка на загрузку рисунков if (TMainMenu(Sender).Name = 'mrsBothLight') or (TPopupMenu(Sender).Name = 'prsBothLight') then ImIndex := 14; if (TMainMenu(Sender).Name = 'mrsBothSolid') or (TPopupMenu(Sender).Name = 'prsBothSolid') then ImIndex := 15; if (TMainMenu(Sender).Name = 'mrsLeftLight') or (TPopupMenu(Sender).Name = 'prsLeftLight') then ImIndex := 16; if (TMainMenu(Sender).Name = 'mrsLeftSolid') or (TPopupMenu(Sender).Name = 'prsLeftSolid') then ImIndex := 17; if (TMainMenu(Sender).Name = 'mrsNone') or (TPopupMenu(Sender).Name = 'prsNone') then ImIndex := 18; if (TMainMenu(Sender).Name = 'mrsRightLight') or (TPopupMenu(Sender).Name = 'prsRightLight') then ImIndex := 19; if (TMainMenu(Sender).Name = 'mrsRightSolid') or (TPopupMenu(Sender).Name = 'prsRightSolid') then ImIndex := 20; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(ImIndex, ImageLoad); DestRect := ARect; DestRect.Top := DestRect.Top + 2; DestRect.Left := DestRect.Left + 30; DestRect.Bottom := DestRect.Top + 16; DestRect.Right := DestRect.Left + 32; ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16)); ACanvas.Refresh; FreeAndNil(ImageLoad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.mrsBothLightAdvancedDrawItem', E.Message); end; end; // ЗАГРУЗКА РИСУНКОВ В СТИЛЬ ЗАЛИВКИ procedure TFSCS_Main.mainFileClick(Sender: TObject); begin CheckCloseReportForm; inherited; end; procedure TFSCS_Main.MainMenuChange(Sender: TObject; Source: TMenuItem; Rebuild: Boolean); begin CheckCloseReportForm; end; procedure TFSCS_Main.mbsVerticalAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: Trect; ImIndex: integer; begin try ImIndex := 0; //#From Oleg# //14.09.2010 // проверка на загрузку рисунков if (TMainMenu(Sender).Name = 'mbsSolid') or (TPopupMenu(Sender).Name = 'pbsSolid') then ImIndex := 21; if (TMainMenu(Sender).Name = 'mbsClear') or (TPopupMenu(Sender).Name = 'pbsClear') then ImIndex := 22; if (TMainMenu(Sender).Name = 'mbsHorizontal') or (TPopupMenu(Sender).Name = 'pbsHorizontal') then ImIndex := 23; if (TMainMenu(Sender).Name = 'mbsVertical') or (TPopupMenu(Sender).Name = 'pbsVertical') then ImIndex := 24; if (TMainMenu(Sender).Name = 'mbsFDiagonal') or (TPopupMenu(Sender).Name = 'pbsFDiagonal') then ImIndex := 25; if (TMainMenu(Sender).Name = 'mbsBDiagonal') or (TPopupMenu(Sender).Name = 'pbsBDiagonal') then ImIndex := 26; if (TMainMenu(Sender).Name = 'mbsCross') or (TPopupMenu(Sender).Name = 'pbsCross') then ImIndex := 27; if (TMainMenu(Sender).Name = 'mbsDiagCross') or (TPopupMenu(Sender).Name = 'pbsDiagCross') then ImIndex := 28; ImageLoad := TBitmap.Create; ImageStyles.GetBitmap(ImIndex, ImageLoad); DestRect := ARect; DestRect.Top := DestRect.Top + 2; DestRect.Left := DestRect.Left + 30; DestRect.Bottom := DestRect.Top + 16; DestRect.Right := DestRect.Left + 32; ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16)); ACanvas.Refresh; FreeAndNil(ImageLoad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.mbsBDiagonalAdvancedDrawItem', E.Message); end; end; //////////////////////////////////////////////////////////////////////////////// // ----------------------- LAYERS ---------------------------------------------- // НОВЫЙ СЛОЙ procedure TFSCS_Main.aNewLayerExecute(Sender: TObject); begin F_NewLayer.ShowModal; end; // УДАЛИТЬ СЛОЙ procedure TFSCS_Main.aDeleteLayerExecute(Sender: TObject); var RemoveLayer: TLayer; LNbr: integer; ActLayer: integer; begin try ActLayer := GCadForm.PCad.ActiveLayer; LNbr := GCadForm.PCad.ActiveLayer; RemoveLayer := GCadForm.PCad.Layers.Items[LNbr]; if (ActLayer > 9) then begin // Tolik 30/08/2019 -- if CheckCanDelLayer(RemoveLayer) then begin //LNbr := GCadForm.PCad.ActiveLayer; //RemoveLayer := GCadForm.PCad.Layers.Items[LNbr]; if GCadForm.PCad.ActiveLayer = LNbr then {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8; {$else} GCadForm.CurrentLayer := 2; {$ifend} GCadForm.PCad.DeleteLayer(RemoveLayer.name); FSCS_Main.cbLayers.Properties.Items.Delete(LNbr - 1); F_LayersDialog.UpdateLayersList; F_LayersDialog.lbCurLayer.Caption := 'Base Layer'; F_LayersDialog.listGrayed.Delete(LNbr); // Tolik 30/08/2019 -- //F_LayersDialog.FIsManualGrayed.Delete(LNbr); F_LayersDialog.FIsManualGrayed.Delete(LNbr - 1); // if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else MessageBox(Application.Handle, cMain_Mes19_1, cMain_Mes1, MB_OK); end else begin if ActLayer = 0 then MessageBox(Application.Handle, cMain_Mes17, cMain_Mes1, MB_OK); if ActLayer = 1 then MessageBox(Application.Handle, cMain_Mes18, cMain_Mes1, MB_OK); if ActLayer = 2 then MessageBox(Application.Handle, cMain_Mes19, cMain_Mes1, MB_OK); if ActLayer = 3 then MessageBox(Application.Handle, cMain_Mes20, cMain_Mes1, MB_OK); if ActLayer = 4 then MessageBox(Application.Handle, cMain_Mes21, cMain_Mes1, MB_OK); if ActLayer = 5 then MessageBox(Application.Handle, cMain_Mes22, cMain_Mes1, MB_OK); if ActLayer = 6 then MessageBox(Application.Handle, cMain_Mes23, cMain_Mes1, MB_OK); if ActLayer = 7 then MessageBox(Application.Handle, cMain_Mes24, cMain_Mes1, MB_OK); if ActLayer = 8 then MessageBox(Application.Handle, cMain_Mes25, cMain_Mes1, MB_OK); if ActLayer = 9 then MessageBox(Application.Handle, cMain_Mes103, cMain_Mes1, MB_OK); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteLayerExecute', E.Message); end; end; // СОЕДИНИТЬ ВСЕ ВИДИМЫЕ СЛОИ В БАЗОВЫЙ procedure TFSCS_Main.aMergeVisibleExecute(Sender: TObject); begin try GCadForm.PCad.MergeVisibleLayers; F_LayersDialog.UpdateLayersList; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMergeVisibleExecute', E.Message); end; end; // СОЕДИНИТЬ ВСЕ СЛОИ В БАЗОВЫЙ procedure TFSCS_Main.aMergeAllExecute(Sender: TObject); begin try GCadForm.PCad.MergeAllLayers; F_LayersDialog.UpdateLayersList; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMergeAllExecute', E.Message); end; end; // НЕАКТИВНЫЕ СЛОИ КАК ПОДЛОЖКА procedure TFSCS_Main.aFlueInactivesExecute(Sender: TObject); var FlueLayer: TLayer; CurItem: TListItem; ActiveLNbr: integer; i: integer; begin try ActiveLNbr := GCadForm.PCad.ActiveLayer; for i := 1 to GCadForm.PCad.Layers.Count - 1 do begin FlueLayer := GCadForm.PCad.Layers.Items[i]; CurItem := F_LayersDialog.lvLayersList.Items[i - 1]; if i <> ActiveLNbr then // неактивные слои begin if FlueLayer.visible <> lost then begin FlueLayer.visible := grayed; CurItem.SubItemImages[1] := 137; end; end else // активный слой begin if FlueLayer.visible <> lost then begin FlueLayer.visible := seen; CurItem.SubItemImages[1] := -1; end; end; end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aFlueInactivesExecute', E.Message); end; end; // СКРЫТЬ НЕАКТИВНЫЕ СЛОИ procedure TFSCS_Main.aHideInactivesExecute(Sender: TObject); var HideLayer: TLayer; CurItem: TListItem; ActiveLNbr: integer; i: integer; begin try ActiveLNbr := GCadForm.PCad.ActiveLayer; for i := 1 to GCadForm.PCad.Layers.Count - 1 do begin HideLayer := GCadForm.PCad.Layers.Items[i]; CurItem := F_LayersDialog.lvLayersList.Items[i - 1]; if i <> ActiveLNbr then begin if HideLayer.visible = seen then F_LayersDialog.listGrayed[i] := 'seen'; if HideLayer.visible = grayed then F_LayersDialog.listGrayed[i] := 'grayed'; CurItem.SubItemImages[1] := -1; CurItem.SubItemImages[0] := -1; HideLayer.visible := lost; end else begin CurItem.SubItemImages[0] := 136; if F_LayersDialog.listGrayed[i] = 'seen' then HideLayer.visible := seen; if F_LayersDialog.listGrayed[i] = 'grayed' then begin HideLayer.visible := grayed; CurItem.SubItemImages[1] := 137; end; end; end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aHideInactivesExecute', E.Message); end; end; // ПОКАЗАТЬ ВСЕ СЛОИ procedure TFSCS_Main.aShowAllLayersExecute(Sender: TObject); var i: integer; ShowLayer: TLayer; CurItem: TListItem; begin try for i := 1 to GCadForm.PCad.Layers.Count - 1 do begin ShowLayer := GCadForm.PCad.Layers.Items[i]; CurItem := F_LayersDialog.lvLayersList.Items[i - 1]; CurItem.SubItemImages[0] := 136; if (F_LayersDialog.listGrayed[i] = 'seen') or (F_LayersDialog.listGrayed[i] = 'lost') then ShowLayer.visible := seen; if F_LayersDialog.listGrayed[i] = 'grayed' then begin ShowLayer.visible := grayed; CurItem.SubItemImages[1] := 137; end; end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowAllLayersExecute', E.Message); end; end; //////////////////////////////////////////////////////////////////////////////// /////-------------- РАБОТА С КАД ----------------------------------------/////// //Tolik 09/02/2021 -- { procedure TFSCS_Main.aToolOrthoLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FContinueTrace := False; aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := False; GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := False; GCurrentConnectorType := ct_Clear; GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; } procedure TFSCS_Main.aToolOrthoLineExecute(Sender: TObject); var NotSCSLayer: Boolean; begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 DropDownFirstToolbar; // Tolik 27/09/2021 -- {$IF Defined(ES_GRAPH_SC)} NotSCSLayer := (GCadForm.CurrentLayer <> 8); {$else} NotSCSLayer := (GCadForm.CurrentLayer <> 2); {$ifend} GCadForm.FContinueTrace := False; GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := False; GCurrentConnectorType := ct_Clear; if NotSCSLayer then begin aSetSCSLayer.Execute; tbToolOrtholineNoob.Click; tbToolOrtholineNoob.Down := True; end else //Tolik 27/09/2021 - - // GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); begin GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); if tbCADToolsExpert.Visible then // Tolik 04/02/2022 -- tbToolOrtholineExpert.Down := True else tbToolOrtholineNoob.Down := True; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; { procedure TFSCS_Main.aToolOrtholineExtExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FContinueTrace := False; aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := False; GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := True; GCurrentConnectorType := ct_Clear; GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; } procedure TFSCS_Main.aToolOrtholineExtExecute(Sender: TObject); var NotSCSLayer: Boolean; begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 {$IF Defined(ES_GRAPH_SC)} NotSCSLayer := (GCadForm.CurrentLayer <> 8); {$else} NotSCSLayer := (GCadForm.CurrentLayer <> 2); {$ifend} GCadForm.FContinueTrace := False; GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := True; GCurrentConnectorType := ct_Clear; if NotSCSLayer then begin aSetSCSLayer.Execute; tbToolOrtholineExtNoob.Click; tbToolOrtholineExtNoob.Down := True; //tbSelect.Down := False; end else GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // procedure TFSCS_Main.aDisconnectExecute(Sender: TObject); var DisConnectFigure: TConnectorObject; // Tolik 03/10/2016 -- SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GPopupFigure = nil then exit; DisConnectFigure := TConnectorObject(GPopupFigure); if CheckCannotDelete(GPopupFigure) then Exit; DisConnectFigure.Deselect; //// если конектор пустой /////////////////////// if DisConnectFigure.ConnectorType = Ct_Clear then begin if (DisConnectFigure.JoinedOrtholinesList.Count = 2) and (DisConnectFigure.FConnRaiseType = crt_None) and (GetRaiseConn(DisConnectFigure) = nil) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; DisconnectConn(DisConnectFigure); // *UNDO* GCadForm.FCanSaveForUndo := True; end else GCadForm.mProtocol.Lines.Add(cMain_Mes26); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectExecute', E.Message); end; // GCadForm.FCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.aDivideLineExecute(Sender: TObject); var i: integer; FFigure: TFigure; SelectedList: TList; // Tolik -- 03/10/2016-- SavedUndoFlag: Boolean; // begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin SavedUndoFlag := GCadForm.FCanSaveForUndo; BeginProgress; try SelectedList := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do SelectedList.Add(TFigure(GCadForm.PCad.Selection[i])); // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if not TOrthoLine(GPopupFigure).FConnectingLine then DivideLine(TOrthoLine(GPopupFigure)); for i := 0 to SelectedList.Count - 1 do begin FFigure := TFigure(SelectedList[i]); if CheckFigureByClassName(FFigure, cTOrthoLine) then if FFigure <> GPopupFigure then if not TOrthoLine(FFigure).FIsRaiseUpDown then if not TOrthoLine(GPopupFigure).FConnectingLine then DivideLine(TOrthoLine(FFigure)); end; // *UNDO* GCadForm.FCanSaveForUndo := True; if SelectedList <> nil then FreeAndNil(SelectedList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDivideLineExecute', E.Message); end; EndProgress; // GCadForm.FCanSaveForUndo := SavedUndoFlag; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aSetSubstrateLayerExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try GCadForm.CurrentLayer := 1; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSubstrateLayerExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aSetSCSLayerExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin try {$IF Defined(ES_GRAPH_SC)} GCadForm.CurrentLayer := 8; {$else} GCadForm.CurrentLayer := 2; {$ifend} // Tolik 10/11/2017 -- если это не сделать, то указатель мышки может остаться в виде "ручки", режим не переключится // и если пользователь до этого таскал подложку, то с таким же успехом сможет таскать компоненты, но они тогда херово перерисовываются if tbCADToolsExpert.Visible then begin tbSelectExpert.Click; tbSelectExpert.Down := True; tbCreateOnClickModeExpert.Down := False; end else begin tbSelectNoob.Click; tbSelectNoob.Down := True; tbCreateOnClickModeNoob.Down := False; end; // except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSCSLayerExecute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aSetDefaultColorsExecute(Sender: TObject); begin if TF_CAD(ActiveMDIChild) <> nil then begin try GCadForm.PCad.DefaultPenColor := clBlack; GCadForm.PCad.DefaultBrushColor := clBlack; GCadForm.PCad.Font.Color := clBlack; GCadForm.PCad.GridColor := clSilver; GCadForm.PCad.GuideColor := clGreen; GCadForm.PCad.PageColor := clWhite; GCadForm.PCad.BackGround := clGray; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDefaultColorsExecute', E.Message); end; end; end; // ИЗМЕНИТЬ ПАРАМЕТРЫ ОРТОЛИНИИ procedure TFSCS_Main.aChangeOrtoParamsExecute(Sender: TObject); var itLine: TOrthoLine; ReplaceLine: TOrthoLine; Joined1, Joined2: TConnectorObject; i: integer; begin try itLine := TOrthoLine(GCadForm.PCad.Selection[0]); GDefaultGap := itLine.FGap; GDefaultNum := itLine.FCount; F_OrthoLineParams.ShowModal; GCadForm.PCad.SetTool(toSelect, 'TSelected'); // преобразование мультилинии в мультилинию if (itLine.FCount <> 1) AND (GDefaultNum <> 1) then begin itLine.FCount := GDefaultNum; itLine.FGap := GDefaultGap; end; // преобразование одиночной в мультилинию if (itLine.FCount = 1) AND (GDefaultNum <> 1) then begin Joined1 := TConnectorObject(itLine.JoinConnector1); Joined2 := TConnectorObject(itLine.JoinConnector2); TOrthoLine(itLine).create(Joined1.ActualPoints[1].x, Joined1.ActualPoints[1].y, Joined1.ActualZOrder[1], Joined2.ActualPoints[1].x, Joined2.ActualPoints[1].y, Joined2.ActualZOrder[1], 1, ord(psSolid), clBlack, 0, Joined1.LayerHandle, mydsNormal, GCadForm.PCad); TText(TOrthoLine(itLine).MultilineCaptionBox).Text := TOrthoLine(itLine).SaveCaption; end; // преобразование мультилинии в одиночную if (GDefaultNum = 1) AND (itLine.FCount <> 1) then begin Joined1 := TConnectorObject(itLine.JoinConnector1); Joined2 := TConnectorObject(itLine.JoinConnector2); TOrthoLine(itLine).SaveCaption := TTextMod(TOrthoLine(itLine).MultilineCaptionBox).Text; TTextMod(TOrthoLine(itLine).MultilineCaptionBox).Delete; TOrthoLine(itLine).create(Joined1.ActualPoints[1].x, Joined1.ActualPoints[1].y, Joined1.ActualZOrder[1], Joined2.ActualPoints[1].x, Joined2.ActualPoints[1].y, Joined2.ActualZOrder[1], 1, ord(psSolid), clBlack, 0, Joined1.LayerHandle, mydsNormal, GCadForm.PCad); end; itLine.FGap := GDefaultGap; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aChangeOrtoParamsExecute', E.Message); end; end; procedure TFSCS_Main.FormClose(Sender: TObject; var Action: TCloseAction); var Rect: TRect; Status: TMemoryStatus; i: integer; MessageResult: integer; begin {$if Defined(ES_GRAPH_SC)} try SaveAutoShowPanel(F_FloatPanel.Visible); except end; if Assigned(GSCStream) then begin if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then begin MessageResult := IDNO; MessageResult := MessageModal('Передать проект "' + F_ProjMan.GSCSBase.CurrProject.GetNameForVisible + '" в сметную программу?', ApplicationName, MB_ICONQUESTION or MB_YESNO); if MessageResult = IDYES then begin try ExpProjToStroyCalcStream(F_ProjMan.GSCSBase.CurrProject, GSCStream); except GSCStream.Clear; end; end; end; end; if CloseCurrProject(true) = IDCANcel then begin if Assigned(GSCStream) then GSCStream.Clear; Action := caNone; ModalResult := mrCancel; Exit; end; Action := caHide; ModalResult := mrOk; {$else} try SaveAutoShowPanel(F_FloatPanel.Visible); except end; {if aExpertMode.Checked then GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := True else GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := False;} if CloseCurrProject(true) = IDCANcel then begin Action := caNone; Exit; end; try Rect.Left := 0; Rect.Top := 0; if Assigned(F_Navigator) then if F_Navigator <> nil then begin try F_Navigator.PCadNavigator.Figures.Clear; except end; FreeAndNil(F_Navigator); end; if Assigned(F_ProjMan) then if F_ProjMan <> nil then begin try F_ProjMan.ManualFloat(Rect); FreeAndNil(F_ProjMan); except end; end; if Assigned(F_Normbase) then if F_NormBase <> nil then begin F_NormBase.ManualFloat(Rect); FreeAndNil(F_NormBase); end; if Assigned(F_Progress) then FreeAndNil(F_Progress); if Assigned(F_BlockEditor) then FreeAndNil(F_BlockEditor); if Assigned(F_AutoTraceType) then FreeAndNil(F_AutoTraceType); if Assigned(F_RaiseHeight) then FreeAndNil(F_RaiseHeight); // GExitProgEx := True; // if Assigned(F_MasterNewList) then FreeAndNil(F_MasterNewList); if Assigned(F_InterfacesAutoTrace) then FreeAndNil(F_InterfacesAutoTrace); if Assigned(F_SCSObjectsProp) then FreeAndNil(F_SCSObjectsProp); if Assigned(F_LoadColor) then FreeAndNil(F_LoadColor); if Assigned(F_OrthoLineParams) then FreeAndNil(F_OrthoLineParams); if Assigned(F_SizePos) then FreeAndNil(F_SizePos); if Assigned(F_NewLayer) then FreeAndNil(F_NewLayer); if Assigned(F_GridStep) then FreeAndNil(F_GridStep); if Assigned(F_Scale) then FreeAndNil(F_Scale); if Assigned(F_IncOn) then FreeAndNil(F_IncOn); if Assigned(F_LayersDialog) then FreeAndNil(F_LayersDialog); if Assigned(F_ComponDesignWizard) then FreeAndNil(F_ComponDesignWizard); if Assigned(F_PrintLists) then FreeAndNil(F_PrintLists); if Assigned(FSCS_Main) then begin FSCS_Main.ActionManager.Free; // FreeAndNil(FSCS_Main); end; if Assigned(FPMItemsRoofHipTypes) then FreeAndNil(FPMItemsRoofHipTypes); try FreeLibrary(Newshandle); except end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.FormClose', E.Message); end; try SetInternationalSettingsToRegistry(GGlobalInternationalSettings); except end; if IsVista then begin {$if Not Defined(ES_GRAPH_SC)} ExitProcess(0); {$ifend} end; for i := 0 to 10000 do Application.ProcessMessages; Status.dwLength := sizeof(TMemoryStatus); GlobalMemoryStatus(Status); if Status.dwMemoryLoad >= 70 then begin {$if Not Defined(ES_GRAPH_SC)} Application.Terminate; {$ifend} end; {$ifend} end; procedure TFSCS_Main.aFreeRotateExecute(Sender: TObject); var SelFigure: TFigure; oldGrpSizex, OldGrpSizeY: Double; BndRect: TDoubleRect; RestoreTConnectorObjectBouns: Boolean; //Tolik -- 18/10/2017 function CheckHasAutoCreated(aPointObject: TConnectorObject): boolean; var i: Integer; function HasAutoCreated(aFigure: TFigureGrp): Boolean; var i: Integer; inFigure: TFigure; begin Result := False; for i := 0 to aFigure.InFigures.count - 1 do begin inFigure := TFigure(aFigure.InFigures[i]); if inFigure is TFigureGrp then Result := HasAutoCreated(TFigureGrp(inFigure)) else if (inFigure.isAutoCreatedFigure = biTrue) then Result := True; if Result then break; end; end; begin Result := False; if Assigned(aPointObject.DrawFigure) then begin Result := HasAutoCreated(aPointObject.DrawFigure); end; end; begin RestoreTConnectorObjectBouns := False; if ActiveMDIChild <> nil then begin if GCadForm.PCad.Selection.Count > 0 then begin try SelFigure := TFigure(GCadForm.PCad.Selection[0]); if (not CheckFigureByClassName(SelFigure, cTCabinet)) and (not CheckFigureByClassName(SelFigure, cTCabinetExt)) then begin GCadForm.PCad.SetTool(toSelect, 'TFigure'); // Tolik 04/09/2017 -- if CheckFigureByClassName(SelFigure, cTConnectorObject) then begin if CheckHasAutoCreated(TConnectorObject(SelFigure)) then begin RestoreTConnectorObjectBouns := True; oldGrpSizex := TConnectorObject(SelFigure).GrpSizeX; OldGrpSizeY := TConnectorObject(SelFigure).GrpSizeY; TFigureGrp(TConnectorObject(SelFigure).DrawFigure).BoundCalc := False; BndRect := TConnectorObject(SelFigure).DrawFigure.GetBoundRectWithoutAutoCreatedFigures; TConnectorObject(SelFigure).GrpSizeX := BndRect.Right - BndRect.Left; TConnectorObject(SelFigure).GrpSizeY := BndRect.Bottom - BndRect.Top; end; end; // SelFigure.RotateSelect; // Tolik 18/10/2017 -- if RestoreTConnectorObjectBouns then //if CheckFigureByClassName(SelFigure, cTConnectorObject) then begin TConnectorObject(SelFigure).GrpSizeX := oldGrpSizex; TConnectorObject(SelFigure).GrpSizeY := OldGrpSizeY; end; RefreshCAD(GCadForm.PCad); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aFreeRotateExecute', E.Message); end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.RegisteredHotKeys; var GLogFile: TMyLoglist; begin end; procedure TFSCS_Main.UnRegisteredHotKeys; var GLogFile: TMyLoglist; begin end; procedure TFSCS_Main.aRegHotKeysExecute(Sender: TObject); begin GAppMinim := False; RegisteredHotKeys; if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin if (GCadForm.CurrentLayer >= 0) and (GCadForm.CurrentLayer <= 1) then UnRegisteredCADHotKeys; if (GCadForm.CurrentLayer >= 2) and (GCadForm.CurrentLayer <= 7) then RegisteredCADHotKeys; end; end; procedure TFSCS_Main.aUnregHotKeysExecute(Sender: TObject); begin UnRegisteredHotKeys; UnRegisteredCADHotKeys; end; procedure TFSCS_Main.aAutoSelectTraceExecute(Sender: TObject); begin if aAutoSelectTrace.Checked = True then begin GCadForm.FAutoSelectTrace := True; if GEndPoint = nil then begin ShowMessage(cMain_Mes27); end; end; if aAutoSelectTrace.Checked = False then GCadForm.FAutoSelectTrace := False; end; procedure TFSCS_Main.aServerAsDefaultExecute(Sender: TObject); var Server: TFigure; EndPoint: TFigure; begin {//18.06.2013 try if GPopupFigure = nil then exit; try EndPoint := GPopupFigure; if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then TConnectorObject(EndPoint).AsEndPoint := True else if CheckFigureByClassName(GPopupFigure, cTHouse) then THouse(EndPoint).AsEndPoint := True; if EndPoint = GEndPoint then Exit; except EndPoint := Nil; end; // сбросить бывший КО if GEndPoint <> nil then begin if CheckFigureByClassName(GEndPoint, cTConnectorObject) then TConnectorObject(GEndPoint).AsEndPoint := False else if CheckFigureByClassName(GEndPoint, cTHouse) then THouse(GEndPoint).AsEndPoint := False; if (GListWithEndPoint <> GCadForm) and (GListWithEndPoint <> nil) then begin RefreshCAD(GListWithEndPoint.PCad); RefreshCAD(GListWithEndPoint.PCad); end; RefreshCAD(GCadForm.PCad); GListWithEndPoint := Nil; end; RefreshCAD(GCadForm.PCad); GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes2); // переназначить новый GEndPoint := EndPoint; GListWithEndPoint := GCadForm; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aServerAsDefaultExecute', E.Message); end;} SetFigureAsEndObject(GCadForm, GPopupFigure); end; procedure TFSCS_Main.sDiv1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin try Accept := CanResizePanelForm(F_ProjMan, NewSize - PDock1.Width); if Accept then if ActiveMDIChild <> nil then begin GCadForm.PCad.AutoRefresh := False; GCadForm.FCurrPCadScrollX := GCadForm.PCad.HSCBarPosition; GCadForm.FCurrPCadScrollY := GCadForm.PCad.VSCBarPosition; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.sDiv1CanResize', E.Message); end; end; procedure TFSCS_Main.sDiv2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin try Accept := CanResizePanelForm(F_NormBase, NewSize - PDock2.Width); if Accept then begin if ActiveMDIChild <> nil then begin if GCadForm.PCad <> nil then begin GCadForm.PCad.AutoRefresh := False; GCadForm.FCurrPCadScrollX := GCadForm.PCad.HSCBarPosition; GCadForm.FCurrPCadScrollY := GCadForm.PCad.VSCBarPosition; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.sDiv2CanResize', E.Message); end; end; procedure TFSCS_Main.sDiv1Moved(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.AutoRefresh := True; end; end; procedure TFSCS_Main.sDiv2Moved(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.PCad.AutoRefresh := True; end; end; procedure TFSCS_Main.aRealignLineExecute(Sender: TObject); // Tolik 03/10/2016-- var SavedUndoFlag: Boolean; // begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; ReAlignLine(TOrthoLine(GPopupFigure)); RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRealignLineExecute', E.Message); end; // GCadForm.FCanSaveForUndo := SavedUndoFlag; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean); var KeyState: TKeyboardState; CurrPos: TPoint; CurrPos1: TPoint; Pt: TPoint; Res1: TWinControl; Hand: THandle; begin Handled := False; if not Application.Active then begin inherited; exit; end; if (Msg.message = 0) then begin inherited; exit; end; try if (Msg.message = WM_MOUSEWHEEL) then try GetCursorPos(Pt); Hand := WindowFromPoint(Pt); Res1 := Nil; Res1 := FindControl(Hand); try if Res1.Parent.Name = 'PCad' then begin if (GCadForm.PCad.ToolIdx = toSelect) and (GCadForm.PCad.SelectedCount = 0) then begin if tbCADToolsExpert.Visible then cbScaleExpert.SetFocus else cbScaleNoob.SetFocus; SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0); RefreshCAD_T(GCadForm.PCad); end; end; except end; if ActiveControl <> nil then begin if (ActiveControl.ClassName = 'TcxCustomComboBoxInnerEdit') or (ActiveControl.ClassName = 'TPanel') then begin Handled := True; exit; end else begin inherited; exit; end; end; except inherited; exit; end; if msg.message = WM_Syscommand then begin if msg.wParam = SC_CLOSE then begin if GCadForm = nil then inherited else Handled := True; exit; end; end; if (GCadForm = nil) or (GCadForm.PCad = nil) then begin inherited; Exit; end else begin if msg.message = wm_MouseWheel then begin try CurrPos := GCadForm.ClientToScreen(Point(GCadForm.VerScroll.Left, GCadForm.VerScroll.Top)); CurrPos1 := GCadForm.ClientToScreen(Point(GCadForm.VerScroll.Left + GCadForm.VerScroll.Width, GCadForm.VerScroll.Top + GCadForm.VerScroll.Height)); // VerScroll if (CurrPos.Y < Mouse.CursorPos.Y) And (CurrPos.X < Mouse.CursorPos.X) And (CurrPos1.Y > Mouse.CursorPos.Y) And (CurrPos1.X > Mouse.CursorPos.X) then begin if 120 - HIWORD(Msg.wParam) < 0 then begin if (GCadForm.VerScroll.Position + ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)) < GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize then GCadForm.VerScroll.Position := GCadForm.VerScroll.Position + ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10) else GCadForm.VerScroll.Position := GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize + 1; end else begin if (GCadForm.VerScroll.Position - ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)) > GCadForm.VerScroll.Min then GCadForm.VerScroll.Position := GCadForm.VerScroll.Position - ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10) else GCadForm.VerScroll.Position := GCadForm.VerScroll.Min; end; GCadForm.Set_PCad_VerScroll; end // HorScroll else begin CurrPos := GCadForm.ClientToScreen(Point(GCadForm.HorScroll.Left, GCadForm.HorScroll.Top)); CurrPos1 := GCadForm.ClientToScreen(Point(GCadForm.HorScroll.Left + GCadForm.HorScroll.Width, GCadForm.HorScroll.Top + GCadForm.HorScroll.Height)); if (CurrPos.Y < Mouse.CursorPos.Y) And (CurrPos.X < Mouse.CursorPos.X) And (CurrPos1.Y > Mouse.CursorPos.Y) And (CurrPos1.X > Mouse.CursorPos.X) then begin if 120 - HIWORD(Msg.wParam) < 0 then begin if (GCadForm.HorScroll.Position + ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)) < GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize then GCadForm.HorScroll.Position := GCadForm.HorScroll.Position + ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10) else GCadForm.HorScroll.Position := GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize + 1; end else begin if (GCadForm.HorScroll.Position - ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)) > GCadForm.HorScroll.Min then GCadForm.HorScroll.Position := GCadForm.HorScroll.Position - ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10) else GCadForm.HorScroll.Position := GCadForm.HorScroll.Min; end; GCadForm.Set_PCad_HorScroll; end; end; Handled := True; exit; except inherited; exit; end; end; end; try if Assigned(GCadForm) then if GCadForm.FWaitWork then begin Handled := True; exit; end else begin inherited; exit; end; except inherited; exit; end; inherited; exit; except inherited; // on E: Exception do addExceptionToLogEx('TFSCS_Main.ApplicationEvents1Message', E.Message); end; end; procedure TFSCS_Main.aNotAsServerDefaultExecute(Sender: TObject); var EndPoint: TFigure; begin try if GPopupFigure = nil then exit; try EndPoint := GPopupFigure; except EndPoint := nil; end; // сбросить КО if CheckFigureByClassName(EndPoint, cTConnectorObject) then TConnectorObject(EndPoint).AsEndPoint := False else if CheckFigureByClassName(EndPoint, cTHouse) then THouse(EndPoint).AsEndPoint := False; GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes3); GEndPoint := Nil; GListWithEndPoint := Nil; RefreshCAD(GCadForm.PCad); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNotAServerDefaultExecute', E.Message); end; end; procedure TFSCS_Main.aSelectTracetoServerExecute(Sender: TObject); var RaiserThisList: TConnectorObject; RaiserOtherList: TConnectorObject; CurrentWS: TConnectorObject; CurrentServer: TConnectorObject; AllTrace: TList; i, j, k: integer; CurGCadForm: TF_CAD; isTrace: boolean; RaiseType: TConnRaiseType; ListOfLists: TIntList; ListOfRaises: TList; CurrentCAD: TF_CAD; ConnFrom: TConnectorObject; ConnTo: TConnectorObject; PrevConn: TConnectorObject; PrevCAD: TF_CAD; ListOfAllTraces: TList; EndPoint: TConnectorObject; TracesLength: Double; procedure SelectObjects; var i: Integer; Figure: TFigure; begin // Tolik -- 08/02/2017 -- if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; // if AllTrace <> nil then begin // Tolik -- 08/02/2017 -- // GCadForm.FTracingList := TList.Create; for i := 0 to AllTrace.Count - 1 do begin Figure := TFigure(AllTrace[i]); GCadForm.FTracingList.Add(Figure); Figure.Select; if CheckFigureByClassName(Figure, TOrthoLine.ClassName) then TracesLength := TracesLength + TOrtholine(Figure).LineLength; end; end; // Tolik -- 08/02/2017 -- // else // GCadForm.FTracingList := TList.Create; // // Tolik -- 27/04/2017 -- GCadForm.PCad.Refresh; // end; begin // Tolik 08/02/2017 -- ListOfRaises := Nil; ListOfLists := nil; // Tolik 21/05/2018 -- // try CurrentServer := nil; //#From Oleg# //14.09.2010 try CurrentWS := TConnectorObject(CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y)); except CurrentWS := Nil; end; if CurrentWS = nil then begin if GPopupFigure <> nil then CurrentWS := TConnectorObject(GPopupFigure) else Exit; end; // *** if CheckFigureByClassName(GEndPoint, cTConnectorObject) then CurrentServer := TConnectorObject(GEndPoint) else if CheckFigureByClassName(GEndPoint, cTHouse) then CurrentServer := GetEndPointByHouse(THouse(GEndPoint), CurrentWS); // *** if (CurrentServer = nil) or (CurrentWS = nil) or (not CheckFigureByClassName(CurrentWS, cTConnectorObject)) then Exit; if (GCadForm.FIsDragOver) and (GFigureSnap <> nil) then begin end else begin BeginProgress('', 1, true); F_Progress.BringToFront; end; try AllTrace := nil; ListOfAllTraces := nil; TracesLength := 0; GCadForm.FDeselectUpDown := True; // в пределах одного листа if GListWithEndPoint = GCadForm then begin //Tolik // ListOfAllTraces := GetAllTraceInCADByMarked_New(CurrentServer, CurrentWS); // ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS); // ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS); // if ((GetKeyState(VK_SHIFT) and 128) = 128) then ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS) else ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS); if ListOfAllTraces.Count > 0 then begin if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then GCadForm.FTracingListIndex := 0; //Tolik 09/10/2017 -- // AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; AllTrace := TList.Create; // проверочка -- на всякий -- if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy); // {//08.08.2012 if AllTrace <> nil then begin GCadForm.FTracingList := TList.Create; for k := 0 to AllTrace.Count - 1 do GCadForm.FTracingList.Add(AllTrace[k]); for i := 0 to AllTrace.Count - 1 do TFigure(AllTrace[i]).Select; end else GCadForm.FTracingList := TList.Create;} SelectObjects; FreeAndNil(AllTrace); end else // Tolik -- 08/02/2017 -- // GCadForm.FTracingList := TList.Create; begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; // end else if GListWithEndPoint <> nil then begin RaiseType := crt_OnFloor; //#From Oleg# //14.09.2010 // другой лист с КО if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then RaiseType := crt_BetweenFloorDown; if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then RaiseType := crt_BetweenFloorUp; ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID); if ListOfLists.Count >= 2 then begin ListOfRaises := GetSortedListOfRaisesFromCurr(ListOfLists, RaiseType, CurrentWS, CurrentServer); if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then begin PrevCAD := nil; PrevConn := nil; for i := 0 to ListOfLists.Count - 1 do begin CurrentCAD := GetListByID(ListOfLists[i]); // взять найденный м-э с-п if i < ListOfLists.Count - 1 then begin ConnTo := TConnectorObject(ListOfRaises[i]); end else begin ConnTo := CurrentServer; end; CurGCadForm := GCadForm; GCadForm := CurrentCAD; if i = 0 then begin ConnFrom := CurrentWS; end else begin ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage)); end; ListOfAllTraces := GetAllTraceInCADByMarked(ConnTo, ConnFrom{ConnFrom, ConnTo}); if ListOfAllTraces.Count > 0 then begin if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then GCadForm.FTracingListIndex := 0; // Tolik 09/02/2017 -- //AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; AllTrace := TList.Create; // проверочка -- на всякий -- if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy); // {//08.08.2012 if AllTrace <> nil then begin GCadForm.FTracingList := TList.Create; for k := 0 to AllTrace.Count - 1 do GCadForm.FTracingList.Add(AllTrace[k]); for j := 0 to AllTrace.Count - 1 do TFigure(AllTrace[j]).Select; GCadForm := CurGCadForm; PrevCAD := CurrentCAD; PrevConn := ConnTo; end else GCadForm.FTracingList := TList.Create;} SelectObjects; // Tolik 21/02/2017 -- //if AllTrace <> nil then if AllTrace.Count > 0 then begin GCadForm := CurGCadForm; PrevCAD := CurrentCAD; PrevConn := ConnTo; end; FreeAndNil(AllTrace); end else // Tolik -- 08/02/2017 -- //GCadForm.FTracingList := TList.Create; begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; end; end; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfRaises <> nil then FreeAndNil(ListOfRaises); end; // Tolik 21/02/2017 -- //if AllTrace <> nil then if TracesLength > 0 then // begin GCadForm.sbView.Panels[1].Text := GCadForm.GetMsgLengthToPoint(TracesLength); //FreeAndNil(AllTrace); end; // Tolik 09/02/2017 -- здесь ListOfAllTraces -- список, который содержит списки, поэтому нужно освободить // еще и ту память, которую занимает каждый из них //if ListOfAllTraces <> nil then // FreeAndNil(ListOfAllTraces); if ListOfAllTraces <> nil then begin for i := 0 to ListOfAllTraces.Count - 1 do begin // Tolik 21/02/2017 -- if TList(ListOfAllTraces[i]) <> nil then // TList(ListOfAllTraces[i]).Free; end; FreeAndNil(ListOfAllTraces); end; // except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectTracetoServerExecute0', E.Message); end; if (GCadForm.FIsDragOver) and (GFigureSnap <> nil) then begin end else EndProgress; RefreshCAD(GCadForm.PCad); if GListWithEndPoint <> nil then begin RefreshCAD(GListWithEndPoint.PCad); end; GCadForm.FDeselectUpDown := false; //Tolik //DragState := dsNone; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectTracetoServerExecute', E.Message); end; end; procedure TFSCS_Main.aMakeCablingExecute(Sender: TObject); var CablingObj: TConnectorObject; CurrLine: TOrthoLine; i: integer; isMaked: Boolean; ptrInterfRecord: PConnectObjectParam; ParamsList: TList; begin try if GPopupFigure = nil then exit; try CablingObj := TConnectorObject(GPopupFigure); except CablingObj := nil; end; ParamsList := TList.Create; for i := 0 to CablingObj.JoinedOrtholinesList.Count - 1 do begin CurrLine := TOrthoLine(CablingObj.JoinedOrtholinesList[i]); New(ptrInterfRecord); ptrInterfRecord.IDObject := CurrLine.ID; if CurrLine.JoinConnector1 = CablingObj then ptrInterfRecord.Side := 1; if CurrLine.JoinConnector2 = CablingObj then ptrInterfRecord.Side := 2; ParamsList.Add(ptrInterfRecord); end; MakeCablingInPM(ParamsList, True); // Tolik 09/02/2017 -- освободить память for i := 0 to ParamsList.Count - 1 do Dispose(PConnectObjectParam(ParamsList[i])); // FreeAndNil(ParamsList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMakeCablingExecute', E.Message); end; end; procedure TFSCS_Main.aCreateRaiseExecute(Sender: TObject); var RaiseOnFigure: TConnectorObject; RaiseHeight: Double; // Tolik SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GPopupFigure = nil then exit; try RaiseOnFigure := TConnectorObject(GPopupFigure); except RaiseOnFigure := nil; end; F_RaiseHeight.cbApplyToAll.Visible := False;//Tolik 04/08/2021 -- F_RaiseHeight.Caption := cMain_Mes28; F_RaiseHeight.lbMessage.Caption := cMain_Mes29; // на соединителе if RaiseOnFigure.ConnectorType = ct_Clear then begin if F_RaiseHeight.Showmodal = mrOK then begin RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseHeight > GCadForm.FRoomHeight then RaiseHeight := GCadForm.FRoomHeight; if RaiseHeight <> RaiseOnFigure.ActualZOrder[1] then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; CreateRaiseOnConnector(RaiseOnFigure, RaiseHeight); // *UNDO* GCadForm.FCanSaveForUndo := True; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else GCadForm.mProtocol.Lines.Add(cMain_Mes30); end; end else // на объекте begin if RaiseOnFigure.JoinedConnectorsList.Count > 0 then begin if F_RaiseHeight.Showmodal = mrOK then begin RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseHeight <> RaiseOnFigure.ActualZOrder[1] then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; // Tolik 17/03/2017 -- //CreateRaiseOnPointObject(RaiseOnFigure, RaiseHeight); CreateRaiseOnPointObjectNew(RaiseOnFigure, RaiseHeight); // if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end else GCadForm.mProtocol.Lines.Add(cMain_Mes30); end; end else GCadForm.mProtocol.Lines.Add(cMain_Mes31); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateRaiseExecute', E.Message); end; //GCadForm.FCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.aDestroyRaiseExecute(Sender: TObject); var RaiseConn: TConnectorObject; RaiseLine: TOrtholine; RaiseOnFigure: TConnectorObject; vList: TF_CAD; vLists: TList; // Tolik -- 03/10/2016-- SavedUndoFlag : Boolean; // begin // Tolik -- 09/02/2017 -- vLists := nil; // SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GPopupFigure = nil then exit; try RaiseOnFigure := TConnectorObject(GPopupFigure); except RaiseOnFigure := nil; end; // определить тип с-п RaiseConn := GetRaiseConn(RaiseOnFigure); if RaiseConn <> nil then begin if RaiseOnFigure.ConnectorType = ct_Clear then begin // *UNDO* if RaiseConn.FConnRaiseType = crt_OnFloor then GCadForm.SaveForUndo(uat_None, True, False) else begin vLists := TList.Create; vLists.Add(GCadForm); vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then vLists.Add(vList); SaveForProjectUndo(vLists, True, False); end; DestroyRaiseOnConnector(RaiseOnFigure); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else begin // *UNDO* if RaiseConn.FConnRaiseType = crt_OnFloor then GCadForm.SaveForUndo(uat_None, True, False) else begin vLists := TList.Create; vLists.Add(GCadForm); vList := GetListByID(RaiseConn.FID_ListToPassage); if vList <> nil then vLists.Add(vList); SaveForProjectUndo(vLists, True, False); end; DestroyRaiseOnPointObject(RaiseOnFigure); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; // Tolik 09/02/2017 -- if vLists <> nil then FreeAndNil(vLists); // end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDestroyRaiseExecute', E.Message); end; //GCadForm.FCanSaveForUndo := SavedUndoFlag; end; // Tolik -- 31/05/2016 -- function GetFigureByCatalogId(CatalogId: Integer): TFigure; var i: Integer; begin Result := nil; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]).ID = CatalogId then begin Result := TFigure(GCadForm.FSCSFigures[i]); break; end; end; end; Procedure ConnectCableComponents(ACompon1, ACompon2: TSCSComponent); var LineCatalog1, LineCatalog2 : TSCSCatalog; SelfSide, JoinSide : integer; Line1, Line2: TOrthoLine; function CheckCanJoinOnConnectors(aConn1, aConn2: TConnectorObject): Boolean; begin Result := False; // если на одном точечном if (aConn1.JoinedConnectorsList.Count > 0) and (TConnectorObject(aConn1.JoinedConnectorsList[0]).JoinedConnectorsList.IndexOf(aConn2) <> -1) then Result := True else // или это один и тот же коннектор if aConn1.ID = aConn2.ID then Result := True; end; begin LineCatalog1 := ACompon1.GetFirstParentCatalog; LineCatalog2 := ACompon2.GetFirstParentCatalog; if ((LineCatalog1 <> nil) and (LineCatalog2 <> nil)) then begin Line1 := TOrthoLine(GetFigureByCatalogId(LineCatalog1.SCSId)); Line2 := TOrthoLine(GetFigureByCatalogId(LineCatalog2.SCSId)); if ((Line1 <> nil) and (Line2 <> nil)) then begin SelfSide := 0; JoinSide := 0; if (ACompon1 <> nil) and (ACompon2 <> nil) then begin if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector1)) then ACompon1.JoinTo(ACompon2, 1, 1) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector2)) then ACompon1.JoinTo(ACompon2, 1, 2) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector1)) then ACompon1.JoinTo(ACompon2, 2, 1) else if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector2)) then ACompon1.JoinTo(ACompon2, 2, 2); end; end; end; end; // // procedure TFSCS_Main.aRaiseLineExecute(Sender: TObject); procedure TFSCS_Main.RaiseSelectedLine(aToHeight: double = -1); var i, j: integer; RaiseHeight: Double; RaiseLine: TOrthoLine; FFigure: TFigure; SelectedList: TList; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // // Tolik NB_Conn: TConnectorObject; SavedTraceList, SavedLineList: TList; SavedComponList: TList; SavedLineConnectionsList: TList; // Список динейных соединений SavedPointConnectionsList: TList; // Список соединеннй с точечными объектами SelfLineConnectInfo, JoinedLineConnectInfo: TLineComponConnectionInfo; // SavedLineComponList, SavedPointComponList, TempLineList: TList; DivLineObject, JoinedPointObject: TSCSCatalog; PointCompon: TSCSComponent; NBConnector: TConnectorObject; InterfRel : TSCSIOfIRel; InterfPosition, JoinedPosition: TSCSInterfPosition; LineCompon: TSCSComponent; ALineInterFace, APointInterFace, aTempInterf: TSCSInterface; LineInterfList: TList; ConnComponList: TList; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; LineComponInterFace, PointComponInterFace: TSCSInterFace; InterFaceAccordanceList: TList; APointInterfID: Integer; ConnectedInterFaces: TSCSIOfIRel; ConnectIDCompRel: Integer; TempInterfaces1, TempInterfaces2: TSCSInterfaces; InterfCount: Integer; ptrConnection: PComplect; DisJoinList: TList; ComponToDeleteList: TSCSComponents; SavedUndoFlag: Boolean; // 03/10/2016 -- Tolik ProgressChecked: Boolean; CanRefreshCadFlag: Boolean; // // 12/05/2016 -- блок записи/восстановления кабельных соединений после подъема/спуска трассы на высоту Procedure CheckSaveLineConnectionsBySide(aLine: TOrthoLine; aCableCompon: TSCSComponent; aSide: Integer); var i, j, k: Integer; InterfPos: TSCSInterfPosition; Interf, ConnectedInterf: TSCSInterface; DirectConnectedComponList, ConnectedComponList: TList; JoinedCompon, ConnectedLineComponent: TSCSComponent; PointToSave: TConnectorObject; PointCatalog, LineCatalog, JoinedLineCatalog: TSCSCatalog; POintFigure, LineFigure: TFigure; CanContinue: Boolean; WayList: TList; // ComponToDeleteList: TSCSComponents; LastComponent: TSCSComponent; LastSide: Integer; isLineConnection, isPointConnection: Boolean; ComponJoinedByMultiInterface: TSCSComponent; JoinedInterface: TSCSInterface; FirstComponID: Integer; SavedPointConnection: Boolean; Procedure SaveConnectionOnPointObject(aPointObject: TConnectorObject; aPointCatalog: TSCSCatalog; aJoinedLineCompon: TSCSComponent; ConnectionSide: Integer); var i, j, k, l, m: Integer; PointJoinedLineCatalog : TSCSCatalog; PointComponent, LineComponent: TSCSComponent; LineJoinedComponList: TList; LineInterface: TSCSInterface; aCableComponInterface: TSCSInterface; begin NBConnector := APointObject; if NBConnector <> nil then begin //JoinedPointObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(NBConnector.Id); // DivLineObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ASnapLine.Id); //DivLineObject := aJoinedLineCompon.GetFirstParentCatalog; //if (aPointCatalog <> nil) and (DivLineObject <> nil) then if (aPointCatalog <> nil) then begin //if ((aPointCatalog.ComponentReferences.Count > 0) and (DivLineObject.ComponentReferences.Count > 0)) then begin InterFaceAccordanceList := TList.Create; //LineInterfList := TList.Create; //for j := 0 to DivLineObject.ComponentReferences.Count - 1 do //begin //LineCompon := DivLineObject.ComponentReferences[j]; // 14/05/2016 // if LineCompon.ComponentType.SysName = ctsnCable then if IsCableComponent(aJoinedLineCompon) then // так правильнее -- для всех кабелей // begin if CheckJoinedComponToComponFromObject(aJoinedLineCompon, aPointCatalog) then begin for k := 0 to aJoinedLineCompon.Interfaces.count - 1 do begin if (aJoinedLineCompon.Interfaces[k].TypeI = itFunctional) and (aJoinedLineCompon.Interfaces[k].Side = ConnectionSide) and ((aJoinedLineCompon.Interfaces[k].IsBusy = biTrue) or (aJoinedLineCompon.Interfaces[k].BusyPositions.Count > 0)) then begin SavedLineComponList := TList.Create; SavedPointComponList := TList.Create; ALineInterFace := TSCSInterFace(aJoinedLineCompon.Interfaces.Items[k]); { if SavedLineComponList.IndexOf(LineCompon.Interfaces.Items[k]) = -1 then SavedLineComponList.Add(TSCSInterFace(LineCompon.Interfaces.Items[k]));} if aCableCompon.Id = aJoinedLineCompon.id then begin if SavedLineComponList.IndexOf(ALineInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(ALineInterFace)); end else begin aCableComponInterFace := aCableCompon.Interfaces[k]; if SavedLineComponList.IndexOf(aCableComponInterFace) = -1 then SavedLineComponList.Add(TSCSInterface(aCableComponInterFace)); // aTempInterf := TSCSInterface(SavedLineComponList[l]); end; APointInterfID := -1; for l := 0 to ALineInterFace.BusyPositions.Count - 1 do begin InterfPosition := ALineInterFace.BusyPositions[l]; JoinedPosition := InterfPosition.GetConnectedPos; if JoinedPosition <> nil then begin if JoinedPosition.InterfOwner <> nil then begin if SavedPointComponList.IndexOf(JoinedPosition.InterfOwner) = -1 then SavedPointComponList.Add(TSCSInterFace(JoinedPosition.InterfOwner)); end; end; end; if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then begin InterFaceAccordanceList.Add(SavedLineComponList); InterFaceAccordanceList.Add(SavedPointComponList); end else begin SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); end; end; end; end; end; //end; end; if InterFaceAccordanceList.Count > 0 then begin // состояние соединения кабеля на точечном объекте SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := aCableCompon.ID;//AJoinedLineCompon.ID; //SelfLineConnectInfo.ComponSide := ConnectionSide; SelfLineConnectInfo.ComponSide := aSide; SelfLineConnectInfo.isLineConnection := False; JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponCatalogID := APointCatalog.ID; JoinedLineConnectInfo.ComponSide := 0; // Tolik 09/02/2017 -- // JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList; JoinedLineConnectInfo.ConnectedComponList := TList.Create; JoinedLineConnectInfo.ConnectedComponList.Assign(InterFaceAccordanceList, LaCopy); // SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); SavedLineConnectionsList.Add(SelfLineConnectInfo); FreeAndNil(InterFaceAccordanceList); end else FreeAndNil(InterFaceAccordanceList); end; end; // сбросить соединения линейного с точечными на заданной стороне LineJoinedComponList := TList.Create; for i := 0 to aJoinedLineCompon.Interfaces.Count - 1 do begin LineInterface := TSCSInterface(aJoinedLineCompon.Interfaces[i]); if (LineInterface.TypeI = itFunctional) and (LineInterface.Side = ConnectionSide) then begin for j := 0 to LineInterface.ConnectedInterfaces.Count - 1 do if LineJoinedComponList.IndexOf(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)) = -1 then LineJoinedComponList.Add(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)); end; end; for i := 0 to LineJoinedComponList.Count - 1 do begin aJoinedLineCompon.DisJoinFrom(TSCSComponent(LineJoinedComponList[i])); end; FreeAndNil(LineJoinedComponList); // end; function GetLastConnectedComponent(ALastCompon: TSCSComponent; SelfSide: integer): TSCSComponent; var i, j, k: Integer; //LineFigure: Tfigure; LineCatalog: TSCSCatalog; LastComponinterface: TSCSInterface; InterfPos: TSCSInterfPosition; LineFound, PointFound: Boolean; ConnectedCompon: TSCSComponent; LastLine: TOrthoLine; SavedPosSide: Integer; LastLineCompon: TSCSComponent; JoinedPointObject: TConnectorObject; JoinedPointCatalog: TSCSCatalog; begin Result := nil; LineFound := False; PointFound := False; CanContinue := False; LastLineCompon := ALastCompon; LineCatalog := ALastCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LastLine := TOrthoLine(GetFigureByCatalogId(LineCatalog.SCSID)); if LastLine <> nil then begin if (not LastLine.FIsVertical) and (not LastLine.FIsRaiseUpDown) then begin if ConnectedComponList.IndexOf(ALastCompon) = -1 then ConnectedComponList.Add(ALastCompon) else exit; Exit; end; end; end; for i := 0 to ALastCompon.Interfaces.Count - 1 do begin LastComponinterface := TSCSInterface(ALastCompon.Interfaces[i]); if ((LastComponinterface.TypeI = itFunctional) and (LastComponinterface.Side <> SelfSide)) then begin if ((LastComponinterface.IsBusy = biTrue) or (LastComponinterface.BusyPositions.Count > 0)) then begin for j := 0 to LastComponinterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(LastComponinterface.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin ConnectedCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); if ConnectedCompon.IsLine = biTrue then begin LastLineCompon := ConnectedCompon; if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then begin SavedPosSide := InterfPos.InterfOwner.Side; // сторона подключения LineCatalog := ConnectedCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(LineCatalog.SCSID); if LineFigure <> nil then begin if TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown then begin if ComponToDeleteList.IndexOf(ConnectedCompon) = -1 then ComponToDeleteList.Add(ConnectedCompon); if ConnectedComponlist.IndexOf(Connectedcompon) = -1 then ConnectedComponList.Add(ConnectedCompon); ALastCompon.DisJoinFrom(ConnectedCompon); Result := GetLastConnectedComponent(ConnectedCompon, SavedPosSide); if Result = Nil then begin if SavedPosSide = 1 then LastSide := 2 else if SavedPosSide = 2 then LastSide := 1; end; end else // если сходим с вертикали -- приехали begin Result := ConnectedCompon; //Result := nil; // LineFigure := nil; // сброс для множественных подключений на том же уровне при наличии мультиинтерфейса if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then ConnectedComponList.Add(ConnectedCompon); {if SavedPosSide = 1 then LastSide := 2 else if SavedPosSide = 2 then LastSide := 1;} LastSide := SavedPosSide; exit; end; end; end; end; end else begin if ConnectedCompon.isLine = biFalse then begin SavedPosSide := LastComponInterface.Side; LastSide := SavedPosSide; JoinedPointCatalog := ConnectedCompon.GetFirstParentCatalog; if JoinedPointCatalog <> nil then begin JoinedPointObject := TConnectorObject(GetFigureByCatalogId(JoinedPointCatalog.SCSID)); if JoinedPointObject <> nil then begin SaveConnectionOnPointObject(JoinedPointObject, JoinedPointCatalog, aLastCompon, LastSide); SavedPointConnection := True; isPointConnection := True; end; Result := nil; Exit; end; end; end; end; end; end; end; end; end; begin CanContinue := False; SelfLineConnectInfo := nil; JoinedLineConnectInfo := Nil; ConnectedComponList := TList.Create; PointToSave := nil; isLineConnection := False; isPointConnection := False; LineFigure := Nil; SavedPointConnection := False; // ComponToDeleteList := TSCSComponents.Create(False); if ((aCableCompon.JoinedComponents.count > 0) and (SavedComponList.IndexOf(aCableCompon) = -1)) then SavedComponList.Add(ACablecompon); for i := 0 to aCableCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); // ищем возможные подключения с указанной стороны if ((Interf.Side = aSide) and (Interf.TypeI = itFunctional) and ((Interf.IsBusy = biTrue) or (interf.BusyPositions.Count > 0))) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); // занятая позиция интерфейса InterfPos := InterfPos.GetConnectedPos; // подключенная к ней непосредственно позиция интерфейса // присоединенного компонента JoinedCompon := InterfPos.InterfOwner.ComponentOwner; // присоединенный компонент if JoinedCompon <> nil then begin // подключен точечный компонент if JoinedCompon.IsLine = biFalse then begin // точечное соединение -- сохранить по позициям для восстановления if ConnectedComponList.IndexOf(JoinedCompon) = -1 then ConnectedComponList.Add(JoinedCompon); if PointToSave = nil then begin PointCatalog := JoinedCompon.GetFirstParentCatalog; PointToSave := TConnectorObject(GetFigurebyCatalogID(PointCatalog.SCSID)); // нашли точечный, присоединенный к кабелю -- сохраняем соединение и вываливаемся if ((PointToSave <> nil) and (CheckFigureByClassName(PointToSave, cTConnectorObject))) then begin SaveConnectionOnPointObject(PointtoSave, PointCatalog, aCableCompon, aSide); ConnectedComponList.Free; exit; //// BREAK ////; end; end; end // подключен линейный компонент // линейные поинтерфейсно соединять не нужно, просто соединить кабель else if JoinedCompon.isLine = biTrue then begin if ConnectedComponlist.IndexOf(JoinedCompon) = -1 then begin ConnectedComponList.Add(JoinedCompon); isLineConnection := True; LastSide := InterfPos.InterfOwner.Side; // сторона подлючения подключенного кабеля к текущему //если подключен линейный - ищем конечную точку восстановления JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); if LineFigure <> nil then begin if (TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown) then begin // список на удаление if (ComponToDeleteList.IndexOf(JoinedCompon) = -1) then ComponToDeleteList.Add(JoinedCompon); // получить последний кусок кабеля aCableCompon.DisJoinFrom(JoinedCompon); JoinedCompon := GetLastConnectedComponent(JoinedCompon, LastSide); end; // если последняя фигура -- вертикаль и дальше обрыв if (JoinedCompon = nil) and (not SavedPointConnection) then begin if ConnectedComponList.Count > 0 then begin JoinedCOmpon := TSCSComponent(ConnectedComponList[ConnectedComponList.Count - 1]); JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID); end; end; end; end; // если соединение - линейное - сохранить его if (LineFigure <> nil) and (not SavedPointConnection) then begin // кабель поднимаемой трассы SelfLineConnectInfo := TLineComponConnectionInfo.Create(True); SelfLineConnectInfo.ComponId := aCableCompon.ID; SelfLineConnectInfo.ComponSide := aSide; // трасса и сторона соединения JoinedLineConnectInfo:= TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponId := JoinedCompon.ID; if TOrthoLine(LineFigure).FIsVertical then begin if LastSide = 1 then LastSide := 2 else if LastSide = 2 then LastSide := 1; end; JoinedLineConnectInfo.ComponSide := LastSide; JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog; if JoinedLineCatalog <> nil then JoinedLineConnectInfo.ComponCatalogID := JoinedLineCatalog.ID; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); SavedLineConnectionsList.Add(SelfLineConnectInfo); //отключить найденный кабель нах if aCableCompon.JoinedComponents.IndexOF(JoinedCompon) <> -1 then aCableCompon.DisJoinFrom(JoinedCompon); end; end; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; end; if isLineConnection then Break; //// BREAK //// if isPointConnection then Break; //// BREAK ////; end; // если мультиинтерфейс - отключить все подключенные на нем( остальные кабели) // и загнать их в список подключенных компонент для восстановления, if aCableCompon.JoinedComponents.Count > 0 then begin for i := 0 to aCableCompon.Interfaces.count - 1 do begin Interf := TSCSInterface(aCableCompon.Interfaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide) and (Interf.Multiple = biTrue) and (Interf.ConnectedInterfaces.Count > 1)) then begin if aCableCompon.JoinedComponents.Count > 0 then begin While Interf.ConnectedInterfaces.Count > 0 do begin JoinedInterface := TSCSInterface(Interf.ConnectedInterfaces[0]); ComponJoinedByMultiInterface := JoinedInterface.ComponentOwner; if ComponJoinedByMultiInterface <> nil then begin if (ComponJoinedByMultiInterface.IsLine = biTrue) then begin ConnectedComponList.Add(ComponJoinedByMultiInterface); // если было сохранение линейного соединения -- добавить в список сохранения подключенный кабель if SelfLineConnectInfo <> nil then begin FirstComponID := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]).ComponId; // на всякий if ComponJoinedByMultiInterface.ID <> FirstComponID then begin JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponId := ComponJoinedByMultiInterface.ID; JoinedLineConnectInfo.ComponSide := JoinedInterface.Side; SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); end; end; end; // отключить (если уже есть в списке или точечный компонент) aCableCompon.DisJoinFrom(ComponJoinedByMultiInterface); end; end; end; end; end; end; // удалить кабель по пути прохождения {if ComponToDeleteList.Count > 0 then begin F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil); ComponToDeleteList.Clear; end; } //FreeAndNil(ComponToDeleteList); ConnectedComponList.Clear; FreeAndNil(ConnectedcomponList); GCadForm.PCad.Refresh; end; Procedure SaveLineConnections(aLine: TOrthoLine); var i, j, k: Integer; LineCatalog: TSCSCatalog; SCSCompon: TSCSComponent; CanSaveThisTrace: Boolean; CanMoveLineConnector1, CanMoveLineConnector2: Boolean; JoinedLine: TOrthoLine; CanSaveLineConnector1, CanSaveLineConnector2: Boolean; function CheckCanSaveOnLineConnector(aConn: TConnectorObject): Boolean; var i,j : Integer; NextRaiseConn: TConnectorObject; VLine1, VLine2, ConnRaiseLine: TOrthoLine; VLineConn1, VLineConn2 : TConnectorObject; DirectionUP, DirectionDown: boolean; begin Result := True; DirectionUP := False; DirectionDown := False; VLineConn1 := Nil; VLineConn2 := Nil; if aConn = nil then begin Result := False; Exit; end; if aConn.Deleted then begin Result := False; exit; end; // если коннектор - на указанной высоте -- выходим нах if Comparevalue(aConn.ActualZOrder[1], RaiseHeight) = 0 then begin Result := False; Exit; end; // Tolik -- 17/11/2016 -- // на коннекторах магистралей и межэтажек тоже записывать не будем (там коннектор двинется как есть) if (aConn.FConnRaiseType = crt_BetweenFloorUp) or (aConn.FConnRaiseType = crt_BetweenFloorDown) or (aConn.FConnRaiseType = crt_TrunkUp) or (aConn.FConnRaiseType = crt_TrunkDown) then begin Result := False; exit; end //Tolik 05/12/2016-- может быть на втором конекторе else if aConn.FConnRaiseType = crt_none then begin NextRaiseConn := nil; for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin if TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector1).ID = aConn.ID then NextRaiseConn := TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector2) else if TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector2).ID = aConn.ID then NextRaiseConn := TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector1) end; if NextRaiseConn <> nil then break; end; if NextRaiseConn <> nil then begin if (NextRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (NextRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or (NextRaiseConn.FConnRaiseType = crt_TrunkUp) or (NextRaiseConn.FConnRaiseType = crt_TrunkDown) then begin Result := False; exit; end end; end; // ConnRaiseLine := Nil; VLine1 := nil; VLine2 := Nil; NextRaiseConn := Nil; // если трасса присоединена к точечному объекту -- нах if aConn.JoinedConnectorsList.Count > 0 then exit; // если двигаем не все трассы коннектора - нах for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then ConnRaiseLine := TOrthoLine(AConn.JoinedOrtholinesList[i]); if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsVertical then begin if VLine1 = Nil then VLine1 := TOrthoLine(AConn.JoinedOrtholinesList[i]) else begin if TOrthoLine(AConn.JoinedOrtholinesList[i]).ID <> VLine1.Id then VLine2 := TOrthoLine(AConn.JoinedOrtholinesList[i]); end; end; // если не двигаем хоть одну трассу -- нах (нужно записать соединение) if (not TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown) and (not TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsVertical) and (SelectedList.IndexOf(TOrthoLine(AConn.JoinedOrtholinesList[i])) = -1) then Exit; end; //есть ли райз if ConnRaiseLine <> nil then begin NextRaiseConn := Nil; if TConnectorObject(ConnRaiseLine.JoinConnector1).ID <> aConn.ID then NextRaiseConn := TConnectorObject(ConnRaiseLine.JoinConnector1) else if TConnectorObject(ConnRaiseLine.JoinConnector2).ID <> aConn.ID then NextRaiseConn := TConnectorObject(ConnRaiseLine.JoinConnector2); if NextRaiseConn <> nil then begin // пишем, если попадем на второй коннектор райза if CompareValue(NextRaiseConn.ActualZOrder[1],RaiseHeight) = 0 then Exit; end; end; {for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin if TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector1).ID <> aConn.ID then NextRaiseConn := TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector1) else if TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector2).ID <> aConn.ID then NextRaiseConn := TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector2); if NextRaiseConn <> nil then begin //если не попадем на вершину райза - не пишем if CompareValue(NextRaiseConn.ActualZOrder[1], RaiseHeight) <> 0 then Result := False; end; Exit; // если есть райз -- вертикалей не будет end; end;} if Result then begin // нет ни райза ни вертикали и все трассы сдвигаются в данной точке одновременно if (ConnRaiseLine = nil) and (VLine1 = nil) then Result := False else // есть вертикаль (или две) if (ConnRaiseLine = nil) and (VLine1 <> nil) then begin // направление сдвига if CompareValue(aConn.ActualZOrder[1], RaiseHeight) = -1 then DirectionUP := True else if CompareValue(aConn.ActualZOrder[1], RaiseHeight) = 1 then DirectionDown := True; // если вертикаль -- одна, смотрим, не попадем ли на коннектор вертикали if VLine2 = nil then begin // не попадем на коннектор if (CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], RaiseHeight) <> 0) and (CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], RaiseHeight) <> 0) then begin // проверить попадание на вертикаль через коннектор if DirectionUP then begin VLineConn1 := TConnectorObject(VLine1.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if VLineConn1.JoinedConnectorsList.Count > 0 then VLineConn1 := TConnectorObject(VLineConn1.JoinedConnectorsList[0]); if VLineConn1.ConnectorType = ct_Clear then begin for i := 0 to VLineConn1.JoinedOrthoLinesList.Count - 1 do begin if (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).FisVertical and (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).Id <> VLine1.Id)) then exit; end; end else begin for i := 0 to VLineConn1.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> VLine1.Id) then ; end; end; end; end else if DirectionDown then begin VLineConn1 := TConnectorObject(VLine1.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if VLineConn1.JoinedConnectorsList.Count > 0 then VLineConn1 := TConnectorObject(VLineConn1.JoinedConnectorsList[0]); if VLineConn1.ConnectorType = ct_Clear then begin for i := 0 to VLineConn1.JoinedOrthoLinesList.Count - 1 do begin if (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).FisVertical and (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).Id <> VLine1.Id)) then exit; end; end else begin for i := 0 to VLineConn1.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> VLine1.Id) then Exit; end; end; end; end; // не попали на вертикаль (переворот вертикали) for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin if (not TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown) and (not TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsVertical) and (SelectedList.IndexOf(TOrthoLine(aConn.JoinedOrtholinesList[i])) = -1) then Exit; end; Result := False; exit; end else // на коннектор begin exit; end; end else // если 2 вертикали - смотрим, попадем ли на коннектор вертикали или можем ли мы в результате // перемещения его перепрыгнуть (если нет - писать тоже ничего не нужно) begin if DirectionUP then begin //берем самый верхний коннектор VLineConn1 := TConnectorObject(VLine1.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = -1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector2); // если не дотягиваем до него -- писать не нужно if CompareValue(VLineConn1.ActualZOrder[1], RaiseHeight) = 1 then begin Result := False; exit; end; end else if DirectionDown then begin //берем самый нижний коннектор VLineConn1 := TConnectorObject(VLine1.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine1.JoinConnector2); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector1); if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = 1 then VLineConn1 := TConnectorObject(VLine2.JoinConnector2); // если не дотягиваем до него -- писать не нужно if CompareValue(VLineConn1.ActualZOrder[1], RaiseHeight) = -1 then begin Result := False; exit; end; end; end; end; end; end; begin if aLine <> nil then begin CanMoveLineConnector1 := False; CanMoveLineConnector2 := False; CanSaveLineConnector1 := False; CanSaveLineConnector2 := False; // если будем поднимать/опускать коннектор2 if ((aLine.JoinConnector1 <> nil) and (CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], RaiseHeight) <> 0)) then CanMoveLineConnector1 := True; // если будем поднимать/опускать коннектор2 if ((aLine.JoinConnector2 <> nil) and (CompareValue(TConnectorObject(aLine.JoinConnector2).ActualZOrder[1], RaiseHeight) <> 0)) then CanMoveLineConnector2 := True; LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aLine.ID); if LineCatalog <> nil then begin CanSaveThisTrace := False; // есть ли кабель и нужно ли сохранять кабельные соединения if LineCatalog.ComponentReferences.Count > 0 then begin for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[i]); if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then begin CanSaveThisTrace := True; // если есть кабель и соединения нужно сохранять -- добавить трассу в список для последующего восстановления SavedTraceList.Add(aLine); if SavedLineList.IndexOf(aLine) = -1 then SavedLineList.Add(aLine); Break; //// BREAK //// end; end; if CanSaveThisTrace then begin if SavedTraceList.IndexOf(LineCatalog) = -1 then SavedTraceList.Add(LineCatalog); if CanMoveLineConnector1 then CanSaveLineConnector1 := CheckCanSaveOnLineConnector(TConnectorObject(aLine.JoinConnector1)); if CanMoveLineConnector2 then CanSaveLineConnector2 := CheckCanSaveOnLineConnector(TConnectorObject(aLine.JoinConnector2)); for i := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[i]); if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then begin // если будем поднимать/опускать коннектор1 - сохранить кабельные соединения до ... if (CanMoveLineConnector1 and CanSaveLineConnector1) then begin CheckSaveLineConnectionsBySide(aLine, SCSCompon, 1); end; // если будем поднимать/опускать коннектор2 - сохранить кабельные соединения до ... if (CanMoveLineConnector2 and CanSaveLineConnector2) then begin CheckSaveLineConnectionsBySide(aLine, SCSCompon, 2); end; end; end; end; end; end; // сохранить остальные соединения на коннекторе { if CanMoveLineConnector1 then begin for i := 0 to TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList[i]); if ((not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.FIsVertical) and (JoinedLine.ID <> aLine.Id) and (SelectedList.IndexOf(JoinedLine) <> - 1)) then begin CanSaveThisTrace := False; LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if LineCatalog <> nil then begin // есть ли кабель и нужно ли сохранять кабельные соединения if LineCatalog.ComponentReferences.Count > 0 then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then begin CanSaveThisTrace := True; // если есть кабель и соединения нужно сохранять -- добавить трассу в список для последующего восстановления if SavedTraceList.IndexOf(JoinedLine) = -1 then SavedTraceList.Add(JoinedLine); Break; //// BREAK //// end; end; end; if CanSaveThisTrace then begin if SavedLineList.IndexOf(JoinedLine) = -1 then SavedLineList.Add(JoinedLine); for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then begin // если будем поднимать/опускать коннектор1 - сохранить кабельные соединения до ... if TConnectorObject(JoinedLine.JoinConnector1).Id = TConnectorObject(aLine.JoinConnector1).ID then CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 1) else if TConnectorObject(JoinedLine.JoinConnector2).Id = TConnectorObject(aLine.JoinConnector1).ID then CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 2); end; end; end; end; end; end; end; if CanMoveLineConnector2 then begin for i := 0 to TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList[i]); if ((not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.FIsVertical) and (JoinedLine.ID <> aLine.Id) and (SelectedList.IndexOf(JoinedLine) <> - 1)) then begin CanSaveThisTrace := False; LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if LineCatalog <> nil then begin // есть ли кабель и нужно ли сохранять кабельные соединения if LineCatalog.ComponentReferences.Count > 0 then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then begin CanSaveThisTrace := True; // если есть кабель и соединения нужно сохранять -- добавить трассу в список для последующего восстановления if SavedTraceList.IndexOf(JoinedLine) = -1 then SavedTraceList.Add(JoinedLine); if SavedLineList.IndexOf(JoinedLine) = -1 then SavedLineList.Add(JoinedLine); Break; //// BREAK //// end; end; end; if CanSaveThisTrace then begin if SavedTraceList.IndexOf(LineCatalog) = -1 then SavedTraceList.Add(LineCatalog); for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then begin // если будем поднимать/опускать коннектор1 - сохранить кабельные соединения до ... if TConnectorObject(JoinedLine.JoinConnector1).Id = TConnectorObject(aLine.JoinConnector2).ID then CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 1) else if TConnectorObject(JoinedLine.JoinConnector2).Id = TConnectorObject(aLine.JoinConnector2).ID then CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 2); end; end; end; end; end; end; end; } end; end; Procedure CheckDisJoinLineComponBySide(aLineCompon: TSCSComponent; ASide: Integer); var i, j: Integer; Interf: TSCSInterface; InterfPos: TSCSInterfPosition; JoinedComponList: TList; begin JoinedComponList := TList.Create; for i := 0 to aLineCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aLineCompon.Interfaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide)) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin if JoinedComponList.IndexOf(InterfPos.InterfOwner.ComponentOwner) = -1 then JoinedComponList.Add(InterfPos.InterfOwner.ComponentOwner); end; end; end; end; for i := 0 to JoinedComponList.Count - 1 do aLineCompon.DisJoinFrom(TSCSComponent(JoinedComponList[i])); FreeAndNil(JoinedComponList); end; Procedure RestoreLineConnectionsBySide(aLine: TOrthoLine; ACableCompon: TSCSComponent; aSide: Integer); var i, j, k, l, m: Integer; TargetLine, TargetPointFigure: TFigure; WayList: TList; SelfConnector, TargetConn: TConnectorObject; TargetCatalog: TSCSCatalog; IdNewCompon: Integer; TargetCompon, NewCompon, FirstCompon, NextCompon: TSCSComponent; PassWayList: Boolean; // прокладывать кабель на вертикали/райзы ComponJoinedByMultiInterFace: TSCSComponent; CanRestoreConnection: Boolean; DisJoinSide: Integer; DisJoinComponList: TList; SideConnectionDropped: Boolean; Function GetInterfaceForConnection(AInterf: TSCSInterFace; WasConnectedCable, isConnectedCable: TSCSComponent; aPointObject: TConnectorObject): TSCSInterFace; var i, j, k: Integer; LineCompon: TSCSComponent; LineFigure: TOrthoLine; LineCatalog: TSCSCatalog; SourceLineCatalog, DestLineCatalog: TSCSCatalog; ConnectionSide : Integer; TmpInterfPos: TSCSInterfPosition; begin Result := nil; LineCatalog := Nil; ConnectionSide := 0; LineCompon := isConnectedCable;//AInterf.ComponentOwner; if LineCompon <> nil then begin LineCatalog := LineCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := TOrthoLine(GetFigurebyCatalogID(LineCatalog.SCSID)); if LineFigure <> nil then begin if (TConnectorObject(LineFigure.JoinConnector1).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or (TConnectorObject(LineFigure.JoinConnector1).ID = aPointObject.ID) then ConnectionSide := 1 else if (TConnectorObject(LineFigure.JoinConnector2).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or (TConnectorObject(LineFigure.JoinConnector2).ID = aPointObject.ID) then ConnectionSide := 2; for j := 0 to LineCompon.Interfaces.Count - 1 do begin if TSCSInterface(LineCompon.Interfaces[j]).TypeI = itFunctional then if TSCSInterface(LineCompon.Interfaces[j]).Npp = AInterf.Npp then // вторая сторона идин х занята уже ...(если не обрыв кабеля) if TSCSInterface(LineCompon.Interfaces[j]).Side = ConnectionSide then if ((TSCSInterface(LineCompon.Interfaces[j]).IsBusy = biFalse) or (TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count = 0)) then begin Result := TSCSInterface(LineCompon.Interfaces[j]); break; end; end; end; end; {SourceLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ALine.ID); if SourceLineCatalog <> nil then begin for i := 0 to SourceLineCatalog.ComponentReferences.Count - 1 do begin if (TSCSComponent(SourceLineCatalog.ComponentReferences[i]).ID = LineCompon.ID) then begin DestLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(AddLine.ID); if DestLineCatalog <> nil then begin if i <= (DestLineCatalog.ComponentReferences.Count - 1) then begin LineCompon := DestLineCatalog.ComponentReferences[i]; if LineCompon <> nil then begin // Difining ConnectionSide { for j := 0 to LineCompon.Interfaces.Count - 1 do begin ConnectionSide := 2; if TSCSInterface(LineCompon.Interfaces[j]).TypeI = itFunctional then if TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count > 0 then begin for k := 0 to TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count - 1 do begin TmpInterfPos := TSCSInterface(LineCompon.Interfaces[j]).BusyPositions[k]; TmpInterfPos := TmpInterfPos.GetConnectedPos; if TSCSComponent(TmpInterfPos.InterfOwner.ComponentOwner).IsLine = biTrue then begin if TmpInterfPos.InterfOwner.Side = 2 then ConnectionSide := 1; break; end; end; end; end;} { end; end; end; Break; //// BREAK ////; end; end; end; } end; end; Function DefineIDComponRel(ALineCompon, APointCompon: TSCSComponent): Integer; var TopCatalog: TSCSCatalog; begin Result := -1; begin TopCatalog := aLineCompon.GetTopParentCatalog; if TopCatalog <> nil then if TopCatalog is TSCSProject then Result := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1); end; //if IDComponRel = -1 then //IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); end; begin WayList := nil; SelfLineConnectInfo := Nil; SelfConnector := nil; TargetConn := Nil; PassWayList := True; DisJoinComponList := nil; CanRestoreConnection := True; SideConnectionDropped := False; While CanRestoreconnection do begin CanRestoreConnection := False; for i := 0 to SavedLineConnectionsList.Count - 1 do begin if ((TLineComponConnectionInfo(SavedLineConnectionsList[i]).ComponId = ACableCompon.ID) and (TLineComponConnectionInfo(SavedLineConnectionsList[i]).ComponSide = aSide)) then begin SelfLineConnectInfo := TLineComponConnectionInfo(SavedLineConnectionsList[i]); CanRestoreConnection := True; Break; //// BREAK ////; end; end; if SelfLineConnectInfo <> nil then begin if not SideConnectionDropped then begin CheckDisJoinLineComponBySide(ACableCompon, aSide); SideConnectionDropped := True; end; if SelfLineConnectInfo.ComponSide = 1 then SelfConnector := TConnectorObject(aLine.JoinConnector1) else if SelfLineConnectInfo.ComponSide = 2 then SelfConnector := TConnectorObject(aLine.JoinConnector2); if SelfConnector <> nil then begin // for i := 0 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); JoinedLineConnectInfo := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]); TargetCompon := nil; if SelfLineConnectInfo.isLineConnection then TargetCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if FirstCompon <> nil then begin // произошло разделение вертикали if TargetCompon = nil then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(JoinedLineConnectInfo.ComponCatalogID); end else if TargetCompon <> nil then TargetCatalog := TargetCompon.GetFirstParentCatalog; // линейное соединение (кабель -- кабель) { if TargetCompon.IsLine = biTrue then begin TargetCatalog := TargetCompon.GetFirstParentCatalog;} if TargetCatalog <> nil then begin TargetLine := GetFigureByCatalogID(TargetCatalog.SCSID); if TargetLine <> nil then begin TargetConn := Nil; if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin // линейноне подключение if JoinedLineConnectInfo.ComponSide = 1 then TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector1) else if JoinedLineConnectInfo.ComponSide = 2 then TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector2); end else if CheckFigureByClassName(TargetLine, CTConnectorObject) then begin // точечное подключение TargetPointfigure := TargetLine; if JoinedLineConnectInfo.ComponSide = 0 then begin TargetConn := TConnectorObject(TargetLine); end; end; if TargetConn <> nil then begin // если произошло разделение вертикали - найти коннектор от высоты подъема WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetConn)); if WayList <> nil then begin // удалить невертикали и нерайзы из пути for j := (WayList.Count - 1) downto 0 do begin if CheckFigureByClassName(TFigure(WayList[j]), cTOrthoLine) then begin if ((not TOrthoLine(WayList[j]).FIsVertical) and (not TOrthoLine(WayList[j]).FIsRaiseUpDown)) then WayList.Delete(j); end {else WayList.Delete(j);} end; // прокладка кабеля (только на райз или на вертикали) for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := Nil; // вкинуть кабель на трассу NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False); // рассоединить добавленный кабель от всего, к чему подключился автоматом if NewCompon <> nil then NewCompon.DisJoinFromAll(false).Free; end; end; end; end; end; end; end; // FirstCompon := TargetCompon; // соединить кабели if WayList <> nil then begin if WayList.Count > 0 then begin //FirstCompon := aCableCompon; for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := TargetCatalog.LastAddedComponent; if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; FirstCompon := NewCompon; NewCompon := Nil; end; end; end else begin //NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end; break; end; end; end; // конечное соединение //NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if SelfLineConnectInfo.isLineConnection then begin NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if ((NewCompon <> nil) and (FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1)) then ConnectCableComponents(FirstCompon, NewCompon); end else begin if not SelfLineConnectInfo.isLineConnection then begin // Restore Connection // восстановить состояние соединения кабеля с точечными компонентами NewCompon := FirstCompon; // если коннектор упал на точечный объект, то кабель мог автоматом соединиться с // компонентами точечного, поэтому нужно их расконнектить до восстановления соединения TargetCatalog := NewCompon.GetFirstParentCatalog; if TargetCatalog <> nil then begin TargetLine := GetFigureByCatalogId(TargetCatalog.SCSID); if TargetLine <> nil then begin DisJoinSide := 0; if TConnectorObject(TOrthoLine(TargetLine).JoinConnector1).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 1 else if TConnectorObject(TOrthoLine(TargetLine).JoinConnector2).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then DisJoinSide := 2; if DisJoinSide <> 0 then begin DisJoinComponList := TList.Create; for i := 0 to NewCompon.Interfaces.Count - 1 do begin if (NewCompon.Interfaces[i].TypeI = itFunctional) and (NewCompon.Interfaces[i].Side = DisJoinSide) then begin for j := 0 to NewCompon.Interfaces[i].ConnectedInterfaces.Count - 1 do begin if (TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner <> nil) and (DisJoinComponList.IndexOf(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner) = -1) then DisJoinComponList.Add(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner); end; end; end; for i := 0 to DisJoinComponList.Count - 1 do begin NewCompon.DisJoinFrom(TSCSComponent(DisJoinComponList[i])); end; end; FreeAndNil(DisJoinComponList); end; end; FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin i := 0; While (i <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[i]); SavedPointComponList := TList(InterFaceAccordanceList[i + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin aTempInterf := TSCSInterface(SavedLineComponList[j]); ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure)); if ALineInterFace <> nil then begin LineCompon := ALineInterFace.ComponentOwner; for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(i,2); end; end; if InterFaceAccordanceList <> nil then begin InterFaceAccordanceList.clear; FreeAndNil(InterFaceAccordanceList); end; end; end; end else begin //NewCompon := aCableCompon;// F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end; WayList.Clear; FreeAndNil(WayList); end else begin // если соединение линейное if SelfLineConnectInfo.isLineConnection then begin // NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId); if NewCompon <> nil then if FirstCompon.JoinedComponents.IndexOf(NewCompon) = - 1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if SelfLineConnectInfo.ConnectedComponList.Count > 1 then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; end // если кабель был присобачен к компонентам точечного объекта - соединить как было else begin end; // end; end else begin if not SelfLineConnectInfo.isLineConnection then begin TargetPointFigure := TConnectorObject(GetFigureByCatalogId(JoinedLineConnectInfo.ComponId)); if TargetPointFigure <> nil then begin // если чистый коннектор и на нем объект -- получить его if (TConnectorObject(TargetPointFigure).ConnectorType = ct_clear) and (TConnectorObject(TargetPointFigure).JoinedConnectorsList.Count > 0) then TargetPointFigure := TFigure(TConnectorObject(TargetPointFigure).JoinedConnectorsList[0]); WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetPointFigure)); if WayList <> nil then begin // прокладка кабеля (только на райз или на вертикали) for j := 0 to WayList.Count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, CTOrthoLine) then begin if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := Nil; // вкинуть кабель на трассу NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False); // рассоединить добавленный кабель от всего, к чему подключился автоматом if NewCompon <> nil then NewCompon.DisJoinFromAll(false).Free; end; end; end; end; // выполнить кабельное соединение по пути следования for j := 0 to WayList.count - 1 do begin TargetLine := TFigure(WayList[j]); if CheckFigureByClassName(TargetLine, cTOrthoLine) then begin if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then begin TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID); if TargetCatalog <> nil then begin NewCompon := TargetCatalog.LastAddedComponent; if NewCompon <> nil then begin if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then ConnectCableComponents(FirstCompon, NewCompon); // если на мультиинтерфейсе if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then begin for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do begin ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId); if ComponJoinedByMultiInterFace <> nil then begin if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace); end; end; end; FirstCompon := NewCompon; NewCompon := Nil; end; end; end; end; end; FreeAndNil(WayList); end; // Restore Connection // восстановить состояние соединения кабеля с точечными компонентами NewCompon := FirstCompon; FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin i := 0; While (i <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[i]); SavedPointComponList := TList(InterFaceAccordanceList[i + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin aTempInterf := TSCSInterface(SavedLineComponList[j]); ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure)); LineCompon := ALineInterFace.ComponentOwner; if ALineInterFace <> nil then begin for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(i,2); end; end; if InterFaceAccordanceList <> nil then begin InterFaceAccordanceList.clear; FreeAndNil(InterFaceAccordanceList); end; end; end; end; end; end; end; SavedLineConnectionsList.Remove(SelfLineConnectInfo); FreeAndNil(SelfLineConnectInfo); end; end; end; Procedure RestoreLineConnections(aLine: TOrthoLine); var i, j: Integer; LineCatalog: TSCSCatalog; LineCompon: TSCSComponent; SavedLine: TOrthoLine; { Procedure CheckDisJoinLineComponBySide(aLineCompon: TSCSComponent; ASide: Integer); var i, j: Integer; Interf: TSCSInterface; InterfPos: TSCSInterfPosition; JoinedComponList: TList; begin JoinedComponList := TList.Create; for i := 0 to aLineCompon.Interfaces.Count - 1 do begin Interf := TSCSInterface(aLineCompon.Interfaces[i]); if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide)) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin if JoinedComponList.IndexOf(InterfPos.InterfOwner.ComponentOwner) = -1 then JoinedComponList.Add(InterfPos.InterfOwner.ComponentOwner); end; end; end; end; for i := 0 to JoinedComponList.Count - 1 do aLineCompon.DisJoinFrom(TSCSComponent(JoinedComponList[i])); FreeAndNil(JoinedComponList); end; } begin if SavedLineConnectionsList.Count = 0 then Exit; for i := 0 to SavedLineList.Count - 1 do begin SavedLine := TOrthoLine(SavedLineList[i]); if ((SavedLine <> nil) and (SavedTraceList.IndexOf(SavedLine) <> -1)) then begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SavedLine.ID); if LineCatalog <> nil then begin if SavedTraceList.IndexOf(LineCatalog) <> - 1 then begin for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin LineCompon := TSCSComponent(LineCatalog.ComponentReferences[j]); if (isCableComponent(LineCompon) and (SavedComponList.IndexOF(LineCompon) <> -1)) then begin //CheckDisJoinLineComponBySide(LineCompon, 1); RestoreLineConnectionsBySide(SavedLine, LineCompon, 1); //CheckDisJoinLineComponBySide(LineCompon, 2); RestoreLineConnectionsBySide(SavedLine, LineCompon, 2); end; end; end; end; end; end; end; // Procedure CheckdelVLines(aLine: TOrthoLine); var i: Integer; LineList: TList; CanLook: Boolean; VLine1, vLine2 : TOrthoLine; Procedure GetVLines(aConn: TConnectorObject); var i, j: Integer; currConn: TConnectorObject; begin currConn := aConn; if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(aConn.JoinedConnectorsList[0]); if currConn.ConnectorType = ct_clear then begin if aConn.ConnectorType = ct_clear then begin for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsVertical then begin if VLine1 = nil then VLine1 := TOrthoLine(aConn.JoinedOrthoLinesList[i]) else if vLine2 = nil then begin VLine2 := TOrthoLine(aConn.JoinedOrthoLinesList[i]); break; end; end; end; end; end else if currConn.ConnectorType = ct_NB then begin for i := 0 to currConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then begin if VLine1 = nil then VLine1 := TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]) else if vLine2 = nil then begin vLine2 := TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); Break; //// BREAK ////; end; end; end; if vLine2 <> nil then break; end; end; end; Procedure DelVLines(vLine: TOrthoLine); var i, j: Integer; CanSeek:Boolean; currConn: TConnectorObject; currLine: TOrthoLine; TempConn: TConnectorObject; CandelLine: Boolean; LineCatalog: TSCSCatalog; procedure GetLineList; var i, j: Integer; Counter: Integer; begin Counter := 0; While CanSeek do begin inc(Counter); CanSeek := False; if Counter > 50 then break; if currConn.ConnectorType = ct_clear then begin for i := 0 to currConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(currConn.JoinedOrtholinesList[i]).FIsVertical and (TOrthoLine(currConn.JoinedOrtholinesList[i]).Id <> currLine.Id) then begin currLine := TOrthoLine(currConn.JoinedOrtholinesList[i]); if LineList.IndexOf(currLine) = -1 then LineList.Add(currLine); if TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector1.Id <> currConn.ID then currConn := TConnectorObject(TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector1) else if TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector2.Id <> currConn.ID then currConn := TConnectorObject(TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector2); if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); CanSeek := True; break; end; end; end else if currConn.ConnectorType = ct_NB then begin for i := 0 to currConn.JoinedConnectorsList.Count - 1 do begin TempConn := TConnectorObject(currConn.JoinedConnectorsList[i]); for j := 0 to TempConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TempConn.JoinedOrtholinesList[j]).FIsVertical and (TOrthoLine(TempConn.JoinedOrtholinesList[j]).ID <> currLine.Id) then begin currLine := TOrthoLine(TempConn.JoinedOrtholinesList[j]); if LineList.IndexOf(currLine) = -1 then LineList.Add(currLine); if currLine.JoinConnector1.Id <> TempConn.ID then currConn := TConnectorObject(currLine.JoinConnector1) else if currLine.JoinConnector2.Id <> TempConn.ID then currConn := TConnectorObject(currLine.JoinConnector2); if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); CanSeek := True; break; end; end; if CanSeek then break; end; end; end; end; begin if ((vLine <> nil) and (not VLine.deleted)) then begin LineList.Add(vLine); CanSeek := True; currConn := TConnectorObject(vLine.JoinConnector1); if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); currLine := vLine; GetLineList; currLine := VLine; currConn := TConnectorObject(vLine.JoinConnector2); if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedConnectorsList[0]); CanSeek := True; GetLineList; CanDelLine := True; while CandelLine do begin CanDelLine := False; for i := 0 to LineList.Count - 1 do begin currLine := TOrthoLine(LineList[i]); if ((TConnectorObject(currLine.JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) or ((TConnectorObject(currLine.JoinConnector2).JoinedConnectorsList.Count = 0) and (TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Count = 1)) then begin LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currLine.Id); if LineCatalog <> nil then begin if LineCatalog.ComponentReferences.Count = 0 then CanDelLine := True else begin CanDelLine := True; for j := 0 to LineCatalog.ComponentReferences.Count - 1 do begin //Tolik 11/11/2021 -- //if ((not TSCSComponent(LineCatalog.ComponentReferences).ServToDelete) and if ((not TSCSComponent(LineCatalog.ComponentReferences[j]).ServToDelete) and // (TSCSComponent(LineCatalog.ComponentReferences[j]).ID <> 0)) then begin CanDelLine := False; Break; //// BREAK ////; end; end; end; end else CanDelLine := True; if CanDelLine then begin LineList.Remove(currLine); if TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Count > 0 then begin TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Remove(currLine); currLine.JoinConnector1 := nil; end; if TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Count > 1 then begin TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Remove(currLine); currLine.JoinConnector2 := nil; end; currLine.Delete; currLine := Nil; break; end; end; end; end; LineList.Clear; end; end; begin VLine1 := nil; // первая вертикаль на коннекторе VLine2 := Nil; // вторая вертикаль на коннекторе LineList := TList.Create; GetVLines(TConnectorObject(aLine.JoinConnector1)); delVLines(VLine1); delVLines(VLine2); VLine1 := nil; // первая вертикаль на коннекторе VLine2 := Nil; // вторая вертикаль на коннекторе GetVLines(TConnectorObject(aLine.JoinConnector2)); delVLines(VLine1); delVLines(VLine2); FreeAndNil(LineList); end; // Tolik 04/08/2021 -- Procedure SelectAllTracesOnCad; var i: integer; begin for i := 0 to GCadform.FSCSFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(GCadform.FSCSFigures[i]), cTOrthoLine) then begin if not TOrthoLine(GCadForm.FSCSFigures[i]).FIsRaiseUpDown then begin if not TOrthoLine(GCadForm.FSCSFigures[i]).FIsVertical then begin if not TOrthoLine(GCadForm.FSCSFigures[i]).Selected then TOrthoLine(GCadForm.FSCSFigures[i]).Select; end; end; end; end; GCadForm.PCad.Refresh; end; // begin SavedUndoFlag := GlobalDisableSaveForUndo; ProgressChecked := False; {CanRefreshCadFlag := False; if GCanRefreshCad then begin GCanRefreshCad := False; CanRefreshCadFlag := True; end;} try // Tolik 12/05/2016 -- нах этот кусок ? {try RaiseLine := TOrthoLine(GPopupFigure); except RaiseLine := nil; end; if RaiseLine = nil then begin if (GPopupFigure <> nil) and CheckFigureByClassName(GPopupFigure, cTOrthoLine) then RaiseLine := TOrthoLine(GPopupFigure); end;} F_RaiseHeight.cbApplyToAll.Visible := true; if aToHeight = -1 then begin F_RaiseHeight.Caption := cMain_Mes32; F_RaiseHeight.lbMessage.Caption := cMain_Mes33; if F_RaiseHeight.Showmodal <> mrOK then Exit; RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseHeight > GCadForm.FRoomHeight then RaiseHeight := GCadForm.FRoomHeight; end else begin RaiseHeight := aToHeight; RaiseHeight := UOMToMetre(RaiseHeight); if RaiseHeight > GCadForm.FRoomHeight then RaiseHeight := GCadForm.FRoomHeight; end; if F_RaiseHeight.cbApplyToAll.Checked then SelectAlltracesOnCad; SavedTraceList := TList.Create; SavedLineConnectionsList := TList.Create; SavedComponList := TList.Create; ComponToDeleteList := TSCSComponents.Create(False); TempLineList := TList.Create; SavedLineList:= TList.Create; begin CurrTick := GetTickCount; //GCadForm.PCad.Locked := true; //BeginProgress; try SelectedList := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then // Tolik -- 12/05/2016 -- учесть вертикальные трассы -- // if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then if ((not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown) and (not TOrthoLine(GCadForm.PCad.Selection[i]).FIsVertical)) then // if (RaiseHeight <> TOrthoLine(FFigure).ActualZOrder[1]) or (RaiseHeight <> TOrthoLine(FFigure).ActualZOrder[2]) then SelectedList.Add(TFigure(GCadForm.PCad.Selection[i])); end; if SelectedList.Count > 0 then begin // Tolik -- 06/12/2016 -- ProgressChecked := True; // залочить окна на время подъема трасс во избежание..., а то некоторые BeginProgress; // нетерпеливые, не дождавшись завершения процесса, нажимают что ни попадя... // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; GlobalDisableSaveForUndo := True; // Tolik -- 08//05/2016-- // подравнять коннекторы ортолиний на точечных перед сдвигом for i := 0 to SelectedList.count - 1 do begin ComponToDeleteList.Clear; RaiseLine := TOrthoLine(SelectedList[i]); if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.Count > 0 then begin NB_Conn := TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList[0]; TConnectorObject(RaiseLine.JoinConnector1).Move(NB_Conn.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].x, NB_Conn.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].y) end; if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.Count > 0 then begin NB_Conn := TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList[0]; TConnectorObject(RaiseLine.JoinConnector2).Move(NB_Conn.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].x, NB_Conn.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].y) end; // сохранение кабельных соединений до сдвига //SaveLineConnections(RaiseLine); end; // for i := 0 to SelectedList.Count - 1 do begin ComponToDeleteList.Clear; //Tolik 23/11/2021 -- if i = 0 then begin for j := GCadForm.PCad.Selection.Count - 1 downto 0 do begin TFigure(GCadForm.PCad.Selection[j]).Deselect; end; end; //FFigure := TFigure(SelectedList[i]); //Tolik -- 12/05/2016 -- RaiseLine := TOrthoLine(SelectedList[i]); //RaiseLineOnHeight(TOrthoLine(FFigure), RaiseHeight, SelectedList); //Tolik 23/11/2021 -- чуть тормознет за счет сравнения высот, зато ускорится за счет того, что не нужно // будет поднимать трассы из списка, которые уже поднялись за счет тех, что были до них в списке if ((CompareValue(RaiseLine.ActualZOrder[1], RaiseHeight) <> 0) or (CompareValue(RaiseLine.ActualZOrder[2], RaiseHeight) <> 0)) then begin SavedLineList.Clear; SaveLineConnections(RaiseLine); if ComponToDeleteList.Count > 0 then begin for j := 0 to ComponToDeleteList.Count - 1 do begin if not TSCSComponent(ComponTodeleteList[j]).ServToDelete then TSCSComponent(ComponToDeleteList[j]).DisJoinFromAll(true).Free else ComponToDeleteList.Remove(TSCSComponent(ComponTodeleteList[j])); end; end; { TempLineList.Clear; TempLineList.Add(RaiseLine);} { RaiseLine.Select; if GCadForm.PCad.Selection.Indexof(RaiseLine) = -1 then GCadForm.PCad.Selection.Add(RaiseLine);} if Assigned(RaiseLine.JoinConnector1) and (not TConnectorObject(RaiseLine.JoinConnector1).deleted) then begin TConnectorObject(RaiseLine.JoinConnector1).JoinedOrthoLinesList.remove(RaiseLine); TConnectorObject(RaiseLine.JoinConnector1).JoinedOrthoLinesList.Insert(0, RaiseLine); end; if Assigned(RaiseLine.JoinConnector2) and (not TConnectorObject(RaiseLine.JoinConnector2).deleted) then begin TConnectorObject(RaiseLine.JoinConnector2).JoinedOrthoLinesList.remove(RaiseLine); TConnectorObject(RaiseLine.JoinConnector2).JoinedOrthoLinesList.Insert(0, RaiseLine); end; RaiseLineOnHeight(RaiseLine, RaiseHeight, SelectedList); //RaiseLineOnHeight(RaiseLine, RaiseHeight, TempLineList); //CheckDeleteAllRaises(GCadForm.PCad); RestoreLineConnections(RaiseLine); if ComponToDeleteList.Count > 0 then begin // Tolik -- 22/12/2016 -- Try // Tolik -- 30/09/2016 -- for j := ComponTodeleteList.Count - 1 downto 0 do begin if ((TSCSComponent(ComponTodeleteList[j]).ServToDelete = true) or (TSCSComponent(ComponToDeleteList[j]).id = 0)) then ComponToDeleteList.delete(j); end; if ComponToDeleteList.Count > 0 then begin for j := ComponToDeleteList.Count - 1 downto 0 do begin if not TSCSComponent(ComponTodeleteList[j]).ServToDelete then TSCSComponent(ComponToDeleteList[j]).DisJoinFromAll(true).Free else ComponToDeleteList.Remove(TSCSComponent(ComponTodeleteList[j])); end; end; F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil); //ComponToDeleteList.Clear; except on E: Exception do addExceptionToLogEx('TFSCS_Main.F_ProjMan.DelComponentsFromList', E.Message); end; end; {if CanRefreshCadFlag then begin GCanRefreshCad := True; end;} // удалить ненужные вертикали Try CheckDelVLines(RaiseLine); except on E: Exception do addExceptionToLogEx('TFSCS_Main.F_ProjMan.CheckDelVLines', E.Message); end; end; // end; // Tolik 12/05/2016 -- восстановление кабельных соединений {for i := 0 to SelectedList.Count - 1 do begin RaiseLine := TOrthoLine(SelectedList[i]); RestoreLineConnections(RaiseLine); end;} if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); RefreshCAD(GCadForm.PCad); // SP !!! CheckDeleteAllRaises(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := True; end; FreeAndNil(SelectedList); finally //EndProgress; //GCadForm.PCad.Locked := false; end; OldTick := GetTickCount - CurrTick; OldTick := GetTickCount - CurrTick; end; FreeAndNil(ComponToDeleteList); FreeAndNil(SavedTraceList); FreeAndNil(SavedLineConnectionsList); FreeAndNil(SavedComponList); FreeAndNil(TempLineList); FreeAndNil(SavedLineList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRaiseLineExecute', E.Message); end; GlobalDisableSaveForUndo := SavedUndoFlag; {if CanRefreshCadFlag then GCanRefreshCad := True;} if ProgressChecked then EndProgress; end; // Tolik -- 01/08/2016 -- procedure TFSCS_Main.aRaiseLineExecute(Sender: TObject); begin RaiseSelectedLine; end; procedure TFSCS_Main.aMasterAutoTraceExecute(Sender: TObject); var IsAnyRTSelected: Boolean; mess: string; i: integer; aEndPointName: string; begin if ActiveMDIChild <> nil then begin if GEndPoint = nil then begin // КО ВЫБРАТЬ F_EndPoints.Execute; end; if GEndPoint <> nil then begin // проверить можно ли трассировать по выбранным или только во всем IsAnyRTSelected := False; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin If CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then If TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_Clear then if TConnectorObject(GCadForm.PCad.Selection[i]) <> GEndPoint then IsAnyRTSelected := True; end; // по выбранным if IsAnyRTSelected then begin if F_AutoTraceType.ShowModal = mrOK then begin if F_AutoTraceType.rbTraceBySelected.Checked then GCadForm.FAutoTraceBySelected := True; if F_AutoTraceType.rbTraceByAll.Checked then GCadForm.FAutoTraceBySelected := False; end else Exit; end else // по всем begin aEndPointName := GetFigureFirstComponentName(GEndPoint.ID); mess := cMain_Mes34 + aEndPointName + #13#10 + cMain_Mes35; //if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_YESNO) = IDYes then //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes36), MB_YESNO) = IDYes then GCadForm.FAutoTraceBySelected := False else Exit; end; //*** Выбрать порядок подключения панелей с портами if Not ChoiceAutoTraceConnectOrder then Exit; ///// EXIT ///// Show_F_InterfacesAutoTraceForm; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aReport_ListObjectsExecute(Sender: TObject); begin RepObjectReport; end; procedure TFSCS_Main.aReport_ResorcesExecute(Sender: TObject); begin RepResourceReport; end; procedure TFSCS_Main.aReport_CablesExecute(Sender: TObject); begin RepCableReport; end; procedure TFSCS_Main.aCreateObjectOnClickExecute(Sender: TObject); begin if aCreateObjectOnClick.Checked = True then begin GCadForm.FCreateObjectOnClick := True; GCadForm.PCad.SetCursor(crDrag); end; if aCreateObjectOnClick.Checked = False then begin GCadForm.FCreateObjectOnClick := False; GCadForm.PCad.SetCursor(crDefault); end; RefreshCAD(GCadForm.PCad); end; procedure TFSCS_Main.aDeleteSCSObjectExecute(Sender: TObject); var i: integer; FFigure,Selfigure: TFigure; mess: string; vList: TList; vIntList: TIntList; FigID: Integer; ListID: Integer; Node: TTreeNode; Obj: PObjectData; DelComponMode: TDelComponMode; vListCad: TF_CAD; CurrCatalog: TSCSCatalog; CurrComponent: TSCSComponent; //Tolik SCSCatalog : TSCSCatalog; SCSComponent : TSCSComponent; j: integer; NeedInputBox: boolean; // 18/11/2016-- DelRaiseFromPointObject: Boolean; // // Tolik -- 21/04/2017 -- RefreshFlag: Boolean; DelFiguresList: TList; DelCableFromPoint: Boolean; // Tolik 24/05/2021 -- ListCount: integer; // function CanDelRaiseFromPointObject(aConn: TConnectorObject): Boolean; var i, j: Integer; JoinedLine : TOrthoLine; begin Result := True; if aConn.ConnectorType <> ct_Nb then exit; for i := 0 to aConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); if (not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.Deleted) and (not JoinedLine.Selected) then begin Result := False; break; end; end; if not Result then break; end; end; { // Tolik 26/05/2021 -- вынесено в U_Common (и переделано чуть-чуть) // Tolik 11/07/2019 - - function CheckNeedInputBox: boolean; var i: Integer; function DoesHaveFigureConnectedCable(aFigure: TFigure): Boolean; var i, j: Integer; FigCatalog: TSCSCatalog; ChildCompon: TSCSComponent; JoinedCompon: TSCSComponent; // Tolik 24/05/2021 -- begin Result := false; if FFigure = nil then exit; if FFigure.Deleted then exit; if CheckFigureByClassName(aFigure, cTOrthoLine) then begin FigCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aFigure.ID); if FigCatalog <> nil then begin for i := 0 to FigCatalog.ComponentReferences.Count - 1 do begin ChildCompon := TSCSComponent(FigCatalog.ComponentReferences[i]); if IsCableComponent(ChildCompon) then begin childCompon.LoadWholeComponent(false); if ChildCompon.WholeComponent.Count > 1 then begin Result := True; break; end; end; end; end; end //Tolik 24/05/2021 -- else if CheckFigureByClassName(aFigure, cTConnectorObject) then begin FigCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aFigure.ID); if FigCatalog <> nil then begin for i := 0 to FigCatalog.ComponentReferences.Count - 1 do begin ChildCompon := TSCSComponent(FigCatalog.ComponentReferences[i]); for j := 0 to ChildCompon.JoinedComponents.Count - 1 do begin JoinedCompon := ChildCompon.JoinedComponents[j]; if IsCableComponent(JoinedCompon) then begin Result := True; break; end; end; end; end; end // end; begin Result := DoesHaveFigureConnectedCable(FFigure); if not Result then begin if GCadForm <> nil then begin if GCadForm.PCad.Selection.Count > 1 then begin for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin Result := DoesHaveFigureConnectedCable(TFigure(GCadForm.PCad.Selection[i])); if Result then break; end; end; end; end; end; // } begin DelCableFromPoint := False; // Tolik 24/05/2021 -- удалять кабели, подключенные к точечным удаляемым объектам // Tolik -- 07/02/2017 -- vList := nil; // // Toilk 21/04/2017 -- RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; DelFiguresList := TList.Create; BeginProgress('', -1, False); // try if GPopupFigure = nil then //Tolik 12/05/2017 -- //exit; begin DelFiguresList.free; GCanRefreshCad := RefreshFlag; exit; end; // try FFigure := GPopupFigure; except FFigure := nil; end; mess := cCad_Mes11; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cCad_Mes12), MB_YESNO) = IDYes then begin { Node := GetTreeNodeByID(FFigure.ID); if node <> nil then begin Obj := Node.Data; with F_ProjMan do begin case Obj.ComponKind of ckCompon: Act_DelComponent.Execute; end; end; end; } DelComponMode := dmTrace; // Tolik 11/07/2019 -- // вообще-то здесь предполагалось сделать проверку на удаление кабеля (если есть) по всей трассе // а написали черте-что .... вот, пришлось поправить, а то выдавало сообщение на удаление компонента // по всей трассе как для трасс, так и для с/п независимо от того, есть там кабель или нет...(нехорошо) { NeedInputBox := False; if (FFigure <> nil)and(CheckFigureByClassName(FFigure,cTOrthoLine)) then NeedInputBox := true; if not NeedInputBox then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin Selfigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(Selfigure, cTOrthoLine) then begin NeedInputBox := true; break; end; end; end; } NeedInputBox := CheckNeedInputBox; // Tolik 11/07/2019 -- вот, собственно, и вся проверка! // ---- if NeedInputBox then begin // if F_ProjMan.GSCSBase.SCSComponent <> nil then // if Trim(F_ProjMan.GSCSBase.SCSComponent.Name) <> '' then DelComponMode := F_ProjMan.F_InputBox.ChoiceDelComponMode(''{F_ProjMan.GSCSBase.SCSComponent.Name}); DelCableFromPoint := (F_ProjMan.F_InputBox.cbDelConnToPoinCable.Checked and F_ProjMan.F_InputBox.cbDelConnToPoinCable.Visible); end; if DelComponMode <> dmNOne then begin if (FFigure <> nil) or (GCadForm.PCad.SelectedCount > 0) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin vList := GetRelatedListsBySelected(GCadForm.PCad.Selection, cst_Delete); // !!! // vIntList := TIntList.Create; // for i := 0 to vList.Count - 1 do // begin // ListID := TF_CAD(vList[i]).FCADListID; // vIntList.Add(ListID); // end; // FigID := FFigure.ID; // BeforeDelObjectFromPM(cfCAD, GCadForm.FCADListID, FigID, vIntList); // !!! // Tolik 25/05/2021 -- если удалять кабели -- определить листы для ундо .... // if VList.Count = 1 then begin VList.Free; VList := GetListsByDeleteCable(DelCableFromPoint, DelComponMode); end; if vList.Count = 1 then GCadForm.SaveForUndo(uat_None, True, False) else SaveForProjectUndo(vList, True, False); GCadForm.FCanSaveForUndo := False; end; // Tolik 24/05/2021 -- удалить кабель, подключенный к удаляемым точечным объектам if DelCableFromPoint then DeleteConnectedToPointsCable; // if DelComponMode = dmTrace then begin DelCableByAllLengthFromSelected; // Tolik 25/05/2021 -- удалить кабели по всей длине с удаляемых трасс if FFigure <> nil then if CheckFigureByClassName(FFigure, cTOrthoLine) then GCadForm.FFiguresDelManual.add(FFigure); for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin Selfigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(Selfigure, cTOrthoLine) then begin if FFigure <> SelFigure then GCadForm.FFiguresDelManual.add(SelFigure); end; end; { if F_ProjMan <> nil then begin for i := 0 to F_ProjMan.Tree_Catalog.SelectionCount - 1 do begin Obj := TTreeNode(F_ProjMan.Tree_Catalog.Selections[i]).Data; CurrComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(obj.ObjectID); if Assigned(CurrComponent) then begin CurrCatalog := CurrComponent.GetFirstParentCatalog; if CurrCatalog <> nil then begin vListCad := GetListByID(CurrCatalog.ListID); if vList <> nil then Selfigure := GetFigureByID(vListCad, CurrCatalog.SCSID); if FFigure <> SelFigure then GCadForm.FFiguresDelManual.add(SelFigure); end; end; end; end; } end; if FFigure <> nil then begin GCadForm.PCad.OnBeforeDelete := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin // Tolik 18/11/2016-- райз с поинта удалится по-любому, даже если к удаляемому точечному присоединены трассы //(на уровне поинта) + трассы на уровне противоположного коннеткора райза, которые в этой точке нужно бы переконнектить {if not CheckCannotDelete(FFigure) then TConnectorObject(FFigure).Delete(True);} if not CheckCannotDelete(FFigure) then begin // TConnectorObject(FFigure).Delete(True); DelRaiseFromPointObject := CanDelRaiseFromPointObject(TConnectorObject(FFigure)); TConnectorObject(FFigure).Delete(true, DelRaiseFromPointObject); end end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not CheckCannotDelete(FFigure) then TOrthoLine(FFigure).Delete; end; GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete; end; // удалить все выделенные // Tolik 21/04/2017 -- for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin if DelFiguresList.IndexOf(TFigure(GCadForm.PCad.Selection[i])) = -1 then DelFiguresList.Add(TFigure(GCadForm.PCad.Selection[i])); end; // //for i := 0 to GCadForm.PCad.SelectedCount - 1 do for i := 0 to DelFiguresList.Count - 1 do begin //FFigure := TFigure(GCadForm.PCad.Selection[i]); FFigure := TFigure(DelFiguresList[i]); GCadForm.PCad.OnBeforeDelete := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not TConnectorObject(FFigure).Deleted then // Tolik 25/05/2021 -- if not CheckCannotDelete(FFigure) then TConnectorObject(FFigure).Delete(True); end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin //Tolik SCSCatalog := nil; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FFigure.ID); if SCSCatalog <> nil then begin for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := nil; SCSComponent := SCSCatalog.ComponentReferences[j]; if SCSComponent <> nil then SCSComponent.ServToDelete := true; end; end; // if not CheckCannotDelete(FFigure) then TOrthoLine(FFigure).Delete; end; GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete; end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; except on E: Exception do begin addExceptionToLogEx('TFSCS_Main.aDeleteSCSObjectExecute', E.Message); // Toilk 21/04/2017 -- GCanRefreshCad := RefreshFlag; // end; end; EndProgress; // Tolik 07/02/2017 -- if vList <> nil then FreeAndNil(vList); DelFiguresList.Free; // 21/05/2018 -- // // Toilk 21/04/2017 -- GCanRefreshCad := RefreshFlag; GCadForm.PCad.Refresh; // end; procedure TFSCS_Main.aShowConnFullnessExecute(Sender: TObject); begin try if aShowConnFullness.Checked = True then GCadForm.FShowConnFullness := True; if aShowConnFullness.Checked = False then GCadForm.FShowConnFullness := False; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowConnFullnessExecute', E.Message); end; end; procedure TFSCS_Main.aShowCableFullnessExecute(Sender: TObject); begin try if aShowCableFullness.Checked = True then begin GCadForm.FShowCableFullness := True; aShowCableChannelFullness.Checked := False; GCadForm.FShowCableChannelFullness := False; end; if aShowCableFullness.Checked = False then begin GCadForm.FShowCableFullness := False; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowCableFullnessExecute', E.Message); end; end; procedure TFSCS_Main.aShowCableChannelFullnessExecute(Sender: TObject); begin try if aShowCableChannelFullness.Checked = True then begin GCadForm.FShowCableChannelFullness := True; aShowCableFullness.Checked := False; GCadForm.FShowCableFullness := False; end; if aShowCableChannelFullness.Checked = False then GCadForm.FShowCableChannelFullness := False; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowCableChannelFullnessExecute', E.Message); end; end; procedure TFSCS_Main.aCreateObjectOnClickToolExecute(Sender: TObject); var ToolClassName: String; ToolData: Integer; begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 if GCadForm.FCreateObjectOnClick = True then begin if tbCADToolsExpert.Visible then begin tbSelectExpert.Click; tbSelectExpert.Down := True; end else begin tbSelectNoob.Click; tbSelectNoob.Down := True; end; DestroyShadowObject; end else begin //29.06.2010 aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := True; DefineCurrLayerByCompon; //29.06.2010 GCadForm.PCad.SetCursor(crDrag); RefreshCAD(GCadForm.PCad); GCadForm.PCad.SetTool(toSelect, 'TSelected'); DropCreatedObjCountOnClickInList(GCadForm.FCADListID); //#From Oleg# CreateShadowObject; // На CAD end; {$IF Defined(ES_GRAPH_SC)} if Not GCadForm.PCad.Focused then begin SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0); GCadForm.PCad.SetFocus; end; // Tolik -- 31/01/2017 -- чтобы правильно выставить тулзу рисования для // архитектурного проектирования if TF_Main(F_NormBase).GSCSBase.SCSComponent.ID <> 0 then begin if IsArchTopComponByIsLine(TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine) or (TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then begin ToolClassName := ''; ToolData := TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine; if (TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then FSCS_Main.SetToolArch('TWallDivPath') else if IsArchTopComponByIsLine(TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine) then begin if TF_Main(F_NormBase).Act_DrawModePoly.Checked then ToolClassName := 'TWallPolyPath' else ToolClassName := 'TRoomWallRect'; end; if ToolClassName <> '' then FSCS_Main.SetToolArch(ToolClassName, ToolData); end; end else TF_Main(F_NormBase).Act_EditTemplate.Execute; // //GCadForm.SetFocus; {$IFEND} end else begin if tbCADToolsExpert.Visible then tbCreateOnClickModeExpert.Down := False else tbCreateOnClickModeNoob.Down := False; MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; end; procedure TFSCS_Main.aTileWindowsExecute(Sender: TObject); begin FSCS_Main.Tile; end; procedure TFSCS_Main.aCascadeWindowsExecute(Sender: TObject); begin FSCS_Main.Cascade; end; procedure TFSCS_Main.CheckClose; begin try GexitProg := False; if MessageBox(FSCS_Main.Handle, cMain_Mes49, cMain_Mes50, MB_YESNO) = IDYes then begin //if CloseCurrProject(true) <> IDCancel then GExitProg := True; // Tolik -- 09/03/2016 -- GExitProgEX := True; // end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.CheckClose', E.Message); end; end; procedure TFSCS_Main.WMAct(var msg: TMessage); begin if not Assigned(FSCS_Main) then Exit; end; procedure TFSCS_Main.aReport_CablesWithLimitLengthExecute(Sender: TObject); begin RepCableExceedLength; end; procedure TFSCS_Main.aReport_CableChannelsExecute(Sender: TObject); begin RepCableCanal; end; procedure TFSCS_Main.aReport_ConnectByColorsExecute(Sender: TObject); begin RepDisparityComponColor; end; procedure TFSCS_Main.aReport_ConnectByProducerExecute(Sender: TObject); begin RepDisparityComponProducer; end; procedure TFSCS_Main.aReport_ConnectionsExecute(Sender: TObject); begin RepCableJournal; end; procedure TFSCS_Main.aReport_SpecificationExecute(Sender: TObject); begin RepSpecification; end; procedure TFSCS_Main.aReport_CableJournalExtExecute(Sender: TObject); begin RepCableJournalExt; end; procedure TFSCS_Main.aInsertBlockExecute(Sender: TObject); var BlkName: string; FDir: string; OpenDialog: TOpenDialog; begin try if ActiveMDIChild <> nil then begin OpenDialog := TOpenDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.blk') then FDir := FDir + '\.blk'; OpenDialog.Title := cMain_Mes51; OpenDialog.InitialDir := FDir; OpenDialog.DefaultExt := 'blk'; OpenDialog.Filter := cMain_Mes52; if OpenDialog.Execute then begin BlkName := OpenDialog.FileName; try GCadForm.CurrentLayer := 1; GCadForm.PCad.InsertBlockwithFileName(GCadForm.PCad.ActiveLayer, BlkName, 20, 20); except ShowMessage(cMain_Mes53); end; end; OpenDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aInsertBlockExecute', E.Message); end; end; //procedure TFSCS_Main.aCreateBlockToNBExecute(Sender: TObject); //var // BlkName: string; // FullBlkName: string; // MetaFile: TMetafile; // Bitmap: TBitmap; // FDir: string; // Buffer: array[0..1023] of Char; // TempPath: string; // //begin // try // if ActiveMDIChild <> nil then // begin // if GCadForm.PCad.SelectedCount > 0 then // begin // SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); // if not DirectoryExists(TempPath) then // TempPath := GetEXEDir + '\'; // BlkName := cMain_Mes54; // FullBlkName := TempPath + cMain_Mes54; // // GCadForm.PCad.MakeSelectionBlock(FullBlkName + '.blk'); // MetaFile := TMetafile.Create; // Bitmap := TBitmap.Create; // MetaFile := GCadForm.PCad.SelectionAsWmf; // Bitmap.Height := Metafile.Height; // Bitmap.Width := Metafile.Width; // Bitmap.Canvas.Draw(0, 0, MetaFile); // //BitmapToNormalSize(Bitmap, 75); // // Bitmap.SaveToFile(FullBlkName + '.bmp'); // FreeAndNil(MetaFile); // FreeAndNil(Bitmap); // AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk'); // if FileExists(FullBlkName + '.bmp') then // DeleteFile(FullBlkName + '.bmp'); // if FileExists(FullBlkName + '.blk') then // DeleteFile(FullBlkName + '.blk'); // end; // end; // except // on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockExecute', E.Message); // end; //end; procedure TFSCS_Main.aCreateBlockToNBExecute(Sender: TObject); var BlkName: string; FullBlkName: string; FullBlkNameOr: string; FullBlkName1: string; FullBlkName2: string; MetaFile: TMetafile; Bitmap: TBitmap; FDir: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; SelList: TList; Block: TBlock; i: integer; begin try if ActiveMDIChild <> nil then begin if GCadForm.PCad.SelectedCount > 0 then begin TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer)); if not DirectoryExists(TempPath) then TempPath := GetEXEDir + '\'; BlkName := cMain_Mes54; FullBlkName := TempPath + cMain_Mes54; if GCadForm.PCad.SelectedCount = 2 then begin SelList := TList.Create; for i := 0 to GCadForm.PCad.Selection.Count - 1 do SelList.Add(GCadForm.PCad.Selection[i]); for i := 0 to SelList.Count - 1 do begin GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle); end; FullBlkName1 := FullBlkName; FullBlkName2 := FullBlkName; FullBlkNameOr := FullBlkName; if TFigure(SelList[0]).CenterPoint.x > TFigure(SelList[1]).CenterPoint.x then FullBlkName1 := FullBlkName + '_active' else FullBlkName2 := FullBlkName + '_active'; for i := 0 to SelList.Count - 1 do begin FullBlkName := FullBlkName1; if i = 1 then FullBlkName := FullBlkName2; GCadForm.PCad.SelectFigure(TFigure(SelList[i]).Handle); //GCadForm.PCad.Refresh; Block := nil; if (TFigure(SelList[i]) is TBlock) then Block := TBlock(TBlock(SelList[i]).duplicate) else if (TFigure(SelList[i]) is TFigureGrp) then Block := TBlock(TFigureGrp(SelList[i]).duplicate) else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; //GCadForm.PCad.Refresh; Block := nil; if (TFigure(SelList[i]) is TBlock) then Block := TBlock(TBlock(SelList[i]).duplicate) else if (TFigure(SelList[i]) is TFigureGrp) then Block := TBlock(TFigureGrp(SelList[i]).duplicate) else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; GCadForm.PCad.Refresh; Block := nil; //if (TFigure(SelList[i]) is TBlock) then // Block := TBlock(TBlock(SelList[i]).duplicate) //else if (TFigure(SelList[i]) is TFigureGrp) then // Block := TBlock(TFigureGrp(SelList[i]).duplicate) //else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); //Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения //BlockToNormalSize(Block, 150); //MetaFile := TMetafile.Create; //Bitmap := TBitmap.Create; //MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); //Bitmap.Height := Metafile.Height; //Bitmap.Width := Metafile.Width; //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.SaveToFile(FullBlkName + '.bmp'); //FreeAndNil(MetaFile); //FreeAndNil(Bitmap); if Block <> nil then begin //Block.InFigures.Clear; Block.Free; end; GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle); GCadForm.PCad.Refresh; end; AddObjectIconFromCADToDirectories(BlkName, FullBlkNameOr + '.bmp', FullBlkNameOr + '.blk'); if FileExists(FullBlkName1 + '.bmp') then DeleteFile(FullBlkName1 + '.bmp'); if FileExists(FullBlkName1 + '.blk') then DeleteFile(FullBlkName1 + '.blk'); if FileExists(FullBlkName2 + '.bmp') then DeleteFile(FullBlkName2 + '.bmp'); if FileExists(FullBlkName2 + '.blk') then DeleteFile(FullBlkName2 + '.blk'); SelList.Clear; FreeAndNil(SelList); end else begin Block := nil; Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); //AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk'); if FileExists(FullBlkName + '.bmp') then DeleteFile(FullBlkName + '.bmp'); if FileExists(FullBlkName + '.blk') then DeleteFile(FullBlkName + '.blk'); if Block <> nil then begin //Block.InFigures.Clear; Block.Free; end; Block := nil; Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk'); if FileExists(FullBlkName + '.bmp') then DeleteFile(FullBlkName + '.bmp'); if FileExists(FullBlkName + '.blk') then DeleteFile(FullBlkName + '.blk'); if Block <> nil then begin //Block.InFigures.Clear; Block.Free; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockExecute', E.Message); end; end; procedure TFSCS_Main.aBlocksEditorExecute(Sender: TObject); begin F_BlockEditor.ShowModal; end; procedure TFSCS_Main.aRotatePointObject90Execute(Sender: TObject); var i: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; // Tolik -- 03/10/2016 -- SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GCadForm.PCad.SelectedCount > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then begin PointObject := TConnectorObject(FFigure); if CheckTrunkObject(PointObject) then begin RotateTrunkObject(PointObject, 90); Exit; end; AngleRad := 90 / 180 * pi; PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]); PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint); PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; Bnd := PointObject.DrawFigure.GetBoundRect; PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // CurrCaptionAngle := 0; //#From Oleg# //14.09.2010 if PointObject.FCaptionsViewType = cv_Right then CurrCaptionAngle := 0; if PointObject.FCaptionsViewType = cv_Down then CurrCaptionAngle := 90; if PointObject.FCaptionsViewType = cv_Left then CurrCaptionAngle := 180; if PointObject.FCaptionsViewType = cv_Up then CurrCaptionAngle := 270; CurrCaptionAngle := CurrCaptionAngle + 90; CurrCaptionAngle := round(CurrCaptionAngle) mod 360; if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then PointObject.FCaptionsViewType := cv_Right else if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then PointObject.FCaptionsViewType := cv_Down else if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then PointObject.FCaptionsViewType := cv_Left else if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then PointObject.FCaptionsViewType := cv_Up else if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then PointObject.FCaptionsViewType := cv_Right; PointObject.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end else RotateFigure(FFigure, 90); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject90Execute', E.Message); end; //GCadForm.FCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.aRotatePointObject180Execute(Sender: TObject); var i: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; // Tolik SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GCadForm.PCad.SelectedCount > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then begin PointObject := TConnectorObject(FFigure); if CheckTrunkObject(PointObject) then begin RotateTrunkObject(PointObject, 180); Exit; end; AngleRad := 180 / 180 * pi; PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]); PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint); PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; Bnd := PointObject.DrawFigure.GetBoundRect; PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // if PointObject.FCaptionsViewType = cv_Right then CurrCaptionAngle := 0; if PointObject.FCaptionsViewType = cv_Down then CurrCaptionAngle := 90; if PointObject.FCaptionsViewType = cv_Left then CurrCaptionAngle := 180; if PointObject.FCaptionsViewType = cv_Up then CurrCaptionAngle := 270; CurrCaptionAngle := CurrCaptionAngle + 180; CurrCaptionAngle := round(CurrCaptionAngle) mod 360; if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then PointObject.FCaptionsViewType := cv_Right else if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then PointObject.FCaptionsViewType := cv_Down else if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then PointObject.FCaptionsViewType := cv_Left else if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then PointObject.FCaptionsViewType := cv_Up else if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then PointObject.FCaptionsViewType := cv_Right; PointObject.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end else RotateFigure(FFigure, 180); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject180Execute', E.Message); end; //GCadForm.FCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.aRotatePointObject270Execute(Sender: TObject); var i: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; // Tolik 03/10/2016 -- SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GCadForm.PCad.SelectedCount > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then begin PointObject := TConnectorObject(FFigure); if CheckTrunkObject(PointObject) then begin RotateTrunkObject(PointObject, 270); Exit; end; AngleRad := 270 / 180 * pi; PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]); PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint); PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad; if PointObject.FDrawFigureAngle >= 2 * pi then PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi; Bnd := PointObject.DrawFigure.GetBoundRect; PointObject.GrpSizeX := Bnd.Right - Bnd.Left; PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top; // if PointObject.FCaptionsViewType = cv_Right then CurrCaptionAngle := 0; if PointObject.FCaptionsViewType = cv_Down then CurrCaptionAngle := 90; if PointObject.FCaptionsViewType = cv_Left then CurrCaptionAngle := 180; if PointObject.FCaptionsViewType = cv_Up then CurrCaptionAngle := 270; CurrCaptionAngle := CurrCaptionAngle + 270; CurrCaptionAngle := round(CurrCaptionAngle) mod 360; if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then PointObject.FCaptionsViewType := cv_Right else if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then PointObject.FCaptionsViewType := cv_Down else if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then PointObject.FCaptionsViewType := cv_Left else if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then PointObject.FCaptionsViewType := cv_Up else if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then PointObject.FCaptionsViewType := cv_Right; PointObject.DefRaizeDrawFigurePos; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end else RotateFigure(FFigure, 270); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aRotatePointObject270Execute', E.Message); end; //GCanForm.FCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.AppException(Sender: TObject; E: Exception); var s: string; begin s := E.Message; if GExitProgEx then {$if Defined(ES_GRAPH_SC)} begin Application.Terminate; end; {$else} ExitProcess(0); {$ifend} end; procedure TFSCS_Main.aShiftUpObjectExecute(Sender: TObject); //30.05.2011 var //30.05.2011 i: integer; //30.05.2011 ConnObjList: TList; //30.05.2011 LinesList: TList; begin try ShiftObjects(sdUp); //30.05.2011 //30.05.2011 // if ActiveMDIChild <> nil then // begin // // // список выделенных объектов // ConnObjList := TList.Create; // LinesList := TList.create; // for i := 0 to GCadForm.PCad.SelectedCount - 1 do // begin // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then // if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then // ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i])); // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then // if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then // LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i])); // end; // // if (ConnObjList.Count > 0) or (LinesList.Count > 0) then // begin // // *UNDO* // if GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := False; // end; // if ConnObjList.Count > 0 then // ObjectsShiftUp(ConnObjList); // if LinesList.Count > 0 then // LinesShiftUp(LinesList); // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // // if ConnObjList <> nil then // FreeAndNil(ConnObjList); // if LinesList <> nil then // FreeAndNil(LinesList); // RefreshCAD(GCadForm.PCad); // end // else // MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftUpObjectExecute', E.Message); end; end; procedure TFSCS_Main.aShieldAssemblySchemeExecute(Sender: TObject); begin BuildWiringSchemeList; end; procedure TFSCS_Main.aShiftDownObjectExecute(Sender: TObject); //30.05.2011 var //30.05.2011 i: integer; //30.05.2011 ConnObjList: TList; //30.05.2011 LinesList: TList; begin try ShiftObjects(sdDown); //30.05.2011 //30.05.2011 //if ActiveMDIChild <> nil then // begin // // список выделенных объектов // ConnObjList := TList.Create; // LinesList := TList.create; // for i := 0 to GCadForm.PCad.SelectedCount - 1 do // begin // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then // if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then // ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i])); // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then // if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then // LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i])); // end; // if (ConnObjList.Count > 0) or (LinesList.Count > 0) then // begin // // *UNDO* // if GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := False; // end; // if ConnObjList.Count > 0 then // ObjectsShiftDown(ConnObjList); // if LinesList.Count > 0 then // LinesShiftDown(LinesList); // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // // if ConnObjList <> nil then // FreeAndNil(ConnObjList); // if LinesList <> nil then // FreeAndNil(LinesList); // RefreshCAD(GCadForm.PCad); // // if BeforeShiftObjects(ConnObjList, LinesList, FigList) then // begin // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // EndShiftObjects(ConnObjList, LinesList, FigList); // end // else // MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftDownObjectExecute', E.Message); end; end; procedure TFSCS_Main.aShiftLeftObjectExecute(Sender: TObject); //30.05.2011 var //30.05.2011 i: integer; //30.05.2011 ConnObjList: TList; //30.05.2011 LinesList: TList; //30.05.2011 FigList: TList; begin try ShiftObjects(sdLeft); //30.05.2011 //30.05.2011 //if ActiveMDIChild <> nil then // begin // // список выделенных объектов // ConnObjList := TList.Create; // LinesList := TList.create; // for i := 0 to GCadForm.PCad.SelectedCount - 1 do // begin // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then // if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then // ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i])); // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then // if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then // LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i])); // end; // if (ConnObjList.Count > 0) or (LinesList.Count > 0) then // begin // // *UNDO* // if GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := False; // end; // if ConnObjList.Count > 0 then // ObjectsShiftLeft(ConnObjList); // if LinesList.Count > 0 then // LinesShiftLeft(LinesList); // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // // if ConnObjList <> nil then // FreeAndNil(ConnObjList); // if LinesList <> nil then // FreeAndNil(LinesList); // RefreshCAD(GCadForm.PCad); // // if BeforeShiftObjects(ConnObjList, LinesList, FigList) then // begin // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // EndShiftObjects(ConnObjList, LinesList, FigList); // end // else // MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftLeftObjectExecute', E.Message); end; end; procedure TFSCS_Main.aShiftRightObjectExecute(Sender: TObject); //30.05.2011 var //30.05.2011 i: integer; //30.05.2011 ConnObjList: TList; //30.05.2011 LinesList: TList; //30.05.2011 FigList: TList; begin try ShiftObjects(sdRight); //30.05.2011 //30.05.2011 //if ActiveMDIChild <> nil then // begin // // список выделенных объектов // ConnObjList := TList.Create; // LinesList := TList.create; // for i := 0 to GCadForm.PCad.SelectedCount - 1 do // begin // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then // if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then // ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i])); // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then // if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then // LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i])); // end; // if (ConnObjList.Count > 0) or (LinesList.Count > 0) then // begin // // *UNDO* // if GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := False; // end; // if ConnObjList.Count > 0 then // ObjectsShiftRight(ConnObjList); // if LinesList.Count > 0 then // LinesShiftRight(LinesList); // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // // if ConnObjList <> nil then // FreeAndNil(ConnObjList); // if LinesList <> nil then // FreeAndNil(LinesList); // RefreshCAD(GCadForm.PCad); // // if BeforeShiftObjects(ConnObjList, LinesList, FigList) then // begin // // *UNDO* // GCadForm.FCanSaveForUndo := True; // end; // EndShiftObjects(ConnObjList, LinesList, FigList); // end // else // MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftRightObjectExecute', E.Message); end; end; procedure TFSCS_Main.RegisteredCADHotKeys; var GLogFile: TMyLoglist; begin end; procedure TFSCS_Main.UnRegisteredCADHotKeys; var GLogFile: TMyLoglist; begin end; function strtoPchar(s:string):Pchar; begin S := S+#0; result:=StrPCopy(@S[1], S) ; end; procedure TFSCS_Main.ReceiveMessage; var pcd: PCopyDataStruct; txt: PChar; begin try pcd := PCopyDataStruct(Msg.LParam); txt := PChar(pcd.lpData); OpenFileAtStart := txt; if OpenFileAtStart <> '' then if FileExists(OpenFileAtStart) then TimerOpenStart.Enabled := True; except end; Application.Restore; end; procedure TFSCS_Main.WMUser(var msg: TMessage); begin Application.Restore; end; procedure TFSCS_Main.aListPropertiesExecute(Sender: TObject); var ListParams: TListParams; begin try if ActiveMDIChild <> nil then begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin F_MasterNewList.Tag := 1; F_MasterNewList.ListPageControl.ActivePageIndex := 0; F_MasterNewList.RzGroupBox12.Height := 192; ListParams := GetListParams(GCadForm.FCADListID); MakeEditList(meEdit, ListParams, True); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aListPropertiesExecute', E.Message); end; end; procedure TFSCS_Main.aProjectPropertiesExecute(Sender: TObject); begin try F_MasterNewList.Caption := cMasterNewList_Mes3; F_MasterNewList.GlobalPageControl.ActivePageIndex := 0; F_MasterNewList.ShowModal; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aProjectPropertiesExecute', E.Message); end; end; procedure TFSCS_Main.aOpenProjectAtCurrNodeExecute(Sender: TObject); begin OpenProjectAtCurrNode; end; procedure TFSCS_Main.aCloseCurrProjectExecute(Sender: TObject); begin // Tolik -- 28/02/20107 -- сбросить счетчик вызовов сообщения о превышении квоты объектов USER GUserOBjectsQuotaLimit_Message_Counter := 0; GCanRefreshCad := False; // try CloseCurrProject(false); Except On E: Exception do; end; GCanRefreshCad := True; // Tolik -- 03/03/2017 -- // SetMenuStatus(False); end; procedure TFSCS_Main.aLoadNewProjectFromFileExecute(Sender: TObject); // Tolik -- 28/02/20107 -- для проверки превышения квоты -- var OldQuotaMessCount: Integer; // begin // {$IF Defined(TRIAL_SCS)} // ShowMessage('Недоступно в Trial-версии!'); // {$ELSE} if GProtectionType <> ltLocal then begin ProgProtection.CheckIsVerls(PRO); ConnCount := ConnCount XOR $1978; ConnCount := ConnCount SHR 6; ConnCount := ConnCount AND $0000ffff; if GetCurrConnectionCount > ConnCount then exit; end; // Tolik -- 21/02/2017 -*- // LoadNewProjectFromFile; GUserOBjectsQuotaLimit_Message_Counter := 0; // при открытии нового проекта подразумевается, что остальные закрыты, // поэтому счетчик сообщений о превышении квоты объектов USER -*- сбрасываем OldQuotaMessCount := GUserOBjectsQuotaLimit_Message_Counter; GIsProjectOpening := True; // чтобы понимать, что в данный момент открывается проект LoadNewProjectFromFile; if OldQuotaMessCount <> GUserOBjectsQuotaLimit_Message_Counter then begin // showmessage('Превышение квоты! Невозможно загрузить проект !!! '); end; if Assigned(GCadForm) then begin F_LayersDialog.LoadFromCADForm(GCadForm); SetProjectChanged(false); end; GIsProjectOpening := False; // // SetMenuStatus(True); // {$IFEND} end; procedure TFSCS_Main.aSaveAsSCSProjectExecute(Sender: TObject); var i: integer; SelCheck: integer; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} SelCheck := 0; if Not IsVista then begin Randomize; SelCheck := Random(100); if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then exit; end; {$IFEND} {$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)} ShowMessage(cMain_Mes9); {$ELSE} SaveProjectToFile; {$IFEND} end; { TMyLoglist } procedure TMyLoglist.Add(aStr: string); begin try StrList.Add(aStr); StrList.SaveToFile(FFileName); except end; end; constructor TMyLoglist.Create(aFName: string); begin inherited create; FFileName := aFName; StrList := TStringList.Create; end; destructor TMyLoglist.Destroy; begin StrList.Free; inherited; end; procedure TFSCS_Main.aComponPropertiesExecute(Sender: TObject); var ClickFigure: TFigure; SelCount: integer; begin try if GPopupFigure = Nil then begin if GCadForm.PCad.SelectedCount > 0 then begin SelCount := GCadForm.PCad.SelectedCount; GPopupFigure := TFigure(GCadForm.PCad.Selection[SelCount - 1]); end; end; if GPopupFigure <> nil then EditFirstFigureComponent(GPopupFigure.ID); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aObjPropertiesExecute', E.Message); end; end; procedure TFSCS_Main.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin try CanClose := False; GExitProg := False; CheckClose; if GExitProg then CanClose := True; GexitProg := True; except on E: Exception do addExceptionToLogEx('TFSCS_Main.FormCloseQuery', E.Message); end; end; procedure TFSCS_Main.aToolPanExecute(Sender: TObject); var HPos, VPos: integer; begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 if GCadForm.PCad.Tag = 0 then begin { HPos := GCadForm.PCad.HSCBarPosition; VPos := GCadForm.PCad.VSCBarPosition; PDock2.Width := PDock2.Width + 1; Application.ProcessMessages; PDock2.Width := PDock2.Width - 1; GCadForm.PCad.Tag := 1; GCadForm.PCad.SetHScrollPosition(HPos, False); GCadForm.PCad.SetVScrollPosition(VPos, True); } end; GIsMousePressed := False; GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- //GCadForm.ChangeScrollsOnChangeListSize; GCadForm.PCad.SetTool(TPCTool(11), ''); end; end; procedure TFSCS_Main.cbScalePropertiesCloseUp(Sender: TObject); begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin if tbCADToolsExpert.Visible then begin if cbScaleExpert.ItemIndex = 0 then if GCadForm.PCad.ZoomScale <> 50 then a50.Execute; if cbScaleExpert.ItemIndex = 1 then if GCadForm.PCad.ZoomScale <> 75 then a75.Execute; if cbScaleExpert.ItemIndex = 2 then if GCadForm.PCad.ZoomScale <> 100 then a100.Execute; if cbScaleExpert.ItemIndex = 3 then if GCadForm.PCad.ZoomScale <> 150 then a150.Execute; if cbScaleExpert.ItemIndex = 4 then if GCadForm.PCad.ZoomScale <> 200 then a200.Execute; if cbScaleExpert.ItemIndex = 5 then if GCadForm.PCad.ZoomScale <> 400 then a400.Execute; if cbScaleExpert.ItemIndex = 6 then aAllScreen.Execute; end else begin if cbScaleNoob.ItemIndex = 0 then if GCadForm.PCad.ZoomScale <> 50 then a50.Execute; if cbScaleNoob.ItemIndex = 1 then if GCadForm.PCad.ZoomScale <> 75 then a75.Execute; if cbScaleNoob.ItemIndex = 2 then if GCadForm.PCad.ZoomScale <> 100 then a100.Execute; if cbScaleNoob.ItemIndex = 3 then if GCadForm.PCad.ZoomScale <> 150 then a150.Execute; if cbScaleNoob.ItemIndex = 4 then if GCadForm.PCad.ZoomScale <> 200 then a200.Execute; if cbScaleNoob.ItemIndex = 5 then if GCadForm.PCad.ZoomScale <> 400 then a400.Execute; if cbScaleNoob.ItemIndex = 6 then aAllScreen.Execute; end; end; // RefreshCAD(GCadForm.PCad); end; procedure TFSCS_Main.cbScaleExpertKeyPress(Sender: TObject; var Key: Char); var val: integer; begin if Key = #13 then begin if tbCADToolsExpert.Visible then Val := StrToInt(FSCS_Main.cbScaleExpert.Text) else Val := StrToInt(FSCS_Main.cbScaleNoob.Text); // if Val < 50 then - // Val := 50; if Val > GCadForm.PCad.MaxScale then Val := GCadForm.PCad.MaxScale; if tbCADToolsExpert.Visible then FSCS_Main.cbScaleExpert.Text := IntToStr(Val) else FSCS_Main.cbScaleNoob.Text := IntToStr(Val); if GCadForm.PCad.ZoomScale <> val then begin GCadForm.SetZoomScale(val); RefreshCAD(GCadForm.PCad); end; end; end; procedure TFSCS_Main.cbLayersPropertiesCloseUp(Sender: TObject); begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin GCadForm.CurrentLayer := FSCS_Main.cbLayers.ItemIndex + 1; if FSCS_Main.tbCADToolsExpert.Visible then FSCS_Main.tbSelectExpert.Down := True else FSCS_Main.tbSelectNoob.Down := True; end; try if (Application.Active) and (GCadForm <> nil) and (GCadForm.PCad <> nil) then if Not GCadForm.PCad.Focused then begin SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0); GCadForm.PCad.SetFocus; end; except ShowMessage('EXCEPTION: TFSCS_Main.cbLayersPropertiesCloseUp (Set PCAD focus)'); end; end; procedure TFSCS_Main.cbLayersCloseUp(Sender: TObject); begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin GCadForm.CurrentLayer := FSCS_Main.cbLayers.ItemIndex; end; end; procedure TFSCS_Main.aDisconnectPointObjectExecute(Sender: TObject); var i: integer; CurObject: TConnectorObject; SelList: TList; // Tolik 03/10/2016 -- SavedUndoFlag: Boolean; // begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try if GPopupFigure = nil then exit; SelList := TList.Create; // отбор объектов for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then begin CurObject := TConnectorObject(GCadForm.PCad.Selection[i]); if CurObject.ConnectorType <> ct_Clear then if CurObject.JoinedConnectorsList.Count > 0 then SelList.Add(CurObject); end; end; if SelList.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to SelList.Count - 1 do begin CurObject := TConnectorObject(SelList[i]); DisconnectPointObject(CurObject); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; FreeAndNil(SelList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectPointObjectExecute', E.Message); end; //GCadForm.fFCanSaveForUndo := SavedUndoFlag; end; procedure TFSCS_Main.cxComboBox1Enter(Sender: TObject); begin FSCS_Main.OldApplicationEventsMessage := Application.OnMessage; Application.OnMessage := FSCS_Main.ApplicationEvents1Message; end; procedure TFSCS_Main.mRegisterClick(Sender: TObject); var TempList: TStringList; begin {$IF Defined (FINAL_SCS)} //GReadOnlyMode := false; ProgramRegisterPro := false; ProgramRegisterTrial := false; ProgID := ProgProtection.GenProgID; ProgramRegisterPro := ProgProtection.CheckIsVer(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVer(TRIAL); GLicProgCode := ProgIDToStr(ProgID); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; try //TempList.Add('0'); RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0); except begin MessageBeep(MB_ICONASTERISK); if Not ShowRegistration then begin end; ProgramRegisterPro := ProgProtection.CheckIsVerls(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVerls(TRIAL); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; Application.ProcessMessages; end; end; {$ELSE} GReadOnlyMode := false; ProgramRegisterPro := True; GLicProgCode := ProgIDToStr(ProgID); {$IFEND} end; procedure TFSCS_Main.aRepWizardExecute(Sender: TObject); var i: integer; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if Not IsVista then begin for i := 0 to 6 do begin if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) <> 0 then begin exit; end; end; end; {$IFEND} CheckCloseReportForm; // Toilk 30/04/2021 -- RepWizard; end; procedure TFSCS_Main.aSaveAsBMPExecute(Sender: TObject); var FName: string; FDir: string; SavePictureDialog: TSavePictureDialog; begin if ActiveMDIChild <> nil then begin SavePictureDialog := TSavePictureDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.bmp') then FDir := FDir + '\.bmp'; SavePictureDialog.Title := cMain_Mes56; SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir; SavePictureDialog.DefaultExt := 'bmp'; SavePictureDialog.Filter := cMain_Mes57; if SavePictureDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName)); // FName := SavePictureDialog.FileName; GCadForm.SetZoomScale(GCadForm.Pcad.ZoomScale); RefreshCAD_T(GCadForm.PCad); GCadForm.PCad.SaveAsBitmap(FName); GCadForm.SetZoomScale(GCadForm.Pcad.ZoomScale); RefreshCAD_T(GCadForm.PCad); except ShowMessage(cMain_Mes8); end; end; SavePictureDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aShowTracesLengthLimitExecute(Sender: TObject); begin try if aShowTracesLengthLimit.Checked = True then begin GCadForm.FShowTracesLengthLimit := True; DefineTracesWithExceedTwistedPair(GCadForm.FCADListID); end; if aShowTracesLengthLimit.Checked = False then begin GCadForm.FShowTracesLengthLimit := False; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowTracesLengthLimitExecute', E.Message); end; end; procedure TFSCS_Main.aSaveProjectExecute(Sender: TObject); var i: integer; begin // Tolik -- 29/12/2016 -- // если что-то еще в процессе - нехуй выполнять запись, а то такое поназаписывается! if (GIsProgress or (GIsProgressCount > 0)) then Exit; // if GProtectionType <> ltLocal then begin ProgProtection.CheckIsVerls(PRO); ConnCount := ConnCount XOR $1978; ConnCount := ConnCount SHR 6; ConnCount := ConnCount AND $0000ffff; if GetCurrConnectionCount > ConnCount then exit; end; {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if Not IsVista then begin for i := 0 to 9 do begin if ((ord(bufflic[i mod 16]) XOR $3A) - (Digest[i mod 16]))<> 0 then begin exit; end; end; end; {$IFEND} try SaveCurrentProject; // очистить Undo листы после сохранения проекта (не факт что нужно) // for i := 0 to MDIChildCount - 1 do // begin // TF_CAD(MDIChildren[i]).ClearUndoList; // end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveProjectExecute', E.Message); end; end; procedure TFSCS_Main.aCurrProjectPropertiesExecute(Sender: TObject); begin ShowCurrProjectProperties; end; procedure TFSCS_Main.aManual_CurrencyExecute(Sender: TObject); begin ShowCurrencyDirectory; end; procedure TFSCS_Main.aManual_NettypesExecute(Sender: TObject); begin ShowNetTypeDirectory; end; procedure TFSCS_Main.aManual_ProducersExecute(Sender: TObject); begin ShowProducersDirectory; end; procedure TFSCS_Main.aManual_InterfacesExecute(Sender: TObject); begin ShowInterfaceDirectory; end; procedure TFSCS_Main.aManual_ObjPropExecute(Sender: TObject); begin ShowPropertyDirectory; end; procedure TFSCS_Main.aManual_LegendsExecute(Sender: TObject); begin ShowObjectIconsDirectory; end; procedure TFSCS_Main.aManual_ComponTypesExecute(Sender: TObject); begin ShowComponentTypesDirectory; end; procedure TFSCS_Main.aManual_NormsExecute(Sender: TObject); begin ShowNormsDirectory; end; procedure TFSCS_Main.aManual_ResourcesExecute(Sender: TObject); begin ShowResourcesDirectory; end; procedure TFSCS_Main.aManual_NDSExecute(Sender: TObject); begin ShowNDSDirectory; end; procedure TFSCS_Main.aDesignBoxExecute(Sender: TObject); var CurrGCadForm: TF_CAD; ListID: Integer; ListCaption: string; aPopupFigure: TConnectorObject; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then begin // Создание листа Дизайна шкафа if TConnectorObject(GPopupFigure).FJoinedListIDForBox = -1 then begin F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked := True; F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked := False; F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked := False; if F_ChooseDesignBoxParams.ShowModal = mrOK then begin CreateDesignList(TConnectorObject(GPopupFigure)); DisableOptionsForDesignList; end; end else // Переоткрытие листа Дизайна листа begin ListID := TConnectorObject(GPopupFigure).FJoinedListIDForBox; CurrGCadForm := GetListByID(ListID); if CurrGCadForm <> nil then begin OpenDesignList(TConnectorObject(GPopupFigure), CurrGCadForm); end else begin aPopupFigure := TConnectorObject(GPopupFigure); ListCaption := GetListParams(ListID).Caption; ReOpenListInCAD(ListID, ListCaption); GPopupFigure := aPopupFigure; OpenDesignList(TConnectorObject(GPopupFigure), GCadForm); end; DisableOptionsForDesignList; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxExecute', E.Message); end; end; procedure TFSCS_Main.aChoiceNBPathExecute(Sender: TObject); begin GDatabaseName := ''; ChoiceNBPath; end; procedure TFSCS_Main.aChoicePMPathExecute(Sender: TObject); begin GDatabaseName := ''; ChoicePMPath; end; procedure TFSCS_Main.aChoiceBaseOptionsExecute(Sender: TObject); begin ChoiceBaseOptions; end; procedure TFSCS_Main.aRegistrationExecute(Sender: TObject); var TempList: TStringList; begin {$IF Defined (FINAL_SCS)} //GReadOnlyMode := False; ProgramRegisterPro := false; ProgramRegisterTrial := false; ProgID := ProgProtection.GenProgID; ProgramRegisterPro := ProgProtection.CheckIsVer(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVer(TRIAL); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; GLicProgCode := ProgIDToStr(ProgID); try //TempList.Add('0'); RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0); except while 234 <> 912 do begin MessageBeep(MB_ICONASTERISK); if Not ShowRegistration then begin end; ProgramRegisterPro := ProgProtection.CheckIsVerls(PRO); ProgramRegisterTrial := ProgProtection.CheckIsVerls(TRIAL); if ProgramRegisterTrial then begin GReadOnlyMode := True; ProgramRegisterPro := True; end; if ProgramRegisterPro or ProgramRegisterTrial then break; Application.ProcessMessages; end; end; {$ELSE} GReadOnlyMode := False; ProgramRegisterPro := True; GLicProgCode := ProgIDToStr(ProgID); {$IFEND} end; procedure TFSCS_Main.aUpdateNormBaseExecute(Sender: TObject); begin UpdateNB; end; procedure TFSCS_Main.tbSCSToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject); begin tbSCSToolsDocking := true; end; procedure TFSCS_Main.tbSCSToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer); begin tbSCSToolsDocking := false; PDock1.DockSite := true; pDock2.DockSite := true; if (F_NormBase <> nil) and (F_ProjMan <> nil) then begin F_NormBase.Panel_Main.DockSite := true; F_ProjMan.Panel_Main.DockSite := true; end; end; procedure TFSCS_Main.FormResize(Sender: TObject); begin try if Assigned(F_FloatPanel) then if F_FloatPanel.ClassName = 'TF_FloatPanel' then ResizeFloatPanel; except end; try if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then begin tbSCSToolsExpert.Width := cSCSExpert; tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width; end; if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then begin {$IF DEFINED(SCS_PE) or DEFINED(SCS_SPA)} // Tolik 24/01/2017 //tbSCSToolsNoob.Width := cSCSNoob_PE; tbSCSToolsNoob.Width := cSCSNoob_PE + 20; // {$ELSE} // Tolik 24/01/2017 -- // tbSCSToolsNoob.Width := cSCSNoob_SCS; tbSCSToolsNoob.Width := cSCSNoob_SCS + 20; // {$IFEND} // Tolik -- 24/01/2017 // tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width; tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width; // end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.FormResize', E.Message); end; end; procedure TFSCS_Main.aHistoryExecute(Sender: TObject); var FileName: string; begin try FileName := ExeDir + '\Docs\History.doc'; if FileExists(FileName) then begin ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0); end else ShowMessage(cMain_Mes58); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aHistoryExecute', E.Message); end; end; procedure TFSCS_Main.ApplicationEvents1Exception(Sender: TObject; E: Exception); begin addExceptionToLogEx('TFSCS_Main.ApplicationEvents1Exception ', E.Message); end; procedure TFSCS_Main.SkipCADPanelChecked; begin try if tbCADToolsExpert.Visible then begin if tbSelectExpert.Down then tbSelectExpert.Down := False; if tbPanExpert.Down then tbPanExpert.Down := False; if tbLineExpert.Down then tbLineExpert.Down := False; //Tolik 23/07/2017 -- if tbPieExpert.Down then tbPieExpert.Down := False; // if tbRectangleExpert.Down then tbRectangleExpert.Down := False; if tbEllipseExpert.Down then tbEllipseExpert.Down := False; if tbCircleExpert.Down then tbCircleExpert.Down := False; if tbArcExpert.Down then tbArcExpert.Down := False; if tbElipticArcExpert.Down then tbElipticArcExpert.Down := False; if tbPolyLineExpert.Down then tbPolyLineExpert.Down := False; if tbPointExpert.Down then tbPointExpert.Down := False; if tbTextExpert.Down then tbTextExpert.Down := False; if tbRichTextExpert.Down then tbRichTextExpert.Down := False; if tbKnifeExpert.Down then tbKnifeExpert.Down := False; if tbHDimLineExpert.Down then tbHDimLineExpert.Down := False; if tbVDimLineExpert.Down then tbVDimLineExpert.Down := False; if tbSCSHDimLineExpert.Down then tbSCSHDimLineExpert.Down := False; if tbSCSVDimLineExpert.Down then tbSCSVDimLineExpert.Down := False; if tbSCSArcDimLineExpert.Down then tbSCSArcDimLineExpert.Down := False; if tbCabinetExpert.Down then tbCabinetExpert.Down := False; if tbWallRectExpert.Down then tbWallRectExpert.Down := False; if tbWallPathExpert.Down then tbWallPathExpert.Down := False; if tbCreateOnClickModeExpert.Down then tbCreateOnClickModeExpert.Down := False; if tbToolOrtholineExpert.Down then tbToolOrtholineExpert.Down := False; if tbToolOrtholineExtExpert.Down then tbToolOrtholineExtExpert.Down := False; end else begin if tbSelectNoob.Down then tbSelectNoob.Down := False; if tbSCSHDimLineNoob.Down then tbSCSHDimLineNoob.Down := False; if tbSCSVDimLineNoob.Down then tbSCSVDimLineNoob.Down := False; if tbSCSArcDimLineNoob.Down then tbSCSArcDimLineNoob.Down := False; if tbCabinetNoob.Down then tbCabinetNoob.Down := False; if tbCabinetExtNoob.Down then tbCabinetExtNoob.Down := False; if tbWallRectNoob.Down then tbWallRectNoob.Down := False; if tbWallPathNoob.Down then tbWallPathNoob.Down := False; if tbCreateOnClickModeNoob.Down then tbCreateOnClickModeNoob.Down := False; if tbToolOrtholineNoob.Down then tbToolOrtholineNoob.Down := False; if tbToolOrtholineExtNoob.Down then tbToolOrtholineExtNoob.Down := False; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.SkipCADPanelChecked', E.Message); end; end; procedure TFSCS_Main.aConnectionsConfiguratorExecute(Sender: TObject); begin try ShowConfigurator; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aConnectionsConfiguratorExecute', E.Message); end; end; procedure TFSCS_Main.aNoMoveConnectedObjectsExecute(Sender: TObject); begin try if aNoMoveConnectedObjects.Checked then GCadForm.FNoMoveConnectedObjects := True else GCadForm.FNoMoveConnectedObjects := False; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNoMoveConnectedObjectsExecute', E.Message); end; end; procedure TFSCS_Main.TimerProcessMessagesTimer(Sender: TObject); begin try TimerProcessMessages.Enabled := False; Application.ProcessMessages; TimerProcessMessages.Enabled := True; except on E: Exception do addExceptionToLogEx('TFSCS_Main.TimerProcessMessagesTimer', E.Message); end; end; procedure TFSCS_Main.aRealignObjectExecute(Sender: TObject); var i: integer; FFigure: TFigure; SelectedList: TList; // Tolik -- 03/10/2016 -- SavedUndoFlag: Boolean; // begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin SavedUndoFlag := GCadForm.FCanSaveForUndo; try // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; ReAlignObject(TConnectorObject(GPopupFigure)); RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := True; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRealignObjectExecute', E.Message); end; //GCadForm.FCanSaveForUndo := SavedUndoFlag; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.FormShow(Sender: TObject); var temps : string; t : word; innt: integer; tmr: integer; tempall: string; temp3: string; is_trial: boolean; is_flash: boolean; s: string; begin //Tolik 03/01/2025 -- GFtpConnectStr := ReadSetting(fnSCSIniFile, dtString, scReservFtp, idtConnectString, ''); mnuReserv.Enabled := GFtpConnectStr <> ''; // // Tolik 06/11/2019 -- WindowState := wsMaximized; Width := Screen.Width; Height := Screen.Height; // //RecreateWnd; {$IF Defined(SCS_PE) or DEFINED(SCS_SPA)} aToolHouse.Visible := False; //Tolik 17/08/2021 -- //tbCADToolsNoob.Width := cCADNoob_PE; //tbCADToolsNoob2.Width := cCADNoob_PE; tbCADToolsNoob.Width := cCADNoob_PE+20; tbCADToolsNoob2.Width := cCADNoob_PE - 100; tbCADToolsNoob2.Left := tbCADToolsNoob.Width + 25; tbCADToolsNoob2.Top := tbCADToolsNoob.Top; // {$ELSEIF Defined(TELECOM)} aToolHouse.Visible := False; tbCADToolsNoob.Width := cCADNoob_TEL; tbCADToolsNoob2.Width := cCADNoob_TEL; {$ELSE} aToolHouse.Visible := True; tbCADToolsNoob.Width := cCADNoob_SCS; //Tolik 17/08/2021 -- //tbCADToolsNoob2.Width := cCADNoob_SCS; tbCADToolsNoob2.Width := cCADNoob_SCS - 100; tbCADToolsNoob2.Left := tbCADToolsNoob.Width + 25; tbCADToolsNoob2.Top := tbCADToolsNoob.Top; // {$IFEND} if OpenFileAtStart <> '' then TimerOpenStart.Enabled := True; FSCS_Main.aRegHotKeys.Execute; try if isAutoShowPanel then ShowFloatPanel; except end; SetProjectChanged(False); SetMenuStatus(False); aManual_Interfaces.Visible := GUseVisibleInterfaces; hints_prog_id := 'scs_ua'; {$if Defined(ES_GRAPH_SC)} hints_prog_id := 'graph_sc'; {$ELSE} {$IF DEFINED(SCS_PE)} hints_prog_id := 'cp'; {$ELSE} {$IF Defined(SCS_PANDUIT)} hints_prog_id := 'panduitcad'; {$ELSE} {$IF Defined (SCS_RF)} hints_prog_id := 'scs_rf'; {$ELSE} hints_prog_id := 'scs_ua'; {$IFEND} {$IFEND} {$IFEND} {$IFEND} hints_prog_id := hints_prog_id + '_' + FastReplace(versionEXE, '.', ''); {$IF Defined(TRIAL_SCS)} hints_prog_id := hints_prog_id + '_' + 'trial'; {$IFEND} stat_prog_id := hints_prog_id; {$IF Defined(FLASH_SCS)} stat_prog_id := stat_prog_id + '_' + 'flash'; {$IFEND} is_trial := false; is_flash := false; {$IF Defined(TRIAL_SCS)} is_trial := true; {$IFEND} {$IF Defined(FLASH_SCS)} is_flash := true; {$IFEND} if GSendInfo then begin try s := ProgID.Data1 + '-' + ProgID.Data2 + '-' + ProgID.Data3 + '-' + ProgID.Data4 + '-' + DateID; s := FormatForUser(s); tempall := FormatForUser(ProgProtection.AnswerReg.Data1) + '-' + FormatForUser(ProgProtection.AnswerReg.Data2); if ProgProtection.AnswerReg.Data3 = '' then ProgProtection.AnswerReg.Data3 := '1111'; temp3 := inttostr(strtoint('$' + FormatForProg(ProgProtection.AnswerReg.Data3))); while length(temp3) < 5 do insert('0', temp3, 1); tempall := tempall + '-' + temp3 + '-' + FormatForUser(ProgProtection.AnswerReg.Data4); except end; try SendStat('http://admin.cableproject.net/stat/sendstat.php', 'scs', stat_prog_id, VersionEXE, DateEXE, s, tempall, is_trial, is_flash); except end; end; F_HintW.Caption := ''; try CheckAndShowHint('http://admin.cableproject.net/hints/' + hints_prog_id + '/index.html', hints_prog_id, FSCS_Main, 7, True); except end; TimerNews.OnTimer := nil; TimerNews.Enabled := False; if PROG_NEWSID <> '-1' then begin try temps := ExtractFilePath(application.ExeName)+'news\mess.txt'; case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html',SiteUrlNews + 'expert_news/expert_news.html', temps, 2, t) of 0:begin innt:=t*60*1000; tmr:=innt; TimerNews.Interval := tmr; end; // 1:begin ShowMessage('Ошибка загрузки библиотеки'); end; // 2:begin ShowMessage('Ошибка вызова процедуры'); end; // 3:begin ShowMessage('Ошибочный параметр вызова'); end; // 4:begin ShowMessage('Ошибка выполнения процедуры'); end; end; Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 0, t); except end; TimerNews.Enabled := True; TimerNews.OnTimer := TimerNewsTimer; end; //Tolik 13/09/2021 -- if not GNewVesrChecked then begin try GNewVesrChecked := True; CheckForNewVersion(VersionEXE, BuildEXE, nil); except on E: Exception do addExceptionToLogEx('TFSCS_Main.CheckForNewVersion', E.Message); end; end; end; procedure TFSCS_Main.TimerOpenStartTimer(Sender: TObject); begin if GIsProgress or GNowOpen then begin end else begin TimerOpenStart.Enabled := False; GNowOpen := True; try if OpenFileAtStart <> '' then if FileExists(OpenFileAtStart) then F_ProjMan.LoadProjectFromFile(OpenFileAtStart); except end; GNowOpen := False; OpenFileAtStart := ''; end; end; procedure TFSCS_Main.TimerRefreshTimer(Sender: TObject); begin if Not TF_CAD(GRefreshCad.Owner).InGUIEvent then begin TF_CAD(GRefreshCad.Owner).InGUIEvent := True; TimerRefresh.Enabled := False; TimerRefresh.Interval := 50; try GRefreshCad.Refresh; except end; TF_CAD(GRefreshCad.Owner).InGUIEvent := False; //Tolik 31/10/2015 {if TF_CAD(GRefreshCad.Owner).GisAction then GRefreshCad.EventEngine(95,1,'',0);} if TF_CAD(GRefreshCad.Owner).GisEventWaiting then GRefreshCad.EventEngine(95,1,'',0); end end; procedure TFSCS_Main.TimerTracingIntervalTimer(Sender: TObject); begin GDropTracing := true; FSCS_Main.TimerTracingInterval.Enabled := false; //showmessage('TracingTimer'); end; procedure TFSCS_Main.FOnAppActivate(Sender: TObject); begin if not GAppMinim then begin try if MDIChildCount > 0 then ReDrawCurrShadowOnCAD; aRegHotKeys.Execute; except // on E: Exception do addExceptionToLogEx('TFSCS_Main.FOnAppActivate', E.Message); end; end; end; procedure TFSCS_Main.aClearGuidesExecute(Sender: TObject); begin try if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin GCadForm.PCad.ClearGuides; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; except// on E: Exception do addExceptionToLogEx('TFSCS_Main.aClearGuidesExecute', E.Message); end; end; procedure TFSCS_Main.AppMinima(Sender: TObject); begin GAppMinim := true; end; procedure TFSCS_Main.aSaveToIBDExecute(Sender: TObject); begin {$if Defined(ES_GRAPH_SC)} SaveProjectForSC; {$else} //10.01.2012 SaveProjectToIBD(F_ProjMan.GSCSBase.CurrProject); SaveProjectToSmeta(F_ProjMan.GSCSBase.CurrProject); {$ifend} end; procedure TFSCS_Main.aToolSCSHDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- SetLayerForDraw; //16.05.2011 aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TSCSHDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aToolSCSVDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- SetLayerForDraw; //16.05.2011 aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TSCSVDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aToolWallRectExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin DropDownFirstToolbar; // Tolik 10/02/2021 -- RaiseActiveNet(GCadForm); GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 8; GCadForm.PCad.SetTool(toFigure, 'TWallRect'); tbWallRectNoob.Down := True; // Tolik 10/02/2021 -- end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolWallRectExecute', E.Message); end; end; procedure TFSCS_Main.SetShowPathLengthType(aPathLengthType: TShowPathLengthType); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin GCadForm.SetShowPathLengthType(aPathLengthType); CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADShowPathLengthType := Ord(aPathLengthType); SaveCADListParams(GCadForm.FCADListID, CurListParams); RefreshCAD(GCadForm.PCad); end; end; procedure TFSCS_Main.SetShowPathTraceLengthType(aPathLengthType: TShowPathLengthType); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin GCadForm.SetShowPathTraceLengthType(aPathLengthType); CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.CADShowPathTraceLengthType := Ord(aPathLengthType); SaveCADListParams(GCadForm.FCADListID, CurListParams); RefreshCAD(GCadForm.PCad); end; end; procedure TFSCS_Main.SetToolArch(const aTool: string; aToolData: Integer=0); begin try if ActiveMDIChild <> nil then begin RaiseActiveNet(GCadForm); GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 8; GCadForm.PCad.SetTool(toFigure, aTool, aToolData); tbCreateOnClickModeExpert.Down := True; tbCreateOnClickModeNoob.Down := True; tbSelectExpert.Down := False; tbSelectNoob.Down := False; end; except end; end; procedure TFSCS_Main.ShiftObjects(AShiftDirection: Integer); var i: integer; ConnObjs: TList; LineObjs: TList; Objs: TList; begin if ActiveMDIChild <> nil then begin ConnObjs := TList.Create; LineObjs := TList.Create; Objs := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then begin if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then ConnObjs.Add(TConnectorObject(GCadForm.PCad.Selection[i])); end else if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then begin if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then LineObjs.Add(TOrthoLine(GCadForm.PCad.Selection[i])); end else Objs.Add(TObject(TObject(GCadForm.PCad.Selection[i]))); end; if (ConnObjs.Count > 0) or (LineObjs.Count > 0) or (Objs.Count > 0) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; case AShiftDirection of sdUp: begin if ConnObjs.Count > 0 then ObjectsShiftUp(ConnObjs); if LineObjs.Count > 0 then LinesShiftUp(LineObjs); if Objs.Count > 0 then MoveFigures(Objs, 0, -0.1); end; sdDown: begin if ConnObjs.Count > 0 then ObjectsShiftDown(ConnObjs); if LineObjs.Count > 0 then LinesShiftDown(LineObjs); if Objs.Count > 0 then MoveFigures(Objs, 0, 0.1); end; sdLeft: begin if ConnObjs.Count > 0 then ObjectsShiftLeft(ConnObjs); if LineObjs.Count > 0 then LinesShiftLeft(LineObjs); if Objs.Count > 0 then MoveFigures(Objs, -0.1, 0); end; sdRight: begin if ConnObjs.Count > 0 then ObjectsShiftRight(ConnObjs); if LineObjs.Count > 0 then LinesShiftRight(LineObjs); if Objs.Count > 0 then MoveFigures(Objs, 0.1, 0); end; end; // *UNDO* GCadForm.FCanSaveForUndo := True; end; if ConnObjs <> nil then FreeAndNil(ConnObjs); if LineObjs <> nil then FreeAndNil(LineObjs); if Objs <> nil then FreeAndNil(Objs); RefreshCAD(GCadForm.PCad); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // Tolik 09/08/2019 - - procedure AutoFitBitMap(Bmp: TBMPObject); var ScaleKoef1: double; ScaleKoef2: double; begin { if GAutoScaleRasterImages then // скейлить картинку, только если включена соответствующая опция в настройках // (Масштабировать растровые изображения, превышающие размеры листа) begin if (GCadForm.PCad.WorkWidth*0.95 < Bmp.ap3.x) or (GCadForm.PCad.WorkHeight*0.95 < Bmp.ap3.y) then begin ScaleKoef1 := GCadForm.PCad.WorkWidth*0.95 / Bmp.ap3.x; ScaleKoef2 := GCadForm.PCad.WorkHeight*0.95 / Bmp.ap3.y; if ScaleKoef1 < ScaleKoef2 then Bmp.Scale(ScaleKoef1, ScaleKoef1, Bmp.ap1) else Bmp.Scale(ScaleKoef2, ScaleKoef2, Bmp.ap1) end; end; } ScaleKoef1 := (GCadForm.PCad.WorkWidth - Bmp.ap3.x) / 2; ScaleKoef2 := (GCadForm.PCad.WorkHeight - Bmp.ap3.y) / 2; Bmp.move(ScaleKoef1, ScaleKoef2); end; { procedure AutoFitBitMap(Bmp: TBMPObject); var ScaleKoef1: double; ScaleKoef2: double; begin if (GCadForm.PCad.WorkWidth*0.95 < Bmp.ap3.x) or (GCadForm.PCad.WorkHeight*0.95 < Bmp.ap3.y) then begin ScaleKoef1 := GCadForm.PCad.WorkWidth*0.95 / Bmp.ap3.x; ScaleKoef2 := GCadForm.PCad.WorkHeight*0.95 / Bmp.ap3.y; if ScaleKoef1 < ScaleKoef2 then Bmp.Scale(ScaleKoef1, ScaleKoef1, Bmp.ap1) else Bmp.Scale(ScaleKoef2, ScaleKoef2, Bmp.ap1) end; ScaleKoef1 := (GCadForm.PCad.WorkWidth - Bmp.ap3.x) / 2; ScaleKoef2 := (GCadForm.PCad.WorkHeight - Bmp.ap3.y) / 2; Bmp.move(ScaleKoef1, ScaleKoef2); end; } procedure TFSCS_Main.LoadSubstrateEx(aReplace: Boolean); var FName, FExt: string; i: integer; FDir: string; OpenDialog: TOpenDialog; Jpeg: TJpegImage; Bmp: TBMPObject; Bitmp: TBitmap; BitmapHandle: TFigHandle; Fig: TFigure; SavedDrawingRect: TDoubleRect; CanRestoreParams: Boolean; Flag: Boolean; procedure RemoveSubstrate; begin CanRestoreParams := false; if aReplace then begin //SavedDrawingRect := GCadForm.PCad.GetDrawingRect; GCadForm.PCad.DeselectAll(0); GCadForm.PCad.SelectAll(lnSubstrate); CanRestoreParams := GCadForm.PCad.Selection.Count > 0; if CanRestoreParams then begin SavedDrawingRect := GCadForm.PCad.GetSelectionRect; //GCadForm.DeleteLayerAllObjects(lnSubstrate, false); GCadForm.DeleteSelection(false); end; end; end; procedure RestoreParams; var DrawingRect: TDoubleRect; rp: TDoublePoint; NewH, NewW, OldH, OldW: Double; begin if aReplace then if CanRestoreParams then begin GCadForm.PCad.DeselectAll(0); GCadForm.PCad.SelectAll(lnSubstrate); if GCadForm.PCad.Selection.Count > 0 then begin DrawingRect := GCadForm.PCad.GetSelectionRect; GCadForm.PCad.MoveSelection(SavedDrawingRect.Left - DrawingRect.Left, SavedDrawingRect.Top - DrawingRect.Top); rp := DoublePoint(SavedDrawingRect.Left, SavedDrawingRect.Top); NewH := DrawingRect.Bottom - DrawingRect.Top; NewW := DrawingRect.Right - DrawingRect.Left; OldH := SavedDrawingRect.Bottom - SavedDrawingRect.Top; OldW := SavedDrawingRect.Right - SavedDrawingRect.Left; GCadForm.PCad.ScaleSelection(OldW/NewW, OldH/NewH, rp); end; end; end; begin bmp := Nil; // Tolik 09/08/2019 -- Flag := GisUserDimLine; if ActiveMDIChild <> nil then begin OpenDialog := TOpenDialog.Create(Self); OpenDialog.Title := cMain_Mes4; OpenDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers); OpenDialog.Filter := cMain_MesAllFormats +'|' + cMain_Mes5 + '|' + cMain_Mes124 +'|'+ cMain_Mes125_ +'|'+ cProgressExp_Msg9_1 +'|'+ GetDialogFilter(exdAll, '*'); OpenDialog.DefaultExt := 'dxf'; if OpenDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctBackgLayers, ExtractFileDir(OpenDialog.FileName)); // FName := AnsiLowerCaseFileName(OpenDialog.FileName); FExt := ExtractFileExt(FName); if FExt = '.scb' then begin RemoveSubstrate; LoadSubstrate(FName); RestoreParams; end else if (FExt = '.dxf') or (FExt = '.dwg') or (FExt = '.svg') or (FExt = '.prn') or (FExt = '.plt') or (FExt = '.wmf') then begin RemoveSubstrate; // Если восстанавливаем размеры по предыдущей подложке, от не задаем вопрос на счет масштабирования через CanRestoreParams LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124, FName, Not CanRestoreParams); RestoreParams; end //Tolik 11/08/2021 -- //else if (FExt = '.bmp') or (FExt = '.jpg') or (FExt = '.jpeg') then else if (FExt = '.bmp') or (FExt = '.jpg') or (FExt = '.jpeg') or (FExt = '.png') then // begin RemoveSubstrate; aSetSubstrateLayer.Execute; if FExt = '.bmp' then begin // Toilk 09/08/2019 -- //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if BitmapHandle <> -1 then Bmp := TBMPObject(BitmapHandle) else GisUserDimLine := False; // Tolik 11/08/2021 -- // end else begin // Tolik 09/08/2019 -- //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if BitmapHandle <> -1 then Bmp := TBMPObject(BitmapHandle) else GisUserDimLine := False; // Tolik 11/08/2021 -- // Это вообще пока что непонятно, зачем .... {Jpeg := TJpegImage.create; Jpeg.LoadFromFile(FName); Bmp.Picture.Width := Jpeg.Width; Bmp.Picture.Height := Jpeg.Height; Bmp.Picture.Canvas.Draw(0, 0, Jpeg); Bmp.Picture.PixelFormat := pf24bit; FreeAndNil(Jpeg);} end; RestoreParams; //if Not aReplace then if Not CanRestoreParams then begin if Bmp <> nil then // Tolik 09/08/2019 -- AutoFitBitmap(Bmp) else GisUserDimLine := False; // Tolik 11/08/2021 -- end; //Tolik 11/08/2021 -- end else if FExt = '.pdf' then begin Bitmp := CreateFPDFView.GetDocBitmap(cMain_Mes136, FName); GisUserDimLine := Flag; if Bitmp <> nil then begin try RemoveSubstrate; FName := ExtractSCSTempDir + GetUniqueFileName('', enBmp); Bitmp.SaveToFile(FName); Bitmp.Free; //Tolik 03/09/2021 - - aSetSubstrateLayer.Execute; BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if BitmapHandle <> -1 then begin Fig := TFigure(BitmapHandle); //Fig := TFigure(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); Fig.width := 0; // Убираем рамку GCadForm.PCad.DeselectAll(0); DeleteFile(FName); RestoreParams; end else GisUserDimLine := False; // Tolik 11/08/2021 -- //if Not aReplace then if Not CanRestoreParams then begin AutoFitBitmap(TBMPObject(Fig)); end; except ShowMessage(cMain_Mes6); GisUserDimLine := False; // Tolik 11/08/2021 -- end; RefreshCAD(GCadForm.PCad); end else GisUserDimLine := False; // Tolik 11/08/2021 -- end; GCadForm.PCad.DeselectAll(0); except ShowMessage(cMain_Mes6); end; { FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbPanExpert.Down := True; FSCS_Main.tbPanNoob.Down := True; FSCS_Main.aToolPan.Execute; } RefreshCAD(GCadForm.PCad); end else GisUserDimLine := False; // Tolik 11/08/2021 -- OpenDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.SetFigureAsEndObject(aCad: TForm; aFigure: TFigure); var EndPoint: TFigure; begin try if aFigure = nil then exit; try EndPoint := aFigure; if CheckFigureByClassName(aFigure, cTConnectorObject) then TConnectorObject(EndPoint).AsEndPoint := True else if CheckFigureByClassName(aFigure, cTHouse) then THouse(EndPoint).AsEndPoint := True; if EndPoint = GEndPoint then Exit; except EndPoint := Nil; end; // сбросить бывший КО if GEndPoint <> nil then begin if CheckFigureByClassName(GEndPoint, cTConnectorObject) then TConnectorObject(GEndPoint).AsEndPoint := False else if CheckFigureByClassName(GEndPoint, cTHouse) then THouse(GEndPoint).AsEndPoint := False; if (GListWithEndPoint <> aCad) and (GListWithEndPoint <> nil) then begin RefreshCAD(GListWithEndPoint.PCad); RefreshCAD(GListWithEndPoint.PCad); end; RefreshCAD(TF_CAD(aCad).PCad); GListWithEndPoint := Nil; end; RefreshCAD(TF_CAD(aCad).PCad); GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes2); // переназначить новый GEndPoint := EndPoint; GListWithEndPoint := GCadForm; except on E: Exception do addExceptionToLogEx('TFSCS_Main.SetFigureAsEndObject', E.Message); end; end; procedure TFSCS_Main.CustomizeNewList; //27.06.2013 var IDFloor: Integer; ListForPassage: TF_CAD; SavedCAD: TF_CAD; WasPausedProgress: Boolean; OldUserDimLine: Boolean; begin //27.06.2013 - подгрузка подложки с заменой существующей, сохраняя размеры/позиции Application.ProcessMessages; WasPausedProgress := False; if GIsProgress then begin PauseProgress(True); WasPausedProgress := True; end; if not GisListCopy then //Tolik 16/06/2021 -- не загружать подложку, если копия листа begin //Tolik 11/08/2021 -- //LoadSubstrateEx(true); GisUserDimLine := True; LoadSubstrateEx(true); OldUserDimLine := GisUserDimLine; // end; if WasPausedProgress then PauseProgress(False); {//25.06.2013 - выбор места для м-э на новом листе, Пока НЕ УДАЛЯТЬ!!!!!!!! IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1); ListForPassage := nil; if IDFloor > 0 then begin ListForPassage := GetListByID(IDFloor); if ListForPassage <> nil then begin // Тулза создания м-э перехода if MessageQuastYN(cMain_Mes139) = IDYES then begin Application.ProcessMessages; if GCadForm.CurrentLayer <> lnSCSCommon then GCadForm.CurrentLayer := lnSCSCommon; GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName); end; end; end;} {$if Not Defined(ES_GRAPH_SC)} //25.06.2013 - выбор места для м-э на листе ниже IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1); ListForPassage := nil; if IDFloor > 0 then begin ListForPassage := GetListByID(IDFloor); if ListForPassage <> nil then begin // Tolik 21/04/2017 -- WasPausedProgress := False; if GIsProgress then begin PauseProgress(True); WasPausedProgress := True; end; // { if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then tbSCSHDimLineExpert.click else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; } // Тулза создания м-э перехода if MessageQuastYN(cMain_Mes139) = IDYES then begin Application.ProcessMessages; SavedCAD := GCADForm; try GCADForm := ListForPassage; GCadForm.BringToFront; if GCadForm.CurrentLayer <> lnSCSCommon then GCadForm.CurrentLayer := lnSCSCommon; GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName); ShowHintRzR(cMain_Mes145, 5000); // Tolik 23/09/2021 -- finally //Tolik 12/08/2021 -- if not GisListCopy then GisUserDimLine := OldUserDimLine; // //GCADForm := SavedCAD; //GCadForm.BringToFront; end; end else begin //Tolik 11/08/2021 -- if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // end; if WasPausedProgress then PauseProgress(False); end; end else begin //Tolik 11/08/2021 -- if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // end; {$ifend} end; procedure TFSCS_Main.aToolWallPathExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin DropDownFirstToolbar; // Tolik 10/02/2021 -- RaiseActiveNet(GCadForm); GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 8; GCadForm.PCad.SetTool(toFigure, 'TWallPath'); tbWallPathNoob.Down := True; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolWallPathExecute', E.Message); end; end; procedure TFSCS_Main.aToolHouseExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 2; GCadForm.PCad.SetTool(toFigure, 'THouseTool'); DropDownFirstToolbar; // Tolik 10/02/2021 -- tbHouseNoob.Down := True; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aToolHouseExecute', E.Message); end; end; // 0 - Удалить сегмент procedure TFSCS_Main.aDeleteWallPathExecute(Sender: TObject); var CurNet: TNet; mess: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin CurNet := TNet(GCadForm.PCad.Selection[0]); if CurNet.SelPath <> nil then begin mess := cMain_Mes37; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes38, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes38), MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, (CurNet.FComponID <> 0), False); GCadForm.FCanSaveForUndo := false; end; CurNet.DeleteSelected; // Tolik 18/10/2016 -- // если удалена последняя стена - удалить и комнату вместе с полом и потолком, чтоб не валялась в ПМ if CurNet.Paths.Count = 0 then begin CurNet.DeleteNet; RefreshCAD(GCadForm.PCad); RaiseActiveNet(GCadForm); end else RefreshCAD(GCadForm.PCad); // if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := true; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWallPathExecute', E.Message); end; end; // 1 - Удалить план procedure TFSCS_Main.aDeleteWallRectExecute(Sender: TObject); var i: integer; CurNet: TNet; CurPath: TNetPath; CurCol: TNetCol; mess: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin mess := cMain_Mes39; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes40, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes40), MB_YESNO) = IDYes then begin CurNet := TNet(GCadForm.PCad.Selection[0]); // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, (CurNet.FcomponID <> 0), False); GCadForm.FCanSaveForUndo := false; end; //04.06.2010 //i := 0; //while i < CurNet.Paths.Count do //begin // CurPath := TNetPath(CurNet.Paths[i]); // CurNet.DeletePath(CurPath); //end; //i := 0; //while i < CurNet.Structs.Count do //begin // CurCol := TNetCol(CurNet.Structs[i]); // CurNet.DeleteStruct(CurCol); //end; //GCadForm.PCad.Figures.Remove(CurNet); CurNet.DeleteNet; RefreshCAD(GCadForm.PCad); RaiseActiveNet(GCadForm); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := true; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWallRectExecute', E.Message); end; end; // 2 - Разделить сегмент procedure TFSCS_Main.aDivSelPathExecute(Sender: TObject); var CurNet: TNet; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin CurNet := TNet(GCadForm.PCad.Selection[0]); if CurNet.SelPath <> nil then begin // *UNDO* //if GCadForm.FCanSaveForUndo then //begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := false; //end; GCadForm.BeginSaveForUndo(uat_None, CurNet.FComponID <> 0, False); try CurNet.DivSelPath; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); finally GCadForm.EndSaveForUndo; end; //GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDivSelPathExecute', E.Message); end; end; // 3 - Установить ширину сегмента procedure TFSCS_Main.aSetWallPathWidthExecute(Sender: TObject); var i, j: integer; tempstr: string; CurSelPath: TNetPath; RulerModeStr: String; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin tempstr := ''; if GCadForm.PCad.RulerMode = rmPage then RulerModeStr := cCadClasses_Mes6 else if GCadForm.PCad.RulerMode = rmWorld then RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure); tempstr := FormatFloat(ffMask, MetreToUOM(CurSelPath.Width * GCadForm.PCad.MapScale / 1000)); if InputQuery(cMain_Mes59, cMain_Mes60 + RulerModeStr, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0.1 then tempstr := '0,1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin //CurSelPath.Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); // *UNDO* //if GCadForm.FCanSaveForUndo then //begin // GCadForm.SaveForUndo(uat_None, False, False); // GCadForm.FCanSaveForUndo := false; //end; //GCadForm.BeginSaveForUndo(uat_None, CurSelPath.FComponID <> 0, False); GCadForm.BeginSaveForUndo(uat_None, False, False); try CurSelPath.Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); // изменение ширины окон и дверей for j := 0 to CurSelPath.Doors.Count - 1 do begin TNetDoor(CurSelPath.Doors[j]).Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); end; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if CurSelPath.FComponID = 0 then GArchEngine.SetLastObjSize(aoskPathWidth, CurSelPath.Width); finally GCadForm.EndSaveForUndo; end; //GCadForm.FCanSaveForUndo := True; if CurSelPath.FComponID <> 0 then begin F_ProjMan.RefreshNode(false); LoadArchObjPropsFromCAD(GetArchObjByCADObj(CurSelPath)); LoadArchObjPropsToCAD(GetArchObjByCADObj(CurSelPath)); end; end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetWallPathWidthExecute', E.Message); end; end; // 4 - Установить ширину всех сегментов procedure TFSCS_Main.aSetAllWallPathWidthExecute(Sender: TObject); var i, j: integer; tempstr: string; CurPath: TNetPath; CurSelPath: TNetPath; RulerModeStr: string; value: Double; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin tempstr := ''; if GCadForm.PCad.RulerMode = rmPage then RulerModeStr := cCadClasses_Mes6 else if GCadForm.PCad.RulerMode = rmWorld then RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure); tempstr := FormatFloat(ffMask, MetreToUOM(CurSelPath.Width * GCadForm.PCad.MapScale / 1000)); if InputQuery(cMain_Mes61, cMain_Mes62 + RulerModeStr, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0.1 then tempstr := '0,1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Value := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); TNet(GCadForm.PCad.Selection[0]).UpdateWallThick(Value); RefreshCAD(GCadForm.PCad); GCadForm.FCanSaveForUndo := True; if CurSelPath.FComponID = 0 then GArchEngine.SetLastObjSize(aoskPathWidth, Value); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllWallPathWidthExecute', E.Message); end; end; // 5 - Добавить окно procedure TFSCS_Main.aAddWindowExecute(Sender: TObject); var Net: TNet; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin Net := TNet(GCadForm.PCad.Selection[0]); if Net.SelPath <> nil then begin if Net.SelPath.FComponID = 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; //04.06.2013 TNet(GCadForm.PCad.Selection[0]).AddWindow; TNet(GCadForm.PCad.Selection[0]).AddWindow(GArchEngine.GetLastDoorObjSize(dotWindow, -1)); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := True; end else begin CreateArchObjWizardByCAD(ctArhWindow, GCadForm, Net.SelPath); end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddWindowExecute', E.Message); end; end; // 6 - Добавить дверь procedure TFSCS_Main.aAddDoorExecute(Sender: TObject); var Net: TNet; Len: Double; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin Net := TNet(GCadForm.PCad.Selection[0]); if Net.SelPath <> nil then begin if Net.SelPath.FComponID = 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; //04.06.2013 TNet(GCadForm.PCad.Selection[0]).AddDoor; TNet(GCadForm.PCad.Selection[0]).AddDoor(dotDoor, GArchEngine.GetLastDoorObjSize(dotDoor, -1)); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end else begin CreateArchObjWizardByCAD(ctArhDoor, GCadForm, Net.SelPath); end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddDoorExecute', E.Message); end; end; // 7 - Добавить колонну procedure TFSCS_Main.aAddColumnExecute(Sender: TObject); begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; TNet(GCadForm.PCad.Selection[0]).AddCol; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddColumnExecute', E.Message); end; end; // 8 - Удалить окно/дверь procedure TFSCS_Main.aDeleteWindowDoorExecute(Sender: TObject); var mess: string; CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.ActiveDoor <> nil then begin mess := cMain_Mes41; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes42, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes42), MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurSelPath.DeleteDoor; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWindowDoorExecute', E.Message); end; end; // 9 - Удалить колонну procedure TFSCS_Main.aDeleteColumnExecute(Sender: TObject); var mess: string; CurSelCol: TNetCol; begin try // Tolik 18/10/2016-- сюда можем попасть даже, когда на КАДе ничего не выбрано(например, после удаления комнаты полностью), так что получим АВ, // поэтому сначала проверяем, а выбрано ли что-нибудь там вообще, а уж потом -- пожалте удалять if GCadForm.PCad.Selection.Count > 0 then begin // if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then begin mess := cMain_Mes43; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes44, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes44), MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurSelCol := TNet(GCadForm.PCad.Selection[0]).SelCol; TNet(GCadForm.PCad.Selection[0]).DeleteStruct(CurSelCol); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteColumnExecute', E.Message); end; end; // 10 - Уставновить размер двери/окна procedure TFSCS_Main.aSetSizeWindowDoorExecute(Sender: TObject); var CurDoor: TNetDoor; tempstr: string; RulerModeStr: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin if TNetPath(TNet(GCadForm.PCad.Selection[0]).SelPath).ActiveDoor <> nil then begin CurDoor := TNetPath(TNet(GCadForm.PCad.Selection[0]).SelPath).ActiveDoor; tempstr := ''; if GCadForm.PCad.RulerMode = rmPage then RulerModeStr := cCadClasses_Mes6 else RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure); tempstr := FormatFloat(ffMask, MetreToUOM(CurDoor.Len * GCadForm.PCad.MapScale / 1000)); if InputQuery(cMain_Mes63, cMain_Mes64 + RulerModeStr, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0.1 then tempstr := '0,1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurDoor.Len := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); CurDoor.DoResize; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; if CurDoor.FComponID = 0 then GArchEngine.SetLastDoorObjSize(CurDoor.DoorObjType, CurDoor.Len); end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSizeWindowDoorExecute', E.Message); end; end; // 11 - Уставновить угол колонны procedure TFSCS_Main.aSetColumnAngleExecute(Sender: TObject); var tempstr: string; CurCol: TNetCol; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then begin CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol; tempstr := FormatFloat(ffMask, CurCol.Angle * 180 / pi); if InputQuery(cMain_Mes65, cMain_Mes66, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0 then tempstr := '0'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurCol.Angle := StrToFloat_My(Tempstr) / 180 * pi; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnAngleExecute', E.Message); end; end; // 12 - Уставновить высоту колонны procedure TFSCS_Main.aSetColumnHeightExecute(Sender: TObject); var RulerModeStr: string; tempstr: string; CurCol: TNetCol; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then begin CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol; tempstr := ''; if GCadForm.PCad.RulerMode = rmPage then RulerModeStr := cCadClasses_Mes6 else RulerModeStr := cCadClasses_Mes6; tempstr := FormatFloat(ffMask, MetreToUOM(CurCol.h * GCadForm.PCad.MapScale / 1000)); if InputQuery(cMain_Mes67, cMain_Mes68 + RulerModeStr, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0.1 then tempstr := '0,1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurCol.h := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnHeightExecute', E.Message); end; end; // 13 - Уставновить ширины колонны procedure TFSCS_Main.aSetColumnWidthExecute(Sender: TObject); var RulerModeStr: string; tempstr: string; CurCol: TNetCol; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then begin CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol; tempstr := ''; if GCadForm.PCad.RulerMode = rmPage then RulerModeStr := cCadClasses_Mes6 else RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure); tempstr := FormatFloat(ffMask, MetreToUOM(CurCol.w * GCadForm.PCad.MapScale / 1000)); if InputQuery(cMain_Mes69, cMain_Mes70 + RulerModeStr, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 0.1 then tempstr := '0,1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurCol.w := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnWidthExecute', E.Message); end; end; // 14 - Установить ширину линий сегмента procedure TFSCS_Main.aSetPathLineWidthExecute(Sender: TObject); var CurSelPath: TNetPath; tempstr: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin tempstr := ''; tempstr := IntToStr(CurSelPath.FPathWidth); if InputQuery(cMain_Mes71, cMain_Mes72, tempstr) then begin try StrToInt(tempstr); if (StrToInt(tempstr) < 1) or (StrToInt(tempstr) > 7) then begin ShowMessage(cMain_Mes73); Exit; end; except ShowMessage(cMain_Mes74); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurSelPath.FPathWidth := StrToInt(Tempstr); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetPathLineWidthExecute', E.Message); end; end; // 15 - Установить стиль линий сегмента procedure TFSCS_Main.aSetPathLineStyleExecute(Sender: TObject); var CurSelPath: TNetPath; tempstr: string; StyleIndex: Integer; mess: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin if CurSelPath.FPathWidth > 1 then begin ShowMessage(cMain_Mes75); Exit; end; tempstr := ''; StyleIndex := Ord(CurSelPath.FPathStyle); mess := cMain_Mes76; tempstr := IntToStr(StyleIndex); if InputQuery(cMain_Mes77, mess, tempstr) then begin try StrToInt(tempstr); if (StrToInt(tempstr) < 0) or (StrToInt(tempstr) > 6) then begin ShowMessage(cMain_Mes78); Exit; end; except ShowMessage(cMain_Mes74); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; StyleIndex := StrToInt(Tempstr); CurSelPath.FPathStyle := TPenStyle(StyleIndex); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetPathLineStyleExecute', E.Message); end; end; // 16 - Установить ширину линий всех сегментов procedure TFSCS_Main.aSetAllPathLineWidthExecute(Sender: TObject); var i: integer; tempstr: string; CurSelPath: TNetPath; CurPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin tempstr := ''; tempstr := IntToStr(CurSelPath.FPathWidth); if InputQuery(cMain_Mes79, cMain_Mes80, tempstr) then begin try StrToInt(tempstr); if (StrToInt(tempstr) < 1) or (StrToInt(tempstr) > 7) then begin ShowMessage(cMain_Mes73); Exit; end; except ShowMessage(cMain_Mes74); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do begin CurPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]); CurPath.FPathWidth := StrToInt(Tempstr); end; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := True; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllPathLineWidthExecute', E.Message); end; end; // 17 - Установить стиль линий всех сегментов procedure TFSCS_Main.aSetAllPathLineStyleExecute(Sender: TObject); var i: integer; tempstr: string; mess: string; StyleIndex: Integer; CurSelPath: TNetPath; CurPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath <> nil then begin tempstr := ''; StyleIndex := Ord(CurSelPath.FPathStyle); mess := cMain_Mes76; tempstr := IntToStr(StyleIndex); if InputQuery(cMain_Mes77, mess, tempstr) then begin try StrToInt(tempstr); if (StrToInt(tempstr) < 0) or (StrToInt(tempstr) > 5) then begin ShowMessage(cMain_Mes78); Exit; end; except ShowMessage(cMain_Mes74); Exit; end; if tempstr <> '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; StyleIndex := StrToInt(Tempstr); for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do begin CurPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]); CurPath.FPathStyle := TPenStyle(StyleIndex); end; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := True; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllPathLineStyleExecute', E.Message); end; end; procedure TFSCS_Main.LoadStamp(aFName: string); var i, j: integer; LHandle: integer; BlockFig: TBlock; InFigure: TFigure; begin try RemoveFrameFromList(GCadForm); LHandle := GCadForm.PCad.GetLayerHandle(7); try BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(7, aFName, GCadForm.PCad.WorkWidth / 2 - 2.5, GCadForm.PCad.WorkHeight / 2)); SetAllStampFiguresLayer(TFigureGrp(BlockFig), LHandle); SetAllStampTextsFont(TFigureGrp(BlockFig), GCadForm.FFontName); // выставить подписи GCadForm.FFrameFileName := aFName; LoadCaptionsOnFrame(GCadForm, GCadForm.FCadStampType); except GCadForm.FFrameFileName := ''; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.LoadStamp', E.Message); end; end; procedure TFSCS_Main.SaveStamp(aFName: string); var i: integer; FFigure: TFigure; LHandle: Integer; begin try GCadForm.PCad.DeselectAll(0); GCadForm.PCad.SelectAll(7); {//17.11.2011 if GCadForm.FFrameProjectName <> nil then GCadForm.FFrameProjectName.Deselect; if GCadForm.FFrameListName <> nil then GCadForm.FFrameListName.Deselect; if GCadForm.FFrameCodeName <> nil then GCadForm.FFrameCodeName.Deselect; if GCadForm.FFrameIndexName <> nil then GCadForm.FFrameIndexName.Deselect;} for i := 0 to GCadForm.FFrameObjects.Count - 1 do begin FFigure := TFigure(GCadForm.FFrameObjects.Objects[i]); if FFigure <> nil then FFigure.Deselect; end; RefreshCAD(GCadForm.PCad); GCadForm.PCad.GroupSelection; GCadForm.PCad.MakeSelectionBlock(aFName); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.SaveStamp', E.Message); end; end; procedure TFSCS_Main.aLoadStampExecute(Sender: TObject); var FName: string; FDir: string; OpenDialog: TOpenDialog; begin try if ActiveMDIChild <> nil then begin OpenDialog := TOpenDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\Stamp') then FDir := FDir + '\Stamp'; OpenDialog.Title := cMain_Mes81; OpenDialog.InitialDir := ExtractDirByCategoryType(dctStamps);//ExtractSaveDirForCategory('Stamp');//FDir; OpenDialog.DefaultExt := 'sch'; OpenDialog.Filter := cMain_Mes82; if OpenDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctStamps, ExtractFileDir(OpenDialog.FileName)); // FName := OpenDialog.FileName; LoadStamp(FName); GCadForm.PCad.DeselectAll(0); except ShowMessage(cMain_Mes6); end; RefreshCAD(GCadForm.PCad); end; OpenDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aLoadStampExecute', E.Message); end; end; procedure TFSCS_Main.aSaveStampExecute(Sender: TObject); var FName: string; FDir: string; SaveDialog: TSaveDialog; begin try if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\Stamp') then FDir := FDir + '\Stamp'; SaveDialog.Title := cMain_Mes83; SaveDialog.InitialDir := ExtractDirByCategoryType(dctStamps);//ExtractSaveDirForCategory('Stamp');//FDir; SaveDialog.DefaultExt := 'sch'; SaveDialog.Filter := cMain_Mes82; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; if SaveDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctStamps, ExtractFileDir(SaveDialog.FileName)); // FName := SaveDialog.FileName; SaveStamp(FName); except ShowMessage(cMain_Mes8); end; end; SaveDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveStampExecute', E.Message ); end; end; procedure TFSCS_Main.aWallPathShowLengthExecute(Sender: TObject); var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.FShowLength then CurSelPath.FShowLength := False else CurSelPath.FShowLength := True; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aWallPathShowLengthExecute', E.Message); end; end; procedure TFSCS_Main.SaveProjectForSC; var FName: string; FDir: string; SaveDialog: TSaveDialog; begin try if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\Save') then FDir := FDir + '\Save'; SaveDialog.Title := 'Cохранить параметры объектов...'; SaveDialog.InitialDir := ExtractFileDir(Application.ExeName) + '\Save'; SaveDialog.DefaultExt := 'scp'; SaveDialog.Filter := 'Файлы параметров объектов (*.scp)|*.scp'; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; if SaveDialog.Execute then begin try FName := SaveDialog.FileName; ExpProjToStroyCalcFile(F_ProjMan.GSCSBase.CurrProject, FName); except //ShowMessage(cMain_Mes8); end; end; SaveDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveFPlanExecute', E.Message); end; end; procedure TFSCS_Main.aSaveFPlanExecute(Sender: TObject); var FName: string; FDir: string; SaveDialog: TSaveDialog; begin try if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.ArchPlan') then FDir := FDir + '\.ArchPlan'; SaveDialog.Title := cMain_Mes84; SaveDialog.InitialDir := ExtractDirByCategoryType(dctArchPlans);//ExtractSaveDirForCategory('.ArchPlan');//FDir; SaveDialog.DefaultExt := 'sca'; SaveDialog.Filter := cMain_Mes85; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; if SaveDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctArchPlans, ExtractFileDir(SaveDialog.FileName)); // FName := SaveDialog.FileName; SaveFPlan(FName); except ShowMessage(cMain_Mes8); end; end; SaveDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveFPlanExecute', E.Message); end; end; procedure TFSCS_Main.aLoadFPlanExecute(Sender: TObject); var FName: string; i: integer; FDir: string; OpenDialog: TOpenDialog; begin try if ActiveMDIChild <> nil then begin OpenDialog := TOpenDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.ArchPlan') then FDir := FDir + '\.ArchPlan'; OpenDialog.Title := cMain_Mes86; OpenDialog.InitialDir := ExtractDirByCategoryType(dctArchPlans);//ExtractSaveDirForCategory('.ArchPlan');//FDir; OpenDialog.DefaultExt := 'sca'; OpenDialog.Filter := cMain_Mes85; if OpenDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctArchPlans, ExtractFileDir(OpenDialog.FileName)); // GisUserDimLine := True; FName := OpenDialog.FileName; LoadFPlan(FName); GCadForm.PCad.DeselectAll(0); //Tolik 11/08/2021 -- if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // except ShowMessage(cMain_Mes6); end; RefreshCAD(GCadForm.PCad); end; OpenDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aLoadFPlanExecute', E.Message); end; end; procedure TFSCS_Main.tbExtProtocolClick(Sender: TObject); begin try ShowLog; except on E: Exception do addExceptionToLogEx('TFSCS_Main.tbExtProtocolClick', E.Message); end; end; procedure TFSCS_Main.N113Click(Sender: TObject); var FileName: string; begin try FileName := ExeDir + '\Docs\UserGuide.doc'; {$IF Defined(SCS_PE) or Defined(SCS_SPA)} FileName := ExeDir + '\Docs\UserGuide.pdf'; {$IFEND} if FileExists(FileName) then begin ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0); end else ShowMessage(cMain_Mes87); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aUserGuideExecute', E.Message); end; end; procedure TFSCS_Main.aDesignBoxCaptionHeightExecute(Sender: TObject); var i: integer; tempstr: string; CurText: TText; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TText') then begin CurText := TText(GCadForm.PCad.Selection[0]); tempstr := FormatFloat(ffMask, CurText.Height); if InputQuery(cMain_Mes88, cMain_Mes89, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 1 then tempstr := '1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), 'TText') then begin CurText := TText(GCadForm.PCad.Selection[i]); CurText.Height := StrToFloat_My(tempstr); CurText.Create(CurText.ActualPoints[1].x, CurText.ActualPoints[1].y, CurText.Height, CurText.CWidth, CurText.Text, CurText.Font.Name, CurText.Font.Charset, CurText.color, CurText.LayerHandle, mydsNormal, GCadForm.PCad); end; end; RefreshCAD(GCadForm.PCad); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxCaptionHeightExecute', E.Message); end; end; procedure TFSCS_Main.aDesignBoxCaptionWidthExecute(Sender: TObject); var i: integer; tempstr: string; CurText: TText; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TText') then begin CurText := TText(GCadForm.PCad.Selection[0]); tempstr := FormatFloat(ffMask, CurText.width); if InputQuery(cMain_Mes90, cMain_Mes91, tempstr) then begin try StrToFloat_My(tempstr); if StrToFloat_My(tempstr) < 1 then tempstr := '1'; except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), 'TText') then begin CurText := TText(GCadForm.PCad.Selection[i]); CurText.CWidth := StrToFloat_My(tempstr); CurText.Create(CurText.ActualPoints[1].x, CurText.ActualPoints[1].y, CurText.Height, CurText.CWidth, CurText.Text, CurText.Font.Name, CurText.Font.Charset, CurText.color, CurText.LayerHandle, mydsNormal, GCadForm.PCad); end; end; RefreshCAD(GCadForm.PCad); end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxCaptionWidthExecute', E.Message); end; end; procedure TFSCS_Main.aManual_SuppliesKindsExecute(Sender: TObject); begin try ShowSuppliesKinds; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aManual_SuppliesKindsExecute', E.Message); end; end; procedure TFSCS_Main.aMasterCableChannelExecute(Sender: TObject); begin try MasterCableCanalTracing; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterCableChannelExecute', E.Message); end; end; procedure TFSCS_Main.aMasterCableTracingExecute(Sender: TObject); begin try MasterCableTracing; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterCableTracingExecute', E.Message); end; end; //Tolik 22/08/2025 -- создать вертикали в одной точке по всем листам проекта (высотой в высоту этажа) procedure TFSCS_Main.aCreateBFMagistralDownExecute(Sender: TObject); begin CreateBFMagistralTR(false, true); end; procedure TFSCS_Main.aCreateBFMagistralExecute(Sender: TObject); begin CreateBFMagistralTR; end; procedure TFSCS_Main.aCreateBFMagistralUpExecute(Sender: TObject); begin CreateBFMagistralTR(false, false, true); end; // procedure TFSCS_Main.aCreateBlockToFileExecute(Sender: TObject); var BlkName: string; FullBlkName: string; FullBlkNameOr: string; FullBlkName1: string; FullBlkName2: string; MetaFile: TMetafile; Bitmap: TBitmap; FDir: string; //08.09.2011 Buffer: array[0..1023] of Char; TempPath: string; SaveDialog: TSaveDialog; FileName: String; SelList: TList; i: integer; Block: TBlock; begin try if ActiveMDIChild <> nil then begin if GCadForm.PCad.SelectedCount > 0 then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.blk') then FDir := FDir + '\.blk'; SaveDialog.Title := cMain_Mes92; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'blk'; //11.03.2012 ''; SaveDialog.Filter := cMain_Mes52; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; SaveDialog.OnCanClose := SDCreateBlockToFileCanClose; // для проверки существования bmp if SaveDialog.Execute then begin FileName := ExtractFilePathOnly(SaveDialog.FileName); FullBlkName := FileName; if GCadForm.PCad.SelectedCount = 2 then begin SelList := TList.Create; for i := 0 to GCadForm.PCad.Selection.Count - 1 do SelList.Add(GCadForm.PCad.Selection[i]); for i := 0 to SelList.Count - 1 do begin GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle); end; FullBlkName1 := FullBlkName; FullBlkName2 := FullBlkName; FullBlkNameOr := FullBlkName; if TFigure(SelList[0]).CenterPoint.x > TFigure(SelList[1]).CenterPoint.x then FullBlkName1 := FullBlkName + '_active' else FullBlkName2 := FullBlkName + '_active'; for i := 0 to SelList.Count - 1 do begin FullBlkName := FullBlkName1; if i = 1 then FullBlkName := FullBlkName2; GCadForm.PCad.SelectFigure(TFigure(SelList[i]).Handle); //GCadForm.PCad.Refresh; Block := nil; if (TFigure(SelList[i]) is TBlock) then Block := TBlock(TBlock(SelList[i]).duplicate) else if (TFigure(SelList[i]) is TFigureGrp) then Block := TBlock(TFigureGrp(SelList[i]).duplicate) else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; //GCadForm.PCad.Refresh; Block := nil; if (TFigure(SelList[i]) is TBlock) then Block := TBlock(TBlock(SelList[i]).duplicate) else if (TFigure(SelList[i]) is TFigureGrp) then Block := TBlock(TFigureGrp(SelList[i]).duplicate) else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения BlockToNormalSize(Block, 150); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; GCadForm.PCad.Refresh; Block := nil; //if (TFigure(SelList[i]) is TBlock) then // Block := TBlock(TBlock(SelList[i]).duplicate) //else if (TFigure(SelList[i]) is TFigureGrp) then // Block := TBlock(TFigureGrp(SelList[i]).duplicate) //else Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); //Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); // Изменяем размеры для растрового изображения //BlockToNormalSize(Block, 150); //MetaFile := TMetafile.Create; //Bitmap := TBitmap.Create; //MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); //Bitmap.Height := Metafile.Height; //Bitmap.Width := Metafile.Width; //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.Canvas.Draw(0, 0, MetaFile); //Bitmap.SaveToFile(FullBlkName + '.bmp'); //FreeAndNil(MetaFile); //FreeAndNil(Bitmap); if Block <> nil then begin //Block.InFigures.Clear; Block.Free; end; GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle); GCadForm.PCad.Refresh; end; SelList.Clear; FreeAndNil(SelList); end else begin Block := nil; Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; Block := nil; Block := GCadForm.PCad.GetSelectionBlockDuplicate; Block.SaveToFile(FullBlkName + '.blk'); Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.BlockObjAsWmf(Block); Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FullBlkName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); if Block <> nil then begin Block.Free; end; end; end; FreeAndNil(SaveDialog); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockToFileExecute', E.Message); end; (* try if ActiveMDIChild <> nil then begin if GCadForm.PCad.SelectedCount > 0 then begin SaveDialog := TSaveDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.blk') then FDir := FDir + '\.blk'; SaveDialog.Title := cMain_Mes92; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'blk'; //11.03.2012 ''; SaveDialog.Filter := cMain_Mes52; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; SaveDialog.OnCanClose := SDCreateBlockToFileCanClose; // для проверки существования bmp if SaveDialog.Execute then begin FileName := ExtractFilePathOnly(SaveDialog.FileName); GCadForm.PCad.MakeSelectionBlock(FileName + '.blk'); MetaFile := TMetafile.Create; Bitmap := TBitmap.Create; MetaFile := GCadForm.PCad.SelectionAsWmf; Bitmap.Height := Metafile.Height; Bitmap.Width := Metafile.Width; Bitmap.Canvas.Draw(0, 0, MetaFile); Bitmap.SaveToFile(FileName + '.bmp'); FreeAndNil(MetaFile); FreeAndNil(Bitmap); end; FreeAndNil(SaveDialog); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockToFileExecute', E.Message); end; *) end; procedure TFSCS_Main.aChangeRaiseHeightExecute(Sender: TObject); var RaiseLine: TOrthoLine; RaiseConn: TConnectorObject; ObjFromRaise: TConnectorObject; CheckRaiseConn: TConnectorObject; i: integer; OldRaiseHeight: Double; RaiseHeight: Double; tempstr: string; SetRaiseHeight: Double; mess: string; CurLine: TOrthoLine; ZDirectionKoef: Integer; // Направление больше нуля или меньше нуля NextConn: TConnectorObject; // Tolik 04/02/2021 -- function CheckCanSnap : Boolean; begin Result := (RaiseConn.JoinedconnectorsList.Count = 0) and GCadForm.FAutoPosTraceBetweenRM; end; begin try if GPopupFigure = nil then exit; try RaiseLine := TOrthoLine(GPopupFigure); except RaiseLine := nil; Exit; end; // RaiseConn := nil; ObjFromRaise := nil; if TConnectorObject(RaiseLine.JoinConnector1).FConnRaiseType <> crt_None then begin RaiseConn := TConnectorObject(RaiseLine.JoinConnector1); ObjFromRaise := RaiseConn.FObjectFromRaise; end; if TConnectorObject(RaiseLine.JoinConnector2).FConnRaiseType <> crt_None then begin RaiseConn := TConnectorObject(RaiseLine.JoinConnector2); ObjFromRaise := RaiseConn.FObjectFromRaise; end; if (RaiseConn <> nil) and (ObjFromRaise <> nil) then begin //24.10.2012 OldRaiseHeight := RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1]; OldRaiseHeight := RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1]; //OldRaiseHeight := Abs(RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1]); tempstr := FormatFloat(ffMask, MetreToUOM(OldRaiseHeight)); if InputQuery(cCad_Mes13, cMain_Mes93, tempstr) then begin try StrToFloat_My(tempstr); except ShowMessage(cSizePos_Mes1); Exit; end; if tempstr <> '' then begin RaiseHeight := StrToFloat_My(tempstr); RaiseHeight := UOMToMetre(RaiseHeight); if RaiseHeight <> OldRaiseHeight then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; ZDirectionKoef := 1; //if RaiseConn.ActualZOrder[1] < 0 then // ZDirectionKoef := -1; // OnFloor if RaiseConn.FConnRaiseType = crt_OnFloor then begin SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + ZDirectionKoef * RaiseHeight; //24.10.2012 if SetRaiseHeight < 0 then //24.10.2012 SetRaiseHeight := 0; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cSCSObjectProp_Mes2), MB_YESNO) = IDYes then begin if CheckCanSnap then begin RaiseConn.ActualZOrder[1] := ObjFromRaise.ActualZOrder[1]; if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else RaiseLine.Delete; end; end else begin RaiseConn.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(RaiseConn.ID, RaiseConn.ActualZOrder[1]); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; RaiseLine.UpdateLengthTextBox(False, true); end; end else // BetweenFloor begin SetRaiseHeight := RaiseConn.ActualZOrder[1] - RaiseHeight; if SetRaiseHeight < 0 then SetRaiseHeight := 0; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = RaiseConn.ActualZOrder[1] then begin mess := cMain_Mes94; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes95, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes95), MB_YESNO) = IDYes then begin if CheckCanSnap then // Tolik 04/02/2020 -- begin RaiseConn.ActualZOrder[1] := ObjFromRaise.ActualZOrder[1]; if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end else RaiseLine.Delete; end; end else begin ObjFromRaise.ActualZOrder[1] := SetRaiseHeight; SetConFigureCoordZInPM(ObjFromRaise.ID, ObjFromRaise.ActualZOrder[1]); RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; RaiseLine.UpdateLengthTextBox(False, true); end; end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aChangeRaiseHeightExecute', E.Message); end; end; procedure TFSCS_Main.aDisconnectFromRMExecute(Sender: TObject); var Conn: TConnectorObject; RM: TConnectorObject; begin try if GPopupFigure <> nil then begin Conn := TConnectorObject(GPopupFigure); if Conn.JoinedConnectorsList.Count > 0 then begin RM := TConnectorObject(Conn.JoinedConnectorsList[0]); if RM <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UnsnapConnectorFromPointObject(Conn, RM); RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectFromRMExecute', E.Message); end; end; procedure TFSCS_Main.aDisconnectAllConnectorsExecute(Sender: TObject); var i, j: integer; RM: TConnectorObject; Conn: TConnectorObject; isRaiseOnIt: Boolean; begin try if GPopupFigure <> nil then begin RM := TConnectorObject(GPopupFigure); i := 0; if RM.JoinedConnectorsList.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; while i < RM.JoinedConnectorsList.Count do begin Conn := TConnectorObject(RM.JoinedConnectorsList[i]); if Conn <> nil then begin isRaiseOnIt := false; for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsRaiseUpDown then isRaiseOnIt := True; end; if not isRaiseOnIt then begin UnsnapConnectorFromPointObject(Conn, RM); RefreshCAD(GCadForm.PCad); end else i := i + 1; end; end; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectAllConnectorsExecute', E.Message); end; end; // Tolik -- 27/05/2016 -- // двинуть объект на противоположную вершину спуска/подъема // оригинал закомменчен, смотри ниже, т.к. не работает ни х // только "на кошках" и то, если кабеля нет, иначе - АВ procedure TFSCS_Main.aRemoveObjectOnHeightExecute(Sender: TObject); var BaseConn: TConnectorObject; OtherConn: TConnectorObject; i, j: integer; prevcount: integer; RaiseLine: TOrthoLine; SavedConnectionsList: TList; SavedComponList: TList; InterFaceAccordanceList, SavedLineComponList, SavedPointComponList: TList; SelfPointConnectInfo, JoinedLineConnectInfo: TLineComponConnectionInfo; SavedPointConnectionsList, PointComponents: TList; RaiseSide: Integer; Procedure SaveConnectionOnPointObject; var i, j, k, l, m, n: Integer; PointCatalog: TSCSCatalog; PointComponent, CableComponent: TSCSComponent; LineComponentsList: TList; function GetJoinedCableSide(CableCompon, JoinedCableCompon: TSCSComponent): Integer; var i, j : Integer; CableInterFace: TSCSInterface; CableInterfPos, JoinedCableInterfPos: TSCSInterfPosition; begin Result := 0; for i := 0 to CableCompon.Interfaces.Count - 1 do begin CableInterFace := TSCSInterface(CableCompon.Interfaces[i]); if (CableInterFace.TypeI = itFunctional) and ((CableInterFace.IsBusy = bitrue) or (CableInterFace.BusyPositions.Count > 0)) then begin for j := 0 to CableInterFace.BusyPositions.Count - 1 do begin CableInterfPos := TSCSInterfPosition(CableInterFace.BusyPositions[j]); JoinedCableInterfPos := CableInterfPos.GetConnectedPos; if JoinedCableInterfPos <> nil then begin if JoinedCableInterfPos.InterfOwner.ComponentOwner.ID = JoinedCableCompon.ID then begin Result := JoinedCableInterfPos.InterfOwner.Side; Break; //// BREAK ////; end; end; end; end; if Result <> 0 then Break; //// BREAK ////; end; end; function GetCableSide(CableComponent: TSCSComponent; aCatalog: TSCSCatalog): Integer; var i, j: Integer; interf: TSCSInterface; InterfPos: TSCSInterfPosition; begin Result := 0; for i := 0 to CableComponent.Interfaces.Count - 1 do begin if (TSCSInterface(CableComponent.Interfaces[i]).TypeI = itFunctional) then begin Interf := TSCSInterface(CableComponent.Interfaces[i]); for j := 0 to interf.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(interf.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if (InterfPos <> nil) and (InterfPos.InterfOwner <> nil) and (InterfPos.InterfOwner.ComponentOwner <> nil) then begin if aCatalog.ComponentReferences.IndexOf(InterfPos.InterfOwner.ComponentOwner) <> -1 then begin Result := interf.Side; break; end; end; end; if Result <> 0 then Break; //// BREAK ////; end; end; end; function GetConnectedInterFace(aInterf: TSCSInterFace; ACompon: TSCSComponent; aSide: integer): TSCSInterface; var i: Integer; begin Result := nil; end; function GetCableFromRaise(aCompon: TSCSComponent) : TSCSComponent; var i: Integer; begin Result := nil; for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then begin Result := TSCSComponent(aCompon.JoinedComponents[i]); Break; //// BREAK ////; end; end; end; function GetInterfFromRaise(aCableComponent: TSCSComponent; aComponSide: Integer; aCableInterFace: TSCSInterface): TSCSInterface; var i: Integer; begin Result := Nil; for i := 0 to aCableComponent.Interfaces.Count - 1 do begin if (TSCSInterface(aCableComponent.Interfaces[i]).Npp = aCableInterFace.Npp) and (TSCSInterface(aCableComponent.Interfaces[i]).Side = aComponSide) then begin Result := TSCSInterface(aCableComponent.Interfaces[i]); Break; //// BREAK ////; end; end; end; procedure SaveLineConnection(aCableList: TList; aPointCatalog: TSCSCatalog); var i, j, k: Integer; CableComponent, JoinedFromRaiseCableComponent, JoinedPointComponent: TSCSComponent; LineCatalog: TSCSCatalog; LineFigure: TFigure; CableInterface, JoinedCableInterFace: TSCSInterface; InterfPos, JoinedInterfPos: TSCSInterfPosition; CableComponSide, JoinedCableComponSide: Integer; ComponToDeleteList: TSCSComponents; CanDelCable: Boolean; ADInterface: TSCSInterface; begin if aCableList.Count > 0 then begin SavedPointConnectionsList := TList.Create; ComponToDeleteList := TSCSComponents.Create(False); for i := 0 to aCableList.Count - 1 do begin InterFaceAccordanceList := TList.Create; CableComponent := TSCSComponent(aCableList[i]); CableComponSide := GetCableSide(CableComponent, aPointCatalog); CanDelCable := False; JoinedFromRaiseCableComponent := nil; LineCatalog := CableComponent.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(LineCatalog.SCSID); if LineFigure <> nil then begin if TOrthoLine(LineFigure).FIsRaiseUpDown then begin CanDelCable := True; JoinedFromRaiseCableComponent := GetCableFromRaise(CableComponent); if JoinedFromRaiseCableComponent <> nil then JoinedCableComponSide := GetJoinedCableSide(CableComponent, JoinedFromRaiseCableComponent); end; end; // сохранять соединения только если это трасса или кабель с райза подключен на другую трассу, а не // к точечному или просто висит в воздухе if ((not CanDelCable) or (CanDelCable and (JoinedFromRaiseCableComponent <> nil))) then begin for j := 0 to CableComponent.Interfaces.Count - 1 do begin SavedLineComponList := TList.Create; SavedPointComponList := TList.Create; CableInterface := TSCSInterface(CableComponent.Interfaces[j]); if (CableInterface.TypeI = itFunctional) and (CableInterface.Side = CableComponSide) and ((CableInterface.BusyPositions.Count > 0) or (CableInterface.IsBusy = biTrue)) then begin if CanDelCable then ADInterface := GetInterfFromRaise(JoinedFromRaiseCableComponent, JoinedCableComponSide, CableInterFace) else ADInterface := CableInterface; if SavedLineComponList.IndexOf(AdInterface) = -1 then SavedLineComponList.Add(ADInterface); for k := 0 to CableInterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(CableInterface.BusyPositions[k]); JoinedInterfPos := InterfPos.GetConnectedPos; if (JoinedInterfPos <> nil) and (JoinedInterfPos.InterfOwner <> nil) and (JoinedInterfPos.InterfOwner.ComponentOwner <> nil) then begin if SavedPointComponList.IndexOf(JoinedInterfPos.InterfOwner) = -1 then SavedPointComponList.Add(JoinedInterfPos.InterfOwner); end; end; end; if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then begin InterFaceAccordanceList.Add(SavedLineComponList); InterFaceAccordanceList.Add(SavedPointComponList); SavedPointComponList := Nil; SavedPointComponList := Nil; end else begin FreeAndNil(SavedPointComponList); FreeAndNil(SavedLineComponList); end; end; end; end; // если кабель на райзе - занести в список на удаление if (CanDelCable and (ComponToDeleteList.IndexOf(CableComponent) = - 1)) then ComponToDeleteList.Add(CableComponent); if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then begin // состояние соединения кабеля на точечном объекте SelfPointConnectInfo := TLineComponConnectionInfo.Create(True); if (not CanDelCable) then begin SelfPointConnectInfo.ComponId := CableComponent.ID;//AJoinedLineCompon.ID; SelfPointConnectInfo.ComponSide := CableComponSide; SelfPointConnectInfo.isLineConnection := True; // подключить через новый кабель на райзе end else begin SelfPointConnectInfo.ComponId := JoinedFromRaiseCableComponent.ID;//AJoinedLineCompon.ID; SelfPointConnectInfo.ComponSide := JoinedCableComponSide; SelfPointConnectInfo.isLineConnection := False; // подключить прямо к тому, что есть (в точке подъема) end; JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False); JoinedLineConnectInfo.ComponCatalogID := 0; JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList; SelfPointConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo); SavedPointConnectionsList.Add(SelfPointConnectInfo); InterFaceAccordanceList := Nil; end else begin if InterFaceAccordanceList <> nil then FreeAndNil(InterFaceAccordanceList); end; end; // удалить кабели с райза if ComponToDeleteList.Count > 0 then F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil); end; end; begin if BaseConn <> nil then begin PointCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(BaseConn.ID); // строим список кабелей, подключенных к поинту if PointCatalog <> nil then begin PointComponents := TList.Create; LineComponentsList := TList.Create; for i := 0 to PointCatalog.ComponentReferences.Count - 1 do begin PointComponent := TSCSComponent(PointCatalog.ComponentReferences[i]); if PointComponents.IndexOf(PointComponent) = -1 then PointComponents.Add(PointComponent); for j := 0 to PointComponent.JoinedComponents.Count - 1 do begin if IsCableComponent(TSCSComponent(PointComponent.JoinedComponents[j])) then begin if LineComponentsList.IndexOf(TSCSComponent(PointComponent.JoinedComponents[j])) = -1 then LineComponentsList.Add(TSCSComponent(PointComponent.JoinedComponents[j])); end; end; end; if LineComponentsList.Count > 0 then SaveLineConnection(LineComponentsList, PointCatalog) else FreeAndNil(LineComponentsList); end; end; end; Procedure RestoreLineConnections; var i, j, k, l, m: Integer; CanDisJoin: boolean; LineCompon, PointCompon, JoinedLineCompon: TSCSComponent; PointCatalog, LineCatalog, RaiseCatalog: TSCSCatalog; PointFigure, LineFigure: TFigure; WayList, LineComponList: TList; LineConnector: TConnectorObject; aTempInterf, aLineInterface, aPointInterface: TSCSInterface; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; ConnectIDCompRel, InterfCount: Integer; ptrConnection: PComplect; TempInterfaces1, TempInterfaces2: TSCSInterfaces; Function DefineIDComponRel(ALineCompon, APointCompon: TSCSComponent): Integer; var TopCatalog: TSCSCatalog; begin Result := -1; begin TopCatalog := aLineCompon.GetTopParentCatalog; if TopCatalog <> nil then if TopCatalog is TSCSProject then Result := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1); end; //if IDComponRel = -1 then //IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); end; begin if SavedPointConnectionsList <> nil then begin RaiseCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(RaiseLine.ID); // сбросить соединения точечных с кабелями, если они соединились автоматически после подъема if (PointComponents <> nil) then begin for i := 0 to PointComponents.Count - 1 do begin PointCompon := TSCSComponent(PointComponents[i]); for j := (PointCompon.JoinedComponents.Count - 1) downto 0 do begin if IsCableComponent(TSCSComponent(PointCompon.JoinedComponents[j])) then PointCompon.DisJoinFrom(TSCSComponent(PointCompon.JoinedComponents[j])); end; end; end; // восстановить соединения for i := (SavedPointConnectionsList.Count - 1) downto 0 do begin SelfPointConnectInfo := TLineComponConnectionInfo(SavedPointConnectionsList[i]); LineCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfPointConnectInfo.ComponId); JoinedLineCompon := Nil; // если соединение через райз - вкинуть кабель и отсоединить от всего if SelfPointConnectInfo.isLineConnection then begin JoinedLineCompon := CopyComponentToPMSCSObject(LineCompon, RaiseCatalog, False); if JoinedLinecompon <> nil then JoinedLineCompon.DisJoinFromAll(false).Free; // соединить кабель на райзе с тем, что был подключен к точечному ConnectCableComponents(LineCompon, JoinedLineCompon); end; if LineCompon <> nil then begin LineCatalog := LineCompon.GetFirstParentCatalog; if LineCatalog <> nil then begin LineFigure := GetFigureByCatalogId(LineCatalog.SCSID); if LineFigure <> nil then begin JoinedLineConnectInfo := TLineComponConnectionInfo(SelfPointConnectInfo.ConnectedComponList[0]); InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList; if InterFaceAccordanceList.Count > 0 then begin m := 0; While (m <= (InterFaceAccordanceList.Count - 1)) do begin SavedLineComponList := TList(InterFaceAccordanceList[m]); SavedPointComponList := TList(InterFaceAccordanceList[m + 1]); for j := 0 to SavedLineComponList.Count - 1 do begin ALineInterFace := TSCSInterface(SavedLineComponList[j]); if SelfPointConnectInfo.isLineConnection then begin for k := 0 to JoinedLineCompon.Interfaces.Count - 1 do begin if ((TSCSInterface(JoinedLineCompon.Interfaces[k]).TypeI = itFunctional) and (TSCSInterface(JoinedLineCompon.Interfaces[k]).Npp = aLineInterface.Npp) and (TSCSInterface(JoinedLineCompon.Interfaces[k]).Side = RaiseSide)) then ALineInterface := TSCSInterface(JoinedLineCompon.Interfaces[k]); end; end; LineCompon := ALineInterFace.ComponentOwner; if ALineInterFace <> nil then begin for k := 0 to SavedPointComponList.Count - 1 do begin APointInterFace := TSCSInterface(SavedPointComponList[k]); PointCompon := APointInterFace.ComponentOwner; AInterfPositions1 := ALineInterFace.GetEmptyPositions; AInterfPositions2 := APointInterFace.GetEmptyPositions; // уравнять количество позиций для соединения if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then begin While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do begin l := AInterfPositions1.Positions.Count - 1; AInterfPositions1.Positions.Delete(l); end; AInterfPositions1.DefineKolvo; end else if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then begin While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do begin l := AInterfPositions2.Positions.Count - 1; AInterfPositions2.Positions.Delete(l); end; AInterfPositions2.DefineKolvo; end; ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon); // До того как соединить интерфейсы, нужно соединить сами компоненты if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then; FreeAndNil(TempInterfaces1); FreeAndNil(TempInterfaces2); end; if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then begin ptrConnection := LineCompon.GetConnectionByConnected(PointCompon); if ptrConnection <> nil then begin TempInterfaces1 := TSCSInterfaces.Create(false); TempInterfaces2 := TSCSInterfaces.Create(false); TempInterfaces1.Add(ALineInterFace); TempInterfaces2.Add(APointInterFace); InterfCount := AInterfPositions1.Kolvo; if InterfCount > AInterfPositions2.Kolvo then InterfCount := AInterfPositions2.Kolvo; TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace, InterfCount, InterfCount, ptrConnection.ID, cntUnion, AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2); TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1); end; end; end; end; end; SavedLineComponList.Clear; SavedPointComponList.Clear; FreeAndNil(SavedLineComponList); FreeAndNil(SavedPointComponList); Inc(m,2); end; end; end; end; end; SavedPointConnectionsList.Remove(SelfPointConnectInfo); FreeAndNil(SelfPointConnectInfo); end; FreeAndNil(SavedPointConnectionsList); end; end; begin try if GPopupFigure <> nil then begin SavedPointConnectionsList := Nil; PointComponents := Nil; RaiseLine := nil; RaiseSide := 0; BaseConn := TConnectorObject(GPopupFigure); // Tolik // определить райз и сторону подключения к райзу в точке подъема if BaseConn <> nil then begin RaiseSide := 0; // противоположная сторона райза для подключения if BaseConn.ConnectorType = ct_Clear then begin for i := 0 to BaseConn.JoinedOrtholinesList.Count - 1 do begin if TorthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin // райз RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]); // сторона противоположного подключения if TConnectorObject(RaiseLine.JoinConnector1).ID = BaseConn.ID then RaiseSide := 2 else if TConnectorObject(RaiseLine.JoinConnector2).ID = BaseConn.ID then RaiseSide := 1; break; end; end; end else if BaseConn.ConnectorType = ct_NB then begin for i := 0 to BaseConn.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]); if TConnectorObject(RaiseLine.JoinConnector1).ID = TConnectorObject(BaseConn.JoinedConnectorsList[i]).ID then RaiseSide := 2 else if TConnectorObject(RaiseLine.JoinConnector2).ID = TConnectorObject(BaseConn.JoinedConnectorsList[i]).ID then RaiseSide := 1; break; end; end; if RaiseSide <> 0 then break; end; end; end; // // ЭТО ВЕРШИНА GMovedByOtherObject := True; if BaseConn.FConnRaiseType = crt_OnFloor then begin OtherConn := BaseConn.FObjectFromRaise; if OtherConn <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; //сохранить кабельные соединения на точечном SaveConnectionOnPointObject; if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithRM(BaseConn, OtherConn) else if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then RemoveRMWithClear(BaseConn, OtherConn) else if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithClear(OtherConn, BaseConn); // if Not BaseConn.Deleted then begin i := 0; while i < BaseConn.JoinedOrtholinesList.Count do begin prevcount := BaseConn.JoinedOrtholinesList.Count; if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(BaseConn) or BaseConn.Deleted then break; end; end; if BaseConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if BaseConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; if Not OtherConn.Deleted then begin i := 0; while i < OtherConn.JoinedOrtholinesList.Count do begin prevcount := OtherConn.JoinedOrtholinesList.Count; if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(OtherConn) or OtherConn.Deleted then break; end; end; if OtherConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if OtherConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; // if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; // ЭТО ОСНОВАНИЕ if GetRaiseConn(BaseConn) <> nil then begin OtherConn := GetRaiseConn(BaseConn); if OtherConn <> nil then begin if OtherConn.FConnRaiseType = crt_OnFloor then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; //сохранить кабельные соединения на точечном SaveConnectionOnPointObject; if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithRM(BaseConn, OtherConn) else if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then RemoveRMWithClear(BaseConn, OtherConn) else if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithClear(OtherConn, BaseConn); // if Not BaseConn.Deleted then begin i := 0; while i < BaseConn.JoinedOrtholinesList.Count do begin prevcount := BaseConn.JoinedOrtholinesList.Count; if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(BaseConn) or BaseConn.Deleted then break; end; end; if BaseConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if BaseConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; if Not OtherConn.Deleted then begin i := 0; while i < OtherConn.JoinedOrtholinesList.Count do begin prevcount := OtherConn.JoinedOrtholinesList.Count; if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(OtherConn) or OtherConn.Deleted then break; end; end; if OtherConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if OtherConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; // if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; // Восстановить кабельные соединения // if InterFaceAccordanceList <> nil then RestoreLineConnections; GMovedByOtherObject := False; CheckDeleteAllRaises(GCadForm.PCad); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRemoveObjectOnHeightExecute', E.Message); end; end; { procedure TFSCS_Main.aRemoveObjectOnHeightExecute(Sender: TObject); var BaseConn: TConnectorObject; OtherConn: TConnectorObject; i: integer; prevcount: integer; RaiseLine: TOrthoLine; begin try if GPopupFigure <> nil then begin BaseConn := TConnectorObject(GPopupFigure); // ЭТО ВЕРШИНА GMovedByOtherObject := True; if BaseConn.FConnRaiseType = crt_OnFloor then begin OtherConn := BaseConn.FObjectFromRaise; if OtherConn <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithRM(BaseConn, OtherConn); if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then RemoveRMWithClear(BaseConn, OtherConn); if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithClear(OtherConn, BaseConn); // if Not BaseConn.Deleted then begin i := 0; while i < BaseConn.JoinedOrtholinesList.Count do begin prevcount := BaseConn.JoinedOrtholinesList.Count; if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(BaseConn) or BaseConn.Deleted then break; end; end; if BaseConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if BaseConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; if Not OtherConn.Deleted then begin i := 0; while i < OtherConn.JoinedOrtholinesList.Count do begin prevcount := OtherConn.JoinedOrtholinesList.Count; if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(OtherConn) or OtherConn.Deleted then break; end; end; if OtherConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if OtherConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; // SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; // ЭТО ОСНОВАНИЕ if GetRaiseConn(BaseConn) <> nil then begin OtherConn := GetRaiseConn(BaseConn); if OtherConn <> nil then begin if OtherConn.FConnRaiseType = crt_OnFloor then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithRM(BaseConn, OtherConn); if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then RemoveRMWithClear(BaseConn, OtherConn); if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then RemoveRMWithClear(OtherConn, BaseConn); // if Not BaseConn.Deleted then begin i := 0; while i < BaseConn.JoinedOrtholinesList.Count do begin prevcount := BaseConn.JoinedOrtholinesList.Count; if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(BaseConn) or BaseConn.Deleted then break; end; end; if BaseConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if BaseConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; if Not OtherConn.Deleted then begin i := 0; while i < OtherConn.JoinedOrtholinesList.Count do begin prevcount := OtherConn.JoinedOrtholinesList.Count; if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then begin if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]); CheckDeleteRaise(RaiseLine); if Not assigned(OtherConn) or OtherConn.Deleted then break; end; end; if OtherConn.JoinedOrtholinesList.Count = PrevCount then i := i + 1; if OtherConn.JoinedOrtholinesList.Count < PrevCount then i := 0; end; end; // SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; end; GMovedByOtherObject := False; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRemoveObjectOnHeightExecute', E.Message); end; end; } procedure TFSCS_Main.aCreateProjectPlanExecute(Sender: TObject); var i: integer; begin try if FSCS_Main.MDIChildCount > 0 then begin for i := 0 to FSCS_Main.MDIChildCount - 1 do begin if TF_CAD(FSCS_Main.MDIChildren[i]).FListType = lt_ProjectPlan then begin ShowMessage(cMain_Mes96); Exit; end; end; if F_ChooseComponTypes.Execute then begin end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateProjectPlanExecute', E.Message); end; end; procedure TFSCS_Main.FloatPanel1Click(Sender: TObject); begin try if F_FloatPanel.Visible then HideFloatPanel else ShowFloatPanel; except end; end; procedure TFSCS_Main.PDock1Resize(Sender: TObject); begin try if F_FloatPanel.ClassName = 'TF_FloatPanel' then ResizeFloatPanel; except end; end; procedure TFSCS_Main.aToolCabinetExecute(Sender: TObject); begin try DropDownFirstToolbar; // Tolik 10/02/2021 -- if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 9; GCadForm.PCad.SetTool(toFigure, 'TCabinet'); tbCabinetNoob.Down := True; // Tolik 10/02/2021 -- end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolCabinetExecute', E.Message); end; end; procedure TFSCS_Main.aSaveAsWMFExecute(Sender: TObject); var FName: string; FDir: string; SavePictureDialog: TSavePictureDialog; Stream: TStream; mf, mf2, mf3: TMetafile; wmf: TWMFObject; i: integer; rtf: TRichText; f: tfigure; begin if ActiveMDIChild <> nil then begin SavePictureDialog := TSavePictureDialog.Create(Self); {$if Defined(ES_GRAPH_SC)} FDir := ExeDir; {$else} FDir := ExtractFileDir(Application.ExeName); {$ifend} if DirectoryExists(FDir + '\.bmp') then FDir := FDir + '\.bmp'; SavePictureDialog.Title := cMain_Mes97; SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir; SavePictureDialog.DefaultExt := 'wmf'; SavePictureDialog.Filter := cMain_Mes98; if SavePictureDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName)); // FName := SavePictureDialog.FileName; GCadForm.PCad.ExportAsWmf(FName); except ShowMessage(cMain_Mes8); end; end; SavePictureDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aShowConfiguratorExecute(Sender: TObject); var Conn: TConnectorObject; begin try if GPopupFigure <> nil then begin Conn := TConnectorObject(GPopupFigure); ShowConfiguratorForPointObject(Conn.ID); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowConfiguratorExecute', E.Message); end; end; procedure TFSCS_Main.aShowRepResourcesExecute(Sender: TObject); begin try RepResourceReport; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowRepResourcesExecute', E.Message); end; end; procedure TFSCS_Main.aCreateNormsOnCadExecute(Sender: TObject); var i: Integer; FindCadNorms: TCadNorms; Lhandle: Integer; begin try if ActiveMDIChild <> nil then begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin FindCadNorms := nil; for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCadNorms) then FindCadNorms := TCadNorms(GCadForm.PCad.Figures[i]); end; if FindCadNorms <> nil then begin RemoveInFigureGrp(FindCadNorms); GCadForm.PCad.Figures.Remove(FindCadNorms); FreeAndNil(FindCadNorms); end; RefreshCAD(GCadForm.PCad); try BeginProgress; LHandle := GCadForm.PCad.GetLayerHandle(1); FindCadNorms := TCadNorms.create(LHandle, GCadForm.PCad); FindCadNorms.FNormsList := GetCurrentNormsForCAD(GCadForm.FCADListID); FindCadNorms.Build; GCadForm.PCad.AddCustomFigure(1, FindCadNorms, False); RefreshCAD(GCadForm.PCad); finally EndProgress; end; end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateNormsOnCadExecute', E.Message); end; end; procedure TFSCS_Main.aNormsEditExecute(Sender: TObject); begin try if GPopupFigure <> nil then if CheckFigureByClassName(GPopupFigure, cTCadNorms) then begin if F_CadNormsList.Execute(TCadNorms(GPopupFigure)) then begin try BeginProgress; TCadNorms(GPopupFigure).ReBuild; // сохранить структуру SetNormsToListFromCAD(GCadForm.FCADListID, TCadNorms(GPopupFigure).FNormsList); finally EndProgress; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNormsEditRecordExecute', E.Message); end; end; procedure TFSCS_Main.aNormsPropExecute(Sender: TObject); begin try if GPopupFigure <> nil then if CheckFigureByClassName(GPopupFigure, cTCadNorms) then begin if F_CadNormsProp.Execute(TCadNorms(GPopupFigure)) then begin try BeginProgress; TCadNorms(GPopupFigure).ReBuild; finally EndProgress; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNormsPropExecute', E.Message); end; end; procedure TFSCS_Main.aMirrorViewExecute(Sender: TObject); var Conn: TConnectorObject; CadCrossObject: TCadCrossObject; begin try BeginProgress; if GPopupFigure <> nil then begin // MessageDlg('', mtWarning, [mbOK], 0); Conn := TConnectorObject(GPopupFigure); if Conn.FMirrored then Conn.FMirrored := False else Conn.FMirrored := True; CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, Conn.ID); if Conn.FTrunkName = ctsnCrossATS then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; ReCreateCadCrossATS(GCadForm.FCADListID, Conn.ID, CadCrossObject); AfterMirrorTrunkObject(Conn); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; if Conn.FTrunkName = ctsnDistributionCabinet then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; ReCreateCadDistribCab(GCadForm.FCADListID, Conn.ID, CadCrossObject); AfterMirrorTrunkObject(Conn); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorViewExecute', E.Message); end; EndProgress; end; procedure TFSCS_Main.aCreateDuplicatesExecute(Sender: TObject); var i, j: Integer; FFigure: TFigure; FiguresList: TList; RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; ObjFromRaise: TConnectorObject; DupList: TList; PointConn: TConnectorObject; GetParentDup: TConnectorObject; DrawDeltaX, DrawDeltaY: Double; PointToX, PointToY: Double; SelBnd: TDoubleRect; Offsetdeltax, Offsetdeltay: double; // Tolik SnapToGridsValue, SnapToGuidesValue, SnapToNearValue: Boolean; CanMoveFigure: Boolean; UserQuotaReached_Message: String; // // Tolik -- 03/09/2016 -- Procedure CheckAlignVLines(aList: TList); var i: Integer; VLine: TOrthoLine; deltax, deltay: Double; begin if ((AList <> nil) and (AList.Count > 0)) then begin for i := 0 to AList.Count - 1 do begin if CheckFigureByClassName(TFigure(aList[i]), cTOrthoLine) then begin VLine := TOrthoLine(aList[i]); if VLine.FIsVertical then begin if TConnectorObject(VLine.JoinConnector1).JoinedConnectorsList.Count > 0 then begin TConnectorObject(VLine.JoinConnector1).ActualPoints[1] := TConnectorObject(TConnectorObject(VLine.JoinConnector1).JoinedConnectorsList[0]).ActualPoints[1]; DeleteObjectFromPM(TConnectorObject(VLine.JoinConnector1).ID, TConnectorObject(VLine.JoinConnector1).Name); end; if TConnectorObject(VLine.JoinConnector2).JoinedConnectorsList.Count > 0 then begin TConnectorObject(VLine.JoinConnector2).ActualPoints[1] := TConnectorObject(TConnectorObject(VLine.JoinConnector2).JoinedConnectorsList[0]).ActualPoints[1]; DeleteObjectFromPM(TConnectorObject(VLine.JoinConnector2).ID, TConnectorObject(VLine.JoinConnector2).Name); end; end; VLine.ActualPoints[1] := TConnectorObject(VLine.JoinConnector1).ActualPoints[1]; VLine.ActualPoints[2] := TConnectorObject(VLine.JoinConnector2).ActualPoints[1]; end; end; end; end; begin // Tolik -- 27/02/2017 -- проверка на угрозу превышения объектов USER UserQuotaReached_Message := ''; // try BeginProgress; // Tolik -- 24/11/2015 -- сохраняем и сбрасываем настройки привязки объектов для КАДа, // иначе при дублировании "поплывут" размеры линейных объектов if GCadForm.PCad.SnapToGrids then SnapToGridsValue := True else SnapToGridsValue := False; if GCadForm.PCad.SnapToGuides then SnapToGuidesValue := True else SnapToGuidesValue := False; if GCadForm.PCad.SnapToNearPoint then SnapToNearValue := True else SnapToNearValue := False; // сброс GCadForm.PCad.SnapToGrids := False; GCadForm.PCad.SnapToGuides := False; GCadForm.PCad.SnapToNearPoint := False; // FiguresList := TList.Create; DupList := nil; // основной цикл for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not (TConnectorObject(FFigure).FIsApproach) then FiguresList.Add(FFigure); end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin FiguresList.Add(FFigure); end else if FFigure is TNet then begin //if TNet(FFigure).FComponID <> 0 then FiguresList.Add(FFigure); end; end; // Tolik -- 20/11/2015 -- пара копий - и мы вне пределов КАДа... оно надо? // сдвигаем по диагонали немножко вправо-вниз, чтобы было видно скопированные фигуры - и харэ // получить границы выделенных объектов { SelBnd := GCadForm.PCad.GetSelectionRect; Offsetdeltax := abs(SelBnd.Right - SelBnd.Left); Offsetdeltay := abs(SelBnd.Bottom - SelBnd.Top); if Offsetdeltax < Offsetdeltay then begin if Offsetdeltax <> 0 then //17.05.2011 Offsetdeltay := 0; end else begin if Offsetdeltay <> 0 then Offsetdeltax := 0; end; } Offsetdeltay := 10; Offsetdeltax := 10; // // дополнить с-п, которые на пустых выделенных с-п for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) and (not TConnectorObject(FFigure).FIsApproach) then begin if TConnectorObject(FFigure).ConnectorType = ct_Clear then begin RaiseConn := nil; RaiseLine := nil; if TConnectorObject(FFigure).JoinedConnectorsList.Count > 0 then ObjFromRaise := TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[0]) else ObjFromRaise := TConnectorObject(FFigure); RaiseConn := GetRaiseConn(ObjFromRaise); if RaiseConn <> nil then RaiseLine := GetRaiseLine(RaiseConn); if RaiseConn <> nil then if CheckNoFigureInList(RaiseConn, FiguresList) then FiguresList.Add(RaiseConn); if RaiseLine <> nil then if not RaiseLine.Deleted then // Tolik 17/12/2020 -- if CheckNoFigureInList(RaiseLine, FiguresList) then FiguresList.Add(RaiseLine); end; end; end; // Tolik 27/02/2017 -- //if FiguresList.Count > 0 then if ((FiguresList.Count > 0) and (GUserOBjectsQuotaLimit_Message_Counter < 3)) then begin UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(FiguresList.Count), cMess_Quota_DuplicateFigList); if UserQuotaReached_Message = '' then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; BeginDublicateCADObjects; DupList := CreateSCSObjectDuplicates(GCadForm, FiguresList); RefreshCAD(GCadForm.PCad); end else if GUserOBjectsQuotaLimit_Message_Counter < 4 then begin PauseProgress(True); ShowMessage(UserQuotaReached_Message); PauseProgress(False); end; end; FreeAndNil(FiguresList); EndDublicateCADObjects; // !!! if DupList <> nil then begin // глобальное смещение УГО объектов for i := 0 to DupList.Count - 1 do begin FFigure := TFigure(DupList[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if TConnectorObject(FFigure).ConnectorType <> ct_Clear then begin PointConn := TConnectorObject(FFigure); GetParentDup := TConnectorObject(GetFigureByID(GCadForm, PointConn.tmpParentDupID)); if GetParentDup <> nil then begin if GetParentDup.DrawFigure <> nil then begin DrawDeltaX := GetParentDup.DrawFigure.CenterPoint.x - GetParentDup.ActualPoints[1].x; DrawDeltaY := GetParentDup.DrawFigure.CenterPoint.y - GetParentDup.ActualPoints[1].y; PointToX := PointConn.ActualPoints[1].x + DrawDeltaX; PointToY := PointConn.ActualPoints[1].y + DrawDeltaY; if PointConn.DrawFigure <> nil then begin PointConn.DrawFigure.move(PointToX - PointConn.DrawFigure.CenterPoint.x, PointToY - PointConn.DrawFigure.CenterPoint.y); end; end; end; PointConn.tmpParentDupID := -1; end; end; end; // выделить группы и сместить ее GCadForm.PCad.DeselectAll(0); RefreshCAD(GCadForm.PCad); for i := 0 to DupList.Count - 1 do TFigure(DupList[i]).Select; // Tolik -- 23/11/2015 -- не сделать - на следующем повторном дубликате // поломается все нах, если будут с/п for i := 0 to DupList.Count - 1 do begin if CheckFigurebyClassName(TFigure(DupList[i]), cTConnectorObject) then begin // на ct_NB выбираем все пустые, чтобы попали с/п (если есть) в следующую копию if TConnectorObject(DupList[i]).ConnectorType = ct_NB then begin for j := 0 to TConnectorObject(DupList[i]).JoinedConnectorsList.Count - 1 do TConnectorObject(TConnectorObject(DupList[i]).JoinedConnectorsList[j]).Selected := True; end else // пустой коннектор if (TConnectorObject(DupList[i]).ConnectorType = ct_Clear) and (TConnectorObject(DupList[i]).JoinedConnectorsList.Count = 0 ) and // там где <> 0 отберется на ct_NB (TConnectorObject(DupList[i]).JoinedOrthoLinesList.Count > 0 ) then TConnectorObject(DupList[i]).Selected := True; end else // с/п не выбираем (на всякий сбрасываем) if CheckFigurebyClassName(TFigure(DupList[i]), cTOrthoLine) then if TOrthoLine(DupList[i]).FIsRaiseUpDown then TOrthoLine(DupList[i]).Selected := False; end; //Tolik 03/09/2016 -- выровнять вертикали после снапа коннеткоров (коннекторы вертикали могут сдвинуться) CheckAlignVLines(DupList); // RefreshCAD(GCadForm.PCad); UnSelectFiguresOnSelectedChange(GcadForm.PCad.Selection); RefreshCAD(GCadForm.PCad); // переместить { for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin { FFigure := TFigure(GCadForm.PCad.Selection[i]); // Tolik 24/11/2015 -- проверить и двинуть только пустые и неприсоединенные к точечным коннекторы // чтобы не было двойного сдвига CanMoveFigure := False; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if TConnectorObject(FFigure).ConnectorType = ct_Clear then begin CanMoveFigure := True; for j := 0 to TConnectorObject(FFigure).JoinedConnectorsList.Count - 1 do begin if ((TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[j]).ConnectorType = ct_NB) and (GCadForm.PCad.Selection.IndexOf(TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[j])) <> -1)) then begin CanMoveFigure := False; Break; //// BREAK //// end; end; end; end else if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if ((GCadForm.PCad.Selection.IndexOf(TOrthoLine(FFigure).JoinConnector1) <> -1) or (GCadForm.PCad.Selection.IndexOf(TOrthoLine(FFigure).JoinConnector2) <> -1)) then CanMoveFigure := False; end else CanMoveFigure := True; if CanMoveFigure then begin } // GCadForm.PCad.MoveSelection(Offsetdeltax, Offsetdeltay); { if not FFigure.LockMove then begin if FFigure is TNet then TNet(FFigure).FMoveAllPoints := true; FFigure.Move(Offsetdeltax, Offsetdeltay); if FFigure is TNet then TNet(FFigure).FMoveAllPoints := false; end; end; end; } if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateDuplicatesExecute', E.Message); end; // Tolik -- 24/11/2015 -- восстанавливаем значения настроек привязки(выравнивания) объектов для КАДа GCadForm.PCad.SnapToGrids := SnapToGridsValue; GCadForm.PCad.SnapToGuides := SnapToGuidesValue; GCadForm.PCad.SnapToNearPoint := SnapToNearValue; if DupList <> nil then // это просто забыли FreeAndNil(DupList); //if GCadForm.GisEventWaiting then if GCadForm.FRemFigures.Count > 0 then begin //GCadForm.PCad.EventEngine(95,1,'',0); // Tolik 27/03/2019 -- GCadForm.PCad.OnGUIEvent := GCADFORM.PCadGUIEvent; end; // EndProgress; end; procedure TFSCS_Main.aCHMExecute(Sender: TObject); var FileName: string; begin try FileName := ExeDir + '\Help\Help.chm'; if FileExists(FileName) then begin ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, SW_SHOWNORMAL); end else ShowMessage(cMain_Mes87); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCHMExecute', E.Message); end; end; procedure TFSCS_Main.aDisconnectTracesExecute(Sender: TObject); var i: Integer; CurObject: TConnectorObject; SelList, FigList: TList; //vList: TList; //vIntLIst: TIntList; begin try if GPopupFigure = nil then exit; SelList := TList.Create; for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then begin CurObject := TConnectorObject(GCadForm.PCad.Selection[i]); if CurObject.ConnectorType = Ct_Clear then SelList.Add(CurObject); end; end; if SelList.Count > 0 then begin // *UNDO* // vIntList := GetListsIDRelatedToFigures(GCadForm.FCADListID, FiguresToIntFigures(SelList)); // vList := IntCadsToCads(vIntList); // if vList.Count = 1 then // GCadForm.SaveForUndo(uat_None, True, False) // else // SaveForProjectUndo(vList, True, False); if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to SelList.Count - 1 do begin CurObject := TConnectorObject(SelList[i]); CurObject.Deselect; DisconnectTraces(CurObject); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; FreeAndNil(SelList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectTracesExecute', E.Message); end; end; procedure TFSCS_Main.aRotateTraceDrawFigure180Execute(Sender: TObject); var RotateTrace: TOrthoLine; CP: TDoublePoint; begin try if GPopupFigure = nil then exit; RotateTrace := TOrthoLine(GPopupFigure); CP := DoublePoint((RotateTrace.ActualPoints[1].x + RotateTrace.ActualPoints[2].x) / 2, (RotateTrace.ActualPoints[1].y + RotateTrace.ActualPoints[2].y) / 2); // вернуть в Режим обычный if RotateTrace.FIsRotated then begin RotateTrace.FIsRotated := false; if RotateTrace.DrawFigure <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; RotateTrace.DrawFigure.Rotate(- pi, CP); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end else // в Режим 180 begin RotateTrace.FIsRotated := true; if RotateTrace.DrawFigure <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; RotateTrace.DrawFigure.Rotate(pi, CP); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateTraceDrawFigure180Execute', E.Message); end; end; procedure TFSCS_Main.aDesignBoxParamsExecute(Sender: TObject); var DesignID: Integer; BoxID: Integer; FList: TF_CAD; FBox: TConnectorObject; begin try F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked := GCadForm.FDesignListShowName; F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked := GCadForm.FDesignListShowSign; F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked := GCadForm.FDesignListShowMark; if F_ChooseDesignBoxParams.Execute then begin GCadForm.FDesignListShowName := F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked; GCadForm.FDesignListShowSign := F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked; GCadForm.FDesignListShowMark := F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked; DesignID := GCadForm.FJoinedListIDForDesignList; BoxID := GCadForm.FJoinedBoxIDForDesignList; FList := GetListByID(DesignID); if FList <> nil then begin FBox := TConnectorObject(GetFigureByID(FList, BoxID)); if FBox <> nil then begin UpdateDesignList(GCadForm, FBox); end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxParamsExecute', E.Message); end; end; procedure TFSCS_Main.aPackNormBaseExecute(Sender: TObject); begin try PackNormBase; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPackNormBaseExecute', E.Message); end; end; procedure TFSCS_Main.aPackProjManExecute(Sender: TObject); begin try PackProjMan; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aPackProjManExecute', E.Message); end; end; procedure TFSCS_Main.aMirrorBlockExecute(Sender: TObject); var vObject: TConnectorObject; ang: Double; begin try if GPopupFigure <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; vObject := TConnectorObject(GPopupFigure); ang := vObject.FDrawFigureAngle; vObject.DrawFigure.Rotate(- ang, vObject.DrawFigure.CenterPoint); vObject.DrawFigure.Mirror(vObject.DrawFigure.CenterPoint, vObject.DrawFigure.CenterPoint); vObject.DrawFigure.Rotate(ang); // vObject.DrawFigure.Rotate(pi, vObject.DrawFigure.CenterPoint); RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorBlockExecute', E.Message); end; end; procedure TFSCS_Main.aMarkForTracingExecute(Sender: TObject); var vLine: TOrthoLine; begin try if GPopupFigure <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; vLine := TOrthoLine(GPopupFigure); vLine.FMarkTracing := not vLine.FMarkTracing; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMarkForTracingExecute', E.Message); end; end; procedure TFSCS_Main.aBlockParamsExecute(Sender: TObject); {var TempBlock: TFigure; FigHandle: Integer; CommonNetIdx: Integer; IsSaveForUndo: Boolean;} var SelFigure: TFigure; SelFigureObj: TSCSComponent; CommonNetIdx: Integer; begin if GCadForm.PCad.Selection.Count > 1 then begin SelFigure := TFigure(GCadForm.PCad.Selection[0]); //10.05.2012 Если TNet, то если выделены все сегменты крыши (связанные), то выводим диалог с учетом высоты крыши if (SelFigure.ClassName = TNet.ClassName) and (TNet(SelFigure).FComponID <> 0) then begin CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet); SelFigureObj := GetArchObjByCADObj(SelFigure); if SelFigureObj <> nil then if SelFigureObj.IsLine = ctArhRoofSeg then begin if IsAllRelatedNetsInList(TNet(SelFigure), GCadForm.PCad.Selection, true) then ShowRoofParams(GCadForm, nil, GCadForm.PCad.Selection); end; if CommonNetIdx <> -1 then begin GCadForm.PCad.Selection.Add(GCadForm.FActiveNet); GCadForm.FActiveNet.Selected := true; end; end; end else ShowBlockParamsForPopupFigure; {try TempBlock := nil; IsSaveForUndo := false; try if (GPopupFigure = nil) then begin if GCadForm.PCad.ActiveLayer = lnArch then begin GCadForm.BeginSaveForUndo(uat_None, False, False); IsSaveForUndo := true; if GCadForm.PCad.SelectedCount = 1 then TempBlock := TFigure(GCadForm.PCad.Selection.Items[0]) else if GCadForm.PCad.SelectedCount > 0 then begin //CommonNetIdx := GCadForm.PCad.Selection.IndexOf(GCadForm.FActiveNet); //if CommonNetIdx <> -1 then //begin // GCadForm.FActiveNet.Selected := false; // GCadForm.PCad.Selection.Delete(CommonNetIdx); //end; CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet); FigHandle := GCadForm.PCad.GroupSelection; SetProjectChanged(True); TempBlock := TFigure(FigHandle); if CommonNetIdx <> -1 then begin GCadForm.PCad.Selection.Add(GCadForm.FActiveNet); GCadForm.FActiveNet.Selected := true; end; end; GPopupFigure := TempBlock; end; end; if GPopupFigure <> nil then begin F_BlockParams.Execute(GPopupFigure); end; if (TempBlock <> nil) and (TempBlock is TFigureGrp) then begin GCadForm.PCad.UnGroupSelection; SetProjectChanged(True); end; finally if IsSaveForUndo then GCadForm.EndSaveForUndo; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBlockParamsExecute', E.Message); end;} end; procedure TFSCS_Main.aCabinetFalseFloorExecute(Sender: TObject); var Cabinet: TCabinet; SCSID: Integer; begin try if GPopupFigure <> nil then begin SCSID := -1; if CheckFigureByClassName(GPopupFigure, cTCabinet) then SCSID := TCabinet(GPopupFigure).FSCSID else if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then SCSID := TCabinetExt(GPopupFigure).FSCSID; ShowRoomPropsInCAD(GCadForm.FCADListID, SCSID); // Cabinet := TCabinet(GPopupFigure); // SetCabinetFalseFloor(Cabinet); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCabinetFalseFloorExecute', E.Message); end; end; procedure TFSCS_Main.aLicenceTypeExecute(Sender: TObject); var CanRemotePath: Boolean; begin try (* {$IF NOT Defined(TRIAL_SCS)} CheckProtectionBase(true); GProtectionType := GetProtectionType; if GProtectionType <> ltLocal then begin if AnsiLowerCase(F_NormBase.DM.Database_SCS.DatabaseName) <> AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')) then begin ShowMessage('Необходимо перезапустить программный комплекс!'); ExitProcess(0); end; end; {$IFEND} *) {$IF Defined (TRIAL_SCS)} CanRemotePath := false; {$ELSE} CanRemotePath := true; {$IFEND} ConnecToNBWizard(true, false, true, CanRemotePath); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aLicenceTypeExecute', E.Message); end; end; procedure TFSCS_Main.aToolMultiLineExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GDefaultNum := 2; GDefaultGap := 4; GCurrentConnectorType := ct_Clear; F_OrthoLineParams.ShowModal; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolMultiLineExecute', E.Message); end; end; procedure TFSCS_Main.aShowDisconnectedObjectsExecute(Sender: TObject); begin try if aShowDisconnectedObjects.Checked = True then begin GCadForm.FShowDisconnectedObjects := True; end else begin GCadForm.FShowDisconnectedObjects := False; end; RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowDisconnectedObjectsExecute', E.Message); end; end; procedure TFSCS_Main.aMasterUpdateComponPriceFromXFExecute(Sender: TObject); begin try ShowMasterUpdatePriceInNB; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterUpdateComponPriceFromXFExecute', E.Message); end; end; procedure TFSCS_Main.aRefreshDesignListExecute(Sender: TObject); var vList: TF_CAD; vBox: TConnectorObject; begin try vList := GetListByID(GCadForm.FJoinedListIDForDesignList); if vList <> nil then begin vBox := TConnectorObject(GetFigureByID(vList, GCadForm.FJoinedBoxIDForDesignList)); if vBox <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndoDesignList(uat_None, false, false); GCadForm.FCanSaveForUndo := False; end; UpdateDesignList(GCadForm, vBox); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRefreshDesignListExecute', E.Message); end; end; procedure TFSCS_Main.aBackUpBaseExecute(Sender: TObject); begin BackUpBase(bkNone); end; procedure TFSCS_Main.aRestoreBaseExecute(Sender: TObject); begin RestoreBase; end; procedure TFSCS_Main.aExpertModeExecute(Sender: TObject); var i: integer; CAD: TF_CAD; begin try GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := aExpertMode.Checked; //01.04.2009 WriteControls(GSCSIni.Controls); //#From Oleg# //19.12.2011 - //for i := 0 to FSCS_Main.MDIChildCount - 1 do //begin // CAD := TF_CAD(FSCS_Main.MDIChildren[i]); // CAD.OnResize := nil; //end; cbMainPanel.DisableAlign; try //cbMainPanel. if aExpertMode.Checked then begin tbCADToolsExpert.Visible := True; tbSCSToolsExpert.Visible := True; // Tolik 24/01/2017 -- tbCADToolsNoob2.Visible := False; tbCalc.Visible := true; // tbCADToolsNoob.Visible := False; tbSCSToolsNoob.Visible := False; if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then begin tbSCSToolsExpert.Width := cSCSExpert; tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width; end; //Tolik 13/08/2021 -- ToolButton9.Visible := True; ToolButton10.Visible := True; //tbSCSToolsNoob.Visible := True; // end else begin //Tolik 13/08/2021 -- ToolButton9.Visible := False; ToolButton10.Visible := False; tbSCSToolsNoob.Visible := False; tbCalc.Visible := false; // tbCADToolsExpert.Visible := False; {$if Defined(ES_GRAPH_SC)} tbSCSToolsExpert.Visible := True; {$else} tbSCSToolsExpert.Visible := False; {$ifend} tbCADToolsNoob2.Visible := False; tbCADToolsNoob.Visible := False; tbCADToolsNoob.Visible := True; // Tolik 24/01/2017 - - tbCADToolsNoob2.Visible := True; // {$if Defined(ES_GRAPH_SC)} tbSCSToolsNoob.Visible := False; {$else} //tbSCSToolsNoob.Visible := True; {$ifend} if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then begin {$IF Defined(SCS_PE) or Defined(SCS_SPA)} tbCADToolsNoob.Width := cCADNoob_PE; tbCADToolsNoob2.Width := cCADNoob_PE; tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 32; // Tolik -- 24/01/2017 // tbSCSToolsNoob.Width := cSCSNoob_PE; tbSCSToolsNoob.Width := cSCSNoob_PE + 20; // {$ELSEIF Defined(TELECOM)} tbCADToolsNoob.Width := cCADNoob_TEL; tbCADToolsNoob2.Width := cCADNoob_TEL; tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 30; // Tolik 24/01/2017 -- // tbSCSToolsNoob.Width := cSCSNoob_SCS; tbSCSToolsNoob.Width := cSCSNoob_SCS + 20; // {$ELSE} // Tolik -- 01/02/2017 -- {$if Defined(ES_GRAPH_SC)} tbCADToolsNoob.Width := 600; tbCADToolsNoob2.Width := 300; {$ELSE} // tbCADToolsNoob.Width := cCADNoob_SCS; //Tolik 17/08/2021 -- //tbCADToolsNoob2.Width := cCADNoob_SCS; tbCADToolsNoob2.Width := cCADNoob_SCS; // tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 30; {$ifend} // Tolik -- 24/01/2017 -- // tbSCSToolsNoob.Width := cSCSNoob_SCS; tbSCSToolsNoob.Width := cSCSNoob_SCS + 20; // {$IFEND} // Tolik -- 24/01/2017 -- // tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width; tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width; // end; end; if tbCADToolsNoob.Visible then begin tbCADToolsNoob.Top := tbCADToolsExpert.Top; tbCADToolsNoob.Left := tbCADToolsExpert.Left; // Tolik -- 01/02/2017 -- tbCADToolsNoob2.Visible := False; tbCADToolsNoob.visible := False; {$if Defined(ES_GRAPH_SC)} tbCADToolsNoob2.Left := tbCADToolsNoob.Left + tbCADToolsNoob.width + 10; tbCADToolsNoob2.Top := tbCADToolsExpert.Top; {$else} tbCADToolsNoob2.Top := tbCADToolsExpert.Top + 30; tbCADToolsNoob2.Left := tbCADToolsExpert.Left; {$ifend} tbCADToolsNoob.Visible := True; tbCADToolsNoob2.Visible := True; // end; if tbSCSToolsNoob.Visible then begin tbSCSToolsNoob.Top := tbSCSToolsExpert.Top; end; if tbCADToolsExpert.Visible then begin tbSelectExpert.Down := True; tbSelectNoob.Down := False; end else begin tbSelectExpert.Down := False; tbSelectNoob.Down := True; end; finally cbMainPanel.EnableAlign; //19.12.2011 - //for i := 0 to FSCS_Main.MDIChildCount - 1 do //begin // CAD := TF_CAD(FSCS_Main.MDIChildren[i]); // CAD.OnResize := CAD.FormResize; //end; end; if GCadForm <> nil then GCadForm.FormActivate(GCadForm); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aExpertModeExecute', E.Message); end; end; procedure TFSCS_Main.cbLayersPropertiesInitPopup(Sender: TObject); var i: integer; begin if (GCadForm.PCad.Layers.Count - 1) <> cbLayers.Properties.Items.Count then begin cbLayers.Properties.Items.Clear; for i := 1 to GCadForm.PCad.LayerCount - 1 do cbLayers.Properties.Items.Add(GCadForm.PCad.GetLayerName(i)); end; end; procedure TFSCS_Main.aShowPMUsersExecute(Sender: TObject); begin try ShowPMUsers; except on E: Exception do addExceptionToLogEx('TFSCS_Main.Act_ShowPMUsersExecute', E.Message); end; end; procedure TFSCS_Main.aLoginUserToProManExecute(Sender: TObject); begin try LoginUserToProMan; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aLoginUserToProManExecute', E.Message); end; end; procedure TFSCS_Main.aShowCurrUserInfoExecute(Sender: TObject); begin try ShowCurrUserInfo; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aShowCurrUserInfoExecute', E.Message); end; end; procedure TFSCS_Main.aExpertNewsExecute(Sender: TObject); var temps : string; t : word; innt: integer; tmr: integer; s : string; begin try if PROG_NEWSID <> '-1' then begin temps := ExtractFilePath(application.ExeName)+'news\mess.txt'; t := 11; case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 1, t) of 0:begin end; end; case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 2, t) of 0:begin innt:=t*60*1000; tmr:=innt; TimerNews.Interval := tmr; end; end; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aExpertNewsExecute', E.Message); end; end; procedure TFSCS_Main.TimerNewsTimer(Sender: TObject); var temps : string; t : word; innt: integer; tmr: integer; begin TimerNews.OnTimer := nil; TimerNews.Enabled := False; if PROG_NEWSID <> '-1' then begin try temps := ExtractFilePath(application.ExeName)+'news\mess.txt'; case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 0, t) of 0:begin TimerNews.Enabled := True; end; 1:begin TimerNews.Enabled := False; // ShowMessage('Ошибка загрузки библиотеки'); end; // 2:begin ShowMessage('Ошибка вызова процедуры'); end; // 3:begin ShowMessage('Ошибочный параметр вызова'); end; // 4:begin ShowMessage('Ошибка выполнения процедуры'); end; end; except end; TimerNews.OnTimer := TimerNewsTimer; end; end; procedure TFSCS_Main.tbCalcClick(Sender: TObject); begin try {$IF Defined(OEM_NIKOMAX)} MessageBox(Application.Handle, 'Недоступно в данной сборке!', 'Внимание!', MB_OK); {$ELSE} ShowKalc; {$IFEND} except on E: Exception do AddExceptionToLogEx('TFSCS_Main.tbCalcClick', E.Message); end; end; procedure TFSCS_Main.aMarkingPagesExecute(Sender: TObject); begin try RepMarkPages; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aMarkingPagesExecute', E.Message); end; end; procedure TFSCS_Main.aMarkForDisableTracingExecute(Sender: TObject); var vLine: TOrthoLine; begin try if GPopupFigure <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; vLine := TOrthoLine(GPopupFigure); vLine.FDisableTracing := not vLine.FDisableTracing; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMarkForTracingExecute', E.Message); end; end; procedure TFSCS_Main.aMasterAutoTraceElectricExecute(Sender: TObject); begin try F_NormBase.Act_AutoTraceByRayMode.Execute; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aMasterAutoTraceElectricExecute', E.Message); end; end; //функция вызова function RunPresentation: boolean; var RunPre: procedure(); stdcall; begin Result := false; if phandle = 0 then phandle := LoadLibrary(PChar('ep.dll')); try if phandle <> 0 then begin Result := true; @RunPre:=GetProcAddress(phandle,'RExecute'); @SetHook:=GetProcAddress(phandle,'SetHook'); @DropHook:=GetProcAddress(phandle,'UnHook'); if (@SetHook <> nil) and (@DropHook <> nil) then is_hook:=true; if @RunPre <> nil then begin try // SetHook; RunPre(); except Result := false; Exit; end; end; end; finally end; end; procedure TFSCS_Main.ExpertPresentation1Click(Sender: TObject); begin if RunPresentation then begin end else begin // Tolik --10/09/2018 -*- (* {$IF Defined(SCS_PE)} ShowMessage('Error load presentation module'); {$ELSE} ShowMessage('Ошибка загрузки модуля презентации'); {$IFEND} *) ShowMessage(cPresentation_err1); // end; end; procedure TFSCS_Main.WMGetSysCommand(var msg: TMessage); //var // OldReadOnly: boolean; begin if (msg.wParam = SC_CLOSE) then begin GNotNeedCheckRaisesBeforeClose := True; //if Assigned(F_ProjMan) then //begin // OldReadOnly := F_ProjMan.GSCSBase.CurrProject.ReadOnly; // F_ProjMan.GSCSBase.CurrProject.ReadOnly := true; //end; GCloseProg := True; try inherited; finally GNotNeedCheckRaisesBeforeClose := False; GCloseProg := False; // if Assigned(F_ProjMan) then // F_ProjMan.GSCSBase.CurrProject.ReadOnly := OldReadOnly; end; end else inherited; end; procedure TFSCS_Main.aCreateFloorRaiseUpExecute(Sender: TObject); var RaiseOnFigure: TConnectorObject; ID_Floor: Integer; i: integer; ConnForPassage: TConnectorObject; RaiseConn: TConnectorObject; RaiseConnPassage: TConnectorObject; ListForPassage: TF_CAD; CurGCadFrom: TF_CAD; LayHandle: Integer; ObjParams: TObjectParams; CreatePoints: TDoublePoint; z: double; vLists: TList; SavedGCadForm: TF_CAD; SavedGPopupFigure: TFigure; begin // Tolik 09/02/2017 -- vLists := nil; // try RaiseOnFigure := nil; //#From Oleg# //14.09.2010 if (not ShowCreateRaiseQuery) or F_CreateRaiseQuery.Execute then begin // искать этаж ID_Floor := GetListIDForCreatePassage(GCadForm.FCADListID, 1); ListForPassage := nil; if ID_Floor > 0 then if Not CheckListExist(ID_Floor) then begin SavedGCadForm := GCadForm; SavedGPopupFigure := GPopupFigure; Application.ProcessMessages; ReopenListInCAD(ID_Floor, ''); Application.ProcessMessages; GCadForm := SavedGCadForm; GPopupFigure := SavedGPopupFigure; end; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = ID_Floor then begin ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]); Break; end; end; // Найденный этаж if ListForPassage = nil then begin ShowMessage(cMain_Mes45); GCadForm.mProtocol.Lines.Add(cMain_Mes45); Exit; end else begin // тип листа не обычный if ListForPassage.FListType <> lt_Normal then begin ShowMessage(cMain_Mes46); Exit; end; // тип сети внешняя if ListForPassage.FSCSType = st_External then begin ShowMessage(cMain_Mes101); Exit; end; end; if GPopupFigure = nil then Exit; // *UNDO* vLists := TList.Create; vLists.Add(GCadForm); vLists.Add(ListForPassage); SaveForProjectUndo(vLists, True, False); // if GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_Floor); // GCadForm.FCanSaveForUndo := False; // end; // if ListForPassage.FCanSaveForUndo then // begin // ListForPassage.SaveForUndo(uat_Floor); // ListForPassage.FCanSaveForUndo := False; // end; if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then begin if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then begin CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y); z := TOrthoLine(GPopupFigure).ActualZOrder[1]; end else begin CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2; CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2; z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2; end; {//25.06.2013 RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad); RaiseOnFigure.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False); RaiseOnFigure.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name); ObjParams := GetFigureParams(RaiseOnFigure.ID); RaiseOnFigure.Name := ObjParams.Name; RaiseOnFigure.FIndex := ObjParams.MarkID;} RaiseOnFigure := GCadForm.CreateConnForFloorRaise(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle); SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure)); end else if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then begin RaiseOnFigure := TConnectorObject(GPopupFigure); end; // создать м-э подъем с этажа на объекте if RaiseOnFigure.ConnectorType = ct_Clear then RaiseConn := CreateBetweenFloorRaiseOnConnector(RaiseOnFigure, lrt_Up) else RaiseConn := CreateBetweenFloorRaiseOnPointObject(RaiseOnFigure, lrt_Up); ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]); CurGCadFrom := GCadForm; GCadForm := ListForPassage; GCadForm.BringToFront; // Создать объект на найденом этаже LayHandle := GCadForm.PCad.GetLayerHandle(2); //24.10.2012 ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight, //24.10.2012 LayHandle, mydsNormal, GCadForm.PCad); ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FLineHeight, LayHandle, mydsNormal, GCadForm.PCad); ConnForPassage.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False); ConnForPassage.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name); ObjParams := GetFigureParams(ConnForPassage.ID); ConnForPassage.Name := ObjParams.Name; ConnForPassage.FIndex := ObjParams.MarkID; // создать м-э спуск от того объекта RaiseConnPassage := CreateBetweenFloorRaiseOnConnector(ConnForPassage, lrt_Down); GCadForm := CurGCadFrom; GCadForm.BringToFront; // Заполнить поля соединений точек перехода RaiseConn.FID_ListToPassage := ListForPassage.FCADListID; RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID; RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID; RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID; SetConnBringToFront(RaiseOnFigure); SetConnBringToFront(ConnForPassage); RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; ListForPassage.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseUpExecute', E.Message); end; // Tolik 09/02/2017 -- if vLists <> nil then FreeAndNil(vLists); // end; procedure TFSCS_Main.ACreateFloorVExecute(Sender: TObject); var i, ListIndex: integer; x,y: Double; FCad, SavedGcadForm: TF_Cad; CadList: TList; CreatedLine: TOrthoLine; p1, p2: TDoublePoint; SavedMoveWithRaise, SSGrid, SSN, SSG: Boolean; SCSList: TSCSList; begin SavedMoveWithRaise := GMoveWithRaise; GMoveWithRaise := False; p1.x := GMouseDownPos.x; p1.y := GMouseDOwnPos.y; p1.z := 0; p2.x := GMouseDownPos.x + 1; p2.y := GMouseDOwnPos.y + 1; p2.z := 0; SSGrid := GCadForm.PCad.SnapToGrids; SSN := GCadForm.PCad.SnapToNearPoint; SSG := GCadForm.PCad.SnapToGuides; GCadForm.PCad.SnapToGrids := False; GCadForm.PCad.SnapToNearPoint := False; GCadForm.PCad.SnapToGuides := False; CreatedLine := CreateTraceByPoints(GCadForm.PCad, p1, p2); CreatedLine.ActualZOrder[1] := 0; TConnectorObject(CreatedLine.JoinConnector1).actualzOrder[1] := 0; TConnectorObject(CreatedLine.JoinConnector2).MoveP(p1.x - p2.x, p1.y - p2.y, False, False); CreatedLine.ActualZOrder[2] := GCadForm.FRoomHeight; TConnectorObject(CreatedLine.JoinConnector2).actualzOrder[1] := GCadForm.FRoomHeight; CreatedLine.LengthCalc; CreatedLine.LineLength := CreatedLine.LengthCalc; GCadForm.PCad.SnapToGrids := SSGrid; GCadForm.PCad.SnapToNearPoint := SSN; GCadForm.PCad.SnapToGuides := SSG; GMoveWithRaise := SavedMoveWithRaise; if GCadForm.cbManualCableTracingMode.Down then begin if F_NormBase.GSCSBase.SCSComponent <> nil then begin if F_NormBase.GSCSBase.SCSComponent.IsLine = biTrue then begin CopyComponentToSCSObject(CreatedLine.ID, F_NormBase.GSCSBase.SCSComponent.ID); end; end; end; end; procedure TFSCS_Main.aCreateFloorRaiseDownExecute(Sender: TObject); var RaiseOnFigure: TConnectorObject; ID_Floor: Integer; i: integer; ConnForPassage: TConnectorObject; RaiseConn: TConnectorObject; RaiseConnPassage: TConnectorObject; ListForPassage: TF_CAD; CurGCadFrom: TF_CAD; LayHandle: Integer; ObjParams: TObjectParams; CreatePoints: TDoublePoint; z: double; vLists: TList; SavedGCadForm: TF_CAD; SavedGPopupFigure: TFigure; begin // Tolik -- 09/02/2017 -- vLists := Nil; // try RaiseOnFigure := nil; //#From Oleg# //14.09.2010 if (not ShowCreateRaiseQuery) or F_CreateRaiseQuery.Execute then begin // искать этаж ID_Floor := GetListIDForCreatePassage(GCadForm.FCADListID, -1); ListForPassage := nil; if ID_Floor > 0 then if Not CheckListExist(ID_Floor) then begin SavedGCadForm := GCadForm; SavedGPopupFigure := GPopupFigure; Application.ProcessMessages; ReopenListInCAD(ID_Floor, ''); Application.ProcessMessages; GCadForm := SavedGCadForm; GPopupFigure := SavedGPopupFigure; end; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = ID_Floor then begin ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]); Break; end; end; // Найденный этаж if ListForPassage = nil then begin ShowMessage(cMain_Mes47); GCadForm.mProtocol.Lines.Add(cMain_Mes47); Exit; end else begin // тип листа не обычный if ListForPassage.FListType <> lt_Normal then begin ShowMessage(cMain_Mes48); Exit; end; // тип сети внешняя if ListForPassage.FSCSType = st_External then begin ShowMessage(cMain_Mes102); Exit; end; end; if GPopupFigure = nil then Exit; // *UNDO* vLists := TList.Create; vLists.Add(GCadForm); vLists.Add(ListForPassage); SaveForProjectUndo(vLists, True, False); if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then begin if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then begin CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y); z := TOrthoLine(GPopupFigure).ActualZOrder[1]; end else begin CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2; CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2; z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2; end; {//19.06.2013 RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad); RaiseOnFigure.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False); RaiseOnFigure.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name); ObjParams := GetFigureParams(RaiseOnFigure.ID); RaiseOnFigure.Name := ObjParams.Name; RaiseOnFigure.FIndex := ObjParams.MarkID;} RaiseOnFigure := GCadForm.CreateConnForFloorRaise(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle); SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure)); end else if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then begin RaiseOnFigure := TConnectorObject(GPopupFigure); end; if RaiseOnFigure.ConnectorType = ct_Clear then RaiseConn := CreateBetweenFloorRaiseOnConnector(RaiseOnFigure, lrt_Down) else RaiseConn := CreateBetweenFloorRaiseOnPointObject(RaiseOnFigure, lrt_Down); CurGCadFrom := GCadForm; GCadForm := ListForPassage; GCadForm.BringToFront; // Создать объект на найденом этаже LayHandle := GCadForm.PCad.GetLayerHandle(2); //24.10.2012 ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight, //24.10.2012 LayHandle, mydsNormal, GCadForm.PCad); ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FLineHeight, LayHandle, mydsNormal, GCadForm.PCad); ConnForPassage.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False); ConnForPassage.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name); ObjParams := GetFigureParams(ConnForPassage.ID); ConnForPassage.Name := ObjParams.Name; ConnForPassage.FIndex := ObjParams.MarkID; // создать м-э подъем от того объекта RaiseConnPassage := CreateBetweenFloorRaiseOnConnector(ConnForPassage, lrt_Up); GCadForm := CurGCadFrom; GCadForm.BringToFront; // Заполнить поля соединений точек перехода RaiseConn.FID_ListToPassage := ListForPassage.FCADListID; RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID; RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID; RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; ListForPassage.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseDownExecute', E.Message); end; // Tolik 09/02/2017 -- if VLists <> nil then FreeAndNil(vLists); // end; procedure TFSCS_Main.aCreateTrunkExecute(Sender: TObject); var i: Integer; Item: TListItem; FList: TF_CAD; // RaiseOnFigure: TConnectorObject; ID_Floor: Integer; ConnForPassage: TConnectorObject; RaiseConn: TConnectorObject; RaiseConnPassage: TConnectorObject; ListForPassage: TF_CAD; CurGCadFrom: TF_CAD; LayHandle: Integer; ObjParams: TObjectParams; CreatePoints: TDoublePoint; z: double; vLists: TList; SavedGCadForm: TF_CAD; SavedGPopupFigure: TFigure; RaiseType1, RaiseType2: TLineRaiseType; ListOfListsInt: TIntList; ListOfLists: TList; SetLen: Double; begin // Tolik 07/02/2017 -- ListOfLists := Nil; vLists := Nil; ListOfListsInt := Nil; // try RaiseOnFigure := nil; //#From Oleg# //14.09.2010 F_ChooseListForTrunk.lvCadLists.Items.Clear; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin FList := TF_CAD(FSCS_Main.MDIChildren[i]); Item := F_ChooseListForTrunk.lvCadLists.Items.Add; Item.Caption := FList.FCADListName + ' ' + IntToStr(FList.FCADListIndex); Item.Data := FList; if (FList.FListType <> lt_Normal) or (FList = GCadForm) then Item.ImageIndex := 180 else Item.ImageIndex := 0; end; if F_ChooseListForTrunk.ShowModal = mrOK then begin if F_ChooseListForTrunk.lvCadLists.Selected <> nil then begin ListForPassage := TF_CAD(F_ChooseListForTrunk.lvCadLists.Selected.Data); if GPopupFigure = nil then Exit; // *UNDO* vLists := TList.Create; vLists.Add(GCadForm); vLists.Add(ListForPassage); SaveForProjectUndo(vLists, True, False); if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then begin if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then begin CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y); z := TOrthoLine(GPopupFigure).ActualZOrder[1]; end else begin CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2; CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2; z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2; end; RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad); RaiseOnFigure.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False); RaiseOnFigure.Name := cCadClasses_Mes12; SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name); ObjParams := GetFigureParams(RaiseOnFigure.ID); RaiseOnFigure.Name := ObjParams.Name; RaiseOnFigure.FIndex := ObjParams.MarkID; SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure)); end else if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then begin RaiseOnFigure := TConnectorObject(GPopupFigure); end; SetLen := 0; // текущий находится выше if GetUpperList(GCadForm.FCADListID, ListForPassage.FCADListID) = GCadForm.FCADListID then begin RaiseType1 := lrt_Down; RaiseType2 := lrt_Up; ListOfListsInt := GetSortedListIDsByBounds(ListForPassage.FCADListID, GCadForm.FCADListID); end else // текущий находится ниже begin RaiseType1 := lrt_Up; RaiseType2 := lrt_Down; ListOfListsInt := GetSortedListIDsByBounds(GCadForm.FCADListID, ListForPassage.FCADListID); end; // Вычислить длинну магистрали if ListOfListsInt <> nil then begin ListOfLists := IntCadsToCads(ListOfListsInt); for i := 0 to ListOfLists.Count - 1 do begin if (TF_CAD(ListOfLists[i]) <> GCadForm) and (TF_CAD(ListOfLists[i]) <> ListForPassage) then SetLen := SetLen + TF_CAD(ListOfLists[i]).FRoomHeight; end; end; SetLen := StrToFloat_My(F_ChooseListForTrunk.edTrunkLength.Text); SetLen := UOMToMetre(SetLen); if RaiseOnFigure.ConnectorType = ct_Clear then RaiseConn := CreateTrunkRaiseOnConnector(RaiseOnFigure, RaiseType1, SetLen) else RaiseConn := CreateTrunkRaiseOnPointObject(RaiseOnFigure, RaiseType1, SetLen); CurGCadFrom := GCadForm; GCadForm := ListForPassage; GCadForm.BringToFront; // Создать объект на найденом этаже LayHandle := GCadForm.PCad.GetLayerHandle(2); ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight, LayHandle, mydsNormal, GCadForm.PCad); ConnForPassage.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False); ConnForPassage.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name); ObjParams := GetFigureParams(ConnForPassage.ID); ConnForPassage.Name := ObjParams.Name; ConnForPassage.FIndex := ObjParams.MarkID; // создать м-э подъем от того объекта RaiseConnPassage := CreateTrunkRaiseOnConnector(ConnForPassage, RaiseType2, 0); GCadForm := CurGCadFrom; GCadForm.BringToFront; // Заполнить поля соединений точек перехода RaiseConn.FID_ListToPassage := ListForPassage.FCADListID; RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID; RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID; RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; ListForPassage.FCanSaveForUndo := True; end; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateTrunkExecute', E.Message); end; // Tolik -- 07/02/2017 -- if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfListsInt <> nil then ListOfListsInt.Free; if vLists <> nil then FreeAndNil(vLists); // end; (* procedure TFSCS_Main.BitBtn1Click(Sender: TObject); begin try GCadForm.PCad.SaveAsBitmap('123.bmp'); GCadForm.PCad.View3D; except end; end; *) procedure TFSCS_Main.miShowConnectedConnComponsClick(Sender: TObject); begin ShowConnDisconnComponsForList(GCadForm.FCADListID, cdConnConCompons); end; procedure TFSCS_Main.miShowConnectedLineComponsClick(Sender: TObject); begin ShowConnDisconnComponsForList(GCadForm.FCADListID, cdConnlineCompons); end; procedure TFSCS_Main.mnuReservClick(Sender: TObject); begin F_Reserv.ShowModal; end; procedure TFSCS_Main.pmConnectedPointsPopup(Sender: TObject); begin miShowConnectedConnCompons.Caption := F_ProjMan.Act_ConnectedConCompons.Caption; end; procedure TFSCS_Main.pmiSCSObjAutoCreateTracesAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var OutText: String; begin OutText := (Sender as TMenuItem).Caption; if (odFocused in State) or (odSelected in State) then begin end else begin {if Sender = N33 then begin OutText := 'AUTOROUTE'; end; if Sender = N46 then begin OutText := 'LAY OUT ON SELECTED ROUTES'; end;} ACanvas.Font.Style := [fsBold]; ARect.Left := 32; ARect.Right := ARect.Right - 32; ACanvas.brush.color := clWhite; //Tolik 26/01/2021 -- ACanvas.FillRect(ARect); DrawText(ACanvas.Handle, PChar(OutText), -1, ARect, DT_VCENTER or dt_LEFT or dt_singleline); end; end; procedure TFSCS_Main.pmConnectedLinesPopup(Sender: TObject); begin miShowConnectedLineCompons.Caption := F_ProjMan.Act_ConnectedLineCompons.Caption; end; procedure SetDefaultActiveLayer; begin if (GCadForm <> nil) and (GCadForm.PCad <> nil) then begin {$IF Defined(ES_GRAPH_SC)} if GCadForm.CurrentLayer <> lnArch then GCadForm.CurrentLayer := lnArch; {$ELSE} if GCadForm.CurrentLayer <> lnSCSCommon then GCadForm.CurrentLayer := lnSCSCommon; {$IFEND} try if (Application.Active) and (GCadForm <> nil) and (GCadForm.PCad <> nil) then if Not GCadForm.PCad.Focused then begin SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0); SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0); GCadForm.PCad.SetFocus; end; except ShowMessage('EXCEPTION: TFSCS_Main.cbLayersPropertiesCloseUp (Set PCAD focus)'); end; end; end; procedure TFSCS_Main.tb3DClick(Sender: TObject); var CtrlDown: boolean; // 2011-05-10 xModelNode: TTreeNode; OldMapScale: Integer; prLists: TList; begin {$ifdef 3D} if ActiveMDIChild <> nil then begin {$IF Not Defined(ES_GRAPH_SC)} SaveSubstrateArchPlan(GetPathToSCSTmpDir + '\3d.jpg'); {$IFEND} GCurrentRoom3DView := nil; {$IF Defined(ES_GRAPH_SC)} ctrlDown:=(IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if ctrlDown then if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then begin try DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D); except end; end; {$IFEND} // 22.07.2011 G3DModelForProject := False; GisChangeFrom3D := False; Gis3D := True; //Tolik 29/08/2025 -- записать Уно проекта перед 3Д //Tolik 11/07/2023 -- //SaveCurrProjectToUndoFiles(true); // SaveUndoProjBefore3D; GIs3D := True; // BeginProgress; if not Assigned(frm3D) then Application.CreateForm(Tfrm3D, frm3d); if Assigned(frm3D.F3DModel) then FreeAndNil(frm3D.F3DModel); frm3D.F3DModel := T3DModel.Create; frm3D.FIdsStream.Clear; frm3D.FFilesStream.Clear; frm3D.ModelTree.Items.Clear; frm3D.ScsModelTree.Items.Clear; xModelNode := frm3D.ModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName); xModelNode.Data := frm3D.F3DModel; xModelNode.HasChildren := True; xModelNode := frm3D.ScsModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName); xModelNode.Data := frm3D.F3DModel; xModelNode.HasChildren := True; frm3D.FZOrder := 0; if GCadForm.FListType = lt_Normal then GCadForm.View3D; EndProgress; frm3d.FCAD := GCadForm; Application.ProcessMessages; frm3d.ShowModal; FreeAndNil(frm3D); //Tolik 11/07/2025 -- восстановить проект, если были изменения через 3Д... {if GisChangeFrom3D then UndoListInPM(-1, GetPathToSCSUndoUniqDir(true), true, 0, 0); } // if GisChangeFrom3D then begin end; GisChangeFrom3D := False; Gis3D := False; // Tolik 23/07/2018 -- GCadForm.PCad.Refresh; // end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); SetDefaultActiveLayer; {$endif 3D} end; procedure TFSCS_Main.aInsertKnotForHouseExecute(Sender: TObject); var House: THouse; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTHouse) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; House := THouse(GPopupFigure); House.InsertKnot(House.SelectedPoint); RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aInsertKnotExecute', E.Message); end; end; procedure TFSCS_Main.aDeleteKnotForHouseExecute(Sender: TObject); var House: THouse; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTHouse) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; House := THouse(GPopupFigure); House.DeleteKnot(House.SelectedPoint); RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteKnotExecute', E.Message); end; end; procedure TFSCS_Main.aAddApproachExecute(Sender: TObject); begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), cTHouse) then begin GCadForm.FActiveHouse := THouse(GCadForm.PCad.Selection[0]); GCadForm.PCad.SetTool(toFigure, 'TApproachTool'); end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aAddApproachExecute', E.Message); end; end; procedure TFSCS_Main.aDeleteHouseExecute(Sender: TObject); var i: integer; CurHouse: THouse; CurPath: TNetPath; mess: string; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), cTHouse) then begin CurHouse := THouse(GCadForm.PCad.Selection[0]); mess := cMain_Mes115; //if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes116, MB_YESNO) = IDYes then if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes116), MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurHouse.Delete; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := true; end; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteHouseExecute', E.Message); end; end; procedure TFSCS_Main.aEditApproachExecute(Sender: TObject); var i: Integer; vCaption: TRichText; vBound: TRectangle; approach: TConnectorObject; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Approach := TConnectorObject(GPopupFigure); vCaption := nil; vBound := nil; //#From Oleg# //14.09.2010 for i := 0 to Approach.DrawFigure.InFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(Approach.DrawFigure.InFigures[i]), 'TRichText') then vCaption := TRichText(Approach.DrawFigure.InFigures[i]) else if CheckFigureByClassName(TFigure(Approach.DrawFigure.InFigures[i]), 'TRectangle') then vBound := TRectangle(Approach.DrawFigure.InFigures[i]); end; if vCaption.edit then begin ReCreateApproachText(Approach.DrawFigure, vCaption, vBound); end; GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aEditApproachExecute', E.Message); end; end; procedure TFSCS_Main.aRotateApproachExecute(Sender: TObject); var Approach: TConnectorObject; begin try if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Approach := TConnectorObject(GPopupFigure); GCadForm.PCad.SetTool(toSelect, 'TFigure'); Approach.DrawFigure.LockModify := False; Approach.DrawFigure.fRMode := True; Approach.DrawFigure.RotateSelect; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aRotateApproachExecute', E.Message); end; end; procedure TFSCS_Main.aModApproachExecute(Sender: TObject); var Approach: TConnectorObject; begin try if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Approach := TConnectorObject(GPopupFigure); Approach.DrawFigure.LockModify := False; Approach.DrawFigure.fTraceMod := True; Approach.DrawFigure.select; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aModApproachExecute', E.Message); end; end; procedure TFSCS_Main.aToolCabinetExtExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin DropDownFirstToolbar; // Tolik 10/02/2021 -- GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.CurrentLayer := 9; GCadForm.PCad.SetTool(toFigure, 'TCabinetExt'); tbCabinetExtNoob.Down := True; // Tolik 10/02/2021 -- end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aToolCabinetExtExecute', E.Message); end; end; procedure TFSCS_Main.aConvertSegmentToArcExecute(Sender: TObject); var Cabinet: TCabinetExt; Segment: TPlSegment; Poly: TPolyline; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Cabinet := TCabinetExt(GPopupFigure); Segment := TPlSegment(Cabinet.Segments[Cabinet.SelectedPoint - 1]); Cabinet.ArrangeSelectedSegment(sArc); RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aConvertSegmentToArcExecute', E.Message); end; end; procedure TFSCS_Main.aInsertKnotForCabinetExecute(Sender: TObject); var Cabinet: TCabinetExt; CP: TDoublePoint; MaxX, MaxY, MinX, MinY: Double; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Cabinet := TCabinetExt(GPopupFigure); Cabinet.InsertKnot(Cabinet.SelectedPoint); if Cabinet.FNumberObject <> nil then begin Cabinet.getbounds(MaxX, MaxY, MinX, MinY); CP.x := (MinX + MaxX) / 2; CP.y := (MinY + MaxY) / 2; Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y); end; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aInsertKnotForCabinetExecute', E.Message); end; end; procedure TFSCS_Main.aDeleteKnotForCabinetExecute(Sender: TObject); var Cabinet: TCabinetExt; CP: TDoublePoint; MaxX, MaxY, MinX, MinY: Double; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Cabinet := TCabinetExt(GPopupFigure); Cabinet.DeleteKnot(Cabinet.SelectedPoint); if Cabinet.FNumberObject <> nil then begin Cabinet.getbounds(MaxX, MaxY, MinX, MinY); CP.x := (MinX + MaxX) / 2; CP.y := (MinY + MaxY) / 2; Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y); end; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteKnotForCabinetExecute', E.Message); end; end; procedure TFSCS_Main.aShowDefectObjectsExecute(Sender: TObject); begin try if aShowDefectObjects.Checked = True then begin GCadForm.FShowDefectObjects := True; // aShowConnFullnessExecute(Sender: TObject); // aShowCableFullnessExecute(Sender: TObject); // aShowCableChannelFullnessExecute(Sender: TObject); end; if aShowDefectObjects.Checked = False then GCadForm.FShowDefectObjects := False; RefreshCAD(GCadForm.PCad); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aShowDefectObjectsExecute', E.Message); end; end; procedure TFSCS_Main.aInvertArcSegmentExecute(Sender: TObject); var Cabinet: TCabinetExt; Segment: TPlSegment; Poly: TPolyline; begin try if GPopupFigure = nil then exit; if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; Cabinet := TCabinetExt(GPopupFigure); Segment := TPlSegment(Cabinet.Segments[Cabinet.SelectedPoint - 1]); if Segment.SType = sArc then Segment.Inverted := not Segment.Inverted; RefreshCAD(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := true; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aConvertSegmentToArcExecute', E.Message); end; end; procedure TFSCS_Main.aOpenVectorDrawingExecute(Sender: TObject); var FName: string; FDir: string; OpenPictureDialog: TSavePictureDialog; begin try if ActiveMDIChild <> nil then begin GisUserDimLine := true; LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124); // Tolik 11/08/2021 - - if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenVectorDrawingExecute', E.Message); end; end; procedure TFSCS_Main.aSaveVectorDrawingExecute(Sender: TObject); var FName: string; FDir: string; SavePictureDialog: TSavePictureDialog; begin try if ActiveMDIChild <> nil then begin SaveDXFFile(GCadForm.PCad, cMain_Mes122, cMain_Mes124_2); GCadForm.PCad.SetFocus;// Tolik 09/04/2020 -- тут надо, а то остаются белые зоны на каде после отображения // экспортируемого листа в левом верхнем углу када end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aSaveVectorDrawingExecute', E.Message); end; end; procedure TFSCS_Main.aOpenRasterDrawingExecute(Sender: TObject); var FName: string; FDir: string; OpenPictureDialog: TOpenPictureDialog; Jpeg: TJpegImage; Bmp: TBMPObject; BmpHandle: TFigHandle;// Tolik 09/08/2019 -- begin Bmp := Nil; // Tolik 09/08/2019 - - GLoadPCadBackGroundImage := True; // Tolik 29/01/2020 -- try if ActiveMDIChild <> nil then begin OpenPictureDialog := TOpenPictureDialog.Create(Self); OpenPictureDialog.Title := cMain_Mes121; OpenPictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir; //Tolik 10/08/2021 -- //OpenPictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg'; //OpenPictureDialog.Filter := cMain_Mes125; OpenPictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg, *.png'; OpenPictureDialog.Filter := cMain_Mes125_; // if OpenPictureDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctPictures, ExtractFileDir(OpenPictureDialog.FileName)); // FName := OpenPictureDialog.FileName; aSetSubstrateLayer.Execute; if pos('.bmp', OpenPictureDialog.FileName) <> 0 then begin // Tolik 09/08/2019 - - //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); BmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if BmpHandle <> -1 then Bmp := TBMPObject(BmpHandle); // end else begin // Tolik 09/08/2019 -- //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); BmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if BmpHandle <> -1 then Bmp := TBMPObject(BmpHandle); // // TODO ???? { Jpeg := TJpegImage.create; Jpeg.LoadFromFile(FName); Bmp.Picture.Width := Jpeg.Width; Bmp.Picture.Height := Jpeg.Height; Bmp.Picture.Canvas.Draw(0, 0, Jpeg); Bmp.Picture.PixelFormat := pf24bit; FreeAndNil(Jpeg); } end; if bmp <> nil then // Tolik 09/08/2019 -- AutoFitBitMap(Bmp); except end; { FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbPanExpert.Down := True; FSCS_Main.tbPanNoob.Down := True; FSCS_Main.aToolPan.Execute; } RefreshCAD(GCadForm.PCad); end; OpenPictureDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenRasterDrawingExecute', E.Message); end; GLoadPCadBackGroundImage := False; // Tolik 29/01/2020 -- // Tolik 12/08/2021 GIsUserDimLine := (bmp <> nil); SetHScale; // end; procedure TFSCS_Main.aSaveRasterDrawingExecute(Sender: TObject); var FName: string; FDir: string; SavePictureDialog: TSavePictureDialog; BmpFileName: string; Bmp: TBitmap; Jpeg: TJPEGImage; PDFDoc: TPDFDocument; begin try if ActiveMDIChild <> nil then begin SavePictureDialog := TSavePictureDialog.Create(Self); SavePictureDialog.Title := cMain_Mes123; SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir; SavePictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg'; SavePictureDialog.Filter := cMain_Mes125 + '|'+ cProgressExp_Msg9_1; SavePictureDialog.Options := SavePictureDialog.Options + [ofOverwritePrompt]; if SavePictureDialog.Execute then begin try // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName)); // FName := SavePictureDialog.FileName; if ExtractFileExt(SavePictureDialog.FileName) = '.pdf' then //06.03.2012 begin PDFDoc := CreatePDFObject(Self, GetListParams(GCadForm.FCADListID).Caption, SavePictureDialog.FileName, nil); PDFDoc.BeginDoc; SetCADPageParamsToPDF(GCadForm, PDFDoc, false); PDFDoc.EndDoc; PDFDoc.Free; end else if pos('.bmp', SavePictureDialog.FileName) <> 0 then begin GCadForm.PCad.SaveAsBitmap(FName); end else begin BmpFileName := ChangeFileExt(FName, '.bmp'); GCadForm.PCad.SaveAsBitmap(BmpFileName); Bmp := TBitmap.Create; Bmp.LoadFromFile(BmpFileName); ConvertBMPToJpeg(Bmp, FName); FreeAndNil(Bmp); DeleteFile(BmpFileName); end; except ShowMessage(cMain_Mes8); end; end; SavePictureDialog.Free; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aSaveRasterDrawingExecute', E.Message); end; end; procedure TFSCS_Main.SetLayerForDraw; begin if GCadForm <> nil then begin if (GCadForm.PCad.ActiveLayer <> lnSubstrate) and (GCadForm.PCad.ActiveLayer <> lnArch) then aSetSubstrateLayer.Execute; end; end; procedure TFSCS_Main.SetMenuStatus(aStatus: Boolean); var aStatusArch: boolean; i: integer; begin {$if Defined(ES_GRAPH_SC)} aStatusArch := false; {$else} aStatusArch := aStatus; {$ifend} try //Tolik 13/08/2021 -- if aStatus then tbCalc.Visible := aExpertMode.Checked else tbCalc.Visible := aStatus; // // главное меню mainEdit.Visible := aStatus; mainObject.Visible := aStatus; mainFormat.Visible := aStatus; mainOptions.Visible := aStatus; mainTools.Visible := aStatus; //mainSCS.Visible := aStatus; mainWindow.Visible := aStatus; // пункты открытых меню // nOpen.Enabled := aStatus; aLoadSubstrate.Enabled := aStatus; aLoadFPlan.Enabled := aStatus; aLoadStamp.Enabled := aStatus; aOpenVectorDrawing.Enabled := aStatus; aOpenRasterDrawing.Enabled := aStatus; nSave.Enabled := aStatus; aCloseCurrProject.Enabled := aStatus; aClose.Enabled := aStatus; aExport.Enabled := aStatus; aExportDWG.Enabled := aStatus; aImport.Enabled := aStatus; aPrevView.Enabled := aStatus; aPrint.Enabled := aStatus; aPrintRect.Enabled := aStatus; aAllScreen.Enabled := aStatus; a50.Enabled := aStatus; a75.Enabled := aStatus; a100.Enabled := aStatus; a150.Enabled := aStatus; a200.Enabled := aStatus; a400.Enabled := aStatus; aInc.Enabled := aStatus; aInc1pt.Enabled := aStatus; aDec1pt.Enabled := aStatus; aViewLayers.Enabled := aStatus; aViewNavigator.Enabled := aStatus; aViewSCSObjectsProp.Enabled := aStatus; aExpertMode.Enabled := aStatus; // Add aCurrProjectProperties.Enabled := aStatus; aListProperties.Enabled := aStatus; aSaveRevision.Enabled := aStatus; aViewRevs.Enabled := aStatus; aProjectSchedule.Enabled := aStatus; aBillWork.Enabled := aStatus; aShowCableRule.Enabled := aStatus; aCreateProjectPlan.Enabled := aStatus; aCreateNormsOnCad.Enabled := aStatus; aConnectionsConfigurator.Enabled := aStatus; // 2011-05-10 n3DModelForList.Enabled := aStatus; n3DModelForProject.Enabled := aStatus; aMasterAutoTrace.Enabled := aStatus; aMasterAutoTraceElectric.Enabled := aStatus; aMasterCableTracing.Enabled := aStatus; aMasterCableChannel.Enabled := aStatus; aShowRepResources.Enabled := aStatus; aBlocksEditor.Enabled := aStatus; aRepWizard.Enabled := aStatus; aMarkingPages.Enabled := aStatus; //aManual_Interfaces.Enabled := aStatus; // // Панели интрументов cbMainPanel.DisableAlign; //20.12.2011 try tbObject.Visible := aStatus; tbLayers.Visible := aStatus; tbOther.Visible := aStatus; if aStatus then begin if aExpertMode.Checked then begin tbSCSToolsExpert.Visible := True; tbCADToolsExpert.Visible := True; tbSCSToolsNoob.Visible := False; tbCADToolsNoob2.Visible := False; tbCADToolsNoob.Visible := False; end else begin {$if Defined(ES_GRAPH_SC)} tbSCSToolsExpert.Visible := True; {$else} tbSCSToolsExpert.Visible := False; {$ifend} tbCADToolsExpert.Visible := False; {$if Defined(ES_GRAPH_SC)} tbSCSToolsNoob.Visible := False; {$else} //tbSCSToolsNoob.Visible := True; {$ifend} tbCADToolsNoob.Visible := True; tbCADToolsNoob2.Visible := True; end; end else begin tbSCSToolsExpert.Visible := aStatusArch; tbCADToolsExpert.Visible := aStatusArch; //tbSCSToolsNoob.Visible := aStatusArch; // Tolik 24/01/2017 if aStatusArch then begin tbCADToolsNoob.Visible := aStatusArch; tbCADToolsNoob2.Visible := aStatusArch; end else if not aStatusArch then begin tbCADToolsNoob2.Visible := aStatusArch; tbCADToolsNoob.Visible := aStatusArch; end; // tbCADToolsNoob.Visible := aStatusArch; // tbCADToolsNoob2.Visible := aStatusArch; // end; // Кнопки на панели инструментов "Файл" tbNewList.Visible := aStatus; tbLoadSubstrate.Visible := aStatus; tbSaveProject.Visible := aStatus; tbPrevView.Visible := aStatus; tbPrint.Visible := aStatus; tbPrintRect.Visible := aStatus; ToolButton35.Visible := aStatus; {$if Not Defined(ES_GRAPH_SC)} tbArch.Visible := False; {$ifend} {$if Defined(ES_GRAPH_SC)} // tbCreateOnClickModeExpert.Visible := False tbArch.Visible := aStatus; tbProjectPlan.Visible := False; FSCS_Main.aBillWork.Visible := False; FSCS_Main.aSaveRevision.Visible := False; FSCS_Main.aViewRevs.Visible := False; FSCS_Main.aProjectSchedule.Visible := False; FSCS_Main.aShowCableRule.Visible := False; FSCS_Main.N70.Visible := False; FSCS_Main.aConnectionsConfigurator.Visible := False; FSCS_Main.aMasterCableTracing.Visible := False; FSCS_Main.aMasterCableChannel.Visible := False; FSCS_Main.aToolCabinet.Visible := False; //12.04.2012 FSCS_Main.aToolWallRect.Visible := False; //12.04.2012 FSCS_Main.aToolWallPath.Visible := False; FSCS_Main.aToolHouse.Visible := False; FSCS_Main.aToolOrthoLine.Visible := False; FSCS_Main.aToolOrthoLineExt.Visible := False; //tbOther.Visible := False; //tbCalc.Visible := False; tbExtProtocol.Visible := False; mainHelp.Enabled := False; aViewSCSObjectsProp.Visible := False; tbChm.Visible := False; aToolCabinetExt.Visible := False; aCreateProjectPlan.Visible := False; aCreateNormsOnCad.Visible := False; aConnectionsConfigurator.Visible := False; // 2011-05-10 n3DModelForList.Enabled := True; n3DModelForProject.Enabled := True; aMasterAutoTraceElectric.Visible := False; aMasterAutoTrace.Visible := False; aMasterCableChannel.Visible := False; aMasterCableTracing.Visible := False; aShowRepResources.Visible := False; aBlocksEditor.Visible := False; aRepWizard.Visible := False; aMarkingPages.Visible := False; {$IF Defined (FINAL_SCS)} nManuals.Visible := False; {$IFEND} aUpdateNormBase.Visible := False; aMasterUpdateComponPriceFromXF.Visible := False; aChoiceBaseOptions.Visible := False; aToolCabinet.Visible := False; aToolCabinetExt.Visible := False; {$IF Defined (FINAL_SCS)} aToolWallRect.Visible := False; aToolWallPath.Visible := False; {$IFEND} aToolHouse.Visible := False; tbCabinetExpert.Visible := False; tbCabinetExtExpert.Visible := False; tbCabinetNoob.Visible := False; tbCabinetExtNoob.Visible := False; aToolHouse.Visible := False; tbHouseExpert.Visible := False; tbHouseNoob.Visible := False; aCreateObjectOnClickTool.Visible := False; aCreateObjectOnClickTool.Visible := True; tbCreateOnClickModeExpert.Visible := False; tbCreateOnClickModeExpert.Visible := True; tbCreateOnClickModeNoob.Visible := False; tbCreateOnClickModeNoob.Visible := True; {$ifend} finally cbMainPanel.EnableAlign; tbFile.AutoSize := false; tbFile.AutoSize := true; end; {$if Defined(ES_GRAPH_SC)} // Tolik -- 01/02/2017 -- //tbFile.Width := 400; tbFile.Width := 450; // tbObject.Left := tbFile.Left + tbFile.Width + 10; tbLayers.Left := tbObject.Left + tbObject.Width + 10; tbOther.Left := tbLayers.Left + tbLayers.Width + 10; tbOther.Width := 30; tbArch.Left := tbOther.Left + tbOther.Width + 10; //Tolik -- 01/02/2017 -- tbArch.Width := 150; // tbCADToolsExpert.Width := 780; //Tolik -- 01/02/2017 -- //tbCADToolsNoob.Width := 700; tbCADToolsNoob.Width := 600; //tbCADToolsNoob2.Width := 700; tbCADToolsNoob2.Width := 300; // {$ifend} tbInteractive.Visible := FInteractiveStep > 0; if tbInteractive.Visible then tbCADToolsExpert.Left := 91 else tbCADToolsExpert.Left := 11; DisableActForReadOnlyMode; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.SetMenuStatus', E.Message); end; end; // Tolik -- 17/03/2017 -- переписана совсем, старая закомменчена - смотри ниже procedure TFSCS_Main.aCreateVerticalExecute(Sender: TObject); var VertOnFigure: TConnectorObject; VertHeight: Double; VLineToSnap: TOrthoLine; ConnToSnap: TConnectorObject; DirectionUp, DirectionDown: Boolean; Nb_Conn: TConnectorObject; procedure CreateConnToSnap; var ObjParams: TObjectParams; begin ConnToSnap := TConnectorObject.Create(VertOnFigure.ActualPoints[1].x, VertOnFigure.ActualPoints[1].y, VertHeight, VertOnFigure.LayerHandle, mydsNormal, GCadForm.PCad); ConnToSnap.ConnectorType := ct_Clear; GCadForm.PCad.AddCustomFigure (GLN(VertOnFigure.LayerHandle), ConnToSnap, False); ConnToSnap.Name := cCadClasses_Mes12; SetNewObjectNameInPM(ConnToSnap.ID, ConnToSnap.Name); ObjParams := GetFigureParams(ConnToSnap.ID); ConnToSnap.Name := ObjParams.Name; ConnToSnap.FIndex := ObjParams.MarkID; end; procedure CheckCanSnapToVLine; var i, j: integer; CanCheckVLine: Boolean; currConn: TConnectorObject; VLineFound: boolean; JoinedLine: TOrthoLine; LineList: TList; function getLineConnByDirection(aLine: tOrthoLine): TConnectorObject; begin Result := TConnectorObject(aLine.JoinConnector1); if DirectionUP then begin if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1 then Result := TConnectorObject(aLine.JoinConnector2); end else if DirectionDown then begin if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = 1 then Result := TConnectorObject(aLine.JoinConnector2); end; end; function GetNextConn(aLine: TOrthoLine): TConnectorObject; begin Result := Nil; if aLine.FIsVertical then begin if DirectionUP then begin if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector1)) = -1) and (CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]) = -1) then begin Result := TConnectorObject(aLine.JoinConnector1); LineList.Add(aLine); VLineToSnap := aLine; end else if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector2)) = -1) and (CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1) then begin Result := TConnectorObject(aLine.JoinConnector2); LineList.Add(aLine); VLineToSnap := aLine; end; end else if DirectionDown then begin if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector1)) = -1) and (CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]) = -1) then begin Result := TConnectorObject(aLine.JoinConnector1); LineList.Add(aLine); VLineToSnap := aLine; end else if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector2)) = -1) and (CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1) then begin Result := TConnectorObject(aLine.JoinConnector2); LineList.Add(aLine); VLineToSnap := aLine; end; end; end; end; begin currConn := nil; LineList := TList.create; if VertOnFigure.ConnectorType = ct_Clear then begin for i := 0 to VertOnFigure.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(VertOnFigure.JoinedOrthoLinesList[i]); currConn := GetNextConn(JoinedLine); if currConn <> nil then Break; //// BREAK ////; end; end else if VertOnFigure.ConnectorType = ct_NB then begin for i := 0 to VertOnFigure.JoinedConnectorsList.Count - 1 do begin currConn := TConnectorObject(VertOnFigure.JoinedConnectorsList[i]); for j := 0 to currConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(currConn.JoinedOrtholinesList[j]); if JoinedLine.FIsVertical then begin currConn := GetNextConn(JoinedLine); if currConn <> nil then break else currConn := TConnectorObject(VertOnFigure.JoinedConnectorsList[i]); end; end; if (currConn <> nil) and (Vertonfigure.JoinedConnectorsList.IndexOf(currConn) = -1) then break; end; end; if (currConn <> nil) and (VLineToSnap <> nil) then begin CanCheckVLine := True; While CanCheckVLine do begin CanCheckVLine := False; if currConn.ConnectorType = ct_clear then begin for i := 0 to currConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(currConn.JoinedOrthoLinesList[i]); if JoinedLine.FIsVertical then begin if LineList.IndexOf(JoinedLine) = -1 then begin LineList.Add(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).Id = currConn.Id then currConn := TConnectorObject(JoinedLine.JoinConnector2) else if TConnectorObject(JoinedLine.JoinConnector2).Id <> currConn.Id then currConn := TConnectorObject(JoinedLine.JoinConnector1); if currConn <> nil then begin if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedCOnnectorsList[0]); CanCheckVLine := True; end; break; end; end; end; end else if currConn.ConnectorType = ct_NB then begin NB_Conn := currConn; for i := 0 to NB_Conn.JoinedConnectorsList.Count - 1 do begin currConn := TConnectorObject(Nb_Conn.JoinedConnectorsList[i]); for j := 0 to currConn.JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(currConn.JoinedOrthoLinesList[j]); if JoinedLine.FIsVertical then begin if LineList.IndexOf(JoinedLine) = -1 then begin LineList.Add(JoinedLine); if TConnectorObject(JoinedLine.JoinConnector1).Id = currConn.Id then currConn := TConnectorObject(JoinedLine.JoinConnector2) else if TConnectorObject(JoinedLine.JoinConnector2).Id <> currConn.Id then currConn := TConnectorObject(JoinedLine.JoinConnector1); if currConn <> nil then begin if currConn.JoinedConnectorsList.Count > 0 then currConn := TConnectorObject(currConn.JoinedCOnnectorsList[0]); CanCheckVLine := True; end; break; end; end; end; if (currConn <> nil) and (NB_Conn.JoinedConnectorsList.IndexOf(currConn) = -1 ) then break; end; end; end; if LineList.Count > 0 then begin for i := 0 to LineList.Count - 1 do begin VLineToSnap := TOrthoLine(LineList[i]); connToSnap := getLineConnByDirection(VLineToSnap); if DirectionUP then begin VLineToSnap := Nil; if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = 1 then begin VLineToSnap := TOrthoLine(LineList[i]); CreateConnToSnap; break; end; end else if DirectionDown then begin VLineToSnap := Nil; if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = -1 then begin VLineToSnap := TOrthoLine(LineList[i]); CreateConnToSnap; break; end; end; if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = 0 then break; end; end; LineList.free; end; end; procedure CreateVLineOnConnector; var vLine: TOrthoLine; // Tolik 27/03/2018 -- begin if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = 1 then DirectionUP := True else if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = -1 then DirectionDown := True else if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = 0 then Exit; VLineToSnap := nil; ConnToSnap := Nil; CheckCanSnapToVLine; if VLineToSnap <> nil then SnapConnectorToVertical(ConnToSnap, VLineToSnap) else if ConntoSnap <> nil then begin if CompareValue(ConnToSnap.ActualZOrder[1], VertHeight) <> 0 then //CreateVerticalOnConnector(ConnToSnap, VertHeight) vLine := CreateVerticalOnConnector(ConnToSnap, VertHeight) end else begin if VertOnFigure.ConnectorType = ct_Clear then //CreateVerticalOnConnector(VertOnFigure, VertHeight) VLine := CreateVerticalOnConnector(VertOnFigure, VertHeight) else //CreateVerticalOnPointObject(VertOnFigure, VertHeight); vLine := CreateVerticalOnPointObject(VertOnFigure, VertHeight); end; end; begin try if GPopupFigure = nil then exit; try VertOnFigure := TConnectorObject(GPopupFigure); except VertOnFigure := nil; end; if VertOnFigure = nil then exit; DirectionUp := False; DirectionDown := False; F_RaiseHeight.cbApplyToAll.Visible := False; //Tolik 04/08/2021 -- F_RaiseHeight.Caption := cMain_Mes126; F_RaiseHeight.lbMessage.Caption := cMain_Mes126; // на соединителе if F_RaiseHeight.Showmodal = mrOK then begin VertHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); VertHeight := UOMToMetre(VertHeight); if VertHeight > GCadForm.FRoomHeight then VertHeight := GCadForm.FRoomHeight; if CompareValue(VertOnFigure.ActualZOrder[1], VertHeight) <> 0 then // так надежнее //if VertHeight <> VertOnFigure.ActualZOrder[1] then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; CreateVLineOnConnector; { if VertOnFigure.ConnectorType = ct_Clear then CreateVerticalOnConnector(VertOnFigure, VertHeight) else CreateVerticalOnPointObject(VertOnFigure, VertHeight); } // *UNDO* GCadForm.FCanSaveForUndo := True; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else GCadForm.mProtocol.Lines.Add(cMain_Mes128); end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateVerticalExecute', E.Message); end; end; (* procedure TFSCS_Main.aCreateVerticalExecute(Sender: TObject); var VertOnFigure: TConnectorObject; VertHeight: Double; begin try if GPopupFigure = nil then exit; try VertOnFigure := TConnectorObject(GPopupFigure); except VertOnFigure := nil; end; F_RaiseHeight.Caption := cMain_Mes126; F_RaiseHeight.lbMessage.Caption := cMain_Mes126; // на соединителе if F_RaiseHeight.Showmodal = mrOK then begin VertHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); VertHeight := UOMToMetre(VertHeight); if VertHeight > GCadForm.FRoomHeight then VertHeight := GCadForm.FRoomHeight; if VertHeight <> VertOnFigure.ActualZOrder[1] then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; if VertOnFigure.ConnectorType = ct_Clear then CreateVerticalOnConnector(VertOnFigure, VertHeight) else CreateVerticalOnPointObject(VertOnFigure, VertHeight); // *UNDO* GCadForm.FCanSaveForUndo := True; SetProjectChanged(True); end else GCadForm.mProtocol.Lines.Add(cMain_Mes128); end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateVerticalExecute', E.Message); end; end; *) procedure TFSCS_Main.TimerFindSnapTimer(Sender: TObject); begin try except on E: Exception do AddExceptionToLogEx('TFSCS_Main.TimerFindSnapTimer', E.Message); end; end; procedure TFSCS_Main.AddDoorObj(aDoorObjType: TDoorObjType); begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; TNet(GCadForm.PCad.Selection[0]).AddDoor(aDoorObjType); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.AddDoorObj', E.Message); end; end; procedure TFSCS_Main.AddDoorEmbrasure; begin AddDoorObj(dotEmbrasure); end; procedure TFSCS_Main.AddDoorNiche; begin AddDoorObj(dotNiche); end; procedure TFSCS_Main.ToolButton1Click(Sender: TObject); begin if Assigned(GSCStream) then begin if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then begin try ExpProjToStroyCalcStream(F_ProjMan.GSCSBase.CurrProject, GSCStream); except GSCStream.Clear; end; end; end; if SaveCurrentProject then begin CloseCurrProject(false, false); FSCS_Main.OnClose := nil; FSCS_Main.OnCloseQuery := nil; ModalResult := mrOk; FSCS_Main.Hide; end; end; procedure TFSCS_Main.ToolButton4Click(Sender: TObject); begin ShowInvoice; end; procedure TFSCS_Main.aNetPathToArcExecute(Sender: TObject); begin NetPathToArc; end; procedure TFSCS_Main.aInvertNetPathArcExecute(Sender: TObject); begin NetArcInvert; end; {TODO} (* procedure TFSCS_Main.bDelModelClick(Sender: TObject); begin Remove3DModelStream; end; *) // 2011-05-10 {procedure TFSCS_Main.Button1Click(Sender: TObject); var tmpdir: string; FName: string; begin tmpdir := ExtractDirByCategoryType(dctPictures); FName := tmpdir + '\' + 'ModelAddParams.temp'; frm3D.SaveModelAddParamsToStream(FName); end;} {procedure TFSCS_Main.Button2Click(Sender: TObject); var tmpdir: string; FName: string; begin tmpdir := ExtractDirByCategoryType(dctPictures); FName := tmpdir + '\' + 'ModelAddParams.temp'; frm3D.LoadModelAddParamsFromStream(FName); end;} procedure TFSCS_Main.n3DModelForProjectClick(Sender: TObject); var i, j: integer; Cad: TF_CAD; CtrlDown: boolean; xModelNode: TTreeNode; SavedGCadForm, TmpCad: TF_Cad; ProjectParams: TProjectParams; ListParams: TListParams; HLists, LLists: TList; PrevIndex, NextIndex: Integer; SubstrateFileName: String; currGLPlane: TGLPlane; SubstrateFileList: TStringList; // Tolik 17/07/2025 -- VList: TList; //tmpCad: TF_Cad; Dir3dUndoName: string; UndoAct: TListUndoAction; cadheight: Double; { procedure InsertIntoHList(Cad: TF_CAD); var i, j: integer; Inserted: Boolean; xCad: TF_CAD; begin Inserted := False; for i := 0 to HLists.Count - 1 do begin xCad := TF_CAD(HLists[i]); if Cad.FCADListIndex < xCad.FCADListIndex then begin HLists.Insert(i, Cad); Inserted := True; break; end; end; if not Inserted then HLists.Add(Cad); end; procedure InsertIntoLList(Cad: TF_CAD); var i, j: integer; Inserted: Boolean; xCad: TF_CAD; begin Inserted := False; for i := 0 to LLists.Count - 1 do begin xCad := TF_CAD(LLists[i]); if Cad.FCADListIndex > xCad.FCADListIndex then begin LLists.Insert(i, Cad); Inserted := True; break; end; end; if not Inserted then LLists.Add(Cad); end; } // Tolik 02/05/2018 -- procedure GetSortModelLists; var i: integer; CadLevelAchieved: Boolean; currCatalog: TSCSCatalog; currList: TSCSList; SortIndex: Integer; currCad: TF_CAD; ReverseListSortOrder: Boolean; procedure InsertIntoHList(Cad: TF_CAD); var i, j: integer; Inserted: Boolean; xCad: TF_CAD; xCadCatalog: TSCSCatalog; begin Inserted := False; for i := 0 to HLists.Count - 1 do begin xCad := TF_CAD(HLists[i]); xCadCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(xCad.FCadListID); if xCadCatalog <> nil then begin if ReverseListSortOrder then begin if xCadCatalog.SortID > currList.SortID then begin HLists.Insert(i, Cad); Inserted := True; break; end; end else begin if xCadCatalog.SortID > currList.SortID then begin HLists.Insert(i, Cad); Inserted := True; break; end; end; end; end; if not Inserted then HLists.Add(Cad); end; procedure InsertIntoLList(Cad: TF_CAD); var i, j: integer; Inserted: Boolean; xCad: TF_CAD; xCadCatalog: TSCSCatalog; begin Inserted := False; for i := 0 to LLists.Count - 1 do begin xCad := TF_CAD(LLists[i]); xCadCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(xCad.FCadListID); if xCadCatalog <> nil then begin if ReverseListSortOrder then begin if xCadCatalog.SortID < currList.SortID then begin LLists.Insert(i, Cad); Inserted := True; break; end; end else begin if xCadCatalog.SortID < currList.SortID then begin LLists.Insert(i, Cad); Inserted := True; break; end; end; end; end; if not Inserted then LLists.Add(Cad); end; begin CadLevelAchieved := False; HLists := TList.Create; LLists := TList.Create; HLists.Add(GCadForm); // типа первый этаж (тот на котором стоим в ПМ) ReverseListSortOrder := F_ProjMan.GSCSBase.CurrProject.Setting.ListsInReverseOrder; currCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(SavedGCadForm.FCADListID); if currCatalog <> nil then begin for i := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 downto 0 do begin currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]; if currList <> nil then begin CurrCad := GetListByID(currList.SCSID); if currCad <> nil then if CurrCad.FListType = lt_Normal then begin if ReverseListSortOrder then begin if CurrList.SortID > currCatalog.SortID then InsertIntoHList(CurrCad) else if CurrList.SortID < currCatalog.SortID then InsertIntoLList(CurrCad); end else begin if CurrList.SortID > currCatalog.SortID then InsertIntoHList(CurrCad) else if CurrList.SortID < currCatalog.SortID then InsertIntoLList(CurrCad); end; end; end; end; end end; { procedure GetSortModelLists; var i: integer; begin HLists := TList.Create; LLists := TList.Create; for i := 0 to FSCS_Main.MDIChildCount - 1 do begin Cad := TF_CAD(FSCS_Main.MDIChildren[i]); if Cad.FListType = lt_Normal then begin if Cad.FCADListIndex > 0 then InsertIntoHList(Cad); if Cad.FCADListIndex <= 0 then InsertIntoLList(Cad); end; end; end; } // Tolik 04/05/2018 -- Function CadListCount: Integer; // посчитать количество листов для 3Д модели var i: Integer; currList: TSCSList; CurrCad: TF_Cad; begin Result := 0; for i := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 downto 0 do begin currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]; if currList <> nil then begin CurrCad := GetListByID(currList.SCSID); if currCad <> nil then if CurrCad.FListType = lt_Normal then Inc(Result); end; end; end; begin // Tolik 04/05/2018 -- если листов проекта больше одного -- выдать сообщение, что текущий лист будет расположен на нулевом уровне // -- и, если пользователь нажмет отмену -- нах отсюда, модель не строим if CadListCount > 1 then if MessageBox(FSCS_Main.Handle, {PAnsiChar}PChar(cMain_Mes144), PChar(cCommon_Mes29), MB_OKCANCEL) <> IDOK then exit; // // Tolik -- 09/02/2017 -- HLists := nil; LLists := Nil; SubstrateFileList := TStringList.Create; // список подложек (чтобы потом удалить созданные jpeg, дабы не засорять диск) // //Tolik 11/07/2025 -- UNDO for 3D {for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin TmpCad := GetListbyID(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].SCSID); if TmpCad <> nil then begin if TmpCad <> nil then begin if TmpCad.FListType = lt_Normal then begin end; end; end; end; } //SaveCurrProjectToUndoFiles(true); //Tolik 17/07/2025 -- Save Project Undo G3dUndoList := TList.create; G3dUndoActList := TList.Create; {VList := TList.create; for i := 0 to F_ProjMan.GSCSBase.CurrProject.ChildCatalogs.Count - 1 do begin if F_ProjMan.GSCSBase.CurrProject.ChildCatalogs[i] is TSCSList then begin TmpCad := GetListByID(F_ProjMan.GSCSBase.CurrProject.ChildCatalogs[i].SCSID); if TmpCad <> nil then VList.Add(TmpCad); end; end; Dir3dUndoName := GetPathToSCSUndoDir +'\3D'; if DirectoryExists(Dir3dUndoName) then FullRemoveDir(Dir3dUndoName, true, true); if Not DirectoryExists(Dir3dUndoName) then begin CreateDir(Dir3dUndoName); if DirectoryExists(Dir3dUndoName) then SaveForProjectUndo(vList, true, false, true); end; // } {$ifdef 3D} ctrlDown:=(IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL)); if ActiveMDIChild <> nil then begin {$IF Not Defined(ES_GRAPH_SC)} SaveSubstrateArchPlan(GetPathToSCSTmpDir + '\3d.jpg'); {$IFEND} GCurrentRoom3DView := nil; if not isMapScaleDifferent then begin G3DModelForProject := True; //Tolik 29/08/2025 -- SaveUndoProjBefore3D; GIs3D := True; GisChangeFrom3D := False; // BeginProgress; if not Assigned(frm3D) then Application.CreateForm(Tfrm3D, frm3d); // 22.07.2011 if Assigned(frm3D.F3DModel) then FreeAndNil(frm3D.F3DModel); frm3D.F3DModel := T3DModel.Create; // Tolik 26/04/2018 -- frm3D.isProjectModel := True; // frm3D.FIdsStream.Clear; frm3D.FFilesStream.Clear; frm3D.ModelTree.Items.Clear; frm3D.ScsModelTree.Items.Clear; xModelNode := frm3D.ModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName); xModelNode.Data := frm3D.F3DModel; xModelNode.HasChildren := True; xModelNode := frm3D.ScsModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName); xModelNode.Data := frm3D.F3DModel; xModelNode.HasChildren := True; SavedGCadForm := GCadForm; F3DSavedCad := GCadForm;// Tolik 05/05/2018 -- F3DPlaneNotLoaded := False; // Tolik 04/05/2018 -- GetSortModelLists; // Tolik 26/04/2018 -- ListOfCadsFor3DModel := TList.Create; //Tolik 24/7/2025 -- cadHeight := 0; frm3d.FCadList.Add(SavedGCadForm); SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); frm3d.FFloorsHeightArray[0] := 0; if HLists.Count > 0 then begin for i := 1 to HLists.Count -1 do begin frm3d.FCadList.Add(HLists[i]); SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); CadHeight := CadHeight + MetreToUOM(TF_CAD(HLists[i -1]).FListSettings.HeightRoom) + 0.01; frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := CadHeight; end; end; if LLists.Count > 0 then begin cadHeight := 0; for i := 0 to LLists.Count - 1 do begin frm3d.FCadList.Add(LLists[i]); SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); CadHeight := CadHeight - MetreToUOM(TF_CAD(LLists[i]).FListSettings.HeightRoom) - 0.01; frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := CadHeight; end; end; //SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); //frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := frm3D.FZOrder + MetreToUOM(ListParams.Settings.HeightRoom + 0.01); // if HLists.Count > 0 then begin HListOfCadsFor3DModel := TList.Create; HListOfCadsFor3DModel.Assign(HLists, laCopy); ListOfCadsFor3DModel.Assign(HLists, laCopy); end; if LLists.Count > 0 then begin LListOfCadsFor3DModel := TList.Create; LListOfCadsFor3DModel.Assign(LLists, laCopy); for i := 0 to LListOfCadsFor3DModel.Count - 1 do begin Cad := TF_CAD(LListOfCadsFor3DModel[i]); ListOfCadsFor3DModel.Insert(0, Cad); end; end; { frm3d.FCadList.Add(SavedGCadForm); SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := 0;} // // Этажи выше уровня земли frm3D.FZOrder := 0; for i := 0 to HLists.Count - 1 do begin SubstrateFileName := ''; GCadForm := TF_CAD(HLists[i]); if i < HLists.Count - 1 then NextIndex := TF_CAD(HLists[i+1]).FCADListIndex else NextIndex := -32001; {$IF Defined(ES_GRAPH_SC)} if ctrlDown then if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then begin try DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D); except end; end; {$IFEND} // Tolik 04/05/2018 -- if GCadForm.FCadListID <> SavedGCadForm.FCadListID then begin begin SubstrateFileName := GetPathToSCSTmpDir + '\GLPlane' + inttostr(GCadForm.FCadListID + 100) + 'd.jpg'; if FileExists(SubstrateFileName) then DeleteFile(SubstrateFileName); SaveSubstrateArchPlan(SubstrateFileName); end; if FileExists(SubstrateFileName) then begin NotBase3DPlane := TGLPlane.Create(frm3D); //NotBase3DPlane.Parent := frm3D.DummyCube1; NotBase3DPlane.Direction.x := 0; NotBase3DPlane.Direction.y := 1; NotBase3DPlane.Direction.z := 0; NotBase3DPlane.Style := []; //NotBase3DPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName); NotBase3DPlane.Name := 'GLPlane' + inttostr(GCadForm.FCadListID + 100); end; end; // if SubstrateFileName <> '' then SubstrateFileList.Add(SubstrateFileName); GCadForm.View3D; NotBase3DPlane := nil; if GCadForm.FCADListIndex <> NextIndex then begin if NextIndex <> -32001 then // Tolik 20/09/2021 - - begin ListParams := GetListParams(GCadForm.FCADListID); frm3D.FZOrder := frm3D.FZOrder + MetreToUOM(ListParams.Settings.HeightRoom + 0.01); //Tolik 24/7/2025 -- //frm3d.FCadList.Add(GCadForm); //SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); //frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := frm3D.FZOrder + MetreToUOM(ListParams.Settings.HeightRoom + 0.01); // end; end else begin //frm3D.FZOrder := frm3D.FZOrder + 0.5; end; end; // Этажи ниже уровня земли frm3D.FZOrder := 0; PrevIndex := -32001; for i := 0 to LLists.Count - 1 do begin GCadForm := TF_CAD(LLists[i]); if GCadForm.FCADListIndex <> PrevIndex then begin ListParams := GetListParams(GCadForm.FCADListID); //Tolik 29/09/2021 -- //frm3D.FZOrder := frm3D.FZOrder - ListParams.Settings.HeightRoom - 0.01; frm3D.FZOrder := frm3D.FZOrder - MetreToUOM(ListParams.Settings.HeightRoom - 0.01); //Tolik 24/07/2025-- //frm3d.FCadList.Add(GCadForm); //SetLength(frm3d.FFloorsHeightArray, Length(frm3d.FFloorsHeightArray) + 1); //frm3d.FFloorsHeightArray[Length(frm3d.FFloorsHeightArray) - 1] := frm3D.FZOrder - MetreToUOM(ListParams.Settings.HeightRoom + 0.01); end else begin //frm3D.FZOrder := frm3D.FZOrder - 0.5; end; // 22.07.2011 PrevIndex := GCadForm.FCADListIndex; {$IF Defined(ES_GRAPH_SC)} if ctrlDown then if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then begin try DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D); except end; end; {$IFEND} // Tolik 04/05/2018 -- if GCadForm.FCadListID <> SavedGCadForm.FCadListID then begin begin SubstrateFileName := GetPathToSCSTmpDir + '\GLPlane' + inttostr(GCadForm.FCadListID + 100) + 'd.jpg'; if FileExists(SubstrateFileName) then DeleteFile(SubstrateFileName); SaveSubstrateArchPlan(SubstrateFileName); end; if FileExists(SubstrateFileName) then begin NotBase3DPlane := TGLPlane.Create(frm3D); //NotBase3DPlane.Parent := frm3D.glDummyCube1; NotBase3DPlane.Direction.x := 0; NotBase3DPlane.Direction.y := 1; NotBase3DPlane.Direction.z := 0; NotBase3DPlane.Style := []; //NotBase3DPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName); NotBase3DPlane.Name := 'GLPlane' + inttostr(GCadForm.FCadListID + 100); end; end; // GCadForm.View3D; if SubstrateFileName <> '' then SubstrateFileList.Add(SubstrateFileName); NotBase3DPlane := nil; end; // Tolik 03/05/2018 -- { if ListOfCadsFor3DModel.Count > 0 then begin F3DFloors := TList.Create; for i := 0 to ListOfCadsFor3DModel.Count - 1 do begin GCadForm := TF_CAD(ListOfCadsFor3DModel[i]); if GCadForm.FCadListID <> SavedGCadForm.FCadListID then begin SubstrateFileName := GetPathToSCSTmpDir + '\' + inttostr(GCadForm.FCadListID) + 'd.jpg'; if FileExists(SubstrateFileName) then DeleteFile(SubstrateFileName); SaveSubstrateArchPlan(SubstrateFileName); end; if FileExists(SubstrateFileName) then begin currGLPlane := TGLPlane.Create(frm3D); currGLPlane.Parent := frm3D.DummyCube; currGLPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName); currGLPlane.Name := 'GLPlane' + inttostr(i+2); F3DFloors.Add(currGLPlane); end; end; end; } // GCadForm := SavedGCadForm; EndProgress; frm3d.FCAD := GCadForm; frm3d.ShowModal; FreeAndNil(frm3D); //Tolik 11/07/2025 -- восстановить проект, если были изменения через 3Д... //if GisChangeFrom3D then //begin // UndoListInPM(-1, GetPathToSCSUndoUniqDir(true), true, 0, 0); // GCadForm.PCad.Refresh; ///end; // end else begin // Tolik 10/05/2018 -*- ShowMessage(cForm3D_Mes13); // так проще и быстрее (* {$IF Defined(SCS_PE)} ShowMessage('Scales of pages (floors) are different. ' + #13#10 + 'To view the entire project 3D model scales of pages should be equal.' + #13#10 + 'But anyway you can open a single page in 3D mode.'); {$ELSEIF Defined(SCS_UKR)} //Tolik 10/05/2018 -- для украинской версии тоже надо!!! ShowMessage('Маштаби на аркушах відрізняються! Потрібно встановити однаковий маштаб.' + #13#10 + 'Але, в любому випадку, ви можете відкрити 3Д модель одного аркуша (поверху).'); {$ELSE} ShowMessage('Масштабы на листах различаются! Нужно установить одинаковый масштаб.' + #13#10 + 'Но, в любом случае, вы можете открыть 3Д модель одного листа (этажа).'); {$IFEND} *) end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); SetDefaultActiveLayer; {$endif 3D} // Tolik -- 09/02/2017 -- if HLists <> nil then FreeAndNil(HLists); if LLists <> Nil then FreeAndNil(LLists); if LListOfCadsFor3DModel <> nil then FreeAndNil(LListOfCadsFor3DModel); // Tolik 24/06/2018 -- if HListOfCadsFor3DModel <> nil then FreeAndNil(HListOfCadsFor3DModel); // Tolik 24/06/2018 -- if ListOfCadsFor3DModel <> nil then FreeAndNil(ListOfCadsFor3DModel); // Tolik 24/06/2018 -- F3DPlaneNotLoaded := True; // Tolik 04/05/2018 -- F3DSavedCad := Nil; // 04/05/2018 -- if NotBase3DPlane <> nil then // Tolik -- 10/05/2018 -- на всякий... NotBase3DPlane := Nil; // Tolik -- 10/05/2018 -- почистить мусор (удалить созданные картинки подложек в темпах)// for i := 0 to SubstrateFileList.Count - 1 do begin SubstrateFileName := SubstrateFileList.Strings[i]; if FileExists(SubstrateFileName) then begin try DeleteFile(SubstrateFileName); except end; end; end; SubstrateFileList.Free; (* if G3dUndoActList.Count > 0 then begin j := G3dUndoActList.Count; while G3dUndoList.Count > 0 do begin if j = 0 then break; GCadForm.SCSUndoNormalList(true); dec(j); end; { for j := G3dUndoActList.Count - 1 downto 0 do begin cad := TF_CAD(G3dUndoList[j]); cad.SCSUndoNormalList(true); end; } end; *) FreeAndNil(G3dUndoList); // Tolik 18/07/2025 -- FreeAndNil(G3dUndoActList); // Tolik 18/07/2025 -- // end; // При проверке на соответствие масштабов иногда возникают казусы в плане соответствия "на глаз" и // несоответствия масштабов из-за округления величин... что вызывает неоднократные сетования пользователей // ПОэтому введен небольшой люфт... Старая закомменчена -- см ниже function TFSCS_Main.isMapScaleDifferent: Boolean; var i: integer; mapscale, currMapScale, MapDelta: double; begin try mapscale := -100; Result := False; for i := 0 to MDIChildCount - 1 do begin if TF_CAD(MDIChildren[i]).FListType = lt_Normal then begin if mapscale = -100 then mapscale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale) else begin currMapScale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale); MapDelta := Abs(currMapScale - mapscale); if CompareValue(MapDelta, 0.05) = 1 then // собственно, вот здесь и проверка и люфтик... begin Result := True; break; end; //if not EQD(Round2(TF_CAD(MDIChildren[i]).PCad.MapScale), mapscale) then //Result := True; end; end; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.isMapScaleDifferent', E.Message); end; end; { function TFSCS_Main.isMapScaleDifferent: Boolean; var i: integer; mapscale: double; begin try mapscale := -100; Result := False; for i := 0 to MDIChildCount - 1 do begin if TF_CAD(MDIChildren[i]).FListType = lt_Normal then begin if mapscale = -100 then mapscale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale) else begin if not EQD(Round2(TF_CAD(MDIChildren[i]).PCad.MapScale), mapscale) then Result := True; end; end; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.isMapScaleDifferent', E.Message); end; end; } procedure TFSCS_Main.aAutoCreateTracesExecute(Sender: TObject); begin AutoCreateTracesMaster(GPopupFigure); //29.06.2013 AutoCreateTraces; GCadForm.PCad.Refresh; // Tolik 28/10/2019 -- end; procedure TFSCS_Main.aDivTracesOnRoowWallsExecute(Sender: TObject); begin DivideTracesOnRoowWalls(GCadForm); end; procedure TFSCS_Main.aPathLengthTypePointsExecute(Sender: TObject); begin SetShowPathLengthType(sltPoints); end; procedure TFSCS_Main.aPathLengthTypeInnerExecute(Sender: TObject); begin SetShowPathLengthType(sltInner); end; procedure TFSCS_Main.aPathLengthTypeOuterExecute(Sender: TObject); begin SetShowPathLengthType(sltOuter); end; procedure TFSCS_Main.aPathTraceLengthTypePointsExecute(Sender: TObject); begin SetShowPathTraceLengthType(sltPoints); end; procedure TFSCS_Main.aPathTraceLengthTypeInnerExecute(Sender: TObject); begin SetShowPathTraceLengthType(sltInner); end; procedure TFSCS_Main.aPathTraceLengthTypeOuterExecute(Sender: TObject); begin SetShowPathTraceLengthType(sltOuter); end; procedure TFSCS_Main.aMirrorFigureExecute(Sender: TObject); var fig: TFigure; i: Integer; begin try if GCadForm.PCad.Selection.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to GCadForm.PCad.Selection.Count - 1 do MirrorFigure(TFigure(GCadForm.PCad.Selection[i])); RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'aMirrorFigureExecute', E.Message); end; end; procedure TFSCS_Main.aTransparentFigureExecute(Sender: TObject); var i: Integer; Figure: TFigure; begin try if GCadForm.PCad.Selection.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Selection[i]); if Figure is TBMPObject then TBMPObject(Figure).Transparent := aTransparentFigure.Checked; end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'aTransparentFigureExecute', E.Message); end; end; procedure TFSCS_Main.aNetPropsExecute(Sender: TObject); begin NetProps; end; procedure TFSCS_Main.DefinePMItemsRoofHipTypes; var InsIdx: Integer; MenuItem: TMenuItem; Types: TStringList; i: Integer; begin if FPMItemsRoofHipTypes = nil then begin FPMItemsRoofHipTypes := TList.Create; Types := TStringList.Create; FillPropValuesByDataType(Types, dtRoofHipType); Types.Add('-'); InsIdx := pmArchDesign.Items.IndexOf(pmiArchDesignSplit2); if InsIdx = -1 then InsIdx := pmArchDesign.Items.Count - 1 else InsIdx := InsIdx + 1; for i := 0 to Types.Count - 1 do begin //if Types[i] <> '' then begin MenuItem := TMenuItem.Create(pmArchDesign); MenuItem.Caption := Types[i]; MenuItem.OnClick := OnPMItemsRoofHipTypeClick; MenuItem.Tag := GetIDFromStrings(Types, i); if (MenuItem.Tag = rhtNone) and (MenuItem.Caption = '') then MenuItem.Caption := cArchCommon_Msg06; //if MenuItem.Tag <> 0 then //begin // MenuItem.AutoCheck := true; // MenuItem.GroupIndex := 2; // MenuItem.RadioItem := true; //end; pmArchDesign.Items.Insert(InsIdx, MenuItem); FPMItemsRoofHipTypes.Add(MenuItem); InsIdx := InsIdx + 1; end; end; Types.Free; end; end; procedure TFSCS_Main.C1Click(Sender: TObject); var i: integer; LineList, PointList, ShieldList, AutoSwitchList, JoinedSwitchCompons, CableList: TSCSComponents; ShieldCompon, AVR_Compon, SwitchCompon: TSCSComponent; ShieldLines, Switch_List: TList; PassedComponList, EndCompons: TSCSComponents; CableComponent: TSCSComponent; Procedure GetSwitchList(var aList: TSCSComponents; aLookList: TSCSComponents); var i: Integer; ChildCompon: TSCSComponent; begin for i := 0 to aLookList.Count - 1 do begin ChildCompon := aLookList[i]; if ChildCompon.ComponentType.SysName = ctsnAutoSwitch then if aList.IndexOf(childCompon) = -1 then aList.Add(ChildCompon); end; end; Procedure CollectConnections(aCompon: TSCSComponent; var aList: TSCSComponents; aCypher: string); var i, j, k: integer; ParentCompon, ChildCompon, JoinedCompon: TSCSComponent; begin if aList.IndexOf(aCompon) = -1 then aList.Add(aCompon); if PassedComponList.IndexOf(aCompon) = -1 then begin PassedComponList.Add(aCompon); for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if aCompon.JoinedComponents[i].IsLine = biTrue then // Подключен кабель begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].Cypher = aCypher then begin if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then CollectConnections(aCompon.JoinedComponents[i], aList, aCypher); end; end else begin // Point Connection if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then begin PassedComponList.Add(aCompon.JoinedComponents[i]); if aList.IndexOf(aCompon.JoinedComponents[i]) = -1 then // тут дополнительну проверку воткнуть, начиная с парента донизу на вхождение begin ParentCompon := aCompon.JoinedComponents[i].GetTopComponent; if ParentCompon <> nil then begin if aList.IndexOf(ParentCompon) = -1 then aList.Add(ParentCompon); if ParentCompon.ComponentType.SysName <> ctsnTerminalBox then if EndCompons.IndexOf(ParentCompon) = -1 then EndCompons.Add(ParentCompon); for j := 0 to ParentCompon.JoinedComponents.Count - 1 do begin JoinedCompon := ParentCompon.JoinedComponents[j]; if PassedComponList.IndexOf(JoinedCompon) = -1 then if JoinedCompon.IsLine = biTrue then if isCableComponent(JoinedCompon) then if JoinedCompon.Cypher = aCypher then CollectConnections(JoinedCompon, aList, aCypher); end; for j := 0 to ParentCompon.ChildReferences.Count - 1 do begin ChildCompon := ParentCompon.ChildReferences[j]; if PassedComponList.IndexOf(ChildCompon) = -1 then PassedComponList.Add(ChildCompon); for k := 0 to ChildCompon.JoinedComponents.Count - 1 do begin JoinedCompon := ChildCompon.JoinedComponents[k]; if PassedComponList.IndexOf(JoinedCompon) = -1 then if JoinedCompon.IsLine = biTrue then if isCableComponent(JoinedCompon) then if JoinedCompon.Cypher = aCypher then CollectConnections(JoinedCompon, aList, aCypher); end; end; end; end; end; end; end; end; end; function GetConnectedToSwitch(aCompon: TSCSComponent): TSCSComponents; var i: integer; JoinedCompon: TSCSComponent; HasNoCableConnection: Boolean; HasPointConnections: Boolean; begin Result := nil; HasNoCableConnection := true; HasPointConnections := False; for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].IDNetType = 3 then HasNoCableConnection := false; end; if HasNoCableConnection then exit; Result := TSCSComponents.Create(false); if PassedComponList.IndexOf(aCompon) = -1 then PassedComponList.Add(aCompon); for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if IsCableComponent(aCompon.JoinedComponents[i]) then if aCompon.JoinedComponents[i].IDNetType = 3 then begin CollectConnections(aCompon.JoinedComponents[i], Result, aCompon.JoinedComponents[i].Cypher); if CableComponent = nil then CableComponent := aCompon.JoinedComponents[i]; end; end; end; begin LineList := nil; PointList := nil; AVR_Compon := nil; ShieldList := nil; AutoSwitchList := Nil; ShieldLines := Nil; Switch_List := Nil; CableList := TSCSComponents.Create(False); if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then begin if F_ProjMan.GSCSBase.CurrProject.CurrList.OpenedInCAD then begin PointList := TSCSComponents.Create(false); // точки LineList := TSCSComponents.Create(false); // кабель for I := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences.Count - 1 do begin if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IDNetType = 3 then begin if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IsLine = biTrue then begin if LineList.IndexOf(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]) = -1 then LineList.Add(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]); end else if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IsLine = biFalse then begin if PointList.IndexOf(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]) = -1 then PointList.Add(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]); end; end; end; end; end; if ((PointList.Count = 0) or (LineList.Count = 0)) then ShowMessage('There is no Objects to display!!!') else begin //построить список щитов ShieldList := TSCSComponents.Create(false); for i := 0 to PointList.Count - 1 do begin if PointList[i].ComponentType.SysName = ctsnShield then if ShieldList.IndexOf(PointList[i]) = -1 then ShieldList.Add(PointList[i]); end; end; if ShieldList.Count > 0 then begin ShieldCompon := ShieldList[0]; // построить список автоматов щитка if ShieldCompon.ChildReferences.Count > 0 then begin AutoSwitchList := TSCSComponents.Create(false); GetSwitchList(AutoSwitchList, ShieldCompon.ChildReferences); end; end else; // не обнаружено ни одного щитка .... ShieldLines := TList.Create; if AutoSwitchList.Count > 0 then begin // построить списки подключений на каждый автомат PassedComponList := TSCSComponents.Create(false); PassedComponList.Add(ShieldCompon); for i := AutoSwitchList.Count - 1 downto 0 do begin SwitchCompon := AutoSwitchList[i]; PassedComponList.Add(SwitchCompon); EndCompons := TSCSComponents.Create(false); CableComponent := nil; JoinedSwitchCompons := GetConnectedToSwitch(SwitchCompon); //PassedComponList.Clear; if EndCompons.Count > 0 then begin if CableComponent <> nil then begin ShieldLines.Insert(0, EndCompons); CableList.Add(CableComponent); end; end else begin AutoSwitchList.delete(i); EndCompons.Free; end; end; if Switch_List = nil then Switch_List := TList.Create; if AutoSwitchList.Count > 0 then Switch_List.Add(AutoSwitchList); end else begin // не обнаружено автоматов в щитке!!! -- може сообщение какое выдать тут..... end; if ShieldLines.Count > 0 then // BuildElectricianChemeList(AVR_Compon, ShieldList, Switch_List, ShieldLines, CableList, nil); if PassedComponList <> nil then PassedComponList.free; if LineList <> nil then LineList.Free; if PointList <> nil then PointList.Free; if ShieldList <> nil then ShieldList.Free; if AutoSwitchList <> nil then AutoSwitchList.free; freeList(ShieldLines); CableList.Free; end; function TFSCS_Main.CanResizePanelForm(AForm: TForm; ADeltaSize: Integer): Boolean; begin Result := true; if Assigned(AForm) then if AForm.Constraints.MinWidth > (AForm.Width + ADeltaSize) then Result := false; end; procedure TFSCS_Main.OnSplitterMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin {if Sender = sDiv1 then begin if Assigned(F_ProjMan) then F_ProjMan.Panel_Tree.DisableAlign; end else if Sender = sDiv2 then begin if Assigned(F_NormBase) then F_NormBase.Panel_Tree.DisableAlign; end; } end; procedure TFSCS_Main.OnSplitterMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin {if Sender = sDiv1 then begin if Assigned(F_ProjMan) then F_ProjMan.Panel_Tree.EnableAlign; end else if Sender = sDiv2 then begin if Assigned(F_NormBase) then F_NormBase.Panel_Tree.EnableAlign; end;} end; procedure TFSCS_Main.OnPMItemsRoofHipTypeClick(Sender: TObject); begin if {(TMenuItem(Sender).Tag <> 0) and} (TMenuItem(Sender).Caption <> '') and (GCadForm.PCad.Selection.Count > 0) then begin SetSelPathRoofHipType(GCadForm.PCad.Selection[0], TMenuItem(Sender).Tag); end; end; procedure TFSCS_Main.SDCreateBlockToFileCanClose(Sender: TObject; var CanClose: Boolean); var i: Integer; FileName: String; begin if TSaveDialog(Sender).Files.Count > 0 then begin // Проверяем есть ли с таким имененм bmp как blk FileName := TSaveDialog(Sender).Files[0]; FileName := ExtractFilePathOnly(FileName) +'.bmp'; if FileExists(FileName) then if MessageQuastYN(FileName+' '+cMain_Mes131) <> IDYES then CanClose := false; end; end; procedure TFSCS_Main.ShowBlockParamsForPopupFigure(aAllowPersent: Boolean=true; aAllowProportion: Boolean=true); var TempBlock: TFigure; FigHandle: Integer; //SelFigure: TFigure; //SelFigureObj: TSCSComponent; CommonNetIdx: Integer; IsSaveForUndo: Boolean; begin try TempBlock := nil; IsSaveForUndo := false; try if (GPopupFigure = nil) then begin if GCadForm.PCad.ActiveLayer = lnArch then begin GCadForm.BeginSaveForUndo(uat_None, False, False); IsSaveForUndo := true; if GCadForm.PCad.SelectedCount = 1 then TempBlock := TFigure(GCadForm.PCad.Selection.Items[0]) else if GCadForm.PCad.SelectedCount > 0 then begin //CommonNetIdx := GCadForm.PCad.Selection.IndexOf(GCadForm.FActiveNet); //if CommonNetIdx <> -1 then //begin // GCadForm.FActiveNet.Selected := false; // GCadForm.PCad.Selection.Delete(CommonNetIdx); //end; CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet); //SelFigure := TFigure(GCadForm.PCad.Selection[0]); //10.05.2012 Если TNet, то если выделены все сегменты крыши (связанные), то выводим диалог с учетом высоты крыши {if (SelFigure.ClassName = TNet.ClassName) and (TNet(SelFigure).FComponID <> 0) then begin SelFigureObj := GetArchObjByCADObj(SelFigure); if SelFigureObj <> nil then if SelFigureObj.IsLine = ctArhRoofSeg then begin if IsAllRelatedNetsInList(TNet(SelFigure), GCadForm.PCad.Selection, true) then begin end; end; end; } FigHandle := GCadForm.PCad.GroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); TempBlock := TFigure(FigHandle); if CommonNetIdx <> -1 then begin GCadForm.PCad.Selection.Add(GCadForm.FActiveNet); GCadForm.FActiveNet.Selected := true; end; end; F_BlockParams.cbProportions.Checked := false; GPopupFigure := TempBlock; end; end; if GPopupFigure <> nil then begin F_BlockParams.Execute(GPopupFigure, aAllowPersent, aAllowProportion); end; if (TempBlock <> nil) and (TempBlock is TFigureGrp) then begin GCadForm.PCad.UnGroupSelection; if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; finally if IsSaveForUndo then GCadForm.EndSaveForUndo; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowBlockParamsForPopupFigure', E.Message); end; end; procedure TFSCS_Main.RecreateHandle; begin RecreateWnd; //07.05.2013 После переключения языка, чтобы подтянулись хинты SetHints; end; procedure TFSCS_Main.SetHints; begin aInteractiveNextStep.Hint := aInteractiveNextStep.Caption; aInteractiveStop.Hint := aInteractiveStop.Caption; end; procedure TFSCS_Main.aConvertToPolygonExecute(Sender: TObject); var CADCoordKoeff: Double; Circle: TCircle; CornerCount: Integer; PolygonPoints: TDoublePointArr; PolygonFigure: TPolyline; Points: TDoublePointArr; LayerHandle: Integer; ObjType: Integer; CurrPt, CenterPt, TempPt, SrcPt1, SrcPt2: TDoublePoint; StartPt: PDoublePoint; ObjProps: TSCSComponent; i, j, ptIdx: Integer; ObjHeight: Double; BaseRadius, BaseCircleLen: Double; BaseCornerCount: Integer; ArchNet: TSCSComponent; Net: TNet; Path: TNetPath; NewPaths: TList; NewPoints: TList; pt: PDoublepoint; LinePoints: TDoublePointArr; begin // Tolik 13/01/2020 Circle := nil; try if (GCadForm.PCad.Selection.Count = 1) then begin CADCoordKoeff := 1000/GCadForm.PCad.MapScale; StartPt := nil; CurrPt := DoublePoint(GCadForm.CurrX, GCadForm.CurrY); ObjProps := nil; ObjType := ctNone; Circle := nil; if TFigure(GCadForm.PCad.Selection[0]) is TCircle then begin Circle := TCircle(GCadForm.PCad.Selection[0]); if (GCadForm.CurrentLayer = lnArch) and IsArchTopComponByIsLine(F_NormBase.GSCSBase.SCSComponent.IsLine) then begin ObjType := F_NormBase.GSCSBase.SCSComponent.IsLine; ObjProps := TSCSComponent.Create(F_ProjMan); ObjProps.AddSimpleProperty(pnCornerCount, 'Количество углов', '6', dtInteger); if ObjType = ctArhRoofSeg then begin ObjProps.AddSimpleProperty(pnHeight, 'Высота', '2', dtFloat); ObjProps.AddSimpleProperty(pnAllowEaves, 'С карнизным свесом', '1', dtBoolean); ObjProps.AddSimpleProperty(pnRoofBaseRadius, 'Радиус основания', FloatToStrU(Circle.radius * GCadForm.PCad.MapScale / 1000), dtFloat); ObjProps.AddSimpleProperty(pnLength, 'Приблизительная длина ребер на основании', '1', dtFloat); end; end; end; CornerCount := 0; if ObjProps <> nil then begin if EditObjectProps(F_ProjMan, ObjProps, false) then CornerCount := ObjProps.GetPropertyValueAsInteger(pnCornerCount); end else CornerCount := InputForm(F_ProjMan, ApplicationName, cMain_Mes129, 6, dtInteger); if CornerCount > 0 then begin BeginProgress; GCadForm.BeginSaveForUndo(uat_None, True, False); try LayerHandle := GCadForm.PCad.GetLayerHandle(GCadForm.CurrentLayer); if TFigure(GCadForm.PCad.Selection[0]) is TCircle then begin CenterPt := Circle.actualpoints[1]; if IspointInCircle(CurrPt.x, CurrPt.y, CenterPt.x, CenterPt.y, Circle.radius) then StartPt := @CurrPt; PolygonPoints := GetPolylineFromArc(CornerCount, CenterPt, Circle.radius, 360, StartPt, nil); ObjType := ctNone; if IsArchTopComponByIsLine(F_NormBase.GSCSBase.SCSComponent.IsLine) then begin ObjType := F_NormBase.GSCSBase.SCSComponent.IsLine; SetLength(Points, 4); for i := 0 to Length(PolygonPoints) - 1 do begin Points[0] := PolygonPoints[i]; if i < (Length(PolygonPoints) - 1) then Points[1] := PolygonPoints[i+1] else Points[1] := PolygonPoints[0]; Points[2] := CenterPt; Points[3] := Points[0]; ArchNet := CreateArchRoomByWallInfo(nil, nil, GCadForm, ObjType, nil, Points, nil, nil, true, true); Net := TNet(GetCADObjByArchObj(ArchNet, GCadForm)); if ObjType = ctArhRoofSeg then begin // Учитывать карнизы if ObjProps.GetPropertyValueAsBooleanDef(pnAllowEaves, false) then for j := 0 to Net.Paths.Count - 1 do begin Path := TNetPath(Net.Paths[j]); if Net.CmpIntersectPaths(Path.p1, Path.p2, @Points[0], @Points[1]) = citEqual then SetPathRoofHipType(Net, Path, rhtEaves) else SetPathRoofHipType(Net, Path, rhtRoofHip); end; // Учитывать высоту точки ObjHeight := ObjProps.GetPropertyValueAsFloat(pnHeight); if ObjHeight > 0 then begin F_ProjMan.SetComponPropValue( GetArchCornerByPoint(Net, Net.GetPointByNear(CenterPt)), pnHeight, FloatToStr(ObjHeight) ); end; end; end; // Добавляем основание BaseRadius := ObjProps.GetPropertyValueAsFloat(pnRoofBaseRadius) * CADCoordKoeff; if BaseRadius > 0 then begin {SetLength(Points, Length(PolygonPoints)+1); for i := 0 to Length(PolygonPoints) - 1 do begin if Abs(BaseRadius - Circle.radius) > 0.1 then Points[i] := MPoint(CenterPt, PolygonPoints[i], BaseRadius) else Points[i] := PolygonPoints[i]; end; Points[Length(PolygonPoints)] := Points[0];} if Abs(BaseRadius - Circle.radius) > 0.1 then TempPt := MPoint(CenterPt, PolygonPoints[0], BaseRadius) else TempPt := PolygonPoints[0]; //CornerCount*7 // Определяем колво углов, так чтобы размер ребер был 20см BaseCircleLen := 2 * pi * BaseRadius; BaseCornerCount := Round(BaseCircleLen / (ObjProps.GetPropertyValueAsFloat(pnLength)*CADCoordKoeff )); Points := GetPolylineFromArc(BaseCornerCount, CenterPt, BaseRadius, 360, @TempPt, nil); SetLength(Points, Length(Points)+1); Points[Length(Points)-1] := Points[0]; ArchNet := CreateArchRoomByWallInfo(nil, nil, GCadForm, ObjType, nil, Points, nil, nil, true, true); F_ProjMan.SetComponPropValue(ArchNet, pnMaterialType, IntToStr(pmtRoofBase)); end; end else begin PolygonFigure := TPolyline.create(PolygonPoints, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, true, LayerHandle, mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure(GCadForm.CurrentLayer, PolygonFigure, False); end; end else if TFigure(GCadForm.PCad.Selection[0]) is TNet then begin Net := TNet(GCadForm.PCad.Selection[0]); Path := Net.SelPath; if Assigned(Path) and (Path.isArc) then begin PolygonPoints := GetPolylineFromArc(CornerCount+1, Path.ArcCenter, GetLineLength(Path.ArcCenter, Path.p1^), Path.ArcAng*180/pi, Path.p1, Path.p2); Path.isArc := false; Net.RefreshPaths; SrcPt1 := Path.p1^; SrcPt2 := Path.p2^; NewPoints := TList.Create; for i := 0 to Length(PolygonPoints) - 1 do begin pt := nil; if Not EQDP(PolygonPoints[i], Path.p1^) and Not EQDP(PolygonPoints[i], Path.p2^) then begin //pt := Net.DivPath(Path, MPoint(Path.p1^, Path.p2^, GetLineLength(Path.p1^, Path.p2^)/2)); //pt := Net.DivPath(Path, PolygonPoints[i]); TempPt := PolygonPoints[i]; PointToLineByAngle(SrcPt1,SrcPt2,TempPt); //PolygonPoints[i] := TempPt; pt := Net.DivPath(Path, TempPt); end; NewPoints.Add(pt); end; for i := 0 to NewPoints.Count - 1 do begin pt := NewPoints[i]; if pt <> nil then pt^ := PolygonPoints[i]; end; NewPoints.Free; Net.RefreshPaths; {NewPaths := TList.Create; NewPaths.Add(Path); for i := 0 to Length(PolygonPoints) - 1 do begin ptIdx := i; // Если инвертирована дуга, то смотрим с конца if Not Path.Inverted then ptIdx := Length(PolygonPoints) - 1 - i; if Not EQDP(PolygonPoints[ptIdx], Path.p1^) and Not EQDP(PolygonPoints[ptIdx], Path.p2^) then begin for j := 0 to NewPaths.Count - 1 do begin pt := Net.DivPath(TNetPath(NewPaths[j]), PolygonPoints[ptIdx]); if pt <> nil then begin pt^ := PolygonPoints[ptIdx]; NewPaths.Add(Net.Paths[Net.Paths.Count - 1]); Break; //// BREAK //// end; end; //if Net.DivPath(Path, PolygonPoints[ptIdx]) = nil then // Net.DivPath(TNetPath(Net.Paths[Net.Paths.Count - 1]), PolygonPoints[ptIdx]); //PDoublePoint(Net.Points[Net.Points.Count - 1])^ := PolygonPoints[ptIdx]; end; end; Net.RefreshPaths; NewPaths.Free; } //PolygonFigure := TPolyline.create(PolygonPoints, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, true, LayerHandle, mydsNormal, GCadForm.PCad); //GCadForm.PCad.AddCustomFigure(GCadForm.CurrentLayer, PolygonFigure, False); end; end; // Tolik -- 13/01/2020 if Circle <> nil then // GCadForm.FRemFigures.Add(Circle); RefreshCAD_T(GCadForm.PCad); finally GCadForm.EndSaveForUndo; EndProgress; end; RefreshCAD(GCadForm.PCad); end; if ObjProps <> nil then ObjProps.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'aConvertToPolygonExecute', E.Message); end; end; procedure TFSCS_Main.aToolSCSArcDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin DropDownNextToolbar; // Tolik 10/02/2021 GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- SetLayerForDraw; GCadForm.PCad.SetTool(toFigure, 'TArcDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.FormDestroy(Sender: TObject); begin FreeAndNil(FCADsInProgress); if Assigned(FInteractiveActions) then FreeAndNil(FInteractiveActions); end; procedure TFSCS_Main.aPrintRectExecute(Sender: TObject); var i: integer; begin {$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)} if Not IsVista then begin BuildFHash; GetLic; for i := 0 to 15 do begin if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then Close; end; end; {$IFEND} {$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)} ShowMessage(cMain_Mes9); {$ELSE} if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.PCad.SetTool(toFigure, 'TPrintRect'); tbSelectNoob.Down := false; tbSelectExpert.Down := false; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); {$IFEND} end; procedure TFSCS_Main.aSegActionExecute(Sender: TObject); var Polyline: TPolyline; MenuCmd: Integer; Rad: Double; begin if (GPopupFigure <> nil) and (GCadForm.PCad.Figures.IndexOf(GPopupFigure) <> -1) and (GPopupFigure is TPolyline) then if Not TAction(Sender).Checked or (Sender = aSegDimLine) then begin GCadForm.BeginSaveForUndo(uat_None, False, False); try Polyline := TPolyline(GPopupFigure); MenuCmd := -1; if Sender = aSegCurveAll then Polyline.ConvertToBezier else if Sender = aSegLineAll then Polyline.ConvertToPolyLine else if Sender = aSegClose then Polyline.Closed := true else if Sender = aSegOpen then Polyline.Closed := false else if Sender = aSegInsertKnot then MenuCmd := 7 else if Sender = aSegDeleteKnot then MenuCmd := 8 else if Sender = aSegLine then MenuCmd := 9 else if Sender = aSegCurve then MenuCmd := 10 else if Sender = aSegArc then MenuCmd := 11 else if Sender = aSegInverArc then MenuCmd := 12 else if Sender = aSegDimLine then MenuCmd := 15 else if Sender = aSegDivTo3 then MenuCmd := 14 else if Sender = aSegRoundCornerByArc then begin //MenuCmd := 16 Rad := 5; //if InputDouble(aSegRoundCornerByArc.Caption, cMain_Mes130, Rad) then //if InputDouble('Round Corner By Arc','Ener Arc Corner',Rad) then begin Rad := InputForm(F_ProjMan, aSegRoundCornerByArc.Caption, cMain_Mes130, Rad, dtFloat); if Rad > 0 then Polyline.RoundCornerByArc(Polyline.SelectedPoint, Rad); end else if Sender = aSegPenNone then MenuCmd := 13 else if Sender = aSegPenZigZag then MenuCmd := 17+0 else if Sender = aSegPenFlower then MenuCmd := 17+1 else if Sender = aSegPenSinus then MenuCmd := 17+2 else if Sender = aSegPenButtons then MenuCmd := 17+3 else if Sender = aSegPenSquare then MenuCmd := 17+4 else if Sender = aSegPenMiniSinus then MenuCmd := 17+5; if MenuCmd <> -1 then begin Polyline.MenuClicked(MenuCmd); end; finally GCadForm.EndSaveForUndo; end; RefreshCAD_T(GCadForm.PCad); end; end; procedure TFSCS_Main.aSaveProjectToPDFExecute(Sender: TObject); var SaveDialog: TSaveDialog; i: Integer; CAD: TF_CAD; PDFDoc: TPDFDocument; O, B: TPDFOutlineNode; CADIdx: Integer; SCSList: TSCSList; ProjLists: TList; SaveAll: Boolean; Form: TForm; // Tolik 22/12/2020 -- begin try if MessageBox(FSCS_Main.Handle, cMain_Mes143, cMain_Mes143_c, MB_YESNO) = IDYes then GExportUSeScale := True; SaveDialog := TSaveDialog.Create(Self); SaveDialog.Title := aSaveProjectToPDF.Caption; SaveDialog.InitialDir := ExtractSaveDir; SaveDialog.DefaultExt := 'pdf'; SaveDialog.Filter := cProgressExp_Msg9_1; SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt]; SaveDialog.FileName := FileNameCorrect(F_ProjMan.GSCSBase.CurrProject.Name); if SaveDialog.Execute then begin // Tolik 16/07/2019 -- добавил небольшую формочку, чтобы можно было выбрать, какие именно листы проекта сохранять, а то // валит все листы, а не всем пользователям такое нравится (вот, по просьбам трудящихся ... и) if not Assigned(F_SelLists) then Application.CreateForm(TF_SelLists, F_SelLists); F_SelLists.CheckList1.Clear; for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count -1 do begin F_SelLists.CheckList1.Items.Add(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].GetNameForVisible(false)); F_SelLists.CheckList1.ItemState[i] := cbChecked; end; if F_SelLists.ShowModal = mrOk then begin i := F_SelLists.CheckList1.ItemsChecked; if i > 0 then begin // PDFDoc := CreatePDFObject(Self, F_ProjMan.GSCSBase.CurrProject.Name, SaveDialog.FileName, nil); PDFDoc.Compression := PDF.ctNone; PDFDoc.JPEGQuality := 100; //PDFDoc.Resolution := 70; if not GExportUSeScale then // Tolik 22/12/2020 PDFDoc.Resolution := 300 else begin if GCadForm <> nil then begin if GCadForm.PCad <> nil then begin Form := GCadForm.PCad.GetForm; if Form <> nil then PDFDoc.Resolution := Form.PixelsPerInch; end; end; end; PDFDoc.PageMode := pmUseOutlines; PDFDoc.PageLayout := plSinglePage; PdfDoc.EMFImageAsJpeg := True; // Tolik 22/12/2020 PDFDoc.Compression := ctFlate; // Tolik 22/12/2020 PDFDoc.BeginDoc; //PDFDoc.Outlines.Add() //B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create); {$IF Defined(SCS_PE)} B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create); {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create, RUSSIAN_CHARSET); {$IFEND} B.Expanded := True; //B.Charset := DEFAULT_CHARSET; //B.Charset := ANSI_CHARSET; {$IF Defined(SCS_PE)} B.Charset := DEFAULT_CHARSET; {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET B.Charset := RUSSIAN_CHARSET; {$IFEND} O := nil; CADIdx := 0; for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin if F_SelLists.CheckList1.ItemChecked[i] then begin SCSList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]; CAD := GetListByID(SCSList.CurrID); if CAD <> nil then begin if CADIdx > 0 then PDFDoc.NewPage; SetCADPageParamsToPDF(CAD, PDFDoc, false); //O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create); {$IF Defined(SCS_PE)} O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create); {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create, RUSSIAN_CHARSET); {$IFEND} TPDFGoToPageAction(O.Action).PageIndex := CADIdx; TPDFGoToPageAction(O.Action).TopOffset := 0; {$IF Defined(SCS_PE)} O.Charset := DEFAULT_CHARSET; {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET O.Charset := RUSSIAN_CHARSET; {$IFEND} O.Expanded := True; Inc(CADIdx); end; end; end; (* for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin SCSList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]; CAD := GetListByID(SCSList.CurrID); if CAD <> nil then begin if CADIdx > 0 then PDFDoc.NewPage; SetCADPageParamsToPDF(CAD, PDFDoc, false); //O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create); {$IF Defined(SCS_PE)} O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create); {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create, RUSSIAN_CHARSET); {$IFEND} TPDFGoToPageAction(O.Action).PageIndex := CADIdx; TPDFGoToPageAction(O.Action).TopOffset := 0; {$IF Defined(SCS_PE)} O.Charset := DEFAULT_CHARSET; {$ELSE} //НУЖНО ЮЗАТЬ RUSSIAN_CHARSET O.Charset := RUSSIAN_CHARSET; {$IFEND} O.Expanded := True; Inc(CADIdx); end; end; *) PDFDoc.EndDoc; PDFDoc.Free; end; end; end; SaveDialog.Free; FreeAndNil(F_SelLists); except on E: Exception do AddExceptionToLogExt(ClassName, 'aSaveProjectToPDFExecute', E.Message); end; GExportUSeScale := False; end; procedure TFSCS_Main.aLinesToTracesExecute(Sender: TObject); var CmpPointDelta: Double; Figure: TFigure; Line: TLine; PolyLine: TPolyline; Seg: TPlSegment; Trace, CTrace: TOrthoLine; FigureList: TList; NewTraces: TList; TracesHeight: Double; i, j, k, l: Integer; Conn1, Conn2: TConnectorObject; SnappedInfo: TStringList; SnapInfo: String; procedure CollectFigures(AFigures: TList); var i: integer; begin for i := 0 to AFigures.Count - 1 do begin Figure := TFigure(AFigures[i]); if CheckFigureByClassName(Figure, TPolyline.ClassName) then begin // проверяем сегменты полилинии, чтобы были типа лин // ---- FigureList.Add(Figure); end else if CheckFigureByClassName(Figure, TLine.ClassName) then begin if Not PointNear(TLine(Figure).ActualPoints[1], TLine(Figure).ActualPoints[2], CmpPointDelta) then FigureList.Add(Figure); end else if CheckFigureByClassName(Figure, TRectangle.ClassName) then FigureList.Add(Figure) else if CheckFigureByClassName(Figure, TFigureGrp.ClassName) then CollectFigures(TFigureGrp(Figure).InFigures); end; end; procedure CreateTrace(p1, p2: TDoublePoint); begin if Not PointNear(p1, p2, CmpPointDelta) then begin Trace := CreateTraceByPoints(GCadForm.PCad, p1, p2); RaiseLineOnHeight(Trace, TracesHeight, nil); NewTraces.Add(Trace); end; end; begin try F_RaiseHeight.cbApplyToAll.Visible := False; // Tolik 04/08/2021 -- GPopupFigure := nil; CmpPointDelta := 1/5; FigureList := TList.Create; {for i := 0 to GCadForm.PCad.Selection.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(Figure, TPolyline.ClassName) then begin // проверяем сегменты полилинии, чтобы были типа лин // ---- FigureList.Add(Figure); end else if CheckFigureByClassName(Figure, TLine.ClassName) then begin if Not EQDP(TLine(Figure).ActualPoints[1], TLine(Figure).ActualPoints[2]) then FigureList.Add(Figure); end else if CheckFigureByClassName(Figure, TFigureGrp.ClassName) then begin end; end;} CollectFigures(GCadForm.PCad.Selection); if FigureList.Count > 0 then begin if MessageQuastYN(cMain_Mes134) = IDYES then begin F_RaiseHeight.Caption := cMain_Mes32; F_RaiseHeight.lbMessage.Caption := cMain_Mes33; F_RaiseHeight.SetVal(GCadForm.FLineHeight); if F_RaiseHeight.Showmodal = mrOK then begin NewTraces := TList.Create; //GCadForm.SaveForUndo(uat_None, true, False); GCadForm.ClearUndoList(false); GCadForm.ClearRedoList(false); GCadForm.PCad.ClearUndoList; GCadForm.FCanSaveForUndo := false; try BeginProgress('', FigureList.Count * 2); try TracesHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text); TracesHeight := UOMToMetre(TracesHeight); if TracesHeight > GCadForm.FRoomHeight then TracesHeight := GCadForm.FRoomHeight; // Create Traces for i := 0 to FigureList.Count - 1 do begin Figure := TFigure(FigureList[i]); //if Figure is TRectangle then // EmptyProcedure; for j := 1 to Figure.PointCount -1 do CreateTrace(Figure.ActualPoints[j], Figure.ActualPoints[j+1]); // Если объект замкнутый, то добавляем замыкающую трассу if Figure.PointCount > 2 then begin if CheckFigureByClassName(Figure, TPolyline.ClassName) then begin if TPolyline(Figure).Closed then CreateTrace(Figure.ActualPoints[1], Figure.ActualPoints[Figure.PointCount]); end else if CheckFigureByClassName(Figure, TRectangle.ClassName) then CreateTrace(Figure.ActualPoints[1], Figure.ActualPoints[Figure.PointCount]); end; StepProgress; end; RefreshCAD(GCadForm.PCad); // Connect Traces SnappedInfo := CreateStringListSorted; for i := 0 to NewTraces.Count - 1 do begin Trace := TOrthoLine(NewTraces[i]); for j := 0 to NewTraces.Count - 1 do begin CTrace := TOrthoLine(NewTraces[j]); if Trace <> CTrace then begin for k := 1 to 2 do for l := 1 to 2 do if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then begin Conn1 := Trace.ConnectorByNum(k); Conn2 := CTrace.ConnectorByNum(l); if Assigned(Conn1) and Assigned(Conn2) then if Conn1 <> Conn2 then begin SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID)); if SnappedInfo.IndexOf(SnapInfo) = -1 then begin if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then // Tolik -- 29/03/2018 -- //Conn1 := SnapConnectorToConnector(Conn1, Conn2) CheckingSnapConnectorToConnector(Conn1, Conn2) // else EmptyProcedure; SnappedInfo.Add(SnapInfo); end; end; end; end; end; StepProgress; end; FreeAndNil(SnappedInfo); RefreshCAD(GCadForm.PCad); finally EndProgress; end; // Удалить исходные линии if MessageQuastYN(cMain_Mes133) = IDYES then begin BeginProgress('', FigureList.Count * 2); try GCadForm.PCad.DeselectAll(0); for i := 0 to FigureList.Count - 1 do begin //Line := TLine(FigureList[i]); //Line.Select; Figure := TFigure(FigureList[i]); // Если не в группе if Figure.Parent = nil then Figure.Select else if CheckFigureByClassName(Figure.Parent, TFigureGrp.ClassName) then if TFigureGrp(Figure.Parent).InFigures.IndexOf(Figure) <> -1 then begin //EmptyProcedure; TFigureGrp(Figure.Parent).RemoveFromGrp(Figure); Figure.Free; FigureList[i] := nil; end; //TFigure(FigureList[i]).Select; end; // Сохраняем с подложкой для отката //GCadForm.PCad.RecordUndo := True; //GCadForm.PCad.RecordModifyUndo(nil); //GCadForm.PCad.RecordUndo := False; GCadForm.FCanSaveForUndo := false; // чтобы не вызвался SaveForProjectUndo на PCadBeforeDelete GCadForm.RemoveSelectedWithoutCheck; RefreshCAD(GCadForm.PCad); finally EndProgress; end; end; // Выделяем новые трассы GCadForm.PCad.DeselectAll(0); for i := 0 to NewTraces.Count - 1 do begin //TOrthoLine(NewTraces[i]).Select; Trace := TOrthoLine(NewTraces[i]); Trace.Select; Trace.JoinConnector1.Select; Trace.JoinConnector2.Select; end; RefreshCAD(GCadForm.PCad); finally GCadForm.FCanSaveForUndo := true; NewTraces.Free; end; end; end; end else MessageInfo(cMain_Mes132); FigureList.Free; except on E: Exception do AddExceptionToLogExt(ClassName, 'aLinesToTracesExecute', E.Message); end; end; procedure TFSCS_Main.aTurnObjectExecute(Sender: TObject); var Path: TNetPath; Niche: TNetDoor; begin Path := NetGetSelPath; if Path <> nil then begin Niche := NetDoorRotate(Path); if Niche <> nil then begin if Niche.FComponID <> 0 then begin Path := Niche.GetPath; if Path <> nil then if Not Path.IsInnerNiche(Niche, true) then begin Sleep(100); Application.ProcessMessages; //ShowHintInCursorPos(cMain_Mes135, 2000); ShowHintRz(cMain_Mes135, 4000, @GCadForm.FPopupScrPoint); end; //NetDoorShowOutNicheMessage(Path.Net, cMain_Mes135); end; end else begin //22.05.2012 Иначе сегменту меняем сторону отображания перпендикулярных точек NetPathPerpendSideRotate(Path); end; end; end; procedure TFSCS_Main.aLoadSubstrateFromPDFExecute(Sender: TObject); var Bmp: TBitmap; Jpg: TJPEGImage; FName: String; bmpHandle: TFigHandle; // Tolik 09/08/2019 -- Fig: TFigure; UserDimLine: boolean;//Tolik 12/08/2021 -- begin if ActiveMDIChild <> nil then begin UserDimLine := False; Bmp := CreateFPDFView.GetDocBitmap(cMain_Mes136); if Bmp <> nil then begin try FName := ExtractSCSTempDir + GetUniqueFileName('', enBmp); Bmp.SaveToFile(FName); Bmp.Free; aSetSubstrateLayer.Execute; // Tolik //Fig := TFigure(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); bmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if bmpHandle <> -1 then begin Fig := TFigure(bmpHandle); if Fig <> nil then // Tolik 12/08/2021 -- begin if not Fig.Deleted then // Tolik 12/08/2021 -- begin Fig.width := 0; // Убираем рамку GCadForm.PCad.DeselectAll(0); DeleteFile(FName); AutoFitBitMap(TBMPObject(Fig)); UserDimLine := True; // Tolik 12/08/2021 -- end; end; end else begin ShowMessage(cMain_Mes6); end; except ShowMessage(cMain_Mes6); end; { FSCS_Main.tbSelectExpert.Down := False; FSCS_Main.tbSelectNoob.Down := False; FSCS_Main.tbPanExpert.Down := True; FSCS_Main.tbPanNoob.Down := True; FSCS_Main.aToolPan.Execute; } RefreshCAD(GCadForm.PCad); end; GisUserDimLine := UserDimLine; // Tolik 12/08/2021 -- SetHScale; // Tolik 12/08/2021 -- end else MessageInfo(CActiveListNotExistMessage); end; procedure TFSCS_Main.InteractiveTest; var Pt: TPoint; begin {//ShowMessage('11'); Pt.X := tbNew.Left+5; Pt.Y := tbNew.Top+tbNew.Height-5; Pt := tbNew.Parent.ClientToScreen(Pt); //Pt.X := Pt.X + tbNew.Width-5; //Pt.Y := Pt.Y + tbNew.Height-5; Sleep(100); Application.ProcessMessages; GOldOnActionExecute := Application.OnActionExecute; GInteractiveAction := TBasicAction(tbNew.Action); Application.OnActionExecute := InteractiveActionExecute; //ShowHintInCursorPos(cMain_Mes135, 2000); ShowHintES('Create a new project', 1000*300, @Pt); //ShowHintRz('Create a new project', 0, @Pt); } RunInteractive(1); end; procedure TFSCS_Main.InteractiveActionExecute(Action: TBasicAction; var Handled: Boolean); begin if FInteractiveActions.IndexOf(Action) <> -1 then begin if FInteractiveStepHitsCount > 0 then begin Dec(FInteractiveStepHitsCount); if FInteractiveStepHitsCount = 0 then begin // Восстанавливаем старый обработчик Application.OnActionExecute := FOldOnActionExecute; FInteractiveActions.Clear; //11.05.2013 StepInteractive; end; end; end; end; procedure TFSCS_Main.FInteractiveMsg(var Msg: TMsg; var Handled: boolean); begin case Msg.message of WM_LBUTTONUP: begin if Msg.hwnd = FInteractiveControlHandler then begin if FInteractiveStepHitsCount > 0 then begin Dec(FInteractiveStepHitsCount); if FInteractiveStepHitsCount = 0 then begin if Assigned(FInteractiveMsgOrig) then FInteractiveMsgOrig(Msg, Handled); // Восстанавливаем старый обработчик Application.OnMessage := FInteractiveMsgOrig; FInteractiveMsgOrig := nil; FInteractiveControlHandler := 0; //11.05.2013 StepInteractive; end; end; end; end; end; if Assigned(FInteractiveMsgOrig) then FInteractiveMsgOrig(Msg, Handled); end; procedure TFSCS_Main.RunInteractive(aScene: Integer); var Pt: TPoint; NodeComp: TTreeNode; begin if FInteractiveActions = nil then FInteractiveActions := TList.Create; // Create forms - in Win7 //F_ProjMan.CreateFResourceReport; aInteractiveStopExecute(nil); FInteractiveStep := 1; FInteractiveScene := aScene; if FInteractiveScene = 1 then FInteractiveStepCount := 10; FInteractiveStepShowed := false; tbCADToolsExpert.Left := 91;//Tolik 02/102/2022 -- tbInteractive.Visible := true; //aInteractiveNextStep.Enabled := false; aInteractiveStop.Enabled := true; // показать хинт возле кнопок управления интерактивным режимом Application.ProcessMessages; // Pt := GetControlScreenPt(tbInteractiveNextStep, ctLeftMiddle); // ShowHintES(cMain_Mes137, 1500, @Pt); // Application.ProcessMessages; // Sleep(2000); //TimerInteractive.Interval := 1000; //FInteractiveTimerExecution := false; //11.05.2013 TimerInteractive.Enabled := True; NodeComp := F_NormBase.FindTreeNodeByDat(280410, [itComponCon]); if NodeComp <> nil then begin PObjectData(NodeComp.Data).FontColor := clGreen; FInteractiveWorkColorSet := True; F_NormBase.Tree_Catalog.Repaint; end; NodeComp := F_NormBase.FindTreeNodeByDat(280414, [itComponCon]); if NodeComp <> nil then begin PObjectData(NodeComp.Data).FontColor := clGreen; FInteractiveRackColorSet := True; F_NormBase.Tree_Catalog.Repaint; end; //if Not Assigned(FInteractiveMsgOrig) then //begin // FInteractiveMsgOrig := Application.OnMessage; // Application.OnMessage := FInteractiveMsg; //end; end; procedure TFSCS_Main.StepInteractive; begin Inc(FInteractiveStep); FInteractiveStepShowed := false; HideHintES; TimerInteractive.Enabled := False; TimerInteractive.Enabled := True; Sleep(100); Application.ProcessMessages; end; procedure TFSCS_Main.TimerInteractiveTimer(Sender: TObject); var Pt: TPoint; HintMessage: String; SCSComponent: TSCSComponent; SCSComponents: TSCSComponents; SprComponentType: TNBComponentType; TestCnt: Integer; Figure: TFigure; SavedHandler: TNotifyEvent; //11.05.2013 begin if FInteractiveStep > FInteractiveStepCount then aInteractiveStopExecute(nil) //TTimer(Sender).Enabled := False else begin SavedHandler := TTimer(Sender).OnTimer; //11.05.2013 TTimer(Sender).OnTimer := nil; //11.05.2013 try //11.05.2013 if Not IsVisibleHintES then begin if Not FInteractiveStepShowed then begin FInteractiveActions.Clear; FInteractiveControlHandler := 0; HintMessage := ''; FInteractiveStepHitsCount := 1; if FInteractiveScene = 1 then begin case FInteractiveStep of 1: // Создание проекта begin //Pt := tbNew. //Pt := tbNew.Parent.ClientToScreen(Pt); Pt := GetControlScreenPt(tbNew, ctBottomMiddle); FInteractiveActions.Add(tbNew.Action); Pt.X := Pt.X+5; Pt.Y := Pt.Y-5; //+tbNew.Height -5; HintMessage := 'Create a new project'; end; 2: // Установка параметров проекта begin if F_MasterNewList.Visible then begin FInteractiveControlHandler := F_MasterNewList.bOk.Handle; Pt := GetControlScreenPt(F_MasterNewList.bOk); HintMessage := 'Set basic project options and press OK. You may leave everything as is.'; end else if F_MasterNewListLite.Visible then begin FInteractiveControlHandler := F_MasterNewListLite.bNext.Handle; Pt := GetControlScreenPt(F_MasterNewListLite.bNext); FInteractiveStepHitsCount := 4; // Кнопка "далее" нажимается 4 раза HintMessage := 'Set basic project options and press Next/Done'; end; end; 3: // Загрузка подложки begin if IsWindowEnabled(Handle) and Not GetIsActiveFormProgress then // Если нет модального окна, диалога if CheckIsOpenProject(false) then if tbLoadSubstrate.Visible and tbLoadSubstrate.Enabled then begin //Pt := GetControlScreenPt(tbLoadSubstrate, ctBottomLeft); //FInteractiveActions.Add(tbLoadSubstrate.Action); //Pt.X := Pt.X+5; //Pt.Y := Pt.Y-5; //+tbLoadSubstrate.Height -5; //HintMessage := 'Load a floor plan in DWG or PDF'; Pt := Point(17, 0); Pt := Self.ClientToScreen(Pt); FInteractiveActions.Add(tbLoadSubstrate.Action); FInteractiveActions.Add(aLoadSubstrate); FInteractiveActions.Add(aOpenVectorDrawing); FInteractiveActions.Add(aLoadSubstrateFromPDF); //HintMessage := 'Load from main menu (File->Load) a floor plan in DWG (Vector drawing) or PDF'; HintMessage := 'Load a Floor plan in DWG. Click on the FILE menu, then LOAD and pick VECTOR DRAWING (DWG, DXF...). Load the file “SAMPLE FLOOR PLAN”'; end; end; 4: // Поиск Раб.Мест в НБ begin if IsWindowEnabled(Handle) then // Если нет модального окна, диалога begin //Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle); Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft); Pt.X := Pt.X + 45; Pt.Y := Pt.Y + 145; //Pt.X := pt.x + trunc(F_NormBase.Tree_Catalog.Width/2); //Pt.Y := pt.Y + trunc(F_NormBase.Tree_Catalog.Height/2); //FInteractiveControlHandler := F_NormBase.Tree_Catalog.Handle; //HintMessage := 'Find Jacks (work areas) in the Library - “Panduit” folder - “Examples - Work areas” folder'; //+snNextRow+cMain_Mes137_2; //HintMessage := 'Find Jacks (work areas) in the Libraryю. Folder “Panduit” - “SAMPLES” - “Work areas” - ' + // 'locate “WA rj45+rj45 for T-45” and click over it'; HintMessage := 'Find jacks (work areas) in the Library. Folder “PANDUIT - SAMPLES - WORK AREAS”. Locate “WA rj45+rj45 for T-45” and click on it'; aInteractiveNextStep.Enabled := true; FInteractiveActions.Add(aInteractiveNextStep); end; end; 5: // Установка 3-х раб.мест begin if GCadForm <> nil then begin Pt := GetControlScreenPt(GCadForm, ctMiddle); //HintMessage := 'Drag and drop 3 jacks on the drawing'; //+snNextRow+cMain_Mes137_2; HintMessage := 'Drag and drop 3 set of jacks “WA rj45+rj45 for T-45” on the drawing'; aInteractiveNextStep.Enabled := true; FInteractiveActions.Add(aInteractiveNextStep); end; end; 6: // Поиск шкафа в НБ begin //HintMessage := 'Find a Rack "PANNET CABLE MANAGEMENT RACK" in the Library and drag and drop on the drawing'; //+snNextRow+cMain_Mes137_2; HintMessage := 'Find a Rack “PANNET CABLE MANAGEMENT” in the “SAMPLES - RACKS AND CABINETS” folder and drag and drop on the drawing'; //Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle); Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft); Pt.X := Pt.X + 45; Pt.Y := Pt.Y + 145; aInteractiveNextStep.Enabled := true; FInteractiveActions.Add(aInteractiveNextStep); end; 7: // Шкаф как конечный объект begin SCSComponent := F_ProjMan.GSCSBase.CurrProject.ComponentReferences.GetComponentByType(ctsnCupboard); if SCSComponent <> nil then begin Figure := GetFigureByID(GCadForm, SCSComponent.GetFirstParentCatalog.SCSID); if Figure <> nil then begin Pt := GCadForm.PCad.PointToScreen(Figure.ActualPoints[1]); //HintMessage := 'Set the Rack as a destination and all the cables from jacks will be layed out down to this Rack. Right-clicking on the Rack and check “As terminal object” in the context menu. The Rack should hightlight red.'; HintMessage := 'Set the Rack as a destination and all the cables from jacks will be layed out down to this Rack. Right-clicking on the Rack and check “Set as destination for cables” in the context menu. The Rack should hightlight red.'; FInteractiveActions.Add(aServerAsDefault); end; end; end; 8: // Прокладка трасс begin //HintMessage := 'Lay out routes. Click this button and connect every jack with the Rack. Click mouse over jacks and right-click it on the Rack to finish the route'; //+snNextRow+cMain_Mes137_2; //HintMessage := 'Lay out routes. Click the button and connect every jack with the Rack.' + // ' When moving route over jacks click the mouse and at the end right-click on the Rack to finish the route'; HintMessage := 'Lay out routes. Click this button and connect every jack with the Rack. Click mouse over every jacks. Make sure the jack is highlighted when mouse is over, otherwise the connection will fail. ' + 'Then сlick over the Rack and finally right-click to finish the route'; if tbCADToolsExpert.Visible then Pt := GetControlScreenPt(tbToolOrtholineExtExpert, ctBottomMiddle) else Pt := GetControlScreenPt(tbToolOrtholineExtNoob, ctBottomMiddle); Pt.y := Pt.y - 10; aInteractiveNextStep.Enabled := true; //FInteractiveActions.Add(aToolOrthoLine); FInteractiveActions.Add(aInteractiveNextStep); end; 9: // Прокладка кабеля begin if GCadForm.PCad.ToolInfo = 'TSelected' then // Если трассы уже проложили begin //Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle); Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft); Pt.X := Pt.X + 45; Pt.Y := Pt.Y + 145; //HintMessage := 'Now that we have layed out routes, please find a cable in the Library to lay out between jacks and a Rack. Right-click on the cable and execute Autoroute'; HintMessage := 'Now that we have layed out routes, please find a cable “UTP CAT5E PVC CABLE” in ' + 'the “SAMPLES-CABLES” folder to lay out it between jacks and the Rack. ' + 'Right-click on the cable and click on the AUTOROUTE command. After that confirm OK in the following windows.'; //FInteractiveActions.Add(F_NormBase.Act_AutoTraceCable); //aInteractiveNextStep.Enabled := true; FInteractiveActions.Add(aInteractiveNextStep); end; end; 10: // Просмотр отчета begin Pt := GetControlScreenPt(tbRepWizard, ctBottomMiddle); Pt.y := Pt.y - 10; Pt.x := Pt.x - 10; HintMessage := 'Check out the deliverables in Reports section. Open Specification first and see the resources calculated for the project'; FInteractiveActions.Add(F_ProjMan.CreateFResourceReport.Act_ShowWizardReport); end; end; end; if (FInteractiveActions.Count > 0) or (FInteractiveControlHandler <> 0) then begin if FInteractiveActions.Count > 0 then begin FOldOnActionExecute := Application.OnActionExecute; Application.OnActionExecute := InteractiveActionExecute; end else if FInteractiveControlHandler <> 0 then begin FInteractiveMsgOrig := Application.OnMessage; Application.OnMessage := FInteractiveMsg; end; FInteractiveStepShowed := true; //Sleep(100); //Application.ProcessMessages; ShowHintES(HintMessage, 0, @Pt); end; end; end else // Если Хинт висит - определяем можно ли прееходить к следующему шагу begin if FInteractiveScene = 1 then begin case FInteractiveStep of 5: // Установка 3-х раб.мест begin if IsWindowEnabled(Handle) then begin if GCadForm <> nil then if Not GCadForm.PCad.IsDragging then begin SprComponentType := F_ProjMan.GetSpravochnik.GetComponentTypeObjBySysName(ctsnWorkPlace); if SprComponentType <> nil then begin SCSComponents := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentsByType(SprComponentType.ComponentType.GUID, true); TestCnt := SCSComponents.Count; FreeAndNil(SCSComponents); if TestCnt = 3 then StepInteractive; // Важно до этого сделать FreeAndNil(SCSComponents);, так как в StepInteractive есть Application.ProcessMessages end; end; end; end; 8: // Прокладка трасс if GCadForm.PCad.ToolInfo = 'TSelected' then begin // Проводим симуляцию автосоздания трасс, для проверки есть ли что с чем соединять TestCnt := AutoCreateTraces(true, true, true); if TestCnt = 0 then StepInteractive; end; end; end; end; finally //11.05.2013 TTimer(Sender).OnTimer := SavedHandler; //11.05.2013 end; //11.05.2013 end; end; procedure TFSCS_Main.aInteractiveNextStepExecute(Sender: TObject); begin aInteractiveNextStep.Enabled := false; end; procedure TFSCS_Main.aInteractiveStopExecute(Sender: TObject); begin TimerInteractive.Enabled := false; FInteractiveStep := 0; if FInteractiveStepShowed then begin // Если не востановлены, то восстановить прежние обработчики - на случай если предыдущие шаги выполнены не все и запущено повторно if Assigned(FInteractiveMsgOrig) then begin Application.OnMessage := FInteractiveMsgOrig; FInteractiveMsgOrig := nil; end; if Assigned(FOldOnActionExecute) then begin Application.OnActionExecute := FOldOnActionExecute; FOldOnActionExecute := nil; end; end; tbInteractive.Visible := false; tbCADToolsExpert.Left := 11; // Tolik 02/12/2022 -- aInteractiveNextStep.Enabled := false; aInteractiveStop.Enabled := false; if IsVisibleHintES then HideHintES; end; procedure TFSCS_Main.pnHintBarHotSpotClick(Sender: TObject); begin //pnHintBarPaint(Self); pnHintBar.Height := pnHintBar.Height + 1; pnHintBar.Height := pnHintBar.Height - 1; end; procedure TFSCS_Main.pnHintBarPaint(Sender: TObject); var Bnd: TRect; begin Bnd := pnHintBar.BoundsRect; Bnd.Right := Bnd.Right - 10; Bnd.Bottom := Bnd.Bottom - 10; //DrawDropShadow( pnHintBar.Canvas, Bnd, 6); end; procedure TFSCS_Main.pmListPopup(Sender: TObject); var i, j: Integer; HasDoors, HasWindows: Boolean; procedure InsertActToPopupMenu(APopupMenu: TPopupMenu; AIndex: Integer; AAction: TAction); var pmnuItem: TMenuItem; begin if Not Assigned(APopupMenu) then Exit; ///// EXIT ///// pmnuItem := TMenuItem.Create(APopupMenu); pmnuItem.Action := AAction; if Not Assigned(AAction) then pmnuItem.Caption := '-'; APopupMenu.Items.Insert(AIndex, pmnuItem); if Assigned(AAction) then begin APopupMenu.Items[AIndex].Caption := AAction.Caption; APopupMenu.Items[AIndex].ImageIndex := AAction.ImageIndex; end; end; begin //F_ProjMan.Act_CopyCurrList.Visible := true; //F_ProjMan.Act_CopyCurrListWithoutCompons.Visible := true; //Tolik 16/06/2021 -- это приводит к мерцанию меню на каде ... перенесено в TF_CAD.FormCADPopupMenu { if PmList.Items[1].Action <> F_ProjMan.Act_CopyCurrListWithoutCompons then begin InsertActToPopupMenu(PmList, 1, F_ProjMan.Act_CopyCurrList); InsertActToPopupMenu(PmList, 1, F_ProjMan.Act_CopyCurrListWithoutCompons); PmList.Items[1].ImageIndex := 209; PmList.Items[2].ImageIndex := 209; end; } FSCS_Main.aSetAllListDoorsHeight.Visible := False; FSCS_Main.aSetAllListWndHeight.Visible := False; FSCS_Main.aSetAllListDoorsPlacementHeight.Visible := False; FSCS_Main.aSetAllListWndPlacement.Visible := False; //Tolik 06/09/218 -- для архитектурного проектирования {$if Defined (ES_GRAPH_SC)} // -- графмодуль {$else} // СКС if GCadForm.CurrentLayer = 8 then begin if GCadForm.FActiveNet <> nil then begin HasDoors := False; HasWindows :=False; for i := 0 to GCadForm.FActiveNet.Paths.Count - 1 do begin for j := 0 to TNetPath(GCadForm.FActiveNet.Paths[i]).Doors.Count - 1 do begin if TNetDoor(TNetPath(GCadForm.FActiveNet.Paths[i]).Doors[j]).DoorObjType = dotDoor then HasDoors := True else if TNetDoor(TNetPath(GCadForm.FActiveNet.Paths[i]).Doors[j]).DoorObjType = dotWindow then HasWindows := True end; end; if HasDoors then begin FSCS_Main.aSetAllListDoorsHeight.Visible := True; FSCS_Main.aSetAllListDoorsPlacementHeight.Visible := True; end; if HasWindows then begin FSCS_Main.aSetAllListWndHeight.Visible := True; FSCS_Main.aSetAllListWndPlacement.Visible := True; end; end; end; {$ifEnd} // end; procedure TFSCS_Main.aExportDWGExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin SaveDXFFile(GCadForm.PCad, cExport_Mes2, cImport_Mes12_2, '*.dwg'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aSaveRevisionExecute(Sender: TObject); begin F_ProjMan.SaveProjectRevision; end; procedure TFSCS_Main.aViewRevsExecute(Sender: TObject); begin F_ProjMan.CreateFProjectRev.Execute; end; procedure TFSCS_Main.aProjectScheduleExecute(Sender: TObject); begin if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then F_ProjMan.CreateFNormsComplete.Execute(F_ProjMan.GSCSBase.CurrProject, true, true, true) else F_ProjMan.CreateFNormsComplete.Execute(F_ProjMan.GetActualSelectedCatalog, true, true, true); end; procedure TFSCS_Main.aBillWorkExecute(Sender: TObject); begin CheckCloseReportForm;//Tolik 15/02/2022 -- F_ProjMan.CreateFNormsGroups.Execute(F_ProjMan.GetActualSelectedCatalog, true, true, true); end; procedure TFSCS_Main.aShowCableRuleClick(Sender: TObject); begin F_ProjMan.Act_CablesNoHitToCanalsExecute(Sender); end; procedure TFSCS_Main.aAutoDivExecute(Sender: TObject); begin ApplySectionSideForTraces(GCADForm); end; procedure TFSCS_Main.N70Click(Sender: TObject); var WAReport : TF_ResourceReport; ReportForm : TForm; SCSCatalog : TSCSCatalog; begin // Если стоим на проекте или на листе, SCSCatalog := nil; SCSCatalog := F_ProjMan.GetActualSelectedCatalog; if ( (SCSCatalog.ItemType <> itNone) and (SCSCatalog.ItemType <> itProjMan) and (SCSCatalog.ItemType <> itDir) ) then begin if (SCSCatalog <> nil) then // and ((SCSCatalog.ItemType = itList) or (SCSCatalog.ItemType = itProject)) then begin //то можем показать отчет Application.CreateForm(TF_ChooseComponTypesForReport,F_ChooseComponTypesForReport); if F_ChooseComponTypesForReport.Execute then; end; end; end; // Tolik 25/03/2021 -- подключить кабелем -- для электрики procedure TFSCS_Main.Act_ConnectByCableAllExecute(Sender: TObject); begin GDropPcadTool := True; GConnectEndPoints := False; Act_ConnectByCable.Execute; end; procedure TFSCS_Main.Act_ConnectByCableExecute(Sender: TObject); var i: integer; SavedEndpoint: TFigure; SelList: TList; isEndPointShield, EndPointSameList, SavedFlag: Boolean; TraceList: TList; WasEndPoint: Boolean; WasSaveForUndo: Boolean; function GetAllTraceInCadToEndPoint(aServer, aWS: TConnectorObject): TList; var RaiserThisList: TConnectorObject; RaiserOtherList: TConnectorObject; CurrentWS: TConnectorObject; CurrentServer: TConnectorObject; AllTrace: TList; i, j, k: integer; CurGCadForm: TF_CAD; isTrace: boolean; RaiseType: TConnRaiseType; ListOfLists: TIntList; ListOfRaises: TList; CurrentCAD: TF_CAD; ConnFrom: TConnectorObject; ConnTo: TConnectorObject; PrevConn: TConnectorObject; PrevCAD: TF_CAD; ListOfAllTraces: TList; EndPoint: TConnectorObject; TracesLength: Double; begin ListOfRaises := Nil; ListOfLists := nil; Result := TList.Create; try CurrentServer := aServer; CurrentWS := aWS; BeginProgress('', -1, False); //F_Progress.BringToFront; AllTrace := nil; ListOfAllTraces := nil; TracesLength := 0; GCadForm.FDeselectUpDown := True; // в пределах одного листа if GListWithEndPoint = GCadForm then begin if ((GetKeyState(VK_SHIFT) and 128) = 128) then ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS) else ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS); if ListOfAllTraces.Count > 0 then begin //if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then GCadForm.FTracingListIndex := 0; //Tolik 09/10/2017 -- // AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; //AllTrace := TList.Create; // проверочка -- на всякий -- //if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and // (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then // AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy); // //FreeAndNil(AllTrace); Result.Assign(ListOfAllTraces[0], laCopy); end else // Tolik -- 08/02/2017 -- // GCadForm.FTracingList := TList.Create; begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; // end else if GListWithEndPoint <> nil then begin RaiseType := crt_OnFloor; //#From Oleg# //14.09.2010 // другой лист с КО if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then RaiseType := crt_BetweenFloorDown; if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then RaiseType := crt_BetweenFloorUp; ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID); if ListOfLists.Count >= 2 then begin ListOfRaises := GetSortedListOfRaisesFromCurr(ListOfLists, RaiseType, CurrentWS, CurrentServer); if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then begin PrevCAD := nil; PrevConn := nil; for i := 0 to ListOfLists.Count - 1 do begin CurrentCAD := GetListByID(ListOfLists[i]); // взять найденный м-э с-п if i < ListOfLists.Count - 1 then begin ConnTo := TConnectorObject(ListOfRaises[i]); end else begin ConnTo := CurrentServer; end; CurGCadForm := GCadForm; GCadForm := CurrentCAD; if i = 0 then begin ConnFrom := CurrentWS; end else begin ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage)); end; //ListOfAllTraces := GetAllTraceInCADByMarked(ConnTo, ConnFrom{ConnFrom, ConnTo}); ListOfAllTraces := GetAllTraceInCADByMarked(ConnFrom, ConnTo); if ListOfAllTraces.Count > 0 then begin //if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then // GCadForm.FTracingListIndex := 0; AllTrace := TList.Create; // проверочка -- на всякий -- //if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and // (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then AllTrace.Assign(TList(ListOfAllTraces[0]), laCopy); if AllTrace.Count > 0 then begin GCadForm := CurGCadForm; PrevCAD := CurrentCAD; PrevConn := ConnTo; for j := 0 to AllTrace.Count - 1 do Result.Add(AllTrace[j]); end; FreeAndNil(AllTrace); //Result.Assign(TList(ListOfAllTraces[0]), laCopy); end else begin if GCadForm.FTracingList = nil then GCadForm.FTracingList := TList.Create else GCadForm.FTracingList.Clear; end; end; end; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfRaises <> nil then FreeAndNil(ListOfRaises); end; if ListOfAllTraces <> nil then begin for i := 0 to ListOfAllTraces.Count - 1 do begin if TList(ListOfAllTraces[i]) <> nil then TList(ListOfAllTraces[i]).Free; end; FreeAndNil(ListOfAllTraces); end; EndProgress; RefreshCAD(GCadForm.PCad); GCadForm.FDeselectUpDown := false; except on E: Exception do addExceptionToLogEx('USCS_Main.aSelectTracetoServerExecute', E.Message); end; if Result.Count = 0 then FreeAndNil(Result); end; function CheckCanConnectByCable: Boolean; var i: integer; currFigure: TFigure; figCatalog: TSCSCatalog; FigCompon: TSCSComponent; begin Result := False; if GEndPoint = nil then begin for i := 0 to SelList.Count - 1 do begin currFigure := TFigure(SelList[i]); if currFigure is TConnectorObject then begin if TConnectorObject(currFigure).ConnectorType = ct_NB then begin figCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currFigure.ID); if FigCatalog <> nil then begin figCompon := FigCatalog.GetFirstComponent; if FigCompon <> nil then begin if FigCompon.IDNetType = 3 then if FigCompon.ComponentType.SysName = ctsnShield then begin Result := True; // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; WasSaveForUndo := True; end; SetFigureAsEndObject(GCadForm, currFigure); break; end; end; end; end; end; end; end; //No shield Selected if not Result then Result := EndPointSameList; if not Result then begin for i := 0 to SelList.Count - 1 do begin TraceList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(TFigure(SelList[i]))); if TraceList <> nil then begin Result := True; TraceList.Free; break; end; end; end; end; function checkEndPointShield: Boolean; var SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; begin Result := False; if GEndPoint <> nil then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GEndPoint.ID); if SCSCatalog <> nil then begin SCSCompon := SCSCatalog.GetFirstComponent; if SCSCompon <> nil then if SCSCompon.ComponentType.SysName = ctsnSHIELD then if SCSCompon.IDNetType = 3 then Result := True; end; end; end; function CheckEndPointSameList: boolean; begin Result := False; if GEndPoint <> nil then begin if GEndPoint.Owner <> nil then if GEndPoint.Owner.Owner <> nil then if TF_Cad(GEndPoint.Owner.Owner).FCADListID = GCadForm.FCADListID then Result := True; end; end; Procedure TraceByCable; var Point: TPoint; begin aToolOrthoLine.Execute; //GetCursorPos(Point); //GCadForm.PCad.SimulateDown(GPopupPoint.X, GPopupPoint.Y); //GCadForm.PCad.SimulateUp(GPopupPoint.X, GPopupPoint.Y); GCadForm.PCad.SimulateDown(GPopupFigure.ap1.X, GPopupFigure.ap1.Y); GCadForm.PCad.SimulateUp(GPopupFigure.ap1.X, GPopupFigure.ap1.Y); GFigureTraceTo := nil; {GPrevFigureSnap := nil; GFigureSnap := GPopupFigure;} if GSnapFiguresList.Count > 0 then begin if GSnapFiguresList[0] = nil then GSnapFiguresList[0] := GPopupFigure; end; GPrevFigureSnap := GPopupFigure; GFigureSnap := nil; //GPrevFigureSnap := GPopupFigure; //GFigureSnap := GPopupFigure; //GPrevFigureSnap := TFigure(GCadForm.PCad.Selection[0]); {GPrevFigureSnap := nil; // GFigureSnap := TFigure(SelList[0]);//TFigure(GCadForm.PCad.Selection[0]); GFigureSnap := GPopupFigure;} //GPrevFigureSnap := GPopupFigure; //GFigureSnap := nil; //GPrevFigureSnap := nil; //GFigureSnap := GPopupFigure; end; begin WasEndPoint := GEndPoint <> nil; WasSaveForUndo := False; GFigureTraceTo := nil; GFigureSnap := nil; GPrevFigureSnap := nil; GCadForm.cbManualCableTracingMode.Down := True; GAutoAddCableAfterDragDrop := true; if GCadForm.PCad.Selection.Count > 1 then begin SelList := TList.Create; isEndPointShield := checkEndPointShield; EndPointSameList := False; //if isEndPointShield then EndPointSameList := CheckEndPointSameList; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin if TFigure(GCadForm.FSCSFigures[i]).Selected then if TFigure(GCadForm.FSCSFigures[i]) is TConnectorObject then if TConnectorObject(GCadForm.FSCSFigures[i]).ConnectorType = ct_NB then if SelList.IndexOf(TFigure(GCadForm.FSCSFigures[i])) = -1 then SelList.Add(TFigure(GCadForm.FSCSFigures[i])); end; if EndPointSameList then GEndPoint.Select; if GCadForm.PCad.Selection.IndexOf(GEndPoint) = -1 then GCadForm.PCad.Selection.Add(GEndPoint); if CheckCanConnectByCable then begin Act_ConnectSelectedPoints.Execute; for i := 0 to SelList.Count - 1 do begin TFigure(SelList[i]).Select; if GCadForm.PCad.Selection.IndexOf(TFigure(SelList[i])) = -1 then GCadForm.PCad.Selection.Add(TFigure(SelList[i])); end; SavedEndpoint := GEndPoint; SavedFlag := GCallAutoTraceElectricMaster; GCallAutoTraceElectricMaster := True; try TF_MAIN(F_NormBase).Act_AutoTraceByRayModeExecute(nil); except on E: Exception do; end; {if not GCallAutoTraceElectricMaster then GCadForm.SCSUndoNormalList;} GCallAutoTraceElectricMaster := SavedFlag; if GEndPoint <> nil then begin if not WasEndPoint then begin TConnectorObject(GEndPoint).AsEndPoint := False; GEndPoint := Nil; GListWithEndPoint := Nil; end; end; GCadForm.PCad.Refresh; end else TraceByCable; end else // IF Only one Selected - Draw By Cable TraceByCable; if WasSaveForUndo then GCadForm.FCanSaveForUndo := True; GCadForm.PCad.DeselectAll(2); end; procedure TFSCS_Main.Act_ConnectByCableOnEndsExecute(Sender: TObject); begin GConnectEndPoints := True; GDropPcadTool := True; Act_ConnectByCable.Execute; end; //Tolik // соединить выбранные точечные трассами Procedure TFSCS_Main.Act_ConnectSelectedPointsExecute(Sender: TObject); Var i,j,k, currIndex: Integer; FiguresList, FiguresPassedList, ThisPointFigures, BeforePointFigures: TList; ListCad: TF_CAD; ConnectedLine: TSCSComponent; Figure1, Figure2, currFigure: Tfigure; LineLength: double; x,y,z : Double; Trace: TOrtholine; TraceList: TList; DirectionUP: boolean; ThisPointFiguresPassed: TList; currLength: double; isVerticalCreated: Boolean; //Tolik -- 27/02/2017 -- UserQuotaReached_Message: String; ObjCounter : Integer; OldCadFigCounter: Integer; GCadFlag: Boolean; ConnectFigure1, ConnectFigure2: TConnectorObject; // Procedure FindAllNearestFigures(Figure: TFigure); Var i: Integer; WasChanged: Boolean; currFigure, tmpFigure: TConnectorObject; Begin ThisPointFigures.Clear; //формируем список for i := 0 to FiguresList.Count - 1 do begin if TConnectorObject(Figure).ID <> TConnectorObject(FiguresList[i]).ID then begin if ( ((TConnectorObject(Figure).ActualPoints[1].x = TConnectorObject(FiguresList[i]).ActualPoints[1].x) and (TConnectorObject(Figure).ActualPoints[1].y = TConnectorObject(FiguresList[i]).ActualPoints[1].y)) or ((abs(TConnectorObject(Figure).ActualPoints[1].x - TConnectorObject(FiguresList[i]).ActualPoints[1].x) < 3) and (abs(TConnectorObject(Figure).ActualPoints[1].y - TConnectorObject(FiguresList[i]).ActualPoints[1].y) < 3)) ) then ThisPointFigures.Add(FiguresList[i]); end; end; ThisPointFigures.Add(Figure); if ThisPointFigures.Count = 1 then ThisPointFigures.Clear; if ThisPointFigures.Count > 1 then begin // сортируем по высоте размещения WasChanged := true; while WasChanged do begin WasChanged := false; for i := 0 to ThisPointFigures.Count - 2 do begin if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] > TConnectorObject(ThisPointFigures[i+1]).ActualZOrder[1] then begin WasChanged := true; currFigure := TConnectorObject(ThisPointFigures[i]); ThisPointFigures[i] := ThisPointFigures[i+1]; ThisPointFigures[i+1] := currFigure; end; end; end; end; End; Procedure SortFigures(Figure: Tfigure); Var currFigure: TFigure; currIndex, i: integer; WasChange: Boolean; currLength: double; Begin WasChange := true; while WasChange do begin WasChange := false; currFigure := ThisPointFigures[0]; currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(currFigure).ActualPoints[1]); // верхние for i := 1 to ThisPointFigures.Count - 1 do begin if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] <> TConnectorObject(currFigure).ActualZOrder[1] then break else begin if currLength < GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]) then begin WasChange := true; currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]); currFigure := ThisPointFigures[i - 1]; ThisPointFigures[i - 1] := ThisPointFigures[i]; ThisPointFigures[i] := currFigure; end; end; end; end; // нижние while WasChange do begin WasChange := false; currFigure := ThisPointFigures[ThisPointFigures.Count - 1]; currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(currFigure).ActualPoints[1]); for i := (ThisPointFigures.Count - 2) downto 0 do begin if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] <> TConnectorObject(currFigure).ActualZOrder[1] then break else begin if currLength < GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]) then begin WasChange := true; currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]); currFigure := ThisPointFigures[i + 1]; ThisPointFigures[i + 1] := ThisPointFigures[i]; ThisPointFigures[i] := currFigure; end; end; end; end; End; // выставляет фигуру в начало или в конец списка Procedure PointToZeroPosition(Figure: TFigure; var FigList: Tlist); Var currIndex: Integer; Begin if FigList.Count > 2 then begin if FigList.IndexOf(Figure) <> -1 then begin currIndex := FigList.IndexOf(Figure); if ((currIndex <> 0) or (currIndex <> FigList.Count - 1)) then begin FigList.Delete(FigList.IndexOf(Figure)); if TConnectorObject(Figure).ActualZOrder[1] <= TConnectorObject(FigList[0]).ActualZOrder[1] then FigList.Insert(0, Figure) else FigList.Add(Figure); end; end; end; End; // ищет ближайшую точку к точечной фигуре (из выбранных) Function FindNearestFigure(Figure: TFigure): TFigure; Var Figure1_, Figure2_: TFigure; Dist, Dist1: double; LineLen : double; currIndex: integer; currFigure: TFigure; Function FindNearest(Figure: TFigure; var Dist: double): TFigure; Var i: Integer; LineLenght: double; PointFigures1, PointFigures2: TList; Begin PointFigures1 := nil; PointFigures2 := nil; Dist := -1; Result := nil; // если начальная фигура одна // if ThisPointFigures.Count = 0 then begin for i := 0 to FiguresList.Count - 1 do begin if FiguresPassedList.IndexOf(FiguresList[i]) = -1 then begin if TConnectorObject(Figure).ID <> TConnectorObject(FiguresList[i]).ID then // if Figure <> FiguresList[i] then begin LineLenght := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(FiguresList[i]).ActualPoints[1]); if ((dist > LineLenght) or (dist = -1)) then begin dist := LineLenght; Result := FiguresList[i]; if Dist = 0 then // сидят в одной точке break; end; end; end; end; end End; Begin Figure1_ := nil; // Tolik 05/08/2021 -- Figure2_ := nil; // Tolik 05/08/2021 -- if BeforePointFigures.Count = 0 then Result := FindNearest(Figure1, Dist) else begin Figure1_ := FindNearest(BeforePointFigures[0], Dist); Figure2_ := FindNearest(BeforePointFigures[BeforePointFigures.Count - 1], Dist1); Result := Figure1_; if (Figure2_ <> nil) and (Result <> nil) then // Tolik 05/08/2021 -- begin if ((TConnectorObject(Result).ID <> TConnectorObject(Figure2_).ID) and (Dist1 < Dist)) then Result := Figure2_; end else begin // Tolik 05/08/2021 -- if Result = nil then begin if Figure2_ <> nil then Result := Figure2_; end; end; end; // определяем ближайшие в данной точке (если есть в пределах допустимого) if Result = nil then begin ThisPointFigures.Clear; exit; end; FindAllNearestFigures(Result); // определяем ближайшие точки для подключения трассой (самый короткий путь) // 1. Если подключаем две "кучки" if (BeforePointFigures.Count > 0) and (ThisPointFigures.Count > 0) then begin Figure1 := BeforePointFigures[0]; Figure2 := ThisPointFigures[0]; // самый короткий путь от низа первой "кучки" до второй (из двух - к низу и верху второй "кучки") LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(ThisPointFigures[0]).ActualPoints[1]); Dist := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1]); if LineLen > Dist then begin Result := ThisPointFigures[ThisPointFigures.Count - 1]; PointToZeroPosition(Result, ThisPointFigures); end else Dist := LineLen; // смотрим вверху LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(ThisPointFigures[0]).ActualPoints[1]); Dist1 := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1]); if ((LineLen < Dist) and (LineLen <= Dist1)) then begin Figure1 := BeforePointFigures[BeforePointFigures.Count - 1]; Result := ThisPointFigures[0]; PointToZeroPosition(Result, ThisPointFigures); end else begin if ((Dist1 < Dist) and (Dist1 < LineLen)) then begin Figure1 := BeforePointFigures[BeforePointFigures.Count - 1]; Result := ThisPointFigures[ThisPointFigures.Count - 1]; PointToZeroPosition(Result, ThisPointFigures); end; end; end; // 2. Впереди "кучка", подключаемся к точечному if ((BeforePointFigures.Count > 0) and (ThisPointFigures.Count = 0)) then begin Figure1 := BeforePointFigures[0]; if Figure2 <> nil then // Tolik 05/08/2021 -- begin LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(Figure2).ActualPoints[1]); Dist := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure2).ActualPoints[1]); if LineLen > Dist then Figure1 := BeforePointFigures[BeforePointFigures.Count - 1]; end; end; // 3. Один точечный подключаем к "кучке" if ((BeforePointFigures.Count = 0) and (ThisPointFigures.Count > 0)) then begin Result := ThisPointFigures[0]; LineLen := GetLineLenght(TConnectorObject(ThisPointFigures[0]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]); Dist := GetLineLenght(TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]); if LineLen > Dist then Result := ThisPointFigures[ThisPointFigures.Count - 1]; PointToZeroPosition(Result, ThisPointFigures); end; End; // возвращает начальную точечную фигуру из выбранных (ближе всего к началу координат) Function FindBeginFigure : TFigure; Var i : Integer; Begin Result := FiguresList[0]; for i := 1 to FiguresList.Count - 1 do begin if sqrt(sqr(TConnectorObject(Result).ActualPoints[1].x)+ sqr(TConnectorObject(Result).ActualPoints[1].y)+ sqr(TConnectorObject(Result).ActualZOrder[1])) > sqrt(sqr(TConnectorObject(FiguresList[i]).ActualPoints[1].x)+ sqr(TConnectorObject(FiguresList[i]).ActualPoints[1].y)+ sqr(TConnectorObject(FiguresList[i]).ActualZOrder[1])) then Result := FiguresList[i]; end; End; { // Для двух точечных проверяем, не сидят ли в одной точке (x,y - одинаковые) Function CheckTheSamePoint(Figure1, Figure2: TFigure): Boolean; Begin Result := false; if (TConnectorObject(Figure1).ActualPoints[1].x = TConnectorObject(Figure2).ActualPoints[1].x) and (TConnectorObject(Figure1).ActualPoints[1].y = TConnectorObject(Figure2).ActualPoints[1].y) then Result := true; End;} //вертикальная трасса между двумя точечными Procedure CreateVertTraceBetweenTwoPoints(Figure1, Figure2: TConnectorObject); Var VertOnFigure: TConnectorObject; VertHeight: Double; Begin try VertOnFigure := Figure1; if Figure2 <> nil then begin VertHeight := TConnectorObject(Figure2).ActualZOrder[1];//(abs(TConnectorObject(Figure1).ActualZOrder[1] - TConnectorObject(Figure2).ActualZOrder[1])); VertHeight := UOMToMetre(VertHeight); { if VertHeight > GCadForm.FRoomHeight then VertHeight := GCadForm.FRoomHeight;} CreateVerticalOnTwoPointObjects(TConnectorObject(Figure1), TConnectorObject(Figure2), VertHeight); // CreateVerticalOnPointObject(VertOnFigure, Figure2, VertHeight); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); isVerticalCreated := True; end else GCadForm.mProtocol.Lines.Add(cMain_Mes128); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.CreateVertTraceBetweenTwoPoints', E.Message); end; End; Function CheckIsRaiseOrVLine(aConn: TConnectorObject): Boolean; var i, j: Integer; Joinedconn: TConnectorObject; begin Result := False; if aConn.ConnectorType = ct_Clear then begin for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do begin if (TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsRaiseUpDown or TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsVertical) then begin Result := True; exit; end; end; end else begin for i := 0 to aConn.JoinedconnectorsList.Count - 1 do begin JoinedConn := TconnectorObject(aConn.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do begin if (TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]).FIsVertical or TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]).FIsRaiseUpDown) then begin Result := True; exit; end; end; end; end; end; Function DrawOneTrace(Figure1, Figure2: TFigure; AddResult: Boolean = true): TFigure; var Catalog1, Catalog2: TSCSCatalog; CanNotDrawTraceOnConn1, CanNotDrawTraceOnConn2: Boolean; ClearConn: TConnectorObject; LHandle: integer; RaiseLine: TOrthoLine; i, j: Integer; Old_Flag: Boolean; Begin Result := nil; if (Figure1 = nil) or (Figure2 = nil) then exit; // проверяем, нет ли между ними трассы TraceList := GetAllTraceInCAD(Figure1, Figure2); // если трассы нет, то нарисуем if TraceList = nil then begin //08/11/2019 -- проверяем на использование вертикальных трасс if GUseVerticalTraces = False then begin // если запрещены вертикальные трассы и хоть на одном из них есть райз -- может // быть трабла, нужно проверить попадание // ОБЯЗАТЕЛЬНО берем во внимание, что трассы создаются на уровне создания трасс (в настройках Када) CanNotDrawTraceOnConn1 := CheckCanDrawOneTrace(TConnectorObject(Figure1)); CanNotDrawTraceOnConn2 := CheckCanDrawOneTrace(TConnectorObject(Figure2)); //если нельзя проложить трассу .... if (CanNotDrawTraceOnConn1 or CanNotDrawTraceOnConn2) then begin try old_Flag := GCadForm.FAutoPosTraceBetweenRM; GCadForm.FAutoPosTraceBetweenRM := True; Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True); GCadForm.FAutoPosTraceBetweenRM := Old_Flag; except on E: Exception do GCadForm.FAutoPosTraceBetweenRM := Old_Flag; end; (*if CanNotDrawTraceOnConn1 then begin if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1); Result := Figure2; end else begin if FiguresPassedList.IndexOf(Figure2) = -1 then FiguresPassedList.Add(Figure2); Result := Figure1; end; // ... занести в протокол, что трасса между этими объектами не была проведена, по причине того, что //в настройках программы выключена опция использования вертикальных трасс Catalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure1.ID); Catalog2 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure2.ID); if Catalog1 <> nil then if Catalog2 <> nil then GCadForm.mProtocol.Lines.Add(CantConnMess1 + Catalog1.GetNameForVisible(false) + CantConnMess2 + Catalog2.GetNameForVisible(false) + CantConnMess4); *) Result := Figure2; exit; end; end; // рисуем трассу // если не сидят в одной точке if not CheckTheSamePoint(Figure1, Figure2) then begin //Trace := CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True, False) Trace := CreateTraceByPoints(GCadForm.PCad, TConnectorObject(Figure1).AP1, TConnectorObject(Figure2).AP2); if TConnectorObject(Figure1).ConnectorType = ct_Clear then CheckingSnapConnectorToConnector(TConnectorObject(Figure1), TConnectorObject(Trace.JoinConnector1)) else CheckingSnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector1), TConnectorObject(Figure1), False); if TConnectorObject(Figure2).ConnectorType = ct_Clear then CheckingSnapConnectorToConnector(TConnectorObject(Figure2), TConnectorObject(Trace.JoinConnector2)) else CheckingSnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector2), TConnectorObject(Figure2), False); end else begin // если точечные сидят в одной точке, // разрешено использование вертикальных линий и высота размещения разная if ( (TConnectorObject(Figure1).ActualZOrder[1] <> TConnectorObject(Figure2).ActualZOrder[1]) and (GUseVerticalTraces = true) ) then // рисуем вертикальную трассу CreateVertTraceBetweenTwoPoints(TConnectorObject(Figure1),TConnectorObject(Figure2)) else begin // не сидят точно в одной точке, не разрешено использование вертикальных линий(или разрешено, // но высота размещения объектов - одинаковая или включена опция, разрешающая размещение трассы // на высоте рабочих мест) - рисуем простую трассу if (CompareValue(TConnectorObject(Figure1).ActualZOrder[1], TConnectorObject(Figure2).ActualZOrder[1]) = 0) then Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True) else // райз begin if (CheckIsRaiseOrVLine(TConnectorObject(Figure1)) or CheckIsRaiseOrVLine(TConnectorObject(Figure2))) then begin try old_Flag := GCadForm.FAutoPosTraceBetweenRM; GCadForm.FAutoPosTraceBetweenRM := True; Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True); GCadForm.FAutoPosTraceBetweenRM := Old_Flag; except on E: Exception do GCadForm.FAutoPosTraceBetweenRM := Old_Flag; end; //Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True) end else begin LHandle := GCadForm.PCad.GetLayerHandle(2); CreateRaiseOnPointObjectNew(TConnectorObject(Figure1), TConnectorObject(Figure2).ActualZOrder[1]); RaiseLine := Nil; ClearConn := Nil; for i := 0 to TConnectorObject(Figure1).JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList[j]); if RaiseLine.JoinConnector1.ID = TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).Id then ClearConn := TConnectorObject(RaiseLine.JoinConnector2) else ClearConn := TconnectorObject(RaiseLine.JoinConnector1); end; end; end; if ClearConn <> nil then CheckingSnapConnectorToPointObject(ClearConn, TConnectorObject(Figure2), False); end; end; end; end; end else begin {if TraceList.count > 0 then begin for i := 0 to TraceList.count - 1 do begin TList(TraceList[i]).Free; TraceList[i] := Nil; end; end;} // 03/08/2018 -- Catalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure1.ID); Catalog2 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure2.ID); if Catalog1 <> nil then if Catalog2 <> nil then GCadForm.mProtocol.Lines.Add(CantConnMess1 + Catalog1.GetNameForVisible(false) + CantConnMess2 + Catalog2.GetNameForVisible(false) + CantConnMess3); // FreeAndNil(TraceList); end; if addResult then begin if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1); Result := Figure2; end; End; // 25/04/2016 -- преобразование С/П в вертикаль procedure CheckConvertRaiseToVertLine(aList: TList); var i, j, k: Integer; Conn, ConnectedConn: TConnectorObject; Figure: TFigure; RaiseLine, vLine: TOrthoLine; CanBreak: Boolean; begin CanBreak := False; for i := 0 to aList.Count - 1 do begin Figure := TFigure(aList[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then begin Conn := TConnectorObject(Figure); RaiseLine := Nil; vLine := Nil; if Conn.ConnectorType = ct_NB then begin for j := 0 to Conn.JoinedConnectorsList.Count - 1 do begin ConnectedConn := TConnectorObject(Conn.JoinedConnectorsList[j]); for k := 0 to ConnectedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]).FIsRaiseUpDown then RaiseLine := TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]) else if TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]).FIsVertical then vLine := TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]); end; end; end else if Conn.ConnectorType = ct_Clear then begin for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsRaiseUpDown then RaiseLine := TOrthoLine(Conn.JoinedOrtholinesList[j]) else if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsVertical then vLine := TOrthoLine(Conn.JoinedOrtholinesList[j]); end; end; end; if RaiseLine <> nil then if vLine <> nil then ConvertRaiseToVertical(RaiseLine); end; end; // попытаться найти подходящий коннектор для соединения трассами function GetPointToConnectFromList(aList: TList; aConn: TConnectorObject): TConnectorObject; var i: Integer; PointList: TList; NextConn: TConnectorObject; Procedure GetLinesFromPoint(aPoint: TConnectorObject; var aRaiseLine, avLine1, avLine2: TOrthoLine); var JoinedConn: TConnectorObject; j, k: Integer; begin if aPoint.ConnectorType = ct_NB then begin JoinedConn := nil; for j := 0 to aPoint.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(aPoint.JoinedConnectorsList[j]); for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).FIsRaiseUpDown then aRaiseLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]) else if TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).FIsVertical then begin if avLine1 = nil then avLine1 := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]) else avLine2 := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]); end; end; end; end else if aPoint.ConnectorType = ct_Clear then begin for j := 0 to aPoint.JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(aPoint.JoinedOrtholinesList[j]).FIsRaiseUpDown then aRaiseLine := TOrthoLine(aPoint.JoinedOrtholinesList[j]) else if TOrthoLine(aPoint.JoinedOrtholinesList[j]).FIsVertical then begin if avLine1 = nil then avLine1 := TOrthoLine(aPoint.JoinedOrtholinesList[j]) else avLine2 := TOrthoLine(aPoint.JoinedOrtholinesList[j]); end; end; end; end; Procedure GetConnList(aConn: TConnectorObject); var i: Integer; RaiseLine, vLine1, vLine2: TOrthoLine; currConn: TConnectorObject; begin RaiseLine := nil; vLine1 := Nil; vLine2 := Nil; if PointList.IndexOf(aConn) = -1 then begin PointList.Add(aConn); GetLinesFromPoint(aConn, RaiseLine, vLine1, vLine2); if RaiseLine <> nil then begin CurrConn := TConnectorObject(RaiseLine.JoinConnector1); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; CurrConn := TConnectorObject(RaiseLine.JoinConnector2); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; end; if vLine1 <> nil then begin CurrConn := TConnectorObject(vLine1.JoinConnector1); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; CurrConn := TConnectorObject(vLine1.JoinConnector2); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; end; if vLine2 <> nil then begin CurrConn := TConnectorObject(vLine2.JoinConnector1); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; CurrConn := TConnectorObject(vLine2.JoinConnector2); if currConn <> nil then begin if CurrConn.JoinedConnectorsList.Count > 0 then CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]); if PointList.IndexOf(currConn) = -1 then begin GetConnList(currConn); end; end; end; end; end; Procedure SortPointList(aList: TList); Var i: Integer; CanSort: Boolean; currConn: TConnectorObject; begin CanSort := true; while CanSort do begin CanSort := False; for i := 0 to aList.Count - 2 do begin if CompareValue(ABS(TConnectorObject(aList[i]).ActualZOrder[1] - GCadForm.FLineHeight), ABS(TConnectorObject(aList[i+1]).ActualZOrder[1] - GCadForm.FLineHeight)) = 1 then begin currConn := TConnectorObject(aList[i]); aList[i] := AList[i + 1]; aList[i + 1] := currConn; CanSort := True; end; end; end; end; begin // если коннектор - на высоте автоматического расположения трасс -- берем его Result := nil; PointList := TList.Create; if aList <> nil then begin //определяем все возможные коннекторы в этой точке для коннекта for i := 0 to aList.Count - 1 do begin NextConn := TConnectorObject(aList[i]); if NextConn.ConnectorType = ct_Clear then if NextConn.JoinedConnectorsList.Count > 0 then NextConn := TConnectorObject(NextConn.JoinedConnectorsList[0]); if PointList.IndexOf(NextConn) = -1 then GetConnList(NextConn); end; end else GetConnList(aConn); // проверяем если есть коннектор(по высоте) - ура for i := 0 to PointList.Count - 1 do begin if CompareValue(TConnectorObject(PointList[i]).ActualZOrder[1], GCadForm.FLineHeight) = 0 then begin Result := TConnectorObject(PointList[i]); break; end; end; //на коннекторы не попадем if Result = nil then begin SortPointList(PointList); // сортировка списка по расстоянию от высоты расположения трасс //if (GCadForm.FAutoPosTraceBetweenRM or GUseVerticalTraces) then // если включена опция располагать трассу на высоте рабочих мест // или допустимо использование вертикальных трасс -- begin for i := 0 to PointList.Count - 1 do begin if TConnectorObject(PointList[i]).ConnectorType = ct_NB then begin Result := TConnectorObject(PointList[i]); // ближайший к высоте расположения(автосоздания) трасс на Каде break; end; end; end; end; PointList.free; end; Begin if GDropComponent <> nil then begin if isCableComponent(GDropComponent) then begin if GEndPoint <> nil then begin if GCadForm.PCad.Selection.IndexOf(GEndPoint) = -1 then begin GEndPoint.Selected := True; GCadForm.PCad.Selection.Add(GEndPoint); end; end; end; end; GCadFlag := GCanRefreshCad; ProcessMessagesEx; BeginProgress; Figure1 := nil; // Tolik 05/08/2021 -- Figure2 := nil; // Tolik 05/08/2021 -- try if GUserOBjectsQuotaLimit_Message_Counter >= 3 then Exit; UserQuotaReached_Message := ''; ObjCounter := 0; OldCadFigCounter := GCadForm.FSCSFigures.Count; // если выбрано более 2-х точечных на каде if GCADForm.PCad.Selection.Count > 1 then begin // UNDO if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; UserQuotaReached_Message := ''; UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(1), cMess_Quota); if UserQuotaReached_Message = '' then begin // Tolik -- 28/02/2017 -- чтобы не вылез PCadGuiEVENT GCanRefreshCad := False; // FiguresPassedList := TList.Create; FiguresList := TList.Create; ThisPointFigures := TList.Create; ThisPointFiguresPassed := TList.Create; BeforePointFigures := TList.Create; isVerticalCreated := False; // если создана вертикаль //собираем выбранные фигуры в список for i := 0 to GCADForm.PCad.Selection.Count - 1 do begin currFigure := TFigure(GCADForm.PCad.Selection[i]); if CheckFigureByClassName(currFigure, cTConnectorObject) then // если точечный - не пустой коннектор(просто пустой, конечный коннетор трассы и т.п.) или не коннектор магистрали, if (TConnectorObject(currFigure).ConnectorType = ct_NB) and (TConnectorObject(currFigure).FTrunkName = '') then // то добавляем в список точечных FiguresList.Add(GCADForm.PCad.Selection[i]); end; // Если точки всего две, то нет ничего проще if FiguresList.Count = 2 then begin // первая Figure1 := FiguresList[0]; // вторая Figure2 := FiguresList[1]; // трасса Figure2 := DrawOneTrace(Figure1, Figure2); end; // Если точек больше двух If FiguresList.Count > 2 then begin try // ищем точку ближе всего к началу координат (от нее начнем) Figure1 := FindBeginFigure; ThisPointFigures.Clear; // на всякий // все приближенные к ней из выбранных FindAllNearestFigures(Figure1); // если в этой точке есть еще точечные (или приблизительно в одной) // подключаем их между собой снизу вверх подряд if ThisPointFigures.Count <> 0 then begin Figure1 := ThisPointFigures[0]; for i := 1 to ThisPointFigures.Count - 1 do begin Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]); if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1); end; Figure1 := ThisPointFigures[0]; end; while FiguresPassedList.Count < FiguresList.Count do begin if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1); BeforePointFigures.Clear; // если идем от кучки, то сохраним ее if ThisPointFigures.Count > 0 then begin for i := 0 to ThisPointFigures.Count - 1 do BeforePointFigures.Add(ThisPointFigures[i]); end; Figure2 := FindNearestFigure(Figure1); // ближайшая точка к текущей, на которой стоим (из выбранных) if Figure2 = nil then break; // все приблизительно в одной точке со второй фигурой // заодно скорректируется и первая в зависимости от минимальной дистанции подключения FindAllNearestFigures(Figure2); // если в этой точке есть еще точечные (или приблизительно в одной) // подключаем их между собой снизу вверх подряд if ThisPointFigures.Count <> 0 then begin Figure2 := ThisPointFigures[0]; for i := 1 to ThisPointFigures.Count - 1 do begin Figure2 := DrawOneTrace(Figure2, ThisPointFigures[i]); if FiguresPassedList.IndexOf(Figure2) = -1 then FiguresPassedList.Add(Figure2); end; // Здесь Figure2 -- самая высокая точка Figure2 := ThisPointFigures[0]; // спрыгиваем вниз end; // получаем точки соединения if BeforePointFigures.Count = 0 then ConnectFigure1 := GetPointToConnectFromList(nil, TConnectorObject(Figure1)) else ConnectFigure1 := GetPointToConnectFromList(BeforePointFigures, nil); if ThisPointFigures.Count = 0 then ConnectFigure2 := GetPointToConnectFromList(nil, TConnectorObject(Figure2)) else ConnectFigure2 := GetPointToConnectFromList(ThisPointFigures, nil); DrawOneTrace(ConnectFigure1, ConnectFigure2, False); // результат здесь неинтересен, т.к. точки могут быть и не те... // переходим на следующую фигуру if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1); Figure1 := Figure2; // если подключаем одну точку (*if ThisPointFigures.Count = 0 then begin Figure1 := DrawOneTrace(Figure1,Figure2); end else // если подключаем "кучку" begin // SortFigures(Figure1); //Figure2 := ThisPointFigures[0]; DirectionUp := true; // соединять точки в "кучке" снизу вверх { if (TConnectorObject(ThisPointFigures[0]).ActualZOrder[1] <> TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualZOrder[1]) then begin if GetLineLenght(TConnectorObject(ThisPointFigures[0]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]) > GetLineLenght(TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]) then begin Figure2 := ThisPointFigures[ThisPointFigures.Count - 1]; DirectionUp := false; // соединять точки в "кучке" сверху вниз end end;} if Figure2 <> ThisPointFigures[0] then DirectionUP := false; Figure1 := DrawOneTrace(Figure1, Figure2); // здесь в фигура 1 - уже начальная точка "кучки" // идем по "кучке" снизу вверх if DirectionUP then begin for i := 1 to ThisPointFigures.Count - 1 do begin Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]) // figure1 = Figure2 и трасса проложена end; end // идем по кучке сверху вниз else begin for i := (ThisPointFigures.Count - 2) downto 0 do begin Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]) // figure1 = Figure2 и трасса проложена end; end; end; *) {if FiguresPassedList.IndexOf(Figure1) = -1 then FiguresPassedList.Add(Figure1);} // Tolik -- 28/02/2017 -*- проверка на превышение квоты объектов USER ObjCounter := GCadForm.FSCSFigures.Count - OldCadFigCounter; if ObjCounter > 49 then begin UserQuotaReached_Message := ''; UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(1),cMess_Quota); if UserQuotaReached_Message <> '' then begin PauseProgress(True); Showmessage(UserQuotaReached_Message); PauseProgress(False); Break; //// BREAK ////; end else OldCadFigCounter := GCadForm.FSCSFigures.Count; end; end; // end while except on E: exception do AddExceptionToLogEX('TFSCS_Main.Act_ConnectSelectedPointsExecute', E.Message); end; end; // если создана вертикаль, нужно пересмотреть список точечных и, если на них попадется С/П - // то преобразовать его в вертикаль if isVerticalCreated then CheckConvertRaiseToVertLine(FiguresList); if FiguresList <> nil then FreeAndNil(FiguresList); if FiguresPassedList <> nil then FreeAndNil(FiguresPassedList); FreeAndNil(ThisPointFigures); FreeAndNil(ThisPointFiguresPassed); FreeAndNil(BeforePointFigures); // FreeAndNil(TraceList); // разрешить UNDO end else ShowMessage(UserQuotaReached_Message); GCadForm.FCanSaveForUndo := True; end; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.Act_ConnectSelectedPointsExecute', E.Message); end; EndProgress; GCanRefreshCad := GCadFlag; GCadForm.PCad.Refresh; End; //Tolik 17/08/2021 -- procedure TFSCS_Main.Act_ConnectToAnotherRackExecute(Sender: TObject); var SavedEndPoint : Tfigure; begin GRackToRack := True; SavedEndPoint := nil; //EndPoint if GEndPoint <> nil then begin SavedEndPoint := GEndPoint; try if CheckFigureByClassName(GEndPoint, cTConnectorObject) then TConnectorObject(GEndPoint).AsEndPoint := False else if CheckFigureByClassName(GEndPoint, cTHouse) then THouse(GEndPoint).AsEndPoint := False; if (GListWithEndPoint <> GCadForm) and (GListWithEndPoint <> nil) then begin RefreshCAD(GListWithEndPoint.PCad); RefreshCAD(GListWithEndPoint.PCad); end else RefreshCAD(GCadForm.PCad); GListWithEndPoint := Nil; GEndPoint := nil; except on E: Exception do addExceptionToLogEx('Act_ConnectToAnotherRackExecute(Drop EndPoint): ', E.Message); end; end; try F_NormBase.Act_AutoTraceCableExecute(nil); except on E: Exception do addExceptionToLogEx('Act_ConnectToAnotherRackExecute: ', E.Message); end; GRackToRack := True; if SavedEndPoint <> nil then SetFigureAsEndObject(GCadForm, SavedEndPoint); end; // procedure TFSCS_Main.Act_ReindexMasterExecute(Sender: TObject); var aCad: TF_CAD; begin if not Assigned(F_ReindexMaster) then Application.CreateForm(TF_ReindexMaster, F_ReindexMaster); F_ReindexMaster.ShowModal; end; // Tolik procedure TFSCS_Main.Act_SelectCableToTraceExecute(Sender: TObject); // Tolik 24/03/2021 -- выбрать кабель в НБ для трассировки (электрика) begin if GSelNodeColor = -1 then begin GSelNodeColor := clRed; try F_NormBase.FindComponentByGUIDWithBlink('{0D22B88D-6739-4A5D-A2D8-E1DA74EEBF5F}'); Except on E: Exception do; end; GSelNodeColor := -1; end; end; procedure TFSCS_Main.Act_SelectFiberCableToTraceExecute(Sender: TObject); begin if GSelNodeColor = -1 then begin GSelNodeColor := clRed; try {$if defined(SCS_PE)} F_NormBase.FindComponentByGUIDWithBlink('{15A46B67-2A90-4459-8130-E04D752DCF54}'); {$ELSE} F_NormBase.FindComponentByGUIDWithBlink('{2C158417-0736-42D4-9EDD-E638C4305391}'); {$IFEND} Except on E: Exception do; end; GSelNodeColor := -1; end; end; procedure TFSCS_Main.Act_SetAsEndObjectExecute(Sender: TObject); begin SetFigureAsEndObject(GCadForm, GPopupFigure); end; // procedure Select_clearConnectors; var i, j: Integer; currList: TSCSList; aCAd: TF_CAD; ConnList: TList; Figure: TFigure; currCatalog : TSCSCatalog; Function GetEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList; var j: Integer; conn1: TConnectorObject; begin Result := TList.Create; if ((acurrList <> nil) and (CadList <> nil)) then begin for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do begin currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]); if currCatalog <> nil then begin Figure := GetFigureByID(CADList, currCatalog.SCSID); if Figure <> nil then begin if CheckFigureByClassName(Figure, cTConnectorObject) then begin Conn1 := TConnectorObject(Figure); if ((Conn1.ConnectorType = ct_Clear) and (TConnectorObject(Conn1).JoinedConnectorsList.Count = 0) and (TConnectorObject(Conn1).JoinedFigures.Count = 0) and (TConnectorObject(Conn1).JoinedOrtholinesList.Count = 0) and (TConnectorObject(Conn1).FIsHouseJoined = false) and (Length(TConnectorObject(Conn1).FJoinedConnectorsIndexes) = 0) and ((TConnectorOBject(Conn1).FConnFullness = cif_Empty) or (TConnectorOBject(Conn1).FConnFullness = cif_None)) ) then Result.Add(Conn1); end; end; end; end; end; end; Begin currList := F_ProjMan.GSCSBase.CurrProject.CurrList; if currList <> nil then begin aCad := GetListByID(currList.SCSID); if aCad <> nil then begin ConnList := GetEmptyConnectorsList(currList, aCad); if ConnList.Count > 0 then begin aCad.PCad.SelectFigures(ConnList); aCad.PCad.FAnySelected := True; aCAd.PCad.ReDrawSelection; aCAd.PCad.SyncEnv; // RefreshCAD(aCAd.PCad); end; ConnList.Free; end; end; End; procedure TFSCS_Main.aSetLeftRightDoorExecute(Sender: TObject); var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.DoorIndex = -1 then exit; if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight then begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight := False; GArchEngine.SetLastObjParam(aoskPathDoorLeftRight,'FALSE'); end else begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight := True; GArchEngine.SetLastObjParam(aoskPathDoorLeftRight,'TRUE'); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message); end; end; Function PointNear3D(p1,p2: TDoublePoint; ZCoord1, ZCoord2: Double; delta: Double=1):Boolean; var pp1, pp2: Double; begin pp1 := ZCoord1; pp2 := ZCoord2; //result := (abs(p1.x - p2.x) <= 1) and (abs(p1.y - p2.y) <= 1); result := (abs(p1.x - p2.x) <= delta) and (abs(p1.y - p2.y) <= delta) and (abs(ZCoord1 - ZCoord2) <= delta); end; procedure TFSCS_Main.aSetMirroredDoorExecute(Sender: TObject); var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.DoorIndex = -1 then exit; if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored then begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored := False; GArchEngine.SetLastObjParam(aoskPathDoorMirrored,'FALSE'); end else begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored := True; GArchEngine.SetLastObjParam(aoskPathDoorMirrored,'TRUE'); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetMirroredDoorExecute', E.Message); end; end; procedure TFSCS_Main.N150Click(Sender: TObject); var i, j, k, l: Integer; TracesList, ConnectorsList: TList; SCSComponent: TSCScomponent; aJoinConnector, JoinedConnector: TConnectorObject; CADList: TF_CAD; currList: TSCSList; Figure: TFigure; currCatalog: TSCSCatalog; SnappedInfo: TStringList; SnapInfo: String; Trace, CTrace: TOrthoLine; CmpPointDelta: double; Conn1, Conn2 : TConnectorObject; p1, p2:TDoublePoint; TraceIndex: Integer; NewTraces : TList; CanCreateList: TIntList; TracesHeight: Double; ClearConnectorsList: TList; PointList1, PointList2: TDoublePointArr; PointCount: Integer; Candel: Boolean; CanBuildList: TIntList; aSnapToGreed_Status, aSnapToGuides_Status, aSnapToNearObject_Status: Boolean; procedure CreateTrace(p1, p2: TDoublePoint); begin if Not PointNear(p1, p2, CmpPointDelta) then begin Trace := CreateTraceByPoints(GCadForm.PCad, p1, p2); // RaiseLineOnHeight(Trace, TracesHeight, nil); NewTraces.Add(Trace); end; end; function CheckNearConnectors(AConn1, AConn2: TConnectorObject): Boolean; var i: Integer; x,y,z,x1,y1,z1 : Double; IsOnOneLine: Boolean; JoinLine: TOrthoLine; Difference: Double; begin Result := True; // здесь проверяем также, чтобы не соединить коннекторы одной ортолинии // даже если ее длина = 0 (может быть и такое) if (aConn1.JoinedOrtholinesList.Count > 0) and (AConn2.JoinedOrtholinesList.Count > 0) then begin IsOnOneLine := False; for i := 0 to AConn1.JoinedOrtholinesList.Count - 1 do begin JoinLine := TOrthoLine(AConn1.JoinedOrtholinesList[i]); if AConn2.JoinedOrtholinesList.IndexOf(JoinLine) <> -1 then begin IsOnOneLine := True; Result := False; break; end; end; if Not IsOnOneLine then begin Result := (Abs(AConn1.ActualPoints[1].x - AConn2.ActualPoints[1].x) < ConnectorDifference ) and (Abs(AConn1.ActualPoints[1].y - AConn2.ActualPoints[1].y) < ConnectorDifference ) and (Abs(AConn1.ActualZOrder[1] - AConn2.ActualZOrder[1]) < ConnectorDifference ); end; end; end; Function GetEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList; var j: Integer; conn1: TConnectorObject; begin Result := TList.Create; if ((acurrList <> nil) and (CadList <> nil)) then begin for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do begin currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]); if currCatalog <> nil then begin Figure := GetFigureByID(CADList, currCatalog.SCSID); if Figure <> nil then begin if CheckFigureByClassName(Figure, cTConnectorObject) then begin Conn1 := TConnectorObject(Figure); if ((Conn1.ConnectorType = ct_Clear) and (TConnectorObject(Conn1).JoinedConnectorsList.Count = 0) and (TConnectorObject(Conn1).JoinedFigures.Count = 0) and (TConnectorObject(Conn1).JoinedOrtholinesList.Count = 0) and (TConnectorObject(Conn1).FIsHouseJoined = false) and (Length(TConnectorObject(Conn1).FJoinedConnectorsIndexes) = 0) and ((TConnectorOBject(Conn1).FConnFullness = cif_Empty) or (TConnectorOBject(Conn1).FConnFullness = cif_None)) ) then Result.Add(Conn1); end; end; end; end; end; end; // соединяет коннекторы трасс на листе procedure JoinTracesOnList(aTracesList: TList); var i, j, k, l : Integer; Catalog, Catalog1 : TSCSCatalog; begin { SnappedInfo := CreateStringListSorted; for i := 0 to aTracesList.Count - 1 do begin Trace := TOrthoLine(aTracesList[i]); Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Trace.ID); for j := 0 to aTracesList.Count - 1 do begin CTrace := TOrthoLine(aTracesList[j]); Catalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CTrace.ID); if Trace <> CTrace then begin try for k := 1 to 2 do for l := 1 to 2 do if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then begin Conn1 := Trace.ConnectorByNum(k); Conn2 := CTrace.ConnectorByNum(l); if Assigned(Conn1) and Assigned(Conn2) then if Conn1 <> Conn2 then begin if PointNear3D(Conn1.ActualPoints[1], Conn2.ActualPoints[1], Conn1.ActualZOrder[1], Conn2.ActualZOrder[1], CmpPointDelta) then begin SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID)); if SnappedInfo.IndexOf(SnapInfo) = -1 then begin if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then SnapConnectorToConnector(Conn1, Conn2) else EmptyProcedure; SnappedInfo.Add(SnapInfo); end; end; end; end; except end; end; end; end; } SnappedInfo := CreateStringListSorted; for i := 0 to aTracesList.Count - 2 do begin Trace := TOrthoLine(aTracesList[i]); Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Trace.ID); for j := (i+1) to aTracesList.Count - 2 do begin CTrace := TOrthoLine(aTracesList[j]); Catalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CTrace.ID); if Trace <> CTrace then begin try for k := 1 to 2 do for l := 1 to 2 do if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then begin Conn1 := Trace.ConnectorByNum(k); Conn2 := CTrace.ConnectorByNum(l); if Assigned(Conn1) and Assigned(Conn2) then if Conn1 <> Conn2 then begin if PointNear3D(Conn1.ActualPoints[1], Conn2.ActualPoints[1], Conn1.ActualZOrder[1], Conn2.ActualZOrder[1], CmpPointDelta) then begin SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID)); if SnappedInfo.IndexOf(SnapInfo) = -1 then begin if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then begin if ((TOrthoLine(Trace).FIsRaiseUpDown = False) and (TOrthoLine(CTrace).FIsRaiseUpDown = False)) then // Tolik 29/03/2018 //Conn1 := SnapConnectorToConnector(Conn1, Conn2) CheckingSnapConnectorToConnector(Conn1, Conn2) // else begin if TOrthoLine(Trace).FIsRaiseUpDown then // Tolik 29/03/2018 //Conn1 := SnapConnectorToConnector(Conn2, Conn1, True) CheckingSnapConnectorToConnector(Conn1, Conn2) // else begin if TOrthoLine(CTrace).FIsRaiseUpDown then // Tolik 29/03/2018 //Conn1 := SnapConnectorToConnector(Conn1, Conn2, True); CheckingSnapConnectorToConnector(Conn1, Conn2); // end; end; end else EmptyProcedure; SnappedInfo.Add(SnapInfo); end; end; end; end; except end; end; end; end; FreeAndNil(SnappedInfo); end; begin TracesList := TList.Create; ConnectorsList := TList.Create; ClearConnectorsList := Nil; CmpPointDelta := 1/5; { for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin} //currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]; currList := F_ProjMan.GSCSBase.CurrProject.CurrList; if currList <> nil then begin CadList := GetListByID(currList.SCSID); if CadList <> nil then begin for j := 0 to currList.ChildCatalogReferences.Count - 1 do begin currCatalog := TSCSCatalog(currList.ChildCatalogReferences[j]); if currCatalog <> nil then begin Figure := GetFigureByID(CADList, currCatalog.SCSID); if Figure <> nil then begin if CheckFigureByClassName(Figure, cTOrthoLine) then begin TracesList.Add(Figure); aJoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector1); //if ConnectorsList.IndexOf(aJoinConnector) = -1 then if aJoinConnector <> nil then ConnectorsList.Add(aJoinConnector) else ShowMessage(cMain_Msg202); aJoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector2); //if ConnectorsList.IndexOf(aJoinConnector) = -1 then if aJoinConnector <> nil then ConnectorsList.Add(aJoinConnector) else ShowMessage(cMain_Msg202); end; end; end; end; end; end; if TracesList.Count > 0 then begin // Ищем пустые коннекторы на проекте для удаления ClearConnectorsList := GetEmptyConnectorsList(currList, CadList); // Удаляем пустые коннекторы с листа (* if ClearConnectorsList.Count > 0 then begin for i := 0 to ClearConnectorsList.Count - 1 do begin Conn1 := TConnectorObject(ClearConnectorsList[i]); if Assigned(TConnectorObject(Conn1).CaptionsGroup) then TConnectorObject(Conn1).CaptionsGroup.delete; if Assigned(TConnectorObject(Conn1).NotesGroup) then TConnectorObject(Conn1).NotesGroup.Delete; if Assigned(TConnectorObject(Conn1).DrawFigure) then TConnectorObject(Conn1).DrawFigure.Delete; TConnectorObject(Conn1).Delete; end; end;*) // сохраняем состояние привязок aSnapToGreed_Status := FSCS_Main.aSnaptoGrid.Checked; aSnapToGuides_Status := FSCS_Main.aSnaptoGuides.Checked; aSnapToNearObject_Status := FSCS_Main.aSnaptoNearObject.Checked; // сбрасываем привязки CadList.PCad.SnapToGrids := False; CadList.PCad.SnapToGuides := False; CadList.PCad.SnapToNearPoint := False; FSCS_Main.aSnaptoGrid.Checked := False; FSCS_Main.aSnaptoGuides.Checked := False; FSCS_Main.aSnaptoNearObject.Checked := False; // соединяем все трассы JoinTracesOnList(TracesList); // TracesList - уже все трассы листа сидят // возвращаем, как было CadList.PCad.SnapToGrids := aSnapToGreed_Status; CadList.PCad.SnapToGuides := aSnapToGuides_Status; CadList.PCad.SnapToNearPoint := aSnapToNearObject_Status; FSCS_Main.aSnaptoGrid.Checked := aSnapToGreed_Status; FSCS_Main.aSnaptoGuides.Checked := aSnapToGuides_Status; FSCS_Main.aSnaptoNearObject.Checked := aSnapToNearObject_Status; FreeAndNil(TracesList); RefreshCAD(CadList.PCad); end; // если вдруг потребуется трассы пересоздать, то можно и так (* NewTraces := TList.Create; {PointList1 := TList.Create; PointList2 := TList.Create;} SetLength(PointList1, 0); SetLength(PointList2, 0); PointCount := 0; CanBuildList := TIntList.Create; // строим список точек и удаляем трассы for i := 0 to TracesList.Count - 1 do begin Trace := TOrthoLine(TracesList[i]); p1 := Trace.JoinConnector1.ActualPoints[1]; p2 := Trace.JoinConnector2.ActualPoints[1]; Inc(PointCount); SetLength(PointList1,PointCount); SetLength(PointList2,PointCount); PointList1[PointCount - 1] := p1; PointList2[PointCount - 1] := p2; if (Trace.FIsRaiseUpDown = false) then begin CanBuildList.Add(1); // сбрасываем списки присоединенных фигур, чтобы удалилось, как есть Trace.JoinedFigures.Clear; Trace.JoinConnector1.JoinedFigures.Clear; Trace.JoinConnector2.JoinedFigures.Clear; TConnectorObject(Trace.JoinConnector1).JoinedConnectorsList.Clear; TConnectorObject(Trace.JoinConnector2).JoinedConnectorsList.Clear; TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Clear; TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Clear; // удаляем трассу Trace.Delete; //Trace.JoinConnector1.Select; if Assigned(TConnectorObject(Trace.JoinConnector1).CaptionsGroup) then TConnectorObject(Trace.JoinConnector1).CaptionsGroup.delete; if Assigned(TConnectorObject(Trace.JoinConnector1).NotesGroup) then TConnectorObject(Trace.JoinConnector1).NotesGroup.Delete; if Assigned(TConnectorObject(Trace.JoinConnector1).DrawFigure) then TConnectorObject(Trace.JoinConnector1).DrawFigure.Delete; if Assigned(TConnectorObject(Trace.JoinConnector2).CaptionsGroup) then TConnectorObject(Trace.JoinConnector2).CaptionsGroup.delete; if Assigned(TConnectorObject(Trace.JoinConnector2).NotesGroup) then TConnectorObject(Trace.JoinConnector2).NotesGroup.Delete; if Assigned(TConnectorObject(Trace.JoinConnector2).DrawFigure) then TConnectorObject(Trace.JoinConnector2).DrawFigure.Delete; TConnectorObject(Trace.JoinConnector1).Delete; TConnectorObject(Trace.JoinConnector2).Delete; end else CanBuildList.Add(0); end; //CadList.DeleteSelection(false); RefreshCAD(CadList.PCad); // строим трассы заново for i := 0 to Length(PointList1) - 1 do begin if CanBuildList[i] > 0 then begin p1 := TDoublePoint(PointList1[i]); p2 := TDoublePoint(PointList2[i]); CreateTrace(p1, p2); end else NewTraces.Add(TOrthoLine(TracesList[i])); end; // соединяем трассы на проекте // Это если после пересоздания JoinTracesOnList(NewTraces); *) //CADList.PCad.MoveAll(0.001, 0.001); // 09/02/2017 -- FreeAndNil(ConnectorsList); if ClearConnectorsList <> nil then FreeAndNil(ClearConnectorsList); // end; //Tolik 26/02/2022 -- procedure TFSCS_Main.N272AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var OutText: String; begin OutText := (Sender as TMenuItem).Caption; if (odFocused in State) or (odSelected in State) then begin end else begin {if Sender = N33 then begin OutText := 'AUTOROUTE'; end; if Sender = N46 then begin OutText := 'LAY OUT ON SELECTED ROUTES'; end;} ACanvas.Font.Style := [fsBold]; ARect.Left := 32; ARect.Right := ARect.Right - 32; ACanvas.brush.color := clWhite; //Tolik 26/01/2021 -- ACanvas.FillRect(ARect); DrawText(ACanvas.Handle, PChar(OutText), -1, ARect, DT_VCENTER or dt_LEFT or dt_singleline); end; end; procedure TFSCS_Main.EmptyConnSelectExecute(Sender: TObject); begin Select_clearConnectors; end; procedure TFSCS_Main.EmptyRaiseVertSelectExecute(Sender: TObject); Var i: integer; TraceList: TList; SCSCatalog: TSCSCatalog; Figure: TFigure; begin if GCadForm <> nil then begin TraceList := TList.Create; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin Figure := TFigure(GCadForm.FSCSFigures[i]); //if TFigure is TOrthoLine then if CheckFigureByClassName(Figure, cTOrthoLine) then begin if (TOrthoLine(Figure).FIsRaiseUpDown or TOrthoLine(Figure).FIsVertical) then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID); if SCSCatalog <> nil then begin if SCSCatalog.ComponentReferences.Count = 0 then if TraceList.IndexOf(Figure) = -1 then TraceList.Add(Figure); end; end; end; end; if TraceList.Count > 0 then begin GCadForm.PCad.DeselectAll(2); GCadForm.PCad.SelectFigures(TraceList); GCadForm.PCad.Refresh; { GCadForm.PCad.FAnySelected := True; GCadForm.PCad.ReDrawSelection; GCadForm.PCad.SyncEnv; } end; TraceList.Free; end; end; procedure TFSCS_Main.EmptyTracesSelectExecute(Sender: TObject); Var i: integer; TraceList: TList; SCSCatalog: TSCSCatalog; Figure: TFigure; begin if GCadForm <> nil then begin TraceList := TList.Create; for i := 0 to GCadForm.FSCSFigures.Count - 1 do begin Figure := TFigure(GCadForm.FSCSFigures[i]); //if TFigure is TOrthoLine then if CheckFigureByClassName(Figure, cTOrthoLine) then begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID); if SCSCatalog <> nil then begin if SCSCatalog.ComponentReferences.Count = 0 then if TraceList.IndexOf(Figure) = -1 then TraceList.Add(Figure); end; end; end; if TraceList.Count > 0 then begin GCadForm.PCad.DeselectAll(2); GCadForm.PCad.SelectFigures(TraceList); GCadForm.PCad.Refresh; {GCadForm.PCad.FAnySelected := True; GCadForm.PCad.ReDrawSelection; GCadForm.PCad.SyncEnv;} end; TraceList.Free; end; end; procedure TFSCS_Main.SelectAllPointObjectsExecute(Sender: TObject); var i, j: Integer; currList: TSCSList; aCAd: TF_CAD; ConnList: TList; Figure: TFigure; currCatalog : TSCSCatalog; Function GetNotEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList; var j: Integer; conn1: TConnectorObject; begin Result := TList.Create; if ((acurrList <> nil) and (CadList <> nil)) then begin for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do begin currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]); if currCatalog <> nil then begin Figure := GetFigureByID(CADList, currCatalog.SCSID); if Figure <> nil then begin if CheckFigureByClassName(Figure, cTConnectorObject) then begin Conn1 := TConnectorObject(Figure); if Conn1.ConnectorType = ct_NB then Result.Add(Conn1); end; end; end; end; end; end; Begin currList := F_ProjMan.GSCSBase.CurrProject.CurrList; if currList <> nil then begin aCad := GetListByID(currList.SCSID); if aCad <> nil then begin ConnList := GetNotEmptyConnectorsList(currList, aCad); if ConnList.Count > 0 then begin aCad.PCad.SelectFigures(ConnList); aCad.PCad.FAnySelected := True; aCAd.PCad.ReDrawSelection; aCAd.PCad.SyncEnv; // RefreshCAD(aCAd.PCad); FreeAndNil(ConnList); end else ConnList.Free; end; end; end; procedure TFSCS_Main.SelectAllLineObjsExecute(Sender: TObject); var i, j: Integer; currList: TSCSList; aCAd: TF_CAD; FigList: TList; Figure: TFigure; currCatalog : TSCSCatalog; TakeRaises: Boolean; Function GetLineList(acurrList: TSCSList; CadList: TF_CAD) : TList; var j: Integer; conn1: TConnectorObject; function CheckSelectConnector(aConnector: TConnectorObject): Boolean; var i: Integer; begin Result := True; for i := 0 to aConnector.JoinedConnectorsList.Count - 1 do begin if TConnectorObject(aConnector.JoinedConnectorsList[i]).ConnectorType = ct_NB then begin Result := false; break; end; end; end; begin Result := TList.Create; if ((acurrList <> nil) and (CadList <> nil)) then begin for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do begin currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]); if currCatalog <> nil then begin Figure := GetFigureByID(CADList, currCatalog.SCSID); if Figure <> nil then begin if CheckFigureByClassName(Figure, cTOrthoLine) then begin if ( (TOrthoLine(Figure).FIsRaiseUpDown = False) or ((TOrthoLine(Figure).FIsRaiseUpDown = True) and TakeRaises ) )then begin Result.Add(Figure); if TOrthoLine(Figure).JoinConnector1 <> nil then begin if CheckSelectConnector(TConnectorObject(TOrthoLine(Figure).JoinConnector1)) then Result.Add(TOrthoLine(Figure).JoinConnector1); end; if TOrthoLine(Figure).JoinConnector2 <> nil then begin if CheckSelectConnector(TConnectorObject(TOrthoLine(Figure).JoinConnector2)) then Result.Add(TOrthoLine(Figure).JoinConnector2); end; end end; end; end; end; end; end; Function ShiftDown : Boolean; Var State : TKeyboardState; Begin GetKeyboardState(State); Result := ((State[vk_Shift] and 128) <> 0); End; Begin TakeRaises := ShiftDown; // нажата ли клавиша Shift currList := F_ProjMan.GSCSBase.CurrProject.CurrList; if currList <> nil then begin aCad := GetListByID(currList.SCSID); if aCad <> nil then begin FigList := GetLineList(currList, aCad); if FigList.Count > 0 then begin aCad.PCad.SelectFigures(FigList); aCad.PCad.FAnySelected := True; aCAd.PCad.ReDrawSelection; aCAd.PCad.SyncEnv; // RefreshCAD(aCAd.PCad); //FreeAndNil(FigList); end; //else FreeAndNil(FigList); { if TakeRaises then aCAD.SelectTracesAndRaisers else aCAd.SelectTraces; } end; end; End; // Tolik procedure TFSCS_Main.Act_Magistral_Channel_IndexExecute(Sender: TObject); var i, j, NewIndex: Integer; SCSComponent: TSCSComponent; SCSCatalog, SCSCatalog1: TSCSCatalog; TraceList, PassedTraceList, currChannelList: TList; aCad: TF_CAD; currList: TSCSList; Figure: TFigure; ChannelTypeList: TStringList; ActLayer: Integer; selectedCypher: String; AllChannelList: TSCSComponents; JoinConnector, JoinedConn: TConnectorObject; // added by Tolik Function GetAngleXYZ(Line1,Line2 : TSCSCatalog; Connector : TConnectorObject) : double; Var i : integer; x,y,z,x1,y1,z1 : double; // координаты векторов vector1, vector2 : TFigure; ListOwner : TList; ListCad : TF_Cad; connector1, connector2 : TConnectorObject; angle : double; angle2 : double; Begin // первый вектор ListCad := GetListByID(Line1.GetListOwner.SCSID); // линия vector1 := TOrthoLine(GetFigureByID(ListCad,Line1.SCSID)); connector1 := TConnectorObject(Tortholine(vector1).JoinConnector1); // определяем направление вектора // if (connector1.ActualPoints[0] = Connector.ActualPoints[0]) and (connector1.ActualPoints.y = Connector.ActualPoints.y) and (connector1.ActualPoints.z = Connector.ActualPoints.z) then if connector1 = Connector then begin connector2 := TConnectorObject(Tortholine(vector1).JoinConnector2); end else begin connector2 := TConnectorObject(Tortholine(vector1).JoinConnector1); connector1 := TConnectorObject(Tortholine(vector1).JoinConnector2); end; //координаты вектора 1 x := RoundX((Connector2.AP1.x - connector1.AP1.x),2); y := RoundX((connector2.AP1.y - Connector1.AP1.y),2); z := MetreToUOM(TOrthoLine(vector1).ActualZOrder[1])/ListCad.PCad.MapScale*1000 - MetreToUOM(TOrthoLine(vector1).ActualZOrder[2])/ListCad.PCad.MapScale*1000; // второй вектор ListCad := GetListByID(Line1.GetListOwner.SCSID); // линия vector2 := TOrthoLine(GetFigureByID(ListCad,Line2.SCSID)); connector1 := TConnectorObject(Tortholine(vector2).JoinConnector1); // определяем направление вектора if ((connector1.ActualPoints[0].x = Connector.ActualPoints[0].x) and (connector1.ActualPoints[0].y = Connector.ActualPoints[0].y) and (connector1.ActualPoints[0].z = Connector.ActualPoints[0].z)) then begin connector1 := TConnectorObject(Tortholine(vector2).JoinConnector1); connector2 := TConnectorObject(Tortholine(vector2).JoinConnector2); end else begin connector2 := TConnectorObject(Tortholine(vector2).JoinConnector1); connector1 := TConnectorObject(Tortholine(vector2).JoinConnector2); end; //координаты вектора 2 x1 := (connector2.AP1.x - Connector1.AP1.x); y1 := (connector2.AP1.y - Connector1.AP1.y); z1 := MetreToUOM(TOrthoLine(vector2).ActualZOrder[1])/ListCad.PCad.MapScale*1000 - MetreToUOM(TOrthoLine(vector2).ActualZOrder[2])/ListCad.PCad.MapScale*1000; //на всякий, чтоб не получить деление на 0 if (((x<>0) or (y<>0) or (z<>0)) and ((x1<>0) or (y1<>0) or (z1<>0))) then begin //angle2 := !!!!abs!!!!((x*x1+y*y1+z*z1)/(sqrt(sqr(x)+sqr(y)+sqr(z))*sqrt(sqr(x1)+sqr(y1)+sqr(z1)))); //Result := Roundx(RadToDeg(arccos(angle2)),1); angle := arccos((x*x1+y*y1+z*z1)/(sqrt(sqr(x)+sqr(y)+sqr(z))*sqrt(sqr(x1)+sqr(y1)+sqr(z1)))); //угол между линиями в градусах Result := Roundx(RadToDeg(angle),1); if Result > 180 then Result := 360 - Result; end; End; procedure RemarkLineComponList(var ComponList: TSCSComponents; var PassedComponList: TList; var counter: Integer); var i, j: Integer; SCSComponent: TSCSComponent; begin if ComponList.Count > 0 then begin for i := 0 to ComponList.Count - 1 do begin SCSComponent := TSCSComponent(ComponList[i]); if PassedComponList.IndexOf(SCSComponent) = -1 then begin SCSComponent.MarkID := counter; // Inc(counter); SCSComponent.SaveComponent; PassedComponList.Add(SCSComponent); ApplyChangeComponMarkID(SCSComponent, true, false, nil); end; end; end; end; Function CheckCanTraceRaizeUpDown(ALine : TOrthoLine) : Boolean; var i : Integer; begin Result := true; if ALine.FIsRaiseUpDown then begin if Assigned(ALine.JoinConnector1) then begin for i := 0 to TConnectorObject(ALine.JoinConnector1).JoinedConnectorsList.Count - 1 do begin if TConnectorObject(TConnectorObject(ALine.JoinConnector1).JoinedConnectorsList[i]).ConnectorType = ct_Nb then begin Result := False; break; end; end; end; if Result then begin if Assigned(ALine.JoinConnector2) then begin for i := 0 to TConnectorObject(ALine.JoinConnector2).JoinedConnectorsList.Count - 1 do begin if TConnectorObject(TConnectorObject(ALine.JoinConnector2).JoinedConnectorsList[i]).ConnectorType = ct_Nb then begin Result := False; break; end; end; end; end; end; end; procedure GetComponsFromTraces(aConnector: TConnectorObject; aCypher: string; var PassedList: TList; var ComponList: TSCSComponents; aLine: TOrthoLine); var i, j, k, l: Integer; Figure: TFigure; BeginLine, JoinLine: TOrthoLine; TempComponList, TempTraceList, TempConnectorsList: TList; CanTraceNextStep: Boolean; SCSCatalog : TSCSCatalog; SCSComponent: TSCSComponent; currConnector, LineConnector: TConnectorObject; BetweenLineAngle: Double; begin CanTraceNextStep := True; TempComponList := TList.Create; TempTraceList := TList.Create; TempConnectorsList := TList.Create; currConnector := TConnectorObject(aConnector); BeginLine := ALine; while CanTraceNextStep do begin for i := 0 to currConnector.JoinedConnectorsList.Count - 1 do begin // если к коннектору подключен точечный - дальше не идем if TConnectorObject(currConnector.JoinedConnectorsList[i]).ConnectorType = ct_NB then begin CanTraceNextStep := False; // SCSCatalog := //F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TConnectorObject(currConnector.JoinedConnectorsList[i]).ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TConnectorObject(currConnector.JoinedConnectorsList[i]).ID); if SCSCatalog <> nil then begin for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[j]); // если точечный - элемент кабельного канала - идем дальше if SCSComponent.ComponentType.SysName = ctsnCableChannelElement then begin CanTraceNextStep := True; break; end; end; end; if not CanTraceNextStep then Break; end; end; // если точечных нет - ищем не пройденные трассы if CanTraceNextStep then begin if TempComponList.Count > 0 then TempComponList.Clear; if TempTraceList.Count > 0 then TempTraceList.Clear; for i := 0 to currConnector.JoinedOrtholinesList.Count - 1 do begin JoinLine := TOrthoLine(currConnector.JoinedOrtholinesList[i]); if CheckCanTraceRaizeUpDown(JoinLine) and (JoinLine <> BeginLine) then begin if PassedList.IndexOf(JoinLine) = -1 then begin //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); if SCSCatalog <> nil then begin for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[j]); if SCSComponent.Cypher = aCypher then begin TempTraceList.Add(JoinLine); TempComponList.Add(SCSComponent); LineConnector := TConnectorObject(JoinLine.JoinConnector1); if LineConnector = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1)) else begin LineConnector := TConnectorObject(JoinLine.JoinConnector2); if LineConnector = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2)); end; PassedList.Add(JoinLine); break; end; end; end; end; end; end; for i := 0 to currConnector.JoinedConnectorsList.Count - 1 do begin for j := 0 to TConnectorObject(currConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do begin JoinLine := TOrthoLine(TConnectorObject(currConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[j]); if CheckCanTraceRaizeUpDown(JoinLine) and (JoinLine <> BeginLine) then begin if PassedList.IndexOf(JoinLine) = -1 then begin if TempTraceList.IndexOf(JoinLine) = -1 then begin //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); if SCSCatalog <> nil then begin for k := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[k]); if SCSComponent.Cypher = aCypher then begin TempTraceList.Add(JoinLine); TempComponList.Add(SCSComponent); if TConnectorObject(JoinLine.JoinConnector1) = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1)) else if TConnectorObject(JoinLine.JoinConnector2) = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2)); break; end; end; end; end; end; end; end; JoinedConn := TConnectorObject(currConnector.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedConnectorsList.Count - 1 do begin for k := 0 to TConnectorObject(JoinedConn.JoinedConnectorsList[j]).JoinedOrtholinesList.Count - 1 do begin JoinLine := TOrthoLine(TConnectorObject(JoinedConn.JoinedConnectorsList[j]).JoinedOrtholinesList[k]); if CheckCanTraceRaizeUpDown(JoinLine) then begin if PassedList.IndexOf(JoinLine) = -1 then begin if TempTraceList.IndexOf(JoinLine) = -1 then begin //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID); if SCSCatalog <> nil then begin for l := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[l]); if SCSComponent.Cypher = aCypher then begin TempTraceList.Add(JoinLine); TempComponList.Add(SCSComponent); if TConnectorObject(JoinLine.JoinConnector1) = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1)) else if TConnectorObject(JoinLine.JoinConnector2) = currConnector then TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2)); break; end; end; end; end; end; end; end; end; end; end; // если трасс дальше нет - сброс if TempTraceList.Count = 0 then CanTraceNextStep := False else begin // если трасса дальше одна - берем сразу и продолжаем if TempTraceList.Count = 1 then begin ComponList.Add(TSCSComponent(TempComponList[0])); JoinLine := TOrthoLine(TempTraceList[0]); if CheckCanTraceRaizeUpDown(JoinLine) then begin currConnector := nil; if TempConnectorsList.IndexOf(TConnectorObject(JoinLine.JoinConnector1)) = -1 then currConnector := TConnectorObject(JoinLine.JoinConnector1) else if TempConnectorsList.IndexOf(TConnectorObject(JoinLine.JoinConnector2)) = -1 then currConnector := TConnectorObject(JoinLine.JoinConnector2); if currConnector = nil then CanTraceNextStep := False; BeginLine := TOrthoLine(TempTraceList[0]); end; end else // если трасс несколько - ищем (если найдем) ту, которая является продолжением текущей трассы (180 град) if TempTraceList.Count > 1 then begin BetweenLineAngle := -1; //SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(BeginLine).ID); SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(BeginLine).ID); for i := 0 to TempTraceList.Count - 1 do begin //SCSCatalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(TempTraceList[i]).ID); SCSCatalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(TempTraceList[i]).ID); BetweenLineAngle := GetAngleXYZ(SCSCatalog, SCSCatalog1, currConnector); if BetweenLineAngle = 180 then begin // продолжаем путь CanTraceNextStep := True; // исходная трасса BeginLine := TOrthoLine(TempTraceList[i]); // исходный коннектор if TConnectorObject(BeginLine.JoinConnector1) <> currConnector then currConnector := TConnectorObject(BeginLine.JoinConnector1) else if TConnectorObject(BeginLine.JoinConnector2) <> currConnector then currConnector := TConnectorObject(BeginLine.JoinConnector2); // компонент для индексации - в общий список ComponList.Add(TSCSComponent(TempComponList[i])); break; end; end; end; end; end; FreeAndNil(TempComponList); FreeAndNil(TempTraceList); FreeAndNil(TempConnectorsList); end; begin ActLayer := GCadForm.PCad.ActiveLayer; currList := F_ProjMan.GSCSBase.CurrProject.CurrList; aCad := GetListByID(currList.SCSID); selectedCypher := ''; if aCad <> nil then begin TraceList := nil; PassedTraceList := nil; ChannelTypeList := nil; AllChannelList := nil; currChannelList := nil; NewIndex := -1; if aCad.PCad.Selection.Count > 0 then begin TraceList := TList.Create; PassedTraceList := TList.Create; Figure := TFigure(aCad.PCAD.Selection[0]); if CheckFigureByClassName(Figure, cTOrthoLine) then // на всякий begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID); if SCSCatalog <> nil then begin try NewIndex := StrToInt(InputBox('', '','1')); except NewIndex := -1; end; if NewIndex <> -1 then begin // строим список каб каналов на трассе AllChannelList := TSCSComponents.Create(false); ChannelTypeList := TStringList.Create; for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin if TSCSComponent(SCSCatalog.ComponentReferences[i]).ComponentType.SysName = ctsnCableChannel then begin SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[i]); if ChannelTypeList.IndexOf(SCSComponent.Cypher) = -1 then begin ChannelTypeList.Add(SCSComponent.Cypher); AllChannelList.Add(SCSComponent); end; end; end; // если кабканал на трассе только один if AllChannelList.Count = 1 then selectedCypher := ChannelTypeList[0] else if AllChannelList.Count > 1 then begin SCSComponent := nil; SCSComponent := F_ProjMan.SelectComponentFromList(AllChannelList, '', '1', '2', '', 0, [], nil, nil, 0); end; if SCSComponent <> nil then begin selectedCypher := SCSComponent.Cypher; AllChannelList.Clear; PassedTraceList.Add(Figure); // пройденные фигуры - чтобы не вернуться назад AllChannelList.Add(SCSComponent); // список компонент для переиндексации // есть выбранный компонент - шуруем по трассам в обе стороны, ищем такие же, пока присоединенная трасса только одна, // только одна из присоединенных с таким же компонентом(берем первый попавшийся), или не закончится точечным или обрывом if assigned(TConnectorObject(TOrthoLine(Figure).JoinConnector1)) then JoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector1); GetComponsFromTraces(JoinConnector, selectedCypher, PassedTraceList, AllChannelList, TOrthoLine(Figure)); if assigned(TConnectorObject(TOrthoLine(Figure).JoinConnector2)) then JoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector2); GetComponsFromTraces(JoinConnector, selectedCypher, PassedTraceList, AllChannelList, TOrthoLine(Figure)); PassedTraceList.Clear; RemarkLineComponList(AllChannelList, PassedTraceList, NewIndex); end; FreeAndNil(ChannelTypeList); AllChannelList.Clear; FreeAndNil(AllChannelList); end else begin ShowMessage(hReindex_Msg1); FreeAndNil(TraceList); FreeAndNil(PassedTraceList); EXIT; end; end; end; aCad.PCad.DeselectAll(ActLayer); aCad.Pcad.Refresh; end; end; end; procedure TFSCS_Main.actLoadPictasRastrExecute(Sender: TObject); var FName: string; FDir: string; OpenPictureDialog: TSavePictureDialog; begin try if ActiveMDIChild <> nil then begin GisUserDimLine := True; LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124,'', True, True); //Tolik 11/08/2021 -- if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 5000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; // end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenVectorDrawingExecute', E.Message); end; end; procedure TFSCS_Main.Act_AlignSelectionExecute(Sender: TObject); begin // end; procedure TFSCS_Main.aToolPieExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- //if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TPie'); //GCadForm.PCad.SetTool(toFigure, 'TArcDimLine'); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.SetSefaultAllowTransparensyExecute(Sender: TObject); var CurListParams: TListParams; begin if ActiveMDIChild <> nil then begin try {GCadForm.FListSettings.AllowTransparency := True; GCadForm.tbShowTransparency.Down := True;} CurListParams := GetListParams(GCadForm.FCADListID); CurListParams.Settings.AllowTransparency := True; //SaveCADListParams(GCadForm.FCADListID, CurListParams); RefreshCAD(GCadForm.PCad); except on E: Exception do addExceptionToLogEx('TFSCS_Main.a100Execute', E.Message); end; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aSetDoubleDoorExecute(Sender: TObject); var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.DoorIndex = -1 then exit; if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled then begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled := False; GArchEngine.SetLastObjParam(aoskPathDoorDoubled,'FALSE') end else begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled := True; GArchEngine.SetLastObjParam(aoskPathDoorDoubled,'TRUE'); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoubleDoorExecute', E.Message); end; end; procedure TFSCS_Main.aSetOpenedDoorExecute(Sender: TObject); Var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.DoorIndex = -1 then exit; if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened then begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := False; GArchEngine.SetLastObjParam(aoskPathDoorOpened,'FALSE'); end else begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := True; TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := False; GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'FALSE'); GArchEngine.SetLastObjParam(aoskPathDoorOpened,'TRUE'); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message); end; end; procedure TFSCS_Main.aSetHalfOpenedDoorExecute(Sender: TObject); Var CurSelPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurSelPath.DoorIndex = -1 then exit; if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened then begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := False; GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'FALSE'); end else begin TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := True; TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := False; GArchEngine.SetLastObjParam(aoskPathDoorOpened,'FALSE'); GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'TRUE'); end; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message); end; end; procedure TFSCS_Main.aSetCornHeightExecute(Sender: TObject); var dist1, dist2, zCoord: Double; currPath, JoinedPath: TNetPath; i, currPathIndex: Integer; NewZ: String; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then begin CurrPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if CurrPath <> nil then if CurrPath.p1 <> nil then if CurrPath.p2 <> nil then begin //currPathIndex := TNet(GCadForm.PCad.Selection[0]).Paths.IndexOf(CurrPath); dist1 := Sqrt(Sqr(CurrPath.p1.x - GMouseDownPos.x) + Sqr(CurrPath.p1.y - GMouseDownPos.y)); dist2 := Sqrt(Sqr(CurrPath.p2.x - GMouseDownPos.x) + Sqr(CurrPath.p2.y - GMouseDownPos.y)); {PathPoint.x := CurrPath.P1.x; PathPoint.y := CurrPath.P1.y; PathPoint.z := CurrPath.P1.z;} i := 1; zCoord := CurrPath.P1H; if CompareValue(dist1, dist2) = 1 then begin {PathPoint.x := CurrPath.P2.x; PathPoint.y := CurrPath.P2.y; PathPoint.z := CurrPath.P2.z;} //zCoord := CurrPath.P2.z; zCoord := CurrPath.P2H; i := 2; end; if zCoord < 0 then NewZ := '-1' else NewZ := FloatToStr(zCoord); if InputQuery(SetAngleHMsg,'', NewZ) then begin Try zCoord := StrToFloat_My(NewZ); except Showmessage(IncorrInpVal); exit; end; if zCoord < 0 then exit else if CompareValue(F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom, zCoord) = -1 then zCoord := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom; if i = 1 then currPath.p1H := zCoord else if i = 2 then currPath.p2H := zCoord; currPath.Refresh; RefreshCAD(GCadForm.PCad); if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end; {if TNet(GCadForm.PCad.Selection[0]).Paths.Count > 1 then begin for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do begin if i <> currPathIndex then begin currPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]); if CompareValue(currPath.p1.x, PathPoint.x) = 0 then if CompareValue(currPath.p1.y, PathPoint.y) = 0 then begin currPath.p1.z := zCoord; currPath := nil; end; if currPath <> nil then begin if CompareValue(currPath.p2.x, PathPoint.x) = 0 then if CompareValue(currPath.p2.y, PathPoint.y) = 0 then begin currPath.p2.z := zCoord; currPath := nil; end; end; end; end; end; } end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetCornHeightExecute', E.Message); end; end; procedure TFSCS_Main.aSetDoorWndHExecute(Sender: TObject); var nDoor: TNetDoor; DWHeight: Double; DWHeightStr, MStr: string; SPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin SPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if SPath <> nil then begin nDoor := SPath.Net.SelDoor; MStr := SetDoorH; if nDoor = nil then begin MStr := SetWndH; nDoor := SPath.Net.SelWindow; end; if nDoor <> nil then begin DWHeightStr := FloatToStr(nDoor.Height); if InputQuery(MStr,'', DWHeightStr) then begin try DWHeight := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DWHeight < 0 then exit else begin nDoor.Height := DWHeight; SPath.refresh; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoorWndHExecute', E.Message); end; end; procedure TFSCS_Main.aSetDoorWindowPllacementHeightExecute(Sender: TObject); var nDoor: TNetDoor; DWHeight: Double; DWHeightStr, MStr: string; SPath: TNetPath; begin try if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin SPath := TNet(GCadForm.PCad.Selection[0]).SelPath; if SPath <> nil then begin nDoor := SPath.Net.SelDoor; MStr := SetDoorPLHMsg; if nDoor = nil then begin MStr := SetWinPLHMsg; nDoor := SPath.Net.SelWindow; end; if nDoor <> nil then begin DWHeightStr := FloatToStr(nDoor.WndPlacementHeight); if InputQuery(MStr,'', DWHeightStr) then begin try DWHeight := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DWHeight < 0 then exit else begin nDoor.WndPlacementHeight := DWHeight; SPath.refresh; end; end; end; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoorWindowPllacementHeightExecute', E.Message); end; end; procedure TFSCS_Main.aSetAllListDoorsPlacementHeightExecute(Sender: TObject); var i, j: Integer; Net: TNet; DWHeightStr: String; DoorH: Double; currPath: TNetPath; Door: TNetDoor; begin if GCadForm.FactiveNet <> nil then begin Net := GCadForm.FActiveNet; DWHeightStr:= FloatToStr(MetreToUom(0.1)); if InputQuery(SetListDoorPLHMsg,'', DWHeightStr) then begin try DoorH := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DoorH >= 0 then begin for i := 0 to Net.Paths.count - 1 do begin currPath := TNetpath(net.Paths[i]); for j := 0 to currPath.Doors.Count - 1 do begin Door := TNetDoor(currPath.Doors[j]); if Door.DoorObjType = dotDoor then Door.WndPlacementHeight := DoorH; end; end; Net.RefreshPaths(false); end; end; end; end; procedure TFSCS_Main.aSetAllListWndPlacementExecute(Sender: TObject); var i, j: Integer; Net: TNet; DWHeightStr: String; DoorH: Double; currPath: TNetPath; Door: TNetDoor; begin if GCadForm.FactiveNet <> nil then begin Net := GCadForm.FActiveNet; DWHeightStr:= FloatToStr(MetreToUom(0.7)); if InputQuery(SetListWinPLHMsg,'', DWHeightStr) then begin try DoorH := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DoorH >= 0 then begin for i := 0 to Net.Paths.count - 1 do begin currPath := TNetpath(net.Paths[i]); for j := 0 to currPath.Doors.Count - 1 do begin Door := TNetDoor(currPath.Doors[j]); if Door.DoorObjType = dotWindow then Door.WndPlacementHeight := DoorH; end; end; Net.RefreshPaths(false); end; end; end; end; procedure TFSCS_Main.aSetAllListDoorsHeightExecute(Sender: TObject); var i, j: Integer; Net: TNet; DWHeightStr: String; DoorH: Double; currPath: TNetPath; Door: TNetDoor; begin if GCadForm.FactiveNet <> nil then begin Net := GCadForm.FActiveNet; DWHeightStr:= FloatToStr(MetreToUom(2)); if InputQuery(SetListDoorH,'', DWHeightStr) then begin try DoorH := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DoorH >= 0 then begin for i := 0 to Net.Paths.count - 1 do begin currPath := TNetpath(net.Paths[i]); for j := 0 to currPath.Doors.Count - 1 do begin Door := TNetDoor(currPath.Doors[j]); if Door.DoorObjType = dotDoor then Door.Height := DoorH; end; end; Net.RefreshPaths(false); end; end; end; end; procedure TFSCS_Main.aSetAllListWndHeightExecute(Sender: TObject); var i, j: Integer; Net: TNet; DWHeightStr: String; DoorH: Double; currPath: TNetPath; Door: TNetDoor; begin if GCadForm.FactiveNet <> nil then begin Net := GCadForm.FActiveNet; DWHeightStr:= FloatToStr(MetreToUom(1.4)); if InputQuery(SetListWndH,'', DWHeightStr) then begin try DoorH := StrToFloat_My(DWHeightStr); except Showmessage(IncorrInpVal); exit; end; if DoorH >= 0 then begin for i := 0 to Net.Paths.count - 1 do begin currPath := TNetpath(net.Paths[i]); for j := 0 to currPath.Doors.Count - 1 do begin Door := TNetDoor(currPath.Doors[j]); if Door.DoorObjType = dotWindow then Door.Height := DoorH; end; end; Net.RefreshPaths(false); end; end; end; end; end.