//{$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, XPMenu, ImgList, Buttons, /// 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; 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; 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; XPMenu: TXPMenu; pmObject: TPopupMenu; MainMenu: TMainMenu; N3: TMenuItem; N13: TMenuItem; N14: TMenuItem; N15: TMenuItem; N16: TMenuItem; N17: TMenuItem; nWindow: TMenuItem; N22: TMenuItem; N135: TMenuItem; N136: TMenuItem; N137: TMenuItem; N139: 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; N218: 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; N21: TMenuItem; N227: TMenuItem; N229: TMenuItem; N230: TMenuItem; N231: TMenuItem; N232: TMenuItem; N233: TMenuItem; N235: TMenuItem; N504: TMenuItem; N754: TMenuItem; N1004: TMenuItem; N1504: TMenuItem; N2004: TMenuItem; N236: TMenuItem; N1100: TMenuItem; N1101: TMenuItem; N237: 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; N8: TMenuItem; aInsertText: TAction; aInsertBitmap: TAction; N9: TMenuItem; N10: TMenuItem; 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; N38: 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; ToolButton1: TToolButton; ToolButton2: TToolButton; ToolButton3: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; tbObject: TToolBar; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton9: TToolButton; ToolButton10: TToolButton; ToolButton12: TToolButton; ToolButton14: 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; N20: TMenuItem; N25: TMenuItem; N27: TMenuItem; aSetDefaultColors: TAction; pmSCSObject: TPopupMenu; Prop0: TMenuItem; aFreeRotate: TAction; N28: TMenuItem; aRegHotKeys: TAction; aUnregHotKeys: TAction; N30: TMenuItem; N42: TMenuItem; aAutoSelectTrace: TAction; aServerAsDefault: TAction; ToolButton11: TToolButton; aOpenProject: TAction; aRealignLine: TAction; Prop2: TMenuItem; ApplicationEvents1: TApplicationEvents; Prop4: TMenuItem; aNotAsServerDefault: TAction; Prop5: TMenuItem; Prop3: TMenuItem; Prop6: TMenuItem; aSelectTracetoServer: TAction; Prop7: TMenuItem; aToolText: TAction; aMakeCabling: TAction; Prop8: TMenuItem; N65: TMenuItem; aViewSCSObjectsProp: TAction; aViewSCS: TMenuItem; aCreateRaise: TAction; Prop9: TMenuItem; aDestroyRaise: TAction; Prop10: TMenuItem; aMasterAutoTrace: TAction; N68: TMenuItem; pmFiguresByLevel: TPopupMenu; aListProperties: TAction; N71: TMenuItem; N70: TMenuItem; aRaiseLine: TAction; Prop11: TMenuItem; aCreateObjectOnClick: TAction; aDeleteSCSObject: TAction; Prop12: TMenuItem; aShowConnFullness: TAction; aShowCableFullness: TAction; aShowCableChannelFullness: TAction; aCreateObjectOnClickTool: TAction; aCreateFloorRaiseUp: TAction; aCreateFloorRaiseDown: TAction; aTileWindows: TAction; Prop13: TMenuItem; Prop14: TMenuItem; aOrderWindow1: TMenuItem; N75: TMenuItem; aCascadeWindows: TAction; aCreateBlockToNB: TAction; aInsertBlock: TAction; aBlocksEditor: TAction; aRotatePointObject90: 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; N82: TMenuItem; N83: TMenuItem; N18: TMenuItem; N84: TMenuItem; Prop15: TMenuItem; Prop16: TMenuItem; ImageArrows: TImageList; N86: TMenuItem; N87: TMenuItem; N88: TMenuItem; N89: TMenuItem; N90: TMenuItem; N91: TMenuItem; Prop1: TMenuItem; N4001: TMenuItem; Prop17: TMenuItem; cbLayers: TcxComboBox; ToolButton31: TToolButton; ToolButton32: TToolButton; N94: TMenuItem; N95: TMenuItem; BMP1: TMenuItem; Prop18: TMenuItem; N51: TMenuItem; N60: TMenuItem; N61: TMenuItem; N62: 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; N96: TMenuItem; N97: TMenuItem; N98: TMenuItem; N99: TMenuItem; N19: TMenuItem; N76: TMenuItem; aRegistration: TAction; mRegister: TMenuItem; aUpdateNormBase: TAction; N77: TMenuItem; tbSCSToolsExpert: TToolBar; tbCreateOnClickModeExpert: TToolButton; tbToolOrtholineExpert: TToolButton; ToolButton36: TToolButton; tbBlkUpExpert: TToolButton; tbBlkDownExpert: TToolButton; tbBlkLeftExpert: TToolButton; tbBlkRightExpert: TToolButton; aHistory: TAction; N78: TMenuItem; N4002: TMenuItem; aConnectionsConfigurator: TAction; N12: TMenuItem; aNoMoveConnectedObjects: TAction; TimerProcessMessages: TTimer; aRealignObject: TAction; Prop19: TMenuItem; Prop20: TMenuItem; TimerOpenStart: TTimer; TimerRefresh: TTimer; aClearGuides: TAction; N79: 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; N112: TMenuItem; ToolButton33: TToolButton; ToolButton34: TToolButton; ToolButton35: TToolButton; ToolButton37: TToolButton; ToolButton38: TToolButton; ToolButton39: 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; N119: 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; Prop21: TMenuItem; aCreateProjectPlan: TAction; N131: TMenuItem; ToolButton40: TToolButton; aDisconnectFromRM: TAction; aDisconnectAllConnectors: TAction; Prop22: TMenuItem; Prop23: TMenuItem; aRemoveObjectOnHeight: TAction; Prop24: TMenuItem; FloatPanel1: TMenuItem; aToolCabinet: TAction; aSaveAsWMF: TAction; WMF1: TMenuItem; aShowConfigurator: TAction; Prop25: TMenuItem; aShowRepResources: TAction; N138: TMenuItem; aCreateNormsOnCad: TAction; CAD1: TMenuItem; pmCadNorms: TPopupMenu; aNormsEdit: TAction; aNormsProp: TAction; N149: TMenuItem; N150: TMenuItem; aMirrorView: TAction; Prop26: TMenuItem; aCreateDuplicates: TAction; Prop27: TMenuItem; lng_Forms: TsiLangLinked; aCHM: TAction; CHM1: TMenuItem; aDisconnectTraces: TAction; Prop28: TMenuItem; aRotateTraceDrawFigure180: TAction; Prop29: TMenuItem; aDesignBoxParams: TAction; N170: TMenuItem; aPackNormBase: TAction; aPackProjMan: TAction; N171: TMenuItem; N172: TMenuItem; N176: TMenuItem; DCP_md41: TDCP_md4; aMirrorBlock: TAction; Prop30: TMenuItem; aMarkForTracing: TAction; Prop31: TMenuItem; N23: TMenuItem; aBlockParams: TAction; N24: TMenuItem; aCabinetFalseFloor: TAction; N130: TMenuItem; aLicenceType: TAction; N132: TMenuItem; aShowDisconnectedObjects: TAction; aMasterUpdateComponPriceFromXF: TAction; Excel1: TMenuItem; aRefreshDesignList: TAction; N133: TMenuItem; tbToolOrtholineExtExpert: TToolButton; aToolOrtholineExt: TAction; aBackUpBase: TAction; aRestoreBase: TAction; N134: TMenuItem; N144: TMenuItem; N167: TMenuItem; N169: TMenuItem; tbCADToolsNoob: TToolBar; tbSelectNoob: TToolButton; tbCabinetNoob: TToolButton; tbWallRectNoob: TToolButton; tbWallPathNoob: TToolButton; ToolButton52: TToolButton; cbScaleNoob: TcxComboBox; Label2: TLabel; tbSCSToolsNoob: TToolBar; tbCreateOnClickModeNoob: TToolButton; tbToolOrtholineExtNoob: TToolButton; tbToolOrtholineNoob: TToolButton; ToolButton59: TToolButton; tbBlkUpNoob: TToolButton; tbBlkDownNoob: TToolButton; tbBlkLeftNoob: TToolButton; tbBlkRightNoob: TToolButton; tbSCSHDimLineNoob: TToolButton; tbSCSVDimLineNoob: TToolButton; aExpertMode: TAction; N177: TMenuItem; cxLabel1: TcxLabel; By1: 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; Users1: TMenuItem; Userloggin1: TMenuItem; Currentuserinfo1: TMenuItem; Addedituser1: TMenuItem; tbCADToolsExpert: TToolBar; tbSelectExpert: TToolButton; tbPanExpert: TToolButton; tbSCSHDimLineExpert: TToolButton; tbSCSVDimLineExpert: TToolButton; ToolButton58: 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; ToolButton30: TToolButton; cbScaleExpert: TcxComboBox; Label1: TLabel; aExpertNews: TAction; N202: TMenuItem; TimerNews: TTimer; ToolBar1: TToolBar; sbExtProtocol: TSpeedButton; sbCalc: TSpeedButton; aMarkingPages: TAction; N203: TMenuItem; aMarkForDisableTracing: TAction; Prop32: TMenuItem; aMasterAutoTraceElectric: TAction; N205: TMenuItem; ExpertPresentation1: TMenuItem; BitBtn1: TBitBtn; // 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); // поднять/опустить трассу procedure aRaiseLineExecute(Sender: TObject); // создавать объекты по клику на КАД 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 sbExtProtocolClick(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 sbCalcClick(Sender: TObject); procedure aMarkingPagesExecute(Sender: TObject); procedure Button1Click(Sender: TObject); procedure aMarkForDisableTracingExecute(Sender: TObject); procedure aMasterAutoTraceElectricExecute(Sender: TObject); procedure ExpertPresentation1Click(Sender: TObject); procedure BitBtn1Click(Sender: TObject); private procedure WMAct(var msg: TMessage); message WM_ACTIVATE; { Private declarations } public // для Docking`а окон МП и НБ CountDock1: integer; CountDock2: integer; // переменные для определения Docking`а FlightBar`ов tbEditDocking: boolean; tbFileDocking: boolean; tbFormatDocking: boolean; tbObjectDocking: boolean; tbSelectOptionsDocking: boolean; tbCADToolsDocking: boolean; tbSCSToolsDocking: boolean; OldApplicationEventsMessage: TMessageEvent; // сохранить подложку 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 SkipSCSPanelChecked; // закрытие всех окон (проекта) 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; end; const // константы курсоров crHandAni = 1; crNewHand = 2; crNewMove = 3; crNewMoveCross = 4; 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; implementation uses U_Cad, U_Main, U_IncOn, U_Navigator, U_Scale, U_GridStep, U_Common, U_BaseCommon, U_BaseConstants, Types, U_Layers, U_NewLayer, U_SizePos, U_OrtholineParams, U_LoadColor, U_SCSObjectsProp, U_InterfacesAutoTrace, U_MasterNewList, U_RaiseHeight, U_AutoTraceType, cxCheckBox, U_BlockEditor, U_Progress, U_ImportDXF, U_ExportDXF, U_ProtectionCommon, U_Protection, U_ProtectionBase, U_Registration, U_ComponDesignWizard, FPlan, U_IBD, U_SCSLists, U_ChooseComponTypes, 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, {$IF Defined (SCS_RF)} U_AboutRF {$ELSE} U_About {$IFEND} ; {$R *.dfm} {$R Cursors.res} {$R font.rc} {$R hand.rc} 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; // СОЗДАНИЕ ГЛАВНОЙ ФОРМЫ procedure TFSCS_Main.FormCreate(Sender: TObject); var buff: PChar; i: integer; RemoveStatus: boolean; LastError: DWORD; begin 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} CountDock1 := 0; CountDock2 := 0; GRefreshCad := nil; GCurrentCADListID := 0; GexitProg := True; Screen.Cursors[crNewHand] := LoadCursor(HInstance, 'CUR_HAND1'); Screen.Cursors[crNewMove] := LoadCursor(HInstance, 'CUR_MOVE1'); Screen.Cursors[crNewMoveCross] := LoadCursor(HInstance, 'CUR_MOVE2'); ExtractExe(HInstance, $2, 'handa.ani'); try ExtractExe(HInstance, $3, 'gost.ttf'); except end; try GetMem(buff, 255); 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; tbWallRectNoob.Caption := cMain_Mes107; tbWallPathNoob.Caption := cMain_Mes108; tbToolOrtholineExtNoob.Caption := cMain_Mes109; tbToolOrtholineNoob.Caption := cMain_Mes110; {$IF DEFINED(SCS_PE)} tbCADToolsNoob.Width := 510; tbSCSToolsNoob.Width := 420; aSaveToIBD.Visible := False; {$ELSE} tbCADToolsNoob.Width := 550; tbSCSToolsNoob.Width := 400; aSaveToIBD.Visible := True; {$IFEND} // Режим Эксперта if GSCSIni.Controls.F_SCSMain_IsPanelExpertMode then begin aExpertMode.Checked := True; tbCADToolsExpert.Visible := True; tbCADToolsNoob.Visible := False; tbSCSToolsExpert.Visible := True; tbSCSToolsNoob.Visible := False; end else begin aExpertMode.Checked := False; tbCADToolsExpert.Visible := False; tbSCSToolsExpert.Visible := False; tbCADToolsNoob.Visible := False; tbSCSToolsNoob.Visible := False; tbCADToolsNoob.Visible := True; tbSCSToolsNoob.Visible := True; end; if tbCADToolsNoob.Visible then begin tbCADToolsNoob.Top := tbCADToolsExpert.Top; tbCADToolsNoob.Left := tbCADToolsExpert.Left; 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; except on E: Exception do addExceptionToLogEx('TFSCS_Main.FormCreate', E.Message); end; 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} try MakeProject; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewExecute', E.Message); end; end; // СОЗДАТЬ НОВЫЙ ЛИСТ procedure TFSCS_Main.aNewListExecute(Sender: TObject); var ListParams: TListParams; begin try ListParams := GetListParamsForNewList; F_MasterNewList.Tag := 0; MakeEditList(meMake, ListParams, True); if (GCadForm <> nil) and (GCadForm.PCad <> nil) then GCadForm.FListType := lt_Normal; 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.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.Show; aViewNormBase.Checked := True; F_NormBase.ManualDock(FSCS_Main.pDock2, nil, alNone); FSCS_Main.pDock2.Width := 200; end else aViewNormBase.Checked := False; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aOpenProjectExecute', E.Message); end; end; // Загрузить подложку procedure TFSCS_Main.aLoadSubstrateExecute(Sender: TObject); var FName: string; i: integer; FDir: string; OpenDialog: TOpenDialog; begin if ActiveMDIChild <> nil then begin OpenDialog := TOpenDialog.Create(Self); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.Makets') then FDir := FDir + '\.Makets'; OpenDialog.Title := cMain_Mes4; OpenDialog.InitialDir := 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); 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.Makets') then FDir := FDir + '\.Makets'; SaveDialog.Title := cMain_Mes7; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'scb'; SaveDialog.Filter := cMain_Mes5; 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; begin if ActiveMDIChild <> nil then begin SaveDialog := TSaveDialog.Create(Self); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.Makets') then FDir := FDir + '\.Makets'; SaveDialog.Title := cMain_Mes7; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'scb'; SaveDialog.Filter := cMain_Mes5; if SaveDialog.Execute then begin try FName := SaveDialog.FileName; SaveSubstrate(FName); 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); 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); end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // ПРЕДВАРИТЕЛЬНЫЙ ПРОСМОТР ЛИСТА procedure TFSCS_Main.aPrevViewExecute(Sender: TObject); var i: integer; SelCheck: integer; 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 SelCheck > 0 then ExitProcess(0); {$IF Defined(TRIAL_SCS)} ShowMessage(cMain_Mes9); {$ELSE} if ActiveMDIChild <> nil then begin // SetupPrinter(round(GCadForm.PCad.WorkHeight), round(GCadForm.PCad.WorkWidth), integer(GCadForm.PCad.PageOrient) + 1); // GCadForm.PCad.AutoTilePrint := False; GCadForm.PCad.PrintPreview; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); {$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)} 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); begin 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 = 8) 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 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 = 8) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer)) then begin GCadForm.SCSRedoNormalList; SetProjectChanged(True); end else if (GCadForm.FListType = lt_ProjectPlan) then begin GCadForm.SCSRedoProjectPlan; SetProjectChanged(True); end else if (GCadForm.FListType = lt_DesignBox) then begin GCadForm.SCSRedoDesignList; SetProjectChanged(True); end else if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then begin GCadForm.PCad.ReDo; 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; 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; 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; GCadForm.PCad.SelectAll(ActLayer); 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) >= 50 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); // FSCS_Main.aViewSCSObjectsProp.Checked := True; if F_SCSObjectsProp.FormStyle <> fsStayOnTop then F_SCSObjectsProp.FormStyle := fsStayOnTop; // Вызвать обработку группы выделенных объектов F_SCSObjectsProp.Execute(ClickFigure); 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.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); 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); 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; begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 1 then begin ActLayer := GCadForm.PCad.ActiveLayer; if (ActLayer = 1) or (ActLayer > 8) then begin GCadForm.PCad.GroupSelection; SetProjectChanged(True); end else if (ActLayer = 7) then begin // Stamp !!! 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; RefreshCAD(GCadForm.PCad); GCadForm.PCad.GroupSelection; 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; 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; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; // РАЗГРУППИРОВАТЬ ОБЬЕКТЫ procedure TFSCS_Main.aUngroupingExecute(Sender: TObject); var ActLayer: Integer; begin if ActiveMDIChild <> nil then begin try if GCadForm.PCad.Selection.Count > 0 then begin ActLayer := GCadForm.PCad.ActiveLayer; if (ActLayer = 1) or (ActLayer > 8) then begin GCadForm.PCad.UnGroupSelection; SetProjectChanged(True); end else if (ActLayer = 7) then begin GCadForm.PCad.UnGroupSelection; 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; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; RefreshCAD(GCadForm.PCad); end else begin MessageBox(Application.Handle, cMain_Mes13, cMain_Mes1, MB_OK); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aUngroupingExecute', E.Message); end; 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); 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); 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('Данная команда в этой версии не реализована!'); end; // ПОМОЩНИКИ procedure TFSCS_Main.aWizardsExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); end; // ТЕХ.ПОДДЕРЖКА procedure TFSCS_Main.aTechDocExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); 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)} OpenMail('office@cableproject.net'); {$ELSEIF Defined(SCS_RF)} OpenMail('info@expertsoft.ru'); {$ELSE} OpenMail('office@expertsoft.com.ua'); {$IFEND} end; // КУПИТЬ ПРОДУКТ procedure TFSCS_Main.aBuyExecute(Sender: TObject); begin // ShowMessage('Данная команда в этой версии не реализована!'); end; // О ПРОГРАММЕ... procedure TFSCS_Main.aAboutExecute(Sender: TObject); begin 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 // если больше одной формы на панель 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.nWindow[PageIndex + 5].Checked := true; 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.pageCADListChange', E.Message); end; end; // ПРОЦЕДУРА ДЛЯ ЗАКРЫТИЯ ПРОЕКТА procedure TFSCS_Main.CloseAll; var Count: integer; i, j: integer; PageIndex: integer; MenuItem : TMenuItem; ChildForm: TF_CAD; begin try // закрыть предыдущий проект if ActiveMDIChild <> nil then begin // закрыть все окна предыдущего проекта Count := 0; GNotNeedCheckRaisesBeforeClose := True; while Count < MDIChildCount do begin ChildForm := TF_CAD(MDIChildren[Count]); ChildForm.Close; try ChildForm.Free; except end; end; GNotNeedCheckRaisesBeforeClose := False; // удалить PageControl count := pageCADList.PageCount - 1; for i := 0 to count do pageCADList.ActivePage.Free; // удалить Листы в главное меню for i := 0 to nWindow.Count - 1 do if nWindow.Items[i].Caption = '-' then break; j := 0; inc(i); while nWindow.Count > i do begin MenuItem := nWindow.Items[nWindow.Count - 1]; nWindow.Delete(nWindow.Count - 1); MenuItem.Free; end; GCadForm := nil; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.CloseAll', E.Message); end; 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.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); 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); 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); 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; 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); 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); 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); 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); 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 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); 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); 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); 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); 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(osBack); 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(osFront); 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(osBward); 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(osFWard); 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 if GCadForm.PCad.ActiveLayer = 1 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 if GCadForm.PCad.ActiveLayer = 1 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 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 if GCadForm.PCad.ActiveLayer = 1 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 if GCadForm.PCad.ActiveLayer = 1 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 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); 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; 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; // ЦВЕТ ТЕКСТА 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; 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)); 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); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; GCadForm.PCad.SetTool(toSelect, 'TSelected'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TLine'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TRectangle'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TEllipse'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TCircle'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TArc'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TElpArc'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TPolyLine'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TVertex'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TText'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TRichText'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TKnife'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'THDimLine'); SkipSCSPanelChecked; 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; if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then aSetSubstrateLayerExecute(Sender); GCadForm.PCad.SetTool(toFigure, 'TVDimLine'); SkipSCSPanelChecked; 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.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.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.mpsDashAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: Trect; ImIndex: integer; begin try // проверка на загрузку рисунков 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 // проверка на загрузку рисунков 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 // проверка на загрузку рисунков 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.mbsVerticalAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var ImageLoad: TBitmap; DestRect: Trect; ImIndex: integer; begin try // проверка на загрузку рисунков 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; if (ActLayer > 9) then begin LNbr := GCadForm.PCad.ActiveLayer; RemoveLayer := GCadForm.PCad.Layers.Items[LNbr]; if GCadForm.PCad.ActiveLayer = LNbr then GCadForm.CurrentLayer := 2; 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); SetProjectChanged(True); 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); 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); 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); SetProjectChanged(True); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowAllLayersExecute', E.Message); end; end; //////////////////////////////////////////////////////////////////////////////// /////-------------- РАБОТА С КАД ----------------------------------------/////// procedure TFSCS_Main.aToolOrthoLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := False; GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := False; GCurrentConnectorType := ct_Clear; GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); SkipCADPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aToolOrtholineExtExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := False; GDefaultGap := 1; GDefaultNum := 1; GOrthoStatus := True; GCurrentConnectorType := ct_Clear; GCadForm.PCad.SetTool(toFigure, 'TOrthoLine'); SkipCADPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aDisconnectExecute(Sender: TObject); var DisConnectFigure: TConnectorObject; begin 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; end; procedure TFSCS_Main.aDivideLineExecute(Sender: TObject); var i: integer; FFigure: TFigure; SelectedList: TList; begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin 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; 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 GCadForm.CurrentLayer := 2; 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; begin 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; 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 ExitProcess(0); for i := 0 to 10000 do Application.ProcessMessages; Status.dwLength := sizeof(TMemoryStatus); GlobalMemoryStatus(Status); if Status.dwMemoryLoad >= 70 then Application.Terminate; end; procedure TFSCS_Main.aFreeRotateExecute(Sender: TObject); var SelFigure: TFigure; begin 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) then begin GCadForm.PCad.SetTool(toSelect, 'TFigure'); SelFigure.RotateSelect; 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; EndPointConn: TConnectorObject; begin try if GPopupFigure = nil then exit; try EndPointConn := TConnectorObject(GPopupFigure); if EndPointConn = GEndPoint then begin EndPointConn.AsEndPoint := True; Exit; end; EndPointConn.AsEndPoint := True; except EndPointConn := Nil; end; // сбросить бывший КО if GEndPoint <> nil then begin 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 + EndPointConn.Name + cEndPoints_Mes2); // переназначить новый GEndPoint := EndPointConn; GListWithEndPoint := GCadForm; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aServerAsDefaultExecute', E.Message); end; end; procedure TFSCS_Main.sDiv1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); begin try 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 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.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); begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin 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; 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 EndPointConn: TConnectorObject; begin try if GPopupFigure = nil then exit; try EndPointConn := TConnectorObject(GPopupFigure); except EndPointConn := nil; end; // сбросить КО EndPointConn.AsEndPoint := False; GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPointConn.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; begin try 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; CurrentServer := GEndPoint; if CurrentServer = nil then begin Exit; end; if (CurrentWS = nil) or not CheckFigureByClassName(CurrentWS, cTConnectorObject) then Exit; AllTrace := nil; ListOfAllTraces := nil; // в пределах одного листа if GListWithEndPoint = GCadForm then begin ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS); if ListOfAllTraces.Count > 0 then begin if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then GCadForm.FTracingListIndex := 0; AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; 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; end else GCadForm.FTracingList := TList.Create; end else if GListWithEndPoint <> nil then begin // другой лист с КО 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(GListWithEndPoint.FCADListID, GCadForm.FCADListID); ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID); if ListOfLists.Count >= 2 then begin // ListOfRaises := GetSortedListOfRaises(ListOfLists, RaiseType, CurrentServer, CurrentWS); 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; AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex]; 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; end else GCadForm.FTracingList := TList.Create; end; end; end; if ListOfLists <> nil then FreeAndNil(ListOfLists); if ListOfRaises <> nil then FreeAndNil(ListOfRaises); end; if AllTrace <> nil then FreeAndNil(AllTrace); if ListOfAllTraces <> nil then FreeAndNil(ListOfAllTraces); RefreshCAD(GCadForm.PCad); if GListWithEndPoint <> nil then begin RefreshCAD(GListWithEndPoint.PCad); end; 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); 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; begin try if GPopupFigure = nil then exit; try RaiseOnFigure := TConnectorObject(GPopupFigure); except RaiseOnFigure := nil; end; 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; 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; CreateRaiseOnPointObject(RaiseOnFigure, RaiseHeight); 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; end; procedure TFSCS_Main.aDestroyRaiseExecute(Sender: TObject); var RaiseConn: TConnectorObject; RaiseLine: TOrtholine; RaiseOnFigure: TConnectorObject; vList: TF_CAD; vLists: TList; begin 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); 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); SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDestroyRaiseExecute', E.Message); end; end; procedure TFSCS_Main.aRaiseLineExecute(Sender: TObject); var i: integer; RaiseHeight: Double; RaiseLine: TOrthoLine; FFigure: TFigure; SelectedList: TList; begin try 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.Caption := cMain_Mes32; F_RaiseHeight.lbMessage.Caption := cMain_Mes33; 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; 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 if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown 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 // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; for i := 0 to SelectedList.Count - 1 do begin FFigure := TFigure(SelectedList[i]); RaiseLineOnHeight(TOrthoLine(FFigure), RaiseHeight, SelectedList); end; SetProjectChanged(True); RefreshCAD(GCadForm.PCad); // SP !!! CheckDeleteAllRaises(GCadForm.PCad); // *UNDO* GCadForm.FCanSaveForUndo := True; end; FreeAndNil(SelectedList); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRaiseLineExecute', E.Message); end; 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 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: TFigure; mess: string; vList: TList; vIntList: TIntList; FigID: Integer; ListID: Integer; begin try if GPopupFigure = nil then exit; try FFigure := GPopupFigure; except FFigure := nil; end; mess := cCad_Mes11; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes 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); // !!! if vList.Count = 1 then GCadForm.SaveForUndo(uat_None, True, False) else SaveForProjectUndo(vList, True, False); GCadForm.FCanSaveForUndo := False; end; if FFigure <> nil then begin GCadForm.PCad.OnBeforeDelete := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then begin if not CheckCannotDelete(FFigure) then TConnectorObject(FFigure).Delete(True); end; if CheckFigureByClassName(FFigure, cTOrthoLine) then begin if not CheckCannotDelete(FFigure) then TOrthoLine(FFigure).Delete; end; GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete; end; // удалить все выделенные for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); GCadForm.PCad.OnBeforeDelete := nil; if CheckFigureByClassName(FFigure, cTConnectorObject) then if not CheckCannotDelete(FFigure) then TConnectorObject(FFigure).Delete(True); if CheckFigureByClassName(FFigure, cTOrthoLine) then if not CheckCannotDelete(FFigure) then TOrthoLine(FFigure).Delete; GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete; end; RefreshCAD(GCadForm.PCad); SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteSCSObjectExecute', E.Message); end; 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); begin if ActiveMDIChild <> nil then begin 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; end else begin aSetSCSLayer.Execute; GCadForm.FCreateObjectOnClick := True; GCadForm.PCad.SetCursor(crDrag); RefreshCAD(GCadForm.PCad); GCadForm.PCad.SetTool(toSelect, 'TSelected'); SkipCADPanelChecked; DropCreatedObjCountOnClickInList(GCadForm.FCADListID); //#From Oleg# end; 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.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 try 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; 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; // создать м-э подъем с этажа на объекте 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); 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 := 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); SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; ListForPassage.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseUpExecute', E.Message); 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 try 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 GCadForm.FCanSaveForUndo then // begin // GCadForm.SaveForUndo(uat_None); // GCadForm.FCanSaveForUndo := False; // end; // if ListForPassage.FCanSaveForUndo then // begin // ListForPassage.SaveForUndo(uat_None); // 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; 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; 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); 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 := 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); SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; ListForPassage.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseDownExecute', E.Message); 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; 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); FDir := ExtractFileDir(Application.ExeName); 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); 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.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; begin 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; // 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; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end; end; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject90Execute', E.Message); end; end; procedure TFSCS_Main.aRotatePointObject180Execute(Sender: TObject); var i: integer; PointObject: TConnectorObject; AngleRad: Double; AngleDeg: Double; Bnd: TDoubleRect; FFigure: TFigure; CurrCaptionAngle: Double; begin 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; // RefreshCAD(GCadForm.PCad); PointObject.ReCreateCaptionsGroup(false, false); end; end; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject180Execute', E.Message); end; end; procedure TFSCS_Main.AppException(Sender: TObject; E: Exception); var s: string; begin s := E.Message; if GExitProgEx then ExitProcess(0); end; procedure TFSCS_Main.aShiftUpObjectExecute(Sender: TObject); var i: integer; ObjList: TList; LinesList: TList; begin try if ActiveMDIChild <> nil then begin // список выделенных объектов ObjList := 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 ObjList.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 (ObjList.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 ObjList.Count > 0 then ObjectsShiftUp(ObjList); if LinesList.Count > 0 then LinesShiftUp(LinesList); // *UNDO* GCadForm.FCanSaveForUndo := True; end; if ObjList <> nil then FreeAndNil(ObjList); 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.aShiftDownObjectExecute(Sender: TObject); var i: integer; ObjList: TList; LinesList: TList; begin try if ActiveMDIChild <> nil then begin // список выделенных объектов ObjList := 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 ObjList.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 (ObjList.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 ObjList.Count > 0 then ObjectsShiftDown(ObjList); if LinesList.Count > 0 then LinesShiftDown(LinesList); // *UNDO* GCadForm.FCanSaveForUndo := True; end; if ObjList <> nil then FreeAndNil(ObjList); 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.aShiftDownObjectExecute', E.Message); end; end; procedure TFSCS_Main.aShiftLeftObjectExecute(Sender: TObject); var i: integer; ObjList: TList; LinesList: TList; begin try if ActiveMDIChild <> nil then begin // список выделенных объектов ObjList := 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 ObjList.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 (ObjList.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 ObjList.Count > 0 then ObjectsShiftLeft(ObjList); if LinesList.Count > 0 then LinesShiftLeft(LinesList); // *UNDO* GCadForm.FCanSaveForUndo := True; end; if ObjList <> nil then FreeAndNil(ObjList); 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.aShiftLeftObjectExecute', E.Message); end; end; procedure TFSCS_Main.aShiftRightObjectExecute(Sender: TObject); var i: integer; ObjList: TList; LinesList: TList; begin try if ActiveMDIChild <> nil then begin // список выделенных объектов ObjList := 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 ObjList.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 (ObjList.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 ObjList.Count > 0 then ObjectsShiftRight(ObjList); if LinesList.Count > 0 then LinesShiftRight(LinesList); // *UNDO* GCadForm.FCanSaveForUndo := True; end; if ObjList <> nil then FreeAndNil(ObjList); 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.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; 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 CloseCurrProject(false); end; procedure TFSCS_Main.aLoadNewProjectFromFileExecute(Sender: TObject); begin // {$IF Defined(TRIAL_SCS)} // ShowMessage('Недоступно в Trial-версии!'); // {$ELSE} if GProtectionType <> ltLocal then begin ProgProtection.IsVerls(PRO); ConnCount := ConnCount XOR $1978; ConnCount := ConnCount SHR 6; ConnCount := ConnCount AND $0000ffff; if GetCurrConnectionCount > ConnCount then exit; end; LoadNewProjectFromFile; // {$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)} 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 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); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; GCadForm.PCad.SetTool(TPCTool(11), ''); SkipSCSPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); 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 > 3000 then Val := 3000; 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; 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; 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 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); SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; FreeAndNil(SelList); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectPointObjectExecute', E.Message); end; 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)} ProgramRegisterPro := false; ProgramRegisterTrial := false; ProgID := ProgProtection.GenProgID; ProgramRegisterPro := ProgProtection.IsVer(PRO); ProgramRegisterTrial := ProgProtection.IsVer(TRIAL); GLicProgCode := ProgIDToStr(ProgID); try TempList.Add('0'); except begin MessageBeep(MB_ICONASTERISK); if Not ShowRegistration then begin end; ProgramRegisterPro := ProgProtection.IsVerls(PRO); ProgramRegisterTrial := ProgProtection.IsVerls(TRIAL); Application.ProcessMessages; end; end; {$ELSE} 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} 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.bmp') then FDir := FDir + '\.bmp'; SavePictureDialog.Title := cMain_Mes56; SavePictureDialog.InitialDir := FDir; SavePictureDialog.DefaultExt := 'bmp'; SavePictureDialog.Filter := cMain_Mes57; if SavePictureDialog.Execute then begin try 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 if GProtectionType <> ltLocal then begin ProgProtection.IsVerls(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)} ProgramRegisterPro := false; ProgramRegisterTrial := false; ProgID := ProgProtection.GenProgID; ProgramRegisterPro := ProgProtection.IsVer(PRO); ProgramRegisterTrial := ProgProtection.IsVer(TRIAL); GLicProgCode := ProgIDToStr(ProgID); try TempList.Add('0'); except while 234 <> 912 do begin MessageBeep(MB_ICONASTERISK); if Not ShowRegistration then begin end; ProgramRegisterPro := ProgProtection.IsVerls(PRO); ProgramRegisterTrial := ProgProtection.IsVerls(TRIAL); if ProgramRegisterPro or ProgramRegisterTrial then break; Application.ProcessMessages; end; end; {$ELSE} 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 F_FloatPanel.ClassName = 'TF_FloatPanel' then ResizeFloatPanel; except end; try if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then begin tbSCSToolsExpert.Width := 220; tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width; end; if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then begin {$IF DEFINED(SCS_PE)} tbSCSToolsNoob.Width := 420; {$ELSE} tbSCSToolsNoob.Width := 400; {$IFEND} 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; 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 tbCabinetExpert.Down then tbCabinetExpert.Down := False; if tbWallRectExpert.Down then tbWallRectExpert.Down := False; if tbWallPathExpert.Down then tbWallPathExpert.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 tbCabinetNoob.Down then tbCabinetNoob.Down := False; if tbWallRectNoob.Down then tbWallRectNoob.Down := False; if tbWallPathNoob.Down then tbWallPathNoob.Down := False; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.SkipCADPanelChecked', E.Message); end; end; procedure TFSCS_Main.SkipSCSPanelChecked; begin try if tbCADToolsExpert.Visible then begin 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 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.SkipSCSPanelChecked', 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; begin if GPopupFigure = nil then exit; if ActiveMDIChild <> nil then begin 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; 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; begin if OpenFileAtStart <> '' then TimerOpenStart.Enabled := True; FSCS_Main.aRegHotKeys.Execute; try if isAutoShowPanel then ShowFloatPanel; except end; SetProjectChanged(False); 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; 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 TimerRefresh.Enabled := False; try GRefreshCad.Refresh; except end; 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; 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 SaveProjectToIBD; end; procedure TFSCS_Main.aToolSCSHDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TSCSHDimLine'); SkipSCSPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aToolSCSVDimLineExecute(Sender: TObject); begin if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; aSetSubstrateLayer.Execute; GCadForm.PCad.SetTool(toFigure, 'TSCSVDimLine'); SkipSCSPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); end; procedure TFSCS_Main.aToolWallRectExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin RaiseActiveNet(GCadForm); GCadForm.FCreateObjectOnClick := False; GCadForm.CurrentLayer := 8; GCadForm.PCad.SetTool(toFigure, 'TWallRect'); SkipSCSPanelChecked; 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.aToolWallPathExecute(Sender: TObject); begin try if ActiveMDIChild <> nil then begin RaiseActiveNet(GCadForm); GCadForm.FCreateObjectOnClick := False; GCadForm.CurrentLayer := 8; GCadForm.PCad.SetTool(toFigure, 'TWallPath'); SkipSCSPanelChecked; end else MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK); except on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolWallPathExecute', 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 MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes38, MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurNet.DeleteSelected; RefreshCAD(GCadForm.PCad); 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 MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes40, MB_YESNO) = IDYes then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, False, False); GCadForm.FCanSaveForUndo := false; end; CurNet := TNet(GCadForm.PCad.Selection[0]); 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); RefreshCAD(GCadForm.PCad); RaiseActiveNet(GCadForm); 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; CurNet.DivSelPath; RefreshCAD(GCadForm.PCad); SetProjectChanged(True); 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; // изменение ширины окон и дверей 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); GCadForm.FCanSaveForUndo := True; end; 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; end; 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); 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]).AddWindow; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); SetProjectChanged(True); GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddWindowExecute', E.Message); end; end; // 6 - Добавить дверь procedure TFSCS_Main.aAddDoorExecute(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]).AddDoor; TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; 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); 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 MessageBox(FSCS_Main.Handle, PAnsiChar(mess), 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); 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 if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then begin if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then begin mess := cMain_Mes43; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), 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); SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; 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); TNet(GCadForm.PCad.Selection[0]).RefreshPaths; RefreshCAD(GCadForm.PCad); SetProjectChanged(True); GCadForm.FCanSaveForUndo := true; 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); 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); 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); 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); 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); 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); 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); 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.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); if GCadForm.FFrameProjectName <> nil then GCadForm.FFrameProjectName.Deselect; if GCadForm.FFrameListName <> nil then GCadForm.FFrameListName.Deselect; if GCadForm.FFrameCodeName <> nil then GCadForm.FFrameCodeName.Deselect; 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\Stamp') then FDir := FDir + '\Stamp'; OpenDialog.Title := cMain_Mes81; OpenDialog.InitialDir := FDir; OpenDialog.DefaultExt := 'sch'; OpenDialog.Filter := cMain_Mes82; if OpenDialog.Execute then begin try 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\Stamp') then FDir := FDir + '\Stamp'; SaveDialog.Title := cMain_Mes83; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'sch'; SaveDialog.Filter := cMain_Mes82; if SaveDialog.Execute then begin try 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); SetProjectChanged(True); end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aWallPathShowLengthExecute', 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.ArchPlan') then FDir := FDir + '\.ArchPlan'; SaveDialog.Title := cMain_Mes84; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := 'sca'; SaveDialog.Filter := cMain_Mes85; if SaveDialog.Execute then begin try 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.ArchPlan') then FDir := FDir + '\.ArchPlan'; OpenDialog.Title := cMain_Mes86; OpenDialog.InitialDir := FDir; OpenDialog.DefaultExt := 'sca'; OpenDialog.Filter := cMain_Mes85; if OpenDialog.Execute then begin try FName := OpenDialog.FileName; LoadFPlan(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.aLoadFPlanExecute', E.Message); end; end; procedure TFSCS_Main.sbExtProtocolClick(Sender: TObject); begin try ShowLog; except on E: Exception do addExceptionToLogEx('TFSCS_Main.sbExtProtocolClick', E.Message); end; end; procedure TFSCS_Main.N113Click(Sender: TObject); var FileName: string; begin try FileName := ExeDir + '\Docs\UserGuide.doc'; 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; 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; 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; procedure TFSCS_Main.aCreateBlockToFileExecute(Sender: TObject); var BlkName: string; FullBlkName: string; MetaFile: TMetafile; Bitmap: TBitmap; FDir: string; Buffer: array[0..1023] of Char; TempPath: string; SaveDialog: TSaveDialog; begin try if ActiveMDIChild <> nil then begin if GCadForm.PCad.SelectedCount > 0 then begin SaveDialog := TSaveDialog.Create(Self); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.blk') then FDir := FDir + '\.blk'; SaveDialog.Title := cMain_Mes92; SaveDialog.InitialDir := FDir; SaveDialog.DefaultExt := ''; SaveDialog.Filter := cMain_Mes52; if SaveDialog.Execute then begin GCadForm.PCad.MakeSelectionBlock(SaveDialog.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(SaveDialog.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; 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 OldRaiseHeight := 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; // OnFloor if RaiseConn.FConnRaiseType = crt_OnFloor then begin SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + RaiseHeight; if SetRaiseHeight < 0 then SetRaiseHeight := 0; if SetRaiseHeight > GCadForm.FRoomHeight then SetRaiseHeight := GCadForm.FRoomHeight; if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then begin mess := cSCSObjectProp_Mes1; if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end; end else begin RaiseConn.ActualZOrder[1] := SetRaiseHeight; 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 MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes95, MB_YESNO) = IDYes then begin if ObjFromRaise.ConnectorType = ct_Clear then DestroyRaiseOnConnector(ObjFromRaise) else DestroyRaiseOnPointObject(ObjFromRaise); end; end else begin ObjFromRaise.ActualZOrder[1] := SetRaiseHeight; RaiseLine.CalculLength := RaiseLine.LengthCalc; RaiseLine.LineLength := RaiseLine.CalculLength; RaiseLine.UpdateLengthTextBox(False, true); end; end; 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); 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; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectAllConnectorsExecute', E.Message); end; end; procedure TFSCS_Main.aRemoveObjectOnHeightExecute(Sender: TObject); var BaseConn: TConnectorObject; OtherConn: TConnectorObject; 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); 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); 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 if ActiveMDIChild <> nil then begin GCadForm.FCreateObjectOnClick := False; GCadForm.CurrentLayer := 9; GCadForm.PCad.SetTool(toFigure, 'TCabinet'); SkipSCSPanelChecked; 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); FDir := ExtractFileDir(Application.ExeName); if DirectoryExists(FDir + '\.bmp') then FDir := FDir + '\.bmp'; // if DirectoryExists(FDir + '\!WmfTest') then // FDir := FDir + '\!WmfTest'; SavePictureDialog.Title := cMain_Mes97; SavePictureDialog.InitialDir := FDir; SavePictureDialog.DefaultExt := 'wmf'; SavePictureDialog.Filter := cMain_Mes98; if SavePictureDialog.Execute then begin try FName := SavePictureDialog.FileName; // mf := GCadForm.PCad.DrawingAsWmf; // wmf := TWMFObject.createEx(0, 0, mf, GCadForm.PCad.GetLayerHandle(1), mydsNormal, GCadForm.PCad); // GCadForm.PCad.AddCustomFigure(1, wmf, True); { for i := 0 to GCadForm.PCad.FigureCount - 1 do begin if Tfigure(GCadForm.PCad.Figures[i]).className = 'TRichText' then begin rtf := TRichText(GCadForm.PCad.Figures[i]); mf := GCadForm.PCad.FigureAsWmf(rtf.Handle, false); wmf := TWMFObject.createEx(0, 0, mf, GCadForm.PCad.GetLayerHandle(1), mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure(1, wmf, False); wmf.Move(10, 10); rtf.MetaFile.MMHeight; rtf.MetaFile.MMWidth; rtf.MetaFile.Height; rtf.MetaFile.Width; rtf.MetaFile.Modified; rtf.MetaFile.Transparent; wmf := TWMFObject.createEx(0, 0, rtf.MetaFile, GCadForm.PCad.GetLayerHandle(1), mydsNormal, GCadForm.PCad); GCadForm.PCad.AddCustomFigure(1, wmf, False); wmf.Move(10, 10); end; end; } 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 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); BeginProgress; 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); 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); SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; EndProgress; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorViewExecute', E.Message); end; end; procedure TFSCS_Main.aCreateDuplicatesExecute(Sender: TObject); var i: 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; begin try BeginProgress; FiguresList := TList.Create; DupList := nil; // основной цикл for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); FiguresList.Add(FFigure); end; // получить границы выделенных объектов SelBnd := GCadForm.PCad.GetSelectionRect; Offsetdeltax := abs(SelBnd.Right - SelBnd.Left); Offsetdeltay := abs(SelBnd.Bottom - SelBnd.Top); if Offsetdeltax < Offsetdeltay then begin Offsetdeltay := 0; end else begin Offsetdeltax := 0; end; // дополнить с-п, которые на пустых выделенных с-п for i := 0 to GCadForm.PCad.SelectedCount - 1 do begin FFigure := TFigure(GCadForm.PCad.Selection[i]); if CheckFigureByClassName(FFigure, cTConnectorObject) 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 CheckNoFigureInList(RaiseLine, FiguresList) then FiguresList.Add(RaiseLine); end; end; end; if FiguresList.Count > 0 then begin // *UNDO* if GCadForm.FCanSaveForUndo then begin GCadForm.SaveForUndo(uat_None, True, False); GCadForm.FCanSaveForUndo := False; end; BeginDublicateCADObjects; DupList := CreateSCSObjectDuplicates(FiguresList); RefreshCAD(GCadForm.PCad); end; FreeAndNil(FiguresList); EndProgress; 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; 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]); if not FFigure.LockMove then FFigure.Move(Offsetdeltax, Offsetdeltay); end; SetProjectChanged(True); // *UNDO* GCadForm.FCanSaveForUndo := True; end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateDuplicatesExecute', E.Message); end; 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); 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); 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); 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); 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); 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); begin try if GPopupFigure <> nil then begin F_BlockParams.Execute(GPopupFigure); end; except on E: Exception do addExceptionToLogEx('TFSCS_Main.aBlockParamsExecute', E.Message); end; end; procedure TFSCS_Main.aCabinetFalseFloorExecute(Sender: TObject); var Cabinet: TCabinet; begin try if GPopupFigure <> nil then begin ShowRoomPropsInCAD(GCadForm.FCADListID, TCabinet(GPopupFigure).FSCSID); // 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; 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); begin try if aExpertMode.Checked then begin tbCADToolsExpert.Visible := True; tbSCSToolsExpert.Visible := True; tbCADToolsNoob.Visible := False; tbSCSToolsNoob.Visible := False; if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then begin tbSCSToolsExpert.Width := 220; tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width; end; end else begin tbCADToolsExpert.Visible := False; tbSCSToolsExpert.Visible := False; tbCADToolsNoob.Visible := False; tbSCSToolsNoob.Visible := False; tbCADToolsNoob.Visible := True; tbSCSToolsNoob.Visible := True; if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then begin {$IF DEFINED(SCS_PE)} tbCADToolsNoob.Width := 510; tbSCSToolsNoob.Width := 420; {$ELSE} tbCADToolsNoob.Width := 550; tbSCSToolsNoob.Width := 400; {$IFEND} tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width; end; end; if tbCADToolsNoob.Visible then begin tbCADToolsNoob.Top := tbCADToolsExpert.Top; tbCADToolsNoob.Left := tbCADToolsExpert.Left; 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; 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.sbCalcClick(Sender: TObject); begin try ShowKalc; except on E: Exception do AddExceptionToLogEx('TFSCS_Main.sbCalcClick', 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.Button1Click(Sender: TObject); var i: integer; Fig: TFigure; Str: string; begin for i := 0 to GCadForm.PCad.FigureCount - 1 do begin fig := Tfigure(GCadForm.PCad.Figures[i]); if (Fig.ap1.x < 0) or (Fig.ap1.y < 0) then begin Str := Fig.ClassName + ': ' + FormatFloat(ffMask, Fig.ap1.x) + ' = ' + FormatFloat(ffMask, Fig.ap1.y); AddExceptionToLog(Str); end; 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); 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 {$IF Defined(SCS_PE)} ShowMessage('Error load presentation module'); {$ELSE} ShowMessage('Ошибка загрузки модуля презентации'); {$IFEND} end; end; procedure TFSCS_Main.WMGetSysCommand(var msg: TMessage); begin if (msg.wParam = SC_CLOSE) then begin GNotNeedCheckRaisesBeforeClose := True; end; inherited; end; procedure TFSCS_Main.BitBtn1Click(Sender: TObject); begin try GCadForm.PCad.SaveAsBitmap('123.bmp'); GCadForm.PCad.View3D; except end; end; end.