admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 17:25:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/Main/USCS_Main.pas
ShevaIV 5d5efaee01 Add form
2025-05-12 10:21:16 +03:00

27368 lines
938 KiB
ObjectPascal
Raw Blame History

//{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O-,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
//{$MINSTACKSIZE $00004000}
//{$MAXSTACKSIZE $00100000}
//{$IMAGEBASE $00400000}
//{$APPTYPE GUI}
unit USCS_Main;
interface
uses
Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ToolWin, ActnMan, ActnCtrls, ActnMenus, ActnList, Menus,
ComCtrls, ExtCtrls, StdCtrls, StdActns, ExtActns, cxControls, cxContainer, cxEdit, cxTextEdit,
cxMaskEdit, cxButtonEdit, ImgList, Buttons, PDF, Math,
/// PowerCad
PCPanel, PCDrawBox, PCDrawing, PowerCad, pcMsbar, {XP_Panel,} PCTypesUtils,
DrawObjects, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings,
DrawEngine, U_ESCadClasess, ColorGrd, Mask, RzCmboBx, RzLstBox, RzEdit,
RzButton, RzSpnEdt, RzBorder, RzCommon, AppEvnts, cxLookAndFeelPainters,
cxButtons, RzShellDialogs, Clipbrd, cxDropDownEdit, RzPanel, RzPopups, Shellapi, Contnrs,
siComp, siLngLnk, RzLabel, RzDBLbl, DCPcrypt2, DCPblockciphers,
DCPcast256, DCPripemd128, DCPmd4, IsPlugEdit, exgrid, ISCalendar, cxLabel,
RzRadChk, RzListVw, Printers, FPlan, LibJpeg, U_ArchCommon, KeyBoard,
RzSplit, FR_Class, FR_DSet, FR_DBSet, FR_View,
U_Common_Classes, FR_Desgn, FR_PrDlg, FR_Prntr, FastStrings,
//Tolik
U_ReindexMaster, GLObjects, cxGraphics, cxLookAndFeels,
PlatformDefaultStyleActnCtrls, {DBTables, SQLMemMain}{Tolik}GLKeyBoard, U_SelLists, DockTabSet,
XPMenu;
//TODO XPMenu, ÷òîáû þçàëñÿ òîò, ÷òî âîçëå ôàéëà USCS_Main â îðèãèíàëüíîé ïàïêå êîìïîíåíòà ïåðåèìåíîâàòü ïàñî÷êó è äêó-øêó
type
TSurfaceWin = class(TWinControl);
TMyLoglist = class(TMyObject)
private
StrList: TStringList;
FFileName: string;
public
constructor Create(aFName: string);
destructor Destroy; override;
procedure Add(aStr: string);
end;
{TSplitter = class(ExtCtrls.TSplitter)
private
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOldMouseMoveTick: Cardinal;
protected
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
published
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
end;}
TFSCS_Main = class(TForm)
ActionManager: TActionManager;
aSaveAsSubstrate: TAction;
aExport: TAction;
aImport: TAction;
aPrevView: TAction;
aPrint: TAction;
aExit: TAction;
aClose: TAction;
aUndo: TAction;
aRedo: TAction;
aCopy: TAction;
aCut: TAction;
aPaste: TAction;
aSelectAll: TAction;
aAllScreen: TAction;
a50: TAction;
a75: TAction;
a100: TAction;
a150: TAction;
a200: TAction;
aInc: TAction;
aInc1pt: TAction;
aDec1pt: TAction;
aShowRuler: TAction;
aShowGrid: TAction;
aViewBtnPanel: TAction;
aViewNormBase: TAction;
aViewLayers: TAction;
aViewCADObjectsProp: TAction;
aViewNavigator: TAction;
aRotate: TAction;
aBackwards: TAction;
aForward: TAction;
aGrouping: TAction;
aUngrouping: TAction;
aLock: TAction;
aUnlock: TAction;
aObjProperties: TAction;
aScale: TAction;
aNewWindow: TAction;
aCloseAllWindows: TAction;
aHelp: TAction;
aPresentation: TAction;
aInteractive: TAction;
aWizards: TAction;
aTechDoc: TAction;
aToAuthors: TAction;
aBuy: TAction;
aAbout: TAction;
aNew: TAction;
aLoadSubstrate: TAction;
PrintDialog: TPrintDialog;
pmObject: TPopupMenu;
MainMenu: TMainMenu;
mainFile: TMenuItem;
mainEdit: TMenuItem;
mainView: TMenuItem;
mainObject: TMenuItem;
mainFormat: TMenuItem;
mainSCS: TMenuItem;
mainWindow: TMenuItem;
mainHelp: TMenuItem;
N135: TMenuItem;
N136: TMenuItem;
N137: TMenuItem;
N140: TMenuItem;
N141: TMenuItem;
N142: TMenuItem;
N143: TMenuItem;
N145: TMenuItem;
N146: TMenuItem;
N147: TMenuItem;
N148: TMenuItem;
N151: TMenuItem;
N152: TMenuItem;
N153: TMenuItem;
N154: TMenuItem;
N155: TMenuItem;
N156: TMenuItem;
N157: TMenuItem;
N158: TMenuItem;
N159: TMenuItem;
N160: TMenuItem;
N161: TMenuItem;
N162: TMenuItem;
N163: TMenuItem;
N501: TMenuItem;
N751: TMenuItem;
N1001: TMenuItem;
N1501: TMenuItem;
N2001: TMenuItem;
N164: TMenuItem;
N165: TMenuItem;
N166: TMenuItem;
N168: TMenuItem;
N173: TMenuItem;
N174: TMenuItem;
N175: TMenuItem;
N178: TMenuItem;
N179: TMenuItem;
N181: TMenuItem;
N182: TMenuItem;
N183: TMenuItem;
N184: TMenuItem;
N185: TMenuItem;
N186: TMenuItem;
N190: TMenuItem;
N191: TMenuItem;
N192: TMenuItem;
N204: TMenuItem;
N206: TMenuItem;
N216: TMenuItem;
N217: TMenuItem;
N219: TMenuItem;
N220: TMenuItem;
N221: TMenuItem;
Wizards2: TMenuItem;
N222: TMenuItem;
N223: TMenuItem;
N224: TMenuItem;
Online2: TMenuItem;
N225: TMenuItem;
N226: TMenuItem;
pmList: TPopupMenu;
pmText: TPopupMenu;
pmiObjectProps: TMenuItem;
N227: TMenuItem;
N229: TMenuItem;
N230: TMenuItem;
N231: TMenuItem;
N232: TMenuItem;
N233: TMenuItem;
pmiListAllScreen: TMenuItem;
pmiList50: TMenuItem;
pmiList75: TMenuItem;
pmiList100: TMenuItem;
pmiList150: TMenuItem;
pmiList200: TMenuItem;
pmiListInc: TMenuItem;
pmiListInc1pt: TMenuItem;
pmiListDec1pt: TMenuItem;
pmiListBackgroundColor: TMenuItem;
N239: TMenuItem;
N240: TMenuItem;
N241: TMenuItem;
N242: TMenuItem;
N243: TMenuItem;
aViewProjectManager: TAction;
N1: TMenuItem;
aNewList: TAction;
PDock1: TPanel;
sDiv1: TSplitter;
sDiv2: TSplitter;
pDock2: TPanel;
pCADList: TPanel;
pageCADList: TPageControl;
aDelete: TAction;
aDeleteAll: TAction;
aDeSelectAll: TAction;
N2: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
aInsertText: TAction;
aInsertBitmap: TAction;
aPenStyle: TAction;
aPenColor: TAction;
aPenWidth: TAction;
aRowStyle: TAction;
aBrushStyle: TAction;
aTextCharset: TAction;
aFontStyle: TAction;
mPenStyle: TMenuItem;
mPenColor: TMenuItem;
mPenw: TMenuItem;
mRowstyle: TMenuItem;
N26: TMenuItem;
mBrushStyle: TMenuItem;
mBrushColor: TMenuItem;
N29: TMenuItem;
mTextColor: TMenuItem;
N31: TMenuItem;
N32: TMenuItem;
N33: TMenuItem;
N34: TMenuItem;
N35: TMenuItem;
N36: TMenuItem;
aFormatOrder: TAction;
aFormatAlign: TAction;
N1191: TMenuItem;
N1192: TMenuItem;
N37: TMenuItem;
N1193: TMenuItem;
N1194: TMenuItem;
N1195: TMenuItem;
mainOptions: TMenuItem;
aGridType: TAction;
aShowCenterGuides: TAction;
aShowGuideLines: TAction;
aSnaptoGrid: TAction;
aSnaptoGuides: TAction;
aSnaptoNearObject: TAction;
aGridColor: TAction;
aGuideColor: TAction;
aBackgroundColor: TAction;
aPageColor: TAction;
aAngularGuides: TAction;
aRulerSystem: TAction;
aRulerMode: TAction;
aPageLayout: TAction;
aPageOrientation: TAction;
aGridStep: TAction;
ShowRulers1: TMenuItem;
ShowGrids1: TMenuItem;
GridType1: TMenuItem;
ShowCenterGuides1: TMenuItem;
ShowGuideLines1: TMenuItem;
SnaptoGrid1: TMenuItem;
SnaptoGuides1: TMenuItem;
SnaptoNearObject1: TMenuItem;
GridColor1: TMenuItem;
GuideColor1: TMenuItem;
BackgroundColor1: TMenuItem;
PageColor1: TMenuItem;
AngularGuides1: TMenuItem;
RulerSystem1: TMenuItem;
RulerMode1: TMenuItem;
PageLayout1: TMenuItem;
PageOrientation1: TMenuItem;
GridStep1: TMenuItem;
N39: TMenuItem;
PageWidth1: TMenuItem;
PageHeight1: TMenuItem;
N40: TMenuItem;
N41: TMenuItem;
aSendtoBack: TAction;
aBringtoFront: TAction;
aSendBackwards: TAction;
aBringForwards: TAction;
aalTop: TAction;
aalBottom: TAction;
aalXcenter: TAction;
aalLeft: TAction;
aalRight: TAction;
aalYCenter: TAction;
apsClear: TAction;
apsDash: TAction;
apsDashDot: TAction;
apsDashDotDot: TAction;
apsDot: TAction;
apsSolid: TAction;
mpsSolid: TMenuItem;
mpsDash: TMenuItem;
mpsDot: TMenuItem;
mpsDashDot: TMenuItem;
mpsDashDotDot: TMenuItem;
mpsClear: TMenuItem;
aPenw1: TAction;
aPenw2: TAction;
aPenw3: TAction;
aPenw4: TAction;
aPenw5: TAction;
aPenw6: TAction;
aPenw7: TAction;
mPenw1: TMenuItem;
mPenw2: TMenuItem;
mPenw3: TMenuItem;
mPenw4: TMenuItem;
mPenw5: TMenuItem;
mPenw6: TMenuItem;
mPenw7: TMenuItem;
arsBothLight: TAction;
arsBothSolid: TAction;
arsLeftLight: TAction;
arsLeftSolid: TAction;
arsNone: TAction;
arsRightLight: TAction;
arsRightSolid: TAction;
mrsBothLight: TMenuItem;
mrsBothSolid: TMenuItem;
mrsLeftLight: TMenuItem;
mrsLeftSolid: TMenuItem;
mrsNone: TMenuItem;
mrsRightLight: TMenuItem;
mrsRightSolid: TMenuItem;
absBDiagonal: TAction;
absClear: TAction;
absCross: TAction;
absDiagCross: TAction;
absFDiagonal: TAction;
absHorizontal: TAction;
absSolid: TAction;
absVertical: TAction;
mbsSolid: TMenuItem;
mbsClear: TMenuItem;
mbsHorizontal: TMenuItem;
mbsVertical: TMenuItem;
mbsFDiagonal: TMenuItem;
mbsBDiagonal: TMenuItem;
mbsCross: TMenuItem;
mbsDiagCross: TMenuItem;
aTextBold: TAction;
aTextItalic: TAction;
aTextUnderLine: TAction;
aTextStrikeThrough: TAction;
extBold1: TMenuItem;
extItalic1: TMenuItem;
extUnderLine1: TMenuItem;
extStrikeThrough1: TMenuItem;
aANSI_CHARSET: TAction;
aDEFAULT_CHARSET: TAction;
aRUSSIAN_CHARSET: TAction;
ANSICHARSET1: TMenuItem;
DEFAULTCHARSET1: TMenuItem;
RUSSIANCHARSET1: TMenuItem;
aLineGrid: TAction;
aPointGrid: TAction;
aCrossGrid: TAction;
N43: TMenuItem;
N44: TMenuItem;
N45: TMenuItem;
aAngularNone: TAction;
aAngular90: TAction;
aAngular30: TAction;
aAngular60: TAction;
aAngular45: TAction;
None1: TMenuItem;
N90Degrees1: TMenuItem;
N30Degrees1: TMenuItem;
N45Degrees1: TMenuItem;
N60Degrees1: TMenuItem;
aMetric: TAction;
aWitworth: TAction;
aPageMode: TAction;
aWorldMode: TAction;
aLandscape: TAction;
aPortrait: TAction;
N46: TMenuItem;
N47: TMenuItem;
N48: TMenuItem;
N49: TMenuItem;
N50: TMenuItem;
N52: TMenuItem;
aA0: TAction;
aA1: TAction;
aA2: TAction;
aA3: TAction;
aA4: TAction;
aA5: TAction;
aA6: TAction;
aB4: TAction;
aB5: TAction;
aTabloid: TAction;
aLetter: TAction;
aCustom: TAction;
A01: TMenuItem;
A11: TMenuItem;
A21: TMenuItem;
A31: TMenuItem;
A41: TMenuItem;
A51: TMenuItem;
A61: TMenuItem;
B41: TMenuItem;
B51: TMenuItem;
N53: TMenuItem;
N54: TMenuItem;
N55: TMenuItem;
cbMainPanel: TControlBar;
tbFile: TToolBar;
tbNew: TToolButton;
tbNewList: TToolButton;
tbPrevView: TToolButton;
tbPrint: TToolButton;
tbObject: TToolBar;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton9: TToolButton;
ToolButton10: TToolButton;
ToolButton12: TToolButton;
ToolButton15: TToolButton;
pmOrderSelection: TPopupMenu;
N56: TMenuItem;
N57: TMenuItem;
N58: TMenuItem;
N59: TMenuItem;
aMoveSelection: TAction;
aRotateSelection: TAction;
aDuplicateSelection: TAction;
aMirrorSelection: TAction;
aToolSelect: TAction;
aToolLine: TAction;
aToolRectangle: TAction;
aToolEllipse: TAction;
aToolCircle: TAction;
aToolArc: TAction;
aToolElipticArc: TAction;
aToolPolyLine: TAction;
aToolPoint: TAction;
aToolRichText: TAction;
aToolKnife: TAction;
aToolHDimLine: TAction;
aToolVDimLine: TAction;
pmPenStyle: TPopupMenu;
pmPenWidth: TPopupMenu;
pmRowStyle: TPopupMenu;
pmBrushStyle: TPopupMenu;
ppsClear: TMenuItem;
ppsDash: TMenuItem;
ppsDashDot: TMenuItem;
ppsDashDotDot: TMenuItem;
ppsDot: TMenuItem;
ppsSolid: TMenuItem;
pPenw1: TMenuItem;
pPenw2: TMenuItem;
pPenw3: TMenuItem;
pPenw4: TMenuItem;
pPenw5: TMenuItem;
pPenw6: TMenuItem;
pPenw7: TMenuItem;
prsBothLight: TMenuItem;
prsBothSolid: TMenuItem;
prsLeftLight: TMenuItem;
prsLeftSolid: TMenuItem;
prsNone: TMenuItem;
prsRightLight: TMenuItem;
prsRightSolid: TMenuItem;
pbsBDiagonal: TMenuItem;
pbsClear: TMenuItem;
pbsCross: TMenuItem;
pbsDiagCross: TMenuItem;
pbsFDiagonal: TMenuItem;
pbsHorizontal: TMenuItem;
pbsSolid: TMenuItem;
pbsVertical: TMenuItem;
imagePanel: TImageList;
aTextFont: TAction;
aTextSize: TAction;
ImageStyles: TImageList;
aNewLayer: TAction;
aDeleteLayer: TAction;
aMergeVisible: TAction;
aMergeAll: TAction;
aFlueInactives: TAction;
aHideInactives: TAction;
aShowAllLayers: TAction;
N11: TMenuItem;
aToolMultiLine: TAction;
aDisconnect: TAction;
aDivideLine: TAction;
aToolOrthoLine: TAction;
tbLayers: TToolBar;
ToolButton47: TToolButton;
ToolButton53: TToolButton;
ToolButton55: TToolButton;
aSetSubstrateLayer: TAction;
aSetSCSLayer: TAction;
pmiListPageColor: TMenuItem;
pmiObjectSplit0: TMenuItem;
pmiObjectSplit1: TMenuItem;
aSetDefaultColors: TAction;
pmSCSObject: TPopupMenu;
pmiSCSObjProperties: TMenuItem;
aFreeRotate: TAction;
pmiListGridStep: TMenuItem;
aRegHotKeys: TAction;
aUnregHotKeys: TAction;
N30: TMenuItem;
N42: TMenuItem;
aAutoSelectTrace: TAction;
aServerAsDefault: TAction;
tbLoadSubstrate: TToolButton;
aOpenProject: TAction;
aRealignLine: TAction;
pmiSCSObjRealignLine: TMenuItem;
ApplicationEvents1: TApplicationEvents;
pmiSCSObjServerAsDefault: TMenuItem;
aNotAsServerDefault: TAction;
pmiSCSObjNotAsServerDefault: TMenuItem;
pmiSCSObjDivideLine: TMenuItem;
pmiSCSObjDisconnect: TMenuItem;
aSelectTracetoServer: TAction;
pmiSCSObjSelectTracetoServer: TMenuItem;
aToolText: TAction;
aMakeCabling: TAction;
pmiSCSObjMakeCabling: TMenuItem;
N65: TMenuItem;
aViewSCSObjectsProp: TAction;
aViewSCS: TMenuItem;
aCreateRaise: TAction;
pmiSCSObjCreateRaise: TMenuItem;
aDestroyRaise: TAction;
pmiSCSObjDestroyRaise: TMenuItem;
aMasterAutoTrace: TAction;
N68: TMenuItem;
pmFiguresByLevel: TPopupMenu;
aListProperties: TAction;
N71: TMenuItem;
pmiListProperties: TMenuItem;
aRaiseLine: TAction;
pmiSCSObjRaiseLine: TMenuItem;
aCreateObjectOnClick: TAction;
aDeleteSCSObject: TAction;
pmiSCSObjDeleteSCSObject: TMenuItem;
aShowConnFullness: TAction;
aShowCableFullness: TAction;
aShowCableChannelFullness: TAction;
aCreateObjectOnClickTool: TAction;
aCreateFloorRaiseUp: TAction;
aCreateFloorRaiseDown: TAction;
aTileWindows: TAction;
pmiSCSObjCreateFloorRaiseUp: TMenuItem;
pmiSCSObjCreateFloorRaiseDown: TMenuItem;
aOrderWindow1: TMenuItem;
N75: TMenuItem;
aCascadeWindows: TAction;
aCreateBlockToNB: TAction;
aInsertBlock: TAction;
aBlocksEditor: TAction;
aRotatePointObject90: TAction;
aRotatePointObject270: TAction;
aRotatePointObject180: TAction;
aShiftUpObject: TAction;
aShiftDownObject: TAction;
aShiftLeftObject: TAction;
aShiftRightObject: TAction;
aProjectProperties: TAction;
aOpenProjectAtCurrNode: TAction;
aCloseCurrProject: TAction;
aLoadNewProjectFromFile: TAction;
aSaveAsSCSProject: TAction;
aComponProperties: TAction;
aToolPan: TAction;
a400: TAction;
aDisconnectPointObject: TAction;
aRepWizard: TAction;
aSaveAsBMP: TAction;
aDesignBox: TAction;
aShowTracesLengthLimit: TAction;
aSaveProject: TAction;
aCurrProjectProperties: TAction;
aManual_Currency: TAction;
aManual_Nettypes: TAction;
aManual_Producers: TAction;
aManual_Interfaces: TAction;
aManual_ObjProp: TAction;
aManual_Legends: TAction;
aManual_ComponTypes: TAction;
aManual_Norms: TAction;
aManual_Resources: TAction;
aManual_NDS: TAction;
pmiObjectSplit2: TMenuItem;
N83: TMenuItem;
N84: TMenuItem;
pmiSCSObjRotatePointObject90: TMenuItem;
pmiSCSObjRotatePointObject270: TMenuItem;
pmiSCSObjRotatePointObject180: TMenuItem;
ImageArrows: TImageList;
N86: TMenuItem;
N87: TMenuItem;
N88: TMenuItem;
N89: TMenuItem;
N91: TMenuItem;
pmiSCSObjComponProperties: TMenuItem;
N4001: TMenuItem;
pmiSCSObjDisconnectPointObject: TMenuItem;
cbLayers: TcxComboBox;
N94: TMenuItem;
nSave: TMenuItem;
pmiSCSObjDesignBox: TMenuItem;
N51: TMenuItem;
N60: TMenuItem;
N61: TMenuItem;
nManuals: TMenuItem;
N63: TMenuItem;
N64: TMenuItem;
N66: TMenuItem;
N67: TMenuItem;
N69: TMenuItem;
N72: TMenuItem;
N73: TMenuItem;
N74: TMenuItem;
N92: TMenuItem;
N93: TMenuItem;
aChoiceNBPath: TAction;
aChoicePMPath: TAction;
aChoiceBaseOptions: TAction;
nSettings: TMenuItem;
N97: TMenuItem;
N98: TMenuItem;
N99: TMenuItem;
N19: TMenuItem;
N76: TMenuItem;
aRegistration: TAction;
mRegister: TMenuItem;
aUpdateNormBase: TAction;
N77: TMenuItem;
tbSCSToolsExpert: TToolBar;
tbBlkUpExpert: TToolButton;
tbBlkDownExpert: TToolButton;
tbBlkLeftExpert: TToolButton;
tbBlkRightExpert: TToolButton;
aHistory: TAction;
N78: TMenuItem;
pmiList400: TMenuItem;
aConnectionsConfigurator: TAction;
N12: TMenuItem;
aNoMoveConnectedObjects: TAction;
TimerProcessMessages: TTimer;
aRealignObject: TAction;
pmiSCSObjRealignLine2: TMenuItem;
pmiSCSObjRealignObject: TMenuItem;
TimerOpenStart: TTimer;
TimerRefresh: TTimer;
aClearGuides: TAction;
pmiListClearGuides: TMenuItem;
aSaveToIBD: TAction;
N80: TMenuItem;
aToolSCSHDimLine: TAction;
aToolSCSVDimLine: TAction;
aToolWallRect: TAction;
aToolWallPath: TAction;
aDeleteWallPath: TAction;
aDeleteWallRect: TAction;
aDivSelPath: TAction;
aSetWallPathWidth: TAction;
aSetAllWallPathWidth: TAction;
aAddWindow: TAction;
aAddDoor: TAction;
aDeleteWindowDoor: TAction;
aSetSizeWindowDoor: TAction;
pmArchDesign: TPopupMenu;
N81: TMenuItem;
N85: TMenuItem;
N100: TMenuItem;
N101: TMenuItem;
N102: TMenuItem;
N103: TMenuItem;
N104: TMenuItem;
N105: TMenuItem;
N106: TMenuItem;
aLoadStamp: TAction;
aSaveStamp: TAction;
N107: TMenuItem;
N108: TMenuItem;
aWallPathShowLength: TAction;
N109: TMenuItem;
aLoadFPlan: TAction;
aSaveFPlan: TAction;
N110: TMenuItem;
N111: TMenuItem;
nOpen: TMenuItem;
ToolButton35: TToolButton;
tbSaveProject: TToolButton;
N113: TMenuItem;
aAddColumn: TAction;
N114: TMenuItem;
aDeleteColumn: TAction;
aSetColumnAngle: TAction;
aSetColumnHeight: TAction;
aSetColumnWidth: TAction;
N115: TMenuItem;
N116: TMenuItem;
N117: TMenuItem;
N118: TMenuItem;
aDesignBoxCaptionHeight: TAction;
aDesignBoxCaptionWidth: TAction;
pmiObjectSplit3: TMenuItem;
N120: TMenuItem;
N121: TMenuItem;
aSetPathLineWidth: TAction;
aSetPathLineStyle: TAction;
N122: TMenuItem;
N123: TMenuItem;
aSetAllPathLineWidth: TAction;
aSetAllPathLineStyle: TAction;
N124: TMenuItem;
N125: TMenuItem;
aManual_SuppliesKinds: TAction;
N126: TMenuItem;
aMasterCableChannel: TAction;
N127: TMenuItem;
aMasterCableTracing: TAction;
N128: TMenuItem;
aCreateBlockToFile: TAction;
N129: TMenuItem;
aChangeRaiseHeight: TAction;
pmiSCSObjChangeRaiseHeight: TMenuItem;
aCreateProjectPlan: TAction;
N131: TMenuItem;
aDisconnectFromRM: TAction;
aDisconnectAllConnectors: TAction;
pmiSCSObjDisconnectAllConnectors: TMenuItem;
pmiSCSObjDisconnectFromRM: TMenuItem;
aRemoveObjectOnHeight: TAction;
pmiSCSObjRemoveObjectOnHeight: TMenuItem;
FloatPanel1: TMenuItem;
aToolCabinet: TAction;
aSaveAsWMF: TAction;
aShowConfigurator: TAction;
pmiSCSObjShowConfigurator: TMenuItem;
aShowRepResources: TAction;
N138: TMenuItem;
aCreateNormsOnCad: TAction;
CAD1: TMenuItem;
pmCadNorms: TPopupMenu;
aNormsEdit: TAction;
aNormsProp: TAction;
pmiCNNormsEdit: TMenuItem;
pmiCNNormsProp: TMenuItem;
aMirrorView: TAction;
pmiSCSObjMirrorView: TMenuItem;
aCreateDuplicates: TAction;
pmiSCSObjCreateDuplicates: TMenuItem;
lng_Forms: TsiLangLinked;
aCHM: TAction;
CHM1: TMenuItem;
aDisconnectTraces: TAction;
pmiSCSObjDisconnectTraces: TMenuItem;
aRotateTraceDrawFigure180: TAction;
pmiSCSObjRotateTraceDrawFigure180: TMenuItem;
aDesignBoxParams: TAction;
pmiListDesignBoxParams: TMenuItem;
aPackNormBase: TAction;
aPackProjMan: TAction;
nServices: TMenuItem;
N172: TMenuItem;
N176: TMenuItem;
aMirrorBlock: TAction;
pmiSCSObjMirrorBlock: TMenuItem;
aMarkForTracing: TAction;
pmiSCSObjMarkForTracing: TMenuItem;
pmiObjectSplit4: TMenuItem;
aBlockParams: TAction;
pmiBlockParams: TMenuItem;
aCabinetFalseFloor: TAction;
N130: TMenuItem;
aLicenceType: TAction;
N132: TMenuItem;
aShowDisconnectedObjects: TAction;
aMasterUpdateComponPriceFromXF: TAction;
Excel1: TMenuItem;
aRefreshDesignList: TAction;
pmiListRefreshDesignList: TMenuItem;
aToolOrtholineExt: TAction;
aBackUpBase: TAction;
aRestoreBase: TAction;
N134: TMenuItem;
N144: TMenuItem;
N167: TMenuItem;
N169: TMenuItem;
tbCADToolsNoob: TToolBar;
tbCADToolsNoob2: TToolBar;
tbSelectNoob: TToolButton;
tbCabinetNoob: TToolButton;
tbWallRectNoob: TToolButton;
tbWallPathNoob: TToolButton;
cbScaleNoob: TcxComboBox;
Label2: TLabel;
tbSCSToolsNoob: TToolBar;
tbBlkUpNoob: TToolButton;
tbBlkDownNoob: TToolButton;
tbBlkLeftNoob: TToolButton;
tbBlkRightNoob: TToolButton;
tbSCSHDimLineNoob: TToolButton;
tbSCSVDimLineNoob: TToolButton;
aExpertMode: TAction;
N177: TMenuItem;
cxLabel1: TcxLabel;
mainTools: TMenuItem;
N180: TMenuItem;
N187: TMenuItem;
N188: TMenuItem;
N193: TMenuItem;
N194: TMenuItem;
N195: TMenuItem;
N196: TMenuItem;
N197: TMenuItem;
N198: TMenuItem;
RTF1: TMenuItem;
N199: TMenuItem;
N200: TMenuItem;
N201: TMenuItem;
aShowPMUsers: TAction;
aLoginUserToProMan: TAction;
aShowCurrUserInfo: TAction;
nUsers: TMenuItem;
Userloggin1: TMenuItem;
Currentuserinfo1: TMenuItem;
Addedituser1: TMenuItem;
tbCADToolsExpert: TToolBar;
tbSelectExpert: TToolButton;
tbPanExpert: TToolButton;
tbSCSHDimLineExpert: TToolButton;
tbSCSVDimLineExpert: TToolButton;
tbsToolsExpert: TToolButton;
tbLineExpert: TToolButton;
tbRectangleExpert: TToolButton;
tbEllipseExpert: TToolButton;
tbCircleExpert: TToolButton;
tbArcExpert: TToolButton;
tbElipticArcExpert: TToolButton;
tbPolyLineExpert: TToolButton;
tbPointExpert: TToolButton;
tbTextExpert: TToolButton;
tbRichTextExpert: TToolButton;
tbKnifeExpert: TToolButton;
tbHDimLineExpert: TToolButton;
tbVDimLineExpert: TToolButton;
ToolButton26: TToolButton;
tbCabinetExpert: TToolButton;
tbWallRectExpert: TToolButton;
tbWallPathExpert: TToolButton;
cbScaleExpert: TcxComboBox;
aExpertNews: TAction;
N202: TMenuItem;
TimerNews: TTimer;
tbOther: TToolBar;
aMarkingPages: TAction;
N203: TMenuItem;
aMarkForDisableTracing: TAction;
pmiSCSObjMarkForDisableTracing: TMenuItem;
aMasterAutoTraceElectric: TAction;
N205: TMenuItem;
ExpertPresentation1: TMenuItem;
//pmiSCSObjRotatePointObject270: TMenuItem;
aCreateTrunk: TAction;
pmiSCSObjCreateTrunk: TMenuItem;
pmConnectedPoints: TPopupMenu;
miShowConnectedConnCompons: TMenuItem;
pmConnectedLines: TPopupMenu;
miShowConnectedLineCompons: TMenuItem;
// 2011-05-10
n3DModelForList: TMenuItem;
tbHouseExpert: TToolButton;
tbHouseNoob: TToolButton;
ToolButton16: TToolButton;
aToolHouse: TAction;
pmHouseDesign: TPopupMenu;
aAddApproach: TAction;
aDeleteHouse: TAction;
pmiHDAddApproach: TMenuItem;
pmiHDDeleteHouse: TMenuItem;
aInsertKnotForHouse: TAction;
aDeleteKnotForHouse: TAction;
pmiHDInsertKnotForHouse: TMenuItem;
pmiHDDeleteKnotForHouse: TMenuItem;
aEditApproach: TAction;
aRotateApproach: TAction;
pmiHDEditApproach: TMenuItem;
pmiHDRotateApproach: TMenuItem;
aModApproach: TAction;
pmiHDModApproach: TMenuItem;
pmiHDServerAsDefault: TMenuItem;
pmiHDNotAsServerDefault: TMenuItem;
tbCabinetExtExpert: TToolButton;
aToolCabinetExt: TAction;
aConvertSegmentToArc: TAction;
aInsertKnotForCabinet: TAction;
aDeleteKnotForCabinet: TAction;
N214: TMenuItem;
N215: TMenuItem;
N234: TMenuItem;
aShowDefectObjects: TAction;
OpenDialog1: TOpenDialog;
aInvertArcSegment: TAction;
N244: TMenuItem;
tbCabinetExtNoob: TToolButton;
tbPanNoob: TToolButton;
ToolButton3: TToolButton;
tbCreateOnClickModeExpert: TToolButton;
tbToolOrtholineExtExpert: TToolButton;
tbToolOrtholineExpert: TToolButton;
ToolButton20: TToolButton;
ToolButton18: TToolButton;
tbCreateOnClickModeNoob: TToolButton;
tbToolOrtholineExtNoob: TToolButton;
tbToolOrtholineNoob: TToolButton;
ToolButton21: TToolButton;
aToolSCSHDimLine1: TMenuItem;
aToolSCSVDimLine1: TMenuItem;
aOpenVectorDrawing: TAction;
aOpenRasterDrawing: TAction;
aSaveVectorDrawing: TAction;
aSaveRasterDrawing: TAction;
N3: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
tbCHM: TToolButton;
aCreateVertical: TAction;
pmiSCSObjCreateVertical: TMenuItem;
tbArch: TToolBar;
ToolButton1: TToolButton;
aNetPathToArc: TAction;
N13: TMenuItem;
aInvertNetPathArc: TAction;
N14: TMenuItem;
n3DModelForProject: TMenuItem;
aAutoCreateTraces: TAction;
pmiSCSObjAutoCreateTraces: TMenuItem;
aDivTracesOnRoowWalls: TAction;
pmiSCSObjDivTracesOnRoowWalls: TMenuItem;
pmShowPathLengthType: TPopupMenu;
N17: TMenuItem;
N18: TMenuItem;
N22: TMenuItem;
aPathLengthTypePoints: TAction;
aPathLengthTypeInner: TAction;
aPathLengthTypeOuter: TAction;
aPathTraceLengthTypePoints: TAction;
aPathTraceLengthTypeInner: TAction;
aPathTraceLengthTypeOuter: TAction;
pmShowPathTraceLengthType: TPopupMenu;
MenuItem1: TMenuItem;
MenuItem2: TMenuItem;
MenuItem3: TMenuItem;
pmiArchDesignSplit2: TMenuItem;
N24: TMenuItem;
N901: TMenuItem;
N25: TMenuItem;
N2701: TMenuItem;
N902: TMenuItem;
N2702: TMenuItem;
N2703: TMenuItem;
N27: TMenuItem;
aMirrorFigure: TAction;
N38: TMenuItem;
N62: TMenuItem;
aNetProps: TAction;
pmiNetProps: TMenuItem;
aConvertToPolygon: TAction;
N23: TMenuItem;
N82: TMenuItem;
tbSCSArcDimLineExpert: TToolButton;
aToolSCSArcDimLine: TAction;
tbSCSArcDimLineNoob: TToolButton;
tbPrintRect: TToolButton;
aPrintRect: TAction;
tbCalc: TToolButton;
tb3D: TToolButton;
tbExtProtocol: TToolButton;
tbConnectionsConfigurator: TToolButton;
tbRepWizard: TToolButton;
aSegCurveAll: TAction;
aSegLineAll: TAction;
aSegClose: TAction;
aSegOpen: TAction;
aSegInsertKnot: TAction;
aSegDeleteKnot: TAction;
aSegLine: TAction;
aSegCurve: TAction;
aSegArc: TAction;
aSegDimLine: TAction;
aSegDivTo3: TAction;
aSegInverArc: TAction;
aSegRoundCornerByArc: TAction;
aSegPenNone: TAction;
aSegPenZigZag: TAction;
aSegPenFlower: TAction;
aSegPenSinus: TAction;
aSegPenButtons: TAction;
aSegPenSquare: TAction;
aSegPenMiniSinus: TAction;
pmiObjectSplitPoly: TMenuItem;
N90: TMenuItem;
N95: TMenuItem;
N96: TMenuItem;
N112: TMenuItem;
pmiObjSegment: TMenuItem;
N119: TMenuItem;
N139: TMenuItem;
N171: TMenuItem;
N245: TMenuItem;
N246: TMenuItem;
N247: TMenuItem;
N310: TMenuItem;
N248: TMenuItem;
pmiSegPenPattern: TMenuItem;
N249: TMenuItem;
N250: TMenuItem;
N251: TMenuItem;
N252: TMenuItem;
N253: TMenuItem;
N254: TMenuItem;
N255: TMenuItem;
aSaveProjectToPDF: TAction;
PDF1: TMenuItem;
pmiSCSObjFreeRotate: TMenuItem;
aLinesToTraces: TAction;
N257: TMenuItem;
pmiArchTurn: TMenuItem;
aTurnObject: TAction;
tbShowRepResources: TToolButton;
aLoadSubstrateFromPDF: TAction;
PDF2: TMenuItem;
TimerInteractive: TTimer;
tbInteractive: TToolBar;
tbInteractiveNextStep: TToolButton;
aInteractiveNextStep: TAction;
aInteractiveStop: TAction;
ToolButton2: TToolButton;
aTransparentFigure: TAction;
N15: TMenuItem;
pnHintBar: TRzSizePanel;
aExportDWG: TAction;
DWG1: TMenuItem;
aSaveRevision: TAction;
aViewRevs: TAction;
aProjectSchedule: TAction;
N16: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
aBillWork: TAction;
N28: TMenuItem;
aShowCableRule: TMenuItem;
aAutoDiv: TAction;
pmiSCSObjAutoDivideLine: TMenuItem;
N70: TMenuItem;
Act_ConnectSelectedPoints: TAction;
Act_ReindexMaster: TAction;
N79: TMenuItem;
N133: TMenuItem;
N149: TMenuItem;
N150: TMenuItem;
N170: TMenuItem;
EmptyConnSelect: TAction;
N207: TMenuItem;
SelectAllLineObjs: TAction;
SelectAllPointObjects: TAction;
N208: TMenuItem;
N209: TMenuItem;
Act_Magistral_Channel_Index: TAction;
N210: TMenuItem;
N211: TMenuItem;
actLoadPictasRastr: TAction;
Act_AlignSelection: TAction;
N212: TMenuItem;
N1100: TMenuItem;
N213: TMenuItem;
N311: TMenuItem;
N410: TMenuItem;
N235: TMenuItem;
aToolPie: TAction;
tbPieExpert: TToolButton;
SetSefaultAllowTransparensy: TAction;
SetNetDoorType: TMenuItem;
N237: TMenuItem;
N256: TMenuItem;
N258: TMenuItem;
aSetDoubleDoor: TAction;
aSetMirroredDoor: TAction;
aSetLeftRightDoor: TAction;
N236: TMenuItem;
N259: TMenuItem;
aSetOpenedDoor: TAction;
aSetHalfOpenedDoor: TAction;
aSetCornHeight: TAction;
N260: TMenuItem;
aSetDoorWndH: TAction;
N261: TMenuItem;
aSetDoorWindowPllacementHeight: TAction;
N263: TMenuItem;
aSetAllListDoorsPlacementHeight: TAction;
N262: TMenuItem;
N264: TMenuItem;
aSetAllListWndPlacement: TAction;
aSetAllListDoorsHeight: TAction;
aSetAllListWndHeight: TAction;
B1: TMenuItem;
N265: TMenuItem;
N266: TMenuItem;
DCP_md41: TDCP_md4;
pmiOneLineCheme: TMenuItem;
aOneLineCheme: TAction;
pmELObjMenu: TPopupMenu;
mnuRot90: TMenuItem;
mnuRot180: TMenuItem;
mnuRot270: TMenuItem;
Act_SelectCableToTrace: TAction;
mnuSelTraceCable: TMenuItem;
mnuAsServer: TMenuItem;
mnuAsNoServer: TMenuItem;
Act_ConnectByCable: TAction;
mnuConnectByCable: TMenuItem;
Act_ConnectByCableAll: TAction;
Act_ConnectByCableOnEnds: TAction;
mnuConnectByCableEnds: TMenuItem;
mnuOnLineSC: TMenuItem;
mnuRotObj: TMenuItem;
N268: TMenuItem;
N269: TMenuItem;
EmptyTracesSelect: TAction;
EmptyRaiseVertSelect: TAction;
Pmi_CopyCurrList: TMenuItem;
Pmi_CopyCurrListWCompon: TMenuItem;
CopyList_All: TAction;
CopyList_WCompon: TAction;
pmSCSRack: TPopupMenu;
pmiAsDefaultServer: TMenuItem;
Act_SelectFiberCableToTrace: TAction;
Act_ConnectToAnotherRack: TAction;
pmiSelectFiberCableToTrace: TMenuItem;
pmiConnectToAnotherRack: TMenuItem;
Act_SetAsEndObject: TAction;
pmi_SelectFiberCableToTrace: TMenuItem;
pmi_ConnectToAnotherRack: TMenuItem;
cxLabel2: TcxLabel;
XPMenu1: TXPMenu;
G1: TMenuItem;
N218: TMenuItem;
N267: TMenuItem;
N270: TMenuItem;
N271: TMenuItem;
N272: TMenuItem;
N273: TMenuItem;
N274: TMenuItem;
ToolButton4: TToolButton;
N275: TMenuItem;
mnuInstRaspredBox: TMenuItem;
aInstRaspredBox: TAction;
mnuShieldAssemblySH: TMenuItem;
aShieldAssemblyScheme: TAction;
TimerTracingInterval: TTimer;
mnuReserv: TMenuItem;
// ACTIONs
// ñîçäàòü íîâûé ïðîåêò
procedure aNewExecute(Sender: TObject);
// çàãðóçèòü ïîäëîæêó
procedure aLoadSubstrateExecute(Sender: TObject);
// çàêðûòü ëèñò
procedure aCloseExecute(Sender: TObject);
// ñîõðàíèòü ïîäëîæêó
procedure aSaveSubstrateExecute(Sender: TObject);
// ñîõðàíèòü ïîäëîæêó êàê...
procedure aSaveAsSubstrateExecute(Sender: TObject);
// Ýêñïîðò â DXF
procedure aExportExecute(Sender: TObject);
// Èìïîðò â DXF
procedure aImportExecute(Sender: TObject);
// Ïðåäâàðèòåëüíûé ïðîñìîòð
procedure aPrevViewExecute(Sender: TObject);
// Ïå÷àòü
procedure aPrintExecute(Sender: TObject);
// Âûõîä èç ïðîãðàììû
procedure aExitExecute(Sender: TObject);
// Undo
procedure aUndoExecute(Sender: TObject);
// Redo
procedure aRedoExecute(Sender: TObject);
// Âûðåçàòü â áóôôåð
procedure aCutExecute(Sender: TObject);
// Êîïèðîâàòü â áóôôåð
procedure aCopyExecute(Sender: TObject);
// Âñòàâèòü èç áóôôåðà
procedure aPasteExecute(Sender: TObject);
// Âûäåëèòü âñå
procedure aSelectAllExecute(Sender: TObject);
// ïîèñê (íå ðàáîòàåò)
procedure aFindExecute(Sender: TObject);
// ïîèñê ñëåäóþùåãî (íå ðàáîòàåò)
procedure aFindNextExecute(Sender: TObject);
// Âî âåñü ýêðàí
procedure aAllScreenExecute(Sender: TObject);
// ìàñøòàá 50%
procedure a50Execute(Sender: TObject);
// ìàñøòàá 75%
procedure a75Execute(Sender: TObject);
// ìàñøòàá 100%
procedure a100Execute(Sender: TObject);
// ìàñøòàá 150%
procedure a150Execute(Sender: TObject);
// ìàñøòàá 200%
procedure a200Execute(Sender: TObject);
// óâåëè÷èòü ìàñøòàá íà...
procedure aIncExecute(Sender: TObject);
// óâåëè÷èòü ìàñøòàá íà 5%
procedure aInc1ptExecute(Sender: TObject);
// óìåíüøèòü ìàñøòàá íà 5%
procedure aDec1ptExecute(Sender: TObject);
// öâåò ôîíà ÊÀÄà
procedure aBackgroundColorExecute(Sender: TObject);
// ïîêàçûâàòü ëèíèéêó íà ÊÀÄå
procedure aShowRulerExecute(Sender: TObject);
// ïîêàçûâàòü ñåòêó íà ÊÀÄå
procedure aShowGridExecute(Sender: TObject);
// ïîêàçûâàòü ïàíåëü èíñòðóìåíòîâ
procedure aViewBtnPanelExecute(Sender: TObject);
// ïîêàçûâàòü îêíî íîðìàòèâíîé áàçû
procedure aViewNormBaseExecute(Sender: TObject);
// ïîêàçûâàòü ñâîéñòâà ÊÀÄ îáúåêòîâ
procedure aViewCADObjectsPropExecute(Sender: TObject);
// ïîêàçûâàòü íàâèãàòîð
procedure aViewNavigatorExecute(Sender: TObject);
// ïîêàçûâàòü ñâîéñòâà ÑÊÑ îáúåêòîâ
procedure aObjPropertiesExecute(Sender: TObject);
// ñâîáîäíîå âðàùåíèå
procedure aRotateExecute(Sender: TObject);
// íà çàäíèé ïëàí
procedure aBackwardsExecute(Sender: TObject);
// íà ïåðåäíèé ïëàí
procedure aForwardExecute(Sender: TObject);
// ñãðóïïèðîâàòü
procedure aGroupingExecute(Sender: TObject);
// ðàçãðóïïèðîâàòü
procedure aUngroupingExecute(Sender: TObject);
// çàáëî÷èòü
procedure aLockExecute(Sender: TObject);
// ðàçáëî÷èòü
procedure aUnlockExecute(Sender: TObject);
// èçìåíèòü øðèôò
procedure aTextFontExecute(Sender: TObject);
// èçìåíèòü MapScale
procedure aScaleExecute(Sender: TObject);
// ñîçäàòü íîâûé ëèñò
procedure aNewWindowExecute(Sender: TObject);
// çàêðûòü âñå îêíà
procedure aCloseAllWindowsExecute(Sender: TObject);
// âûçâàòü Õåëï
procedure aHelpExecute(Sender: TObject);
// Ïðåçåíòàöèÿ
procedure aPresentationExecute(Sender: TObject);
// Èíòåðàêòèâíîå îáó÷åíèå (íå ðàáîòàåò)
procedure aInteractiveExecute(Sender: TObject);
// íå ðàáîòàåò
procedure aWizardsExecute(Sender: TObject);
// íå ðàáîòàåò
procedure aTechDocExecute(Sender: TObject);
// íå ðàáîòàåò
procedure aToAuthorsExecute(Sender: TObject);
procedure aBuyExecute(Sender: TObject);
// Î ïðîãðàììå
procedure aAboutExecute(Sender: TObject);
// ïîêàçûâàòü Ìåíåäæåð ïðîåêòîâ
procedure aViewProjectManagerExecute(Sender: TObject);
// ñîçäàíèå íîâîãî ëèñòà
procedure aNewListExecute(Sender: TObject);
// âñòàâêà òåêñòà
procedure aInsertTextExecute(Sender: TObject);
// âñòàâêà êàðòèíêè
procedure aInsertBitmapExecute(Sender: TObject);
// Óäàëèòü
procedure aDeleteExecute(Sender: TObject);
// óäàëèòü âñå
procedure aDeleteAllExecute(Sender: TObject);
// óáðàòü âûäåëåíèå ñî âñåõ îáúåêòîâ
procedure aDeSelectAllExecute(Sender: TObject);
// ñòèëü ëèíèè
procedure aPenStyleExecute(Sender: TObject);
// öâåò ëèíèè
procedure aPenColorExecute(Sender: TObject);
// øèðèíà ëèíèè
procedure aPenWidthExecute(Sender: TObject);
// ñòèëü ñòðåëêè ëèíèè
procedure aRowStyleExecute(Sender: TObject);
// ñòèëü çàëèâêè
procedure aBrushStyleExecute(Sender: TObject);
// êîäèðîâêà
procedure aTextCharsetExecute(Sender: TObject);
// øðèôò
procedure aFontStyleExecute(Sender: TObject);
// ïåðåìåùåíèå íà çàäíèé/ïåðåäíèé ïëàí
procedure aFormatOrderExecute(Sender: TObject);
// òèï ñåòêè
procedure aGridTypeExecute(Sender: TObject);
// ïîêàçûâàòü öåíòðàëüíûå íàïðàâëÿþùèå
procedure aShowCenterGuidesExecute(Sender: TObject);
// ïîêàçûâàòü íàïðàâëÿþùèå
procedure aShowGuideLinesExecute(Sender: TObject);
// ïðèâÿçêà ê ñåòêå
procedure aSnaptoGridExecute(Sender: TObject);
// ïðèâÿçêà ê íàïðàâëÿþùèì
procedure aSnaptoGuidesExecute(Sender: TObject);
// ïðèâÿçêà ê áëèæíåìó îáúåêòó
procedure aSnaptoNearObjectExecute(Sender: TObject);
// öâåò ñåòêè
procedure aGridColorExecute(Sender: TObject);
// öâåò íàïðàâëÿþùèõ
procedure aGuideColorExecute(Sender: TObject);
// öâåò ñòðàíèöû
procedure aPageColorExecute(Sender: TObject);
// íàïðàâëÿþùèå ïîä óãëîì
procedure aAngularGuidesExecute(Sender: TObject);
// ñèñòåìà ëèíåéêè: ñì, ì
procedure aRulerSystemExecute(Sender: TObject);
// òèï ëèíåéêè: ñòðàíè÷íàÿ, ãëîáàëüíàÿ
procedure aRulerModeExecute(Sender: TObject);
// ôîðìàò ëèñòà
procedure aPageLayoutExecute(Sender: TObject);
// îðèåíòàöèÿ ëèñòà
procedure aPageOrientationExecute(Sender: TObject);
// øàã ñåòêè
procedure aGridStepExecute(Sender: TObject);
// ïëàí íàçàä
procedure aSendtoBackExecute(Sender: TObject);
// ïëàí âïåðåä
procedure aBringtoFrontExecute(Sender: TObject);
// íà çàäíèé ïëàí
procedure aSendBackwardsExecute(Sender: TObject);
// íà ïåðåäíèé ïëàí
procedure aBringForwardsExecute(Sender: TObject);
// âûðàâíèâàíèÿ
procedure aalTopExecute(Sender: TObject);
procedure aalBottomExecute(Sender: TObject);
procedure aalXcenterExecute(Sender: TObject);
procedure aalLeftExecute(Sender: TObject);
procedure aalRightExecute(Sender: TObject);
procedure aalYCenterExecute(Sender: TObject);
procedure aFormatAlignExecute(Sender: TObject);
// ñòèëè ëèíèé
procedure apsClearExecute(Sender: TObject);
procedure apsDashExecute(Sender: TObject);
procedure apsDashDotExecute(Sender: TObject);
procedure apsDashDotDotExecute(Sender: TObject);
procedure apsDotExecute(Sender: TObject);
procedure apsSolidExecute(Sender: TObject);
// øèðèíè ëèíèé
procedure aPenw1Execute(Sender: TObject);
procedure aPenw2Execute(Sender: TObject);
procedure aPenw3Execute(Sender: TObject);
procedure aPenw4Execute(Sender: TObject);
procedure aPenw5Execute(Sender: TObject);
procedure aPenw6Execute(Sender: TObject);
procedure aPenw7Execute(Sender: TObject);
// ñòèëè ñòðåëîê ëèíèé
procedure arsBothLightExecute(Sender: TObject);
procedure arsBothSolidExecute(Sender: TObject);
procedure arsLeftLightExecute(Sender: TObject);
procedure arsLeftSolidExecute(Sender: TObject);
procedure arsNoneExecute(Sender: TObject);
procedure arsRightLightExecute(Sender: TObject);
procedure arsRightSolidExecute(Sender: TObject);
// ñòèëè çàëèâîê
procedure absBDiagonalExecute(Sender: TObject);
procedure absClearExecute(Sender: TObject);
procedure absCrossExecute(Sender: TObject);
procedure absDiagCrossExecute(Sender: TObject);
procedure absFDiagonalExecute(Sender: TObject);
procedure absHorizontalExecute(Sender: TObject);
procedure absSolidExecute(Sender: TObject);
procedure absVerticalExecute(Sender: TObject);
// ñòèëè øðèôòà
procedure aTextBoldExecute(Sender: TObject);
procedure aTextItalicExecute(Sender: TObject);
procedure aTextUnderLineExecute(Sender: TObject);
procedure aTextStrikeThroughExecute(Sender: TObject);
// êîäèðîâêè øðèôòà
procedure aANSI_CHARSETExecute(Sender: TObject);
procedure aDEFAULT_CHARSETExecute(Sender: TObject);
procedure aRUSSIAN_CHARSETExecute(Sender: TObject);
// öâåò çàëèâêè
procedure aBrushColorExecute(Sender: TObject);
// öâåò òåêñòà
procedure aTextColorExecute(Sender: TObject);
// âèäû ñåòêè
procedure aLineGridExecute(Sender: TObject);
procedure aPointGridExecute(Sender: TObject);
procedure aCrossGridExecute(Sender: TObject);
// âèäû íàïðàâëÿþùèõ ïîä óãëîì
procedure aAngularNoneExecute(Sender: TObject);
procedure aAngular90Execute(Sender: TObject);
procedure aAngular30Execute(Sender: TObject);
procedure aAngular60Execute(Sender: TObject);
procedure aAngular45Execute(Sender: TObject);
// âèäû ñèñòåìû ëèíåéêè
procedure aMetricExecute(Sender: TObject);
procedure aWitworthExecute(Sender: TObject);
// âèäû ðåæèìà ëèíåéêè
procedure aPageModeExecute(Sender: TObject);
procedure aWorldModeExecute(Sender: TObject);
// âèäû îðèåíòàöèè ëèñòà
procedure aLandscaleExecute(Sender: TObject);
procedure aPortraitExecute(Sender: TObject);
// âèäû ôîðìàòà ëèñòà
procedure aA0Execute(Sender: TObject);
procedure aA1Execute(Sender: TObject);
procedure aA2Execute(Sender: TObject);
procedure aA3Execute(Sender: TObject);
procedure aA4Execute(Sender: TObject);
procedure aA5Execute(Sender: TObject);
procedure aA6Execute(Sender: TObject);
procedure aB4Execute(Sender: TObject);
procedure aB5Execute(Sender: TObject);
procedure aLetterExecute(Sender: TObject);
procedure aTabloidExecute(Sender: TObject);
procedure aCustomExecute(Sender: TObject);
// äóáëèðîâàòü âûäåëåííûå (ÊÀÄ îáúåêòû)
procedure aDuplicateSelectionExecute(Sender: TObject);
// âðàùåíèå âûáðàííîãî (ÊÀÄ îáúåêòû)
procedure aRotateSelectionExecute(Sender: TObject);
// ïåðåìåùåíèå âûáðàííîãî (ÊÀÄ îáúåêòû)
procedure aMoveSelectionExecute(Sender: TObject);
// çåðêàëüíîå îòîáðàæåíèå âûáðàííîãî (ÊÀÄ îáúåêòû)
procedure aMirrorSelectionExecute(Sender: TObject);
// òóëñà - âûáîðêà
procedure aToolSelectExecute(Sender: TObject);
// òóëñà - ëèíèÿ
procedure aToolLineExecute(Sender: TObject);
// òóëñà - ïðÿìîóãîëíèê
procedure aToolRectangleExecute(Sender: TObject);
// òóëñà - ýëëèïñ
procedure aToolEllipseExecute(Sender: TObject);
// òóëñà - îêðóæíîñòü
procedure aToolCircleExecute(Sender: TObject);
// òóëñà - äóãà
procedure aToolArcExecute(Sender: TObject);
// òóëñà - ýëëèïñè÷åñêàÿ äóãà
procedure aToolElipticArcExecute(Sender: TObject);
// òóëñà - ïîëèëèíèÿ
procedure aToolPolyLineExecute(Sender: TObject);
// òóëñà - òî÷êà
procedure aToolPointExecute(Sender: TObject);
// òóëñà - ÐÒÔ òåêñò
procedure aToolRichTextExecute(Sender: TObject);
// òóëñà - ðàçðåçêà
procedure aToolKnifeExecute(Sender: TObject);
// òóëñà - ãîðèçîíòàëüíàÿ èçìåðèòåëüíàÿ ëèíèÿ
procedure aToolHDimLineExecute(Sender: TObject);
// òóëñà - âåðòèêàëüíàÿ èçìåðèòåëüíàÿ ëèíèÿ
procedure aToolVDimLineExecute(Sender: TObject);
// ðàçìåð òåêñòà
procedure aTextSizeExecute(Sender: TObject);
// ìåíåäæåð ñëîåâ
procedure aViewLayersExecute(Sender: TObject);
// äîáàâëåíèå íîâîãî ñëîÿ
procedure aNewLayerExecute(Sender: TObject);
// óäàëåíèå ñëîÿ
procedure aDeleteLayerExecute(Sender: TObject);
// ñëèÿíèå âñåõ âèäèìûõ ñëîåâ
procedure aMergeVisibleExecute(Sender: TObject);
// ñëèÿíèå âñåõ ñëîåâ
procedure aMergeAllExecute(Sender: TObject);
// âñå íåàêòèâíûå ñëîè êàê ïîäëîæêà
procedure aFlueInactivesExecute(Sender: TObject);
// ñêðûòü âñå íåàêòèâíâûå ñëîè
procedure aHideInactivesExecute(Sender: TObject);
// ïîêàçàòü âñå ñëîè
procedure aShowAllLayersExecute(Sender: TObject);
// óäàëèòü ñîåäèíèòåëü - ñëèÿíèå òðàññ
procedure aDisconnectExecute(Sender: TObject);
// ðàçäåëåíèå òðàññû
procedure aDivideLineExecute(Sender: TObject);
// òóëñà - îðòîëèíèÿ
procedure aToolOrthoLineExecute(Sender: TObject);
// óñòàíîâèòü ñëîé ïîäëîæêà
procedure aSetSubstrateLayerExecute(Sender: TObject);
// óñòàíîâèòü ñëîé ÑÊÑ
procedure aSetSCSLayerExecute(Sender: TObject);
// óñòàíîâêà öâåòîâ ïî óìîë÷àíèþ
procedure aSetDefaultColorsExecute(Sender: TObject);
// èçìåíèòü ïàðàìåòðîâ îðòîëèíèè
procedure aChangeOrtoParamsExecute(Sender: TObject);
// ñâîáîäíîå âðàùåíèå (ÊÀÄ îáúåêòû)
procedure aFreeRotateExecute(Sender: TObject);
// ðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø
procedure aRegHotKeysExecute(Sender: TObject);
// îòðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø
procedure aUnregHotKeysExecute(Sender: TObject);
// àâòîâûäåëÿòü òðàññó äî êîíå÷íîãî îáúåêòà
procedure aAutoSelectTraceExecute(Sender: TObject);
// óñòàíîâèòü êàê ÊÎ
procedure aServerAsDefaultExecute(Sender: TObject);
// îòêðûòü ïðîåêò
procedure aOpenProjectExecute(Sender: TObject);
// âûðàâíèâàíèå ëèíèè ïî ñåòêå
procedure aRealignLineExecute(Sender: TObject);
// óáðàòü óñòàíîâêó êàê ÊÎ
procedure aNotAsServerDefaultExecute(Sender: TObject);
// âûäåëèòü òðàññó äî ÊÎ
procedure aSelectTracetoServerExecute(Sender: TObject);
// òóëñà - òåêñò
procedure aToolTextExecute(Sender: TObject);
// ñäåëàòü ñêðóòêó êàáåëåé (äëÿ ýëåêòðèêè)
procedure aMakeCablingExecute(Sender: TObject);
// ñâîéñòâî ÑÊÑ îáúåêòîâ
procedure aViewSCSObjectsPropExecute(Sender: TObject);
// ñîçäàíèå ñ-ï
procedure aCreateRaiseExecute(Sender: TObject);
// óäàëåíèå ñ-ï
procedure aDestroyRaiseExecute(Sender: TObject);
// ìàñòåð àâòîòðàññèðîâêè
procedure aMasterAutoTraceExecute(Sender: TObject);
// ñâîéñòâà ëèñòà
procedure aListPropertiesExecute(Sender: TObject);
// îò÷åò Âåäîìîñòü îáúåêòîâ
procedure aReport_ListObjectsExecute(Sender: TObject);
// îò÷åò Âåäîìîñòü ðåñóðñîâ
procedure aReport_ResorcesExecute(Sender: TObject);
// îò÷åò Âåäîìîñòü êàáåëåé
procedure aReport_CablesExecute(Sender: TObject);
// îò÷åò Êàáåëè ñ ïðåâûøàþùåé äëèíîé
procedure aReport_CablesWithLimitLengthExecute(Sender: TObject);
// îò÷åò Êàáåëüíûå êàíàëû
procedure aReport_CableChannelsExecute(Sender: TObject);
// îò÷åò Ïîäêëþ÷åíèÿ ïî öâåòàì
procedure aReport_ConnectByColorsExecute(Sender: TObject);
// îò÷åò Ïîäêëþ÷åíèÿ ïî ïðîèçâîäèòåëÿì
procedure aReport_ConnectByProducerExecute(Sender: TObject);
// îò÷åò Êàáåëüíûé æóðíàë
procedure aReport_ConnectionsExecute(Sender: TObject);
// îò÷åò Ñïåöèôèêàöèÿ
procedure aReport_SpecificationExecute(Sender: TObject);
// ïîäíÿòü/îïóñòèòü òðàññó
// Tolik -- 01/08/2016 --
Procedure aRaiseLineExecute(Sender: TObject);
procedure RaiseSelectedLine(aToHeight: Double = -1);
// ñîçäàâàòü îáúåêòû ïî êëèêó íà ÊÀÄ
procedure aCreateObjectOnClickExecute(Sender: TObject);
// óäàëèòü ÑÊÑ îáúåêò
procedure aDeleteSCSObjectExecute(Sender: TObject);
// ïîêàçûâàòü çàïîëíåííîñòü îáúåêòîâ
procedure aShowConnFullnessExecute(Sender: TObject);
// ïîêàçûâàòü çàïîëíåííîñòü êàáåëåé
procedure aShowCableFullnessExecute(Sender: TObject);
// ïîêàçûâàòü çàïîëíåííîñòü êàáåëüíûõ êàíàëîâ
procedure aShowCableChannelFullnessExecute(Sender: TObject);
// òóëñà - ñîçäàâàòü îáúåêòû ïðè êëèêå íà ÊÀÄ
procedure aCreateObjectOnClickToolExecute(Sender: TObject);
// ñîçäàòü ìåæýòàæíûé ïîäüåì
procedure aCreateFloorRaiseUpExecute(Sender: TObject);
// ñîçäàòü ìåæýòàæíûé ñïóñê
procedure aCreateFloorRaiseDownExecute(Sender: TObject);
// ðàñïîëîæèòü îêíà ÊÀÄîâ ïî ïîðÿäêó
procedure aTileWindowsExecute(Sender: TObject);
// ðàñïîëîæèòü îêíà ÊÀÄîâ êàñêàäîì
procedure aCascadeWindowsExecute(Sender: TObject);
// âñòàâèòü áëîê
procedure aInsertBlockExecute(Sender: TObject);
// ñîçäàòü ÓÃÎ â ÍÁ
procedure aCreateBlockToNBExecute(Sender: TObject);
// çàïóñê ðåäàêòîðà ýêñïîðòà ÓÃÎ
procedure aBlocksEditorExecute(Sender: TObject);
// âðàùàòü ÓÃÎ îáúåêòà íà 90 ãðàäóñîâ
procedure aRotatePointObject90Execute(Sender: TObject);
// âðàùàòü ÓÃÎ îáúåêòà íà 180 ãðàäóñîâ
procedure aRotatePointObject180Execute(Sender: TObject);
// ñäâèã ÓÃÎ îáúåêòîâ ââåðõ
procedure aShiftUpObjectExecute(Sender: TObject);
// ñäâèã ÓÃÎ îáúåêòîâ âíèç
procedure aShiftDownObjectExecute(Sender: TObject);
// ñäâèã ÓÃÎ îáúåêòîâ âëåâî
procedure aShiftLeftObjectExecute(Sender: TObject);
// ñäâèã ÓÃÎ îáúåêòîâ âïðàâî
procedure aShiftRightObjectExecute(Sender: TObject);
// îò÷åò Ðàñøèðåííûé êàáåëüíûé æóðíàë
procedure aReport_CableJournalExtExecute(Sender: TObject);
// ñâîéñòâà ïðîåêòà
procedure aProjectPropertiesExecute(Sender: TObject);
// îòêðûòü ïðîåêò èç ôàéëà
procedure aOpenProjectAtCurrNodeExecute(Sender: TObject);
// çàêðûòü òåêóùèé ïðîåêò
procedure aCloseCurrProjectExecute(Sender: TObject);
// çàãðóçêà ïðîåêòà èç ôàéëà
procedure aLoadNewProjectFromFileExecute(Sender: TObject);
// Ñîõðàíèòü ïðîåêò êàê
procedure aSaveAsSCSProjectExecute(Sender: TObject);
// ñâîéñòâà êîìïîíåíòû â îáúåêòå
procedure aComponPropertiesExecute(Sender: TObject);
// òóëñà - ïàíàðîìèðîâàíèå
procedure aToolPanExecute(Sender: TObject);
// ìàñøòàá 400%
procedure a400Execute(Sender: TObject);
// îòñîåäèíèòü ÒÎ
procedure aDisconnectPointObjectExecute(Sender: TObject);
// Ìàñòåð îò÷åòîâ
procedure aRepWizardExecute(Sender: TObject);
// ñîõðàíèòü ÊÀÄ êàê ÁÌÏ
procedure aSaveAsBMPExecute(Sender: TObject);
// ïîêàçûâàòü òðàññû ñ ïðåâûøàþùåé äëèíîé
procedure aShowTracesLengthLimitExecute(Sender: TObject);
// ñîõðàíèòü ïðîåêò â ÌÏ
procedure aSaveProjectExecute(Sender: TObject);
// ñâîéñòâà òåêóùåãî ïðîåêòà
procedure aCurrProjectPropertiesExecute(Sender: TObject);
// ñïðàâî÷íèê Âàëþòû
procedure aManual_CurrencyExecute(Sender: TObject);
// ñïðàâî÷íèê Òèïû ñåòåé
procedure aManual_NettypesExecute(Sender: TObject);
// ñïðàâî÷íèê Ïî ïðîèçâîäèòåëþ
procedure aManual_ProducersExecute(Sender: TObject);
// ñïðàâî÷íèê Èíòåðôåéñû
procedure aManual_InterfacesExecute(Sender: TObject);
// ñïðàâî÷íèê Ñâîéñòâà îáúåêòîâ
procedure aManual_ObjPropExecute(Sender: TObject);
// ñïðàâî÷íèê ÓÃÎ
procedure aManual_LegendsExecute(Sender: TObject);
// ñïðàâî÷íèê Òèïû êîìïîíåíò
procedure aManual_ComponTypesExecute(Sender: TObject);
// ñïðàâî÷íèê Íîðìû
procedure aManual_NormsExecute(Sender: TObject);
// ñïðàâî÷íèê Ðåñóðñû
procedure aManual_ResourcesExecute(Sender: TObject);
// ñïðàâî÷íèê ÍÄÑ
procedure aManual_NDSExecute(Sender: TObject);
// Äèçàéí øêàôà
procedure aDesignBoxExecute(Sender: TObject);
// âûáîð ïóòè ê ÍÁ
procedure aChoiceNBPathExecute(Sender: TObject);
// âûáîð ïóòè ê ÌÏ
procedure aChoicePMPathExecute(Sender: TObject);
// Íàñòðîéêè ïðîãðàììû
procedure aChoiceBaseOptionsExecute(Sender: TObject);
// Ðåãèñòðàöèÿ
procedure aRegistrationExecute(Sender: TObject);
// Îáíîâëåíèå ÍÁ
procedure aUpdateNormBaseExecute(Sender: TObject);
// Õèñòîðè
procedure aHistoryExecute(Sender: TObject);
// êîíôèãóðàòîð ñîåäèíåíèé
procedure aConnectionsConfiguratorExecute(Sender: TObject);
// íå ïåðåìåùàòü ïðèñîåäèíåííûå îáúåêòû
procedure aNoMoveConnectedObjectsExecute(Sender: TObject);
// âûðîâíÿòü Îáúåêò ïî ñåòêå
procedure aRealignObjectExecute(Sender: TObject);
// Î÷èñòèòü íàïðàâëÿþùèå
procedure aClearGuidesExecute(Sender: TObject);
// Ñîõðàíèòü â ÈÁÄ
procedure aSaveToIBDExecute(Sender: TObject);
// òóëñà - ãîðèçîíòàëüíàÿ èçìåðèòåëüíàÿ ëèíèÿ ÑÊÑ
procedure aToolSCSHDimLineExecute(Sender: TObject);
// òóëñà - âåðòèêàëüíàÿ èçìåðèòåëüíàÿ ëèíèÿ ÑÊÑ
procedure aToolSCSVDimLineExecute(Sender: TObject);
// òóëñà - ïëàí
procedure aToolWallRectExecute(Sender: TObject);
// òóëñà - ñåãìåíò ïëàíà
procedure aToolWallPathExecute(Sender: TObject);
// óäàëèòü ñåãìåíò
procedure aDeleteWallPathExecute(Sender: TObject);
// óäàëèòü ïëàí
procedure aDeleteWallRectExecute(Sender: TObject);
// ðàçäåëèòü ñåãìåíò
procedure aDivSelPathExecute(Sender: TObject);
// óñòàíîâèòü øèðèíó ñåãìåíòà
procedure aSetWallPathWidthExecute(Sender: TObject);
// óñòàíîâèòü øèðèíó âñåõ ñåãìåíòîâ ïëàíà
procedure aSetAllWallPathWidthExecute(Sender: TObject);
// äîáàâèòü îêíî íà ñåãìåíò
procedure aAddWindowExecute(Sender: TObject);
// äîáàâèòü äâåðü íà ñåãìåíò
procedure aAddDoorExecute(Sender: TObject);
// óäàëèòü äâåðü/îêíî ñ ñåãìåíòà
procedure aDeleteWindowDoorExecute(Sender: TObject);
// óñòàíîâèòü ðàçìåð îêíà/äâåðè
procedure aSetSizeWindowDoorExecute(Sender: TObject);
// çàãðóçèòü ïîäëîæêó
procedure aLoadStampExecute(Sender: TObject);
// ñîõðàíèòü ïîäëîæêó
procedure aSaveStampExecute(Sender: TObject);
// ïîêàçûâàòü äëèíó ñåãìåíòîâ
procedure aWallPathShowLengthExecute(Sender: TObject);
// ñîõðàíèòü àðõèòåêòóðíûé ïëàí
procedure aSaveFPlanExecute(Sender: TObject);
// çàãðóçèòü àðõèòåêòóðíûé ïëàí
procedure aLoadFPlanExecute(Sender: TObject);
// äîáàâèòü êîëîííó íà ñåãìåíò
procedure aAddColumnExecute(Sender: TObject);
// óäàëèòü êîëîííó ñ ñåãìåíòà
procedure aDeleteColumnExecute(Sender: TObject);
// óñòàíîâèòü óãîë êîëîííû ñåãìåíòà
procedure aSetColumnAngleExecute(Sender: TObject);
// óñòàíîâèòü âûñîòó êîëîííû ñåãìåíòà
procedure aSetColumnHeightExecute(Sender: TObject);
// óñòàíîâèòü øèðèíó êîëîííû ñåãìåíòà
procedure aSetColumnWidthExecute(Sender: TObject);
// âûñîòà ïîäïèñåé ê Äèçàéíó øêàôà
procedure aDesignBoxCaptionHeightExecute(Sender: TObject);
// øèðèíà ïîäïèñåé ê Äèçàéíó øêàôà
procedure aDesignBoxCaptionWidthExecute(Sender: TObject);
// øèðèíà ëèíèè ñåãìåíòà
procedure aSetPathLineWidthExecute(Sender: TObject);
// ñòèëü ëèíèè ñåãìåíòà
procedure aSetPathLineStyleExecute(Sender: TObject);
// øèðèíà ëèíèé âñåõ ñåãìåíòîâ
procedure aSetAllPathLineWidthExecute(Sender: TObject);
// ñòèëü ëèíèé âñåõ ñåãìåíòîâ
procedure aSetAllPathLineStyleExecute(Sender: TObject);
// ñïðàâî÷íèê Òèïû ïîñòàâîê
procedure aManual_SuppliesKindsExecute(Sender: TObject);
// ìàñòåð ïðîêëàäêè êàáåëüíûõ êàíàëîâ
procedure aMasterCableChannelExecute(Sender: TObject);
// ìàñòåð òðàññèðîâêè êàáåëÿ
procedure aMasterCableTracingExecute(Sender: TObject);
// ñîõðàíåíèå ÓÃÎ â ôàéë
procedure aCreateBlockToFileExecute(Sender: TObject);
// èçìåíèòü âûñîòó ñ-ï
procedure aChangeRaiseHeightExecute(Sender: TObject);
// ñîçäàòü ëèñò ñõåìû ïðîåêòà
procedure aCreateProjectPlanExecute(Sender: TObject);
// îòñîåäèíèòü îò ÐÌ
procedure aDisconnectFromRMExecute(Sender: TObject);
// îòñîåäèíèòü âñå ñîåäèíèòåëè îò ÐÌ
procedure aDisconnectAllConnectorsExecute(Sender: TObject);
// ïåðåìåñòèòü îáúåêò íà âûñîòó
procedure aRemoveObjectOnHeightExecute(Sender: TObject);
// òóëñà - êàáèíåò
procedure aToolCabinetExecute(Sender: TObject);
// ñîõðàíèòü ÊÀÄ êàê WMF
procedure aSaveAsWMFExecute(Sender: TObject);
// ïîêàçàòü êîíôèãóðàòîð
procedure aShowConfiguratorExecute(Sender: TObject);
// ïîêàçàòü îò÷åò Âåäîìîñòü ðåñóðñîâ
procedure aShowRepResourcesExecute(Sender: TObject);
// ñîçäàíèå Âåäîìîñòè íîðì íà ÊÀÄ
procedure aCreateNormsOnCadExecute(Sender: TObject);
// ðåäàêòèðîâàíèå Âåäîìîñòè íîðì íà ÊÀÄ
procedure aNormsEditExecute(Sender: TObject);
// ñâîéñòâà Âåäîìîñòè íîðì íà ÊÀÄ
procedure aNormsPropExecute(Sender: TObject);
// çåðêàëüíîå îòîáðàæåíèå êðîññîâ
procedure aMirrorViewExecute(Sender: TObject);
// ñîçäàíèå äóáëèêàòîð
procedure aCreateDuplicatesExecute(Sender: TObject);
// Õåëï â âèäå CHM
procedure aCHMExecute(Sender: TObject);
// Îòñîåäèíèòü âñå òðàññû îò êîííåêòîðà
procedure aDisconnectTracesExecute(Sender: TObject);
// Ïîâåðíóòü ÓÃÎ òðàññû íà 180 ãðàäóñîâ
procedure aRotateTraceDrawFigure180Execute(Sender: TObject);
// ïàðàìåòðû Äèçàéíà øêàôà
procedure aDesignBoxParamsExecute(Sender: TObject);
// óïàêîâêà ÍÁ
procedure aPackNormBaseExecute(Sender: TObject);
// óïàêîâêà ÌÏ
procedure aPackProjManExecute(Sender: TObject);
// çåðêàëüíîå îòîáðàæåíèå ÓÃÎ
procedure aMirrorBlockExecute(Sender: TObject);
// óñòàíîâêà ïîìåòêè òðàññû äëÿ òðàññèðîâêè
procedure aMarkForTracingExecute(Sender: TObject);
// îáðàáîò÷èê çàêðûòèÿ ôîðìû
procedure FormClose(Sender: TObject; var Action: TCloseAction);
// ñîáûòèå íà ìèíèìèçàöèè
procedure AppMinima(Sender: TObject);
// ïåðåäâèæåíèå ñïëèòåðîâ
procedure sDiv1CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
procedure sDiv2CanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
procedure sDiv1Moved(Sender: TObject);
procedure sDiv2Moved(Sender: TObject);
// ïåðåêëþ÷åíèå îêîí/ëèñòîâ
procedure SwitchWindow(Sender: TObject);
procedure PDock1DockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure PDock1UnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean);
procedure PDock1DockDrop(Sender: TObject; Source: TDragDockObject; X, Y: Integer);
procedure FormCreate(Sender: TObject);
procedure pageCADListChange(Sender: TObject);
procedure fcbTextFontChange(Sender: TObject);
procedure fcbTextSizeChange(Sender: TObject);
procedure cbMainPanelDockOver(Sender: TObject; Source: TDragDockObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
procedure tbEditStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbEditEndDock(Sender, Target: TObject; X, Y: Integer);
procedure tbFileStartDock(Sender: TObject; var DragObject: TDragObject);
procedure tbFileEndDock(Sender, Target: TObject; X, Y: Integer);
procedure tbFormatStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbFormatEndDock(Sender, Target: TObject; X, Y: Integer);
procedure tbObjectStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbObjectEndDock(Sender, Target: TObject; X, Y: Integer);
procedure tbSelectOptionsStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbSelectOptionsEndDock(Sender, Target: TObject; X, Y: Integer);
procedure tbCADToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbCADToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer);
procedure mpsDashAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure mPenw1AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure mrsBothLightAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure mbsVerticalAdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure cbScalePropertiesCloseUp(Sender: TObject);
procedure cbScaleExpertKeyPress(Sender: TObject; var Key: Char);
procedure cbLayersPropertiesCloseUp(Sender: TObject);
procedure cbLayersCloseUp(Sender: TObject);
procedure cxComboBox1Enter(Sender: TObject);
procedure mRegisterClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure tbSCSToolsExpertStartDock(Sender: TObject; var DragObject: TDragDockObject);
procedure tbSCSToolsExpertEndDock(Sender, Target: TObject; X, Y: Integer);
procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
procedure TimerProcessMessagesTimer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure TimerOpenStartTimer(Sender: TObject);
procedure TimerRefreshTimer(Sender: TObject);
procedure FOnAppActivate(Sender: TObject);
procedure tbExtProtocolClick(Sender: TObject);
procedure N113Click(Sender: TObject);
procedure FloatPanel1Click(Sender: TObject);
procedure PDock1Resize(Sender: TObject);
// ðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø
procedure RegisteredHotKeys;
// îòðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø
procedure UnRegisteredHotKeys;
// ðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø íà ÊÀÄå
procedure RegisteredCADHotKeys;
// îòðåãèñòðàöèÿ ãîðÿ÷èõ êëàâèø íà ÊÀÄå
procedure UnRegisteredCADHotKeys;
procedure aBlockParamsExecute(Sender: TObject);
procedure aCabinetFalseFloorExecute(Sender: TObject);
procedure aLicenceTypeExecute(Sender: TObject);
procedure aToolMultiLineExecute(Sender: TObject);
procedure aShowDisconnectedObjectsExecute(Sender: TObject);
procedure aMasterUpdateComponPriceFromXFExecute(Sender: TObject);
procedure aRefreshDesignListExecute(Sender: TObject);
procedure aToolOrtholineExtExecute(Sender: TObject);
procedure aBackUpBaseExecute(Sender: TObject);
procedure aRestoreBaseExecute(Sender: TObject);
procedure aExpertModeExecute(Sender: TObject);
procedure cbLayersPropertiesInitPopup(Sender: TObject);
procedure aShowPMUsersExecute(Sender: TObject);
procedure aLoginUserToProManExecute(Sender: TObject);
procedure aShowCurrUserInfoExecute(Sender: TObject);
procedure aExpertNewsExecute(Sender: TObject);
procedure TimerNewsTimer(Sender: TObject);
procedure tbCalcClick(Sender: TObject);
procedure aMarkingPagesExecute(Sender: TObject);
procedure aMarkForDisableTracingExecute(Sender: TObject);
procedure aMasterAutoTraceElectricExecute(Sender: TObject);
procedure ExpertPresentation1Click(Sender: TObject);
procedure aRotatePointObject270Execute(Sender: TObject);
procedure aCreateTrunkExecute(Sender: TObject);
procedure miShowConnectedConnComponsClick(Sender: TObject);
procedure miShowConnectedLineComponsClick(Sender: TObject);
procedure pmConnectedPointsPopup(Sender: TObject);
procedure pmConnectedLinesPopup(Sender: TObject);
procedure tb3DClick(Sender: TObject);
procedure aToolHouseExecute(Sender: TObject);
procedure aAddApproachExecute(Sender: TObject);
procedure aDeleteHouseExecute(Sender: TObject);
procedure aInsertKnotForHouseExecute(Sender: TObject);
procedure aDeleteKnotForHouseExecute(Sender: TObject);
procedure aEditApproachExecute(Sender: TObject);
procedure aRotateApproachExecute(Sender: TObject);
procedure aModApproachExecute(Sender: TObject);
procedure aToolCabinetExtExecute(Sender: TObject);
procedure aConvertSegmentToArcExecute(Sender: TObject);
procedure aInsertKnotForCabinetExecute(Sender: TObject);
procedure aDeleteKnotForCabinetExecute(Sender: TObject);
procedure aShowDefectObjectsExecute(Sender: TObject);
procedure aInvertArcSegmentExecute(Sender: TObject);
procedure aOpenVectorDrawingExecute(Sender: TObject);
procedure aOpenRasterDrawingExecute(Sender: TObject);
procedure aSaveVectorDrawingExecute(Sender: TObject);
procedure aSaveRasterDrawingExecute(Sender: TObject);
procedure aCreateVerticalExecute(Sender: TObject);
procedure TimerFindSnapTimer(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure aNetPathToArcExecute(Sender: TObject);
procedure aInvertNetPathArcExecute(Sender: TObject);
procedure n3DModelForProjectClick(Sender: TObject);
procedure aAutoCreateTracesExecute(Sender: TObject);
procedure aDivTracesOnRoowWallsExecute(Sender: TObject);
procedure aPathLengthTypePointsExecute(Sender: TObject);
procedure aPathLengthTypeInnerExecute(Sender: TObject);
procedure aPathLengthTypeOuterExecute(Sender: TObject);
procedure aPathTraceLengthTypePointsExecute(Sender: TObject);
procedure aPathTraceLengthTypeInnerExecute(Sender: TObject);
procedure aPathTraceLengthTypeOuterExecute(Sender: TObject);
procedure aMirrorFigureExecute(Sender: TObject);
procedure aNetPropsExecute(Sender: TObject);
procedure aConvertToPolygonExecute(Sender: TObject);
procedure aToolSCSArcDimLineExecute(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure aPrintRectExecute(Sender: TObject);
procedure aSegActionExecute(Sender: TObject);
procedure aSaveProjectToPDFExecute(Sender: TObject);
procedure aLinesToTracesExecute(Sender: TObject);
procedure aTurnObjectExecute(Sender: TObject);
procedure aLoadSubstrateFromPDFExecute(Sender: TObject);
procedure TimerInteractiveTimer(Sender: TObject);
procedure aInteractiveNextStepExecute(Sender: TObject);
procedure aInteractiveStopExecute(Sender: TObject);
procedure aTransparentFigureExecute(Sender: TObject);
procedure pnHintBarPaint(Sender: TObject);
procedure pmListPopup(Sender: TObject);
procedure aExportDWGExecute(Sender: TObject);
procedure aSaveRevisionExecute(Sender: TObject);
procedure aViewRevsExecute(Sender: TObject);
procedure aProjectScheduleExecute(Sender: TObject);
procedure aBillWorkExecute(Sender: TObject);
procedure aShowCableRuleClick(Sender: TObject);
procedure aAutoDivExecute(Sender: TObject);
procedure N70Click(Sender: TObject);
procedure Act_ConnectSelectedPointsExecute(Sender: TObject);
procedure Act_ReindexMasterExecute(Sender: TObject);
procedure N150Click(Sender: TObject);
procedure EmptyConnSelectExecute(Sender: TObject);
procedure SelectAllPointObjectsExecute(Sender: TObject);
procedure SelectAllLineObjsExecute(Sender: TObject);
procedure Act_Magistral_Channel_IndexExecute(Sender: TObject);
procedure actLoadPictasRastrExecute(Sender: TObject);
procedure Act_AlignSelectionExecute(Sender: TObject);
procedure aToolPieExecute(Sender: TObject);
procedure SetSefaultAllowTransparensyExecute(Sender: TObject);
procedure aSetDoubleDoorExecute(Sender: TObject);
procedure aSetMirroredDoorExecute(Sender: TObject);
procedure aSetLeftRightDoorExecute(Sender: TObject);
procedure aSetOpenedDoorExecute(Sender: TObject);
procedure aSetHalfOpenedDoorExecute(Sender: TObject);
procedure aSetCornHeightExecute(Sender: TObject);
procedure aSetDoorWndHExecute(Sender: TObject);
procedure aSetDoorWindowPllacementHeightExecute(Sender: TObject);
procedure aSetAllListDoorsPlacementHeightExecute(Sender: TObject);
procedure aSetAllListWndPlacementExecute(Sender: TObject);
procedure aSetAllListDoorsHeightExecute(Sender: TObject);
procedure aSetAllListWndHeightExecute(Sender: TObject);
procedure pnHintBarHotSpotClick(Sender: TObject);
procedure C1Click(Sender: TObject);
procedure aOneLineChemeExecute(Sender: TObject);
procedure Act_SelectCableToTraceExecute(Sender: TObject);
procedure Act_ConnectByCableExecute(Sender: TObject);
procedure Act_ConnectByCableAllExecute(Sender: TObject);
procedure Act_ConnectByCableOnEndsExecute(Sender: TObject);
procedure cbMainPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure mainFileClick(Sender: TObject);
procedure MainMenuChange(Sender: TObject; Source: TMenuItem;
Rebuild: Boolean);
procedure tbCADToolsExpertMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure EmptyTracesSelectExecute(Sender: TObject);
procedure EmptyRaiseVertSelectExecute(Sender: TObject);
procedure CopyList_AllExecute(Sender: TObject);
procedure CopyList_WComponExecute(Sender: TObject);
procedure pmiSCSObjAutoCreateTracesAdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
procedure Act_SetAsEndObjectExecute(Sender: TObject);
procedure Act_SelectFiberCableToTraceExecute(Sender: TObject);
procedure Act_ConnectToAnotherRackExecute(Sender: TObject);
procedure cbMainPanelBandPaint(Sender: TObject; Control: TControl;
Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);
procedure ToolButton4Click(Sender: TObject);
procedure N272AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
procedure aInstRaspredBoxExecute(Sender: TObject);
procedure aShieldAssemblySchemeExecute(Sender: TObject);
procedure TimerTracingIntervalTimer(Sender: TObject);
procedure mnuReservClick(Sender: TObject);
{ procedure SelectAllLineObjsHint(var HintStr: String;
var CanShow: Boolean);
procedure N209DrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect;
Selected: Boolean); }
private
//Tolik 30/04/2021 --
tbCADToolsNoob_oldProc: TWndMethod;
tbCADToolsNoob2_oldProc: TWndMethod;
tbCADToolsExpert_oldProc: TWndMethod;
tbOther_oldProc: TWndMethod;
tbFile_oldProc: TWndMethod;
tbObject_oldProc: TWndMethod;
tbLayers_oldProc: TWndMethod;
tbSCSToolsExpert_oldProc: TWndMethod;
cbMainPanel_oldProc: TWndMethod;
//
procedure WMAct(var msg: TMessage); message WM_ACTIVATE;
procedure SaveProjectForSC;
{ Private declarations }
// Tolik 30/04/2021 --
Procedure tbCADToolsNoob_NewProc(var message: TMessage);
Procedure tbCADToolsNoob2_NewProc(var message: TMessage);
Procedure tbCADToolsExpert_NewProc(var message: TMessage);
Procedure tbOther_NewProc(var message: TMessage);
Procedure tbFile_NewProc(var message: TMessage);
Procedure tbObject_NewProc(var message: TMessage);
Procedure tbLayers_NewProc(var message: TMessage);
Procedure tbSCSToolsExpert_NewProc(var message: TMessage);
Procedure cbMainPanel_NewProc(var message: TMessage);
//
protected
procedure FInteractiveMsg(var Msg: TMsg; var Handled: boolean);
procedure RunInteractive(aScene: Integer);
function CanResizePanelForm(AForm: TForm; ADeltaSize: Integer): Boolean;
//26.12.2011 - Ïåðåõâàò ñîáûòèé ñòàðòà ñïëèòòåðà è îòïóñêàíèÿ
procedure OnSplitterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure OnSplitterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
public
// äëÿ Docking`à îêîí ÌÏ è ÍÁ
CountDock1: integer;
CountDock2: integer;
// ïåðåìåííûå äëÿ îïðåäåëåíèÿ Docking`à FlightBar`îâ
tbEditDocking: boolean;
tbFileDocking: boolean;
tbFormatDocking: boolean;
tbObjectDocking: boolean;
tbSelectOptionsDocking: boolean;
tbCADToolsDocking: boolean;
tbSCSToolsDocking: boolean;
OldApplicationEventsMessage: TMessageEvent;
FPMItemsRoofHipTypes: TList; // Ýëåìåíòû ê.ì. ñ òèïàìè ðåáåð êðûøè
FCADsInProgress: TList;
FOldOnActionExecute: TActionEvent; //03.05.2013
FInteractiveActions: TList; //03.05.2013
FInteractiveControlHandler: HWnd;
FInteractiveStep: Integer; //06.05.2013
FInteractiveStepCount: Integer; //06.05.2013
FInteractiveStepHitsCount: Integer; //09.05.2013 - êîëè÷åñòâî çàõîäîâ çà îäèí øàã
FInteractiveScene: Integer; //06.05.2013
FInteractiveMsgOrig: TMessageEvent;
FInteractiveStepShowed: Boolean;
FInteractiveWorkColorSet: Boolean;
FInteractiveRackColorSet: Boolean;
//FInteractiveTimerExecution: Boolean; //11.05.2013
procedure StepInteractive;
procedure SetCursors;
// ñîõðàíèòü ïîäëîæêó
procedure SaveSubstrate(aFName: string);
// çàãðóçèòü ïîäëîæêó
procedure LoadSubstrate(aFName: string);
// ñîõðàíèòü ïëàí
procedure SaveFPlan(aFName: string);
// çàãðóçèòü ïëàí
procedure LoadFPlan(aFName: string);
// ñîõðàíèòü ðàìêó ëèñòà
procedure SaveStamp(aFName: string);
// çàãðóçèòü ðàìêó ëèñòà
procedure LoadStamp(aFName: string);
// ñáðîñ ïàíåëè èíñòðóìåíòîâ ÊÀÄ
procedure SkipCADPanelChecked;
// çàêðûòèå âñåõ îêîí (ïðîåêòà)
procedure CloseAll;
{ Public declarations }
// îòëàâëèâàíèå Exception, åñëè ôëàã çàêðûòèÿ ïðîãðàììû ïîäíÿò - âûãðóçèòü ïðîãðàììó
procedure AppException(Sender: TObject; E: Exception);
// ïðîâåðêà íà çàêðûòèå ïðîãðàììû
procedure CheckClose;
// ñîáûòèå, íà íåì âîññòàíîâëåíèå ïðîãðàììû ïîñëå ñâîðà÷èâàíèÿ
procedure WMUser(var msg: TMessage); message wm_user;
procedure ReceiveMessage (var Msg: TMessage); message WM_COPYDATA;
procedure WMGetSysCommand(var msg: TMessage); message WM_SYSCOMMAND;
procedure AddDoorObj(aDoorObjType: TDoorObjType);
procedure AddDoorEmbrasure;
procedure AddDoorNiche;
procedure SetLayerForDraw;
procedure SetMenuStatus(aStatus: Boolean);
procedure SetShowPathLengthType(aPathLengthType: TShowPathLengthType);
procedure SetShowPathTraceLengthType(aPathLengthType: TShowPathLengthType);
procedure SetToolArch(const aTool: string; aToolData: Integer=0);
procedure ShiftObjects(AShiftDirection: Integer);
procedure LoadSubstrateEx(aReplace: Boolean);
procedure SetFigureAsEndObject(aCad: TForm; aFigure: TFigure);
procedure CustomizeNewList; //27.06.2013
// 2011-05-10
function isMapScaleDifferent: Boolean;
//12.08.2011
procedure DefinePMItemsRoofHipTypes;
procedure OnPMItemsRoofHipTypeClick(Sender: TObject);
procedure SDCreateBlockToFileCanClose(Sender: TObject; var CanClose: Boolean); //11.03.2012
procedure ShowBlockParamsForPopupFigure(aAllowPersent: Boolean=true; aAllowProportion: Boolean=true);
procedure RecreateHandle;
procedure SetHints;
procedure InteractiveTest;
procedure InteractiveActionExecute(Action: TBasicAction; var Handled: Boolean);
end;
procedure SetDefaultActiveLayer;
procedure AutoFitBitMap(Bmp: TBMPObject);
const
// êîíñòàíòû êóðñîðîâ
crHandAni = 1;
crNewHand = 2;
crNewMove = 3;
crNewMoveCross = 4;
//Tolik
// äîïóñòèìàÿ ðàçíèöà êîîðäèíàò êîííåêòîðîâ â îäíîé òî÷êå
ConnectorDifference = 5;
var
phandle: THandle;
SetHook: procedure(); stdcall;
DropHook: procedure(); stdcall;
is_hook: boolean;
FSCS_Main: TFSCS_Main;
// ôëàã çàêðûòèÿ ïðîãðàììû
GExitProgEx: Boolean = False;
// ñîõð. íîìåð ñëîÿ ñ êîòîðîãî áûëî êîïèðîâàíèå/âûðåçêà â áóôåð îáìåíà
GCurrLayerBuffer: integer;
// ñâîéñòâà îáüåêòà
GObjectProperty: boolean = False;
// Èìÿ íîâîãî Ëèñòà è ÈÄ
GCurrentCADListID: integer;
GExportUSeScale: boolean = False;
hints_prog_id: string = '';
stat_prog_id: string = '';
implementation
uses
U_Cad, U_Main, U_IncOn, U_Navigator, U_Scale, U_GridStep, U_Common, {Tolik 15/02/2021 -- } U_ELCommon, U_BaseCommon, U_BaseConstants,
Unit_DM_SCS, U_SCSComponent, U_ObjsProp,
Types, U_Layers, U_NewLayer, U_SizePos, U_OrtholineParams,
U_LoadColor, U_SCSObjectsProp, U_InterfacesAutoTrace, U_MasterNewList, U_MasterNewListLite, U_RaiseHeight,
U_AutoTraceType, cxCheckBox, U_BlockEditor, U_Progress, U_ImportDXF, U_ExportDXF, U_ProtectionCommon,
U_Protection, U_ProtectionBase, U_Registration, U_ComponDesignWizard, U_SmetaExport, U_SCSLists,
U_ChooseComponTypes, U_ChooseComponTypesForReport, U_FloatPanel, U_EndPoints, U_CadNormsProp,
U_CadNormsList, U_TrunkSCS, U_Constants, RichEdit2, U_ChooseDesignBoxParams, U_ChooseSCSObjectsProp,
U_ReportForm, U_CreateRaiseQuery, U_PrintLists, U_BlockParams, U_ChooseListForTrunk, U_HouseClasses, U_ResourceReport,
// 2011-05-10
U_BaseSettings, PrvForm, {U_Arch3D}U_Arch3DNew, form3D, U_PDFView, U_HintBar, U_HintW,
{$IF Defined (SCS_RF)}
U_AboutRF, U_InputBox
{$ELSE}
U_About
{$IFEND}
// Tolik 16/05/2016 --
, U_SCSClasses
// Tolik 28/03/2017 --
, U_Master_compl
, U_PortsReIndex, U_PEGetBox,
U_Reserv; //Tolik 11/12/2024 --óïðàâëåíèå ðåçåðâíûìè êîïèÿìè
{$R *.dfm}
{$R Cursors.res}
{$R font.rc}
{$R hand.rc}
//
Procedure TFSCS_Main.tbCADToolsNoob_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbCADToolsNoob.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbCADToolsNoob_OldProc(message);
end;
Procedure TFSCS_Main.tbCADToolsNoob2_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbCADToolsNoob2.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbCADToolsNoob2_OldProc(message);
end;
Procedure TFSCS_Main.tbCADToolsExpert_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbCADToolsExpert.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbCADToolsExpert_OldProc(message);
end;
Procedure TFSCS_Main.tbOther_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbOther.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbOther_OldProc(message);
end;
Procedure TFSCS_Main.tbFile_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbFile.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbFile_OldProc(message);
end;
Procedure TFSCS_Main.tbObject_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbObject.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbObject_OldProc(message);
end;
Procedure TFSCS_Main.tbLayers_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbLayers.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbLayers_OldProc(message);
end;
Procedure TFSCS_Main.tbSCSToolsExpert_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := tbSCSToolsExpert.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
tbSCSToolsExpert_OldProc(message);
end;
Procedure TFSCS_Main.cbMainPanel_NewProc(var message: TMessage);
var Control: TControl;
begin
case message.Msg of
WM_LBUTTONDOWN, WM_LBUTTONDBLCLK:
begin
Control := cbMainPanel.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False);
if Assigned(Control) then
if Control is TToolButton then
CheckCloseReportForm;
end;
end;
cbMainPanel_OldProc(message);
end;
//
procedure ExtractExe(Instance: THandle; ResID: Integer; FileName: string);
var
ResStream: TResourceStream; // Îáúåêò - ïîòîê ðåñóðñîâ
FileStream: TFileStream;
begin
try
try
ResStream := TResourceStream.CreateFromID(Instance, Resid, RT_RCDATA);
FileStream := TFileStream.Create(FileName, fmCreate);
try
FileStream.CopyFrom(ResStream, 0);
finally
FreeAndNil(FileStream);
end;
finally
FreeAndNil(ResStream);
end;
except
on E:Exception do
begin
DeleteFile(FileName);
end;
end;
end;
{ TSplitter }
{procedure TSplitter.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
FOldMouseMoveTick := 0;
if Assigned(FOnMouseDown) then
FOnMouseDown(Self, Button, Shift, X, Y);
inherited;
end;
procedure TSplitter.MouseMove(Shift: TShiftState; X, Y: Integer);
var
SavedResizeStyle: TResizeStyle;
begin
SavedResizeStyle := ResizeStyle;
//if ResizeStyle = rsUpdate then
// begin
// // Åñëè ðåçàéç áûë íå òàê äàâíî, òî
// if (GetTickCount - FOldMouseMoveTick) < 40 then
// ResizeStyle := ExtCtrls.rsNone
// else
// FOldMouseMoveTick := GetTickCount;
// end;
inherited;
ResizeStyle := SavedResizeStyle;
end;
procedure TSplitter.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
begin
inherited;
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, Button, Shift, X, Y);
end;
}
procedure TFSCS_Main.SetCursors;
begin
//11.07.2013 - moved from TFSCS_Main.FormCreate
Screen.Cursors[crNewHand] := LoadCursor(HInstance, 'CUR_HAND1');
Screen.Cursors[crNewMove] := LoadCursor(HInstance, 'CUR_MOVE1');
Screen.Cursors[crNewMoveCross] := LoadCursor(HInstance, 'CUR_MOVE2');
end;
// ÑÎÇÄÀÍÈÅ ÃËÀÂÍÎÉ ÔÎÐÌÛ
procedure TFSCS_Main.FormCreate(Sender: TObject);
var
buff: PChar;
i: integer;
RemoveStatus: boolean;
LastError: DWORD;
begin
DisableAlign;
self.Color := clBtnFace;
try
{$IF Defined(TRIAL_SCS)}
Self.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ' Trial)';
{$ELSE}
Self.Caption := ApplicationName + cMain_Mes2 + ' ' + versionEXE + cMain_Mes3 + DateEXE + ')';
{$IFEND}
{$if Defined(ES_GRAPH_SC)}
pnHintBar.Visible := False;
{$ifend}
CountDock1 := 0;
CountDock2 := 0;
GRefreshCad := nil;
GCurrentCADListID := 0;
GexitProg := True;
Self.SetCursors; //11.07.2013
ExtractExe(HInstance, $2, 'handa.ani');
try
ExtractExe(HInstance, $3, 'gost.ttf');
except
end;
try
GetMem(buff, 256*2);
GetWindowsDirectory(buff, 255);
// DeleteFile(PChar(buff + '\Fonts\' + 'gost.ttf'));
if Not FileExists(buff + '\Fonts\' + 'gost.ttf') then
begin
try
CopyFile(PChar(ExeDir + '\gost.ttf'), PChar(buff + '\Fonts\' + 'gost.ttf'), False);
except
end;
end;
if AddFontResource(PChar(buff + '\Fonts\' + 'gost.ttf')) = 0 then
LastError := GetLastError;
FreeMem(Buff);
except
end;
PostMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
Screen.Cursors[crHandAni] := LoadCursorFromFile('handa.ani');
Application.HelpFile := ExeDir + '\HELP\HELP.HLP';
// Çàäàòü Captions íà ïàíåëÿõ
tbSCSHDimLineNoob.Caption := cMain_Mes104;
tbSCSVDimLineNoob.Caption := cMain_Mes105;
tbCabinetNoob.Caption := cMain_Mes106;
tbCabinetExtNoob.Caption := cMain_Mes117;
tbWallRectNoob.Caption := cMain_Mes107;
tbWallPathNoob.Caption := cMain_Mes108;
tbToolOrtholineExtNoob.Caption := cMain_Mes109;
tbToolOrtholineNoob.Caption := cMain_Mes110;
tbHouseNoob.Caption := cMain_Mes114;
tbPanNoob.Caption := cMain_Mes118;
{$IF DEFINED(SCS_PE) or DEFINED(SCS_SPA)}
{$IF Defined(SCS_PANDUIT) or DEFINED(SCS_PE)}
N221.Enabled := True;
aInteractive.Visible := True;
aInteractive.Enabled := true;
{$ELSE}
aInteractive.Visible := False;
{$IFEND}
// Tolik --24/01/2017 - -
//tbSCSToolsNoob.Width := cSCSNoob_PE;
tbSCSToolsNoob.Width := cSCSNoob_PE + 20;
//
aSaveToIBD.Visible := False;
//aCreateNormsOnCad.Visible := False;
aCreateNormsOnCad.Visible := True;
aWizards.Visible := False;
aTechDoc.Visible := True;
aBuy.Visible := False;
aPresentation.Visible := False;
aShowDefectObjects.Visible := False;
//aManual_Norms.Visible := False;
aManual_Norms.Visible := True;
aHelp.Visible := False;
aCHM.Visible := False;
ExpertPresentation1.Visible := False;
{$ELSE}
{$IF Defined(SCS_PANDUIT)}
N221.Enabled := True;
aInteractive.Visible := True;
aInteractive.Enabled := true;
// Tolik -- 24/01/2017 --
//tbSCSToolsNoob.Width := cSCSNoob_PE;
tbSCSToolsNoob.Width := cSCSNoob_PE + 20;
//
aSaveToIBD.Visible := False;
//aCreateNormsOnCad.Visible := False;
aCreateNormsOnCad.Visible := True;
aWizards.Visible := False;
aTechDoc.Visible := True;
aBuy.Visible := False;
aPresentation.Visible := False;
aShowDefectObjects.Visible := False;
//aManual_Norms.Visible := False;
aManual_Norms.Visible := True;
aHelp.Visible := False;
aCHM.Visible := False;
ExpertPresentation1.Visible := False;
{$ELSE}
// Tolik --
// tbSCSToolsNoob.Width := cSCSNoob_SCS;
tbSCSToolsNoob.Width := cSCSNoob_SCS + 20;
//
aSaveToIBD.Visible := True;
aCreateNormsOnCad.Visible := True;
aInteractive.Visible := false;
aWizards.Visible := True;
aTechDoc.Visible := True;
aBuy.Visible := True;
aPresentation.Visible := True;
aShowDefectObjects.Visible := True;
aManual_Norms.Visible := True;
{$IFEND}
{$IFEND}
//07.10.2011 - ïåðåíåñåíî íà FormShow, òàê êàê íà ýòîò ìîìåíò ðàçìåðû ôîðìû íå ïîä ýêðàí,
// ÷òî íå äàåò íåêîòîðûì ïàíåëåì âûñòàâèòü øèðèíó, òàê êàê îíà áîëüøå øèðèíû ôîðìû íà òåê. ìîìåíò
//{$IF Defined(SCS_PE) or DEFINED(SCS_SPA)}
// aToolHouse.Visible := False;
// tbCADToolsNoob.Width := cCADNoob_PE;
// {$ELSEIF Defined(TELECOM)}
// aToolHouse.Visible := False;
// tbCADToolsNoob.Width := cCADNoob_TEL;
// {$ELSE}
// aToolHouse.Visible := True;
// tbCADToolsNoob.Width := cCADNoob_SCS;
// {$IFEND}
{$IF DEFINED(SCS_SPA)}
ExpertPresentation1.Visible := false;
{$IFEND}
// Ðåæèì Ýêñïåðòà
if GSCSIni.Controls.F_SCSMain_IsPanelExpertMode then
begin
aExpertMode.Checked := True;
tbCADToolsExpert.Visible := True;
// Tolik 24/01/2017 --
tbCADToolsNoob2.Visible := False;
//
tbCADToolsNoob.Visible := False;
tbSCSToolsExpert.Visible := True;
tbSCSToolsNoob.Visible := False;
end
else
begin
aExpertMode.Checked := False;
tbCADToolsExpert.Visible := False;
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsExpert.Visible := True;
{$else}
tbSCSToolsExpert.Visible := False;
{$ifend}
tbCADToolsNoob2.Visible := False;
tbCADToolsNoob.Visible := False;
tbCADToolsNoob.Visible := True;
tbCADToolsNoob2.Visible := True;
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsNoob.Visible := False;
{$else}
//
//tbSCSToolsNoob.Visible := True;
{$ifend}
end;
if tbCADToolsNoob.Visible then
begin
tbCADToolsNoob.Top := tbCADToolsExpert.Top;
tbCADToolsNoob.Left := tbCADToolsExpert.Left;
// Tolik -- 01/02/2017 --
{$if Defined(ES_GRAPH_SC)}
tbCADToolsNoob2.Top := tbCADToolsExpert.Top;
tbCADToolsNoob2.Left := tbCADToolsNoob.Left + tbCADToolsNoob.width + 10;
{$else}
tbCADToolsNoob2.Top := tbCADToolsExpert.Top + 30;
tbCADToolsNoob2.Left := tbCADToolsExpert.Left;
{$ifend}
//
end;
if tbSCSToolsNoob.Visible then
begin
tbSCSToolsNoob.Top := tbSCSToolsExpert.Top;
end;
if tbCADToolsExpert.Visible then
begin
tbSelectExpert.Down := True;
tbSelectNoob.Down := False;
end
else
begin
tbSelectExpert.Down := False;
tbSelectNoob.Down := True;
end;
if Assigned(cbScaleExpert) then
begin
cbScaleExpert.Properties.Items.Clear;
cbScaleExpert.Properties.Items.Add('50%');
cbScaleExpert.Properties.Items.Add('75%');
cbScaleExpert.Properties.Items.Add('100%');
cbScaleExpert.Properties.Items.Add('150%');
cbScaleExpert.Properties.Items.Add('200%');
cbScaleExpert.Properties.Items.Add('400%');
cbScaleExpert.Properties.Items.Add(cMain_Mes111);
end;
if Assigned(cbScaleNoob) then
begin
cbScaleNoob.Properties.Items.Clear;
cbScaleNoob.Properties.Items.Add('50%');
cbScaleNoob.Properties.Items.Add('75%');
cbScaleNoob.Properties.Items.Add('100%');
cbScaleNoob.Properties.Items.Add('150%');
cbScaleNoob.Properties.Items.Add('200%');
cbScaleNoob.Properties.Items.Add('400%');
cbScaleNoob.Properties.Items.Add(cMain_Mes111);
end;
if PROG_NEWSID = '-1' then
aExpertNews.Visible := False;
if GLiteVersion then
begin
mainFormat.Visible := False;
mainTools.Visible := False;
tbSelectExpert.Visible := True;
tbPanExpert.Visible := True;
tbsToolsExpert.Visible := False; //29.12.2011
tbLineExpert.Visible := False;
//Tolik 23/07/2017 --
tbPieExpert.Visible := False;
//
tbRectangleExpert.Visible := False;
tbEllipseExpert.Visible := False;
tbCircleExpert.Visible := False;
tbArcExpert.Visible := False;
tbElipticArcExpert.Visible := False;
tbPolyLineExpert.Visible := False;
tbPointExpert.Visible := False;
tbTextExpert.Visible := False;
tbRichTextExpert.Visible := False;
tbKnifeExpert.Visible := False;
tbHDimLineExpert.Visible := False;
tbVDimLineExpert.Visible := False;
tbSCSHDimLineExpert.Visible := True;
tbSCSVDimLineExpert.Visible := True;
tbSCSArcDimLineExpert.Visible := True;
tbCabinetExpert.Visible := True;
tbCabinetExtExpert.Visible := True;
//29.03.2012 tbWallRectExpert.Visible := False;
//29.03.2012 tbWallPathExpert.Visible := False;
tbHouseExpert.Visible := False;
//Tolik 18/02/2022 --
//tbCreateOnClickModeExpert.Down := True;
//tbToolOrtholineExpert.Down := True;
//tbToolOrtholineExtExpert.Down := True;
tbToolOrtholineExpert.Down := False;
tbToolOrtholineExtExpert.Down := False;
tbCreateOnClickModeExpert.Down := False;
//
tbSelectNoob.Visible := True;
tbSCSHDimLineNoob.Visible := True;
tbSCSVDimLineNoob.Visible := True;
tbSCSArcDimLineNoob.Visible := True;
tbCabinetNoob.Visible := True;
tbCabinetExtNoob.Visible := True;
//29.03.2012 tbWallRectNoob.Visible := False;
//29.03.2012 tbWallPathNoob.Visible := False;
tbHouseNoob.Visible := False;
//Tolik 18/02/2022 --
//tbCreateOnClickModeNoob.Down := True;
//tbToolOrtholineNoob.Down := True;
//tbToolOrtholineExtNoob.Down := True;
tbCreateOnClickModeNoob.Down := False;
tbToolOrtholineNoob.Down := False;
tbToolOrtholineExtNoob.Down := False;
//
aMasterAutoTrace.Visible := False;
aMasterAutoTraceElectric.Visible := False;
aCreateNormsOnCad.Visible := False;
aManual_Interfaces.Visible := False;
end;
GFtpConnectStr := ReadSetting(fnSCSIniFile, dtString, scReservFtp, idtConnectString, '');
mnuReserv.Enabled := GFtpConnectStr <> '';
//#From Oleg#
//XPMenu.Active := false;
//XPMenu.Active := True;
FCADsInProgress := TList.Create; //07.11.2011
//sDiv1.OnMouseDown := OnSplitterMouseDown;
//sDiv1.OnMouseUp := OnSplitterMouseUp;
//sDiv2.OnMouseDown := OnSplitterMouseDown;
//sDiv2.OnMouseUp := OnSplitterMouseUp;
SetHints;
//pnHintBar
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.FormCreate', E.Message);
end;
// Tolik 05/05/2021 --
tbCADToolsNoob_OldProc := tbCADToolsNoob.WindowProc;
tbCADToolsNoob.WindowProc := tbCADToolsNoob_newProc;
tbCADToolsNoob2_OldProc := tbCADToolsNoob2.WindowProc;
tbCADToolsNoob2.WindowProc := tbCADToolsNoob2_newProc;
tbCADToolsExpert_OldProc := tbCADToolsExpert.WindowProc;
tbCADToolsExpert.WindowProc := tbCADToolsExpert_newProc;
tbOther_OldProc := tbOther.WindowProc;
tbOther.WindowProc := tbOther_newProc;
tbFile_OldProc := tbFile.WindowProc;
tbFile.WindowProc := tbFile_newProc;
tbObject_OldProc := tbObject.WindowProc;
tbObject.WindowProc := tbObject_newProc;
tbLayers_OldProc := tbLayers.WindowProc;
tbLayers.WindowProc := tbLayers_newProc;
tbSCSToolsExpert_OldProc := tbSCSToolsExpert.WindowProc;
tbSCSToolsExpert.WindowProc := tbSCSToolsExpert_newProc;
cbMainPanel_OldProc := cbMainPanel.WindowProc;
cbMainPanel.WindowProc := cbMainPanel_newProc;
//
EnableAlign;
end;
// ÑÎÇÄÀÒÜ ÏÐÎÅÊÒ
procedure TFSCS_Main.aNewExecute(Sender: TObject);
var
i: integer;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
if Not IsVista then
begin
BuildFHash;
GetLic;
for i := 0 to 15 do
begin
if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) <> 0 then
begin
exit;
end;
end;
end;
{$IFEND}
// Tolik 30/04/2021 --
{
tbCADToolsNoob_OldProc := tbCADToolsNoob.WindowProc;
tbCADToolsNoob.WindowProc := tbCADToolsNoob_newProc;
tbCADToolsNoob2_OldProc := tbCADToolsNoob2.WindowProc;
tbCADToolsNoob2.WindowProc := tbCADToolsNoob2_newProc;
tbCADToolsExpert_OldProc := tbCADToolsExpert.WindowProc;
tbCADToolsExpert.WindowProc := tbCADToolsExpert_newProc;
tbOther_OldProc := tbOther.WindowProc;
tbOther.WindowProc := tbOther_newProc;
tbFile_OldProc := tbFile.WindowProc;
tbFile.WindowProc := tbFile_newProc;
tbObject_OldProc := tbObject.WindowProc;
tbObject.WindowProc := tbObject_newProc;
tbLayers_OldProc := tbLayers.WindowProc;
tbLayers.WindowProc := tbLayers_newProc;
cbMainPanel_OldProc := cbMainPanel.WindowProc;
cbMainPanel.WindowProc := cbMainPanel_newProc;
}
//
try
MakeProject;
// SetMenuStatus(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewExecute', E.Message);
end;
end;
// ÑÎÇÄÀÒÜ ÍÎÂÛÉ ËÈÑÒ
procedure TFSCS_Main.aNewListExecute(Sender: TObject);
var
ListParams: TListParams;
Res: Boolean;
//IDFloor: Integer;
// ListForPassage: TF_CAD;
// SavedCAD: TF_CAD;
begin
try
ListParams := GetListParamsForNewList;
F_MasterNewList.Tag := 0;
Res := MakeEditList(meMake, ListParams, True);
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
GCadForm.FListType := lt_Normal;
//24.06.2013 - ñîçäàíèå ì-ý ïåðåõîäà
if Res then
begin
CustomizeNewList;
// //27.06.2013 - ïîäãðóçêà ïîäëîæêè ñ çàìåíîé ñóùåñòâóþùåé, ñîõðàíÿÿ ðàçìåðû/ïîçèöèè
// Application.ProcessMessages;
// LoadSubstrateEx(true);
// //25.06.2013 - âûáîð ìåñòà äëÿ ì-ý íà íîâîì ëèñòå
// IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1);
// ListForPassage := nil;
//
// if IDFloor > 0 then
// begin
// ListForPassage := GetListByID(IDFloor);
// if ListForPassage <> nil then
// begin
// // Òóëçà ñîçäàíèÿ ì-ý ïåðåõîäà
// if MessageQuastYN(cMain_Mes139) = IDYES then
// begin
// Application.ProcessMessages;
// if GCadForm.CurrentLayer <> lnSCSCommon then
// GCadForm.CurrentLayer := lnSCSCommon;
// GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName);
// end;
// end;
// end;
////25.06.2013 - âûáîð ìåñòà äëÿ ì-ý íà ëèñòå íèæå
// IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1);
// ListForPassage := nil;
// if IDFloor > 0 then
// begin
// ListForPassage := GetListByID(IDFloor);
// if ListForPassage <> nil then
// begin
// // Òóëçà ñîçäàíèÿ ì-ý ïåðåõîäà
// if MessageQuastYN(cMain_Mes139) = IDYES then
// begin
// Application.ProcessMessages;
// SavedCAD := GCADForm;
// try
// GCADForm := ListForPassage;
// GCadForm.BringToFront;
//
// if GCadForm.CurrentLayer <> lnSCSCommon then
// GCadForm.CurrentLayer := lnSCSCommon;
// GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName);
// finally
// //GCADForm := SavedCAD;
// //GCadForm.BringToFront;
// end;
// end;
// end;
// end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewListExecute', E.Message);
end;
end;
// ÎÊÐÛÒÜ ÏÐÎÅÊÒ
procedure TFSCS_Main.aOpenProjectExecute(Sender: TObject);
begin
try
// ïîäâÿçàòü ê ôîðìå ïðîåêòà
if F_ProjMan <> nil then
begin
F_ProjMan.Position := poDesigned;
F_ProjMan.Show;
aViewProjectManager.Checked := True;
F_ProjMan.ManualDock(FSCS_Main.pDock1, nil, alNone);
FSCS_Main.pDock1.Width := 200;
end
else
aViewProjectManager.Checked := False;
if F_NormBase <> nil then
begin
F_NormBase.Position := poDesigned;
F_NormBase.Show;
aViewNormBase.Checked := True;
F_NormBase.ManualDock(FSCS_Main.pDock2, nil, alNone);
FSCS_Main.pDock2.Width := 200;
end
else
aViewNormBase.Checked := False;
if F_HintBar = nil then
begin
F_HintBar := TF_HintBar.Create(Application);
F_HintBar.Parent := pnHintBar;
F_HintBar.Align := alClient;
F_HintBar.Show;
F_HintBar.StartWizard;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aOpenProjectExecute', E.Message);
end;
end;
// Çàãðóçèòü ïîäëîæêó
procedure TFSCS_Main.aLoadSubstrateExecute(Sender: TObject);
var
FName, FExt: string;
i: integer;
FDir: string;
OpenDialog: TOpenDialog;
Jpeg: TJpegImage;
Bmp: TBMPObject;
Bitmp: TBitmap;
Fig: TFigure;
begin
GisUserDimLine := True;//Tolik 11/08/2021 --
//if ActiveMDIChild <> nil then
// begin
// OpenDialog := TOpenDialog.Create(Self);
// {$if Defined(ES_GRAPH_SC)}
// FDir := ExeDir;
// {$else}
// FDir := ExtractFileDir(Application.ExeName);
// {$ifend}
// if DirectoryExists(FDir + '\.Makets') then
// FDir := FDir + '\.Makets';
// OpenDialog.Title := cMain_Mes4;
// OpenDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers);//ExtractSaveDirForCategory('.Makets'); //FDir;
// OpenDialog.DefaultExt := 'scb';
// OpenDialog.Filter := cMain_Mes5;
// if OpenDialog.Execute then
// begin
// try
// FName := OpenDialog.FileName;
// LoadSubstrate(FName);
// GCadForm.PCad.DeselectAll(0);
// except
// ShowMessage(cMain_Mes6);
// end;
// RefreshCAD(GCadForm.PCad);
// end;
// OpenDialog.Free;
// end
// else
// MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
LoadSubstrateEx(false);
//Tolik 11/08/2021 --
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
end;
// ÇÀÊÐÛÒÜ ÏÐÎÅÊÒ
procedure TFSCS_Main.aCloseExecute(Sender: TObject);
begin
try
if FSCS_Main.MDIChildCount > 0 then
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
// GNotNeedCheckRaisesBeforeClose := True;
GCadForm.Close;
// GNotNeedCheckRaisesBeforeClose := False;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCloseExecute', E.Message);
end;
end;
// ñîõðàíåíèå ïîäëîæåê
procedure TFSCS_Main.SaveSubstrate(aFName: string);
var
TempCad: TPowerCad;
begin
TempCad := TPowerCad.create(FSCS_Main);
try
TempCad.Parent := FSCS_Main;
TempCad.NewLayer(cCad_Mes1);
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.ActiveLayer := 1;
GCadForm.PCad.SelectAll(1);
Clipboard.Clear;
GCadForm.PCad.CopyToClipBoard;
TempCad.PasteFromClipBoard(1);
TempCad.SaveToFile(1, aFName);
Clipboard.Clear;
finally
try
FreeAndNil(TempCad);
except
end;
end;
end;
// çàãðóçêà ïîäëîæåê
procedure TFSCS_Main.LoadSubstrate(aFName: string);
var
TempCad: TPowerCad;
i: integer;
begin
TempCad := TPowerCad.create(FSCS_Main);
try
TempCad.Parent := FSCS_Main;
TempCad.LoadFromFile(aFName);
TempCad.SelectAll(1);
Clipboard.Clear;
TempCad.ActiveLayer := 1;
GCadForm.CurrentLayer := 1;
TempCad.CopyToClipBoard;
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.PCad.PasteFromClipBoard(1);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
Clipboard.Clear;
finally
try
FreeAndNil(TempCad);
except
end;
end;
end;
procedure TFSCS_Main.SaveFPlan(aFName: string);
var
TempCad: TPowerCad;
begin
TempCad := TPowerCad.create(FSCS_Main);
try
TempCad.Parent := FSCS_Main;
TempCad.NewLayer(cCad_Mes8);
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.ActiveLayer := 8;
GCadForm.PCad.SelectAll(8);
Clipboard.Clear;
GCadForm.PCad.CopyToClipBoard;
TempCad.PasteFromClipBoard(1);
TempCad.SaveToFile(1, aFName);
Clipboard.Clear;
finally
try
FreeAndNil(TempCad);
except
end;
end;
end;
procedure TFSCS_Main.LoadFPlan(aFName: string);
var
TempCad: TPowerCad;
i: integer;
begin
TempCad := TPowerCad.create(FSCS_Main);
try
TempCad.Parent := FSCS_Main;
TempCad.LoadFromFile(aFName);
TempCad.SelectAll(1);
Clipboard.Clear;
TempCad.ActiveLayer := 1;
GCadForm.CurrentLayer := 8;
TempCad.CopyToClipBoard;
GCadForm.PCad.OnObjectInserted := nil;
GCadForm.PCad.PasteFromClipBoard(8);
GCadForm.PCad.OnObjectInserted := GCadForm.PCadObjectInserted;
Clipboard.Clear;
finally
try
FreeAndNil(TempCad);
except
end;
end;
end;
// ÑÎÕÐÀÍÈÒÜ Ïîäëîæêó
procedure TFSCS_Main.aSaveSubstrateExecute(Sender: TObject);
var
FName: string;
FDir: string;
SaveDialog: TSaveDialog;
begin
if ActiveMDIChild <> nil then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.Makets') then
FDir := FDir + '\.Makets';
SaveDialog.Title := cMain_Mes7;
SaveDialog.InitialDir := FDir;
SaveDialog.DefaultExt := 'scb';
SaveDialog.Filter := cMain_Mes5;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
if SaveDialog.Execute then
begin
try
FName := SaveDialog.FileName;
SaveSubstrate(FName);
except
ShowMessage(cMain_Mes6);
end;
end;
SaveDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÎÕÐÀÍÈÒÜ ïîäëîæêó ÊÀÊ ...
procedure TFSCS_Main.aSaveAsSubstrateExecute(Sender: TObject);
var
FName: string;
FDir: string;
SaveDialog: TSaveDialog;
PDFDoc: TPDFDocument;
begin
if ActiveMDIChild <> nil then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.Makets') then
FDir := FDir + '\.Makets';
SaveDialog.Title := cMain_Mes7;
SaveDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers);//ExtractSaveDirForCategory('.Makets');//FDir;
SaveDialog.DefaultExt := 'scb';
SaveDialog.Filter := cMain_Mes5 + '|'+ cProgressExp_Msg9_1; //29.02.2012 cMain_Mes5;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
if SaveDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctBackgLayers, ExtractFileDir(SaveDialog.FileName));
//
FName := SaveDialog.FileName;
if ExtractFileExt(SaveDialog.FileName) = '.scb' then
SaveSubstrate(FName)
else
begin
PDFDoc := CreatePDFObject(Self, cCad_Mes1 +' '+ GetListParams(GCadForm.FCADListID).Caption, SaveDialog.FileName, nil);
PDFDoc.BeginDoc;
SetCADPageParamsToPDF(GCadForm, PDFDoc, true);
PDFDoc.EndDoc;
PDFDoc.Free;
end;
except
ShowMessage(cMain_Mes8);
end;
end;
SaveDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÝÊÑÏÎÐÒÈÐÎÂÀÒÜ ÈÇ ÏÐÎÅÊÒÀ
procedure TFSCS_Main.aExportExecute(Sender: TObject);
var
FName: string;
begin
if ActiveMDIChild <> nil then
begin
SaveDXFFile(GCadForm.PCad, cExport_Mes1, cImport_Mes12);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÈÌÏÎÐÒÈÐÎÂÀÒÜ Â ÏÐÎÅÊÒ
procedure TFSCS_Main.aImportExecute(Sender: TObject);
var
FName: string;
begin
if ActiveMDIChild <> nil then
begin
// LoadDXFFile(GCadForm.PCad);
LoadDXFFileNew(GCadForm.PCad, cImport_Mes4, cImport_Mes5);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÐÅÄÂÀÐÈÒÅËÜÍÛÉ ÏÐÎÑÌÎÒÐ ËÈÑÒÀ
procedure TFSCS_Main.aPrevViewExecute(Sender: TObject);
var
i: integer;
SelCheck: integer;
prnW,prnH: Integer;
resX,resY: Integer;
pw, ph: integer;
dev,
driv,
port: array[0..80] of Char;
deviceMode: THandle;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
SelCheck := 0;
if Not IsVista then
begin
GetLic;
BuildFHash;
SelCheck := 0;
for i := 0 to 35 do
begin
SelCheck := SelCheck + ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A)))
end;
end;
{$ELSE}
SelCheck := 0;
{$IFEND}
{$if Not Defined(ES_GRAPH_SC)}
if SelCheck > 0 then
ExitProcess(0);
{$ifend}
{$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)}
ShowMessage(cMain_Mes9);
{$ELSE}
{$if Defined(ES_GRAPH_SC_EXE)}
// ShowMessage('Print...');
{$ifend}
try
if ActiveMDIChild <> nil then
begin
// SetupPrinter(round(GCadForm.PCad.WorkHeight), round(GCadForm.PCad.WorkWidth), integer(GCadForm.PCad.PageOrient) + 1);
// GCadForm.PCad.AutoTilePrint := False;
try
Printer.GetPrinter(dev, driv, port, deviceMode);
Printer.SetPrinter(dev, driv, port, 0)
except
on E: Exception do ShowMessage('Printer.GetPrinter - ' + E.Message);
end;
try
// Portrait
if GCadForm.PCad.PageOrient = TPageOrient(1) then
begin
Printer.Orientation := TPrinterOrientation(0);
end
else
// Landscape
begin
Printer.Orientation := TPrinterOrientation(1);
end;
except
on E: Exception do ShowMessage('Printer.Orientation - ' + E.Message);
end;
try
prnW := GetDeviceCaps(printer.Handle, PHYSICALWIDTH);
prnH := GetDeviceCaps(printer.Handle, PHYSICALHEIGHT);
resX := GetDeviceCaps(printer.Handle, LOGPIXELSX);
resY := GetDeviceCaps(printer.Handle, LOGPIXELSY);
except
on E: Exception do ShowMessage('GetDeviceCaps - ' + E.Message);
end;
pw := round(prnW / (resX / 25.4));
ph := round(prnH / (resY / 25.4));
try
GPreview := True;
Init_prnW := round(prnW * (GCadForm.PCad.WorkWidth / pw));
Init_prnH := round(prnH * (GCadForm.PCad.WorkHeight / ph));
try
GCadForm.PCad.PrintPreview;
except
on E: Exception do ShowMessage('PCad.PrintPreview - ' + E.Message);
end;
finally
GPreview := False;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do ShowMessage(E.Message);
end;
{$IFEND}
end;
// ÏÅ×ÀÒÜ ËÈÑÒÀ
procedure TFSCS_Main.aPrintExecute(Sender: TObject);
var
i: integer;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
if Not IsVista then
begin
BuildFHash;
GetLic;
for i := 0 to 15 do
begin
if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then
Close;
end;
end;
{$IFEND}
{$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)}
ShowMessage(cMain_Mes9);
{$ELSE}
if ActiveMDIChild <> nil then
FSCS_Main.aPrevViewExecute(Sender)
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
{$IFEND}
end;
// ÂÛÕÎÄ ÈÇ ÏÐÎÅÊÒÀ
procedure TFSCS_Main.aExitExecute(Sender: TObject);
begin
GNotNeedCheckRaisesBeforeClose := True;
FSCS_Main.Close;
end;
// ÎÒÌÅÍÈÒÜ
procedure TFSCS_Main.aUndoExecute(Sender: TObject);
var a: Integer;
figstream: TMemoryStream;
FileStream: Tstream;
Figure: TFigure;
xSize: Integer;
begin
(*try
// Tolik 18/11/2020 -- Ýòî "Âûëåòèò" íà ïóñòîì ïðîåêòå (åñëè, íàïðèìåð, âñå ëèñòû óäàëèòü !!!, òàì GCadForm íå áóäåò!!!)
if Assigned(GCadForm) then
begin
//
FileStream := TStream.Create;
//FileStream := SafeOpenFileStream('c:\Figstream.txt', fmCreate, 'TPCDrawing.SaveSCSFiguresToFile', cSCSComponent_Msg22_7);
For a := 0 to GCadForm.PCad.Figures.Count - 1 do
begin
Figure := TFigure(GCadForm.PCad.Figures[a]);
//if Figure.Classname <> 'TFigureGrpNotMod' then
//if Figure.Classname = 'TFigureGrp' then
begin
figStream := TMemoryStream.Create;
Figure.WriteToStream(figStream);
xSize := figStream.Size;
figStream.Seek(0, soFromBeginning);
FileStream.Write(xSize, 4);
StreamToStream(figStream, FileStream, xSize);
FreeAndNil(figStream);
end;
end;
FreeAndNil(FileStream);
end;
Except
On E:Exception do ShowMessage('Write Figures to Stream ERROR !!! ' + Figure.Cname);
end;
*)
if ActiveMDIChild <> nil then
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
// CTRL + Z äëÿ ñëîÿ ÑÊÑ
if (GCadForm.FListType = lt_Normal) and ((GCadForm.PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer)) then
begin
GCadForm.SCSUndoNormalList;
SetProjectChanged(True);
end
else
if (GCadForm.FListType = lt_ProjectPlan) then
begin
GCadForm.SCSUndoProjectPlan;
SetProjectChanged(True);
end
else
if (GCadForm.FListType = lt_DesignBox) then
begin
GCadForm.SCSUndoDesignList;
SetProjectChanged(True);
end
// Tolik 12/02/2021 --
else
if (GCadForm.FListType = lt_ElScheme) then
begin
GCadForm.SCSUndoElScheme;
SetProjectChanged(True);
end
//Tolik 06/02/2023 --
else
if (GCadForm.FListType = lt_AScheme) then
begin
GCadForm.SCSUndoElScheme;
SetProjectChanged(True);
end
//
else
if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
begin
GCadForm.PCad.UnDo;
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aUndoExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÂÒÎÐÈÒÜ
procedure TFSCS_Main.aRedoExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
// CTRL + Y äëÿ ñëîÿ ÑÊÑ
if (GCadForm.FListType = lt_Normal) and ((GCadForm.PCad.ActiveLayer = lnArch) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer)) then
begin
GCadForm.SCSRedoNormalList;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (GCadForm.FListType = lt_ProjectPlan) then
begin
GCadForm.SCSRedoProjectPlan;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (GCadForm.FListType = lt_DesignBox) then
begin
GCadForm.SCSRedoDesignList;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
// Tolik 12/02/2021 -- åñëè òèï ëèñòà - ñõåìà ýëåêòðè÷åñêàÿ
else
if ((GCadForm.FListType = lt_ElScheme) or (GCadForm.FListType = lt_AScheme)) then
begin
//GCadForm.SCSRedoElScheme;
GCadForm.PCad.ReDo;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
//
else
if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
begin
GCadForm.PCad.ReDo;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRedoExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÅÇÀÒÜ ÂÛÄÅËÅÍÍÎÅ
procedure TFSCS_Main.aCutExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
try
if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
begin
GCadForm.PCad.CutToClipBoard;
GCurrLayerBuffer := GCadForm.PCad.ActiveLayer;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCutExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÊÎÏÈÐÎÂÀÒÜ ÂÛÄÅËÅÍÍÎÅ
procedure TFSCS_Main.aCopyExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
try
if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
begin
GCadForm.PCad.CopyToClipBoard;
GCurrLayerBuffer := GCadForm.PCad.ActiveLayer;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCopyExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÑÒÀÂÈÒÜ ÂÛÄÅËÅÍÍÎÅ
procedure TFSCS_Main.aPasteExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if (GCadForm.PCad.ActiveLayer <> 1) and (GCadForm.PCad.ActiveLayer <> 8) and (GCadForm.PCad.ActiveLayer <> 7) then
begin
GCadForm.CurrentLayer := 1;
end;
if not CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
GCadForm.PCad.PasteFromClipBoard(GCadForm.PCad.ActiveLayer);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPasteExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÄÅËÈÒÜ ÂÑÅ
procedure TFSCS_Main.aSelectAllExecute(Sender: TObject);
var
ActLayer: integer;
begin
if ActiveMDIChild <> nil then
begin
try
ActLayer := GCadForm.PCad.ActiveLayer;
if ActLayer = lnSCSCommon then
begin
// c Shift íî áåç ALT - âûäåëèòü âñå òðàññû è ñ/ï
// c Shift è c ALT - âûäåëèòü òðàññû áåç ñ/ï (òîëüêî ñ/ï ìîæíî áóäåò âûäåëèòü òàê: âíà÷àëå ïðîñòî Ctrl-A - âûäåëèòñÿ âñå,
// à çàòåì èíâåðòèðóåì âûäåëåíèå - âûäåëÿòñÿ òîëüêî ñ/ï
// ñ ALT íî áåç Shift - èíâåðòèðîâàòü âûáîð
if ((GetKeyState(VK_SHIFT) and 128) = 128) and ((GetKeyState(VK_MENU) and 128) = 0) then //Åñëè íàæàòà VK_SHIFT è íå íàæàò ALT
begin
GCadForm.SelectTracesAndRaisers;
end
else if ((GetKeyState(VK_SHIFT) and 128) = 128) and ((GetKeyState(VK_MENU) and 128) = 128) then //Åñëè íàæàòà ALT è Shift (÷òî áû ðàáîòàëî ñ ìåíþ - âíà÷àëå íàæèìàòü ïóíêò íå îòïóñêàÿ ìûøó íàæàòü Alt)
begin
GCadForm.SelectTraces;
end
else if ((GetKeyState(VK_SHIFT) and 128) = 0) and ((GetKeyState(VK_MENU) and 128) = 128) then //Åñëè íàæàòà ALT íî áåç Shift (÷òî áû ðàáîòàëî ñ ìåíþ - âíà÷àëå íàæèìàòü ïóíêò íå îòïóñêàÿ ìûøó íàæàòü Alt)
begin
GCadForm.InvertSCSSelection;
end
else
GCadForm.PCad.SelectAll(ActLayer);
end
else
begin
if ((GetKeyState(VK_MENU) and 128) = 128) then //Åñëè íàæàòà ALT íî áåç Shift (÷òî áû ðàáîòàëî ñ ìåíþ - âíà÷àëå íàæèìàòü ïóíêò íå îòïóñêàÿ ìûøó íàæàòü Alt)
GCadForm.InvertAllSelection
else
GCadForm.PCad.SelectAll(ActLayer);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectAllExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÍÀÉÒÈ ÎÁÜÅÊÒ
procedure TFSCS_Main.aFindExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
end;
// ÍÀÉÒÈ ÄÀËÅÅ...
procedure TFSCS_Main.aFindNextExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
end;
// ËÈÑÒ ÂÎ ÂÅÑÜ ÝÊÐÀÍ
procedure TFSCS_Main.aAllScreenExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.FitToWindow;
// if GCadForm.PCad.ZoomScale < 50 then
// GCadForm.SetZoomScale(50);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aAllScreenExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ËÈÑÒ ÍÀ 50%
procedure TFSCS_Main.a50Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(50);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a50Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ËÈÑÒ ÍÀ 75%
procedure TFSCS_Main.a75Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(75);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a75Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ËÈÑÒ ÍÀ 100%
procedure TFSCS_Main.a100Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(100);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a100Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ËÈÑÒ ÍÀ 150%
procedure TFSCS_Main.a150Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(150);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a150Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ËÈÑÒ ÍÀ 200%
procedure TFSCS_Main.a200Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(200);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a200Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.a400Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(400);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a400Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÂÅËÈ×ÈÒÜ ÌÀÑØÒÀÁ ÍÀ...
procedure TFSCS_Main.aIncExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
F_IncOn.ShowModal
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÂÅËÈ×ÈÒÜ ÌÀÑØÒÀÁ
procedure TFSCS_Main.aInc1ptExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.SetZoomScale(GCadForm.PCad.ZoomScale + 5);
if GCadForm.PCad.AutoRefresh then
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aInc1ptExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÌÅÍÜØÈÒÜ ÌÀÑØÒÀÁ
procedure TFSCS_Main.aDec1ptExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if (GCadForm.PCad.ZoomScale - 5) >= 10 then
begin
GCadForm.SetZoomScale(GCadForm.PCad.ZoomScale - 5);
if GCadForm.PCad.AutoRefresh then
RefreshCAD(GCadForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDec1ptExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÔÎÍÀ
procedure TFSCS_Main.aBackgroundColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clGray;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.BackGround;
F_LoadColor.ShowModal;
GCadForm.PCad.BackGround := F_LoadColor.ColorPicker.SelectedColor;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBackgroundColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ËÈÍÅÉÊÓ
procedure TFSCS_Main.aShowRulerExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aShowRuler.Checked then
GCadForm.PCad.RulerVisible := true
else
GCadForm.PCad.RulerVisible := false;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADShowRuler := GCadForm.PCad.RulerVisible;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ÑÅÒÊÓ
procedure TFSCS_Main.aShowGridExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aShowGrid.Checked then
GCadForm.PCad.Grids := true
else
GCadForm.PCad.Grids := false;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADShowGrid := GCadForm.PCad.Grids;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ÏÀÍÅËÜ ÈÍÑÒÐÓÌÅÍÒÎÂ
procedure TFSCS_Main.aViewBtnPanelExecute(Sender: TObject);
begin
if aViewBtnPanel.Checked then
cbMainPanel.Visible := true
else
cbMainPanel.Visible := false;
end;
// ÏÎÊÀÇÛÂÀÒÜ ÍÎÐÌÀÒÈÂÍÓÞ ÁÀÇÓ
procedure TFSCS_Main.aViewNormBaseExecute(Sender: TObject);
var
ParentPanel: TComponent;
begin
if F_NormBase <> nil then
begin
try
if aViewNormBase.Checked then
begin
FSCS_Main.sDiv2.Visible := False;
FSCS_Main.pDock2.Visible := True;
FSCS_Main.sDiv2.Visible := True;
end
else
begin
FSCS_Main.pDock2.Visible := False;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aViewNormBaseExecute', E.Message);
end;
end
else
begin
aViewNormBase.Checked := False;
MessageBox(Application.Handle, cMain_Mes10, cMain_Mes1, MB_OK);
end;
end;
// ÏÎÊÀÇÛÂÀÒÜ ÌÅÍÅÄÆÅÐ ÏÐÎÅÊÒÎÂ
procedure TFSCS_Main.aViewProjectManagerExecute(Sender: TObject);
var
ParentPanel: TComponent;
begin
if F_ProjMan <> nil then
begin
try
if aViewProjectManager.Checked then
begin
FSCS_Main.PDock1.Visible := True;
end
else
begin
FSCS_Main.PDock1.Visible := False;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aViewProjectManagerExecute', E.Message);
end;
end
else
begin
aViewProjectManager.Checked := False;
MessageBox(Application.Handle, cMain_Mes11, cMain_Mes1, MB_OK);
end;
end;
// ÏÎÊÀÇÛÂÀÒÜ ÑÂÎÉÑÒÂÀ CAD-ÎÁÜÅÊÒÎÂ
procedure TFSCS_Main.aViewCADObjectsPropExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aViewCADObjectsProp.Checked then
begin
F_SizePos.Caption := cMain_Mes12;
F_SizePos.Show;
end
else
F_SizePos.Close;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ÑÂÎÉÑÒÂÀ ÑÊÑ-ÎÁÜÅÊÒÎÂ
procedure TFSCS_Main.aViewSCSObjectsPropExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aViewSCSObjectsProp.Checked then
begin
F_SCSObjectsProp.Caption := cMain_Mes12;
F_SCSObjectsProp.Show;
end
else
F_SCSObjectsProp.Close;
end
else
begin
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
aViewSCSObjectsProp.Checked := False;
end;
end;
// ÏÎÊÀÇÀÒÜ ÌÅÍÅÄÆÅÐ ÑËÎÅÂ
procedure TFSCS_Main.aViewLayersExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aViewLayers.Checked then
F_LayersDialog.Show
else
F_LayersDialog.Close;
end
else
begin
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
aViewLayers.Checked := False;
end;
end;
// ÏÎÊÀÇÀÒÜ ÍÀÂÈÃÀÒÎÐ
procedure TFSCS_Main.aViewNavigatorExecute(Sender: TObject);
var
MainRight: integer;
begin
if aViewNavigator.Checked then
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
if F_Navigator = nil then
begin
F_Navigator := TF_Navigator.Create(nil);
GSaveNavigatorFigures := F_Navigator.PCadNavigator.Figures;
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
F_Navigator.PCadNavigator.Figures := GCadForm.PCad.Figures;
MainRight := FSCS_Main.Left + FSCS_Main.Width;
F_Navigator.Top := FSCS_Main.Top + 45;
F_Navigator.Left := MainRight - F_Navigator.Width - 5;
if not F_Navigator.Showing then
F_Navigator.Show;
end;
end
else
aViewNavigator.Checked := False;
end
else
begin
if F_Navigator <> nil then
begin
F_Navigator.PCadNavigator.Figures := GSaveNavigatorFigures;
FreeAndNil(F_Navigator);
end;
end;
end;
// ÑÂÎÉÑÒÂÀ ÎÁÜÅÊÒÀ
procedure TFSCS_Main.aObjPropertiesExecute(Sender: TObject);
var
ClickFigure: TFigure;
SelCount: Integer;
SelCheck: integer;
i: integer;
begin
if ActiveMDIChild <> nil then
begin
try
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
SelCheck := 0;
if Not IsVista then
begin
for i := 0 to 15 do
begin
SelCheck := SelCheck + ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A)))
end;
end;
{$ELSE}
SelCheck := 0;
{$IFEND}
if GCadForm.PCad.SelectedCount > SelCheck then
begin
if GPopupFigure = Nil then
begin
SelCount := GCadForm.PCad.SelectedCount;
GPopupFigure := TFigure(GCadForm.PCad.Selection[SelCount - 1]);
end;
ClickFigure := TFigure(GPopupFigure);
if Assigned(ClickFigure) then
begin
if CheckFigureByClassName(ClickFigure, cTConnectorObject) or
CheckFigureByClassName(ClickFigure, cTOrthoLine) then //09.04.2012
begin
//
FSCS_Main.aViewSCSObjectsProp.Checked := True;
if F_SCSObjectsProp.FormStyle <> fsStayOnTop then
F_SCSObjectsProp.FormStyle := fsStayOnTop;
//
if F_SCSObjectsProp.Showing then
SetForegroundWindow(F_SCSObjectsProp.Handle);
// Âûçâàòü îáðàáîòêó ãðóïïû âûäåëåííûõ îáúåêòîâ
F_SCSObjectsProp.Execute(ClickFigure);
end
else
if CheckFigureByClassName(ClickFigure, TSCSFigureGrp.ClassName) or
CheckFigureByClassName(ClickFigure, TFigureGrp.ClassName) or
CheckFigureByClassName(ClickFigure, TBlock.ClassName) or
CheckFigureByClassName(ClickFigure, TPolyline.ClassName)
// Tolik 18/10/2017 --
or CheckFigureByClassName(ClickFigure, TPie.ClassName) // ñåêòîð
//
then
aBlockParams.Execute
else
ClickFigure.Edit;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aObjPropertiesExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aOneLineChemeExecute(Sender: TObject);
var i: integer;
LineList, PointList, ShieldList, AutoSwitchList, JoinedSwitchCompons, CableList: TSCSComponents;
ShieldCompon, AVR_Compon, SwitchCompon: TSCSComponent;
ShieldLines, Switch_List: TList;
PassedComponList, EndCompons: TSCSComponents;
CableComponent: TSCSComponent;
ShieldFigure: TConnectorObject;
ShieldCatalog: TSCSCatalog;
AllConnectedTrace: TList;
AllConnectedCables: TSCSComponents;
Procedure GetSwitchList(var aList: TSCSComponents; aLookList: TSCSComponents);
var i: Integer;
ChildCompon: TSCSComponent;
begin
for i := 0 to aLookList.Count - 1 do
begin
ChildCompon := aLookList[i];
if ChildCompon.ComponentType.SysName = ctsnAutoSwitch then
if aList.IndexOf(childCompon) = -1 then
aList.Add(ChildCompon);
end;
end;
Procedure CollectConnections(aCompon: TSCSComponent; var aList: TSCSComponents; aCypher: string);
var i, j, k: integer;
ParentCompon, ChildCompon, JoinedCompon: TSCSComponent;
begin
if aList.IndexOf(aCompon) = -1 then
aList.Add(aCompon);
if isCableComponent(aCompon) then
if AllConnectedCables.IndexOf(aCompon) = -1 then
AllConnectedCables.Add(aCompon);
if PassedComponList.IndexOf(aCompon) = -1 then
begin
PassedComponList.Add(aCompon);
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if aCompon.JoinedComponents[i].IsLine = biTrue then // Ïîäêëþ÷åí êàáåëü
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].Cypher = aCypher then
begin
if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then
CollectConnections(aCompon.JoinedComponents[i], aList, aCypher);
end;
end
else
begin // Point Connection
if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then
begin
PassedComponList.Add(aCompon.JoinedComponents[i]);
if aList.IndexOf(aCompon.JoinedComponents[i]) = -1 then // òóò äîïîëíèòåëüíó ïðîâåðêó âîòêíóòü, íà÷èíàÿ ñ ïàðåíòà äîíèçó íà âõîæäåíèå
begin
ParentCompon := aCompon.JoinedComponents[i].GetTopComponent;
if ParentCompon <> nil then
begin
if aList.IndexOf(ParentCompon) = -1 then
aList.Add(ParentCompon);
if ParentCompon.ComponentType.SysName <> ctsnTerminalBox then
if EndCompons.IndexOf(ParentCompon) = -1 then
EndCompons.Add(ParentCompon);
for j := 0 to ParentCompon.JoinedComponents.Count - 1 do
begin
JoinedCompon := ParentCompon.JoinedComponents[j];
if PassedComponList.IndexOf(JoinedCompon) = -1 then
if JoinedCompon.IsLine = biTrue then
if isCableComponent(JoinedCompon) then
if JoinedCompon.Cypher = aCypher then
CollectConnections(JoinedCompon, aList, aCypher);
end;
for j := 0 to ParentCompon.ChildReferences.Count - 1 do
begin
ChildCompon := ParentCompon.ChildReferences[j];
if PassedComponList.IndexOf(ChildCompon) = -1 then
PassedComponList.Add(ChildCompon);
for k := 0 to ChildCompon.JoinedComponents.Count - 1 do
begin
JoinedCompon := ChildCompon.JoinedComponents[k];
if PassedComponList.IndexOf(JoinedCompon) = -1 then
if JoinedCompon.IsLine = biTrue then
if isCableComponent(JoinedCompon) then
if JoinedCompon.Cypher = aCypher then
CollectConnections(JoinedCompon, aList, aCypher);
end;
end;
end;
end;
end;
end;
end;
end;
end;
function GetConnectedToSwitch(aCompon: TSCSComponent): TSCSComponents;
var i: integer;
JoinedCompon: TSCSComponent;
HasNoCableConnection: Boolean;
HasPointConnections: Boolean;
begin
Result := nil;
HasNoCableConnection := true;
HasPointConnections := False;
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].IDNetType = 3 then
HasNoCableConnection := false;
end;
if HasNoCableConnection then
exit;
Result := TSCSComponents.Create(false);
if PassedComponList.IndexOf(aCompon) = -1 then
PassedComponList.Add(aCompon);
AllConnectedCables.Add(aCompon);
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].IDNetType = 3 then
begin
CollectConnections(aCompon.JoinedComponents[i], Result, aCompon.JoinedComponents[i].Cypher);
if CableComponent = nil then
CableComponent := aCompon.JoinedComponents[i];
end;
end;
end;
Procedure RemovePlugSwithes(aList: TSCSComponents);
var i: integer;
begin
for i := aList.Count - 1 downto 0 do
begin
if aList[i].ComponentType.SysName = ctsnPlugSwitch then
aList.delete(i);
end;
end;
begin
ShieldFigure := nil;
if GPopupFigure <> nil then
if GPopupFigure is TConnectorObject then
if TConnectorObject(GPopupFigure).ConnectorType = ct_NB then
ShieldFigure := TConnectorObject(GPopupFigure);
if ShieldFigure = nil then
exit;
ShieldCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ShieldFigure.ID);
if ShieldCatalog = nil then
exit;
PointList := TSCSComponents.Create(false); // òî÷êè
LineList := TSCSComponents.Create(false); // êàáåëü
AllConnectedTrace := nil;
AVR_Compon := nil;
ShieldList := nil;
AutoSwitchList := Nil;
ShieldLines := Nil;
Switch_List := Nil;
CableList := TSCSComponents.Create(False);
for i := 0 to ShieldCatalog.ComponentReferences.Count - 1 do
begin
if ShieldCatalog.ComponentReferences[i].isTop then
PointList.Add(ShieldCatalog.ComponentReferences[i]);
end;
if PointList.Count > 0 then
begin
//ïîñòðîèòü ñïèñîê ùèòîâ
ShieldList := TSCSComponents.Create(false);
for i := 0 to PointList.Count - 1 do
begin
if PointList[i].ComponentType.SysName = ctsnShield then // ùèòîê
if PointList[i].IdNetType = 3 then // ýëåêòðè÷åñêàÿ ñåòü
if ShieldList.IndexOf(PointList[i]) = -1 then
ShieldList.Add(PointList[i]);
break; // òîëüêî îäèí
end;
end;
if ShieldList.Count > 0 then
begin
ShieldCompon := ShieldList[0];
// ïîñòðîèòü ñïèñîê àâòîìàòîâ ùèòêà
if ShieldCompon.ChildReferences.Count > 0 then
begin
AutoSwitchList := TSCSComponents.Create(false);
GetSwitchList(AutoSwitchList, ShieldCompon.ChildReferences);
end;
end
else
begin
CableList.Free;
PointList.Free;
ShieldList.Free;
LineList.Free;
exit; // íå îáíàðóæåíî íè îäíîãî ùèòêà ....
end;
ShieldLines := TList.Create;
AllConnectedTrace := TList.Create;
if AutoSwitchList.Count > 0 then
begin
// ïîñòðîèòü ñïèñêè ïîäêëþ÷åíèé íà êàæäûé àâòîìàò
PassedComponList := TSCSComponents.Create(false);
PassedComponList.Add(ShieldCompon);
for i := AutoSwitchList.Count - 1 downto 0 do
begin
AllConnectedCables := TSCSComponents.Create(false);
SwitchCompon := AutoSwitchList[i];
PassedComponList.Add(SwitchCompon);
EndCompons := TSCSComponents.Create(false);
CableComponent := nil;
JoinedSwitchCompons := GetConnectedToSwitch(SwitchCompon);
//PassedComponList.Clear;
if EndCompons.Count > 0 then
begin
RemovePlugSwithes(EndCompons);
if EndCompons.Count > 0 then
begin
if CableComponent <> nil then
begin
ShieldLines.Insert(0, EndCompons);
////20/06/2022 --
{
CableList.Add(CableComponent);
AllConnectedTrace.Add(AllConnectedCables);
}
CableList.Insert(0, CableComponent);
AllConnectedTrace.Insert(0, AllConnectedCables);
end;
end;
end
else
begin
AutoSwitchList.delete(i);
EndCompons.Free;
AllConnectedCables.Free;
end;
end;
if Switch_List = nil then
Switch_List := TList.Create;
if AutoSwitchList.Count > 0 then
Switch_List.Add(AutoSwitchList);
end
else
begin // íå îáíàðóæåíî àâòîìàòîâ â ùèòêå!!! -- ìîæå ñîîáùåíèå êàêîå âûäàòü òóò.....
end;
if ShieldLines.Count > 0 then //
BuildElectricianChemeList(AVR_Compon, ShieldList, Switch_List, ShieldLines, CableList, AllConnectedTrace)
else
ShowMessage(EL_Mess29);
if PassedComponList <> nil then
PassedComponList.free;
if LineList <> nil then
LineList.Free;
if PointList <> nil then
PointList.Free;
if ShieldList <> nil then
ShieldList.Free;
if AutoSwitchList <> nil then
AutoSwitchList.free;
FreeList(ShieldLines);
CableList.Free;
if AllConnectedTrace <> nil then
begin
for i := 0 to AllConnectedTrace.Count - 1 do
TSCSComponents(AllConnectedTrace[i]).free;
AllConnectedTrace.free;
end;
end;
// ÂÐÀÙÀÒÜ ÂÛÄÅËÅÍÍÛÉ ÎÁÜÅÊÒ
procedure TFSCS_Main.aRotateExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
if GCadForm.PCad.ActiveLayer = 1 then
GCadForm.PCad.SetTool(toOperation, 'TRotate');
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÇÀÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aBackwardsExecute(Sender: TObject);
var
i: integer;
FFigure: TFigure;
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osBack);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBackwardsExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÏÅÐÅÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aForwardExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osFront);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aForwardExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÃÐÓÏÏÈÐÎÂÀÒÜ ÎÁÜÅÊÒÛ
procedure TFSCS_Main.aGroupingExecute(Sender: TObject);
var
i: Integer;
ActLayer: Integer;
FFigure: TFigure;
// Tolik 03/10/2016--
SavedUndoFlag : Boolean;
//
begin
if ActiveMDIChild <> nil then
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GCadForm.PCad.Selection.Count > 1 then
begin
ActLayer := GCadForm.PCad.ActiveLayer;
if (ActLayer = lnSubstrate) {or (ActLayer > 8)} or (ActLayer = lnArch) then
begin
if ActLayer = lnArch then
GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet);
GCadForm.PCad.GroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (ActLayer = 7) then
begin
// Stamp !!!
{//17.11.2011
if GCadForm.FFrameProjectName <> nil then
if GCadForm.FFrameProjectName.Selected then
GCadForm.FFrameProjectName.Deselect;
if GCadForm.FFrameListName <> nil then
if GCadForm.FFrameListName.Selected then
GCadForm.FFrameListName.Deselect;
if GCadForm.FFrameCodeName <> nil then
if GCadForm.FFrameCodeName.Selected then
GCadForm.FFrameCodeName.Deselect;
if GCadForm.FFrameIndexName <> nil then
if GCadForm.FFrameIndexName.Selected then
GCadForm.FFrameIndexName.Deselect;}
for i := 0 to GCadForm.FFrameObjects.Count - 1 do
begin
FFigure := TFigure(GCadForm.FFrameObjects.Objects[i]);
if FFigure <> nil then
if FFigure.Selected then
FFigure.Deselect;
end;
RefreshCAD(GCadForm.PCad);
GCadForm.PCad.GroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (ActLayer = 2) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
SCSGroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end
else
begin
MessageBox(Application.Handle, cMain_Mes13, cMain_Mes1, MB_OK);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aGroupingExecute', E.Message);
end;
// GCadForm.FCanSaveForUndo := SavedUndoFlag;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÇÃÐÓÏÏÈÐÎÂÀÒÜ ÎÁÜÅÊÒÛ
procedure TFSCS_Main.aUngroupingExecute(Sender: TObject);
var
ActLayer: Integer;
// Tolik 03/10/2016--
SavedUndoFlag: Boolean;
//
begin
if ActiveMDIChild <> nil then
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GCadForm.PCad.Selection.Count > 0 then
begin
ActLayer := GCadForm.PCad.ActiveLayer;
if (ActLayer = 1) {or (ActLayer > 8)} or (ActLayer = 8) then
begin
GCadForm.PCad.UnGroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (ActLayer = 7) then
begin
GCadForm.PCad.UnGroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
if (ActLayer = 2) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
SCSUngroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
RefreshCAD(GCadForm.PCad);
end
else
begin
MessageBox(Application.Handle, cMain_Mes13_1, cMain_Mes1, MB_OK);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aUngroupingExecute', E.Message);
end;
// GCadForm.FCanSaveForUndo := SavedUndoFlag;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÇÀÁËÎÊÈÐÎÂÀÒÜ ÎÁÜÅÊÒ
procedure TFSCS_Main.aLockExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
if (GCadForm.PCad.ActiveLayer = 1) then
begin
GCadForm.PCad.LockSelectionToModify(True);
GCadForm.PCad.LockSelectionToMove(True);
GCadForm.PCad.OrderSelection(osBack);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aLockExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÇÁËÎÊÈÐÎÂÀÒÜ ÎÁÜÅÊÒ
procedure TFSCS_Main.aUnlockExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
if GCadForm.PCad.ActiveLayer = 1 then
begin
GCadForm.PCad.LockSelectionToModify(False);
GCadForm.PCad.LockSelectionToMove(False);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aUnlockExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÈÇÌÅÍÈÒÜ ØÐÈÔÒ
procedure TFSCS_Main.aTextFontExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextFontExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÑÒÀÍÎÂÈÒÜ ÌÀÑØÒÀÁ
procedure TFSCS_Main.aScaleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.RulerMode = rmWorld then
F_Scale.ShowModal
else
MessageBox(Application.Handle, cMain_Mes14, cMain_Mes15, MB_OK);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÍÎÂÎÅ ÎÊÍÎ (ËÈÑÒ)
procedure TFSCS_Main.aNewWindowExecute(Sender: TObject);
begin
try
aNewList.Execute;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNewWindowExecute', E.Message);
end;
end;
// ÇÀÊÐÛÒÜ ÂÑÅ ÎÊÍÀ (ÏÐÎÅÊÒ)
procedure TFSCS_Main.aCloseAllWindowsExecute(Sender: TObject);
begin
CloseAll;
end;
// ÑÏÐÀÂÊÀ
procedure TFSCS_Main.aHelpExecute(Sender: TObject);
var
FileName: string;
begin
try
Application.HelpCommand(HELP_FORCEFILE, 0);
// Application.HelpCommand(HELP_FINDER, 0);
{ FileName := ExeDir + '\Docs\HELP_CKC.HLP';
if FileExists(FileName) then
begin
ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0);
end
else
ShowMessage('Ôàéë ñïðàâêè íå íàéäåí!');
}
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aHelpExecute', E.Message);
end;
end;
// ÏÐÅÇÅÍÒÀÖÈß
procedure TFSCS_Main.aPresentationExecute(Sender: TObject);
var
FileName: string;
begin
try
FileName := ExeDir + '\presentation.exe';
if FileExists(FileName) then
begin
ShellExecute(0, PChar('open'), PChar(FileName), 0, 0, SW_MAXIMIZE);
end
else
ShowMessage(cMain_Mes16);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPresentationExecute', E.Message);
end;
end;
// ÈÍÒÅÐÀÊÒÈÂÍÎÅ ÎÁÓ×ÅÍÈÅ
procedure TFSCS_Main.aInteractiveExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
InteractiveTest;
end;
// ÏÎÌÎÙÍÈÊÈ
procedure TFSCS_Main.aWizardsExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
end;
// ÒÅÕ.ÏÎÄÄÅÐÆÊÀ
procedure TFSCS_Main.aTechDocExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
OpenURL(urlSupport);
end;
procedure OpenMail(s: string='');
var
SHI : TShellExecuteInfo;
tmpstr: string;
begin
try
ZeroMemory(@SHI, sizeof(SHI));
SHI.cbSize := sizeof(SHI);
SHI.fMask := SEE_MASK_NOCLOSEPROCESS;
SHI.Wnd := Application.Handle;
SHI.lpVerb := PChar('Open');
if s = '' then
SHI.lpFile := PChar('mailto:' + 'office@expertsoft.com.ua')
else
begin
tmpstr := 'mailto:' + s;
SHI.lpFile := PChar(tmpstr);
end;
SHI.lpParameters := nil;
SHI.lpDirectory := nil;
ShellExecuteEx(@SHI);
except
end;
end;
// ÍÀÏÈÑÀÒÜ ÐÀÇÐÎÁÎÒ×ÈÊÓ
procedure TFSCS_Main.aToAuthorsExecute(Sender: TObject);
begin
{$IF Defined(SCS_PE)}
{$IF Defined(SCS_PANDUIT)}
MessageInfo(cActionNoRealized);
{$ELSE}
OpenMail('office@cableproject.net');
{$IFEND}
{$ELSEIF Defined(SCS_SPA)}
OpenMail('office@telcocad.net');
{$ELSEIF Defined(SCS_RF)}
{$IF Defined(SCS_PANDUIT)}
MessageInfo(cActionNoRealized);
{$ELSE}
OpenMail('info@expertsoft.ru');
{$IFEND}
{$ELSE}
OpenMail('office@expertsoft.com.ua');
{$IFEND}
end;
// ÊÓÏÈÒÜ ÏÐÎÄÓÊÒ
procedure TFSCS_Main.aBuyExecute(Sender: TObject);
begin
// ShowMessage('Äàííàÿ êîìàíäà â ýòîé âåðñèè íå ðåàëèçîâàíà!');
CheckAndShowHint('http://admin.cableproject.net/hints/' + hints_prog_id + '/index.html', hints_prog_id, FSCS_Main, 0, True);
end;
// Î ÏÐÎÃÐÀÌÌÅ...
procedure TFSCS_Main.aAboutExecute(Sender: TObject);
begin
(*
tbCADToolsExpert.AutoSize := false;
tbCADToolsExpert.Realign;
tbCADToolsExpert.Refresh;
tbCADToolsExpert.Repaint;
tbCADToolsExpert.Show;
*)
try
F_About := TF_About.Create(Application);
F_About.ShowModal;
finally
FreeAndNil(F_About);
end;
end;
////////////////////////////////////////////////////
// ÐÀÁÎÒÀ Ñ ÎÊÍÀÌÈ ÏÀÍÅËßÌÈ ////////////////////////
////////////////////////////////////////////////////
// ÏÅÐÅÊËÞ×ÅÍÈÅ ÌÅÆÄÓ ÎÊÍÀÌÈ
procedure TFSCS_Main.SwitchWindow(Sender: TObject);
var
i: integer;
PageIndex: integer;
begin
try
TMenuItem(Sender).Checked := True;
i := TMenuItem(Sender).MenuIndex - 5;
FSCS_Main.pageCADList.ActivePageIndex := i;
PageIndex := pageCADList.ActivePageIndex;
for i := 0 to MDIChildCount - 1 do
begin
if MDIChildren[i].Tag = pageCADList.ActivePage.Tag then
begin
MDIChildren[i].BringToFront;
Exit;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.SwitchWindow', E.Message);
end;
end;
// ÎÁÜÅÊÒ ÍÀÄ ÏÀÍÅËÜÞ
procedure TFSCS_Main.PDock1DockOver(Sender: TObject; Source: TDragDockObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
var
DockForm: TForm;
begin
try
DockForm := nil; //#From Oleg# //14.09.2010
// åñëè áîëüøå îäíîé ôîðìû íà ïàíåëü
if (Sender = PDock1) And (CountDock1 > 0) then
begin
PDock1.DockSite := false;
Exit;
end;
if (Sender = PDock2) And (CountDock2 > 0) then
begin
PDock2.DockSite := false;
Exit;
end;
// åñëè äîêàåòñÿ îäèí èç ôëàéòáàðîâ
if FSCS_Main.tbEditDocking Or FSCS_Main.tbFileDocking Or FSCS_Main.tbFormatDocking Or
FSCS_Main.tbObjectDocking Or FSCS_Main.tbSelectOptionsDocking Or
FSCS_Main.tbCADToolsDocking Or FSCS_Main.tbSCSToolsDocking then
begin
PDock1.DockSite := false;
pDock2.DockSite := false;
Exit;
end;
if F_ProjMan <> nil then
if F_ProjMan.Docking then
DockForm := F_ProjMan;
if F_NormBase <> nil then
if F_NormBase.Docking then
DockForm := F_NormBase;
if TPanel(Sender) = PDock1 then
Source.DockRect := Rect(Source.DockRect.Left, Source.DockRect.Top,
Source.DockRect.Left + DockForm.Width, Source.DockRect.Bottom)
else
if TPanel(Sender) = PDock2 then
Source.DockRect := Rect(Source.DockRect.Right - DockForm.Width, Source.DockRect.Top,
Source.DockRect.Right, Source.DockRect.Bottom);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1DockOver', E.Message);
end;
end;
// ÎÒÂßÇÊÀ ÎÁÜÅÊÒÀ ÎÒ ÏÀÍÅËÈ
procedure TFSCS_Main.PDock1UnDock(Sender: TObject; Client: TControl;
NewTarget: TWinControl; var Allow: Boolean);
begin
try
Allow := False;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1UnDock', E.Message);
end;
end;
// ÎÁÜÅÊÒ Â ÏÀÍÅËÈ
procedure TFSCS_Main.PDock1DockDrop(Sender: TObject;
Source: TDragDockObject; X, Y: Integer);
var
ParentPanel: TComponent;
begin
try
if Sender = PDock1 then
CountDock1 := CountDock1 + 1;
if Sender = PDock2 then
CountDock2 := CountDock2 + 1;
if (Sender = PDock1) And (CountDock1 = 1) then
begin
sDiv1.Visible := True;
TPanel(Sender).Width := Source.DockRect.Right - Source.DockRect.Left;
end;
if (Sender = PDock2) And (CountDock2 = 1) then
begin
sDiv2.Visible := True;
TPanel(Sender).Width := Source.DockRect.Right - Source.DockRect.Left;
end;
if F_NormBase <> nil then
begin
ParentPanel := TForm(F_NormBase).GetParentComponent;
if ParentPanel = nil then
begin
F_NormBase.Panel_Addition.DragKind := dkDock;
F_NormBase.Panel_Tree.DragKind := dkDock;
end
else
begin
F_NormBase.Panel_Addition.DragKind := dkDrag;
F_NormBase.Panel_Tree.DragKind := dkDrag;
end;
end;
if F_ProjMan <> nil then
begin
ParentPanel := TForm(F_ProjMan).GetParentComponent;
if ParentPanel = nil then
begin
F_ProjMan.Panel_Addition.DragKind := dkDock;
F_ProjMan.Panel_Tree.DragKind := dkDock;
end
else
begin
F_ProjMan.Panel_Addition.DragKind := dkDrag;
F_ProjMan.Panel_Tree.DragKind := dkDrag;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.PDock1DockDrop', E.Message);
end;
end;
// ÏÐÈ ÏÅÐÅÊËÞ×ÅÍÈÈ ÌÅÆÄÓ ËÈÑÒÀÌÈ Â PAGECONTROL
procedure TFSCS_Main.pageCADListChange(Sender: TObject);
var
PageIndex: integer;
i: integer;
begin
try
PageIndex := pageCADList.ActivePageIndex;
FSCS_Main.mainWindow[PageIndex + 5].Checked := true;
for i := 0 to MDIChildCount - 1 do
begin
if MDIChildren[i].Tag = pageCADList.ActivePage.Tag then
begin
if MDIChildren[i] is TF_CAD then
SwitchListInCAD(TF_CAD(MDIChildren[i]).FCADListID, '')
else
MDIChildren[i].BringToFront;
Exit;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.pageCADListChange', E.Message);
end;
end;
// ÏÐÎÖÅÄÓÐÀ ÄËß ÇÀÊÐÛÒÈß ÏÐÎÅÊÒÀ
procedure TFSCS_Main.CloseAll;
var
Count: integer;
i, j: integer;
PageIndex: integer;
MenuItem : TMenuItem;
ChildForm: TF_CAD;
//ATable: TSQLMemTable;
// Tolik -- 09/03/2017 --
RefreshFlag: Boolean;
ChildFormName: string;
//
begin
// Tolik 15/08/2019 --
if GExitProgEX then
Application.OnIdle := nil;
//
// Tolik 09/02/2017 -- íà âñÿêèé, ÷òîáû íå îáíîâèëñÿ Êàä ïðè óäàëåíèè
RefreshFlag := GCanRefreshCad;
GCanRefreshCad := False;
//
try
// çàêðûòü ïðåäûäóùèé ïðîåêò
if ActiveMDIChild <> nil then
begin
// çàêðûòü âñå îêíà ïðåäûäóùåãî ïðîåêòà
Count := 0;
GNotNeedCheckRaisesBeforeClose := True;
//
while Count < MDIChildCount do
begin
ChildForm := TF_CAD(MDIChildren[Count]);
// Tolik 02/08/2017 --
GCadForm := ChildForm;
//
ChildFormName := ChildForm.Name;
ChildForm.Close;
try
// Tolik --30/01/2017 --
ChildForm.FCadClose := True;
//
ChildForm.Free;
except
// Tolik 29/09/2016 --
//on E: Exception do addExceptionToLogEx('TFSCS_Main.CloseAll on ChilFormClose ', E.Message);
on E: Exception do
// Tolik - -27/01/2017 -- ïîêà íå ïîéìàëè, ãäå ïàäàåò -- õîòü êîñòûëü....
begin
try
{for i := 0 to ChildForm.ControlCount - 1 do
begin
if TControl(ChildForm.Controls[i]).ClassName = 'TPowerCad' then
begin
ChildForm.RemoveControl(TControl(ChildForm.Controls[i]));
Break; //// BREAK ////;
end;
end;}
for i := 0 to FSCS_Main.ComponentCount - 1 do
begin
if TComponent(FSCS_Main.Components[i]).Name = ChildFormName then
begin
FSCS_Main.RemoveComponent(TComponent(FSCS_Main.Components[i]));
break;
end;
end;
ChildForm.Free;
except
addExceptionToLogEx('TFSCS_Main.CloseAll on ChilFormClose ', E.Message);
end;
end;
//
end;
end;
GNotNeedCheckRaisesBeforeClose := False;
// óäàëèòü PageControl
count := pageCADList.PageCount - 1;
for i := 0 to count do
pageCADList.ActivePage.Free;
// óäàëèòü Ëèñòû â ãëàâíîå ìåíþ
for i := 0 to mainWindow.Count - 1 do
if mainWindow.Items[i].Caption = '-' then
break;
j := 0;
inc(i);
while mainWindow.Count > i do
begin
MenuItem := mainWindow.Items[mainWindow.Count - 1];
mainWindow.Delete(mainWindow.Count - 1);
MenuItem.Free;
end;
GCadForm := nil;
// Tolik 09/03/2017 --
//GCanRefreshCad := RefreshFlag;
//
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.CloseAll', E.Message);
end;
GCanRefreshCad := RefreshFlag;
end;
procedure TFSCS_Main.CopyList_AllExecute(Sender: TObject);
begin
if Assigned(F_ProjMan) then
F_ProjMan.Act_CopyCurrList.Execute;
end;
procedure TFSCS_Main.CopyList_WComponExecute(Sender: TObject);
begin
if Assigned(F_ProjMan) then
F_ProjMan.Act_CopyCurrListWithoutCompons.Execute;
end;
// ÂÑÒÀÂÈÒÜ ÒÅÊÑÒ
procedure TFSCS_Main.aInsertTextExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.CurrentLayer := 1;
GCadForm.PCad.SetTool(toFigure, 'TRichText');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aInstRaspredBoxExecute(Sender: TObject);
var RaspredBox: TSCSComponent;
begin
try
//Application.ProcessMessages;
//FSCS_Main.pmELObjMenu.CloseMenu;
if GPlugSwitch <> nil then
begin
F_PEGetBox.SetNBToForm;
//FSCS_Main.pmELObjMenu.CloseMenu;
if F_PEGetBox.ShowModal = mrOk then
begin
if GCadForm <> nil then
begin
RaspredBox := F_PEGetBox.GetCompon;
if RaspredBox <> nil then
begin
GDropComponent := RaspredBox;
//GFigureSnap := GPlugSwitch;
GCadForm.DoDragDrop(TConnectorObject(GPlugSwitch).ap1.x, TconnectorObject(GPlugSwitch).ap1.y);
end;
end;
end;
end;
finally
GPlugSwitch := nil;
end;
end;
// ÂÑÒÀÂÈÒÜ ÊÀÐÒÈÍÊÓ
procedure TFSCS_Main.aInsertBitmapExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.CurrentLayer := 1;
GCadForm.PCad.SetTool(toFigure, 'TBMPObject');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÄÀËÈÒÜ ÂÛÄÅËÅÍÍÛÉ
procedure TFSCS_Main.aDeleteExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
GCadForm.PCad.RemoveSelection;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÄÀËÈÒÜ ÂÑÅ ÎÁÜÅÊÒÛ
procedure TFSCS_Main.aDeleteAllExecute(Sender: TObject);
var
ActLayer: integer;
begin
if ActiveMDIChild <> nil then
begin
try
ActLayer := GCadForm.PCad.ActiveLayer;
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.SelectAll(ActLayer);
if GCadForm.PCad.SelectedCount > 0 then
begin
GCadForm.PCad.RemoveSelection;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteAllExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÓÁÐÀÒÜ ÂÛÄÅËÅÍÈÅ ÂÑÅÕ ÎÁÜÅÊÒÎÂ
procedure TFSCS_Main.aDeSelectAllExecute(Sender: TObject);
var
ActLayer: integer;
begin
if ActiveMDIChild <> nil then
begin
try
ActLayer := GCadForm.PCad.ActiveLayer;
GCadForm.PCad.DeselectAll(ActLayer);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeSelectAllExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÒÈËÜ ËÈÍÈÈ
procedure TFSCS_Main.aPenStyleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'apsSolid' then
apsSolidExecute(Sender);
if TAction(Sender).Name = 'apsDash' then
apsDashExecute(Sender);
if TAction(Sender).Name = 'apsDashDot' then
apsDashDotExecute(Sender);
if TAction(Sender).Name = 'apsDashDotDot' then
apsDashDotDotExecute(Sender);
if TAction(Sender).Name = 'apsDot' then
apsDotExecute(Sender);
if TAction(Sender).Name = 'apsClear' then
apsClearExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenStyleExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ËÈÍÈÈ
procedure TFSCS_Main.aPenColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clBlack;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.DefaultPenColor;
F_LoadColor.ShowModal;
GCadForm.PCad.DefaultPenColor := F_LoadColor.ColorPicker.SelectedColor;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÇÌÅÐ ËÈÍÈÈ
procedure TFSCS_Main.aPenWidthExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aPenw1' then
aPenw1Execute(sender);
if TAction(Sender).Name = 'aPenw2' then
aPenw2Execute(sender);
if TAction(Sender).Name = 'aPenw3' then
aPenw3Execute(sender);
if TAction(Sender).Name = 'aPenw4' then
aPenw4Execute(sender);
if TAction(Sender).Name = 'aPenw5' then
aPenw5Execute(sender);
if TAction(Sender).Name = 'aPenw6' then
aPenw6Execute(sender);
if TAction(Sender).Name = 'aPenw7' then
aPenw7Execute(sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPenWidthExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÒÈËÜ ÑÒÐÅËÊÈ
procedure TFSCS_Main.aRowStyleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'arsBothLight' then
arsBothLightExecute(Sender);
if TAction(Sender).Name = 'arsBothSolid' then
arsBothSolidExecute(Sender);
if TAction(Sender).Name = 'arsLeftLight' then
arsLeftLightExecute(Sender);
if TAction(Sender).Name = 'arsLeftSolid' then
arsLeftSolidExecute(Sender);
if TAction(Sender).Name = 'arsNone' then
arsNoneExecute(Sender);
if TAction(Sender).Name = 'arsRightLight' then
arsRightLightExecute(Sender);
if TAction(Sender).Name = 'arsRightSolid' then
arsRightSolidExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRowStyleExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÒÈËÜ ÇÀËÈÂÊÈ
procedure TFSCS_Main.aBrushStyleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'absBDiagonal' then
absBDiagonalExecute(Sender);
if TAction(Sender).Name = 'absClear' then
absClearExecute(Sender);
if TAction(Sender).Name = 'absCross' then
absCrossExecute(Sender);
if TAction(Sender).Name = 'absDiagCross' then
absDiagCrossExecute(Sender);
if TAction(Sender).Name = 'absFDiagonal' then
absFDiagonalExecute(Sender);
if TAction(Sender).Name = 'absHorizontal' then
absHorizontalExecute(Sender);
if TAction(Sender).Name = 'absSolid' then
absSolidExecute(Sender);
if TAction(Sender).Name = 'absVertical' then
absVerticalExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBrushStyleExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ØÐÈÔÒ ÒÅÊÑÒÀ
procedure TFSCS_Main.aTextCharsetExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aANSI_CHARSET' then
aANSI_CHARSETExecute(Sender);
if TAction(Sender).Name = 'aDEFAULT_CHARSET' then
aDEFAULT_CHARSETExecute(Sender);
if TAction(Sender).Name = 'aRUSSIAN_CHARSET' then
aRUSSIAN_CHARSETExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextCharsetExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÍÀ×ÅÐÒÀÍÈÅ ÒÅÊÑÒÀ
procedure TFSCS_Main.aFontStyleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aTextBold' then
aTextBoldExecute(Sender);
if TAction(Sender).Name = 'aTextItalic' then
aTextItalicExecute(Sender);
if TAction(Sender).Name = 'aTextUnderLine' then
aTextUnderLineExecute(Sender);
if TAction(Sender).Name = 'aTextStrikeThrough' then
aTextStrikeThroughExecute(Sender);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aFontStyleExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÑÏÎËÎÆÅÍÈÅ ÎÁÜÅÊÒÎÂ
procedure TFSCS_Main.aFormatOrderExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
//if GCadForm.PCad.Selection.Count = 1 then
if GCadForm.PCad.Selection.Count >= 1 then
begin
try
if TAction(Sender).Name = 'aSendtoBack' then
aSendtoBackExecute(Sender);
if TAction(Sender).Name = 'aBringtoFront' then
aBringtoFrontExecute(Sender);
if TAction(Sender).Name = 'aSendBackwards' then
aSendBackwardsExecute(Sender);
if TAction(Sender).Name = 'aBringForwards' then
aBringForwardsExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aFormatOrderExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÒÈÏ ÑÅÒÊÈ
procedure TFSCS_Main.aGridTypeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aLineGrid' then
aLineGridExecute(Sender);
if TAction(Sender).Name = 'aPointGrid' then
aPointGridExecute(Sender);
if TAction(Sender).Name = 'aCrossGrid' then
aCrossGridExecute(Sender);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aGridTypeExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ÖÅÍÒÐÀËÜÍÛÅ ÍÀÏÐÂËßÞÙÈÅ
procedure TFSCS_Main.aShowCenterGuidesExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aShowCenterGuides.Checked then
GCadForm.PCad.CenterGuide := true
else
GCadForm.PCad.CenterGuide := false;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÎÊÀÇÛÂÀÒÜ ÍÀÏÐÀÂËßÞÙÈÅ
procedure TFSCS_Main.aShowGuideLinesExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aShowGuideLines.Checked then
GCadForm.PCad.GuidesVisible := true
else
GCadForm.PCad.GuidesVisible := false;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADShowGuides := GCadForm.PCad.GuidesVisible;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
GCadForm.PCad.Refresh;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÐÈÂßÇÊÀ Ê ÑÅÒÊÅ
procedure TFSCS_Main.aSnaptoGridExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aSnaptoGrid.Checked then
GCadForm.PCad.SnapToGrids := true
else
GCadForm.PCad.SnapToGrids := false;
GCadForm.LastSnapGridStatus := GCadForm.PCad.SnapToGrids;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADSnapGrid := GCadForm.PCad.SnapToGrids;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÐÈÂßÇÊÀ Ê ÍÀÏÐÀÂËßÞÙÈÌ
procedure TFSCS_Main.aSnaptoGuidesExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aSnaptoGuides.Checked then
GCadForm.PCad.SnapToGuides := true
else
GCadForm.PCad.SnapToGuides := false;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADSnapGuides := GCadForm.PCad.SnapToGuides;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÐÈÂßÇÊÀ Ê ÁËÈÆÍÅÌÓ ÎÁÜÅÊÒÓ
procedure TFSCS_Main.aSnaptoNearObjectExecute(Sender: TObject);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
if aSnaptoNearObject.Checked then
GCadForm.PCad.SnapToNearPoint := true
else
GCadForm.PCad.SnapToNearPoint := false;
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADSnapNearObject := GCadForm.PCad.SnapToNearPoint;
SaveCADListParams(GCadForm.FCADListID, CurListParams);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÑÅÒÊÈ
procedure TFSCS_Main.aGridColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clSilver;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.GridColor;
F_LoadColor.ShowModal;
GCadForm.PCad.GridColor := F_LoadColor.ColorPicker.SelectedColor;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aGridColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÍÀÏÐÀÂËßÞÙÈÕ
procedure TFSCS_Main.aGuideColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clGreen;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.GuideColor;
F_LoadColor.ShowModal;
GCadForm.PCad.GuideColor := F_LoadColor.ColorPicker.SelectedColor;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aGuideColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÑÒÐÀÍÈÖÛ
procedure TFSCS_Main.aPageColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clWhite;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.PageColor;
F_LoadColor.ShowModal;
GCadForm.PCad.PageColor := F_LoadColor.ColorPicker.SelectedColor;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÍÀÏÐÀÂËßÞÙÈÅ ÏÎÄ ÓÃËÎÌ
procedure TFSCS_Main.aAngularGuidesExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aAngularNone' then
aAngularNoneExecute(Sender);
if TAction(Sender).Name = 'aAngular90' then
aAngular90Execute(Sender);
if TAction(Sender).Name = 'aAngular30' then
aAngular30Execute(Sender);
if TAction(Sender).Name = 'aAngular45' then
aAngular45Execute(Sender);
if TAction(Sender).Name = 'aAngular60' then
aAngular60Execute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aAngularGuidesExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÑÈÑÒÅÌÀ ËÈÍÅÉÊÈ
procedure TFSCS_Main.aRulerSystemExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if TAction(Sender).Name = 'aMetric' then
aMetricExecute(Sender);
if TAction(Sender).Name = 'aWitworth' then
aWitworthExecute(Sender);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÅÆÈÌ ËÈÍÅÉÊÈ
procedure TFSCS_Main.aRulerModeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if TAction(Sender).Name = 'aPageMode' then
aPageModeExecute(Sender);
if TAction(Sender).Name = 'aWorldMode' then
aWorldModeExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÇÌÅÐ ÑÒÐÀÍÈÖÛ
procedure TFSCS_Main.aPageLayoutExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aA0' then
aA0Execute(Sender);
if TAction(Sender).Name = 'aA1' then
aA1Execute(Sender);
if TAction(Sender).Name = 'aA2' then
aA2Execute(Sender);
if TAction(Sender).Name = 'aA3' then
aA3Execute(Sender);
if TAction(Sender).Name = 'aA4' then
aA4Execute(Sender);
if TAction(Sender).Name = 'aA5' then
aA5Execute(Sender);
if TAction(Sender).Name = 'aA6' then
aA6Execute(Sender);
if TAction(Sender).Name = 'aB4' then
aB4Execute(Sender);
if TAction(Sender).Name = 'aB5' then
aB5Execute(Sender);
if TAction(Sender).Name = 'aLetter' then
aLetterExecute(Sender);
if TAction(Sender).Name = 'aTabloid' then
aTabloidExecute(Sender);
if TAction(Sender).Name = 'aCustom' then
aCustomExecute(Sender);
// îáíîâèòü ñêðîëëû
GCadForm.ChangeScrollsOnChangeListSize;
// îáíîâèòü íàâèãàòîð
if F_Navigator <> nil then
begin
RefreshCAD(F_Navigator.PCadNavigator);
ReAssignNavigatorParams;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageLayoutExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÐÈÅÍÒÀÖÈß ÑÒÐÀÍÈÖÛ
procedure TFSCS_Main.aPageOrientationExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if TAction(Sender).Name = 'aLandscape' then
aLandscaleExecute(Sender);
if TAction(Sender).Name = 'aPortrait' then
aPortraitExecute(Sender);
// îáíîâèòü ñêðîëëû
GCadForm.ChangeScrollsOnChangeListSize;
// îáíîâèòü íàâèãàòîð
if F_Navigator <> nil then
begin
RefreshCAD(F_Navigator.PCadNavigator);
ReAssignNavigatorParams;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPageOrientationExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ØÀÃ ÑÅÒÊÈ
procedure TFSCS_Main.aGridStepExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
F_GridStep.ShowModal;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÇÀÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aSendtoBackExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osBward{osBack});
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSendtoBackExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÏÅÐÅÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aBringtoFrontExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osFWard{osFront});
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBringtoFrontExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÇÀÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aSendBackwardsExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osBack{osBward});
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSendBackwardsExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÎÁÜÅÊÒ ÍÀ ÏÅÐÅÄÍÈÉ ÏËÀÍ
procedure TFSCS_Main.aBringForwardsExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.PCad.OrderSelection(osFront{osFWard});
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBringForwardsExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ ÂÅÐÕÍÅÌÓ ÊÐÀÞ
procedure TFSCS_Main.aalTopExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
// Tolik -- 07/02/2017 --
//if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then
//
begin
GCadForm.PCad.AlignSelection(haTop, vaNoChange);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÍÈÂÀÍÈÅ ÏÎ ÍÈÆÍÅÌÓ ÊÐÀÞ
procedure TFSCS_Main.aalBottomExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
// Tolik -- 07/02/2017 --
//if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then
//
begin
GCadForm.PCad.AlignSelection(haBottom, vaNoChange);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ X
procedure TFSCS_Main.aalXcenterExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
begin
GCadForm.PCad.AlignSelection(haCenter, vaNoChange);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ ËÅÂÎÌÓ ÊÐÀÞ
procedure TFSCS_Main.aalLeftExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
// Tolik -- 06/02/2017 --
//if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then
begin
GCadForm.PCad.AlignSelection(haNoChange, vaLeft);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ ÏÐÀÂÎÌÓ ÊÐÀÞ
procedure TFSCS_Main.aalRightExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
// Tolik -- 07/02/2017 --
//if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2)or(GCadForm.PCad.ActiveLayer = 8) then
begin
GCadForm.PCad.AlignSelection(haNoChange, vaRight);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÂÍÈÂÀÍÈÅ ÏÎ Y
procedure TFSCS_Main.aalYCenterExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if (GCadForm.PCad.ActiveLayer = 1)or(GCadForm.PCad.ActiveLayer = 2) then
begin
GCadForm.PCad.AlignSelection(haNoChange, vaCenter);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÛÐÀÍÈÂÀÍÈÅ ÎÁÜÅÊÒÀ ÏÎ ...
procedure TFSCS_Main.aFormatAlignExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.Selection.Count > 1 then
begin
try
if TAction(Sender).Name = 'aalTop' then
aalTopExecute(Sender);
if TAction(Sender).Name = 'aalBottom' then
aalBottomExecute(Sender);
if TAction(Sender).Name = 'aalXcenter' then
aalXcenterExecute(Sender);
if TAction(Sender).Name = 'aalLeft' then
aalLeftExecute(Sender);
if TAction(Sender).Name = 'aalRight' then
aalRightExecute(Sender);
if TAction(Sender).Name = 'aalYCenter' then
aalYCenterExecute(Sender);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aFormatAlignExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//---------------------------------------------------
// ÒÈÏÛ ÑÒÈËß ËÈÍÈÈ
procedure TFSCS_Main.apsClearExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psClear;
apsClear.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(5, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.apsDashExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psDash;
apsDash.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(1, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.apsDashDotExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psDashDot;
apsDashDot.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(3, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.apsDashDotDotExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psDashDotDot;
apsDashDotDot.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(4, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.apsDotExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psDot;
apsDot.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(2, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.apsSolidExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenStyle := psSolid;
apsSolid.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(0, ImageLoad);
mPenStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//--------------------------------------------------
// ÒÈÏÛ ÐÀÇÌÅÐÀ ËÈÍÈÈ
procedure TFSCS_Main.aPenw1Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 1;
aPenw1.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(6, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw2Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 2;
aPenw2.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(7, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw3Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 3;
aPenw3.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(8, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw4Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 4;
aPenw4.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(9, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw5Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 5;
aPenw5.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(10, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw6Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 6;
aPenw6.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(11, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPenw7Execute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultPenWidth := 7;
aPenw7.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(12, ImageLoad);
mPenw.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//--------------------------------------------------------
// ÒÈÏÛ ÑÒÈËß ÑÒÐÅËÊÈ
procedure TFSCS_Main.arsBothLightExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsBothLight;
arsBothLight.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(14, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsBothSolidExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsBothSolid;
arsBothSolid.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(15, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsLeftLightExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsLeftLight;
arsLeftLight.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(16, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsLeftSolidExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsLeftSolid;
arsLeftSolid.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(17, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsNoneExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsNone;
arsNone.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(18, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsRightLightExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsRightLight;
arsRightLight.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(19, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.arsRightSolidExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultRowStyle := rsRightSolid;
arsRightSolid.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(20, ImageLoad);
mRowstyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//-------------------------------------------------------
// ÒÈÏÛ ÑÒÈËß ÇÀËÈÂÊÈ
procedure TFSCS_Main.absBDiagonalExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsBDiagonal;
absBDiagonal.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(26, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absClearExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsClear;
absClear.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(22, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absCrossExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsCross;
absCross.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(27, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absDiagCrossExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsDiagCross;
absDiagCross.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(28, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absFDiagonalExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsFDiagonal;
absFDiagonal.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(25, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absHorizontalExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsHorizontal;
absHorizontal.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(23, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absSolidExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsSolid;
absSolid.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(21, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.absVerticalExecute(Sender: TObject);
var
ImageLoad: TBitmap;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.DefaultBrushStyle := bsVertical;
absVertical.Checked := true;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(24, ImageLoad);
mBrushStyle.Bitmap := ImageLoad;
FreeAndNil(ImageLoad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//-----------------------------------------------------
// ÒÈÏÛ ÍÀ×ÅÐÒÀÍÈß ÒÅÊÑÒÀ
procedure TFSCS_Main.aTextBoldExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aTextBold.Checked then
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsBold]
else
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsBold];
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aTextItalicExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aTextItalic.Checked then
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsItalic]
else
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsItalic];
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aTextUnderLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aTextUnderLine.Checked then
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsUnderLine]
else
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsUnderLine];
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aTextStrikeThroughExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
if aTextStrikeThrough.Checked then
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style + [fsStrikeOut]
else
GCadForm.PCad.Font.Style := GCadForm.PCad.Font.Style - [fsStrikeOut];
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//---------------------------------------------------------
// ÒÈÏÛ ØÐÈÔÒÎÂ ÒÅÊÑÒÀ
procedure TFSCS_Main.aANSI_CHARSETExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.Font.Charset := ANSI_CHARSET;
aANSI_CHARSET.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aDEFAULT_CHARSETExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.Font.Charset := DEFAULT_CHARSET;
aDEFAULT_CHARSET.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aRUSSIAN_CHARSETExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.Font.Charset := RUSSIAN_CHARSET;
aRUSSIAN_CHARSET.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÇÀËÈÂÊÈ
procedure TFSCS_Main.aBrushColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clBlack;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.DefaultBrushColor;
F_LoadColor.ShowModal;
GCadForm.PCad.DefaultBrushColor := F_LoadColor.ColorPicker.SelectedColor;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBrushColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÖÂÅÒ ÒÅÊÑÒÀ
//Tolik 01/11/2021 -- ñòàðàÿ çàêîììåí÷åíà - ñì. íèæå
procedure TFSCS_Main.aTextColorExecute(Sender: TObject);
var i: Integer;
TextList: TList;
begin
if ActiveMDIChild <> nil then
begin
try
TextList := TList.Create;
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
begin
if TFigure(GCadForm.PCad.Selection[i]).ClassName = 'TText' then
TextList.Add(TFigure(GCadForm.PCad.Selection[i]));
end;
F_LoadColor.ColorPicker.DefaultColor := clBlack;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.Font.Color;
F_LoadColor.ShowModal;
if TextList.Count > 0 then
begin
for i := 0 to TextList.Count - 1 do
begin
//TText(TextList[i]).Font.Color := F_LoadColor.ColorPicker.SelectedColor;
TText(TextList[i]).Color := F_LoadColor.ColorPicker.SelectedColor;
end;
GCadForm.PCad.Refresh;
end
else
GCadForm.PCad.Font.Color := F_LoadColor.ColorPicker.SelectedColor;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
TextList.free;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
{
procedure TFSCS_Main.aTextColorExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
F_LoadColor.ColorPicker.DefaultColor := clBlack;
F_LoadColor.ColorPicker.SelectedColor := GCadForm.PCad.Font.Color;
F_LoadColor.ShowModal;
GCadForm.PCad.Font.Color := F_LoadColor.ColorPicker.SelectedColor;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aTextColorExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
}
//-----------------------------------------------------
// ÒÈÏÛ ÒÈÏÎÂ ÑÅÒÊÈ
procedure TFSCS_Main.aLineGridExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GridType := grtLine;
aLineGrid.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPointGridExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GridType := grtPoint;
aPointGrid.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aCrossGridExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GridType := grtCross;
aCrossGrid.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//--------------------------------------------------------
// ÒÈÏÛ ÍÀÏÐÀÂËßÞÙÈÕ ÏÎÄ ÓÃËÎÌ
procedure TFSCS_Main.aAngularNoneExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GuideTrace := gtNone;
aAngularNone.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aAngular90Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GuideTrace := gtNinty;
aAngular90.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aAngular30Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GuideTrace := gtThirty;
aAngular30.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aAngular60Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GuideTrace := gtSixty;
aAngular60.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aAngular45Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.GuideTrace := gtFortyFive;
aAngular45.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//---------------------------------------------------
// ÒÈÏÛ ÑÈÑÒÅÌÛ ËÈÍÅÉÊÈ
procedure TFSCS_Main.aMetricExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.RulerSystem := rsMetric;
aMetric.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aWitworthExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.RulerSystem := rsWhitworth;
aWitworth.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//----------------------------------------------------
// ÒÈÏÛ ÐÅÆÈÌÀ ËÈÍÅÉÊÈ
procedure TFSCS_Main.aPageModeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.RulerMode := rmPage;
aPageMode.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aWorldModeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.RulerMode := rmWorld;
aWorldMode.Checked := true;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//------------------------------------------------------
// ÒÈÏÛ ÎÐÈÅÍÒÀÖÈÈ ÑÒÐÀÍÈÖÛ
procedure TFSCS_Main.aLandscaleExecute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
try
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
GCadForm.PCad.PageOrient := poLandscape;
aLandscape.Checked := true;
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
// âûñòàâèòü ðàìêó
if GCadForm.PCad.PageLayout = plA0 then
LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA1 then
LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA2 then
LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA3 then
LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA4 then
LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout <> plCustom then
LoadFrameToList(GCadForm, '');
}
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aLandscaleExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aPortraitExecute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
try
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
GCadForm.PCad.PageOrient := poPortrait;
aPortrait.Checked := true;
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
// âûñòàâèòü ðàìêó
if GCadForm.PCad.PageLayout = plA0 then
LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA1 then
LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA2 then
LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA3 then
LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageLayout = plA4 then
LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch')
else
if GCadForm.pcad.PageLayout <> plCustom then
LoadFrameToList(GCadForm, '');
}
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPortraitExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//-----------------------------------------------
// ÒÈÏÛ ÐÀÇÌÅÐÀ ÑÒÐÀÍÈÖÛ
procedure TFSCS_Main.aA0Execute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
GCadForm.PCad.PageLayout := plA0;
if GCadForm.PCad.PageOrient = poLandscape then
LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageOrient = poPortrait then
LoadFrameToList(GCadForm, FullPathName + 'A0_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch');
aA0.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA1Execute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
GCadForm.PCad.PageLayout := plA1;
if GCadForm.PCad.PageOrient = poLandscape then
LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageOrient = poPortrait then
LoadFrameToList(GCadForm, FullPathName + 'A1_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch');
aA1.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA2Execute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
GCadForm.PCad.PageLayout := plA2;
if GCadForm.PCad.PageOrient = poLandscape then
LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageOrient = poPortrait then
LoadFrameToList(GCadForm, FullPathName + 'A2_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch');
aA2.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA3Execute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
GCadForm.PCad.PageLayout := plA3;
if GCadForm.PCad.PageOrient = poLandscape then
LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageOrient = poPortrait then
LoadFrameToList(GCadForm, FullPathName + 'A3_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch');
aA3.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA4Execute(Sender: TObject);
var
StampTypeStr: string;
StampLangStr: string;
FullPathName: string;
begin
if ActiveMDIChild <> nil then
begin
{
FullPathName := ExtractFileDir(Application.ExeName) + '\Stamp\';
//
if GCadForm.FCadStampType = stt_simple then
StampTypeStr := 'Small';
if GCadForm.FCadStampType = stt_extended then
StampTypeStr := 'Big';
if GCadForm.FCadStampType = stt_detailed then
StampTypeStr := 'ExtBig';
//
if GCadForm.FCadStampLang = stl_ukr then
StampLangStr := 'ukr';
if GCadForm.FCadStampLang = stl_rus then
StampLangStr := 'rus';
//
GCadForm.PCad.PageLayout := plA4;
if GCadForm.PCad.PageOrient = poLandscape then
LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Landscape_' + StampLangStr + '.sch')
else
if GCadForm.PCad.PageOrient = poPortrait then
LoadFrameToList(GCadForm, FullPathName + 'A4_' + StampTypeStr + '_Portrait_' + StampLangStr + '.sch');
aA4.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA5Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plA5;
LoadFrameToList(GCadForm, '');
aa5.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aA6Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plA6;
LoadFrameToList(GCadForm, '');
aa6.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aB4Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plB4;
LoadFrameToList(GCadForm, '');
ab4.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aB5Execute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plB5;
LoadFrameToList(GCadForm, '');
ab5.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aLetterExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plLetter;
LoadFrameToList(GCadForm, '');
aLetter.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aTabloidExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plTabloid;
LoadFrameToList(GCadForm, '');
aTabloid.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aCustomExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
{
GCadForm.PCad.PageLayout := plCustom;
LoadFrameToList(GCadForm, '');
aCustom.Checked := true;
}
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÄÓÁËÈÊÀÒ ÂÛÄÅËÅÍÍÎÃÎ ÎÁÜÅÊÒÀ
procedure TFSCS_Main.aDuplicateSelectionExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
GCadForm.PCad.SetTool(toOperation, 'TMirror');
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDuplicateSelectionExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÂÐÀÙÅÍÈÅ ÂÛÄÅËÅÍÍÎÃÎ ÎÁÜÅÊÒÀ
procedure TFSCS_Main.aRotateSelectionExecute(Sender: TObject);
var
Point: TDoublePoint;
i: integer;
SelFigure: TFigure;
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
try
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
SelFigure := TFigure(GCadForm.PCad.Selection[i]);
Point := TFigure(SelFigure).CenterPoint;
GCadForm.PCad.RotateSelection(100, DoublePoint(Point.X, Point.Y));
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateSelectionExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÏÅÐÅÌÅÙÅÍÈÅ ÂÛÄÅËÅÍÍÎÃÎ ÎÁÜÅÊÒÀ
procedure TFSCS_Main.aMoveSelectionExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
GCadForm.PCad.SetTool(toOperation, 'TMove');
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMoveSelectionExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÇÅÐÊÀËÜÍÎÅ ÎÒÎÁÐÀÆÅÍÈÅ ÂÛÄÅËÅÍÍÎÃÎ ÎÁÜÅÊÒÀ
procedure TFSCS_Main.aMirrorSelectionExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
GCadForm.PCad.SetTool(toOperation, 'TMirror');
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorSelectionExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ------- ÑÏÈÑÎÊ ÈÍÑÒÐÓÌÅÍÒÎÂ CAD----------------------
// SELECT
procedure TFSCS_Main.aToolSelectExecute(Sender: TObject);
var
SCSList: TSCSList;
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
if GCadForm <> nil then
begin
SCSList := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID);
if SCSList <> nil then
SCSList.FNewComponNameMark := '';
end;
//GNewComponNameMark := '';
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
try
if GCadForm.PCad.TraceFigure <> nil then
begin
if GCadForm.PCad.TraceFigure is TOrthoLine then // åñëè íå ïðîâåðÿòü è äåëàòü EndTrace äëÿ âñåõ àáñîëþòíî - áóäåò õðåíü íà àâòîñîçäàíèè ̪ ïîñëå êîïèðîâàíèÿ ëèñòà
begin
// Tolik --18/11/2015
// GCadForm.PCad.EndTrace([ssRight]); -- EndTrace ñäåëàåì òîëüêî åñëè ìû ÷òî-òî ðèñîâàëè,
// à åñëè íå ðèñîâàëè èëè ïîñòàâèëè òîëüêî îäèí êîíåö òðàññû è âûøëè çà ãðàíèöû ÊÀÄà - ïðîñòî
// øëåïíåì TraceFigure
if (GCadForm.PCad.ToolInfo = 'TOrthoLine') and (GCadForm.PCad.TraceFigure <> nil) and (GClickIndex > 1) then
begin
if GCadForm.FAutoCadMouse then // Tolik -- åñëè â íàñòðîéêàõ ëèñòà - Àâòîêàäîâñêàÿ ìûøêà
Inc(GClickIndex); // èíà÷å ïîèìååì åùå îäèí áàã (à òàê è áûëî!!!) - ïîòåðþ ïîñëåäíåé îáîçíà÷åííîé òðàññû !!!
// ïðè âûõîäå êóðñîðà çà ãðàíèöû ÊÀÄà
GCadForm.PCad.EndTrace([ssRight]);
end
else
GCadForm.PCad.KillTraceFig; // ø-ë-å-ï!
end;
end;
//
except
end;
GCadForm.PCad.SetTool(toSelect, 'TSelected');
tbCreateOnClickModeExpert.Down := False;
tbCreateOnClickModeNoob.Down := False;
tbSelectExpert.Down := True;
tbSelectNoob.Down := True;
GCurrShadowTraceX := -1;
GCurrShadowTraceY := -1;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// LINE
procedure TFSCS_Main.aToolLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// RECTANGLE
procedure TFSCS_Main.aToolRectangleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TRectangle');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ELLIPSE
procedure TFSCS_Main.aToolEllipseExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TEllipse');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// CIRCLE
procedure TFSCS_Main.aToolCircleExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TCircle');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ARC
procedure TFSCS_Main.aToolArcExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TArc');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ELIPTIC ARC
procedure TFSCS_Main.aToolElipticArcExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TElpArc');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// POLYLINE
procedure TFSCS_Main.aToolPolyLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TPolyLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// POINT (VERTEX)
procedure TFSCS_Main.aToolPointExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TVertex');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// TEXT
procedure TFSCS_Main.aToolTextExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TText');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// RICHTEXT
procedure TFSCS_Main.aToolRichTextExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TRichText');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// KNIFE
procedure TFSCS_Main.aToolKnifeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TKnife');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// HDIMLINE
procedure TFSCS_Main.aToolHDimLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'THDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// VDIMLINE
procedure TFSCS_Main.aToolVDimLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayerExecute(Sender);
GCadForm.PCad.SetTool(toFigure, 'TVDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÐÀÇÌÅÐ ÒÅÊÑÒÀ
procedure TFSCS_Main.aTextSizeExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// ÈÇÌÅÍÅÈÅ ØÐÈÔÒÀ
procedure TFSCS_Main.fcbTextFontChange(Sender: TObject);
begin
aTextFontExecute(Sender);
end;
// ÈÇÌÅÍÅÍÈÅ ÐÀÇÌÅÐÀ ØÐÈÔÒÀ
procedure TFSCS_Main.fcbTextSizeChange(Sender: TObject);
begin
aTextSizeExecute(Sender);
end;
// ÏÎÏÛÒÊÀ ÄÎÊÀ Ê ÏÀÍÅËÈ ÈÍÑÒÐÓÌÅÍÒÎÂ
procedure TFSCS_Main.cbMainPanelBandPaint(Sender: TObject; Control: TControl;
Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions);
begin
Options := [];
end;
procedure TFSCS_Main.cbMainPanelDockOver(Sender: TObject;
Source: TDragDockObject; X, Y: Integer; State: TDragState;
var Accept: Boolean);
begin
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
if (F_NormBase.Docking or F_ProjMan.Docking) then
cbMainPanel.DockSite := false;
end;
end;
procedure TFSCS_Main.cbMainPanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
end;
// --------------------------------------------------
// ÏÎÏÛÒÊÀ ÄÎÊÀ ÔËÀÉÒÁÀÐÎÂ Ê ÏÀÍÅËÈ ÈÍÑÒÐÓÌÅÍÒÎÂ
procedure TFSCS_Main.tbEditStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbEditDocking := true;
end;
procedure TFSCS_Main.tbEditEndDock(Sender, Target: TObject; X, Y: Integer);
begin
tbEditDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbFileStartDock(Sender: TObject;
var DragObject: TDragObject);
begin
tbFileDocking := true;
end;
procedure TFSCS_Main.tbFileEndDock(Sender, Target: TObject; X, Y: Integer);
begin
tbFileDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbFormatStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbFormatDocking := true;
end;
procedure TFSCS_Main.tbFormatEndDock(Sender, Target: TObject; X,
Y: Integer);
begin
tbFormatDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbObjectStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbObjectDocking := true;
end;
procedure TFSCS_Main.tbObjectEndDock(Sender, Target: TObject; X,
Y: Integer);
begin
tbObjectDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbSelectOptionsStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbSelectOptionsDocking := true;
end;
procedure TFSCS_Main.tbSelectOptionsEndDock(Sender, Target: TObject; X,
Y: Integer);
begin
tbSelectOptionsDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbCADToolsExpertStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbCADToolsDocking := true;
end;
procedure TFSCS_Main.tbCADToolsExpertEndDock(Sender, Target: TObject; X,
Y: Integer);
begin
tbCADToolsDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.tbCADToolsExpertMouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;
// ÇÀÃÐÓÇÊÀ ÐÈÑÓÍÊÎÂ Â ÑÒÈËÜ ËÈÍÈÈ
procedure TFSCS_Main.mpsDashAdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
ImageLoad: TBitmap;
DestRect: Trect;
ImIndex: integer;
begin
try
ImIndex := 0; //#From Oleg# //14.09.2010
// ïðîâåðêà íà çàãðóçêó ðèñóíêîâ
if (TMainMenu(Sender).Name = 'mpsSolid') or (TPopupMenu(Sender).Name = 'ppsSolid') then
ImIndex := 0;
if (TMainMenu(Sender).Name = 'mpsDash') or (TPopupMenu(Sender).Name = 'ppsDash') then
ImIndex := 1;
if (TMainMenu(Sender).Name = 'mpsDot') or (TPopupMenu(Sender).Name = 'ppsDot') then
ImIndex := 2;
if (TMainMenu(Sender).Name = 'mpsDashDot') or (TPopupMenu(Sender).Name = 'ppsDashDot') then
ImIndex := 3;
if (TMainMenu(Sender).Name = 'mpsDashDotDot') or (TPopupMenu(Sender).Name = 'ppsDashDotDot') then
ImIndex := 4;
if (TMainMenu(Sender).Name = 'mpsClear') or (TPopupMenu(Sender).Name = 'ppsClear') then
ImIndex := 5;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(ImIndex, ImageLoad);
DestRect := ARect;
DestRect.Top := DestRect.Top + 2;
DestRect.Left := DestRect.Left + 30;
DestRect.Bottom := DestRect.Top + 16;
DestRect.Right := DestRect.Left + 32;
ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16));
ACanvas.Refresh;
FreeAndNil(ImageLoad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.mpsClearAdvancedDrawItem', E.Message);
end;
end;
// ÇÀÃÐÓÇÊÀ ÐÈÑÓÍÊÎÂ Â ÐÀÇÌÅÐ ËÈÍÈÈ
procedure TFSCS_Main.mPenw1AdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
ImageLoad: TBitmap;
DestRect: Trect;
ImIndex: integer;
begin
try
ImIndex := 0; //#From Oleg# //14.09.2010
// ïðîâåðêà íà çàãðóçêó ðèñóíêîâ
if (TMainMenu(Sender).Name = 'mPenw1') or (TPopupMenu(Sender).Name = 'pPenw1') then
ImIndex := 6;
if (TMainMenu(Sender).Name = 'mPenw2') or (TPopupMenu(Sender).Name = 'pPenw2') then
ImIndex := 7;
if (TMainMenu(Sender).Name = 'mPenw3') or (TPopupMenu(Sender).Name = 'pPenw3') then
ImIndex := 8;
if (TMainMenu(Sender).Name = 'mPenw4') or (TPopupMenu(Sender).Name = 'pPenw4') then
ImIndex := 9;
if (TMainMenu(Sender).Name = 'mPenw5') or (TPopupMenu(Sender).Name = 'pPenw5') then
ImIndex := 10;
if (TMainMenu(Sender).Name = 'mPenw6') or (TPopupMenu(Sender).Name = 'pPenw6') then
ImIndex := 11;
if (TMainMenu(Sender).Name = 'mPenw7') or (TPopupMenu(Sender).Name = 'pPenw7') then
ImIndex := 12;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(ImIndex, ImageLoad);
DestRect := ARect;
DestRect.Top := DestRect.Top + 2;
DestRect.Left := DestRect.Left + 30;
DestRect.Bottom := DestRect.Top + 16;
DestRect.Right := DestRect.Left + 32;
ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16));
ACanvas.Refresh;
FreeAndNil(ImageLoad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.mPenw1AdvancedDrawItem', E.Message);
end;
end;
// ÇÀÃÐÓÇÊÀ ÐÈÑÓÍÊÎÂ Â ÑÒÈËÜ ÑÒÐÅËÊÈ
procedure TFSCS_Main.mrsBothLightAdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
ImageLoad: TBitmap;
DestRect: TRect;
ImIndex: integer;
begin
try
ImIndex := 0; //#From Oleg# //14.09.2010
// ïðîâåðêà íà çàãðóçêó ðèñóíêîâ
if (TMainMenu(Sender).Name = 'mrsBothLight') or (TPopupMenu(Sender).Name = 'prsBothLight') then
ImIndex := 14;
if (TMainMenu(Sender).Name = 'mrsBothSolid') or (TPopupMenu(Sender).Name = 'prsBothSolid') then
ImIndex := 15;
if (TMainMenu(Sender).Name = 'mrsLeftLight') or (TPopupMenu(Sender).Name = 'prsLeftLight') then
ImIndex := 16;
if (TMainMenu(Sender).Name = 'mrsLeftSolid') or (TPopupMenu(Sender).Name = 'prsLeftSolid') then
ImIndex := 17;
if (TMainMenu(Sender).Name = 'mrsNone') or (TPopupMenu(Sender).Name = 'prsNone') then
ImIndex := 18;
if (TMainMenu(Sender).Name = 'mrsRightLight') or (TPopupMenu(Sender).Name = 'prsRightLight') then
ImIndex := 19;
if (TMainMenu(Sender).Name = 'mrsRightSolid') or (TPopupMenu(Sender).Name = 'prsRightSolid') then
ImIndex := 20;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(ImIndex, ImageLoad);
DestRect := ARect;
DestRect.Top := DestRect.Top + 2;
DestRect.Left := DestRect.Left + 30;
DestRect.Bottom := DestRect.Top + 16;
DestRect.Right := DestRect.Left + 32;
ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16));
ACanvas.Refresh;
FreeAndNil(ImageLoad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.mrsBothLightAdvancedDrawItem', E.Message);
end;
end;
// ÇÀÃÐÓÇÊÀ ÐÈÑÓÍÊÎÂ Â ÑÒÈËÜ ÇÀËÈÂÊÈ
procedure TFSCS_Main.mainFileClick(Sender: TObject);
begin
CheckCloseReportForm;
inherited;
end;
procedure TFSCS_Main.MainMenuChange(Sender: TObject; Source: TMenuItem;
Rebuild: Boolean);
begin
CheckCloseReportForm;
end;
procedure TFSCS_Main.mbsVerticalAdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
ImageLoad: TBitmap;
DestRect: Trect;
ImIndex: integer;
begin
try
ImIndex := 0; //#From Oleg# //14.09.2010
// ïðîâåðêà íà çàãðóçêó ðèñóíêîâ
if (TMainMenu(Sender).Name = 'mbsSolid') or (TPopupMenu(Sender).Name = 'pbsSolid') then
ImIndex := 21;
if (TMainMenu(Sender).Name = 'mbsClear') or (TPopupMenu(Sender).Name = 'pbsClear') then
ImIndex := 22;
if (TMainMenu(Sender).Name = 'mbsHorizontal') or (TPopupMenu(Sender).Name = 'pbsHorizontal') then
ImIndex := 23;
if (TMainMenu(Sender).Name = 'mbsVertical') or (TPopupMenu(Sender).Name = 'pbsVertical') then
ImIndex := 24;
if (TMainMenu(Sender).Name = 'mbsFDiagonal') or (TPopupMenu(Sender).Name = 'pbsFDiagonal') then
ImIndex := 25;
if (TMainMenu(Sender).Name = 'mbsBDiagonal') or (TPopupMenu(Sender).Name = 'pbsBDiagonal') then
ImIndex := 26;
if (TMainMenu(Sender).Name = 'mbsCross') or (TPopupMenu(Sender).Name = 'pbsCross') then
ImIndex := 27;
if (TMainMenu(Sender).Name = 'mbsDiagCross') or (TPopupMenu(Sender).Name = 'pbsDiagCross') then
ImIndex := 28;
ImageLoad := TBitmap.Create;
ImageStyles.GetBitmap(ImIndex, ImageLoad);
DestRect := ARect;
DestRect.Top := DestRect.Top + 2;
DestRect.Left := DestRect.Left + 30;
DestRect.Bottom := DestRect.Top + 16;
DestRect.Right := DestRect.Left + 32;
ACanvas.CopyRect(DestRect, ImageLoad.Canvas, Rect(1, 0, 33, 16));
ACanvas.Refresh;
FreeAndNil(ImageLoad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.mbsBDiagonalAdvancedDrawItem', E.Message);
end;
end;
////////////////////////////////////////////////////////////////////////////////
// ----------------------- LAYERS ----------------------------------------------
// ÍÎÂÛÉ ÑËÎÉ
procedure TFSCS_Main.aNewLayerExecute(Sender: TObject);
begin
F_NewLayer.ShowModal;
end;
// ÓÄÀËÈÒÜ ÑËÎÉ
procedure TFSCS_Main.aDeleteLayerExecute(Sender: TObject);
var
RemoveLayer: TLayer;
LNbr: integer;
ActLayer: integer;
begin
try
ActLayer := GCadForm.PCad.ActiveLayer;
LNbr := GCadForm.PCad.ActiveLayer;
RemoveLayer := GCadForm.PCad.Layers.Items[LNbr];
if (ActLayer > 9) then
begin
// Tolik 30/08/2019 --
if CheckCanDelLayer(RemoveLayer) then
begin
//LNbr := GCadForm.PCad.ActiveLayer;
//RemoveLayer := GCadForm.PCad.Layers.Items[LNbr];
if GCadForm.PCad.ActiveLayer = LNbr then
{$IF Defined(ES_GRAPH_SC)}
GCadForm.CurrentLayer := 8;
{$else}
GCadForm.CurrentLayer := 2;
{$ifend}
GCadForm.PCad.DeleteLayer(RemoveLayer.name);
FSCS_Main.cbLayers.Properties.Items.Delete(LNbr - 1);
F_LayersDialog.UpdateLayersList;
F_LayersDialog.lbCurLayer.Caption := 'Base Layer';
F_LayersDialog.listGrayed.Delete(LNbr);
// Tolik 30/08/2019 --
//F_LayersDialog.FIsManualGrayed.Delete(LNbr);
F_LayersDialog.FIsManualGrayed.Delete(LNbr - 1);
//
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
MessageBox(Application.Handle, cMain_Mes19_1, cMain_Mes1, MB_OK);
end
else
begin
if ActLayer = 0 then
MessageBox(Application.Handle, cMain_Mes17, cMain_Mes1, MB_OK);
if ActLayer = 1 then
MessageBox(Application.Handle, cMain_Mes18, cMain_Mes1, MB_OK);
if ActLayer = 2 then
MessageBox(Application.Handle, cMain_Mes19, cMain_Mes1, MB_OK);
if ActLayer = 3 then
MessageBox(Application.Handle, cMain_Mes20, cMain_Mes1, MB_OK);
if ActLayer = 4 then
MessageBox(Application.Handle, cMain_Mes21, cMain_Mes1, MB_OK);
if ActLayer = 5 then
MessageBox(Application.Handle, cMain_Mes22, cMain_Mes1, MB_OK);
if ActLayer = 6 then
MessageBox(Application.Handle, cMain_Mes23, cMain_Mes1, MB_OK);
if ActLayer = 7 then
MessageBox(Application.Handle, cMain_Mes24, cMain_Mes1, MB_OK);
if ActLayer = 8 then
MessageBox(Application.Handle, cMain_Mes25, cMain_Mes1, MB_OK);
if ActLayer = 9 then
MessageBox(Application.Handle, cMain_Mes103, cMain_Mes1, MB_OK);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteLayerExecute', E.Message);
end;
end;
// ÑÎÅÄÈÍÈÒÜ ÂÑÅ ÂÈÄÈÌÛÅ ÑËÎÈ Â ÁÀÇÎÂÛÉ
procedure TFSCS_Main.aMergeVisibleExecute(Sender: TObject);
begin
try
GCadForm.PCad.MergeVisibleLayers;
F_LayersDialog.UpdateLayersList;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMergeVisibleExecute', E.Message);
end;
end;
// ÑÎÅÄÈÍÈÒÜ ÂÑÅ ÑËÎÈ Â ÁÀÇÎÂÛÉ
procedure TFSCS_Main.aMergeAllExecute(Sender: TObject);
begin
try
GCadForm.PCad.MergeAllLayers;
F_LayersDialog.UpdateLayersList;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMergeAllExecute', E.Message);
end;
end;
// ÍÅÀÊÒÈÂÍÛÅ ÑËÎÈ ÊÀÊ ÏÎÄËÎÆÊÀ
procedure TFSCS_Main.aFlueInactivesExecute(Sender: TObject);
var
FlueLayer: TLayer;
CurItem: TListItem;
ActiveLNbr: integer;
i: integer;
begin
try
ActiveLNbr := GCadForm.PCad.ActiveLayer;
for i := 1 to GCadForm.PCad.Layers.Count - 1 do
begin
FlueLayer := GCadForm.PCad.Layers.Items[i];
CurItem := F_LayersDialog.lvLayersList.Items[i - 1];
if i <> ActiveLNbr then // íåàêòèâíûå ñëîè
begin
if FlueLayer.visible <> lost then
begin
FlueLayer.visible := grayed;
CurItem.SubItemImages[1] := 137;
end;
end
else // àêòèâíûé ñëîé
begin
if FlueLayer.visible <> lost then
begin
FlueLayer.visible := seen;
CurItem.SubItemImages[1] := -1;
end;
end;
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aFlueInactivesExecute', E.Message);
end;
end;
// ÑÊÐÛÒÜ ÍÅÀÊÒÈÂÍÛÅ ÑËÎÈ
procedure TFSCS_Main.aHideInactivesExecute(Sender: TObject);
var
HideLayer: TLayer;
CurItem: TListItem;
ActiveLNbr: integer;
i: integer;
begin
try
ActiveLNbr := GCadForm.PCad.ActiveLayer;
for i := 1 to GCadForm.PCad.Layers.Count - 1 do
begin
HideLayer := GCadForm.PCad.Layers.Items[i];
CurItem := F_LayersDialog.lvLayersList.Items[i - 1];
if i <> ActiveLNbr then
begin
if HideLayer.visible = seen then
F_LayersDialog.listGrayed[i] := 'seen';
if HideLayer.visible = grayed then
F_LayersDialog.listGrayed[i] := 'grayed';
CurItem.SubItemImages[1] := -1;
CurItem.SubItemImages[0] := -1;
HideLayer.visible := lost;
end
else
begin
CurItem.SubItemImages[0] := 136;
if F_LayersDialog.listGrayed[i] = 'seen' then
HideLayer.visible := seen;
if F_LayersDialog.listGrayed[i] = 'grayed' then
begin
HideLayer.visible := grayed;
CurItem.SubItemImages[1] := 137;
end;
end;
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aHideInactivesExecute', E.Message);
end;
end;
// ÏÎÊÀÇÀÒÜ ÂÑÅ ÑËÎÈ
procedure TFSCS_Main.aShowAllLayersExecute(Sender: TObject);
var
i: integer;
ShowLayer: TLayer;
CurItem: TListItem;
begin
try
for i := 1 to GCadForm.PCad.Layers.Count - 1 do
begin
ShowLayer := GCadForm.PCad.Layers.Items[i];
CurItem := F_LayersDialog.lvLayersList.Items[i - 1];
CurItem.SubItemImages[0] := 136;
if (F_LayersDialog.listGrayed[i] = 'seen') or (F_LayersDialog.listGrayed[i] = 'lost') then
ShowLayer.visible := seen;
if F_LayersDialog.listGrayed[i] = 'grayed' then
begin
ShowLayer.visible := grayed;
CurItem.SubItemImages[1] := 137;
end;
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowAllLayersExecute', E.Message);
end;
end;
////////////////////////////////////////////////////////////////////////////////
/////-------------- ÐÀÁÎÒÀ Ñ ÊÀÄ ----------------------------------------///////
//Tolik 09/02/2021 --
{
procedure TFSCS_Main.aToolOrthoLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FContinueTrace := False;
aSetSCSLayer.Execute;
GCadForm.FCreateObjectOnClick := False;
GDefaultGap := 1;
GDefaultNum := 1;
GOrthoStatus := False;
GCurrentConnectorType := ct_Clear;
GCadForm.PCad.SetTool(toFigure, 'TOrthoLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
}
procedure TFSCS_Main.aToolOrthoLineExecute(Sender: TObject);
var NotSCSLayer: Boolean;
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
DropDownFirstToolbar; // Tolik 27/09/2021 --
{$IF Defined(ES_GRAPH_SC)}
NotSCSLayer := (GCadForm.CurrentLayer <> 8);
{$else}
NotSCSLayer := (GCadForm.CurrentLayer <> 2);
{$ifend}
GCadForm.FContinueTrace := False;
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GDefaultGap := 1;
GDefaultNum := 1;
GOrthoStatus := False;
GCurrentConnectorType := ct_Clear;
if NotSCSLayer then
begin
aSetSCSLayer.Execute;
tbToolOrtholineNoob.Click;
tbToolOrtholineNoob.Down := True;
end
else
//Tolik 27/09/2021 - -
// GCadForm.PCad.SetTool(toFigure, 'TOrthoLine');
begin
GCadForm.PCad.SetTool(toFigure, 'TOrthoLine');
if tbCADToolsExpert.Visible then // Tolik 04/02/2022 --
tbToolOrtholineExpert.Down := True
else
tbToolOrtholineNoob.Down := True;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
{
procedure TFSCS_Main.aToolOrtholineExtExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FContinueTrace := False;
aSetSCSLayer.Execute;
GCadForm.FCreateObjectOnClick := False;
GDefaultGap := 1;
GDefaultNum := 1;
GOrthoStatus := True;
GCurrentConnectorType := ct_Clear;
GCadForm.PCad.SetTool(toFigure, 'TOrthoLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
}
procedure TFSCS_Main.aToolOrtholineExtExecute(Sender: TObject);
var NotSCSLayer: Boolean;
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
{$IF Defined(ES_GRAPH_SC)}
NotSCSLayer := (GCadForm.CurrentLayer <> 8);
{$else}
NotSCSLayer := (GCadForm.CurrentLayer <> 2);
{$ifend}
GCadForm.FContinueTrace := False;
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GDefaultGap := 1;
GDefaultNum := 1;
GOrthoStatus := True;
GCurrentConnectorType := ct_Clear;
if NotSCSLayer then
begin
aSetSCSLayer.Execute;
tbToolOrtholineExtNoob.Click;
tbToolOrtholineExtNoob.Down := True;
//tbSelect.Down := False;
end
else
GCadForm.PCad.SetTool(toFigure, 'TOrthoLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
//
procedure TFSCS_Main.aDisconnectExecute(Sender: TObject);
var
DisConnectFigure: TConnectorObject;
// Tolik 03/10/2016 --
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GPopupFigure = nil then
exit;
DisConnectFigure := TConnectorObject(GPopupFigure);
if CheckCannotDelete(GPopupFigure) then
Exit;
DisConnectFigure.Deselect;
//// åñëè êîíåêòîð ïóñòîé ///////////////////////
if DisConnectFigure.ConnectorType = Ct_Clear then
begin
if (DisConnectFigure.JoinedOrtholinesList.Count = 2) and
(DisConnectFigure.FConnRaiseType = crt_None) and (GetRaiseConn(DisConnectFigure) = nil) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
DisconnectConn(DisConnectFigure);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes26);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectExecute', E.Message);
end;
// GCadForm.FCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.aDivideLineExecute(Sender: TObject);
var
i: integer;
FFigure: TFigure;
SelectedList: TList;
// Tolik -- 03/10/2016--
SavedUndoFlag: Boolean;
//
begin
if GPopupFigure = nil then
exit;
if ActiveMDIChild <> nil then
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
BeginProgress;
try
SelectedList := TList.Create;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
SelectedList.Add(TFigure(GCadForm.PCad.Selection[i]));
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if not TOrthoLine(GPopupFigure).FConnectingLine then
DivideLine(TOrthoLine(GPopupFigure));
for i := 0 to SelectedList.Count - 1 do
begin
FFigure := TFigure(SelectedList[i]);
if CheckFigureByClassName(FFigure, cTOrthoLine) then
if FFigure <> GPopupFigure then
if not TOrthoLine(FFigure).FIsRaiseUpDown then
if not TOrthoLine(GPopupFigure).FConnectingLine then
DivideLine(TOrthoLine(FFigure));
end;
// *UNDO*
GCadForm.FCanSaveForUndo := True;
if SelectedList <> nil then
FreeAndNil(SelectedList);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDivideLineExecute', E.Message);
end;
EndProgress;
// GCadForm.FCanSaveForUndo := SavedUndoFlag;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aSetSubstrateLayerExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
GCadForm.CurrentLayer := 1;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSubstrateLayerExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aSetSCSLayerExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
try
{$IF Defined(ES_GRAPH_SC)}
GCadForm.CurrentLayer := 8;
{$else}
GCadForm.CurrentLayer := 2;
{$ifend}
// Tolik 10/11/2017 -- åñëè ýòî íå ñäåëàòü, òî óêàçàòåëü ìûøêè ìîæåò îñòàòüñÿ â âèäå "ðó÷êè", ðåæèì íå ïåðåêëþ÷èòñÿ
// è åñëè ïîëüçîâàòåëü äî ýòîãî òàñêàë ïîäëîæêó, òî ñ òàêèì æå óñïåõîì ñìîæåò òàñêàòü êîìïîíåíòû, íî îíè òîãäà õåðîâî ïåðåðèñîâûâàþòñÿ
if tbCADToolsExpert.Visible then
begin
tbSelectExpert.Click;
tbSelectExpert.Down := True;
tbCreateOnClickModeExpert.Down := False;
end
else
begin
tbSelectNoob.Click;
tbSelectNoob.Down := True;
tbCreateOnClickModeNoob.Down := False;
end;
//
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSCSLayerExecute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aSetDefaultColorsExecute(Sender: TObject);
begin
if TF_CAD(ActiveMDIChild) <> nil then
begin
try
GCadForm.PCad.DefaultPenColor := clBlack;
GCadForm.PCad.DefaultBrushColor := clBlack;
GCadForm.PCad.Font.Color := clBlack;
GCadForm.PCad.GridColor := clSilver;
GCadForm.PCad.GuideColor := clGreen;
GCadForm.PCad.PageColor := clWhite;
GCadForm.PCad.BackGround := clGray;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDefaultColorsExecute', E.Message);
end;
end;
end;
// ÈÇÌÅÍÈÒÜ ÏÀÐÀÌÅÒÐÛ ÎÐÒÎËÈÍÈÈ
procedure TFSCS_Main.aChangeOrtoParamsExecute(Sender: TObject);
var
itLine: TOrthoLine;
ReplaceLine: TOrthoLine;
Joined1, Joined2: TConnectorObject;
i: integer;
begin
try
itLine := TOrthoLine(GCadForm.PCad.Selection[0]);
GDefaultGap := itLine.FGap;
GDefaultNum := itLine.FCount;
F_OrthoLineParams.ShowModal;
GCadForm.PCad.SetTool(toSelect, 'TSelected');
// ïðåîáðàçîâàíèå ìóëüòèëèíèè â ìóëüòèëèíèþ
if (itLine.FCount <> 1) AND (GDefaultNum <> 1) then
begin
itLine.FCount := GDefaultNum;
itLine.FGap := GDefaultGap;
end;
// ïðåîáðàçîâàíèå îäèíî÷íîé â ìóëüòèëèíèþ
if (itLine.FCount = 1) AND (GDefaultNum <> 1) then
begin
Joined1 := TConnectorObject(itLine.JoinConnector1);
Joined2 := TConnectorObject(itLine.JoinConnector2);
TOrthoLine(itLine).create(Joined1.ActualPoints[1].x, Joined1.ActualPoints[1].y, Joined1.ActualZOrder[1],
Joined2.ActualPoints[1].x, Joined2.ActualPoints[1].y, Joined2.ActualZOrder[1],
1, ord(psSolid), clBlack, 0, Joined1.LayerHandle, mydsNormal, GCadForm.PCad);
TText(TOrthoLine(itLine).MultilineCaptionBox).Text := TOrthoLine(itLine).SaveCaption;
end;
// ïðåîáðàçîâàíèå ìóëüòèëèíèè â îäèíî÷íóþ
if (GDefaultNum = 1) AND (itLine.FCount <> 1) then
begin
Joined1 := TConnectorObject(itLine.JoinConnector1);
Joined2 := TConnectorObject(itLine.JoinConnector2);
TOrthoLine(itLine).SaveCaption := TTextMod(TOrthoLine(itLine).MultilineCaptionBox).Text;
TTextMod(TOrthoLine(itLine).MultilineCaptionBox).Delete;
TOrthoLine(itLine).create(Joined1.ActualPoints[1].x, Joined1.ActualPoints[1].y, Joined1.ActualZOrder[1],
Joined2.ActualPoints[1].x, Joined2.ActualPoints[1].y, Joined2.ActualZOrder[1],
1, ord(psSolid), clBlack, 0, Joined1.LayerHandle, mydsNormal, GCadForm.PCad);
end;
itLine.FGap := GDefaultGap;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aChangeOrtoParamsExecute', E.Message);
end;
end;
procedure TFSCS_Main.FormClose(Sender: TObject; var Action: TCloseAction);
var
Rect: TRect;
Status: TMemoryStatus;
i: integer;
MessageResult: integer;
begin
{$if Defined(ES_GRAPH_SC)}
try
SaveAutoShowPanel(F_FloatPanel.Visible);
except
end;
if Assigned(GSCStream) then
begin
if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then
begin
MessageResult := IDNO;
MessageResult := MessageModal('Ïåðåäàòü ïðîåêò "' + F_ProjMan.GSCSBase.CurrProject.GetNameForVisible + '" â ñìåòíóþ ïðîãðàììó?', ApplicationName,
MB_ICONQUESTION or MB_YESNO);
if MessageResult = IDYES then
begin
try
ExpProjToStroyCalcStream(F_ProjMan.GSCSBase.CurrProject, GSCStream);
except
GSCStream.Clear;
end;
end;
end;
end;
if CloseCurrProject(true) = IDCANcel then
begin
if Assigned(GSCStream) then
GSCStream.Clear;
Action := caNone;
ModalResult := mrCancel;
Exit;
end;
Action := caHide;
ModalResult := mrOk;
{$else}
try
SaveAutoShowPanel(F_FloatPanel.Visible);
except
end;
{if aExpertMode.Checked then
GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := True
else
GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := False;}
if CloseCurrProject(true) = IDCANcel then
begin
Action := caNone;
Exit;
end;
try
Rect.Left := 0;
Rect.Top := 0;
if Assigned(F_Navigator) then
if F_Navigator <> nil then
begin
try
F_Navigator.PCadNavigator.Figures.Clear;
except
end;
FreeAndNil(F_Navigator);
end;
if Assigned(F_ProjMan) then
if F_ProjMan <> nil then
begin
try
F_ProjMan.ManualFloat(Rect);
FreeAndNil(F_ProjMan);
except
end;
end;
if Assigned(F_Normbase) then
if F_NormBase <> nil then
begin
F_NormBase.ManualFloat(Rect);
FreeAndNil(F_NormBase);
end;
if Assigned(F_Progress) then
FreeAndNil(F_Progress);
if Assigned(F_BlockEditor) then
FreeAndNil(F_BlockEditor);
if Assigned(F_AutoTraceType) then
FreeAndNil(F_AutoTraceType);
if Assigned(F_RaiseHeight) then
FreeAndNil(F_RaiseHeight);
//
GExitProgEx := True;
//
if Assigned(F_MasterNewList) then
FreeAndNil(F_MasterNewList);
if Assigned(F_InterfacesAutoTrace) then
FreeAndNil(F_InterfacesAutoTrace);
if Assigned(F_SCSObjectsProp) then
FreeAndNil(F_SCSObjectsProp);
if Assigned(F_LoadColor) then
FreeAndNil(F_LoadColor);
if Assigned(F_OrthoLineParams) then
FreeAndNil(F_OrthoLineParams);
if Assigned(F_SizePos) then
FreeAndNil(F_SizePos);
if Assigned(F_NewLayer) then
FreeAndNil(F_NewLayer);
if Assigned(F_GridStep) then
FreeAndNil(F_GridStep);
if Assigned(F_Scale) then
FreeAndNil(F_Scale);
if Assigned(F_IncOn) then
FreeAndNil(F_IncOn);
if Assigned(F_LayersDialog) then
FreeAndNil(F_LayersDialog);
if Assigned(F_ComponDesignWizard) then
FreeAndNil(F_ComponDesignWizard);
if Assigned(F_PrintLists) then
FreeAndNil(F_PrintLists);
if Assigned(FSCS_Main) then
begin
FSCS_Main.ActionManager.Free;
// FreeAndNil(FSCS_Main);
end;
if Assigned(FPMItemsRoofHipTypes) then
FreeAndNil(FPMItemsRoofHipTypes);
try
FreeLibrary(Newshandle);
except
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.FormClose', E.Message);
end;
try
SetInternationalSettingsToRegistry(GGlobalInternationalSettings);
except
end;
if IsVista then
begin
{$if Not Defined(ES_GRAPH_SC)}
ExitProcess(0);
{$ifend}
end;
for i := 0 to 10000 do
Application.ProcessMessages;
Status.dwLength := sizeof(TMemoryStatus);
GlobalMemoryStatus(Status);
if Status.dwMemoryLoad >= 70 then
begin
{$if Not Defined(ES_GRAPH_SC)}
Application.Terminate;
{$ifend}
end;
{$ifend}
end;
procedure TFSCS_Main.aFreeRotateExecute(Sender: TObject);
var
SelFigure: TFigure;
oldGrpSizex, OldGrpSizeY: Double;
BndRect: TDoubleRect;
RestoreTConnectorObjectBouns: Boolean; //Tolik -- 18/10/2017
function CheckHasAutoCreated(aPointObject: TConnectorObject): boolean;
var i: Integer;
function HasAutoCreated(aFigure: TFigureGrp): Boolean;
var i: Integer;
inFigure: TFigure;
begin
Result := False;
for i := 0 to aFigure.InFigures.count - 1 do
begin
inFigure := TFigure(aFigure.InFigures[i]);
if inFigure is TFigureGrp then
Result := HasAutoCreated(TFigureGrp(inFigure))
else
if (inFigure.isAutoCreatedFigure = biTrue) then
Result := True;
if Result then
break;
end;
end;
begin
Result := False;
if Assigned(aPointObject.DrawFigure) then
begin
Result := HasAutoCreated(aPointObject.DrawFigure);
end;
end;
begin
RestoreTConnectorObjectBouns := False;
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.Selection.Count > 0 then
begin
try
SelFigure := TFigure(GCadForm.PCad.Selection[0]);
if (not CheckFigureByClassName(SelFigure, cTCabinet)) and (not CheckFigureByClassName(SelFigure, cTCabinetExt)) then
begin
GCadForm.PCad.SetTool(toSelect, 'TFigure');
// Tolik 04/09/2017 --
if CheckFigureByClassName(SelFigure, cTConnectorObject) then
begin
if CheckHasAutoCreated(TConnectorObject(SelFigure)) then
begin
RestoreTConnectorObjectBouns := True;
oldGrpSizex := TConnectorObject(SelFigure).GrpSizeX;
OldGrpSizeY := TConnectorObject(SelFigure).GrpSizeY;
TFigureGrp(TConnectorObject(SelFigure).DrawFigure).BoundCalc := False;
BndRect := TConnectorObject(SelFigure).DrawFigure.GetBoundRectWithoutAutoCreatedFigures;
TConnectorObject(SelFigure).GrpSizeX := BndRect.Right - BndRect.Left;
TConnectorObject(SelFigure).GrpSizeY := BndRect.Bottom - BndRect.Top;
end;
end;
//
SelFigure.RotateSelect;
// Tolik 18/10/2017 --
if RestoreTConnectorObjectBouns then
//if CheckFigureByClassName(SelFigure, cTConnectorObject) then
begin
TConnectorObject(SelFigure).GrpSizeX := oldGrpSizex;
TConnectorObject(SelFigure).GrpSizeY := OldGrpSizeY;
end;
RefreshCAD(GCadForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aFreeRotateExecute', E.Message);
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.RegisteredHotKeys;
var
GLogFile: TMyLoglist;
begin
end;
procedure TFSCS_Main.UnRegisteredHotKeys;
var
GLogFile: TMyLoglist;
begin
end;
procedure TFSCS_Main.aRegHotKeysExecute(Sender: TObject);
begin
GAppMinim := False;
RegisteredHotKeys;
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
if (GCadForm.CurrentLayer >= 0) and (GCadForm.CurrentLayer <= 1) then
UnRegisteredCADHotKeys;
if (GCadForm.CurrentLayer >= 2) and (GCadForm.CurrentLayer <= 7) then
RegisteredCADHotKeys;
end;
end;
procedure TFSCS_Main.aUnregHotKeysExecute(Sender: TObject);
begin
UnRegisteredHotKeys;
UnRegisteredCADHotKeys;
end;
procedure TFSCS_Main.aAutoSelectTraceExecute(Sender: TObject);
begin
if aAutoSelectTrace.Checked = True then
begin
GCadForm.FAutoSelectTrace := True;
if GEndPoint = nil then
begin
ShowMessage(cMain_Mes27);
end;
end;
if aAutoSelectTrace.Checked = False then
GCadForm.FAutoSelectTrace := False;
end;
procedure TFSCS_Main.aServerAsDefaultExecute(Sender: TObject);
var
Server: TFigure;
EndPoint: TFigure;
begin
{//18.06.2013
try
if GPopupFigure = nil then
exit;
try
EndPoint := GPopupFigure;
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
TConnectorObject(EndPoint).AsEndPoint := True
else
if CheckFigureByClassName(GPopupFigure, cTHouse) then
THouse(EndPoint).AsEndPoint := True;
if EndPoint = GEndPoint then
Exit;
except
EndPoint := Nil;
end;
// ñáðîñèòü áûâøèé ÊÎ
if GEndPoint <> nil then
begin
if CheckFigureByClassName(GEndPoint, cTConnectorObject) then
TConnectorObject(GEndPoint).AsEndPoint := False
else
if CheckFigureByClassName(GEndPoint, cTHouse) then
THouse(GEndPoint).AsEndPoint := False;
if (GListWithEndPoint <> GCadForm) and (GListWithEndPoint <> nil) then
begin
RefreshCAD(GListWithEndPoint.PCad);
RefreshCAD(GListWithEndPoint.PCad);
end;
RefreshCAD(GCadForm.PCad);
GListWithEndPoint := Nil;
end;
RefreshCAD(GCadForm.PCad);
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes2);
// ïåðåíàçíà÷èòü íîâûé
GEndPoint := EndPoint;
GListWithEndPoint := GCadForm;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aServerAsDefaultExecute', E.Message);
end;}
SetFigureAsEndObject(GCadForm, GPopupFigure);
end;
procedure TFSCS_Main.sDiv1CanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
begin
try
Accept := CanResizePanelForm(F_ProjMan, NewSize - PDock1.Width);
if Accept then
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.AutoRefresh := False;
GCadForm.FCurrPCadScrollX := GCadForm.PCad.HSCBarPosition;
GCadForm.FCurrPCadScrollY := GCadForm.PCad.VSCBarPosition;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.sDiv1CanResize', E.Message);
end;
end;
procedure TFSCS_Main.sDiv2CanResize(Sender: TObject; var NewSize: Integer;
var Accept: Boolean);
begin
try
Accept := CanResizePanelForm(F_NormBase, NewSize - PDock2.Width);
if Accept then
begin
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad <> nil then
begin
GCadForm.PCad.AutoRefresh := False;
GCadForm.FCurrPCadScrollX := GCadForm.PCad.HSCBarPosition;
GCadForm.FCurrPCadScrollY := GCadForm.PCad.VSCBarPosition;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.sDiv2CanResize', E.Message);
end;
end;
procedure TFSCS_Main.sDiv1Moved(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.AutoRefresh := True;
end;
end;
procedure TFSCS_Main.sDiv2Moved(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.PCad.AutoRefresh := True;
end;
end;
procedure TFSCS_Main.aRealignLineExecute(Sender: TObject);
// Tolik 03/10/2016--
var
SavedUndoFlag: Boolean;
//
begin
if GPopupFigure = nil then
exit;
if ActiveMDIChild <> nil then
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
ReAlignLine(TOrthoLine(GPopupFigure));
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRealignLineExecute', E.Message);
end;
// GCadForm.FCanSaveForUndo := SavedUndoFlag;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.ApplicationEvents1Message(var Msg: tagMSG; var Handled: Boolean);
var
KeyState: TKeyboardState;
CurrPos: TPoint;
CurrPos1: TPoint;
Pt: TPoint;
Res1: TWinControl;
Hand: THandle;
begin
Handled := False;
if not Application.Active then
begin
inherited;
exit;
end;
if (Msg.message = 0) then
begin
inherited;
exit;
end;
try
if (Msg.message = WM_MOUSEWHEEL) then
try
GetCursorPos(Pt);
Hand := WindowFromPoint(Pt);
Res1 := Nil;
Res1 := FindControl(Hand);
try
if Res1.Parent.Name = 'PCad' then
begin
if (GCadForm.PCad.ToolIdx = toSelect) and (GCadForm.PCad.SelectedCount = 0) then
begin
if tbCADToolsExpert.Visible then
cbScaleExpert.SetFocus
else
cbScaleNoob.SetFocus;
SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0);
RefreshCAD_T(GCadForm.PCad);
end;
end;
except
end;
if ActiveControl <> nil then
begin
if (ActiveControl.ClassName = 'TcxCustomComboBoxInnerEdit') or (ActiveControl.ClassName = 'TPanel') then
begin
Handled := True;
exit;
end
else
begin
inherited;
exit;
end;
end;
except
inherited;
exit;
end;
if msg.message = WM_Syscommand then
begin
if msg.wParam = SC_CLOSE then
begin
if GCadForm = nil then
inherited
else
Handled := True;
exit;
end;
end;
if (GCadForm = nil) or (GCadForm.PCad = nil) then
begin
inherited;
Exit;
end
else
begin
if msg.message = wm_MouseWheel then
begin
try
CurrPos := GCadForm.ClientToScreen(Point(GCadForm.VerScroll.Left, GCadForm.VerScroll.Top));
CurrPos1 := GCadForm.ClientToScreen(Point(GCadForm.VerScroll.Left + GCadForm.VerScroll.Width, GCadForm.VerScroll.Top + GCadForm.VerScroll.Height));
// VerScroll
if (CurrPos.Y < Mouse.CursorPos.Y) And (CurrPos.X < Mouse.CursorPos.X) And
(CurrPos1.Y > Mouse.CursorPos.Y) And (CurrPos1.X > Mouse.CursorPos.X) then
begin
if 120 - HIWORD(Msg.wParam) < 0 then
begin
if (GCadForm.VerScroll.Position + ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)) < GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize then
GCadForm.VerScroll.Position := GCadForm.VerScroll.Position + ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)
else
GCadForm.VerScroll.Position := GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize + 1;
end
else
begin
if (GCadForm.VerScroll.Position - ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)) > GCadForm.VerScroll.Min then
GCadForm.VerScroll.Position := GCadForm.VerScroll.Position - ((GCadForm.VerScroll.Max - GCadForm.VerScroll.PageSize) div 10)
else
GCadForm.VerScroll.Position := GCadForm.VerScroll.Min;
end;
GCadForm.Set_PCad_VerScroll;
end
// HorScroll
else
begin
CurrPos := GCadForm.ClientToScreen(Point(GCadForm.HorScroll.Left, GCadForm.HorScroll.Top));
CurrPos1 := GCadForm.ClientToScreen(Point(GCadForm.HorScroll.Left + GCadForm.HorScroll.Width, GCadForm.HorScroll.Top + GCadForm.HorScroll.Height));
if (CurrPos.Y < Mouse.CursorPos.Y) And (CurrPos.X < Mouse.CursorPos.X)
And (CurrPos1.Y > Mouse.CursorPos.Y) And (CurrPos1.X > Mouse.CursorPos.X) then
begin
if 120 - HIWORD(Msg.wParam) < 0 then
begin
if (GCadForm.HorScroll.Position + ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)) < GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize then
GCadForm.HorScroll.Position := GCadForm.HorScroll.Position + ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)
else
GCadForm.HorScroll.Position := GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize + 1;
end
else
begin
if (GCadForm.HorScroll.Position - ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)) > GCadForm.HorScroll.Min then
GCadForm.HorScroll.Position := GCadForm.HorScroll.Position - ((GCadForm.HorScroll.Max - GCadForm.HorScroll.PageSize) div 10)
else
GCadForm.HorScroll.Position := GCadForm.HorScroll.Min;
end;
GCadForm.Set_PCad_HorScroll;
end;
end;
Handled := True;
exit;
except
inherited;
exit;
end;
end;
end;
try
if Assigned(GCadForm) then
if GCadForm.FWaitWork then
begin
Handled := True;
exit;
end
else
begin
inherited;
exit;
end;
except
inherited;
exit;
end;
inherited;
exit;
except
inherited;
// on E: Exception do addExceptionToLogEx('TFSCS_Main.ApplicationEvents1Message', E.Message);
end;
end;
procedure TFSCS_Main.aNotAsServerDefaultExecute(Sender: TObject);
var
EndPoint: TFigure;
begin
try
if GPopupFigure = nil then
exit;
try
EndPoint := GPopupFigure;
except
EndPoint := nil;
end;
// ñáðîñèòü ÊÎ
if CheckFigureByClassName(EndPoint, cTConnectorObject) then
TConnectorObject(EndPoint).AsEndPoint := False
else
if CheckFigureByClassName(EndPoint, cTHouse) then
THouse(EndPoint).AsEndPoint := False;
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes3);
GEndPoint := Nil;
GListWithEndPoint := Nil;
RefreshCAD(GCadForm.PCad);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNotAServerDefaultExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSelectTracetoServerExecute(Sender: TObject);
var
RaiserThisList: TConnectorObject;
RaiserOtherList: TConnectorObject;
CurrentWS: TConnectorObject;
CurrentServer: TConnectorObject;
AllTrace: TList;
i, j, k: integer;
CurGCadForm: TF_CAD;
isTrace: boolean;
RaiseType: TConnRaiseType;
ListOfLists: TIntList;
ListOfRaises: TList;
CurrentCAD: TF_CAD;
ConnFrom: TConnectorObject;
ConnTo: TConnectorObject;
PrevConn: TConnectorObject;
PrevCAD: TF_CAD;
ListOfAllTraces: TList;
EndPoint: TConnectorObject;
TracesLength: Double;
procedure SelectObjects;
var
i: Integer;
Figure: TFigure;
begin
// Tolik -- 08/02/2017 --
if GCadForm.FTracingList = nil then
GCadForm.FTracingList := TList.Create
else
GCadForm.FTracingList.Clear;
//
if AllTrace <> nil then
begin
// Tolik -- 08/02/2017 --
// GCadForm.FTracingList := TList.Create;
for i := 0 to AllTrace.Count - 1 do
begin
Figure := TFigure(AllTrace[i]);
GCadForm.FTracingList.Add(Figure);
Figure.Select;
if CheckFigureByClassName(Figure, TOrthoLine.ClassName) then
TracesLength := TracesLength + TOrtholine(Figure).LineLength;
end;
end;
// Tolik -- 08/02/2017 --
// else
// GCadForm.FTracingList := TList.Create;
//
// Tolik -- 27/04/2017 --
GCadForm.PCad.Refresh;
//
end;
begin
// Tolik 08/02/2017 --
ListOfRaises := Nil;
ListOfLists := nil; // Tolik 21/05/2018 --
//
try
CurrentServer := nil; //#From Oleg# //14.09.2010
try
CurrentWS := TConnectorObject(CheckBySCSObjects(GCurrMousePos.x, GCurrMousePos.y));
except
CurrentWS := Nil;
end;
if CurrentWS = nil then
begin
if GPopupFigure <> nil then
CurrentWS := TConnectorObject(GPopupFigure)
else
Exit;
end;
// ***
if CheckFigureByClassName(GEndPoint, cTConnectorObject) then
CurrentServer := TConnectorObject(GEndPoint)
else
if CheckFigureByClassName(GEndPoint, cTHouse) then
CurrentServer := GetEndPointByHouse(THouse(GEndPoint), CurrentWS);
// ***
if (CurrentServer = nil) or (CurrentWS = nil) or (not CheckFigureByClassName(CurrentWS, cTConnectorObject)) then
Exit;
if (GCadForm.FIsDragOver) and (GFigureSnap <> nil) then
begin
end
else
begin
BeginProgress('', 1, true);
F_Progress.BringToFront;
end;
try
AllTrace := nil;
ListOfAllTraces := nil;
TracesLength := 0;
GCadForm.FDeselectUpDown := True;
// â ïðåäåëàõ îäíîãî ëèñòà
if GListWithEndPoint = GCadForm then
begin
//Tolik
// ListOfAllTraces := GetAllTraceInCADByMarked_New(CurrentServer, CurrentWS);
// ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS);
// ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS);
//
if ((GetKeyState(VK_SHIFT) and 128) = 128) then
ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS)
else
ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS);
if ListOfAllTraces.Count > 0 then
begin
if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then
GCadForm.FTracingListIndex := 0;
//Tolik 09/10/2017 --
// AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex];
AllTrace := TList.Create;
// ïðîâåðî÷êà -- íà âñÿêèé --
if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and
(TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then
AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy);
//
{//08.08.2012
if AllTrace <> nil then
begin
GCadForm.FTracingList := TList.Create;
for k := 0 to AllTrace.Count - 1 do
GCadForm.FTracingList.Add(AllTrace[k]);
for i := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[i]).Select;
end
else
GCadForm.FTracingList := TList.Create;}
SelectObjects;
FreeAndNil(AllTrace);
end
else
// Tolik -- 08/02/2017 --
// GCadForm.FTracingList := TList.Create;
begin
if GCadForm.FTracingList = nil then
GCadForm.FTracingList := TList.Create
else
GCadForm.FTracingList.Clear;
end;
//
end
else
if GListWithEndPoint <> nil then
begin
RaiseType := crt_OnFloor; //#From Oleg# //14.09.2010
// äðóãîé ëèñò ñ ÊÎ
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then
RaiseType := crt_BetweenFloorDown;
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then
RaiseType := crt_BetweenFloorUp;
ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID);
if ListOfLists.Count >= 2 then
begin
ListOfRaises := GetSortedListOfRaisesFromCurr(ListOfLists, RaiseType, CurrentWS, CurrentServer);
if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then
begin
PrevCAD := nil;
PrevConn := nil;
for i := 0 to ListOfLists.Count - 1 do
begin
CurrentCAD := GetListByID(ListOfLists[i]);
// âçÿòü íàéäåííûé ì-ý ñ-ï
if i < ListOfLists.Count - 1 then
begin
ConnTo := TConnectorObject(ListOfRaises[i]);
end
else
begin
ConnTo := CurrentServer;
end;
CurGCadForm := GCadForm;
GCadForm := CurrentCAD;
if i = 0 then
begin
ConnFrom := CurrentWS;
end
else
begin
ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage));
end;
ListOfAllTraces := GetAllTraceInCADByMarked(ConnTo, ConnFrom{ConnFrom, ConnTo});
if ListOfAllTraces.Count > 0 then
begin
if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then
GCadForm.FTracingListIndex := 0;
// Tolik 09/02/2017 --
//AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex];
AllTrace := TList.Create;
// ïðîâåðî÷êà -- íà âñÿêèé --
if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and
(TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then
AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy);
//
{//08.08.2012
if AllTrace <> nil then
begin
GCadForm.FTracingList := TList.Create;
for k := 0 to AllTrace.Count - 1 do
GCadForm.FTracingList.Add(AllTrace[k]);
for j := 0 to AllTrace.Count - 1 do
TFigure(AllTrace[j]).Select;
GCadForm := CurGCadForm;
PrevCAD := CurrentCAD;
PrevConn := ConnTo;
end
else
GCadForm.FTracingList := TList.Create;}
SelectObjects;
// Tolik 21/02/2017 --
//if AllTrace <> nil then
if AllTrace.Count > 0 then
begin
GCadForm := CurGCadForm;
PrevCAD := CurrentCAD;
PrevConn := ConnTo;
end;
FreeAndNil(AllTrace);
end
else
// Tolik -- 08/02/2017 --
//GCadForm.FTracingList := TList.Create;
begin
if GCadForm.FTracingList = nil then
GCadForm.FTracingList := TList.Create
else
GCadForm.FTracingList.Clear;
end;
end;
end;
end;
if ListOfLists <> nil then
FreeAndNil(ListOfLists);
if ListOfRaises <> nil then
FreeAndNil(ListOfRaises);
end;
// Tolik 21/02/2017 --
//if AllTrace <> nil then
if TracesLength > 0 then
//
begin
GCadForm.sbView.Panels[1].Text := GCadForm.GetMsgLengthToPoint(TracesLength);
//FreeAndNil(AllTrace);
end;
// Tolik 09/02/2017 -- çäåñü ListOfAllTraces -- ñïèñîê, êîòîðûé ñîäåðæèò ñïèñêè, ïîýòîìó íóæíî îñâîáîäèòü
// åùå è òó ïàìÿòü, êîòîðóþ çàíèìàåò êàæäûé èç íèõ
//if ListOfAllTraces <> nil then
// FreeAndNil(ListOfAllTraces);
if ListOfAllTraces <> nil then
begin
for i := 0 to ListOfAllTraces.Count - 1 do
begin
// Tolik 21/02/2017 --
if TList(ListOfAllTraces[i]) <> nil then
//
TList(ListOfAllTraces[i]).Free;
end;
FreeAndNil(ListOfAllTraces);
end;
//
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectTracetoServerExecute0', E.Message);
end;
if (GCadForm.FIsDragOver) and (GFigureSnap <> nil) then
begin
end
else
EndProgress;
RefreshCAD(GCadForm.PCad);
if GListWithEndPoint <> nil then
begin
RefreshCAD(GListWithEndPoint.PCad);
end;
GCadForm.FDeselectUpDown := false;
//Tolik
//DragState := dsNone;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSelectTracetoServerExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMakeCablingExecute(Sender: TObject);
var
CablingObj: TConnectorObject;
CurrLine: TOrthoLine;
i: integer;
isMaked: Boolean;
ptrInterfRecord: PConnectObjectParam;
ParamsList: TList;
begin
try
if GPopupFigure = nil then
exit;
try
CablingObj := TConnectorObject(GPopupFigure);
except
CablingObj := nil;
end;
ParamsList := TList.Create;
for i := 0 to CablingObj.JoinedOrtholinesList.Count - 1 do
begin
CurrLine := TOrthoLine(CablingObj.JoinedOrtholinesList[i]);
New(ptrInterfRecord);
ptrInterfRecord.IDObject := CurrLine.ID;
if CurrLine.JoinConnector1 = CablingObj then
ptrInterfRecord.Side := 1;
if CurrLine.JoinConnector2 = CablingObj then
ptrInterfRecord.Side := 2;
ParamsList.Add(ptrInterfRecord);
end;
MakeCablingInPM(ParamsList, True);
// Tolik 09/02/2017 -- îñâîáîäèòü ïàìÿòü
for i := 0 to ParamsList.Count - 1 do
Dispose(PConnectObjectParam(ParamsList[i]));
//
FreeAndNil(ParamsList);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMakeCablingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aCreateRaiseExecute(Sender: TObject);
var
RaiseOnFigure: TConnectorObject;
RaiseHeight: Double;
// Tolik
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GPopupFigure = nil then
exit;
try
RaiseOnFigure := TConnectorObject(GPopupFigure);
except
RaiseOnFigure := nil;
end;
F_RaiseHeight.cbApplyToAll.Visible := False;//Tolik 04/08/2021 --
F_RaiseHeight.Caption := cMain_Mes28;
F_RaiseHeight.lbMessage.Caption := cMain_Mes29;
// íà ñîåäèíèòåëå
if RaiseOnFigure.ConnectorType = ct_Clear then
begin
if F_RaiseHeight.Showmodal = mrOK then
begin
RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseHeight > GCadForm.FRoomHeight then
RaiseHeight := GCadForm.FRoomHeight;
if RaiseHeight <> RaiseOnFigure.ActualZOrder[1] then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
CreateRaiseOnConnector(RaiseOnFigure, RaiseHeight);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes30);
end;
end
else
// íà îáúåêòå
begin
if RaiseOnFigure.JoinedConnectorsList.Count > 0 then
begin
if F_RaiseHeight.Showmodal = mrOK then
begin
RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseHeight <> RaiseOnFigure.ActualZOrder[1] then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
// Tolik 17/03/2017 --
//CreateRaiseOnPointObject(RaiseOnFigure, RaiseHeight);
CreateRaiseOnPointObjectNew(RaiseOnFigure, RaiseHeight);
//
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes30);
end;
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes31);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateRaiseExecute', E.Message);
end;
//GCadForm.FCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.aDestroyRaiseExecute(Sender: TObject);
var
RaiseConn: TConnectorObject;
RaiseLine: TOrtholine;
RaiseOnFigure: TConnectorObject;
vList: TF_CAD;
vLists: TList;
// Tolik -- 03/10/2016--
SavedUndoFlag : Boolean;
//
begin
// Tolik -- 09/02/2017 --
vLists := nil;
//
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GPopupFigure = nil then
exit;
try
RaiseOnFigure := TConnectorObject(GPopupFigure);
except
RaiseOnFigure := nil;
end;
// îïðåäåëèòü òèï ñ-ï
RaiseConn := GetRaiseConn(RaiseOnFigure);
if RaiseConn <> nil then
begin
if RaiseOnFigure.ConnectorType = ct_Clear then
begin
// *UNDO*
if RaiseConn.FConnRaiseType = crt_OnFloor then
GCadForm.SaveForUndo(uat_None, True, False)
else
begin
vLists := TList.Create;
vLists.Add(GCadForm);
vList := GetListByID(RaiseConn.FID_ListToPassage);
if vList <> nil then
vLists.Add(vList);
SaveForProjectUndo(vLists, True, False);
end;
DestroyRaiseOnConnector(RaiseOnFigure);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
begin
// *UNDO*
if RaiseConn.FConnRaiseType = crt_OnFloor then
GCadForm.SaveForUndo(uat_None, True, False)
else
begin
vLists := TList.Create;
vLists.Add(GCadForm);
vList := GetListByID(RaiseConn.FID_ListToPassage);
if vList <> nil then
vLists.Add(vList);
SaveForProjectUndo(vLists, True, False);
end;
DestroyRaiseOnPointObject(RaiseOnFigure);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
// Tolik 09/02/2017 --
if vLists <> nil then
FreeAndNil(vLists);
//
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDestroyRaiseExecute', E.Message);
end;
//GCadForm.FCanSaveForUndo := SavedUndoFlag;
end;
// Tolik -- 31/05/2016 --
function GetFigureByCatalogId(CatalogId: Integer): TFigure;
var i: Integer;
begin
Result := nil;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
if TFigure(GCadForm.FSCSFigures[i]).ID = CatalogId then
begin
Result := TFigure(GCadForm.FSCSFigures[i]);
break;
end;
end;
end;
Procedure ConnectCableComponents(ACompon1, ACompon2: TSCSComponent);
var LineCatalog1, LineCatalog2 : TSCSCatalog;
SelfSide, JoinSide : integer;
Line1, Line2: TOrthoLine;
function CheckCanJoinOnConnectors(aConn1, aConn2: TConnectorObject): Boolean;
begin
Result := False;
// åñëè íà îäíîì òî÷å÷íîì
if (aConn1.JoinedConnectorsList.Count > 0) and
(TConnectorObject(aConn1.JoinedConnectorsList[0]).JoinedConnectorsList.IndexOf(aConn2) <> -1) then
Result := True
else
// èëè ýòî îäèí è òîò æå êîííåêòîð
if aConn1.ID = aConn2.ID then
Result := True;
end;
begin
LineCatalog1 := ACompon1.GetFirstParentCatalog;
LineCatalog2 := ACompon2.GetFirstParentCatalog;
if ((LineCatalog1 <> nil) and (LineCatalog2 <> nil)) then
begin
Line1 := TOrthoLine(GetFigureByCatalogId(LineCatalog1.SCSId));
Line2 := TOrthoLine(GetFigureByCatalogId(LineCatalog2.SCSId));
if ((Line1 <> nil) and (Line2 <> nil)) then
begin
SelfSide := 0;
JoinSide := 0;
if (ACompon1 <> nil) and (ACompon2 <> nil) then
begin
if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector1)) then
ACompon1.JoinTo(ACompon2, 1, 1)
else
if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector1), TConnectorObject(Line2.JoinConnector2)) then
ACompon1.JoinTo(ACompon2, 1, 2)
else
if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector1)) then
ACompon1.JoinTo(ACompon2, 2, 1)
else
if CheckCanJoinOnConnectors(TConnectorObject(Line1.JoinConnector2), TConnectorObject(Line2.JoinConnector2)) then
ACompon1.JoinTo(ACompon2, 2, 2);
end;
end;
end;
end;
//
// procedure TFSCS_Main.aRaiseLineExecute(Sender: TObject);
procedure TFSCS_Main.RaiseSelectedLine(aToHeight: double = -1);
var
i, j: integer;
RaiseHeight: Double;
RaiseLine: TOrthoLine;
FFigure: TFigure;
SelectedList: TList;
// Tolik 28/08/2019 --
//CurrTick, OldTick: Cardinal;
CurrTick, OldTick: DWord;
//
// Tolik
NB_Conn: TConnectorObject;
SavedTraceList, SavedLineList: TList;
SavedComponList: TList;
SavedLineConnectionsList: TList; // Ñïèñîê äèíåéíûõ ñîåäèíåíèé
SavedPointConnectionsList: TList; // Ñïèñîê ñîåäèíåííé ñ òî÷å÷íûìè îáúåêòàìè
SelfLineConnectInfo, JoinedLineConnectInfo: TLineComponConnectionInfo;
//
SavedLineComponList, SavedPointComponList, TempLineList: TList;
DivLineObject, JoinedPointObject: TSCSCatalog;
PointCompon: TSCSComponent;
NBConnector: TConnectorObject;
InterfRel : TSCSIOfIRel;
InterfPosition, JoinedPosition: TSCSInterfPosition;
LineCompon: TSCSComponent;
ALineInterFace, APointInterFace, aTempInterf: TSCSInterface;
LineInterfList: TList;
ConnComponList: TList;
AInterfPositions1, AInterfPositions2: TSCSInterfPositions;
LineComponInterFace, PointComponInterFace: TSCSInterFace;
InterFaceAccordanceList: TList;
APointInterfID: Integer;
ConnectedInterFaces: TSCSIOfIRel;
ConnectIDCompRel: Integer;
TempInterfaces1, TempInterfaces2: TSCSInterfaces;
InterfCount: Integer;
ptrConnection: PComplect;
DisJoinList: TList;
ComponToDeleteList: TSCSComponents;
SavedUndoFlag: Boolean; // 03/10/2016 -- Tolik
ProgressChecked: Boolean;
CanRefreshCadFlag: Boolean;
//
// 12/05/2016 -- áëîê çàïèñè/âîññòàíîâëåíèÿ êàáåëüíûõ ñîåäèíåíèé ïîñëå ïîäúåìà/ñïóñêà òðàññû íà âûñîòó
Procedure CheckSaveLineConnectionsBySide(aLine: TOrthoLine; aCableCompon: TSCSComponent; aSide: Integer);
var i, j, k: Integer;
InterfPos: TSCSInterfPosition;
Interf, ConnectedInterf: TSCSInterface;
DirectConnectedComponList, ConnectedComponList: TList;
JoinedCompon, ConnectedLineComponent: TSCSComponent;
PointToSave: TConnectorObject;
PointCatalog, LineCatalog, JoinedLineCatalog: TSCSCatalog;
POintFigure, LineFigure: TFigure;
CanContinue: Boolean;
WayList: TList;
// ComponToDeleteList: TSCSComponents;
LastComponent: TSCSComponent;
LastSide: Integer;
isLineConnection, isPointConnection: Boolean;
ComponJoinedByMultiInterface: TSCSComponent;
JoinedInterface: TSCSInterface;
FirstComponID: Integer;
SavedPointConnection: Boolean;
Procedure SaveConnectionOnPointObject(aPointObject: TConnectorObject; aPointCatalog: TSCSCatalog; aJoinedLineCompon: TSCSComponent; ConnectionSide: Integer);
var i, j, k, l, m: Integer;
PointJoinedLineCatalog : TSCSCatalog;
PointComponent, LineComponent: TSCSComponent;
LineJoinedComponList: TList;
LineInterface: TSCSInterface;
aCableComponInterface: TSCSInterface;
begin
NBConnector := APointObject;
if NBConnector <> nil then
begin
//JoinedPointObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(NBConnector.Id);
// DivLineObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ASnapLine.Id);
//DivLineObject := aJoinedLineCompon.GetFirstParentCatalog;
//if (aPointCatalog <> nil) and (DivLineObject <> nil) then
if (aPointCatalog <> nil) then
begin
//if ((aPointCatalog.ComponentReferences.Count > 0) and (DivLineObject.ComponentReferences.Count > 0)) then
begin
InterFaceAccordanceList := TList.Create;
//LineInterfList := TList.Create;
//for j := 0 to DivLineObject.ComponentReferences.Count - 1 do
//begin
//LineCompon := DivLineObject.ComponentReferences[j];
// 14/05/2016
// if LineCompon.ComponentType.SysName = ctsnCable then
if IsCableComponent(aJoinedLineCompon) then // òàê ïðàâèëüíåå -- äëÿ âñåõ êàáåëåé
//
begin
if CheckJoinedComponToComponFromObject(aJoinedLineCompon, aPointCatalog) then
begin
for k := 0 to aJoinedLineCompon.Interfaces.count - 1 do
begin
if (aJoinedLineCompon.Interfaces[k].TypeI = itFunctional) and (aJoinedLineCompon.Interfaces[k].Side = ConnectionSide) and
((aJoinedLineCompon.Interfaces[k].IsBusy = biTrue) or (aJoinedLineCompon.Interfaces[k].BusyPositions.Count > 0)) then
begin
SavedLineComponList := TList.Create;
SavedPointComponList := TList.Create;
ALineInterFace := TSCSInterFace(aJoinedLineCompon.Interfaces.Items[k]);
{
if SavedLineComponList.IndexOf(LineCompon.Interfaces.Items[k]) = -1 then
SavedLineComponList.Add(TSCSInterFace(LineCompon.Interfaces.Items[k]));}
if aCableCompon.Id = aJoinedLineCompon.id then
begin
if SavedLineComponList.IndexOf(ALineInterFace) = -1 then
SavedLineComponList.Add(TSCSInterface(ALineInterFace));
end
else
begin
aCableComponInterFace := aCableCompon.Interfaces[k];
if SavedLineComponList.IndexOf(aCableComponInterFace) = -1 then
SavedLineComponList.Add(TSCSInterface(aCableComponInterFace));
// aTempInterf := TSCSInterface(SavedLineComponList[l]);
end;
APointInterfID := -1;
for l := 0 to ALineInterFace.BusyPositions.Count - 1 do
begin
InterfPosition := ALineInterFace.BusyPositions[l];
JoinedPosition := InterfPosition.GetConnectedPos;
if JoinedPosition <> nil then
begin
if JoinedPosition.InterfOwner <> nil then
begin
if SavedPointComponList.IndexOf(JoinedPosition.InterfOwner) = -1 then
SavedPointComponList.Add(TSCSInterFace(JoinedPosition.InterfOwner));
end;
end;
end;
if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then
begin
InterFaceAccordanceList.Add(SavedLineComponList);
InterFaceAccordanceList.Add(SavedPointComponList);
end
else
begin
SavedLineComponList.Clear;
SavedPointComponList.Clear;
FreeAndNil(SavedLineComponList);
FreeAndNil(SavedPointComponList);
end;
end;
end;
end;
end;
//end;
end;
if InterFaceAccordanceList.Count > 0 then
begin
// ñîñòîÿíèå ñîåäèíåíèÿ êàáåëÿ íà òî÷å÷íîì îáúåêòå
SelfLineConnectInfo := TLineComponConnectionInfo.Create(True);
SelfLineConnectInfo.ComponId := aCableCompon.ID;//AJoinedLineCompon.ID;
//SelfLineConnectInfo.ComponSide := ConnectionSide;
SelfLineConnectInfo.ComponSide := aSide;
SelfLineConnectInfo.isLineConnection := False;
JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False);
JoinedLineConnectInfo.ComponCatalogID := APointCatalog.ID;
JoinedLineConnectInfo.ComponSide := 0;
// Tolik 09/02/2017 --
// JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList;
JoinedLineConnectInfo.ConnectedComponList := TList.Create;
JoinedLineConnectInfo.ConnectedComponList.Assign(InterFaceAccordanceList, LaCopy);
//
SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo);
SavedLineConnectionsList.Add(SelfLineConnectInfo);
FreeAndNil(InterFaceAccordanceList);
end
else
FreeAndNil(InterFaceAccordanceList);
end;
end;
// ñáðîñèòü ñîåäèíåíèÿ ëèíåéíîãî ñ òî÷å÷íûìè íà çàäàííîé ñòîðîíå
LineJoinedComponList := TList.Create;
for i := 0 to aJoinedLineCompon.Interfaces.Count - 1 do
begin
LineInterface := TSCSInterface(aJoinedLineCompon.Interfaces[i]);
if (LineInterface.TypeI = itFunctional) and (LineInterface.Side = ConnectionSide) then
begin
for j := 0 to LineInterface.ConnectedInterfaces.Count - 1 do
if LineJoinedComponList.IndexOf(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner)) = -1 then
LineJoinedComponList.Add(TSCSComponent(LineInterface.ConnectedInterfaces[j].ComponentOwner));
end;
end;
for i := 0 to LineJoinedComponList.Count - 1 do
begin
aJoinedLineCompon.DisJoinFrom(TSCSComponent(LineJoinedComponList[i]));
end;
FreeAndNil(LineJoinedComponList);
//
end;
function GetLastConnectedComponent(ALastCompon: TSCSComponent; SelfSide: integer): TSCSComponent;
var i, j, k: Integer;
//LineFigure: Tfigure;
LineCatalog: TSCSCatalog;
LastComponinterface: TSCSInterface;
InterfPos: TSCSInterfPosition;
LineFound, PointFound: Boolean;
ConnectedCompon: TSCSComponent;
LastLine: TOrthoLine;
SavedPosSide: Integer;
LastLineCompon: TSCSComponent;
JoinedPointObject: TConnectorObject;
JoinedPointCatalog: TSCSCatalog;
begin
Result := nil;
LineFound := False;
PointFound := False;
CanContinue := False;
LastLineCompon := ALastCompon;
LineCatalog := ALastCompon.GetFirstParentCatalog;
if LineCatalog <> nil then
begin
LastLine := TOrthoLine(GetFigureByCatalogId(LineCatalog.SCSID));
if LastLine <> nil then
begin
if (not LastLine.FIsVertical) and (not LastLine.FIsRaiseUpDown) then
begin
if ConnectedComponList.IndexOf(ALastCompon) = -1 then
ConnectedComponList.Add(ALastCompon)
else
exit;
Exit;
end;
end;
end;
for i := 0 to ALastCompon.Interfaces.Count - 1 do
begin
LastComponinterface := TSCSInterface(ALastCompon.Interfaces[i]);
if ((LastComponinterface.TypeI = itFunctional) and (LastComponinterface.Side <> SelfSide)) then
begin
if ((LastComponinterface.IsBusy = biTrue) or (LastComponinterface.BusyPositions.Count > 0)) then
begin
for j := 0 to LastComponinterface.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(LastComponinterface.BusyPositions[j]);
InterfPos := InterfPos.GetConnectedPos;
if InterfPos <> nil then
begin
ConnectedCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner);
if ConnectedCompon.IsLine = biTrue then
begin
LastLineCompon := ConnectedCompon;
if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then
begin
SavedPosSide := InterfPos.InterfOwner.Side; // ñòîðîíà ïîäêëþ÷åíèÿ
LineCatalog := ConnectedCompon.GetFirstParentCatalog;
if LineCatalog <> nil then
begin
LineFigure := GetFigureByCatalogId(LineCatalog.SCSID);
if LineFigure <> nil then
begin
if TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown then
begin
if ComponToDeleteList.IndexOf(ConnectedCompon) = -1 then
ComponToDeleteList.Add(ConnectedCompon);
if ConnectedComponlist.IndexOf(Connectedcompon) = -1 then
ConnectedComponList.Add(ConnectedCompon);
ALastCompon.DisJoinFrom(ConnectedCompon);
Result := GetLastConnectedComponent(ConnectedCompon, SavedPosSide);
if Result = Nil then
begin
if SavedPosSide = 1 then
LastSide := 2
else
if SavedPosSide = 2 then
LastSide := 1;
end;
end
else
// åñëè ñõîäèì ñ âåðòèêàëè -- ïðèåõàëè
begin
Result := ConnectedCompon;
//Result := nil;
// LineFigure := nil; // ñáðîñ äëÿ ìíîæåñòâåííûõ ïîäêëþ÷åíèé íà òîì æå óðîâíå ïðè íàëè÷èè ìóëüòèèíòåðôåéñà
if ConnectedComponList.IndexOf(ConnectedCompon) = -1 then
ConnectedComponList.Add(ConnectedCompon);
{if SavedPosSide = 1 then
LastSide := 2
else
if SavedPosSide = 2 then
LastSide := 1;}
LastSide := SavedPosSide;
exit;
end;
end;
end;
end;
end
else
begin
if ConnectedCompon.isLine = biFalse then
begin
SavedPosSide := LastComponInterface.Side;
LastSide := SavedPosSide;
JoinedPointCatalog := ConnectedCompon.GetFirstParentCatalog;
if JoinedPointCatalog <> nil then
begin
JoinedPointObject := TConnectorObject(GetFigureByCatalogId(JoinedPointCatalog.SCSID));
if JoinedPointObject <> nil then
begin
SaveConnectionOnPointObject(JoinedPointObject, JoinedPointCatalog, aLastCompon, LastSide);
SavedPointConnection := True;
isPointConnection := True;
end;
Result := nil;
Exit;
end;
end;
end;
end;
end;
end;
end;
end;
end;
begin
CanContinue := False;
SelfLineConnectInfo := nil;
JoinedLineConnectInfo := Nil;
ConnectedComponList := TList.Create;
PointToSave := nil;
isLineConnection := False;
isPointConnection := False;
LineFigure := Nil;
SavedPointConnection := False;
// ComponToDeleteList := TSCSComponents.Create(False);
if ((aCableCompon.JoinedComponents.count > 0) and (SavedComponList.IndexOf(aCableCompon) = -1)) then
SavedComponList.Add(ACablecompon);
for i := 0 to aCableCompon.Interfaces.Count - 1 do
begin
Interf := TSCSInterface(aCableCompon.Interfaces[i]);
// èùåì âîçìîæíûå ïîäêëþ÷åíèÿ ñ óêàçàííîé ñòîðîíû
if ((Interf.Side = aSide) and (Interf.TypeI = itFunctional) and
((Interf.IsBusy = biTrue) or (interf.BusyPositions.Count > 0))) then
begin
for j := 0 to Interf.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]); // çàíÿòàÿ ïîçèöèÿ èíòåðôåéñà
InterfPos := InterfPos.GetConnectedPos; // ïîäêëþ÷åííàÿ ê íåé íåïîñðåäñòâåííî ïîçèöèÿ èíòåðôåéñà
// ïðèñîåäèíåííîãî êîìïîíåíòà
JoinedCompon := InterfPos.InterfOwner.ComponentOwner; // ïðèñîåäèíåííûé êîìïîíåíò
if JoinedCompon <> nil then
begin
// ïîäêëþ÷åí òî÷å÷íûé êîìïîíåíò
if JoinedCompon.IsLine = biFalse then
begin
// òî÷å÷íîå ñîåäèíåíèå -- ñîõðàíèòü ïî ïîçèöèÿì äëÿ âîññòàíîâëåíèÿ
if ConnectedComponList.IndexOf(JoinedCompon) = -1 then
ConnectedComponList.Add(JoinedCompon);
if PointToSave = nil then
begin
PointCatalog := JoinedCompon.GetFirstParentCatalog;
PointToSave := TConnectorObject(GetFigurebyCatalogID(PointCatalog.SCSID));
// íàøëè òî÷å÷íûé, ïðèñîåäèíåííûé ê êàáåëþ -- ñîõðàíÿåì ñîåäèíåíèå è âûâàëèâàåìñÿ
if ((PointToSave <> nil) and (CheckFigureByClassName(PointToSave, cTConnectorObject))) then
begin
SaveConnectionOnPointObject(PointtoSave, PointCatalog, aCableCompon, aSide);
ConnectedComponList.Free;
exit; //// BREAK ////;
end;
end;
end
// ïîäêëþ÷åí ëèíåéíûé êîìïîíåíò
// ëèíåéíûå ïîèíòåðôåéñíî ñîåäèíÿòü íå íóæíî, ïðîñòî ñîåäèíèòü êàáåëü
else
if JoinedCompon.isLine = biTrue then
begin
if ConnectedComponlist.IndexOf(JoinedCompon) = -1 then
begin
ConnectedComponList.Add(JoinedCompon);
isLineConnection := True;
LastSide := InterfPos.InterfOwner.Side; // ñòîðîíà ïîäëþ÷åíèÿ ïîäêëþ÷åííîãî êàáåëÿ ê òåêóùåìó
//åñëè ïîäêëþ÷åí ëèíåéíûé - èùåì êîíå÷íóþ òî÷êó âîññòàíîâëåíèÿ
JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog;
if JoinedLineCatalog <> nil then
begin
LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID);
if LineFigure <> nil then
begin
if (TOrthoLine(LineFigure).FIsVertical or TOrthoLine(LineFigure).FIsRaiseUpDown) then
begin
// ñïèñîê íà óäàëåíèå
if (ComponToDeleteList.IndexOf(JoinedCompon) = -1) then
ComponToDeleteList.Add(JoinedCompon);
// ïîëó÷èòü ïîñëåäíèé êóñîê êàáåëÿ
aCableCompon.DisJoinFrom(JoinedCompon);
JoinedCompon := GetLastConnectedComponent(JoinedCompon, LastSide);
end;
// åñëè ïîñëåäíÿÿ ôèãóðà -- âåðòèêàëü è äàëüøå îáðûâ
if (JoinedCompon = nil) and (not SavedPointConnection) then
begin
if ConnectedComponList.Count > 0 then
begin
JoinedCOmpon := TSCSComponent(ConnectedComponList[ConnectedComponList.Count - 1]);
JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog;
LineFigure := GetFigureByCatalogId(JoinedLineCatalog.SCSID);
end;
end;
end;
end;
// åñëè ñîåäèíåíèå - ëèíåéíîå - ñîõðàíèòü åãî
if (LineFigure <> nil) and (not SavedPointConnection) then
begin
// êàáåëü ïîäíèìàåìîé òðàññû
SelfLineConnectInfo := TLineComponConnectionInfo.Create(True);
SelfLineConnectInfo.ComponId := aCableCompon.ID;
SelfLineConnectInfo.ComponSide := aSide;
// òðàññà è ñòîðîíà ñîåäèíåíèÿ
JoinedLineConnectInfo:= TLineComponConnectionInfo.Create(False);
JoinedLineConnectInfo.ComponId := JoinedCompon.ID;
if TOrthoLine(LineFigure).FIsVertical then
begin
if LastSide = 1 then
LastSide := 2
else
if LastSide = 2 then
LastSide := 1;
end;
JoinedLineConnectInfo.ComponSide := LastSide;
JoinedLineCatalog := JoinedCompon.GetFirstParentCatalog;
if JoinedLineCatalog <> nil then
JoinedLineConnectInfo.ComponCatalogID := JoinedLineCatalog.ID;
SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo);
SavedLineConnectionsList.Add(SelfLineConnectInfo);
//îòêëþ÷èòü íàéäåííûé êàáåëü íàõ
if aCableCompon.JoinedComponents.IndexOF(JoinedCompon) <> -1 then
aCableCompon.DisJoinFrom(JoinedCompon);
end;
end;
end;
end;
if isLineConnection then
Break; //// BREAK ////
if isPointConnection then
Break; //// BREAK ////;
end;
end;
if isLineConnection then
Break; //// BREAK ////
if isPointConnection then
Break; //// BREAK ////;
end;
// åñëè ìóëüòèèíòåðôåéñ - îòêëþ÷èòü âñå ïîäêëþ÷åííûå íà íåì( îñòàëüíûå êàáåëè)
// è çàãíàòü èõ â ñïèñîê ïîäêëþ÷åííûõ êîìïîíåíò äëÿ âîññòàíîâëåíèÿ,
if aCableCompon.JoinedComponents.Count > 0 then
begin
for i := 0 to aCableCompon.Interfaces.count - 1 do
begin
Interf := TSCSInterface(aCableCompon.Interfaces[i]);
if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide) and (Interf.Multiple = biTrue) and
(Interf.ConnectedInterfaces.Count > 1)) then
begin
if aCableCompon.JoinedComponents.Count > 0 then
begin
While Interf.ConnectedInterfaces.Count > 0 do
begin
JoinedInterface := TSCSInterface(Interf.ConnectedInterfaces[0]);
ComponJoinedByMultiInterface := JoinedInterface.ComponentOwner;
if ComponJoinedByMultiInterface <> nil then
begin
if (ComponJoinedByMultiInterface.IsLine = biTrue) then
begin
ConnectedComponList.Add(ComponJoinedByMultiInterface);
// åñëè áûëî ñîõðàíåíèå ëèíåéíîãî ñîåäèíåíèÿ -- äîáàâèòü â ñïèñîê ñîõðàíåíèÿ ïîäêëþ÷åííûé êàáåëü
if SelfLineConnectInfo <> nil then
begin
FirstComponID := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]).ComponId; // íà âñÿêèé
if ComponJoinedByMultiInterface.ID <> FirstComponID then
begin
JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False);
JoinedLineConnectInfo.ComponId := ComponJoinedByMultiInterface.ID;
JoinedLineConnectInfo.ComponSide := JoinedInterface.Side;
SelfLineConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo);
end;
end;
end;
// îòêëþ÷èòü (åñëè óæå åñòü â ñïèñêå èëè òî÷å÷íûé êîìïîíåíò)
aCableCompon.DisJoinFrom(ComponJoinedByMultiInterface);
end;
end;
end;
end;
end;
end;
// óäàëèòü êàáåëü ïî ïóòè ïðîõîæäåíèÿ
{if ComponToDeleteList.Count > 0 then
begin
F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil);
ComponToDeleteList.Clear;
end; }
//FreeAndNil(ComponToDeleteList);
ConnectedComponList.Clear;
FreeAndNil(ConnectedcomponList);
GCadForm.PCad.Refresh;
end;
Procedure SaveLineConnections(aLine: TOrthoLine);
var i, j, k: Integer;
LineCatalog: TSCSCatalog;
SCSCompon: TSCSComponent;
CanSaveThisTrace: Boolean;
CanMoveLineConnector1, CanMoveLineConnector2: Boolean;
JoinedLine: TOrthoLine;
CanSaveLineConnector1, CanSaveLineConnector2: Boolean;
function CheckCanSaveOnLineConnector(aConn: TConnectorObject): Boolean;
var i,j : Integer;
NextRaiseConn: TConnectorObject;
VLine1, VLine2, ConnRaiseLine: TOrthoLine;
VLineConn1, VLineConn2 : TConnectorObject;
DirectionUP, DirectionDown: boolean;
begin
Result := True;
DirectionUP := False;
DirectionDown := False;
VLineConn1 := Nil;
VLineConn2 := Nil;
if aConn = nil then
begin
Result := False;
Exit;
end;
if aConn.Deleted then
begin
Result := False;
exit;
end;
// åñëè êîííåêòîð - íà óêàçàííîé âûñîòå -- âûõîäèì íàõ
if Comparevalue(aConn.ActualZOrder[1], RaiseHeight) = 0 then
begin
Result := False;
Exit;
end;
// Tolik -- 17/11/2016 --
// íà êîííåêòîðàõ ìàãèñòðàëåé è ìåæýòàæåê òîæå çàïèñûâàòü íå áóäåì (òàì êîííåêòîð äâèíåòñÿ êàê åñòü)
if (aConn.FConnRaiseType = crt_BetweenFloorUp) or (aConn.FConnRaiseType = crt_BetweenFloorDown) or
(aConn.FConnRaiseType = crt_TrunkUp) or (aConn.FConnRaiseType = crt_TrunkDown) then
begin
Result := False;
exit;
end
//Tolik 05/12/2016-- ìîæåò áûòü íà âòîðîì êîíåêòîðå
else
if aConn.FConnRaiseType = crt_none then
begin
NextRaiseConn := nil;
for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
if TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector1).ID = aConn.ID then
NextRaiseConn := TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector2)
else
if TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector2).ID = aConn.ID then
NextRaiseConn := TConnectorObject(TOrthoLine(aConn.JoinedOrtholinesList[i]).JoinConnector1)
end;
if NextRaiseConn <> nil then
break;
end;
if NextRaiseConn <> nil then
begin
if (NextRaiseConn.FConnRaiseType = crt_BetweenFloorUp) or (NextRaiseConn.FConnRaiseType = crt_BetweenFloorDown) or
(NextRaiseConn.FConnRaiseType = crt_TrunkUp) or (NextRaiseConn.FConnRaiseType = crt_TrunkDown) then
begin
Result := False;
exit;
end
end;
end;
//
ConnRaiseLine := Nil;
VLine1 := nil;
VLine2 := Nil;
NextRaiseConn := Nil;
// åñëè òðàññà ïðèñîåäèíåíà ê òî÷å÷íîìó îáúåêòó -- íàõ
if aConn.JoinedConnectorsList.Count > 0 then
exit;
// åñëè äâèãàåì íå âñå òðàññû êîííåêòîðà - íàõ
for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
ConnRaiseLine := TOrthoLine(AConn.JoinedOrtholinesList[i]);
if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsVertical then
begin
if VLine1 = Nil then
VLine1 := TOrthoLine(AConn.JoinedOrtholinesList[i])
else
begin
if TOrthoLine(AConn.JoinedOrtholinesList[i]).ID <> VLine1.Id then
VLine2 := TOrthoLine(AConn.JoinedOrtholinesList[i]);
end;
end;
// åñëè íå äâèãàåì õîòü îäíó òðàññó -- íàõ (íóæíî çàïèñàòü ñîåäèíåíèå)
if (not TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown) and
(not TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsVertical) and
(SelectedList.IndexOf(TOrthoLine(AConn.JoinedOrtholinesList[i])) = -1) then
Exit;
end;
//åñòü ëè ðàéç
if ConnRaiseLine <> nil then
begin
NextRaiseConn := Nil;
if TConnectorObject(ConnRaiseLine.JoinConnector1).ID <> aConn.ID then
NextRaiseConn := TConnectorObject(ConnRaiseLine.JoinConnector1)
else
if TConnectorObject(ConnRaiseLine.JoinConnector2).ID <> aConn.ID then
NextRaiseConn := TConnectorObject(ConnRaiseLine.JoinConnector2);
if NextRaiseConn <> nil then
begin
// ïèøåì, åñëè ïîïàäåì íà âòîðîé êîííåêòîð ðàéçà
if CompareValue(NextRaiseConn.ActualZOrder[1],RaiseHeight) = 0 then
Exit;
end;
end;
{for i := 0 to AConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(AConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
if TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector1).ID <> aConn.ID then
NextRaiseConn := TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector1)
else
if TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector2).ID <> aConn.ID then
NextRaiseConn := TConnectorObject(TOrthoLine(AConn.JoinedOrtholinesList[i]).JoinConnector2);
if NextRaiseConn <> nil then
begin
//åñëè íå ïîïàäåì íà âåðøèíó ðàéçà - íå ïèøåì
if CompareValue(NextRaiseConn.ActualZOrder[1], RaiseHeight) <> 0 then
Result := False;
end;
Exit; // åñëè åñòü ðàéç -- âåðòèêàëåé íå áóäåò
end;
end;}
if Result then
begin
// íåò íè ðàéçà íè âåðòèêàëè è âñå òðàññû ñäâèãàþòñÿ â äàííîé òî÷êå îäíîâðåìåííî
if (ConnRaiseLine = nil) and (VLine1 = nil) then
Result := False
else
// åñòü âåðòèêàëü (èëè äâå)
if (ConnRaiseLine = nil) and (VLine1 <> nil) then
begin
// íàïðàâëåíèå ñäâèãà
if CompareValue(aConn.ActualZOrder[1], RaiseHeight) = -1 then
DirectionUP := True
else
if CompareValue(aConn.ActualZOrder[1], RaiseHeight) = 1 then
DirectionDown := True;
// åñëè âåðòèêàëü -- îäíà, ñìîòðèì, íå ïîïàäåì ëè íà êîííåêòîð âåðòèêàëè
if VLine2 = nil then
begin
// íå ïîïàäåì íà êîííåêòîð
if (CompareValue(TConnectorObject(VLine1.JoinConnector1).ActualZOrder[1], RaiseHeight) <> 0) and
(CompareValue(TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1], RaiseHeight) <> 0) then
begin
// ïðîâåðèòü ïîïàäàíèå íà âåðòèêàëü ÷åðåç êîííåêòîð
if DirectionUP then
begin
VLineConn1 := TConnectorObject(VLine1.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then
VLineConn1 := TConnectorObject(VLine1.JoinConnector2);
if VLineConn1.JoinedConnectorsList.Count > 0 then
VLineConn1 := TConnectorObject(VLineConn1.JoinedConnectorsList[0]);
if VLineConn1.ConnectorType = ct_Clear then
begin
for i := 0 to VLineConn1.JoinedOrthoLinesList.Count - 1 do
begin
if (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).FisVertical and
(TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).Id <> VLine1.Id)) then
exit;
end;
end
else
begin
for i := 0 to VLineConn1.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and
(TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> VLine1.Id) then
;
end;
end;
end;
end
else
if DirectionDown then
begin
VLineConn1 := TConnectorObject(VLine1.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then
VLineConn1 := TConnectorObject(VLine1.JoinConnector2);
if VLineConn1.JoinedConnectorsList.Count > 0 then
VLineConn1 := TConnectorObject(VLineConn1.JoinedConnectorsList[0]);
if VLineConn1.ConnectorType = ct_Clear then
begin
for i := 0 to VLineConn1.JoinedOrthoLinesList.Count - 1 do
begin
if (TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).FisVertical and
(TOrthoLine(VLineConn1.JoinedOrthoLinesList[i]).Id <> VLine1.Id)) then
exit;
end;
end
else
begin
for i := 0 to VLineConn1.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical and
(TOrthoLine(TConnectorObject(VLineConn1.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).ID <> VLine1.Id) then
Exit;
end;
end;
end;
end;
// íå ïîïàëè íà âåðòèêàëü (ïåðåâîðîò âåðòèêàëè)
for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do
begin
if (not TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown) and
(not TOrthoLine(aConn.JoinedOrtholinesList[i]).FIsVertical) and
(SelectedList.IndexOf(TOrthoLine(aConn.JoinedOrtholinesList[i])) = -1) then
Exit;
end;
Result := False;
exit;
end
else
// íà êîííåêòîð
begin
exit;
end;
end
else
// åñëè 2 âåðòèêàëè - ñìîòðèì, ïîïàäåì ëè íà êîííåêòîð âåðòèêàëè èëè ìîæåì ëè ìû â ðåçóëüòàòå
// ïåðåìåùåíèÿ åãî ïåðåïðûãíóòü (åñëè íåò - ïèñàòü òîæå íè÷åãî íå íóæíî)
begin
if DirectionUP then
begin
//áåðåì ñàìûé âåðõíèé êîííåêòîð
VLineConn1 := TConnectorObject(VLine1.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = -1 then
VLineConn1 := TConnectorObject(VLine1.JoinConnector2);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = -1 then
VLineConn1 := TConnectorObject(VLine2.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = -1 then
VLineConn1 := TConnectorObject(VLine2.JoinConnector2);
// åñëè íå äîòÿãèâàåì äî íåãî -- ïèñàòü íå íóæíî
if CompareValue(VLineConn1.ActualZOrder[1], RaiseHeight) = 1 then
begin
Result := False;
exit;
end;
end
else
if DirectionDown then
begin
//áåðåì ñàìûé íèæíèé êîííåêòîð
VLineConn1 := TConnectorObject(VLine1.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine1.JoinConnector2).ActualZOrder[1]) = 1 then
VLineConn1 := TConnectorObject(VLine1.JoinConnector2);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector1).ActualZOrder[1]) = 1 then
VLineConn1 := TConnectorObject(VLine2.JoinConnector1);
if CompareValue(VLineConn1.ActualZOrder[1], TConnectorObject(VLine2.JoinConnector2).ActualZOrder[1]) = 1 then
VLineConn1 := TConnectorObject(VLine2.JoinConnector2);
// åñëè íå äîòÿãèâàåì äî íåãî -- ïèñàòü íå íóæíî
if CompareValue(VLineConn1.ActualZOrder[1], RaiseHeight) = -1 then
begin
Result := False;
exit;
end;
end;
end;
end;
end;
end;
begin
if aLine <> nil then
begin
CanMoveLineConnector1 := False;
CanMoveLineConnector2 := False;
CanSaveLineConnector1 := False;
CanSaveLineConnector2 := False;
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð2
if ((aLine.JoinConnector1 <> nil) and
(CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], RaiseHeight) <> 0)) then
CanMoveLineConnector1 := True;
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð2
if ((aLine.JoinConnector2 <> nil) and
(CompareValue(TConnectorObject(aLine.JoinConnector2).ActualZOrder[1], RaiseHeight) <> 0)) then
CanMoveLineConnector2 := True;
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aLine.ID);
if LineCatalog <> nil then
begin
CanSaveThisTrace := False;
// åñòü ëè êàáåëü è íóæíî ëè ñîõðàíÿòü êàáåëüíûå ñîåäèíåíèÿ
if LineCatalog.ComponentReferences.Count > 0 then
begin
for i := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[i]);
if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then
begin
CanSaveThisTrace := True;
// åñëè åñòü êàáåëü è ñîåäèíåíèÿ íóæíî ñîõðàíÿòü -- äîáàâèòü òðàññó â ñïèñîê äëÿ ïîñëåäóþùåãî âîññòàíîâëåíèÿ
SavedTraceList.Add(aLine);
if SavedLineList.IndexOf(aLine) = -1 then
SavedLineList.Add(aLine);
Break; //// BREAK ////
end;
end;
if CanSaveThisTrace then
begin
if SavedTraceList.IndexOf(LineCatalog) = -1 then
SavedTraceList.Add(LineCatalog);
if CanMoveLineConnector1 then
CanSaveLineConnector1 := CheckCanSaveOnLineConnector(TConnectorObject(aLine.JoinConnector1));
if CanMoveLineConnector2 then
CanSaveLineConnector2 := CheckCanSaveOnLineConnector(TConnectorObject(aLine.JoinConnector2));
for i := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[i]);
if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then
begin
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð1 - ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ äî ...
if (CanMoveLineConnector1 and CanSaveLineConnector1) then
begin
CheckSaveLineConnectionsBySide(aLine, SCSCompon, 1);
end;
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð2 - ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ äî ...
if (CanMoveLineConnector2 and CanSaveLineConnector2) then
begin
CheckSaveLineConnectionsBySide(aLine, SCSCompon, 2);
end;
end;
end;
end;
end;
end;
// ñîõðàíèòü îñòàëüíûå ñîåäèíåíèÿ íà êîííåêòîðå
{ if CanMoveLineConnector1 then
begin
for i := 0 to TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TConnectorObject(aLine.JoinConnector1).JoinedOrtholinesList[i]);
if ((not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.FIsVertical) and (JoinedLine.ID <> aLine.Id) and
(SelectedList.IndexOf(JoinedLine) <> - 1)) then
begin
CanSaveThisTrace := False;
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID);
if LineCatalog <> nil then
begin
// åñòü ëè êàáåëü è íóæíî ëè ñîõðàíÿòü êàáåëüíûå ñîåäèíåíèÿ
if LineCatalog.ComponentReferences.Count > 0 then
begin
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]);
if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then
begin
CanSaveThisTrace := True;
// åñëè åñòü êàáåëü è ñîåäèíåíèÿ íóæíî ñîõðàíÿòü -- äîáàâèòü òðàññó â ñïèñîê äëÿ ïîñëåäóþùåãî âîññòàíîâëåíèÿ
if SavedTraceList.IndexOf(JoinedLine) = -1 then
SavedTraceList.Add(JoinedLine);
Break; //// BREAK ////
end;
end;
end;
if CanSaveThisTrace then
begin
if SavedLineList.IndexOf(JoinedLine) = -1 then
SavedLineList.Add(JoinedLine);
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]);
if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then
begin
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð1 - ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ äî ...
if TConnectorObject(JoinedLine.JoinConnector1).Id = TConnectorObject(aLine.JoinConnector1).ID then
CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 1)
else
if TConnectorObject(JoinedLine.JoinConnector2).Id = TConnectorObject(aLine.JoinConnector1).ID then
CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 2);
end;
end;
end;
end;
end;
end;
end;
if CanMoveLineConnector2 then
begin
for i := 0 to TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TConnectorObject(aLine.JoinConnector2).JoinedOrtholinesList[i]);
if ((not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.FIsVertical) and (JoinedLine.ID <> aLine.Id) and
(SelectedList.IndexOf(JoinedLine) <> - 1)) then
begin
CanSaveThisTrace := False;
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID);
if LineCatalog <> nil then
begin
// åñòü ëè êàáåëü è íóæíî ëè ñîõðàíÿòü êàáåëüíûå ñîåäèíåíèÿ
if LineCatalog.ComponentReferences.Count > 0 then
begin
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]);
if (IsCableComponent(SCSCompon) and (SCScompon.JoinedComponents.Count > 0)) then
begin
CanSaveThisTrace := True;
// åñëè åñòü êàáåëü è ñîåäèíåíèÿ íóæíî ñîõðàíÿòü -- äîáàâèòü òðàññó â ñïèñîê äëÿ ïîñëåäóþùåãî âîññòàíîâëåíèÿ
if SavedTraceList.IndexOf(JoinedLine) = -1 then
SavedTraceList.Add(JoinedLine);
if SavedLineList.IndexOf(JoinedLine) = -1 then
SavedLineList.Add(JoinedLine);
Break; //// BREAK ////
end;
end;
end;
if CanSaveThisTrace then
begin
if SavedTraceList.IndexOf(LineCatalog) = -1 then
SavedTraceList.Add(LineCatalog);
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
SCSCompon := TSCSComponent(LineCatalog.ComponentReferences[j]);
if (IsCableComponent(SCSCompon) and (SCSCompon.JoinedComponents.Count > 0)) then
begin
// åñëè áóäåì ïîäíèìàòü/îïóñêàòü êîííåêòîð1 - ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ äî ...
if TConnectorObject(JoinedLine.JoinConnector1).Id = TConnectorObject(aLine.JoinConnector2).ID then
CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 1)
else
if TConnectorObject(JoinedLine.JoinConnector2).Id = TConnectorObject(aLine.JoinConnector2).ID then
CheckSaveLineConnectionsBySide(JoinedLine, SCSCompon, 2);
end;
end;
end;
end;
end;
end;
end;
}
end;
end;
Procedure CheckDisJoinLineComponBySide(aLineCompon: TSCSComponent; ASide: Integer);
var i, j: Integer;
Interf: TSCSInterface;
InterfPos: TSCSInterfPosition;
JoinedComponList: TList;
begin
JoinedComponList := TList.Create;
for i := 0 to aLineCompon.Interfaces.Count - 1 do
begin
Interf := TSCSInterface(aLineCompon.Interfaces[i]);
if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide)) then
begin
for j := 0 to Interf.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]);
InterfPos := InterfPos.GetConnectedPos;
if InterfPos <> nil then
begin
if JoinedComponList.IndexOf(InterfPos.InterfOwner.ComponentOwner) = -1 then
JoinedComponList.Add(InterfPos.InterfOwner.ComponentOwner);
end;
end;
end;
end;
for i := 0 to JoinedComponList.Count - 1 do
aLineCompon.DisJoinFrom(TSCSComponent(JoinedComponList[i]));
FreeAndNil(JoinedComponList);
end;
Procedure RestoreLineConnectionsBySide(aLine: TOrthoLine; ACableCompon: TSCSComponent; aSide: Integer);
var i, j, k, l, m: Integer;
TargetLine, TargetPointFigure: TFigure;
WayList: TList;
SelfConnector, TargetConn: TConnectorObject;
TargetCatalog: TSCSCatalog;
IdNewCompon: Integer;
TargetCompon, NewCompon, FirstCompon, NextCompon: TSCSComponent;
PassWayList: Boolean; // ïðîêëàäûâàòü êàáåëü íà âåðòèêàëè/ðàéçû
ComponJoinedByMultiInterFace: TSCSComponent;
CanRestoreConnection: Boolean;
DisJoinSide: Integer;
DisJoinComponList: TList;
SideConnectionDropped: Boolean;
Function GetInterfaceForConnection(AInterf: TSCSInterFace; WasConnectedCable, isConnectedCable: TSCSComponent; aPointObject: TConnectorObject): TSCSInterFace;
var i, j, k: Integer;
LineCompon: TSCSComponent;
LineFigure: TOrthoLine;
LineCatalog: TSCSCatalog;
SourceLineCatalog, DestLineCatalog: TSCSCatalog;
ConnectionSide : Integer;
TmpInterfPos: TSCSInterfPosition;
begin
Result := nil;
LineCatalog := Nil;
ConnectionSide := 0;
LineCompon := isConnectedCable;//AInterf.ComponentOwner;
if LineCompon <> nil then
begin
LineCatalog := LineCompon.GetFirstParentCatalog;
if LineCatalog <> nil then
begin
LineFigure := TOrthoLine(GetFigurebyCatalogID(LineCatalog.SCSID));
if LineFigure <> nil then
begin
if (TConnectorObject(LineFigure.JoinConnector1).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or
(TConnectorObject(LineFigure.JoinConnector1).ID = aPointObject.ID) then
ConnectionSide := 1
else
if (TConnectorObject(LineFigure.JoinConnector2).JoinedConnectorsList.IndexOf(aPointObject) <> -1) or
(TConnectorObject(LineFigure.JoinConnector2).ID = aPointObject.ID) then
ConnectionSide := 2;
for j := 0 to LineCompon.Interfaces.Count - 1 do
begin
if TSCSInterface(LineCompon.Interfaces[j]).TypeI = itFunctional then
if TSCSInterface(LineCompon.Interfaces[j]).Npp = AInterf.Npp then
// âòîðàÿ ñòîðîíà èäèí õ çàíÿòà óæå ...(åñëè íå îáðûâ êàáåëÿ)
if TSCSInterface(LineCompon.Interfaces[j]).Side = ConnectionSide then
if ((TSCSInterface(LineCompon.Interfaces[j]).IsBusy = biFalse) or
(TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count = 0)) then
begin
Result := TSCSInterface(LineCompon.Interfaces[j]);
break;
end;
end;
end;
end;
{SourceLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(ALine.ID);
if SourceLineCatalog <> nil then
begin
for i := 0 to SourceLineCatalog.ComponentReferences.Count - 1 do
begin
if (TSCSComponent(SourceLineCatalog.ComponentReferences[i]).ID = LineCompon.ID) then
begin
DestLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(AddLine.ID);
if DestLineCatalog <> nil then
begin
if i <= (DestLineCatalog.ComponentReferences.Count - 1) then
begin
LineCompon := DestLineCatalog.ComponentReferences[i];
if LineCompon <> nil then
begin
// Difining ConnectionSide
{ for j := 0 to LineCompon.Interfaces.Count - 1 do
begin
ConnectionSide := 2;
if TSCSInterface(LineCompon.Interfaces[j]).TypeI = itFunctional then
if TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count > 0 then
begin
for k := 0 to TSCSInterface(LineCompon.Interfaces[j]).BusyPositions.Count - 1 do
begin
TmpInterfPos := TSCSInterface(LineCompon.Interfaces[j]).BusyPositions[k];
TmpInterfPos := TmpInterfPos.GetConnectedPos;
if TSCSComponent(TmpInterfPos.InterfOwner.ComponentOwner).IsLine = biTrue then
begin
if TmpInterfPos.InterfOwner.Side = 2 then
ConnectionSide := 1;
break;
end;
end;
end;
end;}
{ end;
end;
end;
Break; //// BREAK ////;
end;
end;
end; }
end;
end;
Function DefineIDComponRel(ALineCompon, APointCompon: TSCSComponent): Integer;
var
TopCatalog: TSCSCatalog;
begin
Result := -1;
begin
TopCatalog := aLineCompon.GetTopParentCatalog;
if TopCatalog <> nil then
if TopCatalog is TSCSProject then
Result := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1);
end;
//if IDComponRel = -1 then
//IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType);
end;
begin
WayList := nil;
SelfLineConnectInfo := Nil;
SelfConnector := nil;
TargetConn := Nil;
PassWayList := True;
DisJoinComponList := nil;
CanRestoreConnection := True;
SideConnectionDropped := False;
While CanRestoreconnection do
begin
CanRestoreConnection := False;
for i := 0 to SavedLineConnectionsList.Count - 1 do
begin
if ((TLineComponConnectionInfo(SavedLineConnectionsList[i]).ComponId = ACableCompon.ID) and
(TLineComponConnectionInfo(SavedLineConnectionsList[i]).ComponSide = aSide)) then
begin
SelfLineConnectInfo := TLineComponConnectionInfo(SavedLineConnectionsList[i]);
CanRestoreConnection := True;
Break; //// BREAK ////;
end;
end;
if SelfLineConnectInfo <> nil then
begin
if not SideConnectionDropped then
begin
CheckDisJoinLineComponBySide(ACableCompon, aSide);
SideConnectionDropped := True;
end;
if SelfLineConnectInfo.ComponSide = 1 then
SelfConnector := TConnectorObject(aLine.JoinConnector1)
else
if SelfLineConnectInfo.ComponSide = 2 then
SelfConnector := TConnectorObject(aLine.JoinConnector2);
if SelfConnector <> nil then
begin
// for i := 0 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId);
JoinedLineConnectInfo := TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[0]);
TargetCompon := nil;
if SelfLineConnectInfo.isLineConnection then
TargetCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if FirstCompon <> nil then
begin
// ïðîèçîøëî ðàçäåëåíèå âåðòèêàëè
if TargetCompon = nil then
begin
TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(JoinedLineConnectInfo.ComponCatalogID);
end
else
if TargetCompon <> nil then
TargetCatalog := TargetCompon.GetFirstParentCatalog;
// ëèíåéíîå ñîåäèíåíèå (êàáåëü -- êàáåëü)
{ if TargetCompon.IsLine = biTrue then
begin
TargetCatalog := TargetCompon.GetFirstParentCatalog;}
if TargetCatalog <> nil then
begin
TargetLine := GetFigureByCatalogID(TargetCatalog.SCSID);
if TargetLine <> nil then
begin
TargetConn := Nil;
if CheckFigureByClassName(TargetLine, cTOrthoLine) then
begin
// ëèíåéíîíå ïîäêëþ÷åíèå
if JoinedLineConnectInfo.ComponSide = 1 then
TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector1)
else
if JoinedLineConnectInfo.ComponSide = 2 then
TargetConn := TConnectorObject(TOrthoLine(TargetLine).JoinConnector2);
end
else
if CheckFigureByClassName(TargetLine, CTConnectorObject) then
begin
// òî÷å÷íîå ïîäêëþ÷åíèå
TargetPointfigure := TargetLine;
if JoinedLineConnectInfo.ComponSide = 0 then
begin
TargetConn := TConnectorObject(TargetLine);
end;
end;
if TargetConn <> nil then
begin
// åñëè ïðîèçîøëî ðàçäåëåíèå âåðòèêàëè - íàéòè êîííåêòîð îò âûñîòû ïîäúåìà
WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetConn));
if WayList <> nil then
begin
// óäàëèòü íåâåðòèêàëè è íåðàéçû èç ïóòè
for j := (WayList.Count - 1) downto 0 do
begin
if CheckFigureByClassName(TFigure(WayList[j]), cTOrthoLine) then
begin
if ((not TOrthoLine(WayList[j]).FIsVertical) and (not TOrthoLine(WayList[j]).FIsRaiseUpDown)) then
WayList.Delete(j);
end
{else
WayList.Delete(j);}
end;
// ïðîêëàäêà êàáåëÿ (òîëüêî íà ðàéç èëè íà âåðòèêàëè)
for j := 0 to WayList.Count - 1 do
begin
TargetLine := TFigure(WayList[j]);
if CheckFigureByClassName(TargetLine, CTOrthoLine) then
begin
if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then
begin
TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID);
if TargetCatalog <> nil then
begin
NewCompon := Nil;
// âêèíóòü êàáåëü íà òðàññó
NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False);
// ðàññîåäèíèòü äîáàâëåííûé êàáåëü îò âñåãî, ê ÷åìó ïîäêëþ÷èëñÿ àâòîìàòîì
if NewCompon <> nil then
NewCompon.DisJoinFromAll(false).Free;
end;
end;
end;
end;
end;
end;
end;
// FirstCompon := TargetCompon;
// ñîåäèíèòü êàáåëè
if WayList <> nil then
begin
if WayList.Count > 0 then
begin
//FirstCompon := aCableCompon;
for j := 0 to WayList.count - 1 do
begin
TargetLine := TFigure(WayList[j]);
if CheckFigureByClassName(TargetLine, cTOrthoLine) then
begin
if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then
begin
TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID);
if TargetCatalog <> nil then
begin
NewCompon := TargetCatalog.LastAddedComponent;
if NewCompon <> nil then
begin
if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then
ConnectCableComponents(FirstCompon, NewCompon);
// åñëè íà ìóëüòèèíòåðôåéñå
if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then
begin
for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId);
if ComponJoinedByMultiInterFace <> nil then
begin
if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then
ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace);
end;
end;
end;
FirstCompon := NewCompon;
NewCompon := Nil;
end;
end;
end
else
begin
//NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if NewCompon <> nil then
begin
if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then
ConnectCableComponents(FirstCompon, NewCompon);
// åñëè íà ìóëüòèèíòåðôåéñå
if SelfLineConnectInfo.ConnectedComponList.Count > 1 then
begin
for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId);
if ComponJoinedByMultiInterFace <> nil then
begin
if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then
ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace);
end;
end;
end;
end;
break;
end;
end;
end;
// êîíå÷íîå ñîåäèíåíèå
//NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if SelfLineConnectInfo.isLineConnection then
begin
NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if ((NewCompon <> nil) and (FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1)) then
ConnectCableComponents(FirstCompon, NewCompon);
end
else
begin
if not SelfLineConnectInfo.isLineConnection then
begin
// Restore Connection
// âîññòàíîâèòü ñîñòîÿíèå ñîåäèíåíèÿ êàáåëÿ ñ òî÷å÷íûìè êîìïîíåíòàìè
NewCompon := FirstCompon;
// åñëè êîííåêòîð óïàë íà òî÷å÷íûé îáúåêò, òî êàáåëü ìîã àâòîìàòîì ñîåäèíèòüñÿ ñ
// êîìïîíåíòàìè òî÷å÷íîãî, ïîýòîìó íóæíî èõ ðàñêîííåêòèòü äî âîññòàíîâëåíèÿ ñîåäèíåíèÿ
TargetCatalog := NewCompon.GetFirstParentCatalog;
if TargetCatalog <> nil then
begin
TargetLine := GetFigureByCatalogId(TargetCatalog.SCSID);
if TargetLine <> nil then
begin
DisJoinSide := 0;
if TConnectorObject(TOrthoLine(TargetLine).JoinConnector1).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then
DisJoinSide := 1
else
if TConnectorObject(TOrthoLine(TargetLine).JoinConnector2).JoinedConnectorsList.IndexOf(TConnectorObject(TargetPointFigure)) <> -1 then
DisJoinSide := 2;
if DisJoinSide <> 0 then
begin
DisJoinComponList := TList.Create;
for i := 0 to NewCompon.Interfaces.Count - 1 do
begin
if (NewCompon.Interfaces[i].TypeI = itFunctional) and
(NewCompon.Interfaces[i].Side = DisJoinSide) then
begin
for j := 0 to NewCompon.Interfaces[i].ConnectedInterfaces.Count - 1 do
begin
if (TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner <> nil) and
(DisJoinComponList.IndexOf(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner) = -1) then
DisJoinComponList.Add(TSCSInterface(NewCompon.Interfaces[i].ConnectedInterfaces[j]).ComponentOwner);
end;
end;
end;
for i := 0 to DisJoinComponList.Count - 1 do
begin
NewCompon.DisJoinFrom(TSCSComponent(DisJoinComponList[i]));
end;
end;
FreeAndNil(DisJoinComponList);
end;
end;
FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId);
InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList;
if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then
begin
i := 0;
While (i <= (InterFaceAccordanceList.Count - 1)) do
begin
SavedLineComponList := TList(InterFaceAccordanceList[i]);
SavedPointComponList := TList(InterFaceAccordanceList[i + 1]);
for j := 0 to SavedLineComponList.Count - 1 do
begin
aTempInterf := TSCSInterface(SavedLineComponList[j]);
ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure));
if ALineInterFace <> nil then
begin
LineCompon := ALineInterFace.ComponentOwner;
for k := 0 to SavedPointComponList.Count - 1 do
begin
APointInterFace := TSCSInterface(SavedPointComponList[k]);
PointCompon := APointInterFace.ComponentOwner;
AInterfPositions1 := ALineInterFace.GetEmptyPositions;
AInterfPositions2 := APointInterFace.GetEmptyPositions;
// óðàâíÿòü êîëè÷åñòâî ïîçèöèé äëÿ ñîåäèíåíèÿ
if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then
begin
While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do
begin
l := AInterfPositions1.Positions.Count - 1;
AInterfPositions1.Positions.Delete(l);
end;
AInterfPositions1.DefineKolvo;
end
else
if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then
begin
While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do
begin
l := AInterfPositions2.Positions.Count - 1;
AInterfPositions2.Positions.Delete(l);
end;
AInterfPositions2.DefineKolvo;
end;
ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon);
// Äî òîãî êàê ñîåäèíèòü èíòåðôåéñû, íóæíî ñîåäèíèòü ñàìè êîìïîíåíòû
if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then;
FreeAndNil(TempInterfaces1);
FreeAndNil(TempInterfaces2);
end;
if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then
begin
ptrConnection := LineCompon.GetConnectionByConnected(PointCompon);
if ptrConnection <> nil then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
TempInterfaces1.Add(ALineInterFace);
TempInterfaces2.Add(APointInterFace);
InterfCount := AInterfPositions1.Kolvo;
if InterfCount > AInterfPositions2.Kolvo then
InterfCount := AInterfPositions2.Kolvo;
TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace,
InterfCount, InterfCount, ptrConnection.ID, cntUnion,
AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2);
TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1);
end;
end;
end;
end;
end;
SavedLineComponList.Clear;
SavedPointComponList.Clear;
FreeAndNil(SavedLineComponList);
FreeAndNil(SavedPointComponList);
Inc(i,2);
end;
end;
if InterFaceAccordanceList <> nil then
begin
InterFaceAccordanceList.clear;
FreeAndNil(InterFaceAccordanceList);
end;
end;
end;
end
else
begin
//NewCompon := aCableCompon;// F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if NewCompon <> nil then
if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then
ConnectCableComponents(FirstCompon, NewCompon);
// åñëè íà ìóëüòèèíòåðôåéñå
if SelfLineConnectInfo.ConnectedComponList.Count > 1 then
begin
for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId);
if ComponJoinedByMultiInterFace <> nil then
begin
if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then
ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace);
end;
end;
end;
end;
WayList.Clear;
FreeAndNil(WayList);
end
else
begin
// åñëè ñîåäèíåíèå ëèíåéíîå
if SelfLineConnectInfo.isLineConnection then
begin
// NewCompon := aCableCompon;//F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
NewCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(JoinedLineConnectInfo.ComponId);
if NewCompon <> nil then
if FirstCompon.JoinedComponents.IndexOf(NewCompon) = - 1 then
ConnectCableComponents(FirstCompon, NewCompon);
// åñëè íà ìóëüòèèíòåðôåéñå
if SelfLineConnectInfo.ConnectedComponList.Count > 1 then
begin
for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId);
if ComponJoinedByMultiInterFace <> nil then
begin
if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then
ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace);
end;
end;
end;
end
// åñëè êàáåëü áûë ïðèñîáà÷åí ê êîìïîíåíòàì òî÷å÷íîãî îáúåêòà - ñîåäèíèòü êàê áûëî
else
begin
end;
//
end;
end
else
begin
if not SelfLineConnectInfo.isLineConnection then
begin
TargetPointFigure := TConnectorObject(GetFigureByCatalogId(JoinedLineConnectInfo.ComponId));
if TargetPointFigure <> nil then
begin
// åñëè ÷èñòûé êîííåêòîð è íà íåì îáúåêò -- ïîëó÷èòü åãî
if (TConnectorObject(TargetPointFigure).ConnectorType = ct_clear) and
(TConnectorObject(TargetPointFigure).JoinedConnectorsList.Count > 0) then
TargetPointFigure := TFigure(TConnectorObject(TargetPointFigure).JoinedConnectorsList[0]);
WayList := GetAllTraceInCAD(TFigure(SelfConnector), TFigure(TargetPointFigure));
if WayList <> nil then
begin
// ïðîêëàäêà êàáåëÿ (òîëüêî íà ðàéç èëè íà âåðòèêàëè)
for j := 0 to WayList.Count - 1 do
begin
TargetLine := TFigure(WayList[j]);
if CheckFigureByClassName(TargetLine, CTOrthoLine) then
begin
if ((TOrthoLine(TargetLine).FIsVertical) or (TOrthoLine(TargetLine).FIsRaiseUpDown)) then
begin
TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID);
if TargetCatalog <> nil then
begin
NewCompon := Nil;
// âêèíóòü êàáåëü íà òðàññó
NewCompon := CopyComponentToPMSCSObject(ACableCompon, TargetCatalog, False);
// ðàññîåäèíèòü äîáàâëåííûé êàáåëü îò âñåãî, ê ÷åìó ïîäêëþ÷èëñÿ àâòîìàòîì
if NewCompon <> nil then
NewCompon.DisJoinFromAll(false).Free;
end;
end;
end;
end;
// âûïîëíèòü êàáåëüíîå ñîåäèíåíèå ïî ïóòè ñëåäîâàíèÿ
for j := 0 to WayList.count - 1 do
begin
TargetLine := TFigure(WayList[j]);
if CheckFigureByClassName(TargetLine, cTOrthoLine) then
begin
if TOrthoLine(TargetLine).FIsVertical or TOrthoLine(TargetLine).FIsRaiseUpDown then
begin
TargetCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TargetLine.ID);
if TargetCatalog <> nil then
begin
NewCompon := TargetCatalog.LastAddedComponent;
if NewCompon <> nil then
begin
if FirstCompon.JoinedComponents.IndexOf(NewCompon) = -1 then
ConnectCableComponents(FirstCompon, NewCompon);
// åñëè íà ìóëüòèèíòåðôåéñå
if ((j = 0) and (SelfLineConnectInfo.ConnectedComponList.Count > 1)) then
begin
for k := 1 to SelfLineConnectInfo.ConnectedComponList.Count - 1 do
begin
ComponJoinedByMultiInterFace := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(TLineComponConnectionInfo(SelfLineConnectInfo.ConnectedComponList[k]).ComponId);
if ComponJoinedByMultiInterFace <> nil then
begin
if NewCompon.JoinedComponents.IndexOf(ComponJoinedByMultiInterFace) = -1 then
ConnectCableComponents(NewCompon, ComponJoinedByMultiInterFace);
end;
end;
end;
FirstCompon := NewCompon;
NewCompon := Nil;
end;
end;
end;
end;
end;
FreeAndNil(WayList);
end;
// Restore Connection
// âîññòàíîâèòü ñîñòîÿíèå ñîåäèíåíèÿ êàáåëÿ ñ òî÷å÷íûìè êîìïîíåíòàìè
NewCompon := FirstCompon;
FirstCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfLineConnectInfo.ComponId);
InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList;
if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then
begin
i := 0;
While (i <= (InterFaceAccordanceList.Count - 1)) do
begin
SavedLineComponList := TList(InterFaceAccordanceList[i]);
SavedPointComponList := TList(InterFaceAccordanceList[i + 1]);
for j := 0 to SavedLineComponList.Count - 1 do
begin
aTempInterf := TSCSInterface(SavedLineComponList[j]);
ALineInterFace := GetInterfaceForConnection(aTempInterf, FirstCompon, NewCompon, TConnectorObject(TargetPointFigure));
LineCompon := ALineInterFace.ComponentOwner;
if ALineInterFace <> nil then
begin
for k := 0 to SavedPointComponList.Count - 1 do
begin
APointInterFace := TSCSInterface(SavedPointComponList[k]);
PointCompon := APointInterFace.ComponentOwner;
AInterfPositions1 := ALineInterFace.GetEmptyPositions;
AInterfPositions2 := APointInterFace.GetEmptyPositions;
// óðàâíÿòü êîëè÷åñòâî ïîçèöèé äëÿ ñîåäèíåíèÿ
if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then
begin
While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do
begin
l := AInterfPositions1.Positions.Count - 1;
AInterfPositions1.Positions.Delete(l);
end;
AInterfPositions1.DefineKolvo;
end
else
if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then
begin
While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do
begin
l := AInterfPositions2.Positions.Count - 1;
AInterfPositions2.Positions.Delete(l);
end;
AInterfPositions2.DefineKolvo;
end;
ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon);
// Äî òîãî êàê ñîåäèíèòü èíòåðôåéñû, íóæíî ñîåäèíèòü ñàìè êîìïîíåíòû
if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then;
FreeAndNil(TempInterfaces1);
FreeAndNil(TempInterfaces2);
end;
if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then
begin
ptrConnection := LineCompon.GetConnectionByConnected(PointCompon);
if ptrConnection <> nil then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
TempInterfaces1.Add(ALineInterFace);
TempInterfaces2.Add(APointInterFace);
InterfCount := AInterfPositions1.Kolvo;
if InterfCount > AInterfPositions2.Kolvo then
InterfCount := AInterfPositions2.Kolvo;
TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace,
InterfCount, InterfCount, ptrConnection.ID, cntUnion,
AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2);
TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1);
end;
end;
end;
end;
end;
SavedLineComponList.Clear;
SavedPointComponList.Clear;
FreeAndNil(SavedLineComponList);
FreeAndNil(SavedPointComponList);
Inc(i,2);
end;
end;
if InterFaceAccordanceList <> nil then
begin
InterFaceAccordanceList.clear;
FreeAndNil(InterFaceAccordanceList);
end;
end;
end;
end;
end;
end;
end;
SavedLineConnectionsList.Remove(SelfLineConnectInfo);
FreeAndNil(SelfLineConnectInfo);
end;
end;
end;
Procedure RestoreLineConnections(aLine: TOrthoLine);
var i, j: Integer;
LineCatalog: TSCSCatalog;
LineCompon: TSCSComponent;
SavedLine: TOrthoLine;
{ Procedure CheckDisJoinLineComponBySide(aLineCompon: TSCSComponent; ASide: Integer);
var i, j: Integer;
Interf: TSCSInterface;
InterfPos: TSCSInterfPosition;
JoinedComponList: TList;
begin
JoinedComponList := TList.Create;
for i := 0 to aLineCompon.Interfaces.Count - 1 do
begin
Interf := TSCSInterface(aLineCompon.Interfaces[i]);
if ((Interf.TypeI = itFunctional) and (Interf.Side = aSide)) then
begin
for j := 0 to Interf.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(Interf.BusyPositions[j]);
InterfPos := InterfPos.GetConnectedPos;
if InterfPos <> nil then
begin
if JoinedComponList.IndexOf(InterfPos.InterfOwner.ComponentOwner) = -1 then
JoinedComponList.Add(InterfPos.InterfOwner.ComponentOwner);
end;
end;
end;
end;
for i := 0 to JoinedComponList.Count - 1 do
aLineCompon.DisJoinFrom(TSCSComponent(JoinedComponList[i]));
FreeAndNil(JoinedComponList);
end; }
begin
if SavedLineConnectionsList.Count = 0 then
Exit;
for i := 0 to SavedLineList.Count - 1 do
begin
SavedLine := TOrthoLine(SavedLineList[i]);
if ((SavedLine <> nil) and (SavedTraceList.IndexOf(SavedLine) <> -1)) then
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SavedLine.ID);
if LineCatalog <> nil then
begin
if SavedTraceList.IndexOf(LineCatalog) <> - 1 then
begin
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
LineCompon := TSCSComponent(LineCatalog.ComponentReferences[j]);
if (isCableComponent(LineCompon) and
(SavedComponList.IndexOF(LineCompon) <> -1)) then
begin
//CheckDisJoinLineComponBySide(LineCompon, 1);
RestoreLineConnectionsBySide(SavedLine, LineCompon, 1);
//CheckDisJoinLineComponBySide(LineCompon, 2);
RestoreLineConnectionsBySide(SavedLine, LineCompon, 2);
end;
end;
end;
end;
end;
end;
end;
//
Procedure CheckdelVLines(aLine: TOrthoLine);
var i: Integer;
LineList: TList;
CanLook: Boolean;
VLine1, vLine2 : TOrthoLine;
Procedure GetVLines(aConn: TConnectorObject);
var i, j: Integer;
currConn: TConnectorObject;
begin
currConn := aConn;
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(aConn.JoinedConnectorsList[0]);
if currConn.ConnectorType = ct_clear then
begin
if aConn.ConnectorType = ct_clear then
begin
for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do
begin
if TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsVertical then
begin
if VLine1 = nil then
VLine1 := TOrthoLine(aConn.JoinedOrthoLinesList[i])
else
if vLine2 = nil then
begin
VLine2 := TOrthoLine(aConn.JoinedOrthoLinesList[i]);
break;
end;
end;
end;
end;
end
else
if currConn.ConnectorType = ct_NB then
begin
for i := 0 to currConn.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsVertical then
begin
if VLine1 = nil then
VLine1 := TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j])
else
if vLine2 = nil then
begin
vLine2 := TOrthoLine(TConnectorObject(currConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]);
Break; //// BREAK ////;
end;
end;
end;
if vLine2 <> nil then
break;
end;
end;
end;
Procedure DelVLines(vLine: TOrthoLine);
var i, j: Integer;
CanSeek:Boolean;
currConn: TConnectorObject;
currLine: TOrthoLine;
TempConn: TConnectorObject;
CandelLine: Boolean;
LineCatalog: TSCSCatalog;
procedure GetLineList;
var i, j: Integer;
Counter: Integer;
begin
Counter := 0;
While CanSeek do
begin
inc(Counter);
CanSeek := False;
if Counter > 50 then
break;
if currConn.ConnectorType = ct_clear then
begin
for i := 0 to currConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(currConn.JoinedOrtholinesList[i]).FIsVertical and
(TOrthoLine(currConn.JoinedOrtholinesList[i]).Id <> currLine.Id) then
begin
currLine := TOrthoLine(currConn.JoinedOrtholinesList[i]);
if LineList.IndexOf(currLine) = -1 then
LineList.Add(currLine);
if TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector1.Id <> currConn.ID then
currConn := TConnectorObject(TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector1)
else
if TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector2.Id <> currConn.ID then
currConn := TConnectorObject(TOrthoLine(currConn.JoinedOrtholinesList[i]).JoinConnector2);
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedConnectorsList[0]);
CanSeek := True;
break;
end;
end;
end
else
if currConn.ConnectorType = ct_NB then
begin
for i := 0 to currConn.JoinedConnectorsList.Count - 1 do
begin
TempConn := TConnectorObject(currConn.JoinedConnectorsList[i]);
for j := 0 to TempConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(TempConn.JoinedOrtholinesList[j]).FIsVertical and
(TOrthoLine(TempConn.JoinedOrtholinesList[j]).ID <> currLine.Id) then
begin
currLine := TOrthoLine(TempConn.JoinedOrtholinesList[j]);
if LineList.IndexOf(currLine) = -1 then
LineList.Add(currLine);
if currLine.JoinConnector1.Id <> TempConn.ID then
currConn := TConnectorObject(currLine.JoinConnector1)
else
if currLine.JoinConnector2.Id <> TempConn.ID then
currConn := TConnectorObject(currLine.JoinConnector2);
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedConnectorsList[0]);
CanSeek := True;
break;
end;
end;
if CanSeek then break;
end;
end;
end;
end;
begin
if ((vLine <> nil) and (not VLine.deleted)) then
begin
LineList.Add(vLine);
CanSeek := True;
currConn := TConnectorObject(vLine.JoinConnector1);
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedConnectorsList[0]);
currLine := vLine;
GetLineList;
currLine := VLine;
currConn := TConnectorObject(vLine.JoinConnector2);
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedConnectorsList[0]);
CanSeek := True;
GetLineList;
CanDelLine := True;
while CandelLine do
begin
CanDelLine := False;
for i := 0 to LineList.Count - 1 do
begin
currLine := TOrthoLine(LineList[i]);
if ((TConnectorObject(currLine.JoinConnector1).JoinedConnectorsList.Count = 0) and
(TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Count = 1)) or
((TConnectorObject(currLine.JoinConnector2).JoinedConnectorsList.Count = 0) and
(TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Count = 1)) then
begin
LineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currLine.Id);
if LineCatalog <> nil then
begin
if LineCatalog.ComponentReferences.Count = 0 then
CanDelLine := True
else
begin
CanDelLine := True;
for j := 0 to LineCatalog.ComponentReferences.Count - 1 do
begin
//Tolik 11/11/2021 --
//if ((not TSCSComponent(LineCatalog.ComponentReferences).ServToDelete) and
if ((not TSCSComponent(LineCatalog.ComponentReferences[j]).ServToDelete) and
//
(TSCSComponent(LineCatalog.ComponentReferences[j]).ID <> 0)) then
begin
CanDelLine := False;
Break; //// BREAK ////;
end;
end;
end;
end
else
CanDelLine := True;
if CanDelLine then
begin
LineList.Remove(currLine);
if TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Count > 0 then
begin
TConnectorObject(currLine.JoinConnector1).JoinedOrtholinesList.Remove(currLine);
currLine.JoinConnector1 := nil;
end;
if TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Count > 1 then
begin
TConnectorObject(currLine.JoinConnector2).JoinedOrtholinesList.Remove(currLine);
currLine.JoinConnector2 := nil;
end;
currLine.Delete;
currLine := Nil;
break;
end;
end;
end;
end;
LineList.Clear;
end;
end;
begin
VLine1 := nil; // ïåðâàÿ âåðòèêàëü íà êîííåêòîðå
VLine2 := Nil; // âòîðàÿ âåðòèêàëü íà êîííåêòîðå
LineList := TList.Create;
GetVLines(TConnectorObject(aLine.JoinConnector1));
delVLines(VLine1);
delVLines(VLine2);
VLine1 := nil; // ïåðâàÿ âåðòèêàëü íà êîííåêòîðå
VLine2 := Nil; // âòîðàÿ âåðòèêàëü íà êîííåêòîðå
GetVLines(TConnectorObject(aLine.JoinConnector2));
delVLines(VLine1);
delVLines(VLine2);
FreeAndNil(LineList);
end;
// Tolik 04/08/2021 --
Procedure SelectAllTracesOnCad;
var i: integer;
begin
for i := 0 to GCadform.FSCSFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(GCadform.FSCSFigures[i]), cTOrthoLine) then
begin
if not TOrthoLine(GCadForm.FSCSFigures[i]).FIsRaiseUpDown then
begin
if not TOrthoLine(GCadForm.FSCSFigures[i]).FIsVertical then
begin
if not TOrthoLine(GCadForm.FSCSFigures[i]).Selected then
TOrthoLine(GCadForm.FSCSFigures[i]).Select;
end;
end;
end;
end;
GCadForm.PCad.Refresh;
end;
//
begin
SavedUndoFlag := GlobalDisableSaveForUndo;
ProgressChecked := False;
{CanRefreshCadFlag := False;
if GCanRefreshCad then
begin
GCanRefreshCad := False;
CanRefreshCadFlag := True;
end;}
try
// Tolik 12/05/2016 -- íàõ ýòîò êóñîê ?
{try
RaiseLine := TOrthoLine(GPopupFigure);
except
RaiseLine := nil;
end;
if RaiseLine = nil then
begin
if (GPopupFigure <> nil) and CheckFigureByClassName(GPopupFigure, cTOrthoLine) then
RaiseLine := TOrthoLine(GPopupFigure);
end;}
F_RaiseHeight.cbApplyToAll.Visible := true;
if aToHeight = -1 then
begin
F_RaiseHeight.Caption := cMain_Mes32;
F_RaiseHeight.lbMessage.Caption := cMain_Mes33;
if F_RaiseHeight.Showmodal <> mrOK then
Exit;
RaiseHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseHeight > GCadForm.FRoomHeight then
RaiseHeight := GCadForm.FRoomHeight;
end
else
begin
RaiseHeight := aToHeight;
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseHeight > GCadForm.FRoomHeight then
RaiseHeight := GCadForm.FRoomHeight;
end;
if F_RaiseHeight.cbApplyToAll.Checked then
SelectAlltracesOnCad;
SavedTraceList := TList.Create;
SavedLineConnectionsList := TList.Create;
SavedComponList := TList.Create;
ComponToDeleteList := TSCSComponents.Create(False);
TempLineList := TList.Create;
SavedLineList:= TList.Create;
begin
CurrTick := GetTickCount;
//GCadForm.PCad.Locked := true;
//BeginProgress;
try
SelectedList := TList.Create;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
// Tolik -- 12/05/2016 -- ó÷åñòü âåðòèêàëüíûå òðàññû --
// if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
if ((not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown) and
(not TOrthoLine(GCadForm.PCad.Selection[i]).FIsVertical)) then
//
if (RaiseHeight <> TOrthoLine(FFigure).ActualZOrder[1]) or (RaiseHeight <> TOrthoLine(FFigure).ActualZOrder[2]) then
SelectedList.Add(TFigure(GCadForm.PCad.Selection[i]));
end;
if SelectedList.Count > 0 then
begin
// Tolik -- 06/12/2016 --
ProgressChecked := True; // çàëî÷èòü îêíà íà âðåìÿ ïîäúåìà òðàññ âî èçáåæàíèå..., à òî íåêîòîðûå
BeginProgress; // íåòåðïåëèâûå, íå äîæäàâøèñü çàâåðøåíèÿ ïðîöåññà, íàæèìàþò ÷òî íè ïîïàäÿ...
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
GlobalDisableSaveForUndo := True;
// Tolik -- 08//05/2016--
// ïîäðàâíÿòü êîííåêòîðû îðòîëèíèé íà òî÷å÷íûõ ïåðåä ñäâèãîì
for i := 0 to SelectedList.count - 1 do
begin
ComponToDeleteList.Clear;
RaiseLine := TOrthoLine(SelectedList[i]);
if TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList.Count > 0 then
begin
NB_Conn := TConnectorObject(RaiseLine.JoinConnector1).JoinedConnectorsList[0];
TConnectorObject(RaiseLine.JoinConnector1).Move(NB_Conn.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].x,
NB_Conn.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector1).ActualPoints[1].y)
end;
if TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList.Count > 0 then
begin
NB_Conn := TConnectorObject(RaiseLine.JoinConnector2).JoinedConnectorsList[0];
TConnectorObject(RaiseLine.JoinConnector2).Move(NB_Conn.ActualPoints[1].x - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].x,
NB_Conn.ActualPoints[1].y - TConnectorObject(RaiseLine.JoinConnector2).ActualPoints[1].y)
end;
// ñîõðàíåíèå êàáåëüíûõ ñîåäèíåíèé äî ñäâèãà
//SaveLineConnections(RaiseLine);
end;
//
for i := 0 to SelectedList.Count - 1 do
begin
ComponToDeleteList.Clear;
//Tolik 23/11/2021 --
if i = 0 then
begin
for j := GCadForm.PCad.Selection.Count - 1 downto 0 do
begin
TFigure(GCadForm.PCad.Selection[j]).Deselect;
end;
end;
//FFigure := TFigure(SelectedList[i]);
//Tolik -- 12/05/2016 --
RaiseLine := TOrthoLine(SelectedList[i]);
//RaiseLineOnHeight(TOrthoLine(FFigure), RaiseHeight, SelectedList);
//Tolik 23/11/2021 -- ÷óòü òîðìîçíåò çà ñ÷åò ñðàâíåíèÿ âûñîò, çàòî óñêîðèòñÿ çà ñ÷åò òîãî, ÷òî íå íóæíî
// áóäåò ïîäíèìàòü òðàññû èç ñïèñêà, êîòîðûå óæå ïîäíÿëèñü çà ñ÷åò òåõ, ÷òî áûëè äî íèõ â ñïèñêå
if ((CompareValue(RaiseLine.ActualZOrder[1], RaiseHeight) <> 0) or
(CompareValue(RaiseLine.ActualZOrder[2], RaiseHeight) <> 0)) then
begin
SavedLineList.Clear;
SaveLineConnections(RaiseLine);
if ComponToDeleteList.Count > 0 then
begin
for j := 0 to ComponToDeleteList.Count - 1 do
begin
if not TSCSComponent(ComponTodeleteList[j]).ServToDelete then
TSCSComponent(ComponToDeleteList[j]).DisJoinFromAll(true).Free
else
ComponToDeleteList.Remove(TSCSComponent(ComponTodeleteList[j]));
end;
end;
{ TempLineList.Clear;
TempLineList.Add(RaiseLine);}
{ RaiseLine.Select;
if GCadForm.PCad.Selection.Indexof(RaiseLine) = -1 then
GCadForm.PCad.Selection.Add(RaiseLine);}
if Assigned(RaiseLine.JoinConnector1) and (not TConnectorObject(RaiseLine.JoinConnector1).deleted) then
begin
TConnectorObject(RaiseLine.JoinConnector1).JoinedOrthoLinesList.remove(RaiseLine);
TConnectorObject(RaiseLine.JoinConnector1).JoinedOrthoLinesList.Insert(0, RaiseLine);
end;
if Assigned(RaiseLine.JoinConnector2) and (not TConnectorObject(RaiseLine.JoinConnector2).deleted) then
begin
TConnectorObject(RaiseLine.JoinConnector2).JoinedOrthoLinesList.remove(RaiseLine);
TConnectorObject(RaiseLine.JoinConnector2).JoinedOrthoLinesList.Insert(0, RaiseLine);
end;
RaiseLineOnHeight(RaiseLine, RaiseHeight, SelectedList);
//RaiseLineOnHeight(RaiseLine, RaiseHeight, TempLineList);
//CheckDeleteAllRaises(GCadForm.PCad);
RestoreLineConnections(RaiseLine);
if ComponToDeleteList.Count > 0 then
begin
// Tolik -- 22/12/2016 --
Try
// Tolik -- 30/09/2016 --
for j := ComponTodeleteList.Count - 1 downto 0 do
begin
if ((TSCSComponent(ComponTodeleteList[j]).ServToDelete = true) or (TSCSComponent(ComponToDeleteList[j]).id = 0)) then
ComponToDeleteList.delete(j);
end;
if ComponToDeleteList.Count > 0 then
begin
for j := ComponToDeleteList.Count - 1 downto 0 do
begin
if not TSCSComponent(ComponTodeleteList[j]).ServToDelete then
TSCSComponent(ComponToDeleteList[j]).DisJoinFromAll(true).Free
else
ComponToDeleteList.Remove(TSCSComponent(ComponTodeleteList[j]));
end;
end;
F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil);
//ComponToDeleteList.Clear;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.F_ProjMan.DelComponentsFromList', E.Message);
end;
end;
{if CanRefreshCadFlag then
begin
GCanRefreshCad := True;
end;}
// óäàëèòü íåíóæíûå âåðòèêàëè
Try
CheckDelVLines(RaiseLine);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.F_ProjMan.CheckDelVLines', E.Message);
end;
end;
//
end;
// Tolik 12/05/2016 -- âîññòàíîâëåíèå êàáåëüíûõ ñîåäèíåíèé
{for i := 0 to SelectedList.Count - 1 do
begin
RaiseLine := TOrthoLine(SelectedList[i]);
RestoreLineConnections(RaiseLine);
end;}
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
RefreshCAD(GCadForm.PCad);
// SP !!!
CheckDeleteAllRaises(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
FreeAndNil(SelectedList);
finally
//EndProgress;
//GCadForm.PCad.Locked := false;
end;
OldTick := GetTickCount - CurrTick;
OldTick := GetTickCount - CurrTick;
end;
FreeAndNil(ComponToDeleteList);
FreeAndNil(SavedTraceList);
FreeAndNil(SavedLineConnectionsList);
FreeAndNil(SavedComponList);
FreeAndNil(TempLineList);
FreeAndNil(SavedLineList);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRaiseLineExecute', E.Message);
end;
GlobalDisableSaveForUndo := SavedUndoFlag;
{if CanRefreshCadFlag then
GCanRefreshCad := True;}
if ProgressChecked then
EndProgress;
end;
// Tolik -- 01/08/2016 --
procedure TFSCS_Main.aRaiseLineExecute(Sender: TObject);
begin
RaiseSelectedLine;
end;
procedure TFSCS_Main.aMasterAutoTraceExecute(Sender: TObject);
var
IsAnyRTSelected: Boolean;
mess: string;
i: integer;
aEndPointName: string;
begin
if ActiveMDIChild <> nil then
begin
if GEndPoint = nil then
begin
// ÊÎ ÂÛÁÐÀÒÜ
F_EndPoints.Execute;
end;
if GEndPoint <> nil then
begin
// ïðîâåðèòü ìîæíî ëè òðàññèðîâàòü ïî âûáðàííûì èëè òîëüêî âî âñåì
IsAnyRTSelected := False;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
If CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
If TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_Clear then
if TConnectorObject(GCadForm.PCad.Selection[i]) <> GEndPoint then
IsAnyRTSelected := True;
end;
// ïî âûáðàííûì
if IsAnyRTSelected then
begin
if F_AutoTraceType.ShowModal = mrOK then
begin
if F_AutoTraceType.rbTraceBySelected.Checked then
GCadForm.FAutoTraceBySelected := True;
if F_AutoTraceType.rbTraceByAll.Checked then
GCadForm.FAutoTraceBySelected := False;
end
else
Exit;
end
else
// ïî âñåì
begin
aEndPointName := GetFigureFirstComponentName(GEndPoint.ID);
mess := cMain_Mes34 + aEndPointName + #13#10 + cMain_Mes35;
//if MessageBox(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_YESNO) = IDYes then
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes36, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes36), MB_YESNO) = IDYes then
GCadForm.FAutoTraceBySelected := False
else
Exit;
end;
//*** Âûáðàòü ïîðÿäîê ïîäêëþ÷åíèÿ ïàíåëåé ñ ïîðòàìè
if Not ChoiceAutoTraceConnectOrder then
Exit; ///// EXIT /////
Show_F_InterfacesAutoTraceForm;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aReport_ListObjectsExecute(Sender: TObject);
begin
RepObjectReport;
end;
procedure TFSCS_Main.aReport_ResorcesExecute(Sender: TObject);
begin
RepResourceReport;
end;
procedure TFSCS_Main.aReport_CablesExecute(Sender: TObject);
begin
RepCableReport;
end;
procedure TFSCS_Main.aCreateObjectOnClickExecute(Sender: TObject);
begin
if aCreateObjectOnClick.Checked = True then
begin
GCadForm.FCreateObjectOnClick := True;
GCadForm.PCad.SetCursor(crDrag);
end;
if aCreateObjectOnClick.Checked = False then
begin
GCadForm.FCreateObjectOnClick := False;
GCadForm.PCad.SetCursor(crDefault);
end;
RefreshCAD(GCadForm.PCad);
end;
procedure TFSCS_Main.aDeleteSCSObjectExecute(Sender: TObject);
var
i: integer;
FFigure,Selfigure: TFigure;
mess: string;
vList: TList;
vIntList: TIntList;
FigID: Integer;
ListID: Integer;
Node: TTreeNode;
Obj: PObjectData;
DelComponMode: TDelComponMode;
vListCad: TF_CAD;
CurrCatalog: TSCSCatalog;
CurrComponent: TSCSComponent;
//Tolik
SCSCatalog : TSCSCatalog;
SCSComponent : TSCSComponent;
j: integer;
NeedInputBox: boolean;
// 18/11/2016--
DelRaiseFromPointObject: Boolean;
//
// Tolik -- 21/04/2017 --
RefreshFlag: Boolean;
DelFiguresList: TList;
DelCableFromPoint: Boolean; // Tolik 24/05/2021 --
ListCount: integer;
//
function CanDelRaiseFromPointObject(aConn: TConnectorObject): Boolean;
var i, j: Integer;
JoinedLine : TOrthoLine;
begin
Result := True;
if aConn.ConnectorType <> ct_Nb then
exit;
for i := 0 to aConn.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(TConnectorObject(aConn.JoinedConnectorsList[i]).JoinedOrtholinesList[j]);
if (not JoinedLine.FIsRaiseUpDown) and (not JoinedLine.Deleted) and (not JoinedLine.Selected) then
begin
Result := False;
break;
end;
end;
if not Result then
break;
end;
end;
{ // Tolik 26/05/2021 -- âûíåñåíî â U_Common (è ïåðåäåëàíî ÷óòü-÷óòü)
// Tolik 11/07/2019 - -
function CheckNeedInputBox: boolean;
var i: Integer;
function DoesHaveFigureConnectedCable(aFigure: TFigure): Boolean;
var i, j: Integer;
FigCatalog: TSCSCatalog;
ChildCompon: TSCSComponent;
JoinedCompon: TSCSComponent; // Tolik 24/05/2021 --
begin
Result := false;
if FFigure = nil then
exit;
if FFigure.Deleted then
exit;
if CheckFigureByClassName(aFigure, cTOrthoLine) then
begin
FigCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aFigure.ID);
if FigCatalog <> nil then
begin
for i := 0 to FigCatalog.ComponentReferences.Count - 1 do
begin
ChildCompon := TSCSComponent(FigCatalog.ComponentReferences[i]);
if IsCableComponent(ChildCompon) then
begin
childCompon.LoadWholeComponent(false);
if ChildCompon.WholeComponent.Count > 1 then
begin
Result := True;
break;
end;
end;
end;
end;
end
//Tolik 24/05/2021 --
else
if CheckFigureByClassName(aFigure, cTConnectorObject) then
begin
FigCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(aFigure.ID);
if FigCatalog <> nil then
begin
for i := 0 to FigCatalog.ComponentReferences.Count - 1 do
begin
ChildCompon := TSCSComponent(FigCatalog.ComponentReferences[i]);
for j := 0 to ChildCompon.JoinedComponents.Count - 1 do
begin
JoinedCompon := ChildCompon.JoinedComponents[j];
if IsCableComponent(JoinedCompon) then
begin
Result := True;
break;
end;
end;
end;
end;
end
//
end;
begin
Result := DoesHaveFigureConnectedCable(FFigure);
if not Result then
begin
if GCadForm <> nil then
begin
if GCadForm.PCad.Selection.Count > 1 then
begin
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
begin
Result := DoesHaveFigureConnectedCable(TFigure(GCadForm.PCad.Selection[i]));
if Result then
break;
end;
end;
end;
end;
end;
//
}
begin
DelCableFromPoint := False; // Tolik 24/05/2021 -- óäàëÿòü êàáåëè, ïîäêëþ÷åííûå ê òî÷å÷íûì óäàëÿåìûì îáúåêòàì
// Tolik -- 07/02/2017 --
vList := nil;
//
// Toilk 21/04/2017 --
RefreshFlag := GCanRefreshCad;
GCanRefreshCad := False;
DelFiguresList := TList.Create;
BeginProgress('', -1, False);
//
try
if GPopupFigure = nil then
//Tolik 12/05/2017 --
//exit;
begin
DelFiguresList.free;
GCanRefreshCad := RefreshFlag;
exit;
end;
//
try
FFigure := GPopupFigure;
except
FFigure := nil;
end;
mess := cCad_Mes11;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cCad_Mes12, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cCad_Mes12), MB_YESNO) = IDYes then
begin
{ Node := GetTreeNodeByID(FFigure.ID);
if node <> nil then
begin
Obj := Node.Data;
with F_ProjMan do
begin
case Obj.ComponKind of
ckCompon:
Act_DelComponent.Execute;
end;
end;
end; }
DelComponMode := dmTrace;
// Tolik 11/07/2019 --
// âîîáùå-òî çäåñü ïðåäïîëàãàëîñü ñäåëàòü ïðîâåðêó íà óäàëåíèå êàáåëÿ (åñëè åñòü) ïî âñåé òðàññå
// à íàïèñàëè ÷åðòå-÷òî .... âîò, ïðèøëîñü ïîïðàâèòü, à òî âûäàâàëî ñîîáùåíèå íà óäàëåíèå êîìïîíåíòà
// ïî âñåé òðàññå êàê äëÿ òðàññ, òàê è äëÿ ñ/ï íåçàâèñèìî îò òîãî, åñòü òàì êàáåëü èëè íåò...(íåõîðîøî)
{
NeedInputBox := False;
if (FFigure <> nil)and(CheckFigureByClassName(FFigure,cTOrthoLine)) then
NeedInputBox := true;
if not NeedInputBox then
begin
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
Selfigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(Selfigure, cTOrthoLine) then
begin
NeedInputBox := true;
break;
end;
end;
end;
}
NeedInputBox := CheckNeedInputBox; // Tolik 11/07/2019 -- âîò, ñîáñòâåííî, è âñÿ ïðîâåðêà!
// ----
if NeedInputBox then
begin
// if F_ProjMan.GSCSBase.SCSComponent <> nil then
// if Trim(F_ProjMan.GSCSBase.SCSComponent.Name) <> '' then
DelComponMode := F_ProjMan.F_InputBox.ChoiceDelComponMode(''{F_ProjMan.GSCSBase.SCSComponent.Name});
DelCableFromPoint := (F_ProjMan.F_InputBox.cbDelConnToPoinCable.Checked and F_ProjMan.F_InputBox.cbDelConnToPoinCable.Visible);
end;
if DelComponMode <> dmNOne then
begin
if (FFigure <> nil) or (GCadForm.PCad.SelectedCount > 0) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
vList := GetRelatedListsBySelected(GCadForm.PCad.Selection, cst_Delete);
// !!!
// vIntList := TIntList.Create;
// for i := 0 to vList.Count - 1 do
// begin
// ListID := TF_CAD(vList[i]).FCADListID;
// vIntList.Add(ListID);
// end;
// FigID := FFigure.ID;
// BeforeDelObjectFromPM(cfCAD, GCadForm.FCADListID, FigID, vIntList);
// !!!
// Tolik 25/05/2021 -- åñëè óäàëÿòü êàáåëè -- îïðåäåëèòü ëèñòû äëÿ óíäî ....
//
if VList.Count = 1 then
begin
VList.Free;
VList := GetListsByDeleteCable(DelCableFromPoint, DelComponMode);
end;
if vList.Count = 1 then
GCadForm.SaveForUndo(uat_None, True, False)
else
SaveForProjectUndo(vList, True, False);
GCadForm.FCanSaveForUndo := False;
end;
// Tolik 24/05/2021 -- óäàëèòü êàáåëü, ïîäêëþ÷åííûé ê óäàëÿåìûì òî÷å÷íûì îáúåêòàì
if DelCableFromPoint then
DeleteConnectedToPointsCable;
//
if DelComponMode = dmTrace then
begin
DelCableByAllLengthFromSelected; // Tolik 25/05/2021 -- óäàëèòü êàáåëè ïî âñåé äëèíå ñ óäàëÿåìûõ òðàññ
if FFigure <> nil then
if CheckFigureByClassName(FFigure, cTOrthoLine) then
GCadForm.FFiguresDelManual.add(FFigure);
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
Selfigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(Selfigure, cTOrthoLine) then
begin
if FFigure <> SelFigure then
GCadForm.FFiguresDelManual.add(SelFigure);
end;
end;
{
if F_ProjMan <> nil then
begin
for i := 0 to F_ProjMan.Tree_Catalog.SelectionCount - 1 do
begin
Obj := TTreeNode(F_ProjMan.Tree_Catalog.Selections[i]).Data;
CurrComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(obj.ObjectID);
if Assigned(CurrComponent) then
begin
CurrCatalog := CurrComponent.GetFirstParentCatalog;
if CurrCatalog <> nil then
begin
vListCad := GetListByID(CurrCatalog.ListID);
if vList <> nil then
Selfigure := GetFigureByID(vListCad, CurrCatalog.SCSID);
if FFigure <> SelFigure then
GCadForm.FFiguresDelManual.add(SelFigure);
end;
end;
end;
end;
}
end;
if FFigure <> nil then
begin
GCadForm.PCad.OnBeforeDelete := nil;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
// Tolik 18/11/2016-- ðàéç ñ ïîèíòà óäàëèòñÿ ïî-ëþáîìó, äàæå åñëè ê óäàëÿåìîìó òî÷å÷íîìó ïðèñîåäèíåíû òðàññû
//(íà óðîâíå ïîèíòà) + òðàññû íà óðîâíå ïðîòèâîïîëîæíîãî êîííåòêîðà ðàéçà, êîòîðûå â ýòîé òî÷êå íóæíî áû ïåðåêîííåêòèòü
{if not CheckCannotDelete(FFigure) then
TConnectorObject(FFigure).Delete(True);}
if not CheckCannotDelete(FFigure) then
begin
// TConnectorObject(FFigure).Delete(True);
DelRaiseFromPointObject := CanDelRaiseFromPointObject(TConnectorObject(FFigure));
TConnectorObject(FFigure).Delete(true, DelRaiseFromPointObject);
end
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if not CheckCannotDelete(FFigure) then
TOrthoLine(FFigure).Delete;
end;
GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete;
end;
// óäàëèòü âñå âûäåëåííûå
// Tolik 21/04/2017 --
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
begin
if DelFiguresList.IndexOf(TFigure(GCadForm.PCad.Selection[i])) = -1 then
DelFiguresList.Add(TFigure(GCadForm.PCad.Selection[i]));
end;
//
//for i := 0 to GCadForm.PCad.SelectedCount - 1 do
for i := 0 to DelFiguresList.Count - 1 do
begin
//FFigure := TFigure(GCadForm.PCad.Selection[i]);
FFigure := TFigure(DelFiguresList[i]);
GCadForm.PCad.OnBeforeDelete := nil;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if not TConnectorObject(FFigure).Deleted then // Tolik 25/05/2021 --
if not CheckCannotDelete(FFigure) then
TConnectorObject(FFigure).Delete(True);
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
//Tolik
SCSCatalog := nil;
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FFigure.ID);
if SCSCatalog <> nil then
begin
for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSComponent := nil;
SCSComponent := SCSCatalog.ComponentReferences[j];
if SCSComponent <> nil then
SCSComponent.ServToDelete := true;
end;
end;
//
if not CheckCannotDelete(FFigure) then
TOrthoLine(FFigure).Delete;
end;
GCadForm.PCad.OnBeforeDelete := GCadForm.PCadBeforeDelete;
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
except
on E: Exception do
begin
addExceptionToLogEx('TFSCS_Main.aDeleteSCSObjectExecute', E.Message);
// Toilk 21/04/2017 --
GCanRefreshCad := RefreshFlag;
//
end;
end;
EndProgress;
// Tolik 07/02/2017 --
if vList <> nil then
FreeAndNil(vList);
DelFiguresList.Free; // 21/05/2018 --
//
// Toilk 21/04/2017 --
GCanRefreshCad := RefreshFlag;
GCadForm.PCad.Refresh;
//
end;
procedure TFSCS_Main.aShowConnFullnessExecute(Sender: TObject);
begin
try
if aShowConnFullness.Checked = True then
GCadForm.FShowConnFullness := True;
if aShowConnFullness.Checked = False then
GCadForm.FShowConnFullness := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowConnFullnessExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowCableFullnessExecute(Sender: TObject);
begin
try
if aShowCableFullness.Checked = True then
begin
GCadForm.FShowCableFullness := True;
aShowCableChannelFullness.Checked := False;
GCadForm.FShowCableChannelFullness := False;
end;
if aShowCableFullness.Checked = False then
begin
GCadForm.FShowCableFullness := False;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowCableFullnessExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowCableChannelFullnessExecute(Sender: TObject);
begin
try
if aShowCableChannelFullness.Checked = True then
begin
GCadForm.FShowCableChannelFullness := True;
aShowCableFullness.Checked := False;
GCadForm.FShowCableFullness := False;
end;
if aShowCableChannelFullness.Checked = False then
GCadForm.FShowCableChannelFullness := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowCableChannelFullnessExecute', E.Message);
end;
end;
procedure TFSCS_Main.aCreateObjectOnClickToolExecute(Sender: TObject);
var ToolClassName: String;
ToolData: Integer;
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
if GCadForm.FCreateObjectOnClick = True then
begin
if tbCADToolsExpert.Visible then
begin
tbSelectExpert.Click;
tbSelectExpert.Down := True;
end
else
begin
tbSelectNoob.Click;
tbSelectNoob.Down := True;
end;
DestroyShadowObject;
end
else
begin
//29.06.2010 aSetSCSLayer.Execute;
GCadForm.FCreateObjectOnClick := True;
DefineCurrLayerByCompon; //29.06.2010
GCadForm.PCad.SetCursor(crDrag);
RefreshCAD(GCadForm.PCad);
GCadForm.PCad.SetTool(toSelect, 'TSelected');
DropCreatedObjCountOnClickInList(GCadForm.FCADListID); //#From Oleg#
CreateShadowObject; // Íà CAD
end;
{$IF Defined(ES_GRAPH_SC)}
if Not GCadForm.PCad.Focused then
begin
SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0);
GCadForm.PCad.SetFocus;
end;
// Tolik -- 31/01/2017 -- ÷òîáû ïðàâèëüíî âûñòàâèòü òóëçó ðèñîâàíèÿ äëÿ
// àðõèòåêòóðíîãî ïðîåêòèðîâàíèÿ
if TF_Main(F_NormBase).GSCSBase.SCSComponent.ID <> 0 then
begin
if IsArchTopComponByIsLine(TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine)
or (TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then
begin
ToolClassName := '';
ToolData := TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine;
if (TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then
FSCS_Main.SetToolArch('TWallDivPath')
else
if IsArchTopComponByIsLine(TF_Main(F_NormBase).GSCSBase.SCSComponent.IsLine) then
begin
if TF_Main(F_NormBase).Act_DrawModePoly.Checked then
ToolClassName := 'TWallPolyPath'
else
ToolClassName := 'TRoomWallRect';
end;
if ToolClassName <> '' then
FSCS_Main.SetToolArch(ToolClassName, ToolData);
end;
end
else
TF_Main(F_NormBase).Act_EditTemplate.Execute;
//
//GCadForm.SetFocus;
{$IFEND}
end
else
begin
if tbCADToolsExpert.Visible then
tbCreateOnClickModeExpert.Down := False
else
tbCreateOnClickModeNoob.Down := False;
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
end;
procedure TFSCS_Main.aTileWindowsExecute(Sender: TObject);
begin
FSCS_Main.Tile;
end;
procedure TFSCS_Main.aCascadeWindowsExecute(Sender: TObject);
begin
FSCS_Main.Cascade;
end;
procedure TFSCS_Main.CheckClose;
begin
try
GexitProg := False;
if MessageBox(FSCS_Main.Handle, cMain_Mes49, cMain_Mes50, MB_YESNO) = IDYes then
begin
//if CloseCurrProject(true) <> IDCancel then
GExitProg := True;
// Tolik -- 09/03/2016 --
GExitProgEX := True;
//
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.CheckClose', E.Message);
end;
end;
procedure TFSCS_Main.WMAct(var msg: TMessage);
begin
if not Assigned(FSCS_Main) then
Exit;
end;
procedure TFSCS_Main.aReport_CablesWithLimitLengthExecute(Sender: TObject);
begin
RepCableExceedLength;
end;
procedure TFSCS_Main.aReport_CableChannelsExecute(Sender: TObject);
begin
RepCableCanal;
end;
procedure TFSCS_Main.aReport_ConnectByColorsExecute(Sender: TObject);
begin
RepDisparityComponColor;
end;
procedure TFSCS_Main.aReport_ConnectByProducerExecute(Sender: TObject);
begin
RepDisparityComponProducer;
end;
procedure TFSCS_Main.aReport_ConnectionsExecute(Sender: TObject);
begin
RepCableJournal;
end;
procedure TFSCS_Main.aReport_SpecificationExecute(Sender: TObject);
begin
RepSpecification;
end;
procedure TFSCS_Main.aReport_CableJournalExtExecute(Sender: TObject);
begin
RepCableJournalExt;
end;
procedure TFSCS_Main.aInsertBlockExecute(Sender: TObject);
var
BlkName: string;
FDir: string;
OpenDialog: TOpenDialog;
begin
try
if ActiveMDIChild <> nil then
begin
OpenDialog := TOpenDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.blk') then
FDir := FDir + '\.blk';
OpenDialog.Title := cMain_Mes51;
OpenDialog.InitialDir := FDir;
OpenDialog.DefaultExt := 'blk';
OpenDialog.Filter := cMain_Mes52;
if OpenDialog.Execute then
begin
BlkName := OpenDialog.FileName;
try
GCadForm.CurrentLayer := 1;
GCadForm.PCad.InsertBlockwithFileName(GCadForm.PCad.ActiveLayer, BlkName, 20, 20);
except
ShowMessage(cMain_Mes53);
end;
end;
OpenDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aInsertBlockExecute', E.Message);
end;
end;
//procedure TFSCS_Main.aCreateBlockToNBExecute(Sender: TObject);
//var
// BlkName: string;
// FullBlkName: string;
// MetaFile: TMetafile;
// Bitmap: TBitmap;
// FDir: string;
// Buffer: array[0..1023] of Char;
// TempPath: string;
//
//begin
// try
// if ActiveMDIChild <> nil then
// begin
// if GCadForm.PCad.SelectedCount > 0 then
// begin
// SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
// if not DirectoryExists(TempPath) then
// TempPath := GetEXEDir + '\';
// BlkName := cMain_Mes54;
// FullBlkName := TempPath + cMain_Mes54;
//
// GCadForm.PCad.MakeSelectionBlock(FullBlkName + '.blk');
// MetaFile := TMetafile.Create;
// Bitmap := TBitmap.Create;
// MetaFile := GCadForm.PCad.SelectionAsWmf;
// Bitmap.Height := Metafile.Height;
// Bitmap.Width := Metafile.Width;
// Bitmap.Canvas.Draw(0, 0, MetaFile);
// //BitmapToNormalSize(Bitmap, 75);
//
// Bitmap.SaveToFile(FullBlkName + '.bmp');
// FreeAndNil(MetaFile);
// FreeAndNil(Bitmap);
// AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk');
// if FileExists(FullBlkName + '.bmp') then
// DeleteFile(FullBlkName + '.bmp');
// if FileExists(FullBlkName + '.blk') then
// DeleteFile(FullBlkName + '.blk');
// end;
// end;
// except
// on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockExecute', E.Message);
// end;
//end;
procedure TFSCS_Main.aCreateBlockToNBExecute(Sender: TObject);
var
BlkName: string;
FullBlkName: string;
FullBlkNameOr: string;
FullBlkName1: string;
FullBlkName2: string;
MetaFile: TMetafile;
Bitmap: TBitmap;
FDir: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
SelList: TList;
Block: TBlock;
i: integer;
begin
try
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.SelectedCount > 0 then
begin
TempPath := GetAnsiTempPath; //08.09.2011 SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
if not DirectoryExists(TempPath) then
TempPath := GetEXEDir + '\';
BlkName := cMain_Mes54;
FullBlkName := TempPath + cMain_Mes54;
if GCadForm.PCad.SelectedCount = 2 then
begin
SelList := TList.Create;
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
SelList.Add(GCadForm.PCad.Selection[i]);
for i := 0 to SelList.Count - 1 do
begin
GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle);
end;
FullBlkName1 := FullBlkName;
FullBlkName2 := FullBlkName;
FullBlkNameOr := FullBlkName;
if TFigure(SelList[0]).CenterPoint.x > TFigure(SelList[1]).CenterPoint.x then
FullBlkName1 := FullBlkName + '_active'
else
FullBlkName2 := FullBlkName + '_active';
for i := 0 to SelList.Count - 1 do
begin
FullBlkName := FullBlkName1;
if i = 1 then
FullBlkName := FullBlkName2;
GCadForm.PCad.SelectFigure(TFigure(SelList[i]).Handle);
//GCadForm.PCad.Refresh;
Block := nil;
if (TFigure(SelList[i]) is TBlock) then
Block := TBlock(TBlock(SelList[i]).duplicate)
else if (TFigure(SelList[i]) is TFigureGrp) then
Block := TBlock(TFigureGrp(SelList[i]).duplicate)
else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
//GCadForm.PCad.Refresh;
Block := nil;
if (TFigure(SelList[i]) is TBlock) then
Block := TBlock(TBlock(SelList[i]).duplicate)
else if (TFigure(SelList[i]) is TFigureGrp) then
Block := TBlock(TFigureGrp(SelList[i]).duplicate)
else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
GCadForm.PCad.Refresh;
Block := nil;
//if (TFigure(SelList[i]) is TBlock) then
// Block := TBlock(TBlock(SelList[i]).duplicate)
//else if (TFigure(SelList[i]) is TFigureGrp) then
// Block := TBlock(TFigureGrp(SelList[i]).duplicate)
//else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
//Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
//BlockToNormalSize(Block, 150);
//MetaFile := TMetafile.Create;
//Bitmap := TBitmap.Create;
//MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
//Bitmap.Height := Metafile.Height;
//Bitmap.Width := Metafile.Width;
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.SaveToFile(FullBlkName + '.bmp');
//FreeAndNil(MetaFile);
//FreeAndNil(Bitmap);
if Block <> nil then
begin
//Block.InFigures.Clear;
Block.Free;
end;
GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle);
GCadForm.PCad.Refresh;
end;
AddObjectIconFromCADToDirectories(BlkName, FullBlkNameOr + '.bmp', FullBlkNameOr + '.blk');
if FileExists(FullBlkName1 + '.bmp') then
DeleteFile(FullBlkName1 + '.bmp');
if FileExists(FullBlkName1 + '.blk') then
DeleteFile(FullBlkName1 + '.blk');
if FileExists(FullBlkName2 + '.bmp') then
DeleteFile(FullBlkName2 + '.bmp');
if FileExists(FullBlkName2 + '.blk') then
DeleteFile(FullBlkName2 + '.blk');
SelList.Clear;
FreeAndNil(SelList);
end
else
begin
Block := nil;
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
//AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk');
if FileExists(FullBlkName + '.bmp') then
DeleteFile(FullBlkName + '.bmp');
if FileExists(FullBlkName + '.blk') then
DeleteFile(FullBlkName + '.blk');
if Block <> nil then
begin
//Block.InFigures.Clear;
Block.Free;
end;
Block := nil;
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
AddObjectIconFromCADToDirectories(BlkName, FullBlkName + '.bmp', FullBlkName + '.blk');
if FileExists(FullBlkName + '.bmp') then
DeleteFile(FullBlkName + '.bmp');
if FileExists(FullBlkName + '.blk') then
DeleteFile(FullBlkName + '.blk');
if Block <> nil then
begin
//Block.InFigures.Clear;
Block.Free;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockExecute', E.Message);
end;
end;
procedure TFSCS_Main.aBlocksEditorExecute(Sender: TObject);
begin
F_BlockEditor.ShowModal;
end;
procedure TFSCS_Main.aRotatePointObject90Execute(Sender: TObject);
var
i: integer;
PointObject: TConnectorObject;
AngleRad: Double;
AngleDeg: Double;
Bnd: TDoubleRect;
FFigure: TFigure;
CurrCaptionAngle: Double;
// Tolik -- 03/10/2016 --
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GCadForm.PCad.SelectedCount > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then
begin
PointObject := TConnectorObject(FFigure);
if CheckTrunkObject(PointObject) then
begin
RotateTrunkObject(PointObject, 90);
Exit;
end;
AngleRad := 90 / 180 * pi;
PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]);
PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint);
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad;
if PointObject.FDrawFigureAngle >= 2 * pi then
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi;
Bnd := PointObject.DrawFigure.GetBoundRect;
PointObject.GrpSizeX := Bnd.Right - Bnd.Left;
PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top;
//
CurrCaptionAngle := 0; //#From Oleg# //14.09.2010
if PointObject.FCaptionsViewType = cv_Right then
CurrCaptionAngle := 0;
if PointObject.FCaptionsViewType = cv_Down then
CurrCaptionAngle := 90;
if PointObject.FCaptionsViewType = cv_Left then
CurrCaptionAngle := 180;
if PointObject.FCaptionsViewType = cv_Up then
CurrCaptionAngle := 270;
CurrCaptionAngle := CurrCaptionAngle + 90;
CurrCaptionAngle := round(CurrCaptionAngle) mod 360;
if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then
PointObject.FCaptionsViewType := cv_Right
else
if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then
PointObject.FCaptionsViewType := cv_Down
else
if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then
PointObject.FCaptionsViewType := cv_Left
else
if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then
PointObject.FCaptionsViewType := cv_Up
else
if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then
PointObject.FCaptionsViewType := cv_Right;
PointObject.DefRaizeDrawFigurePos;
//
RefreshCAD(GCadForm.PCad);
PointObject.ReCreateCaptionsGroup(false, false);
end
else
RotateFigure(FFigure, 90);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject90Execute', E.Message);
end;
//GCadForm.FCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.aRotatePointObject180Execute(Sender: TObject);
var
i: integer;
PointObject: TConnectorObject;
AngleRad: Double;
AngleDeg: Double;
Bnd: TDoubleRect;
FFigure: TFigure;
CurrCaptionAngle: Double;
// Tolik
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GCadForm.PCad.SelectedCount > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then
begin
PointObject := TConnectorObject(FFigure);
if CheckTrunkObject(PointObject) then
begin
RotateTrunkObject(PointObject, 180);
Exit;
end;
AngleRad := 180 / 180 * pi;
PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]);
PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint);
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad;
if PointObject.FDrawFigureAngle >= 2 * pi then
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi;
Bnd := PointObject.DrawFigure.GetBoundRect;
PointObject.GrpSizeX := Bnd.Right - Bnd.Left;
PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top;
//
if PointObject.FCaptionsViewType = cv_Right then
CurrCaptionAngle := 0;
if PointObject.FCaptionsViewType = cv_Down then
CurrCaptionAngle := 90;
if PointObject.FCaptionsViewType = cv_Left then
CurrCaptionAngle := 180;
if PointObject.FCaptionsViewType = cv_Up then
CurrCaptionAngle := 270;
CurrCaptionAngle := CurrCaptionAngle + 180;
CurrCaptionAngle := round(CurrCaptionAngle) mod 360;
if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then
PointObject.FCaptionsViewType := cv_Right
else
if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then
PointObject.FCaptionsViewType := cv_Down
else
if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then
PointObject.FCaptionsViewType := cv_Left
else
if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then
PointObject.FCaptionsViewType := cv_Up
else
if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then
PointObject.FCaptionsViewType := cv_Right;
PointObject.DefRaizeDrawFigurePos;
//
RefreshCAD(GCadForm.PCad);
PointObject.ReCreateCaptionsGroup(false, false);
end
else
RotateFigure(FFigure, 180);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotatePointObject180Execute', E.Message);
end;
//GCadForm.FCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.aRotatePointObject270Execute(Sender: TObject);
var
i: integer;
PointObject: TConnectorObject;
AngleRad: Double;
AngleDeg: Double;
Bnd: TDoubleRect;
FFigure: TFigure;
CurrCaptionAngle: Double;
// Tolik 03/10/2016 --
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GCadForm.PCad.SelectedCount > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) and (TConnectorObject(FFigure).ConnectorType <> ct_Clear) then
begin
PointObject := TConnectorObject(FFigure);
if CheckTrunkObject(PointObject) then
begin
RotateTrunkObject(PointObject, 270);
Exit;
end;
AngleRad := 270 / 180 * pi;
PointObject.Rotate(AngleRad, PointObject.ActualPoints[1]);
PointObject.DrawFigure.Rotate(AngleRad, PointObject.CenterPoint);
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle + AngleRad;
if PointObject.FDrawFigureAngle >= 2 * pi then
PointObject.FDrawFigureAngle := PointObject.FDrawFigureAngle - 2 * pi;
Bnd := PointObject.DrawFigure.GetBoundRect;
PointObject.GrpSizeX := Bnd.Right - Bnd.Left;
PointObject.GrpSizeY := Bnd.Bottom - Bnd.Top;
//
if PointObject.FCaptionsViewType = cv_Right then
CurrCaptionAngle := 0;
if PointObject.FCaptionsViewType = cv_Down then
CurrCaptionAngle := 90;
if PointObject.FCaptionsViewType = cv_Left then
CurrCaptionAngle := 180;
if PointObject.FCaptionsViewType = cv_Up then
CurrCaptionAngle := 270;
CurrCaptionAngle := CurrCaptionAngle + 270;
CurrCaptionAngle := round(CurrCaptionAngle) mod 360;
if (CurrCaptionAngle >= 0) and (CurrCaptionAngle <= 45) then
PointObject.FCaptionsViewType := cv_Right
else
if (CurrCaptionAngle > 45) and (CurrCaptionAngle < 135) then
PointObject.FCaptionsViewType := cv_Down
else
if (CurrCaptionAngle >= 135) and (CurrCaptionAngle <= 225) then
PointObject.FCaptionsViewType := cv_Left
else
if (CurrCaptionAngle > 225) and (CurrCaptionAngle < 315) then
PointObject.FCaptionsViewType := cv_Up
else
if (CurrCaptionAngle >= 315) and (CurrCaptionAngle <= 360) then
PointObject.FCaptionsViewType := cv_Right;
PointObject.DefRaizeDrawFigurePos;
//
RefreshCAD(GCadForm.PCad);
PointObject.ReCreateCaptionsGroup(false, false);
end
else
RotateFigure(FFigure, 270);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aRotatePointObject270Execute', E.Message);
end;
//GCanForm.FCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.AppException(Sender: TObject; E: Exception);
var
s: string;
begin
s := E.Message;
if GExitProgEx then
{$if Defined(ES_GRAPH_SC)}
begin
Application.Terminate;
end;
{$else}
ExitProcess(0);
{$ifend}
end;
procedure TFSCS_Main.aShiftUpObjectExecute(Sender: TObject);
//30.05.2011 var
//30.05.2011 i: integer;
//30.05.2011 ConnObjList: TList;
//30.05.2011 LinesList: TList;
begin
try
ShiftObjects(sdUp); //30.05.2011
//30.05.2011
// if ActiveMDIChild <> nil then
// begin
//
// // ñïèñîê âûäåëåííûõ îáúåêòîâ
// ConnObjList := TList.Create;
// LinesList := TList.create;
// for i := 0 to GCadForm.PCad.SelectedCount - 1 do
// begin
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
// if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then
// ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i]));
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
// if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
// LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i]));
// end;
//
// if (ConnObjList.Count > 0) or (LinesList.Count > 0) then
// begin
// // *UNDO*
// if GCadForm.FCanSaveForUndo then
// begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := False;
// end;
// if ConnObjList.Count > 0 then
// ObjectsShiftUp(ConnObjList);
// if LinesList.Count > 0 then
// LinesShiftUp(LinesList);
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
//
// if ConnObjList <> nil then
// FreeAndNil(ConnObjList);
// if LinesList <> nil then
// FreeAndNil(LinesList);
// RefreshCAD(GCadForm.PCad);
// end
// else
// MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftUpObjectExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShieldAssemblySchemeExecute(Sender: TObject);
begin
BuildWiringSchemeList;
end;
procedure TFSCS_Main.aShiftDownObjectExecute(Sender: TObject);
//30.05.2011 var
//30.05.2011 i: integer;
//30.05.2011 ConnObjList: TList;
//30.05.2011 LinesList: TList;
begin
try
ShiftObjects(sdDown); //30.05.2011
//30.05.2011
//if ActiveMDIChild <> nil then
// begin
// // ñïèñîê âûäåëåííûõ îáúåêòîâ
// ConnObjList := TList.Create;
// LinesList := TList.create;
// for i := 0 to GCadForm.PCad.SelectedCount - 1 do
// begin
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
// if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then
// ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i]));
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
// if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
// LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i]));
// end;
// if (ConnObjList.Count > 0) or (LinesList.Count > 0) then
// begin
// // *UNDO*
// if GCadForm.FCanSaveForUndo then
// begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := False;
// end;
// if ConnObjList.Count > 0 then
// ObjectsShiftDown(ConnObjList);
// if LinesList.Count > 0 then
// LinesShiftDown(LinesList);
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
//
// if ConnObjList <> nil then
// FreeAndNil(ConnObjList);
// if LinesList <> nil then
// FreeAndNil(LinesList);
// RefreshCAD(GCadForm.PCad);
//
// if BeforeShiftObjects(ConnObjList, LinesList, FigList) then
// begin
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
// EndShiftObjects(ConnObjList, LinesList, FigList);
// end
// else
// MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftDownObjectExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShiftLeftObjectExecute(Sender: TObject);
//30.05.2011 var
//30.05.2011 i: integer;
//30.05.2011 ConnObjList: TList;
//30.05.2011 LinesList: TList;
//30.05.2011 FigList: TList;
begin
try
ShiftObjects(sdLeft); //30.05.2011
//30.05.2011
//if ActiveMDIChild <> nil then
// begin
// // ñïèñîê âûäåëåííûõ îáúåêòîâ
// ConnObjList := TList.Create;
// LinesList := TList.create;
// for i := 0 to GCadForm.PCad.SelectedCount - 1 do
// begin
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
// if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then
// ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i]));
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
// if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
// LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i]));
// end;
// if (ConnObjList.Count > 0) or (LinesList.Count > 0) then
// begin
// // *UNDO*
// if GCadForm.FCanSaveForUndo then
// begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := False;
// end;
// if ConnObjList.Count > 0 then
// ObjectsShiftLeft(ConnObjList);
// if LinesList.Count > 0 then
// LinesShiftLeft(LinesList);
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
//
// if ConnObjList <> nil then
// FreeAndNil(ConnObjList);
// if LinesList <> nil then
// FreeAndNil(LinesList);
// RefreshCAD(GCadForm.PCad);
//
// if BeforeShiftObjects(ConnObjList, LinesList, FigList) then
// begin
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
// EndShiftObjects(ConnObjList, LinesList, FigList);
// end
// else
// MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftLeftObjectExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShiftRightObjectExecute(Sender: TObject);
//30.05.2011 var
//30.05.2011 i: integer;
//30.05.2011 ConnObjList: TList;
//30.05.2011 LinesList: TList;
//30.05.2011 FigList: TList;
begin
try
ShiftObjects(sdRight); //30.05.2011
//30.05.2011
//if ActiveMDIChild <> nil then
// begin
// // ñïèñîê âûäåëåííûõ îáúåêòîâ
// ConnObjList := TList.Create;
// LinesList := TList.create;
// for i := 0 to GCadForm.PCad.SelectedCount - 1 do
// begin
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
// if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then
// ConnObjList.Add(TConnectorObject(GCadForm.PCad.Selection[i]));
// if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
// if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
// LinesList.Add(TOrthoLine(GCadForm.PCad.Selection[i]));
// end;
// if (ConnObjList.Count > 0) or (LinesList.Count > 0) then
// begin
// // *UNDO*
// if GCadForm.FCanSaveForUndo then
// begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := False;
// end;
// if ConnObjList.Count > 0 then
// ObjectsShiftRight(ConnObjList);
// if LinesList.Count > 0 then
// LinesShiftRight(LinesList);
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
//
// if ConnObjList <> nil then
// FreeAndNil(ConnObjList);
// if LinesList <> nil then
// FreeAndNil(LinesList);
// RefreshCAD(GCadForm.PCad);
//
// if BeforeShiftObjects(ConnObjList, LinesList, FigList) then
// begin
// // *UNDO*
// GCadForm.FCanSaveForUndo := True;
// end;
// EndShiftObjects(ConnObjList, LinesList, FigList);
// end
// else
// MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShiftRightObjectExecute', E.Message);
end;
end;
procedure TFSCS_Main.RegisteredCADHotKeys;
var
GLogFile: TMyLoglist;
begin
end;
procedure TFSCS_Main.UnRegisteredCADHotKeys;
var
GLogFile: TMyLoglist;
begin
end;
function strtoPchar(s:string):Pchar;
begin
S := S+#0;
result:=StrPCopy(@S[1], S) ;
end;
procedure TFSCS_Main.ReceiveMessage;
var
pcd: PCopyDataStruct;
txt: PChar;
begin
try
pcd := PCopyDataStruct(Msg.LParam);
txt := PChar(pcd.lpData);
OpenFileAtStart := txt;
if OpenFileAtStart <> '' then
if FileExists(OpenFileAtStart) then
TimerOpenStart.Enabled := True;
except
end;
Application.Restore;
end;
procedure TFSCS_Main.WMUser(var msg: TMessage);
begin
Application.Restore;
end;
procedure TFSCS_Main.aListPropertiesExecute(Sender: TObject);
var
ListParams: TListParams;
begin
try
if ActiveMDIChild <> nil then
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
F_MasterNewList.Tag := 1;
F_MasterNewList.ListPageControl.ActivePageIndex := 0;
F_MasterNewList.RzGroupBox12.Height := 192;
ListParams := GetListParams(GCadForm.FCADListID);
MakeEditList(meEdit, ListParams, True);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aListPropertiesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aProjectPropertiesExecute(Sender: TObject);
begin
try
F_MasterNewList.Caption := cMasterNewList_Mes3;
F_MasterNewList.GlobalPageControl.ActivePageIndex := 0;
F_MasterNewList.ShowModal;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aProjectPropertiesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aOpenProjectAtCurrNodeExecute(Sender: TObject);
begin
OpenProjectAtCurrNode;
end;
procedure TFSCS_Main.aCloseCurrProjectExecute(Sender: TObject);
begin
// Tolik -- 28/02/20107 -- ñáðîñèòü ñ÷åò÷èê âûçîâîâ ñîîáùåíèÿ î ïðåâûøåíèè êâîòû îáúåêòîâ USER
GUserOBjectsQuotaLimit_Message_Counter := 0;
GCanRefreshCad := False;
//
try
CloseCurrProject(false);
Except
On E: Exception do;
end;
GCanRefreshCad := True; // Tolik -- 03/03/2017 --
// SetMenuStatus(False);
end;
procedure TFSCS_Main.aLoadNewProjectFromFileExecute(Sender: TObject);
// Tolik -- 28/02/20107 -- äëÿ ïðîâåðêè ïðåâûøåíèÿ êâîòû --
var
OldQuotaMessCount: Integer;
//
begin
// {$IF Defined(TRIAL_SCS)}
// ShowMessage('Íåäîñòóïíî â Trial-âåðñèè!');
// {$ELSE}
if GProtectionType <> ltLocal then
begin
ProgProtection.CheckIsVerls(PRO);
ConnCount := ConnCount XOR $1978;
ConnCount := ConnCount SHR 6;
ConnCount := ConnCount AND $0000ffff;
if GetCurrConnectionCount > ConnCount then
exit;
end;
// Tolik -- 21/02/2017 -*-
// LoadNewProjectFromFile;
GUserOBjectsQuotaLimit_Message_Counter := 0; // ïðè îòêðûòèè íîâîãî ïðîåêòà ïîäðàçóìåâàåòñÿ, ÷òî îñòàëüíûå çàêðûòû,
// ïîýòîìó ñ÷åò÷èê ñîîáùåíèé î ïðåâûøåíèè êâîòû îáúåêòîâ USER -*- ñáðàñûâàåì
OldQuotaMessCount := GUserOBjectsQuotaLimit_Message_Counter;
GIsProjectOpening := True; // ÷òîáû ïîíèìàòü, ÷òî â äàííûé ìîìåíò îòêðûâàåòñÿ ïðîåêò
LoadNewProjectFromFile;
if OldQuotaMessCount <> GUserOBjectsQuotaLimit_Message_Counter then
begin
// showmessage('Ïðåâûøåíèå êâîòû! Íåâîçìîæíî çàãðóçèòü ïðîåêò !!! ');
end;
if Assigned(GCadForm) then
begin
F_LayersDialog.LoadFromCADForm(GCadForm);
SetProjectChanged(false);
end;
GIsProjectOpening := False;
//
// SetMenuStatus(True);
// {$IFEND}
end;
procedure TFSCS_Main.aSaveAsSCSProjectExecute(Sender: TObject);
var
i: integer;
SelCheck: integer;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
SelCheck := 0;
if Not IsVista then
begin
Randomize;
SelCheck := Random(100);
if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then
exit;
end;
{$IFEND}
{$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)}
ShowMessage(cMain_Mes9);
{$ELSE}
SaveProjectToFile;
{$IFEND}
end;
{ TMyLoglist }
procedure TMyLoglist.Add(aStr: string);
begin
try
StrList.Add(aStr);
StrList.SaveToFile(FFileName);
except
end;
end;
constructor TMyLoglist.Create(aFName: string);
begin
inherited create;
FFileName := aFName;
StrList := TStringList.Create;
end;
destructor TMyLoglist.Destroy;
begin
StrList.Free;
inherited;
end;
procedure TFSCS_Main.aComponPropertiesExecute(Sender: TObject);
var
ClickFigure: TFigure;
SelCount: integer;
begin
try
if GPopupFigure = Nil then
begin
if GCadForm.PCad.SelectedCount > 0 then
begin
SelCount := GCadForm.PCad.SelectedCount;
GPopupFigure := TFigure(GCadForm.PCad.Selection[SelCount - 1]);
end;
end;
if GPopupFigure <> nil then
EditFirstFigureComponent(GPopupFigure.ID);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aObjPropertiesExecute', E.Message);
end;
end;
procedure TFSCS_Main.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
try
CanClose := False;
GExitProg := False;
CheckClose;
if GExitProg then
CanClose := True;
GexitProg := True;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.FormCloseQuery', E.Message);
end;
end;
procedure TFSCS_Main.aToolPanExecute(Sender: TObject);
var
HPos, VPos: integer;
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
if GCadForm.PCad.Tag = 0 then
begin
{
HPos := GCadForm.PCad.HSCBarPosition;
VPos := GCadForm.PCad.VSCBarPosition;
PDock2.Width := PDock2.Width + 1;
Application.ProcessMessages;
PDock2.Width := PDock2.Width - 1;
GCadForm.PCad.Tag := 1;
GCadForm.PCad.SetHScrollPosition(HPos, False);
GCadForm.PCad.SetVScrollPosition(VPos, True);
}
end;
GIsMousePressed := False;
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
//GCadForm.ChangeScrollsOnChangeListSize;
GCadForm.PCad.SetTool(TPCTool(11), '');
end;
end;
procedure TFSCS_Main.cbScalePropertiesCloseUp(Sender: TObject);
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
if tbCADToolsExpert.Visible then
begin
if cbScaleExpert.ItemIndex = 0 then
if GCadForm.PCad.ZoomScale <> 50 then
a50.Execute;
if cbScaleExpert.ItemIndex = 1 then
if GCadForm.PCad.ZoomScale <> 75 then
a75.Execute;
if cbScaleExpert.ItemIndex = 2 then
if GCadForm.PCad.ZoomScale <> 100 then
a100.Execute;
if cbScaleExpert.ItemIndex = 3 then
if GCadForm.PCad.ZoomScale <> 150 then
a150.Execute;
if cbScaleExpert.ItemIndex = 4 then
if GCadForm.PCad.ZoomScale <> 200 then
a200.Execute;
if cbScaleExpert.ItemIndex = 5 then
if GCadForm.PCad.ZoomScale <> 400 then
a400.Execute;
if cbScaleExpert.ItemIndex = 6 then
aAllScreen.Execute;
end
else
begin
if cbScaleNoob.ItemIndex = 0 then
if GCadForm.PCad.ZoomScale <> 50 then
a50.Execute;
if cbScaleNoob.ItemIndex = 1 then
if GCadForm.PCad.ZoomScale <> 75 then
a75.Execute;
if cbScaleNoob.ItemIndex = 2 then
if GCadForm.PCad.ZoomScale <> 100 then
a100.Execute;
if cbScaleNoob.ItemIndex = 3 then
if GCadForm.PCad.ZoomScale <> 150 then
a150.Execute;
if cbScaleNoob.ItemIndex = 4 then
if GCadForm.PCad.ZoomScale <> 200 then
a200.Execute;
if cbScaleNoob.ItemIndex = 5 then
if GCadForm.PCad.ZoomScale <> 400 then
a400.Execute;
if cbScaleNoob.ItemIndex = 6 then
aAllScreen.Execute;
end;
end;
// RefreshCAD(GCadForm.PCad);
end;
procedure TFSCS_Main.cbScaleExpertKeyPress(Sender: TObject; var Key: Char);
var
val: integer;
begin
if Key = #13 then
begin
if tbCADToolsExpert.Visible then
Val := StrToInt(FSCS_Main.cbScaleExpert.Text)
else
Val := StrToInt(FSCS_Main.cbScaleNoob.Text);
// if Val < 50 then -
// Val := 50;
if Val > GCadForm.PCad.MaxScale then
Val := GCadForm.PCad.MaxScale;
if tbCADToolsExpert.Visible then
FSCS_Main.cbScaleExpert.Text := IntToStr(Val)
else
FSCS_Main.cbScaleNoob.Text := IntToStr(Val);
if GCadForm.PCad.ZoomScale <> val then
begin
GCadForm.SetZoomScale(val);
RefreshCAD(GCadForm.PCad);
end;
end;
end;
procedure TFSCS_Main.cbLayersPropertiesCloseUp(Sender: TObject);
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
GCadForm.CurrentLayer := FSCS_Main.cbLayers.ItemIndex + 1;
if FSCS_Main.tbCADToolsExpert.Visible then
FSCS_Main.tbSelectExpert.Down := True
else
FSCS_Main.tbSelectNoob.Down := True;
end;
try
if (Application.Active) and (GCadForm <> nil) and (GCadForm.PCad <> nil) then
if Not GCadForm.PCad.Focused then
begin
SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0);
GCadForm.PCad.SetFocus;
end;
except
ShowMessage('EXCEPTION: TFSCS_Main.cbLayersPropertiesCloseUp (Set PCAD focus)');
end;
end;
procedure TFSCS_Main.cbLayersCloseUp(Sender: TObject);
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
GCadForm.CurrentLayer := FSCS_Main.cbLayers.ItemIndex;
end;
end;
procedure TFSCS_Main.aDisconnectPointObjectExecute(Sender: TObject);
var
i: integer;
CurObject: TConnectorObject;
SelList: TList;
// Tolik 03/10/2016 --
SavedUndoFlag: Boolean;
//
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
if GPopupFigure = nil then
exit;
SelList := TList.Create;
// îòáîð îáúåêòîâ
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
begin
CurObject := TConnectorObject(GCadForm.PCad.Selection[i]);
if CurObject.ConnectorType <> ct_Clear then
if CurObject.JoinedConnectorsList.Count > 0 then
SelList.Add(CurObject);
end;
end;
if SelList.Count > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to SelList.Count - 1 do
begin
CurObject := TConnectorObject(SelList[i]);
DisconnectPointObject(CurObject);
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
FreeAndNil(SelList);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectPointObjectExecute', E.Message);
end;
//GCadForm.fFCanSaveForUndo := SavedUndoFlag;
end;
procedure TFSCS_Main.cxComboBox1Enter(Sender: TObject);
begin
FSCS_Main.OldApplicationEventsMessage := Application.OnMessage;
Application.OnMessage := FSCS_Main.ApplicationEvents1Message;
end;
procedure TFSCS_Main.mRegisterClick(Sender: TObject);
var
TempList: TStringList;
begin
{$IF Defined (FINAL_SCS)}
//GReadOnlyMode := false;
ProgramRegisterPro := false;
ProgramRegisterTrial := false;
ProgID := ProgProtection.GenProgID;
ProgramRegisterPro := ProgProtection.CheckIsVer(PRO);
ProgramRegisterTrial := ProgProtection.CheckIsVer(TRIAL);
GLicProgCode := ProgIDToStr(ProgID);
if ProgramRegisterTrial then
begin
GReadOnlyMode := True;
ProgramRegisterPro := True;
end;
try
//TempList.Add('0');
RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
except
begin
MessageBeep(MB_ICONASTERISK);
if Not ShowRegistration then
begin
end;
ProgramRegisterPro := ProgProtection.CheckIsVerls(PRO);
ProgramRegisterTrial := ProgProtection.CheckIsVerls(TRIAL);
if ProgramRegisterTrial then
begin
GReadOnlyMode := True;
ProgramRegisterPro := True;
end;
Application.ProcessMessages;
end;
end;
{$ELSE}
GReadOnlyMode := false;
ProgramRegisterPro := True;
GLicProgCode := ProgIDToStr(ProgID);
{$IFEND}
end;
procedure TFSCS_Main.aRepWizardExecute(Sender: TObject);
var
i: integer;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
if Not IsVista then
begin
for i := 0 to 6 do
begin
if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) <> 0 then
begin
exit;
end;
end;
end;
{$IFEND}
CheckCloseReportForm; // Toilk 30/04/2021 --
RepWizard;
end;
procedure TFSCS_Main.aSaveAsBMPExecute(Sender: TObject);
var
FName: string;
FDir: string;
SavePictureDialog: TSavePictureDialog;
begin
if ActiveMDIChild <> nil then
begin
SavePictureDialog := TSavePictureDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.bmp') then
FDir := FDir + '\.bmp';
SavePictureDialog.Title := cMain_Mes56;
SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir;
SavePictureDialog.DefaultExt := 'bmp';
SavePictureDialog.Filter := cMain_Mes57;
if SavePictureDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName));
//
FName := SavePictureDialog.FileName;
GCadForm.SetZoomScale(GCadForm.Pcad.ZoomScale);
RefreshCAD_T(GCadForm.PCad);
GCadForm.PCad.SaveAsBitmap(FName);
GCadForm.SetZoomScale(GCadForm.Pcad.ZoomScale);
RefreshCAD_T(GCadForm.PCad);
except
ShowMessage(cMain_Mes8);
end;
end;
SavePictureDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aShowTracesLengthLimitExecute(Sender: TObject);
begin
try
if aShowTracesLengthLimit.Checked = True then
begin
GCadForm.FShowTracesLengthLimit := True;
DefineTracesWithExceedTwistedPair(GCadForm.FCADListID);
end;
if aShowTracesLengthLimit.Checked = False then
begin
GCadForm.FShowTracesLengthLimit := False;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowTracesLengthLimitExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSaveProjectExecute(Sender: TObject);
var
i: integer;
begin
// Tolik -- 29/12/2016 --
// åñëè ÷òî-òî åùå â ïðîöåññå - íåõóé âûïîëíÿòü çàïèñü, à òî òàêîå ïîíàçàïèñûâàåòñÿ!
if (GIsProgress or (GIsProgressCount > 0)) then
Exit;
//
if GProtectionType <> ltLocal then
begin
ProgProtection.CheckIsVerls(PRO);
ConnCount := ConnCount XOR $1978;
ConnCount := ConnCount SHR 6;
ConnCount := ConnCount AND $0000ffff;
if GetCurrConnectionCount > ConnCount then
exit;
end;
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
if Not IsVista then
begin
for i := 0 to 9 do
begin
if ((ord(bufflic[i mod 16]) XOR $3A) - (Digest[i mod 16]))<> 0 then
begin
exit;
end;
end;
end;
{$IFEND}
try
SaveCurrentProject;
// î÷èñòèòü Undo ëèñòû ïîñëå ñîõðàíåíèÿ ïðîåêòà (íå ôàêò ÷òî íóæíî)
// for i := 0 to MDIChildCount - 1 do
// begin
// TF_CAD(MDIChildren[i]).ClearUndoList;
// end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveProjectExecute', E.Message);
end;
end;
procedure TFSCS_Main.aCurrProjectPropertiesExecute(Sender: TObject);
begin
ShowCurrProjectProperties;
end;
procedure TFSCS_Main.aManual_CurrencyExecute(Sender: TObject);
begin
ShowCurrencyDirectory;
end;
procedure TFSCS_Main.aManual_NettypesExecute(Sender: TObject);
begin
ShowNetTypeDirectory;
end;
procedure TFSCS_Main.aManual_ProducersExecute(Sender: TObject);
begin
ShowProducersDirectory;
end;
procedure TFSCS_Main.aManual_InterfacesExecute(Sender: TObject);
begin
ShowInterfaceDirectory;
end;
procedure TFSCS_Main.aManual_ObjPropExecute(Sender: TObject);
begin
ShowPropertyDirectory;
end;
procedure TFSCS_Main.aManual_LegendsExecute(Sender: TObject);
begin
ShowObjectIconsDirectory;
end;
procedure TFSCS_Main.aManual_ComponTypesExecute(Sender: TObject);
begin
ShowComponentTypesDirectory;
end;
procedure TFSCS_Main.aManual_NormsExecute(Sender: TObject);
begin
ShowNormsDirectory;
end;
procedure TFSCS_Main.aManual_ResourcesExecute(Sender: TObject);
begin
ShowResourcesDirectory;
end;
procedure TFSCS_Main.aManual_NDSExecute(Sender: TObject);
begin
ShowNDSDirectory;
end;
procedure TFSCS_Main.aDesignBoxExecute(Sender: TObject);
var
CurrGCadForm: TF_CAD;
ListID: Integer;
ListCaption: string;
aPopupFigure: TConnectorObject;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
begin
// Ñîçäàíèå ëèñòà Äèçàéíà øêàôà
if TConnectorObject(GPopupFigure).FJoinedListIDForBox = -1 then
begin
F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked := True;
F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked := False;
F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked := False;
if F_ChooseDesignBoxParams.ShowModal = mrOK then
begin
CreateDesignList(TConnectorObject(GPopupFigure));
DisableOptionsForDesignList;
end;
end
else
// Ïåðåîòêðûòèå ëèñòà Äèçàéíà ëèñòà
begin
ListID := TConnectorObject(GPopupFigure).FJoinedListIDForBox;
CurrGCadForm := GetListByID(ListID);
if CurrGCadForm <> nil then
begin
OpenDesignList(TConnectorObject(GPopupFigure), CurrGCadForm);
end
else
begin
aPopupFigure := TConnectorObject(GPopupFigure);
ListCaption := GetListParams(ListID).Caption;
ReOpenListInCAD(ListID, ListCaption);
GPopupFigure := aPopupFigure;
OpenDesignList(TConnectorObject(GPopupFigure), GCadForm);
end;
DisableOptionsForDesignList;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxExecute', E.Message);
end;
end;
procedure TFSCS_Main.aChoiceNBPathExecute(Sender: TObject);
begin
GDatabaseName := '';
ChoiceNBPath;
end;
procedure TFSCS_Main.aChoicePMPathExecute(Sender: TObject);
begin
GDatabaseName := '';
ChoicePMPath;
end;
procedure TFSCS_Main.aChoiceBaseOptionsExecute(Sender: TObject);
begin
ChoiceBaseOptions;
end;
procedure TFSCS_Main.aRegistrationExecute(Sender: TObject);
var
TempList: TStringList;
begin
{$IF Defined (FINAL_SCS)}
//GReadOnlyMode := False;
ProgramRegisterPro := false;
ProgramRegisterTrial := false;
ProgID := ProgProtection.GenProgID;
ProgramRegisterPro := ProgProtection.CheckIsVer(PRO);
ProgramRegisterTrial := ProgProtection.CheckIsVer(TRIAL);
if ProgramRegisterTrial then
begin
GReadOnlyMode := True;
ProgramRegisterPro := True;
end;
GLicProgCode := ProgIDToStr(ProgID);
try
//TempList.Add('0');
RaiseException(EXCEPTION_INT_DIVIDE_BY_ZERO ,0, 0, 0);
except
while 234 <> 912 do
begin
MessageBeep(MB_ICONASTERISK);
if Not ShowRegistration then
begin
end;
ProgramRegisterPro := ProgProtection.CheckIsVerls(PRO);
ProgramRegisterTrial := ProgProtection.CheckIsVerls(TRIAL);
if ProgramRegisterTrial then
begin
GReadOnlyMode := True;
ProgramRegisterPro := True;
end;
if ProgramRegisterPro or ProgramRegisterTrial then
break;
Application.ProcessMessages;
end;
end;
{$ELSE}
GReadOnlyMode := False;
ProgramRegisterPro := True;
GLicProgCode := ProgIDToStr(ProgID);
{$IFEND}
end;
procedure TFSCS_Main.aUpdateNormBaseExecute(Sender: TObject);
begin
UpdateNB;
end;
procedure TFSCS_Main.tbSCSToolsExpertStartDock(Sender: TObject;
var DragObject: TDragDockObject);
begin
tbSCSToolsDocking := true;
end;
procedure TFSCS_Main.tbSCSToolsExpertEndDock(Sender, Target: TObject; X,
Y: Integer);
begin
tbSCSToolsDocking := false;
PDock1.DockSite := true;
pDock2.DockSite := true;
if (F_NormBase <> nil) and (F_ProjMan <> nil) then
begin
F_NormBase.Panel_Main.DockSite := true;
F_ProjMan.Panel_Main.DockSite := true;
end;
end;
procedure TFSCS_Main.FormResize(Sender: TObject);
begin
try
if Assigned(F_FloatPanel) then
if F_FloatPanel.ClassName = 'TF_FloatPanel' then
ResizeFloatPanel;
except
end;
try
if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then
begin
tbSCSToolsExpert.Width := cSCSExpert;
tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width;
end;
if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then
begin
{$IF DEFINED(SCS_PE) or DEFINED(SCS_SPA)}
// Tolik 24/01/2017
//tbSCSToolsNoob.Width := cSCSNoob_PE;
tbSCSToolsNoob.Width := cSCSNoob_PE + 20;
//
{$ELSE}
// Tolik 24/01/2017 --
// tbSCSToolsNoob.Width := cSCSNoob_SCS;
tbSCSToolsNoob.Width := cSCSNoob_SCS + 20;
//
{$IFEND}
// Tolik -- 24/01/2017
// tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width;
tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width;
//
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.FormResize', E.Message);
end;
end;
procedure TFSCS_Main.aHistoryExecute(Sender: TObject);
var
FileName: string;
begin
try
FileName := ExeDir + '\Docs\History.doc';
if FileExists(FileName) then
begin
ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0);
end
else
ShowMessage(cMain_Mes58);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aHistoryExecute', E.Message);
end;
end;
procedure TFSCS_Main.ApplicationEvents1Exception(Sender: TObject;
E: Exception);
begin
addExceptionToLogEx('TFSCS_Main.ApplicationEvents1Exception ', E.Message);
end;
procedure TFSCS_Main.SkipCADPanelChecked;
begin
try
if tbCADToolsExpert.Visible then
begin
if tbSelectExpert.Down then
tbSelectExpert.Down := False;
if tbPanExpert.Down then
tbPanExpert.Down := False;
if tbLineExpert.Down then
tbLineExpert.Down := False;
//Tolik 23/07/2017 --
if tbPieExpert.Down then
tbPieExpert.Down := False;
//
if tbRectangleExpert.Down then
tbRectangleExpert.Down := False;
if tbEllipseExpert.Down then
tbEllipseExpert.Down := False;
if tbCircleExpert.Down then
tbCircleExpert.Down := False;
if tbArcExpert.Down then
tbArcExpert.Down := False;
if tbElipticArcExpert.Down then
tbElipticArcExpert.Down := False;
if tbPolyLineExpert.Down then
tbPolyLineExpert.Down := False;
if tbPointExpert.Down then
tbPointExpert.Down := False;
if tbTextExpert.Down then
tbTextExpert.Down := False;
if tbRichTextExpert.Down then
tbRichTextExpert.Down := False;
if tbKnifeExpert.Down then
tbKnifeExpert.Down := False;
if tbHDimLineExpert.Down then
tbHDimLineExpert.Down := False;
if tbVDimLineExpert.Down then
tbVDimLineExpert.Down := False;
if tbSCSHDimLineExpert.Down then
tbSCSHDimLineExpert.Down := False;
if tbSCSVDimLineExpert.Down then
tbSCSVDimLineExpert.Down := False;
if tbSCSArcDimLineExpert.Down then
tbSCSArcDimLineExpert.Down := False;
if tbCabinetExpert.Down then
tbCabinetExpert.Down := False;
if tbWallRectExpert.Down then
tbWallRectExpert.Down := False;
if tbWallPathExpert.Down then
tbWallPathExpert.Down := False;
if tbCreateOnClickModeExpert.Down then
tbCreateOnClickModeExpert.Down := False;
if tbToolOrtholineExpert.Down then
tbToolOrtholineExpert.Down := False;
if tbToolOrtholineExtExpert.Down then
tbToolOrtholineExtExpert.Down := False;
end
else
begin
if tbSelectNoob.Down then
tbSelectNoob.Down := False;
if tbSCSHDimLineNoob.Down then
tbSCSHDimLineNoob.Down := False;
if tbSCSVDimLineNoob.Down then
tbSCSVDimLineNoob.Down := False;
if tbSCSArcDimLineNoob.Down then
tbSCSArcDimLineNoob.Down := False;
if tbCabinetNoob.Down then
tbCabinetNoob.Down := False;
if tbCabinetExtNoob.Down then
tbCabinetExtNoob.Down := False;
if tbWallRectNoob.Down then
tbWallRectNoob.Down := False;
if tbWallPathNoob.Down then
tbWallPathNoob.Down := False;
if tbCreateOnClickModeNoob.Down then
tbCreateOnClickModeNoob.Down := False;
if tbToolOrtholineNoob.Down then
tbToolOrtholineNoob.Down := False;
if tbToolOrtholineExtNoob.Down then
tbToolOrtholineExtNoob.Down := False;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.SkipCADPanelChecked', E.Message);
end;
end;
procedure TFSCS_Main.aConnectionsConfiguratorExecute(Sender: TObject);
begin
try
ShowConfigurator;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aConnectionsConfiguratorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aNoMoveConnectedObjectsExecute(Sender: TObject);
begin
try
if aNoMoveConnectedObjects.Checked then
GCadForm.FNoMoveConnectedObjects := True
else
GCadForm.FNoMoveConnectedObjects := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNoMoveConnectedObjectsExecute', E.Message);
end;
end;
procedure TFSCS_Main.TimerProcessMessagesTimer(Sender: TObject);
begin
try
TimerProcessMessages.Enabled := False;
Application.ProcessMessages;
TimerProcessMessages.Enabled := True;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.TimerProcessMessagesTimer', E.Message);
end;
end;
procedure TFSCS_Main.aRealignObjectExecute(Sender: TObject);
var
i: integer;
FFigure: TFigure;
SelectedList: TList;
// Tolik -- 03/10/2016 --
SavedUndoFlag: Boolean;
//
begin
if GPopupFigure = nil then
exit;
if ActiveMDIChild <> nil then
begin
SavedUndoFlag := GCadForm.FCanSaveForUndo;
try
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
ReAlignObject(TConnectorObject(GPopupFigure));
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRealignObjectExecute', E.Message);
end;
//GCadForm.FCanSaveForUndo := SavedUndoFlag;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.FormShow(Sender: TObject);
var
temps : string;
t : word;
innt: integer;
tmr: integer;
tempall: string;
temp3: string;
is_trial: boolean;
is_flash: boolean;
s: string;
begin
//Tolik 03/01/2025 --
GFtpConnectStr := ReadSetting(fnSCSIniFile, dtString, scReservFtp, idtConnectString, '');
mnuReserv.Enabled := GFtpConnectStr <> '';
//
// Tolik 06/11/2019 --
WindowState := wsMaximized;
Width := Screen.Width;
Height := Screen.Height;
//
//RecreateWnd;
{$IF Defined(SCS_PE) or DEFINED(SCS_SPA)}
aToolHouse.Visible := False;
//Tolik 17/08/2021 --
//tbCADToolsNoob.Width := cCADNoob_PE;
//tbCADToolsNoob2.Width := cCADNoob_PE;
tbCADToolsNoob.Width := cCADNoob_PE+20;
tbCADToolsNoob2.Width := cCADNoob_PE - 100;
tbCADToolsNoob2.Left := tbCADToolsNoob.Width + 25;
tbCADToolsNoob2.Top := tbCADToolsNoob.Top;
//
{$ELSEIF Defined(TELECOM)}
aToolHouse.Visible := False;
tbCADToolsNoob.Width := cCADNoob_TEL;
tbCADToolsNoob2.Width := cCADNoob_TEL;
{$ELSE}
aToolHouse.Visible := True;
tbCADToolsNoob.Width := cCADNoob_SCS;
//Tolik 17/08/2021 --
//tbCADToolsNoob2.Width := cCADNoob_SCS;
tbCADToolsNoob2.Width := cCADNoob_SCS - 100;
tbCADToolsNoob2.Left := tbCADToolsNoob.Width + 25;
tbCADToolsNoob2.Top := tbCADToolsNoob.Top;
//
{$IFEND}
if OpenFileAtStart <> '' then
TimerOpenStart.Enabled := True;
FSCS_Main.aRegHotKeys.Execute;
try
if isAutoShowPanel then
ShowFloatPanel;
except
end;
SetProjectChanged(False);
SetMenuStatus(False);
aManual_Interfaces.Visible := GUseVisibleInterfaces;
hints_prog_id := 'scs_ua';
{$if Defined(ES_GRAPH_SC)}
hints_prog_id := 'graph_sc';
{$ELSE}
{$IF DEFINED(SCS_PE)}
hints_prog_id := 'cp';
{$ELSE}
{$IF Defined(SCS_PANDUIT)}
hints_prog_id := 'panduitcad';
{$ELSE}
{$IF Defined (SCS_RF)}
hints_prog_id := 'scs_rf';
{$ELSE}
hints_prog_id := 'scs_ua';
{$IFEND}
{$IFEND}
{$IFEND}
{$IFEND}
hints_prog_id := hints_prog_id + '_' + FastReplace(versionEXE, '.', '');
{$IF Defined(TRIAL_SCS)}
hints_prog_id := hints_prog_id + '_' + 'trial';
{$IFEND}
stat_prog_id := hints_prog_id;
{$IF Defined(FLASH_SCS)}
stat_prog_id := stat_prog_id + '_' + 'flash';
{$IFEND}
is_trial := false;
is_flash := false;
{$IF Defined(TRIAL_SCS)}
is_trial := true;
{$IFEND}
{$IF Defined(FLASH_SCS)}
is_flash := true;
{$IFEND}
if GSendInfo then
begin
try
s := ProgID.Data1 + '-' + ProgID.Data2 + '-' +
ProgID.Data3 + '-' + ProgID.Data4 + '-' + DateID;
s := FormatForUser(s);
tempall := FormatForUser(ProgProtection.AnswerReg.Data1) +
'-' + FormatForUser(ProgProtection.AnswerReg.Data2);
if ProgProtection.AnswerReg.Data3 = '' then
ProgProtection.AnswerReg.Data3 := '1111';
temp3 := inttostr(strtoint('$' + FormatForProg(ProgProtection.AnswerReg.Data3)));
while length(temp3) < 5 do
insert('0', temp3, 1);
tempall := tempall + '-' + temp3 +
'-' + FormatForUser(ProgProtection.AnswerReg.Data4);
except
end;
try
SendStat('http://admin.cableproject.net/stat/sendstat.php', 'scs', stat_prog_id, VersionEXE, DateEXE, s, tempall, is_trial, is_flash);
except
end;
end;
F_HintW.Caption := '';
try
CheckAndShowHint('http://admin.cableproject.net/hints/' + hints_prog_id + '/index.html', hints_prog_id, FSCS_Main, 7, True);
except
end;
TimerNews.OnTimer := nil;
TimerNews.Enabled := False;
if PROG_NEWSID <> '-1' then
begin
try
temps := ExtractFilePath(application.ExeName)+'news\mess.txt';
case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html',SiteUrlNews + 'expert_news/expert_news.html', temps, 2, t) of
0:begin
innt:=t*60*1000;
tmr:=innt;
TimerNews.Interval := tmr;
end;
// 1:begin ShowMessage('Îøèáêà çàãðóçêè áèáëèîòåêè'); end;
// 2:begin ShowMessage('Îøèáêà âûçîâà ïðîöåäóðû'); end;
// 3:begin ShowMessage('Îøèáî÷íûé ïàðàìåòð âûçîâà'); end;
// 4:begin ShowMessage('Îøèáêà âûïîëíåíèÿ ïðîöåäóðû'); end;
end;
Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 0, t);
except
end;
TimerNews.Enabled := True;
TimerNews.OnTimer := TimerNewsTimer;
end;
//Tolik 13/09/2021 --
if not GNewVesrChecked then
begin
try
GNewVesrChecked := True;
CheckForNewVersion(VersionEXE, BuildEXE, nil);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.CheckForNewVersion', E.Message);
end;
end;
end;
procedure TFSCS_Main.TimerOpenStartTimer(Sender: TObject);
begin
if GIsProgress or GNowOpen then
begin
end
else
begin
TimerOpenStart.Enabled := False;
GNowOpen := True;
try
if OpenFileAtStart <> '' then
if FileExists(OpenFileAtStart) then
F_ProjMan.LoadProjectFromFile(OpenFileAtStart);
except
end;
GNowOpen := False;
OpenFileAtStart := '';
end;
end;
procedure TFSCS_Main.TimerRefreshTimer(Sender: TObject);
begin
if Not TF_CAD(GRefreshCad.Owner).InGUIEvent then
begin
TF_CAD(GRefreshCad.Owner).InGUIEvent := True;
TimerRefresh.Enabled := False;
TimerRefresh.Interval := 50;
try
GRefreshCad.Refresh;
except
end;
TF_CAD(GRefreshCad.Owner).InGUIEvent := False;
//Tolik 31/10/2015
{if TF_CAD(GRefreshCad.Owner).GisAction then
GRefreshCad.EventEngine(95,1,'',0);}
if TF_CAD(GRefreshCad.Owner).GisEventWaiting then
GRefreshCad.EventEngine(95,1,'',0);
end
end;
procedure TFSCS_Main.TimerTracingIntervalTimer(Sender: TObject);
begin
GDropTracing := true;
FSCS_Main.TimerTracingInterval.Enabled := false;
//showmessage('TracingTimer');
end;
procedure TFSCS_Main.FOnAppActivate(Sender: TObject);
begin
if not GAppMinim then
begin
try
if MDIChildCount > 0 then
ReDrawCurrShadowOnCAD;
aRegHotKeys.Execute;
except
// on E: Exception do addExceptionToLogEx('TFSCS_Main.FOnAppActivate', E.Message);
end;
end;
end;
procedure TFSCS_Main.aClearGuidesExecute(Sender: TObject);
begin
try
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
GCadForm.PCad.ClearGuides;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
except//
on E: Exception do addExceptionToLogEx('TFSCS_Main.aClearGuidesExecute', E.Message);
end;
end;
procedure TFSCS_Main.AppMinima(Sender: TObject);
begin
GAppMinim := true;
end;
procedure TFSCS_Main.aSaveToIBDExecute(Sender: TObject);
begin
{$if Defined(ES_GRAPH_SC)}
SaveProjectForSC;
{$else}
//10.01.2012 SaveProjectToIBD(F_ProjMan.GSCSBase.CurrProject);
SaveProjectToSmeta(F_ProjMan.GSCSBase.CurrProject);
{$ifend}
end;
procedure TFSCS_Main.aToolSCSHDimLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
SetLayerForDraw; //16.05.2011 aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TSCSHDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aToolSCSVDimLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
SetLayerForDraw; //16.05.2011 aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TSCSVDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aToolWallRectExecute(Sender: TObject);
begin
try
if ActiveMDIChild <> nil then
begin
DropDownFirstToolbar; // Tolik 10/02/2021 --
RaiseActiveNet(GCadForm);
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 8;
GCadForm.PCad.SetTool(toFigure, 'TWallRect');
tbWallRectNoob.Down := True; // Tolik 10/02/2021 --
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolWallRectExecute', E.Message);
end;
end;
procedure TFSCS_Main.SetShowPathLengthType(aPathLengthType: TShowPathLengthType);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.SetShowPathLengthType(aPathLengthType);
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADShowPathLengthType := Ord(aPathLengthType);
SaveCADListParams(GCadForm.FCADListID, CurListParams);
RefreshCAD(GCadForm.PCad);
end;
end;
procedure TFSCS_Main.SetShowPathTraceLengthType(aPathLengthType: TShowPathLengthType);
var
CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
GCadForm.SetShowPathTraceLengthType(aPathLengthType);
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.CADShowPathTraceLengthType := Ord(aPathLengthType);
SaveCADListParams(GCadForm.FCADListID, CurListParams);
RefreshCAD(GCadForm.PCad);
end;
end;
procedure TFSCS_Main.SetToolArch(const aTool: string; aToolData: Integer=0);
begin
try
if ActiveMDIChild <> nil then
begin
RaiseActiveNet(GCadForm);
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 8;
GCadForm.PCad.SetTool(toFigure, aTool, aToolData);
tbCreateOnClickModeExpert.Down := True;
tbCreateOnClickModeNoob.Down := True;
tbSelectExpert.Down := False;
tbSelectNoob.Down := False;
end;
except
end;
end;
procedure TFSCS_Main.ShiftObjects(AShiftDirection: Integer);
var
i: integer;
ConnObjs: TList;
LineObjs: TList;
Objs: TList;
begin
if ActiveMDIChild <> nil then
begin
ConnObjs := TList.Create;
LineObjs := TList.Create;
Objs := TList.Create;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
begin
if TConnectorObject(GCadForm.PCad.Selection[i]).ConnectorType <> ct_clear then
ConnObjs.Add(TConnectorObject(GCadForm.PCad.Selection[i]));
end
else if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTOrthoLine) then
begin
if not TOrthoLine(GCadForm.PCad.Selection[i]).FIsRaiseUpDown then
LineObjs.Add(TOrthoLine(GCadForm.PCad.Selection[i]));
end
else
Objs.Add(TObject(TObject(GCadForm.PCad.Selection[i])));
end;
if (ConnObjs.Count > 0) or (LineObjs.Count > 0) or (Objs.Count > 0) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
case AShiftDirection of
sdUp:
begin
if ConnObjs.Count > 0 then
ObjectsShiftUp(ConnObjs);
if LineObjs.Count > 0 then
LinesShiftUp(LineObjs);
if Objs.Count > 0 then
MoveFigures(Objs, 0, -0.1);
end;
sdDown:
begin
if ConnObjs.Count > 0 then
ObjectsShiftDown(ConnObjs);
if LineObjs.Count > 0 then
LinesShiftDown(LineObjs);
if Objs.Count > 0 then
MoveFigures(Objs, 0, 0.1);
end;
sdLeft:
begin
if ConnObjs.Count > 0 then
ObjectsShiftLeft(ConnObjs);
if LineObjs.Count > 0 then
LinesShiftLeft(LineObjs);
if Objs.Count > 0 then
MoveFigures(Objs, -0.1, 0);
end;
sdRight:
begin
if ConnObjs.Count > 0 then
ObjectsShiftRight(ConnObjs);
if LineObjs.Count > 0 then
LinesShiftRight(LineObjs);
if Objs.Count > 0 then
MoveFigures(Objs, 0.1, 0);
end;
end;
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
if ConnObjs <> nil then
FreeAndNil(ConnObjs);
if LineObjs <> nil then
FreeAndNil(LineObjs);
if Objs <> nil then
FreeAndNil(Objs);
RefreshCAD(GCadForm.PCad);
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
// Tolik 09/08/2019 - -
procedure AutoFitBitMap(Bmp: TBMPObject);
var
ScaleKoef1: double;
ScaleKoef2: double;
begin
{ if GAutoScaleRasterImages then // ñêåéëèòü êàðòèíêó, òîëüêî åñëè âêëþ÷åíà ñîîòâåòñòâóþùàÿ îïöèÿ â íàñòðîéêàõ
// (Ìàñøòàáèðîâàòü ðàñòðîâûå èçîáðàæåíèÿ, ïðåâûøàþùèå ðàçìåðû ëèñòà)
begin
if (GCadForm.PCad.WorkWidth*0.95 < Bmp.ap3.x) or (GCadForm.PCad.WorkHeight*0.95 < Bmp.ap3.y) then
begin
ScaleKoef1 := GCadForm.PCad.WorkWidth*0.95 / Bmp.ap3.x;
ScaleKoef2 := GCadForm.PCad.WorkHeight*0.95 / Bmp.ap3.y;
if ScaleKoef1 < ScaleKoef2 then
Bmp.Scale(ScaleKoef1, ScaleKoef1, Bmp.ap1)
else
Bmp.Scale(ScaleKoef2, ScaleKoef2, Bmp.ap1)
end;
end;
}
ScaleKoef1 := (GCadForm.PCad.WorkWidth - Bmp.ap3.x) / 2;
ScaleKoef2 := (GCadForm.PCad.WorkHeight - Bmp.ap3.y) / 2;
Bmp.move(ScaleKoef1, ScaleKoef2);
end;
{
procedure AutoFitBitMap(Bmp: TBMPObject);
var
ScaleKoef1: double;
ScaleKoef2: double;
begin
if (GCadForm.PCad.WorkWidth*0.95 < Bmp.ap3.x) or (GCadForm.PCad.WorkHeight*0.95 < Bmp.ap3.y) then
begin
ScaleKoef1 := GCadForm.PCad.WorkWidth*0.95 / Bmp.ap3.x;
ScaleKoef2 := GCadForm.PCad.WorkHeight*0.95 / Bmp.ap3.y;
if ScaleKoef1 < ScaleKoef2 then
Bmp.Scale(ScaleKoef1, ScaleKoef1, Bmp.ap1)
else
Bmp.Scale(ScaleKoef2, ScaleKoef2, Bmp.ap1)
end;
ScaleKoef1 := (GCadForm.PCad.WorkWidth - Bmp.ap3.x) / 2;
ScaleKoef2 := (GCadForm.PCad.WorkHeight - Bmp.ap3.y) / 2;
Bmp.move(ScaleKoef1, ScaleKoef2);
end;
}
procedure TFSCS_Main.LoadSubstrateEx(aReplace: Boolean);
var
FName, FExt: string;
i: integer;
FDir: string;
OpenDialog: TOpenDialog;
Jpeg: TJpegImage;
Bmp: TBMPObject;
Bitmp: TBitmap;
BitmapHandle: TFigHandle;
Fig: TFigure;
SavedDrawingRect: TDoubleRect;
CanRestoreParams: Boolean;
Flag: Boolean;
procedure RemoveSubstrate;
begin
CanRestoreParams := false;
if aReplace then
begin
//SavedDrawingRect := GCadForm.PCad.GetDrawingRect;
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.SelectAll(lnSubstrate);
CanRestoreParams := GCadForm.PCad.Selection.Count > 0;
if CanRestoreParams then
begin
SavedDrawingRect := GCadForm.PCad.GetSelectionRect;
//GCadForm.DeleteLayerAllObjects(lnSubstrate, false);
GCadForm.DeleteSelection(false);
end;
end;
end;
procedure RestoreParams;
var
DrawingRect: TDoubleRect;
rp: TDoublePoint;
NewH, NewW, OldH, OldW: Double;
begin
if aReplace then
if CanRestoreParams then
begin
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.SelectAll(lnSubstrate);
if GCadForm.PCad.Selection.Count > 0 then
begin
DrawingRect := GCadForm.PCad.GetSelectionRect;
GCadForm.PCad.MoveSelection(SavedDrawingRect.Left - DrawingRect.Left, SavedDrawingRect.Top - DrawingRect.Top);
rp := DoublePoint(SavedDrawingRect.Left, SavedDrawingRect.Top);
NewH := DrawingRect.Bottom - DrawingRect.Top;
NewW := DrawingRect.Right - DrawingRect.Left;
OldH := SavedDrawingRect.Bottom - SavedDrawingRect.Top;
OldW := SavedDrawingRect.Right - SavedDrawingRect.Left;
GCadForm.PCad.ScaleSelection(OldW/NewW, OldH/NewH, rp);
end;
end;
end;
begin
bmp := Nil; // Tolik 09/08/2019 --
Flag := GisUserDimLine;
if ActiveMDIChild <> nil then
begin
OpenDialog := TOpenDialog.Create(Self);
OpenDialog.Title := cMain_Mes4;
OpenDialog.InitialDir := ExtractDirByCategoryType(dctBackgLayers);
OpenDialog.Filter := cMain_MesAllFormats +'|' + cMain_Mes5 + '|' + cMain_Mes124 +'|'+ cMain_Mes125_ +'|'+
cProgressExp_Msg9_1 +'|'+ GetDialogFilter(exdAll, '*');
OpenDialog.DefaultExt := 'dxf';
if OpenDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctBackgLayers, ExtractFileDir(OpenDialog.FileName));
//
FName := AnsiLowerCaseFileName(OpenDialog.FileName);
FExt := ExtractFileExt(FName);
if FExt = '.scb' then
begin
RemoveSubstrate;
LoadSubstrate(FName);
RestoreParams;
end
else if (FExt = '.dxf') or (FExt = '.dwg') or (FExt = '.svg') or (FExt = '.prn') or (FExt = '.plt') or (FExt = '.wmf') then
begin
RemoveSubstrate;
// Åñëè âîññòàíàâëèâàåì ðàçìåðû ïî ïðåäûäóùåé ïîäëîæêå, îò íå çàäàåì âîïðîñ íà ñ÷åò ìàñøòàáèðîâàíèÿ ÷åðåç CanRestoreParams
LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124, FName, Not CanRestoreParams);
RestoreParams;
end
//Tolik 11/08/2021 --
//else if (FExt = '.bmp') or (FExt = '.jpg') or (FExt = '.jpeg') then
else if (FExt = '.bmp') or (FExt = '.jpg') or (FExt = '.jpeg') or (FExt = '.png') then
//
begin
RemoveSubstrate;
aSetSubstrateLayer.Execute;
if FExt = '.bmp' then
begin
// Toilk 09/08/2019 --
//Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if BitmapHandle <> -1 then
Bmp := TBMPObject(BitmapHandle)
else
GisUserDimLine := False; // Tolik 11/08/2021 --
//
end
else
begin
// Tolik 09/08/2019 --
//Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if BitmapHandle <> -1 then
Bmp := TBMPObject(BitmapHandle)
else
GisUserDimLine := False; // Tolik 11/08/2021 --
// Ýòî âîîáùå ïîêà ÷òî íåïîíÿòíî, çà÷åì ....
{Jpeg := TJpegImage.create;
Jpeg.LoadFromFile(FName);
Bmp.Picture.Width := Jpeg.Width;
Bmp.Picture.Height := Jpeg.Height;
Bmp.Picture.Canvas.Draw(0, 0, Jpeg);
Bmp.Picture.PixelFormat := pf24bit;
FreeAndNil(Jpeg);}
end;
RestoreParams;
//if Not aReplace then
if Not CanRestoreParams then
begin
if Bmp <> nil then // Tolik 09/08/2019 --
AutoFitBitmap(Bmp)
else
GisUserDimLine := False; // Tolik 11/08/2021 --
end;
//Tolik 11/08/2021 --
end
else if FExt = '.pdf' then
begin
Bitmp := CreateFPDFView.GetDocBitmap(cMain_Mes136, FName);
GisUserDimLine := Flag;
if Bitmp <> nil then
begin
try
RemoveSubstrate;
FName := ExtractSCSTempDir + GetUniqueFileName('', enBmp);
Bitmp.SaveToFile(FName);
Bitmp.Free;
//Tolik 03/09/2021 - -
aSetSubstrateLayer.Execute;
BitmapHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if BitmapHandle <> -1 then
begin
Fig := TFigure(BitmapHandle);
//Fig := TFigure(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
Fig.width := 0; // Óáèðàåì ðàìêó
GCadForm.PCad.DeselectAll(0);
DeleteFile(FName);
RestoreParams;
end
else
GisUserDimLine := False; // Tolik 11/08/2021 --
//if Not aReplace then
if Not CanRestoreParams then
begin
AutoFitBitmap(TBMPObject(Fig));
end;
except
ShowMessage(cMain_Mes6);
GisUserDimLine := False; // Tolik 11/08/2021 --
end;
RefreshCAD(GCadForm.PCad);
end
else
GisUserDimLine := False; // Tolik 11/08/2021 --
end;
GCadForm.PCad.DeselectAll(0);
except
ShowMessage(cMain_Mes6);
end;
{
FSCS_Main.tbSelectExpert.Down := False;
FSCS_Main.tbSelectNoob.Down := False;
FSCS_Main.tbPanExpert.Down := True;
FSCS_Main.tbPanNoob.Down := True;
FSCS_Main.aToolPan.Execute;
}
RefreshCAD(GCadForm.PCad);
end
else
GisUserDimLine := False; // Tolik 11/08/2021 --
OpenDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.SetFigureAsEndObject(aCad: TForm; aFigure: TFigure);
var
EndPoint: TFigure;
begin
try
if aFigure = nil then
exit;
try
EndPoint := aFigure;
if CheckFigureByClassName(aFigure, cTConnectorObject) then
TConnectorObject(EndPoint).AsEndPoint := True
else
if CheckFigureByClassName(aFigure, cTHouse) then
THouse(EndPoint).AsEndPoint := True;
if EndPoint = GEndPoint then
Exit;
except
EndPoint := Nil;
end;
// ñáðîñèòü áûâøèé ÊÎ
if GEndPoint <> nil then
begin
if CheckFigureByClassName(GEndPoint, cTConnectorObject) then
TConnectorObject(GEndPoint).AsEndPoint := False
else
if CheckFigureByClassName(GEndPoint, cTHouse) then
THouse(GEndPoint).AsEndPoint := False;
if (GListWithEndPoint <> aCad) and (GListWithEndPoint <> nil) then
begin
RefreshCAD(GListWithEndPoint.PCad);
RefreshCAD(GListWithEndPoint.PCad);
end;
RefreshCAD(TF_CAD(aCad).PCad);
GListWithEndPoint := Nil;
end;
RefreshCAD(TF_CAD(aCad).PCad);
GCadForm.mProtocol.Lines.Add(cEndPoints_Mes1 + EndPoint.Name + cEndPoints_Mes2);
// ïåðåíàçíà÷èòü íîâûé
GEndPoint := EndPoint;
GListWithEndPoint := GCadForm;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.SetFigureAsEndObject', E.Message);
end;
end;
procedure TFSCS_Main.CustomizeNewList; //27.06.2013
var
IDFloor: Integer;
ListForPassage: TF_CAD;
SavedCAD: TF_CAD;
WasPausedProgress: Boolean;
OldUserDimLine: Boolean;
begin
//27.06.2013 - ïîäãðóçêà ïîäëîæêè ñ çàìåíîé ñóùåñòâóþùåé, ñîõðàíÿÿ ðàçìåðû/ïîçèöèè
Application.ProcessMessages;
WasPausedProgress := False;
if GIsProgress then
begin
PauseProgress(True);
WasPausedProgress := True;
end;
if not GisListCopy then //Tolik 16/06/2021 -- íå çàãðóæàòü ïîäëîæêó, åñëè êîïèÿ ëèñòà
begin
//Tolik 11/08/2021 --
//LoadSubstrateEx(true);
GisUserDimLine := True;
LoadSubstrateEx(true);
OldUserDimLine := GisUserDimLine;
//
end;
if WasPausedProgress then
PauseProgress(False);
{//25.06.2013 - âûáîð ìåñòà äëÿ ì-ý íà íîâîì ëèñòå, Ïîêà ÍÅ ÓÄÀËßÒÜ!!!!!!!!
IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1);
ListForPassage := nil;
if IDFloor > 0 then
begin
ListForPassage := GetListByID(IDFloor);
if ListForPassage <> nil then
begin
// Òóëçà ñîçäàíèÿ ì-ý ïåðåõîäà
if MessageQuastYN(cMain_Mes139) = IDYES then
begin
Application.ProcessMessages;
if GCadForm.CurrentLayer <> lnSCSCommon then
GCadForm.CurrentLayer := lnSCSCommon;
GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName);
end;
end;
end;}
{$if Not Defined(ES_GRAPH_SC)}
//25.06.2013 - âûáîð ìåñòà äëÿ ì-ý íà ëèñòå íèæå
IDFloor := GetListIDForCreatePassage(GCadForm.FCADListID, -1);
ListForPassage := nil;
if IDFloor > 0 then
begin
ListForPassage := GetListByID(IDFloor);
if ListForPassage <> nil then
begin
// Tolik 21/04/2017 --
WasPausedProgress := False;
if GIsProgress then
begin
PauseProgress(True);
WasPausedProgress := True;
end;
//
{
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
tbSCSHDimLineExpert.click
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
}
// Òóëçà ñîçäàíèÿ ì-ý ïåðåõîäà
if MessageQuastYN(cMain_Mes139) = IDYES then
begin
Application.ProcessMessages;
SavedCAD := GCADForm;
try
GCADForm := ListForPassage;
GCadForm.BringToFront;
if GCadForm.CurrentLayer <> lnSCSCommon then
GCadForm.CurrentLayer := lnSCSCommon;
GCadForm.PCad.SetTool(toFigure, TBetweenFloorUpVertex.ClassName);
ShowHintRzR(cMain_Mes145, 5000); // Tolik 23/09/2021 --
finally
//Tolik 12/08/2021 --
if not GisListCopy then
GisUserDimLine := OldUserDimLine;
//
//GCADForm := SavedCAD;
//GCadForm.BringToFront;
end;
end
else
begin
//Tolik 11/08/2021 --
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
end;
if WasPausedProgress then
PauseProgress(False);
end;
end
else
begin
//Tolik 11/08/2021 --
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
end;
{$ifend}
end;
procedure TFSCS_Main.aToolWallPathExecute(Sender: TObject);
begin
try
if ActiveMDIChild <> nil then
begin
DropDownFirstToolbar; // Tolik 10/02/2021 --
RaiseActiveNet(GCadForm);
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 8;
GCadForm.PCad.SetTool(toFigure, 'TWallPath');
tbWallPathNoob.Down := True;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolWallPathExecute', E.Message);
end;
end;
procedure TFSCS_Main.aToolHouseExecute(Sender: TObject);
begin
try
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 2;
GCadForm.PCad.SetTool(toFigure, 'THouseTool');
DropDownFirstToolbar; // Tolik 10/02/2021 --
tbHouseNoob.Down := True;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aToolHouseExecute', E.Message);
end;
end;
// 0 - Óäàëèòü ñåãìåíò
procedure TFSCS_Main.aDeleteWallPathExecute(Sender: TObject);
var
CurNet: TNet;
mess: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
CurNet := TNet(GCadForm.PCad.Selection[0]);
if CurNet.SelPath <> nil then
begin
mess := cMain_Mes37;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes38, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes38), MB_YESNO) = IDYes then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, (CurNet.FComponID <> 0), False);
GCadForm.FCanSaveForUndo := false;
end;
CurNet.DeleteSelected;
// Tolik 18/10/2016 --
// åñëè óäàëåíà ïîñëåäíÿÿ ñòåíà - óäàëèòü è êîìíàòó âìåñòå ñ ïîëîì è ïîòîëêîì, ÷òîá íå âàëÿëàñü â ÏÌ
if CurNet.Paths.Count = 0 then
begin
CurNet.DeleteNet;
RefreshCAD(GCadForm.PCad);
RaiseActiveNet(GCadForm);
end
else
RefreshCAD(GCadForm.PCad);
//
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWallPathExecute', E.Message);
end;
end;
// 1 - Óäàëèòü ïëàí
procedure TFSCS_Main.aDeleteWallRectExecute(Sender: TObject);
var
i: integer;
CurNet: TNet;
CurPath: TNetPath;
CurCol: TNetCol;
mess: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
mess := cMain_Mes39;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes40, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes40), MB_YESNO) = IDYes then
begin
CurNet := TNet(GCadForm.PCad.Selection[0]);
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, (CurNet.FcomponID <> 0), False);
GCadForm.FCanSaveForUndo := false;
end;
//04.06.2010
//i := 0;
//while i < CurNet.Paths.Count do
//begin
// CurPath := TNetPath(CurNet.Paths[i]);
// CurNet.DeletePath(CurPath);
//end;
//i := 0;
//while i < CurNet.Structs.Count do
//begin
// CurCol := TNetCol(CurNet.Structs[i]);
// CurNet.DeleteStruct(CurCol);
//end;
//GCadForm.PCad.Figures.Remove(CurNet);
CurNet.DeleteNet;
RefreshCAD(GCadForm.PCad);
RaiseActiveNet(GCadForm);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWallRectExecute', E.Message);
end;
end;
// 2 - Ðàçäåëèòü ñåãìåíò
procedure TFSCS_Main.aDivSelPathExecute(Sender: TObject);
var
CurNet: TNet;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
CurNet := TNet(GCadForm.PCad.Selection[0]);
if CurNet.SelPath <> nil then
begin
// *UNDO*
//if GCadForm.FCanSaveForUndo then
//begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := false;
//end;
GCadForm.BeginSaveForUndo(uat_None, CurNet.FComponID <> 0, False);
try
CurNet.DivSelPath;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
finally
GCadForm.EndSaveForUndo;
end;
//GCadForm.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDivSelPathExecute', E.Message);
end;
end;
// 3 - Óñòàíîâèòü øèðèíó ñåãìåíòà
procedure TFSCS_Main.aSetWallPathWidthExecute(Sender: TObject);
var
i, j: integer;
tempstr: string;
CurSelPath: TNetPath;
RulerModeStr: String;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
tempstr := '';
if GCadForm.PCad.RulerMode = rmPage then
RulerModeStr := cCadClasses_Mes6
else
if GCadForm.PCad.RulerMode = rmWorld then
RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure);
tempstr := FormatFloat(ffMask, MetreToUOM(CurSelPath.Width * GCadForm.PCad.MapScale / 1000));
if InputQuery(cMain_Mes59, cMain_Mes60 + RulerModeStr, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0.1 then
tempstr := '0,1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
//CurSelPath.Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
// *UNDO*
//if GCadForm.FCanSaveForUndo then
//begin
// GCadForm.SaveForUndo(uat_None, False, False);
// GCadForm.FCanSaveForUndo := false;
//end;
//GCadForm.BeginSaveForUndo(uat_None, CurSelPath.FComponID <> 0, False);
GCadForm.BeginSaveForUndo(uat_None, False, False);
try
CurSelPath.Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
// èçìåíåíèå øèðèíû îêîí è äâåðåé
for j := 0 to CurSelPath.Doors.Count - 1 do
begin
TNetDoor(CurSelPath.Doors[j]).Width := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
end;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if CurSelPath.FComponID = 0 then
GArchEngine.SetLastObjSize(aoskPathWidth, CurSelPath.Width);
finally
GCadForm.EndSaveForUndo;
end;
//GCadForm.FCanSaveForUndo := True;
if CurSelPath.FComponID <> 0 then
begin
F_ProjMan.RefreshNode(false);
LoadArchObjPropsFromCAD(GetArchObjByCADObj(CurSelPath));
LoadArchObjPropsToCAD(GetArchObjByCADObj(CurSelPath));
end;
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetWallPathWidthExecute', E.Message);
end;
end;
// 4 - Óñòàíîâèòü øèðèíó âñåõ ñåãìåíòîâ
procedure TFSCS_Main.aSetAllWallPathWidthExecute(Sender: TObject);
var
i, j: integer;
tempstr: string;
CurPath: TNetPath;
CurSelPath: TNetPath;
RulerModeStr: string;
value: Double;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
tempstr := '';
if GCadForm.PCad.RulerMode = rmPage then
RulerModeStr := cCadClasses_Mes6
else
if GCadForm.PCad.RulerMode = rmWorld then
RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure);
tempstr := FormatFloat(ffMask, MetreToUOM(CurSelPath.Width * GCadForm.PCad.MapScale / 1000));
if InputQuery(cMain_Mes61, cMain_Mes62 + RulerModeStr, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0.1 then
tempstr := '0,1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Value := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
TNet(GCadForm.PCad.Selection[0]).UpdateWallThick(Value);
RefreshCAD(GCadForm.PCad);
GCadForm.FCanSaveForUndo := True;
if CurSelPath.FComponID = 0 then
GArchEngine.SetLastObjSize(aoskPathWidth, Value);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllWallPathWidthExecute', E.Message);
end;
end;
// 5 - Äîáàâèòü îêíî
procedure TFSCS_Main.aAddWindowExecute(Sender: TObject);
var
Net: TNet;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
Net := TNet(GCadForm.PCad.Selection[0]);
if Net.SelPath <> nil then
begin
if Net.SelPath.FComponID = 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
//04.06.2013 TNet(GCadForm.PCad.Selection[0]).AddWindow;
TNet(GCadForm.PCad.Selection[0]).AddWindow(GArchEngine.GetLastDoorObjSize(dotWindow, -1));
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := True;
end
else
begin
CreateArchObjWizardByCAD(ctArhWindow, GCadForm, Net.SelPath);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddWindowExecute', E.Message);
end;
end;
// 6 - Äîáàâèòü äâåðü
procedure TFSCS_Main.aAddDoorExecute(Sender: TObject);
var
Net: TNet;
Len: Double;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
Net := TNet(GCadForm.PCad.Selection[0]);
if Net.SelPath <> nil then
begin
if Net.SelPath.FComponID = 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
//04.06.2013 TNet(GCadForm.PCad.Selection[0]).AddDoor;
TNet(GCadForm.PCad.Selection[0]).AddDoor(dotDoor, GArchEngine.GetLastDoorObjSize(dotDoor, -1));
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end
else
begin
CreateArchObjWizardByCAD(ctArhDoor, GCadForm, Net.SelPath);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddDoorExecute', E.Message);
end;
end;
// 7 - Äîáàâèòü êîëîííó
procedure TFSCS_Main.aAddColumnExecute(Sender: TObject);
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
TNet(GCadForm.PCad.Selection[0]).AddCol;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aAddColumnExecute', E.Message);
end;
end;
// 8 - Óäàëèòü îêíî/äâåðü
procedure TFSCS_Main.aDeleteWindowDoorExecute(Sender: TObject);
var
mess: string;
CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.ActiveDoor <> nil then
begin
mess := cMain_Mes41;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes42, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes42), MB_YESNO) = IDYes then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurSelPath.DeleteDoor;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteWindowDoorExecute', E.Message);
end;
end;
// 9 - Óäàëèòü êîëîííó
procedure TFSCS_Main.aDeleteColumnExecute(Sender: TObject);
var
mess: string;
CurSelCol: TNetCol;
begin
try
// Tolik 18/10/2016-- ñþäà ìîæåì ïîïàñòü äàæå, êîãäà íà ÊÀÄå íè÷åãî íå âûáðàíî(íàïðèìåð, ïîñëå óäàëåíèÿ êîìíàòû ïîëíîñòüþ), òàê ÷òî ïîëó÷èì ÀÂ,
// ïîýòîìó ñíà÷àëà ïðîâåðÿåì, à âûáðàíî ëè ÷òî-íèáóäü òàì âîîáùå, à óæ ïîòîì -- ïîæàëòå óäàëÿòü
if GCadForm.PCad.Selection.Count > 0 then
begin
//
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then
begin
mess := cMain_Mes43;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes44, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes44), MB_YESNO) = IDYes then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurSelCol := TNet(GCadForm.PCad.Selection[0]).SelCol;
TNet(GCadForm.PCad.Selection[0]).DeleteStruct(CurSelCol);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDeleteColumnExecute', E.Message);
end;
end;
// 10 - Óñòàâíîâèòü ðàçìåð äâåðè/îêíà
procedure TFSCS_Main.aSetSizeWindowDoorExecute(Sender: TObject);
var
CurDoor: TNetDoor;
tempstr: string;
RulerModeStr: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
if TNetPath(TNet(GCadForm.PCad.Selection[0]).SelPath).ActiveDoor <> nil then
begin
CurDoor := TNetPath(TNet(GCadForm.PCad.Selection[0]).SelPath).ActiveDoor;
tempstr := '';
if GCadForm.PCad.RulerMode = rmPage then
RulerModeStr := cCadClasses_Mes6
else
RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure);
tempstr := FormatFloat(ffMask, MetreToUOM(CurDoor.Len * GCadForm.PCad.MapScale / 1000));
if InputQuery(cMain_Mes63, cMain_Mes64 + RulerModeStr, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0.1 then
tempstr := '0,1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurDoor.Len := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
CurDoor.DoResize;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
if CurDoor.FComponID = 0 then
GArchEngine.SetLastDoorObjSize(CurDoor.DoorObjType, CurDoor.Len);
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetSizeWindowDoorExecute', E.Message);
end;
end;
// 11 - Óñòàâíîâèòü óãîë êîëîííû
procedure TFSCS_Main.aSetColumnAngleExecute(Sender: TObject);
var
tempstr: string;
CurCol: TNetCol;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then
begin
CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol;
tempstr := FormatFloat(ffMask, CurCol.Angle * 180 / pi);
if InputQuery(cMain_Mes65, cMain_Mes66, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0 then
tempstr := '0';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurCol.Angle := StrToFloat_My(Tempstr) / 180 * pi;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnAngleExecute', E.Message);
end;
end;
// 12 - Óñòàâíîâèòü âûñîòó êîëîííû
procedure TFSCS_Main.aSetColumnHeightExecute(Sender: TObject);
var
RulerModeStr: string;
tempstr: string;
CurCol: TNetCol;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then
begin
CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol;
tempstr := '';
if GCadForm.PCad.RulerMode = rmPage then
RulerModeStr := cCadClasses_Mes6
else
RulerModeStr := cCadClasses_Mes6;
tempstr := FormatFloat(ffMask, MetreToUOM(CurCol.h * GCadForm.PCad.MapScale / 1000));
if InputQuery(cMain_Mes67, cMain_Mes68 + RulerModeStr, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0.1 then
tempstr := '0,1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurCol.h := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnHeightExecute', E.Message);
end;
end;
// 13 - Óñòàâíîâèòü øèðèíû êîëîííû
procedure TFSCS_Main.aSetColumnWidthExecute(Sender: TObject);
var
RulerModeStr: string;
tempstr: string;
CurCol: TNetCol;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelCol <> nil then
begin
CurCol := TNet(GCadForm.PCad.Selection[0]).SelCol;
tempstr := '';
if GCadForm.PCad.RulerMode = rmPage then
RulerModeStr := cCadClasses_Mes6
else
RulerModeStr := GetUOMString(GCurrProjUnitOfMeasure);
tempstr := FormatFloat(ffMask, MetreToUOM(CurCol.w * GCadForm.PCad.MapScale / 1000));
if InputQuery(cMain_Mes69, cMain_Mes70 + RulerModeStr, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 0.1 then
tempstr := '0,1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurCol.w := UOMToMetre(StrToFloat_My(Tempstr) * 1000 / GCadForm.PCad.MapScale);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetColumnWidthExecute', E.Message);
end;
end;
// 14 - Óñòàíîâèòü øèðèíó ëèíèé ñåãìåíòà
procedure TFSCS_Main.aSetPathLineWidthExecute(Sender: TObject);
var
CurSelPath: TNetPath;
tempstr: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
tempstr := '';
tempstr := IntToStr(CurSelPath.FPathWidth);
if InputQuery(cMain_Mes71, cMain_Mes72, tempstr) then
begin
try
StrToInt(tempstr);
if (StrToInt(tempstr) < 1) or (StrToInt(tempstr) > 7) then
begin
ShowMessage(cMain_Mes73);
Exit;
end;
except
ShowMessage(cMain_Mes74);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurSelPath.FPathWidth := StrToInt(Tempstr);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetPathLineWidthExecute', E.Message);
end;
end;
// 15 - Óñòàíîâèòü ñòèëü ëèíèé ñåãìåíòà
procedure TFSCS_Main.aSetPathLineStyleExecute(Sender: TObject);
var
CurSelPath: TNetPath;
tempstr: string;
StyleIndex: Integer;
mess: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
if CurSelPath.FPathWidth > 1 then
begin
ShowMessage(cMain_Mes75);
Exit;
end;
tempstr := '';
StyleIndex := Ord(CurSelPath.FPathStyle);
mess := cMain_Mes76;
tempstr := IntToStr(StyleIndex);
if InputQuery(cMain_Mes77, mess, tempstr) then
begin
try
StrToInt(tempstr);
if (StrToInt(tempstr) < 0) or (StrToInt(tempstr) > 6) then
begin
ShowMessage(cMain_Mes78);
Exit;
end;
except
ShowMessage(cMain_Mes74);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
StyleIndex := StrToInt(Tempstr);
CurSelPath.FPathStyle := TPenStyle(StyleIndex);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetPathLineStyleExecute', E.Message);
end;
end;
// 16 - Óñòàíîâèòü øèðèíó ëèíèé âñåõ ñåãìåíòîâ
procedure TFSCS_Main.aSetAllPathLineWidthExecute(Sender: TObject);
var
i: integer;
tempstr: string;
CurSelPath: TNetPath;
CurPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
tempstr := '';
tempstr := IntToStr(CurSelPath.FPathWidth);
if InputQuery(cMain_Mes79, cMain_Mes80, tempstr) then
begin
try
StrToInt(tempstr);
if (StrToInt(tempstr) < 1) or (StrToInt(tempstr) > 7) then
begin
ShowMessage(cMain_Mes73);
Exit;
end;
except
ShowMessage(cMain_Mes74);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do
begin
CurPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]);
CurPath.FPathWidth := StrToInt(Tempstr);
end;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllPathLineWidthExecute', E.Message);
end;
end;
// 17 - Óñòàíîâèòü ñòèëü ëèíèé âñåõ ñåãìåíòîâ
procedure TFSCS_Main.aSetAllPathLineStyleExecute(Sender: TObject);
var
i: integer;
tempstr: string;
mess: string;
StyleIndex: Integer;
CurSelPath: TNetPath;
CurPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath <> nil then
begin
tempstr := '';
StyleIndex := Ord(CurSelPath.FPathStyle);
mess := cMain_Mes76;
tempstr := IntToStr(StyleIndex);
if InputQuery(cMain_Mes77, mess, tempstr) then
begin
try
StrToInt(tempstr);
if (StrToInt(tempstr) < 0) or (StrToInt(tempstr) > 5) then
begin
ShowMessage(cMain_Mes78);
Exit;
end;
except
ShowMessage(cMain_Mes74);
Exit;
end;
if tempstr <> '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
StyleIndex := StrToInt(Tempstr);
for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do
begin
CurPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]);
CurPath.FPathStyle := TPenStyle(StyleIndex);
end;
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetAllPathLineStyleExecute', E.Message);
end;
end;
procedure TFSCS_Main.LoadStamp(aFName: string);
var
i, j: integer;
LHandle: integer;
BlockFig: TBlock;
InFigure: TFigure;
begin
try
RemoveFrameFromList(GCadForm);
LHandle := GCadForm.PCad.GetLayerHandle(7);
try
BlockFig := TBlock(GCadForm.PCad.InsertBlockwithFileName(7, aFName, GCadForm.PCad.WorkWidth / 2 - 2.5, GCadForm.PCad.WorkHeight / 2));
SetAllStampFiguresLayer(TFigureGrp(BlockFig), LHandle);
SetAllStampTextsFont(TFigureGrp(BlockFig), GCadForm.FFontName);
// âûñòàâèòü ïîäïèñè
GCadForm.FFrameFileName := aFName;
LoadCaptionsOnFrame(GCadForm, GCadForm.FCadStampType);
except
GCadForm.FFrameFileName := '';
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.LoadStamp', E.Message);
end;
end;
procedure TFSCS_Main.SaveStamp(aFName: string);
var
i: integer;
FFigure: TFigure;
LHandle: Integer;
begin
try
GCadForm.PCad.DeselectAll(0);
GCadForm.PCad.SelectAll(7);
{//17.11.2011
if GCadForm.FFrameProjectName <> nil then
GCadForm.FFrameProjectName.Deselect;
if GCadForm.FFrameListName <> nil then
GCadForm.FFrameListName.Deselect;
if GCadForm.FFrameCodeName <> nil then
GCadForm.FFrameCodeName.Deselect;
if GCadForm.FFrameIndexName <> nil then
GCadForm.FFrameIndexName.Deselect;}
for i := 0 to GCadForm.FFrameObjects.Count - 1 do
begin
FFigure := TFigure(GCadForm.FFrameObjects.Objects[i]);
if FFigure <> nil then
FFigure.Deselect;
end;
RefreshCAD(GCadForm.PCad);
GCadForm.PCad.GroupSelection;
GCadForm.PCad.MakeSelectionBlock(aFName);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.SaveStamp', E.Message);
end;
end;
procedure TFSCS_Main.aLoadStampExecute(Sender: TObject);
var
FName: string;
FDir: string;
OpenDialog: TOpenDialog;
begin
try
if ActiveMDIChild <> nil then
begin
OpenDialog := TOpenDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\Stamp') then
FDir := FDir + '\Stamp';
OpenDialog.Title := cMain_Mes81;
OpenDialog.InitialDir := ExtractDirByCategoryType(dctStamps);//ExtractSaveDirForCategory('Stamp');//FDir;
OpenDialog.DefaultExt := 'sch';
OpenDialog.Filter := cMain_Mes82;
if OpenDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctStamps, ExtractFileDir(OpenDialog.FileName));
//
FName := OpenDialog.FileName;
LoadStamp(FName);
GCadForm.PCad.DeselectAll(0);
except
ShowMessage(cMain_Mes6);
end;
RefreshCAD(GCadForm.PCad);
end;
OpenDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aLoadStampExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSaveStampExecute(Sender: TObject);
var
FName: string;
FDir: string;
SaveDialog: TSaveDialog;
begin
try
if ActiveMDIChild <> nil then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\Stamp') then
FDir := FDir + '\Stamp';
SaveDialog.Title := cMain_Mes83;
SaveDialog.InitialDir := ExtractDirByCategoryType(dctStamps);//ExtractSaveDirForCategory('Stamp');//FDir;
SaveDialog.DefaultExt := 'sch';
SaveDialog.Filter := cMain_Mes82;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
if SaveDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctStamps, ExtractFileDir(SaveDialog.FileName));
//
FName := SaveDialog.FileName;
SaveStamp(FName);
except
ShowMessage(cMain_Mes8);
end;
end;
SaveDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveStampExecute', E.Message
);
end;
end;
procedure TFSCS_Main.aWallPathShowLengthExecute(Sender: TObject);
var
CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.FShowLength then
CurSelPath.FShowLength := False
else
CurSelPath.FShowLength := True;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aWallPathShowLengthExecute', E.Message);
end;
end;
procedure TFSCS_Main.SaveProjectForSC;
var
FName: string;
FDir: string;
SaveDialog: TSaveDialog;
begin
try
if ActiveMDIChild <> nil then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\Save') then
FDir := FDir + '\Save';
SaveDialog.Title := 'Cîõðàíèòü ïàðàìåòðû îáúåêòîâ...';
SaveDialog.InitialDir := ExtractFileDir(Application.ExeName) + '\Save';
SaveDialog.DefaultExt := 'scp';
SaveDialog.Filter := 'Ôàéëû ïàðàìåòðîâ îáúåêòîâ (*.scp)|*.scp';
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
if SaveDialog.Execute then
begin
try
FName := SaveDialog.FileName;
ExpProjToStroyCalcFile(F_ProjMan.GSCSBase.CurrProject, FName);
except
//ShowMessage(cMain_Mes8);
end;
end;
SaveDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveFPlanExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSaveFPlanExecute(Sender: TObject);
var
FName: string;
FDir: string;
SaveDialog: TSaveDialog;
begin
try
if ActiveMDIChild <> nil then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.ArchPlan') then
FDir := FDir + '\.ArchPlan';
SaveDialog.Title := cMain_Mes84;
SaveDialog.InitialDir := ExtractDirByCategoryType(dctArchPlans);//ExtractSaveDirForCategory('.ArchPlan');//FDir;
SaveDialog.DefaultExt := 'sca';
SaveDialog.Filter := cMain_Mes85;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
if SaveDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctArchPlans, ExtractFileDir(SaveDialog.FileName));
//
FName := SaveDialog.FileName;
SaveFPlan(FName);
except
ShowMessage(cMain_Mes8);
end;
end;
SaveDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSaveFPlanExecute', E.Message);
end;
end;
procedure TFSCS_Main.aLoadFPlanExecute(Sender: TObject);
var
FName: string;
i: integer;
FDir: string;
OpenDialog: TOpenDialog;
begin
try
if ActiveMDIChild <> nil then
begin
OpenDialog := TOpenDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.ArchPlan') then
FDir := FDir + '\.ArchPlan';
OpenDialog.Title := cMain_Mes86;
OpenDialog.InitialDir := ExtractDirByCategoryType(dctArchPlans);//ExtractSaveDirForCategory('.ArchPlan');//FDir;
OpenDialog.DefaultExt := 'sca';
OpenDialog.Filter := cMain_Mes85;
if OpenDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctArchPlans, ExtractFileDir(OpenDialog.FileName));
//
GisUserDimLine := True;
FName := OpenDialog.FileName;
LoadFPlan(FName);
GCadForm.PCad.DeselectAll(0);
//Tolik 11/08/2021 --
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
except
ShowMessage(cMain_Mes6);
end;
RefreshCAD(GCadForm.PCad);
end;
OpenDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aLoadFPlanExecute', E.Message);
end;
end;
procedure TFSCS_Main.tbExtProtocolClick(Sender: TObject);
begin
try
ShowLog;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.tbExtProtocolClick', E.Message);
end;
end;
procedure TFSCS_Main.N113Click(Sender: TObject);
var
FileName: string;
begin
try
FileName := ExeDir + '\Docs\UserGuide.doc';
{$IF Defined(SCS_PE) or Defined(SCS_SPA)}
FileName := ExeDir + '\Docs\UserGuide.pdf';
{$IFEND}
if FileExists(FileName) then
begin
ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, 0);
end
else
ShowMessage(cMain_Mes87);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aUserGuideExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDesignBoxCaptionHeightExecute(Sender: TObject);
var
i: integer;
tempstr: string;
CurText: TText;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TText') then
begin
CurText := TText(GCadForm.PCad.Selection[0]);
tempstr := FormatFloat(ffMask, CurText.Height);
if InputQuery(cMain_Mes88, cMain_Mes89, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 1 then
tempstr := '1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), 'TText') then
begin
CurText := TText(GCadForm.PCad.Selection[i]);
CurText.Height := StrToFloat_My(tempstr);
CurText.Create(CurText.ActualPoints[1].x, CurText.ActualPoints[1].y,
CurText.Height, CurText.CWidth, CurText.Text, CurText.Font.Name, CurText.Font.Charset,
CurText.color, CurText.LayerHandle, mydsNormal, GCadForm.PCad);
end;
end;
RefreshCAD(GCadForm.PCad);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxCaptionHeightExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDesignBoxCaptionWidthExecute(Sender: TObject);
var
i: integer;
tempstr: string;
CurText: TText;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TText') then
begin
CurText := TText(GCadForm.PCad.Selection[0]);
tempstr := FormatFloat(ffMask, CurText.width);
if InputQuery(cMain_Mes90, cMain_Mes91, tempstr) then
begin
try
StrToFloat_My(tempstr);
if StrToFloat_My(tempstr) < 1 then
tempstr := '1';
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), 'TText') then
begin
CurText := TText(GCadForm.PCad.Selection[i]);
CurText.CWidth := StrToFloat_My(tempstr);
CurText.Create(CurText.ActualPoints[1].x, CurText.ActualPoints[1].y,
CurText.Height, CurText.CWidth, CurText.Text, CurText.Font.Name, CurText.Font.Charset,
CurText.color, CurText.LayerHandle, mydsNormal, GCadForm.PCad);
end;
end;
RefreshCAD(GCadForm.PCad);
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxCaptionWidthExecute', E.Message);
end;
end;
procedure TFSCS_Main.aManual_SuppliesKindsExecute(Sender: TObject);
begin
try
ShowSuppliesKinds;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aManual_SuppliesKindsExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMasterCableChannelExecute(Sender: TObject);
begin
try
MasterCableCanalTracing;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterCableChannelExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMasterCableTracingExecute(Sender: TObject);
begin
try
MasterCableTracing;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterCableTracingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aCreateBlockToFileExecute(Sender: TObject);
var
BlkName: string;
FullBlkName: string;
FullBlkNameOr: string;
FullBlkName1: string;
FullBlkName2: string;
MetaFile: TMetafile;
Bitmap: TBitmap;
FDir: string;
//08.09.2011 Buffer: array[0..1023] of Char;
TempPath: string;
SaveDialog: TSaveDialog;
FileName: String;
SelList: TList;
i: integer;
Block: TBlock;
begin
try
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.SelectedCount > 0 then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.blk') then
FDir := FDir + '\.blk';
SaveDialog.Title := cMain_Mes92;
SaveDialog.InitialDir := FDir;
SaveDialog.DefaultExt := 'blk'; //11.03.2012 '';
SaveDialog.Filter := cMain_Mes52;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
SaveDialog.OnCanClose := SDCreateBlockToFileCanClose; // äëÿ ïðîâåðêè ñóùåñòâîâàíèÿ bmp
if SaveDialog.Execute then
begin
FileName := ExtractFilePathOnly(SaveDialog.FileName);
FullBlkName := FileName;
if GCadForm.PCad.SelectedCount = 2 then
begin
SelList := TList.Create;
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
SelList.Add(GCadForm.PCad.Selection[i]);
for i := 0 to SelList.Count - 1 do
begin
GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle);
end;
FullBlkName1 := FullBlkName;
FullBlkName2 := FullBlkName;
FullBlkNameOr := FullBlkName;
if TFigure(SelList[0]).CenterPoint.x > TFigure(SelList[1]).CenterPoint.x then
FullBlkName1 := FullBlkName + '_active'
else
FullBlkName2 := FullBlkName + '_active';
for i := 0 to SelList.Count - 1 do
begin
FullBlkName := FullBlkName1;
if i = 1 then
FullBlkName := FullBlkName2;
GCadForm.PCad.SelectFigure(TFigure(SelList[i]).Handle);
//GCadForm.PCad.Refresh;
Block := nil;
if (TFigure(SelList[i]) is TBlock) then
Block := TBlock(TBlock(SelList[i]).duplicate)
else if (TFigure(SelList[i]) is TFigureGrp) then
Block := TBlock(TFigureGrp(SelList[i]).duplicate)
else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
//GCadForm.PCad.Refresh;
Block := nil;
if (TFigure(SelList[i]) is TBlock) then
Block := TBlock(TBlock(SelList[i]).duplicate)
else if (TFigure(SelList[i]) is TFigureGrp) then
Block := TBlock(TFigureGrp(SelList[i]).duplicate)
else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
BlockToNormalSize(Block, 150);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
GCadForm.PCad.Refresh;
Block := nil;
//if (TFigure(SelList[i]) is TBlock) then
// Block := TBlock(TBlock(SelList[i]).duplicate)
//else if (TFigure(SelList[i]) is TFigureGrp) then
// Block := TBlock(TFigureGrp(SelList[i]).duplicate)
//else
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
//Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
// Èçìåíÿåì ðàçìåðû äëÿ ðàñòðîâîãî èçîáðàæåíèÿ
//BlockToNormalSize(Block, 150);
//MetaFile := TMetafile.Create;
//Bitmap := TBitmap.Create;
//MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
//Bitmap.Height := Metafile.Height;
//Bitmap.Width := Metafile.Width;
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.Canvas.Draw(0, 0, MetaFile);
//Bitmap.SaveToFile(FullBlkName + '.bmp');
//FreeAndNil(MetaFile);
//FreeAndNil(Bitmap);
if Block <> nil then
begin
//Block.InFigures.Clear;
Block.Free;
end;
GCadForm.PCad.DeSelectFigure(TFigure(SelList[i]).Handle);
GCadForm.PCad.Refresh;
end;
SelList.Clear;
FreeAndNil(SelList);
end
else
begin
Block := nil;
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
Block := nil;
Block := GCadForm.PCad.GetSelectionBlockDuplicate;
Block.SaveToFile(FullBlkName + '.blk');
Block.Scale(GCadForm.PCad.ZoomScale / 100, GCadForm.PCad.ZoomScale / 100, Block.ap1);
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.BlockObjAsWmf(Block);
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FullBlkName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
if Block <> nil then
begin
Block.Free;
end;
end;
end;
FreeAndNil(SaveDialog);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockToFileExecute', E.Message);
end;
(*
try
if ActiveMDIChild <> nil then
begin
if GCadForm.PCad.SelectedCount > 0 then
begin
SaveDialog := TSaveDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.blk') then
FDir := FDir + '\.blk';
SaveDialog.Title := cMain_Mes92;
SaveDialog.InitialDir := FDir;
SaveDialog.DefaultExt := 'blk'; //11.03.2012 '';
SaveDialog.Filter := cMain_Mes52;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
SaveDialog.OnCanClose := SDCreateBlockToFileCanClose; // äëÿ ïðîâåðêè ñóùåñòâîâàíèÿ bmp
if SaveDialog.Execute then
begin
FileName := ExtractFilePathOnly(SaveDialog.FileName);
GCadForm.PCad.MakeSelectionBlock(FileName + '.blk');
MetaFile := TMetafile.Create;
Bitmap := TBitmap.Create;
MetaFile := GCadForm.PCad.SelectionAsWmf;
Bitmap.Height := Metafile.Height;
Bitmap.Width := Metafile.Width;
Bitmap.Canvas.Draw(0, 0, MetaFile);
Bitmap.SaveToFile(FileName + '.bmp');
FreeAndNil(MetaFile);
FreeAndNil(Bitmap);
end;
FreeAndNil(SaveDialog);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateBlockToFileExecute', E.Message);
end;
*)
end;
procedure TFSCS_Main.aChangeRaiseHeightExecute(Sender: TObject);
var
RaiseLine: TOrthoLine;
RaiseConn: TConnectorObject;
ObjFromRaise: TConnectorObject;
CheckRaiseConn: TConnectorObject;
i: integer;
OldRaiseHeight: Double;
RaiseHeight: Double;
tempstr: string;
SetRaiseHeight: Double;
mess: string;
CurLine: TOrthoLine;
ZDirectionKoef: Integer; // Íàïðàâëåíèå áîëüøå íóëÿ èëè ìåíüøå íóëÿ
NextConn: TConnectorObject; // Tolik 04/02/2021 --
function CheckCanSnap : Boolean;
begin
Result := (RaiseConn.JoinedconnectorsList.Count = 0) and GCadForm.FAutoPosTraceBetweenRM;
end;
begin
try
if GPopupFigure = nil then
exit;
try
RaiseLine := TOrthoLine(GPopupFigure);
except
RaiseLine := nil;
Exit;
end;
//
RaiseConn := nil;
ObjFromRaise := nil;
if TConnectorObject(RaiseLine.JoinConnector1).FConnRaiseType <> crt_None then
begin
RaiseConn := TConnectorObject(RaiseLine.JoinConnector1);
ObjFromRaise := RaiseConn.FObjectFromRaise;
end;
if TConnectorObject(RaiseLine.JoinConnector2).FConnRaiseType <> crt_None then
begin
RaiseConn := TConnectorObject(RaiseLine.JoinConnector2);
ObjFromRaise := RaiseConn.FObjectFromRaise;
end;
if (RaiseConn <> nil) and (ObjFromRaise <> nil) then
begin
//24.10.2012 OldRaiseHeight := RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1];
OldRaiseHeight := RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1];
//OldRaiseHeight := Abs(RaiseConn.ActualZOrder[1] - ObjFromRaise.ActualZOrder[1]);
tempstr := FormatFloat(ffMask, MetreToUOM(OldRaiseHeight));
if InputQuery(cCad_Mes13, cMain_Mes93, tempstr) then
begin
try
StrToFloat_My(tempstr);
except
ShowMessage(cSizePos_Mes1);
Exit;
end;
if tempstr <> '' then
begin
RaiseHeight := StrToFloat_My(tempstr);
RaiseHeight := UOMToMetre(RaiseHeight);
if RaiseHeight <> OldRaiseHeight then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
ZDirectionKoef := 1;
//if RaiseConn.ActualZOrder[1] < 0 then
// ZDirectionKoef := -1;
// OnFloor
if RaiseConn.FConnRaiseType = crt_OnFloor then
begin
SetRaiseHeight := ObjFromRaise.ActualZOrder[1] + ZDirectionKoef * RaiseHeight;
//24.10.2012 if SetRaiseHeight < 0 then
//24.10.2012 SetRaiseHeight := 0;
if SetRaiseHeight > GCadForm.FRoomHeight then
SetRaiseHeight := GCadForm.FRoomHeight;
if SetRaiseHeight = ObjFromRaise.ActualZOrder[1] then
begin
mess := cSCSObjectProp_Mes1;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cSCSObjectProp_Mes2, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cSCSObjectProp_Mes2), MB_YESNO) = IDYes then
begin
if CheckCanSnap then
begin
RaiseConn.ActualZOrder[1] := ObjFromRaise.ActualZOrder[1];
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
RaiseLine.Delete;
end;
end
else
begin
RaiseConn.ActualZOrder[1] := SetRaiseHeight;
SetConFigureCoordZInPM(RaiseConn.ID, RaiseConn.ActualZOrder[1]);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
RaiseLine.UpdateLengthTextBox(False, true);
end;
end
else
// BetweenFloor
begin
SetRaiseHeight := RaiseConn.ActualZOrder[1] - RaiseHeight;
if SetRaiseHeight < 0 then
SetRaiseHeight := 0;
if SetRaiseHeight > GCadForm.FRoomHeight then
SetRaiseHeight := GCadForm.FRoomHeight;
if SetRaiseHeight = RaiseConn.ActualZOrder[1] then
begin
mess := cMain_Mes94;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes95, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes95), MB_YESNO) = IDYes then
begin
if CheckCanSnap then // Tolik 04/02/2020 --
begin
RaiseConn.ActualZOrder[1] := ObjFromRaise.ActualZOrder[1];
if ObjFromRaise.ConnectorType = ct_Clear then
DestroyRaiseOnConnector(ObjFromRaise)
else
DestroyRaiseOnPointObject(ObjFromRaise);
end
else
RaiseLine.Delete;
end;
end
else
begin
ObjFromRaise.ActualZOrder[1] := SetRaiseHeight;
SetConFigureCoordZInPM(ObjFromRaise.ID, ObjFromRaise.ActualZOrder[1]);
RaiseLine.CalculLength := RaiseLine.LengthCalc;
RaiseLine.LineLength := RaiseLine.CalculLength;
RaiseLine.UpdateLengthTextBox(False, true);
end;
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aChangeRaiseHeightExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDisconnectFromRMExecute(Sender: TObject);
var
Conn: TConnectorObject;
RM: TConnectorObject;
begin
try
if GPopupFigure <> nil then
begin
Conn := TConnectorObject(GPopupFigure);
if Conn.JoinedConnectorsList.Count > 0 then
begin
RM := TConnectorObject(Conn.JoinedConnectorsList[0]);
if RM <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
UnsnapConnectorFromPointObject(Conn, RM);
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectFromRMExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDisconnectAllConnectorsExecute(Sender: TObject);
var
i, j: integer;
RM: TConnectorObject;
Conn: TConnectorObject;
isRaiseOnIt: Boolean;
begin
try
if GPopupFigure <> nil then
begin
RM := TConnectorObject(GPopupFigure);
i := 0;
if RM.JoinedConnectorsList.Count > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
while i < RM.JoinedConnectorsList.Count do
begin
Conn := TConnectorObject(RM.JoinedConnectorsList[i]);
if Conn <> nil then
begin
isRaiseOnIt := false;
for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
isRaiseOnIt := True;
end;
if not isRaiseOnIt then
begin
UnsnapConnectorFromPointObject(Conn, RM);
RefreshCAD(GCadForm.PCad);
end
else
i := i + 1;
end;
end;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectAllConnectorsExecute', E.Message);
end;
end;
// Tolik -- 27/05/2016 --
// äâèíóòü îáúåêò íà ïðîòèâîïîëîæíóþ âåðøèíó ñïóñêà/ïîäúåìà
// îðèãèíàë çàêîììåí÷åí, ñìîòðè íèæå, ò.ê. íå ðàáîòàåò íè õ
// òîëüêî "íà êîøêàõ" è òî, åñëè êàáåëÿ íåò, èíà÷å - ÀÂ
procedure TFSCS_Main.aRemoveObjectOnHeightExecute(Sender: TObject);
var
BaseConn: TConnectorObject;
OtherConn: TConnectorObject;
i, j: integer;
prevcount: integer;
RaiseLine: TOrthoLine;
SavedConnectionsList: TList;
SavedComponList: TList;
InterFaceAccordanceList, SavedLineComponList, SavedPointComponList: TList;
SelfPointConnectInfo, JoinedLineConnectInfo: TLineComponConnectionInfo;
SavedPointConnectionsList, PointComponents: TList;
RaiseSide: Integer;
Procedure SaveConnectionOnPointObject;
var i, j, k, l, m, n: Integer;
PointCatalog: TSCSCatalog;
PointComponent, CableComponent: TSCSComponent;
LineComponentsList: TList;
function GetJoinedCableSide(CableCompon, JoinedCableCompon: TSCSComponent): Integer;
var i, j : Integer;
CableInterFace: TSCSInterface;
CableInterfPos, JoinedCableInterfPos: TSCSInterfPosition;
begin
Result := 0;
for i := 0 to CableCompon.Interfaces.Count - 1 do
begin
CableInterFace := TSCSInterface(CableCompon.Interfaces[i]);
if (CableInterFace.TypeI = itFunctional) and ((CableInterFace.IsBusy = bitrue) or
(CableInterFace.BusyPositions.Count > 0)) then
begin
for j := 0 to CableInterFace.BusyPositions.Count - 1 do
begin
CableInterfPos := TSCSInterfPosition(CableInterFace.BusyPositions[j]);
JoinedCableInterfPos := CableInterfPos.GetConnectedPos;
if JoinedCableInterfPos <> nil then
begin
if JoinedCableInterfPos.InterfOwner.ComponentOwner.ID = JoinedCableCompon.ID then
begin
Result := JoinedCableInterfPos.InterfOwner.Side;
Break; //// BREAK ////;
end;
end;
end;
end;
if Result <> 0 then Break; //// BREAK ////;
end;
end;
function GetCableSide(CableComponent: TSCSComponent; aCatalog: TSCSCatalog): Integer;
var i, j: Integer;
interf: TSCSInterface;
InterfPos: TSCSInterfPosition;
begin
Result := 0;
for i := 0 to CableComponent.Interfaces.Count - 1 do
begin
if (TSCSInterface(CableComponent.Interfaces[i]).TypeI = itFunctional) then
begin
Interf := TSCSInterface(CableComponent.Interfaces[i]);
for j := 0 to interf.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(interf.BusyPositions[j]);
InterfPos := InterfPos.GetConnectedPos;
if (InterfPos <> nil) and (InterfPos.InterfOwner <> nil) and
(InterfPos.InterfOwner.ComponentOwner <> nil) then
begin
if aCatalog.ComponentReferences.IndexOf(InterfPos.InterfOwner.ComponentOwner) <> -1 then
begin
Result := interf.Side;
break;
end;
end;
end;
if Result <> 0 then
Break; //// BREAK ////;
end;
end;
end;
function GetConnectedInterFace(aInterf: TSCSInterFace; ACompon: TSCSComponent; aSide: integer): TSCSInterface;
var i: Integer;
begin
Result := nil;
end;
function GetCableFromRaise(aCompon: TSCSComponent) : TSCSComponent;
var i: Integer;
begin
Result := nil;
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
begin
Result := TSCSComponent(aCompon.JoinedComponents[i]);
Break; //// BREAK ////;
end;
end;
end;
function GetInterfFromRaise(aCableComponent: TSCSComponent; aComponSide: Integer; aCableInterFace: TSCSInterface): TSCSInterface;
var i: Integer;
begin
Result := Nil;
for i := 0 to aCableComponent.Interfaces.Count - 1 do
begin
if (TSCSInterface(aCableComponent.Interfaces[i]).Npp = aCableInterFace.Npp) and
(TSCSInterface(aCableComponent.Interfaces[i]).Side = aComponSide) then
begin
Result := TSCSInterface(aCableComponent.Interfaces[i]);
Break; //// BREAK ////;
end;
end;
end;
procedure SaveLineConnection(aCableList: TList; aPointCatalog: TSCSCatalog);
var i, j, k: Integer;
CableComponent, JoinedFromRaiseCableComponent, JoinedPointComponent: TSCSComponent;
LineCatalog: TSCSCatalog;
LineFigure: TFigure;
CableInterface, JoinedCableInterFace: TSCSInterface;
InterfPos, JoinedInterfPos: TSCSInterfPosition;
CableComponSide, JoinedCableComponSide: Integer;
ComponToDeleteList: TSCSComponents;
CanDelCable: Boolean;
ADInterface: TSCSInterface;
begin
if aCableList.Count > 0 then
begin
SavedPointConnectionsList := TList.Create;
ComponToDeleteList := TSCSComponents.Create(False);
for i := 0 to aCableList.Count - 1 do
begin
InterFaceAccordanceList := TList.Create;
CableComponent := TSCSComponent(aCableList[i]);
CableComponSide := GetCableSide(CableComponent, aPointCatalog);
CanDelCable := False;
JoinedFromRaiseCableComponent := nil;
LineCatalog := CableComponent.GetFirstParentCatalog;
if LineCatalog <> nil then
begin
LineFigure := GetFigureByCatalogId(LineCatalog.SCSID);
if LineFigure <> nil then
begin
if TOrthoLine(LineFigure).FIsRaiseUpDown then
begin
CanDelCable := True;
JoinedFromRaiseCableComponent := GetCableFromRaise(CableComponent);
if JoinedFromRaiseCableComponent <> nil then
JoinedCableComponSide := GetJoinedCableSide(CableComponent, JoinedFromRaiseCableComponent);
end;
end;
// ñîõðàíÿòü ñîåäèíåíèÿ òîëüêî åñëè ýòî òðàññà èëè êàáåëü ñ ðàéçà ïîäêëþ÷åí íà äðóãóþ òðàññó, à íå
// ê òî÷å÷íîìó èëè ïðîñòî âèñèò â âîçäóõå
if ((not CanDelCable) or (CanDelCable and (JoinedFromRaiseCableComponent <> nil))) then
begin
for j := 0 to CableComponent.Interfaces.Count - 1 do
begin
SavedLineComponList := TList.Create;
SavedPointComponList := TList.Create;
CableInterface := TSCSInterface(CableComponent.Interfaces[j]);
if (CableInterface.TypeI = itFunctional) and (CableInterface.Side = CableComponSide) and
((CableInterface.BusyPositions.Count > 0) or (CableInterface.IsBusy = biTrue)) then
begin
if CanDelCable then
ADInterface := GetInterfFromRaise(JoinedFromRaiseCableComponent, JoinedCableComponSide, CableInterFace)
else
ADInterface := CableInterface;
if SavedLineComponList.IndexOf(AdInterface) = -1 then
SavedLineComponList.Add(ADInterface);
for k := 0 to CableInterface.BusyPositions.Count - 1 do
begin
InterfPos := TSCSInterfPosition(CableInterface.BusyPositions[k]);
JoinedInterfPos := InterfPos.GetConnectedPos;
if (JoinedInterfPos <> nil) and (JoinedInterfPos.InterfOwner <> nil) and
(JoinedInterfPos.InterfOwner.ComponentOwner <> nil) then
begin
if SavedPointComponList.IndexOf(JoinedInterfPos.InterfOwner) = -1 then
SavedPointComponList.Add(JoinedInterfPos.InterfOwner);
end;
end;
end;
if ((SavedLineComponList.Count > 0) and (SavedPointComponList.Count > 0)) then
begin
InterFaceAccordanceList.Add(SavedLineComponList);
InterFaceAccordanceList.Add(SavedPointComponList);
SavedPointComponList := Nil;
SavedPointComponList := Nil;
end
else
begin
FreeAndNil(SavedPointComponList);
FreeAndNil(SavedLineComponList);
end;
end;
end;
end;
// åñëè êàáåëü íà ðàéçå - çàíåñòè â ñïèñîê íà óäàëåíèå
if (CanDelCable and (ComponToDeleteList.IndexOf(CableComponent) = - 1)) then
ComponToDeleteList.Add(CableComponent);
if ((InterFaceAccordanceList <> nil) and (InterFaceAccordanceList.Count > 0)) then
begin
// ñîñòîÿíèå ñîåäèíåíèÿ êàáåëÿ íà òî÷å÷íîì îáúåêòå
SelfPointConnectInfo := TLineComponConnectionInfo.Create(True);
if (not CanDelCable) then
begin
SelfPointConnectInfo.ComponId := CableComponent.ID;//AJoinedLineCompon.ID;
SelfPointConnectInfo.ComponSide := CableComponSide;
SelfPointConnectInfo.isLineConnection := True; // ïîäêëþ÷èòü ÷åðåç íîâûé êàáåëü íà ðàéçå
end
else
begin
SelfPointConnectInfo.ComponId := JoinedFromRaiseCableComponent.ID;//AJoinedLineCompon.ID;
SelfPointConnectInfo.ComponSide := JoinedCableComponSide;
SelfPointConnectInfo.isLineConnection := False; // ïîäêëþ÷èòü ïðÿìî ê òîìó, ÷òî åñòü (â òî÷êå ïîäúåìà)
end;
JoinedLineConnectInfo := TLineComponConnectionInfo.Create(False);
JoinedLineConnectInfo.ComponCatalogID := 0;
JoinedLineConnectInfo.ConnectedComponList := InterFaceAccordanceList;
SelfPointConnectInfo.ConnectedComponList.Add(JoinedLineConnectInfo);
SavedPointConnectionsList.Add(SelfPointConnectInfo);
InterFaceAccordanceList := Nil;
end
else
begin
if InterFaceAccordanceList <> nil then
FreeAndNil(InterFaceAccordanceList);
end;
end;
// óäàëèòü êàáåëè ñ ðàéçà
if ComponToDeleteList.Count > 0 then
F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.CurrList, ComponToDeleteList, False, biNone, false, nil);
end;
end;
begin
if BaseConn <> nil then
begin
PointCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(BaseConn.ID);
// ñòðîèì ñïèñîê êàáåëåé, ïîäêëþ÷åííûõ ê ïîèíòó
if PointCatalog <> nil then
begin
PointComponents := TList.Create;
LineComponentsList := TList.Create;
for i := 0 to PointCatalog.ComponentReferences.Count - 1 do
begin
PointComponent := TSCSComponent(PointCatalog.ComponentReferences[i]);
if PointComponents.IndexOf(PointComponent) = -1 then
PointComponents.Add(PointComponent);
for j := 0 to PointComponent.JoinedComponents.Count - 1 do
begin
if IsCableComponent(TSCSComponent(PointComponent.JoinedComponents[j])) then
begin
if LineComponentsList.IndexOf(TSCSComponent(PointComponent.JoinedComponents[j])) = -1 then
LineComponentsList.Add(TSCSComponent(PointComponent.JoinedComponents[j]));
end;
end;
end;
if LineComponentsList.Count > 0 then
SaveLineConnection(LineComponentsList, PointCatalog)
else
FreeAndNil(LineComponentsList);
end;
end;
end;
Procedure RestoreLineConnections;
var i, j, k, l, m: Integer;
CanDisJoin: boolean;
LineCompon, PointCompon, JoinedLineCompon: TSCSComponent;
PointCatalog, LineCatalog, RaiseCatalog: TSCSCatalog;
PointFigure, LineFigure: TFigure;
WayList, LineComponList: TList;
LineConnector: TConnectorObject;
aTempInterf, aLineInterface, aPointInterface: TSCSInterface;
AInterfPositions1, AInterfPositions2: TSCSInterfPositions;
ConnectIDCompRel, InterfCount: Integer;
ptrConnection: PComplect;
TempInterfaces1, TempInterfaces2: TSCSInterfaces;
Function DefineIDComponRel(ALineCompon, APointCompon: TSCSComponent): Integer;
var
TopCatalog: TSCSCatalog;
begin
Result := -1;
begin
TopCatalog := aLineCompon.GetTopParentCatalog;
if TopCatalog <> nil then
if TopCatalog is TSCSProject then
Result := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1);
end;
//if IDComponRel = -1 then
//IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType);
end;
begin
if SavedPointConnectionsList <> nil then
begin
RaiseCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(RaiseLine.ID);
// ñáðîñèòü ñîåäèíåíèÿ òî÷å÷íûõ ñ êàáåëÿìè, åñëè îíè ñîåäèíèëèñü àâòîìàòè÷åñêè ïîñëå ïîäúåìà
if (PointComponents <> nil) then
begin
for i := 0 to PointComponents.Count - 1 do
begin
PointCompon := TSCSComponent(PointComponents[i]);
for j := (PointCompon.JoinedComponents.Count - 1) downto 0 do
begin
if IsCableComponent(TSCSComponent(PointCompon.JoinedComponents[j])) then
PointCompon.DisJoinFrom(TSCSComponent(PointCompon.JoinedComponents[j]));
end;
end;
end;
// âîññòàíîâèòü ñîåäèíåíèÿ
for i := (SavedPointConnectionsList.Count - 1) downto 0 do
begin
SelfPointConnectInfo := TLineComponConnectionInfo(SavedPointConnectionsList[i]);
LineCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(SelfPointConnectInfo.ComponId);
JoinedLineCompon := Nil;
// åñëè ñîåäèíåíèå ÷åðåç ðàéç - âêèíóòü êàáåëü è îòñîåäèíèòü îò âñåãî
if SelfPointConnectInfo.isLineConnection then
begin
JoinedLineCompon := CopyComponentToPMSCSObject(LineCompon, RaiseCatalog, False);
if JoinedLinecompon <> nil then
JoinedLineCompon.DisJoinFromAll(false).Free;
// ñîåäèíèòü êàáåëü íà ðàéçå ñ òåì, ÷òî áûë ïîäêëþ÷åí ê òî÷å÷íîìó
ConnectCableComponents(LineCompon, JoinedLineCompon);
end;
if LineCompon <> nil then
begin
LineCatalog := LineCompon.GetFirstParentCatalog;
if LineCatalog <> nil then
begin
LineFigure := GetFigureByCatalogId(LineCatalog.SCSID);
if LineFigure <> nil then
begin
JoinedLineConnectInfo := TLineComponConnectionInfo(SelfPointConnectInfo.ConnectedComponList[0]);
InterFaceAccordanceList := JoinedLineConnectInfo.ConnectedComponList;
if InterFaceAccordanceList.Count > 0 then
begin
m := 0;
While (m <= (InterFaceAccordanceList.Count - 1)) do
begin
SavedLineComponList := TList(InterFaceAccordanceList[m]);
SavedPointComponList := TList(InterFaceAccordanceList[m + 1]);
for j := 0 to SavedLineComponList.Count - 1 do
begin
ALineInterFace := TSCSInterface(SavedLineComponList[j]);
if SelfPointConnectInfo.isLineConnection then
begin
for k := 0 to JoinedLineCompon.Interfaces.Count - 1 do
begin
if ((TSCSInterface(JoinedLineCompon.Interfaces[k]).TypeI = itFunctional) and
(TSCSInterface(JoinedLineCompon.Interfaces[k]).Npp = aLineInterface.Npp) and
(TSCSInterface(JoinedLineCompon.Interfaces[k]).Side = RaiseSide)) then
ALineInterface := TSCSInterface(JoinedLineCompon.Interfaces[k]);
end;
end;
LineCompon := ALineInterFace.ComponentOwner;
if ALineInterFace <> nil then
begin
for k := 0 to SavedPointComponList.Count - 1 do
begin
APointInterFace := TSCSInterface(SavedPointComponList[k]);
PointCompon := APointInterFace.ComponentOwner;
AInterfPositions1 := ALineInterFace.GetEmptyPositions;
AInterfPositions2 := APointInterFace.GetEmptyPositions;
// óðàâíÿòü êîëè÷åñòâî ïîçèöèé äëÿ ñîåäèíåíèÿ
if AInterfPositions1.Positions.Count > AInterfPositions2.Positions.Count then
begin
While AInterfPositions1.Positions.Count <> AInterfPositions2.Positions.Count do
begin
l := AInterfPositions1.Positions.Count - 1;
AInterfPositions1.Positions.Delete(l);
end;
AInterfPositions1.DefineKolvo;
end
else
if AInterfPositions2.Positions.Count > AInterfPositions1.Positions.Count then
begin
While AInterfPositions2.Positions.Count <> AInterfPositions1.Positions.Count do
begin
l := AInterfPositions2.Positions.Count - 1;
AInterfPositions2.Positions.Delete(l);
end;
AInterfPositions2.DefineKolvo;
end;
ConnectIDCompRel := DefineIDComponRel(LineCompon, PointCompon);
// Äî òîãî êàê ñîåäèíèòü èíòåðôåéñû, íóæíî ñîåäèíèòü ñàìè êîìïîíåíòû
if LineCompon.JoinedComponents.IndexOf(PointCompon) = -1 then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
if TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(LineCompon, PointCompon, false, TempInterfaces1, TempInterfaces2, true).CanConnect then;
FreeAndNil(TempInterfaces1);
FreeAndNil(TempInterfaces2);
end;
if LineCompon.JoinedComponents.IndexOf(PointCompon) <> -1 then
begin
ptrConnection := LineCompon.GetConnectionByConnected(PointCompon);
if ptrConnection <> nil then
begin
TempInterfaces1 := TSCSInterfaces.Create(false);
TempInterfaces2 := TSCSInterfaces.Create(false);
TempInterfaces1.Add(ALineInterFace);
TempInterfaces2.Add(APointInterFace);
InterfCount := AInterfPositions1.Kolvo;
if InterfCount > AInterfPositions2.Kolvo then
InterfCount := AInterfPositions2.Kolvo;
TF_Main(LineCompon.ActiveForm).ConnectInterfacesWithAccordance(ALineInterFace, APointInterFace,
InterfCount, InterfCount, ptrConnection.ID, cntUnion,
AInterfPositions1, AInterfPositions2, true, TempInterfaces1, TempInterfaces2);
TF_Main(LineCompon.ActiveForm).F_ChoiceConnectSide.OnAfterJoinCompons(LineCompon, PointCompon, -1, -1);
end;
end;
end;
end;
end;
SavedLineComponList.Clear;
SavedPointComponList.Clear;
FreeAndNil(SavedLineComponList);
FreeAndNil(SavedPointComponList);
Inc(m,2);
end;
end;
end;
end;
end;
SavedPointConnectionsList.Remove(SelfPointConnectInfo);
FreeAndNil(SelfPointConnectInfo);
end;
FreeAndNil(SavedPointConnectionsList);
end;
end;
begin
try
if GPopupFigure <> nil then
begin
SavedPointConnectionsList := Nil;
PointComponents := Nil;
RaiseLine := nil;
RaiseSide := 0;
BaseConn := TConnectorObject(GPopupFigure);
// Tolik
// îïðåäåëèòü ðàéç è ñòîðîíó ïîäêëþ÷åíèÿ ê ðàéçó â òî÷êå ïîäúåìà
if BaseConn <> nil then
begin
RaiseSide := 0; // ïðîòèâîïîëîæíàÿ ñòîðîíà ðàéçà äëÿ ïîäêëþ÷åíèÿ
if BaseConn.ConnectorType = ct_Clear then
begin
for i := 0 to BaseConn.JoinedOrtholinesList.Count - 1 do
begin
if TorthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
// ðàéç
RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]);
// ñòîðîíà ïðîòèâîïîëîæíîãî ïîäêëþ÷åíèÿ
if TConnectorObject(RaiseLine.JoinConnector1).ID = BaseConn.ID then
RaiseSide := 2
else
if TConnectorObject(RaiseLine.JoinConnector2).ID = BaseConn.ID then
RaiseSide := 1;
break;
end;
end;
end
else
if BaseConn.ConnectorType = ct_NB then
begin
for i := 0 to BaseConn.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList.Count - 1 do
begin
if TOrthoLine(TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(TConnectorObject(BaseConn.JoinedConnectorsList[i]).JoinedOrthoLinesList[j]);
if TConnectorObject(RaiseLine.JoinConnector1).ID = TConnectorObject(BaseConn.JoinedConnectorsList[i]).ID then
RaiseSide := 2
else
if TConnectorObject(RaiseLine.JoinConnector2).ID = TConnectorObject(BaseConn.JoinedConnectorsList[i]).ID then
RaiseSide := 1;
break;
end;
end;
if RaiseSide <> 0 then
break;
end;
end;
end;
//
// ÝÒÎ ÂÅÐØÈÍÀ
GMovedByOtherObject := True;
if BaseConn.FConnRaiseType = crt_OnFloor then
begin
OtherConn := BaseConn.FObjectFromRaise;
if OtherConn <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
//ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ íà òî÷å÷íîì
SaveConnectionOnPointObject;
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithRM(BaseConn, OtherConn)
else
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then
RemoveRMWithClear(BaseConn, OtherConn)
else
if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithClear(OtherConn, BaseConn);
//
if Not BaseConn.Deleted then
begin
i := 0;
while i < BaseConn.JoinedOrtholinesList.Count do
begin
prevcount := BaseConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(BaseConn) or BaseConn.Deleted then
break;
end;
end;
if BaseConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if BaseConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
if Not OtherConn.Deleted then
begin
i := 0;
while i < OtherConn.JoinedOrtholinesList.Count do
begin
prevcount := OtherConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(OtherConn) or OtherConn.Deleted then
break;
end;
end;
if OtherConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if OtherConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
//
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
// ÝÒÎ ÎÑÍÎÂÀÍÈÅ
if GetRaiseConn(BaseConn) <> nil then
begin
OtherConn := GetRaiseConn(BaseConn);
if OtherConn <> nil then
begin
if OtherConn.FConnRaiseType = crt_OnFloor then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
//ñîõðàíèòü êàáåëüíûå ñîåäèíåíèÿ íà òî÷å÷íîì
SaveConnectionOnPointObject;
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithRM(BaseConn, OtherConn)
else
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then
RemoveRMWithClear(BaseConn, OtherConn)
else
if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithClear(OtherConn, BaseConn);
//
if Not BaseConn.Deleted then
begin
i := 0;
while i < BaseConn.JoinedOrtholinesList.Count do
begin
prevcount := BaseConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(BaseConn) or BaseConn.Deleted then
break;
end;
end;
if BaseConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if BaseConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
if Not OtherConn.Deleted then
begin
i := 0;
while i < OtherConn.JoinedOrtholinesList.Count do
begin
prevcount := OtherConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(OtherConn) or OtherConn.Deleted then
break;
end;
end;
if OtherConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if OtherConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
//
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
// Âîññòàíîâèòü êàáåëüíûå ñîåäèíåíèÿ
// if InterFaceAccordanceList <> nil then
RestoreLineConnections;
GMovedByOtherObject := False;
CheckDeleteAllRaises(GCadForm.PCad);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRemoveObjectOnHeightExecute', E.Message);
end;
end;
{
procedure TFSCS_Main.aRemoveObjectOnHeightExecute(Sender: TObject);
var
BaseConn: TConnectorObject;
OtherConn: TConnectorObject;
i: integer;
prevcount: integer;
RaiseLine: TOrthoLine;
begin
try
if GPopupFigure <> nil then
begin
BaseConn := TConnectorObject(GPopupFigure);
// ÝÒÎ ÂÅÐØÈÍÀ
GMovedByOtherObject := True;
if BaseConn.FConnRaiseType = crt_OnFloor then
begin
OtherConn := BaseConn.FObjectFromRaise;
if OtherConn <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithRM(BaseConn, OtherConn);
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then
RemoveRMWithClear(BaseConn, OtherConn);
if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithClear(OtherConn, BaseConn);
//
if Not BaseConn.Deleted then
begin
i := 0;
while i < BaseConn.JoinedOrtholinesList.Count do
begin
prevcount := BaseConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(BaseConn) or BaseConn.Deleted then
break;
end;
end;
if BaseConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if BaseConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
if Not OtherConn.Deleted then
begin
i := 0;
while i < OtherConn.JoinedOrtholinesList.Count do
begin
prevcount := OtherConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(OtherConn) or OtherConn.Deleted then
break;
end;
end;
if OtherConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if OtherConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
//
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
// ÝÒÎ ÎÑÍÎÂÀÍÈÅ
if GetRaiseConn(BaseConn) <> nil then
begin
OtherConn := GetRaiseConn(BaseConn);
if OtherConn <> nil then
begin
if OtherConn.FConnRaiseType = crt_OnFloor then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithRM(BaseConn, OtherConn);
if (BaseConn.ConnectorType <> ct_Clear) and (OtherConn.ConnectorType = ct_Clear) then
RemoveRMWithClear(BaseConn, OtherConn);
if (BaseConn.ConnectorType = ct_Clear) and (OtherConn.ConnectorType <> ct_Clear) then
RemoveRMWithClear(OtherConn, BaseConn);
//
if Not BaseConn.Deleted then
begin
i := 0;
while i < BaseConn.JoinedOrtholinesList.Count do
begin
prevcount := BaseConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(BaseConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(BaseConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(BaseConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(BaseConn) or BaseConn.Deleted then
break;
end;
end;
if BaseConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if BaseConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
if Not OtherConn.Deleted then
begin
i := 0;
while i < OtherConn.JoinedOrtholinesList.Count do
begin
prevcount := OtherConn.JoinedOrtholinesList.Count;
if Not TOrthoLine(OtherConn.JoinedOrtholinesList[i]).Deleted then
begin
if TOrthoLine(OtherConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(OtherConn.JoinedOrtholinesList[i]);
CheckDeleteRaise(RaiseLine);
if Not assigned(OtherConn) or OtherConn.Deleted then
break;
end;
end;
if OtherConn.JoinedOrtholinesList.Count = PrevCount then
i := i + 1;
if OtherConn.JoinedOrtholinesList.Count < PrevCount then
i := 0;
end;
end;
//
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
end;
GMovedByOtherObject := False;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRemoveObjectOnHeightExecute', E.Message);
end;
end; }
procedure TFSCS_Main.aCreateProjectPlanExecute(Sender: TObject);
var
i: integer;
begin
try
if FSCS_Main.MDIChildCount > 0 then
begin
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
if TF_CAD(FSCS_Main.MDIChildren[i]).FListType = lt_ProjectPlan then
begin
ShowMessage(cMain_Mes96);
Exit;
end;
end;
if F_ChooseComponTypes.Execute then
begin
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateProjectPlanExecute', E.Message);
end;
end;
procedure TFSCS_Main.FloatPanel1Click(Sender: TObject);
begin
try
if F_FloatPanel.Visible then
HideFloatPanel
else
ShowFloatPanel;
except
end;
end;
procedure TFSCS_Main.PDock1Resize(Sender: TObject);
begin
try
if F_FloatPanel.ClassName = 'TF_FloatPanel' then
ResizeFloatPanel;
except
end;
end;
procedure TFSCS_Main.aToolCabinetExecute(Sender: TObject);
begin
try
DropDownFirstToolbar; // Tolik 10/02/2021 --
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 9;
GCadForm.PCad.SetTool(toFigure, 'TCabinet');
tbCabinetNoob.Down := True; // Tolik 10/02/2021 --
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolCabinetExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSaveAsWMFExecute(Sender: TObject);
var
FName: string;
FDir: string;
SavePictureDialog: TSavePictureDialog;
Stream: TStream;
mf, mf2, mf3: TMetafile;
wmf: TWMFObject;
i: integer;
rtf: TRichText;
f: tfigure;
begin
if ActiveMDIChild <> nil then
begin
SavePictureDialog := TSavePictureDialog.Create(Self);
{$if Defined(ES_GRAPH_SC)}
FDir := ExeDir;
{$else}
FDir := ExtractFileDir(Application.ExeName);
{$ifend}
if DirectoryExists(FDir + '\.bmp') then
FDir := FDir + '\.bmp';
SavePictureDialog.Title := cMain_Mes97;
SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir;
SavePictureDialog.DefaultExt := 'wmf';
SavePictureDialog.Filter := cMain_Mes98;
if SavePictureDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName));
//
FName := SavePictureDialog.FileName;
GCadForm.PCad.ExportAsWmf(FName);
except
ShowMessage(cMain_Mes8);
end;
end;
SavePictureDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aShowConfiguratorExecute(Sender: TObject);
var
Conn: TConnectorObject;
begin
try
if GPopupFigure <> nil then
begin
Conn := TConnectorObject(GPopupFigure);
ShowConfiguratorForPointObject(Conn.ID);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowConfiguratorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowRepResourcesExecute(Sender: TObject);
begin
try
RepResourceReport;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowRepResourcesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aCreateNormsOnCadExecute(Sender: TObject);
var
i: Integer;
FindCadNorms: TCadNorms;
Lhandle: Integer;
begin
try
if ActiveMDIChild <> nil then
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
FindCadNorms := nil;
for i := 0 to GCadForm.PCad.FigureCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[i]), cTCadNorms) then
FindCadNorms := TCadNorms(GCadForm.PCad.Figures[i]);
end;
if FindCadNorms <> nil then
begin
RemoveInFigureGrp(FindCadNorms);
GCadForm.PCad.Figures.Remove(FindCadNorms);
FreeAndNil(FindCadNorms);
end;
RefreshCAD(GCadForm.PCad);
try
BeginProgress;
LHandle := GCadForm.PCad.GetLayerHandle(1);
FindCadNorms := TCadNorms.create(LHandle, GCadForm.PCad);
FindCadNorms.FNormsList := GetCurrentNormsForCAD(GCadForm.FCADListID);
FindCadNorms.Build;
GCadForm.PCad.AddCustomFigure(1, FindCadNorms, False);
RefreshCAD(GCadForm.PCad);
finally
EndProgress;
end;
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateNormsOnCadExecute', E.Message);
end;
end;
procedure TFSCS_Main.aNormsEditExecute(Sender: TObject);
begin
try
if GPopupFigure <> nil then
if CheckFigureByClassName(GPopupFigure, cTCadNorms) then
begin
if F_CadNormsList.Execute(TCadNorms(GPopupFigure)) then
begin
try
BeginProgress;
TCadNorms(GPopupFigure).ReBuild;
// ñîõðàíèòü ñòðóêòóðó
SetNormsToListFromCAD(GCadForm.FCADListID, TCadNorms(GPopupFigure).FNormsList);
finally
EndProgress;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNormsEditRecordExecute', E.Message);
end;
end;
procedure TFSCS_Main.aNormsPropExecute(Sender: TObject);
begin
try
if GPopupFigure <> nil then
if CheckFigureByClassName(GPopupFigure, cTCadNorms) then
begin
if F_CadNormsProp.Execute(TCadNorms(GPopupFigure)) then
begin
try
BeginProgress;
TCadNorms(GPopupFigure).ReBuild;
finally
EndProgress;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aNormsPropExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMirrorViewExecute(Sender: TObject);
var
Conn: TConnectorObject;
CadCrossObject: TCadCrossObject;
begin
try
BeginProgress;
if GPopupFigure <> nil then
begin
// MessageDlg('', mtWarning, [mbOK], 0);
Conn := TConnectorObject(GPopupFigure);
if Conn.FMirrored then
Conn.FMirrored := False
else
Conn.FMirrored := True;
CadCrossObject := GetPointObjectConnectedTrunk(GCadForm.FCADListID, Conn.ID);
if Conn.FTrunkName = ctsnCrossATS then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
ReCreateCadCrossATS(GCadForm.FCADListID, Conn.ID, CadCrossObject);
AfterMirrorTrunkObject(Conn);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
if Conn.FTrunkName = ctsnDistributionCabinet then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
ReCreateCadDistribCab(GCadForm.FCADListID, Conn.ID, CadCrossObject);
AfterMirrorTrunkObject(Conn);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorViewExecute', E.Message);
end;
EndProgress;
end;
procedure TFSCS_Main.aCreateDuplicatesExecute(Sender: TObject);
var
i, j: Integer;
FFigure: TFigure;
FiguresList: TList;
RaiseConn: TConnectorObject;
RaiseLine: TOrthoLine;
ObjFromRaise: TConnectorObject;
DupList: TList;
PointConn: TConnectorObject;
GetParentDup: TConnectorObject;
DrawDeltaX, DrawDeltaY: Double;
PointToX, PointToY: Double;
SelBnd: TDoubleRect;
Offsetdeltax, Offsetdeltay: double;
// Tolik
SnapToGridsValue, SnapToGuidesValue, SnapToNearValue: Boolean;
CanMoveFigure: Boolean;
UserQuotaReached_Message: String;
//
// Tolik -- 03/09/2016 --
Procedure CheckAlignVLines(aList: TList);
var i: Integer;
VLine: TOrthoLine;
deltax, deltay: Double;
begin
if ((AList <> nil) and (AList.Count > 0)) then
begin
for i := 0 to AList.Count - 1 do
begin
if CheckFigureByClassName(TFigure(aList[i]), cTOrthoLine) then
begin
VLine := TOrthoLine(aList[i]);
if VLine.FIsVertical then
begin
if TConnectorObject(VLine.JoinConnector1).JoinedConnectorsList.Count > 0 then
begin
TConnectorObject(VLine.JoinConnector1).ActualPoints[1] := TConnectorObject(TConnectorObject(VLine.JoinConnector1).JoinedConnectorsList[0]).ActualPoints[1];
DeleteObjectFromPM(TConnectorObject(VLine.JoinConnector1).ID, TConnectorObject(VLine.JoinConnector1).Name);
end;
if TConnectorObject(VLine.JoinConnector2).JoinedConnectorsList.Count > 0 then
begin
TConnectorObject(VLine.JoinConnector2).ActualPoints[1] := TConnectorObject(TConnectorObject(VLine.JoinConnector2).JoinedConnectorsList[0]).ActualPoints[1];
DeleteObjectFromPM(TConnectorObject(VLine.JoinConnector2).ID, TConnectorObject(VLine.JoinConnector2).Name);
end;
end;
VLine.ActualPoints[1] := TConnectorObject(VLine.JoinConnector1).ActualPoints[1];
VLine.ActualPoints[2] := TConnectorObject(VLine.JoinConnector2).ActualPoints[1];
end;
end;
end;
end;
begin
// Tolik -- 27/02/2017 -- ïðîâåðêà íà óãðîçó ïðåâûøåíèÿ îáúåêòîâ USER
UserQuotaReached_Message := '';
//
try
BeginProgress;
// Tolik -- 24/11/2015 -- ñîõðàíÿåì è ñáðàñûâàåì íàñòðîéêè ïðèâÿçêè îáúåêòîâ äëÿ ÊÀÄà,
// èíà÷å ïðè äóáëèðîâàíèè "ïîïëûâóò" ðàçìåðû ëèíåéíûõ îáúåêòîâ
if GCadForm.PCad.SnapToGrids then
SnapToGridsValue := True
else
SnapToGridsValue := False;
if GCadForm.PCad.SnapToGuides then
SnapToGuidesValue := True
else
SnapToGuidesValue := False;
if GCadForm.PCad.SnapToNearPoint then
SnapToNearValue := True
else
SnapToNearValue := False;
// ñáðîñ
GCadForm.PCad.SnapToGrids := False;
GCadForm.PCad.SnapToGuides := False;
GCadForm.PCad.SnapToNearPoint := False;
//
FiguresList := TList.Create;
DupList := nil;
// îñíîâíîé öèêë
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if not (TConnectorObject(FFigure).FIsApproach) then
FiguresList.Add(FFigure);
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
FiguresList.Add(FFigure);
end
else
if FFigure is TNet then
begin
//if TNet(FFigure).FComponID <> 0 then
FiguresList.Add(FFigure);
end;
end;
// Tolik -- 20/11/2015 -- ïàðà êîïèé - è ìû âíå ïðåäåëîâ ÊÀÄà... îíî íàäî?
// ñäâèãàåì ïî äèàãîíàëè íåìíîæêî âïðàâî-âíèç, ÷òîáû áûëî âèäíî ñêîïèðîâàííûå ôèãóðû - è õàðý
// ïîëó÷èòü ãðàíèöû âûäåëåííûõ îáúåêòîâ
{
SelBnd := GCadForm.PCad.GetSelectionRect;
Offsetdeltax := abs(SelBnd.Right - SelBnd.Left);
Offsetdeltay := abs(SelBnd.Bottom - SelBnd.Top);
if Offsetdeltax < Offsetdeltay then
begin
if Offsetdeltax <> 0 then //17.05.2011
Offsetdeltay := 0;
end
else
begin
if Offsetdeltay <> 0 then
Offsetdeltax := 0;
end;
}
Offsetdeltay := 10;
Offsetdeltax := 10;
//
// äîïîëíèòü ñ-ï, êîòîðûå íà ïóñòûõ âûäåëåííûõ ñ-ï
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
FFigure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) and (not TConnectorObject(FFigure).FIsApproach) then
begin
if TConnectorObject(FFigure).ConnectorType = ct_Clear then
begin
RaiseConn := nil;
RaiseLine := nil;
if TConnectorObject(FFigure).JoinedConnectorsList.Count > 0 then
ObjFromRaise := TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[0])
else
ObjFromRaise := TConnectorObject(FFigure);
RaiseConn := GetRaiseConn(ObjFromRaise);
if RaiseConn <> nil then
RaiseLine := GetRaiseLine(RaiseConn);
if RaiseConn <> nil then
if CheckNoFigureInList(RaiseConn, FiguresList) then
FiguresList.Add(RaiseConn);
if RaiseLine <> nil then
if not RaiseLine.Deleted then // Tolik 17/12/2020 --
if CheckNoFigureInList(RaiseLine, FiguresList) then
FiguresList.Add(RaiseLine);
end;
end;
end;
// Tolik 27/02/2017 --
//if FiguresList.Count > 0 then
if ((FiguresList.Count > 0) and (GUserOBjectsQuotaLimit_Message_Counter < 3)) then
begin
UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(FiguresList.Count), cMess_Quota_DuplicateFigList);
if UserQuotaReached_Message = '' then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
BeginDublicateCADObjects;
DupList := CreateSCSObjectDuplicates(GCadForm, FiguresList);
RefreshCAD(GCadForm.PCad);
end
else
if GUserOBjectsQuotaLimit_Message_Counter < 4 then
begin
PauseProgress(True);
ShowMessage(UserQuotaReached_Message);
PauseProgress(False);
end;
end;
FreeAndNil(FiguresList);
EndDublicateCADObjects;
// !!!
if DupList <> nil then
begin
// ãëîáàëüíîå ñìåùåíèå ÓÃÎ îáúåêòîâ
for i := 0 to DupList.Count - 1 do
begin
FFigure := TFigure(DupList[i]);
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if TConnectorObject(FFigure).ConnectorType <> ct_Clear then
begin
PointConn := TConnectorObject(FFigure);
GetParentDup := TConnectorObject(GetFigureByID(GCadForm, PointConn.tmpParentDupID));
if GetParentDup <> nil then
begin
if GetParentDup.DrawFigure <> nil then
begin
DrawDeltaX := GetParentDup.DrawFigure.CenterPoint.x - GetParentDup.ActualPoints[1].x;
DrawDeltaY := GetParentDup.DrawFigure.CenterPoint.y - GetParentDup.ActualPoints[1].y;
PointToX := PointConn.ActualPoints[1].x + DrawDeltaX;
PointToY := PointConn.ActualPoints[1].y + DrawDeltaY;
if PointConn.DrawFigure <> nil then
begin
PointConn.DrawFigure.move(PointToX - PointConn.DrawFigure.CenterPoint.x, PointToY - PointConn.DrawFigure.CenterPoint.y);
end;
end;
end;
PointConn.tmpParentDupID := -1;
end;
end;
end;
// âûäåëèòü ãðóïïû è ñìåñòèòü åå
GCadForm.PCad.DeselectAll(0);
RefreshCAD(GCadForm.PCad);
for i := 0 to DupList.Count - 1 do
TFigure(DupList[i]).Select;
// Tolik -- 23/11/2015 -- íå ñäåëàòü - íà ñëåäóþùåì ïîâòîðíîì äóáëèêàòå
// ïîëîìàåòñÿ âñå íàõ, åñëè áóäóò ñ/ï
for i := 0 to DupList.Count - 1 do
begin
if CheckFigurebyClassName(TFigure(DupList[i]), cTConnectorObject) then
begin
// íà ct_NB âûáèðàåì âñå ïóñòûå, ÷òîáû ïîïàëè ñ/ï (åñëè åñòü) â ñëåäóþùóþ êîïèþ
if TConnectorObject(DupList[i]).ConnectorType = ct_NB then
begin
for j := 0 to TConnectorObject(DupList[i]).JoinedConnectorsList.Count - 1 do
TConnectorObject(TConnectorObject(DupList[i]).JoinedConnectorsList[j]).Selected := True;
end
else // ïóñòîé êîííåêòîð
if (TConnectorObject(DupList[i]).ConnectorType = ct_Clear) and
(TConnectorObject(DupList[i]).JoinedConnectorsList.Count = 0 ) and // òàì ãäå <> 0 îòáåðåòñÿ íà ct_NB
(TConnectorObject(DupList[i]).JoinedOrthoLinesList.Count > 0 ) then
TConnectorObject(DupList[i]).Selected := True;
end
else
// ñ/ï íå âûáèðàåì (íà âñÿêèé ñáðàñûâàåì)
if CheckFigurebyClassName(TFigure(DupList[i]), cTOrthoLine) then
if TOrthoLine(DupList[i]).FIsRaiseUpDown then
TOrthoLine(DupList[i]).Selected := False;
end;
//Tolik 03/09/2016 -- âûðîâíÿòü âåðòèêàëè ïîñëå ñíàïà êîííåòêîðîâ (êîííåêòîðû âåðòèêàëè ìîãóò ñäâèíóòüñÿ)
CheckAlignVLines(DupList);
//
RefreshCAD(GCadForm.PCad);
UnSelectFiguresOnSelectedChange(GcadForm.PCad.Selection);
RefreshCAD(GCadForm.PCad);
// ïåðåìåñòèòü
{ for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
{ FFigure := TFigure(GCadForm.PCad.Selection[i]);
// Tolik 24/11/2015 -- ïðîâåðèòü è äâèíóòü òîëüêî ïóñòûå è íåïðèñîåäèíåííûå ê òî÷å÷íûì êîííåêòîðû
// ÷òîáû íå áûëî äâîéíîãî ñäâèãà
CanMoveFigure := False;
if CheckFigureByClassName(FFigure, cTConnectorObject) then
begin
if TConnectorObject(FFigure).ConnectorType = ct_Clear then
begin
CanMoveFigure := True;
for j := 0 to TConnectorObject(FFigure).JoinedConnectorsList.Count - 1 do
begin
if ((TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[j]).ConnectorType = ct_NB) and
(GCadForm.PCad.Selection.IndexOf(TConnectorObject(TConnectorObject(FFigure).JoinedConnectorsList[j])) <> -1)) then
begin
CanMoveFigure := False;
Break; //// BREAK ////
end;
end;
end;
end
else
if CheckFigureByClassName(FFigure, cTOrthoLine) then
begin
if ((GCadForm.PCad.Selection.IndexOf(TOrthoLine(FFigure).JoinConnector1) <> -1) or
(GCadForm.PCad.Selection.IndexOf(TOrthoLine(FFigure).JoinConnector2) <> -1)) then
CanMoveFigure := False;
end
else
CanMoveFigure := True;
if CanMoveFigure then
begin }
//
GCadForm.PCad.MoveSelection(Offsetdeltax, Offsetdeltay);
{ if not FFigure.LockMove then
begin
if FFigure is TNet then
TNet(FFigure).FMoveAllPoints := true;
FFigure.Move(Offsetdeltax, Offsetdeltay);
if FFigure is TNet then
TNet(FFigure).FMoveAllPoints := false;
end;
end;
end; }
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateDuplicatesExecute', E.Message);
end;
// Tolik -- 24/11/2015 -- âîññòàíàâëèâàåì çíà÷åíèÿ íàñòðîåê ïðèâÿçêè(âûðàâíèâàíèÿ) îáúåêòîâ äëÿ ÊÀÄà
GCadForm.PCad.SnapToGrids := SnapToGridsValue;
GCadForm.PCad.SnapToGuides := SnapToGuidesValue;
GCadForm.PCad.SnapToNearPoint := SnapToNearValue;
if DupList <> nil then // ýòî ïðîñòî çàáûëè
FreeAndNil(DupList);
//if GCadForm.GisEventWaiting then
if GCadForm.FRemFigures.Count > 0 then
begin
//GCadForm.PCad.EventEngine(95,1,'',0); // Tolik 27/03/2019 --
GCadForm.PCad.OnGUIEvent := GCADFORM.PCadGUIEvent;
end;
//
EndProgress;
end;
procedure TFSCS_Main.aCHMExecute(Sender: TObject);
var
FileName: string;
begin
try
FileName := ExeDir + '\Help\Help.chm';
if FileExists(FileName) then
begin
ShellExecute(FSCS_Main.Handle, 0, PChar(FileName), 0, 0, SW_SHOWNORMAL);
end
else
ShowMessage(cMain_Mes87);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCHMExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDisconnectTracesExecute(Sender: TObject);
var
i: Integer;
CurObject: TConnectorObject;
SelList, FigList: TList;
//vList: TList;
//vIntLIst: TIntList;
begin
try
if GPopupFigure = nil then
exit;
SelList := TList.Create;
for i := 0 to GCadForm.PCad.SelectedCount - 1 do
begin
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[i]), cTConnectorObject) then
begin
CurObject := TConnectorObject(GCadForm.PCad.Selection[i]);
if CurObject.ConnectorType = Ct_Clear then
SelList.Add(CurObject);
end;
end;
if SelList.Count > 0 then
begin
// *UNDO*
// vIntList := GetListsIDRelatedToFigures(GCadForm.FCADListID, FiguresToIntFigures(SelList));
// vList := IntCadsToCads(vIntList);
// if vList.Count = 1 then
// GCadForm.SaveForUndo(uat_None, True, False)
// else
// SaveForProjectUndo(vList, True, False);
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to SelList.Count - 1 do
begin
CurObject := TConnectorObject(SelList[i]);
CurObject.Deselect;
DisconnectTraces(CurObject);
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
FreeAndNil(SelList);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDisconnectTracesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aRotateTraceDrawFigure180Execute(Sender: TObject);
var
RotateTrace: TOrthoLine;
CP: TDoublePoint;
begin
try
if GPopupFigure = nil then
exit;
RotateTrace := TOrthoLine(GPopupFigure);
CP := DoublePoint((RotateTrace.ActualPoints[1].x + RotateTrace.ActualPoints[2].x) / 2,
(RotateTrace.ActualPoints[1].y + RotateTrace.ActualPoints[2].y) / 2);
// âåðíóòü â Ðåæèì îáû÷íûé
if RotateTrace.FIsRotated then
begin
RotateTrace.FIsRotated := false;
if RotateTrace.DrawFigure <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
RotateTrace.DrawFigure.Rotate(- pi, CP);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end
else
// â Ðåæèì 180
begin
RotateTrace.FIsRotated := true;
if RotateTrace.DrawFigure <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
RotateTrace.DrawFigure.Rotate(pi, CP);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRotateTraceDrawFigure180Execute', E.Message);
end;
end;
procedure TFSCS_Main.aDesignBoxParamsExecute(Sender: TObject);
var
DesignID: Integer;
BoxID: Integer;
FList: TF_CAD;
FBox: TConnectorObject;
begin
try
F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked := GCadForm.FDesignListShowName;
F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked := GCadForm.FDesignListShowSign;
F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked := GCadForm.FDesignListShowMark;
if F_ChooseDesignBoxParams.Execute then
begin
GCadForm.FDesignListShowName := F_ChooseDesignBoxParams.cbShowDesignBoxName.Checked;
GCadForm.FDesignListShowSign := F_ChooseDesignBoxParams.cbShowDesignBoxSign.Checked;
GCadForm.FDesignListShowMark := F_ChooseDesignBoxParams.cbShowDesignBoxMark.Checked;
DesignID := GCadForm.FJoinedListIDForDesignList;
BoxID := GCadForm.FJoinedBoxIDForDesignList;
FList := GetListByID(DesignID);
if FList <> nil then
begin
FBox := TConnectorObject(GetFigureByID(FList, BoxID));
if FBox <> nil then
begin
UpdateDesignList(GCadForm, FBox);
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aDesignBoxParamsExecute', E.Message);
end;
end;
procedure TFSCS_Main.aPackNormBaseExecute(Sender: TObject);
begin
try
PackNormBase;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPackNormBaseExecute', E.Message);
end;
end;
procedure TFSCS_Main.aPackProjManExecute(Sender: TObject);
begin
try
PackProjMan;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aPackProjManExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMirrorBlockExecute(Sender: TObject);
var
vObject: TConnectorObject;
ang: Double;
begin
try
if GPopupFigure <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
vObject := TConnectorObject(GPopupFigure);
ang := vObject.FDrawFigureAngle;
vObject.DrawFigure.Rotate(- ang, vObject.DrawFigure.CenterPoint);
vObject.DrawFigure.Mirror(vObject.DrawFigure.CenterPoint, vObject.DrawFigure.CenterPoint);
vObject.DrawFigure.Rotate(ang);
// vObject.DrawFigure.Rotate(pi, vObject.DrawFigure.CenterPoint);
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMirrorBlockExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMarkForTracingExecute(Sender: TObject);
var
vLine: TOrthoLine;
begin
try
if GPopupFigure <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
vLine := TOrthoLine(GPopupFigure);
vLine.FMarkTracing := not vLine.FMarkTracing;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMarkForTracingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aBlockParamsExecute(Sender: TObject);
{var
TempBlock: TFigure;
FigHandle: Integer;
CommonNetIdx: Integer;
IsSaveForUndo: Boolean;}
var
SelFigure: TFigure;
SelFigureObj: TSCSComponent;
CommonNetIdx: Integer;
begin
if GCadForm.PCad.Selection.Count > 1 then
begin
SelFigure := TFigure(GCadForm.PCad.Selection[0]);
//10.05.2012 Åñëè TNet, òî åñëè âûäåëåíû âñå ñåãìåíòû êðûøè (ñâÿçàííûå), òî âûâîäèì äèàëîã ñ ó÷åòîì âûñîòû êðûøè
if (SelFigure.ClassName = TNet.ClassName) and (TNet(SelFigure).FComponID <> 0) then
begin
CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet);
SelFigureObj := GetArchObjByCADObj(SelFigure);
if SelFigureObj <> nil then
if SelFigureObj.IsLine = ctArhRoofSeg then
begin
if IsAllRelatedNetsInList(TNet(SelFigure), GCadForm.PCad.Selection, true) then
ShowRoofParams(GCadForm, nil, GCadForm.PCad.Selection);
end;
if CommonNetIdx <> -1 then
begin
GCadForm.PCad.Selection.Add(GCadForm.FActiveNet);
GCadForm.FActiveNet.Selected := true;
end;
end;
end
else
ShowBlockParamsForPopupFigure;
{try
TempBlock := nil;
IsSaveForUndo := false;
try
if (GPopupFigure = nil) then
begin
if GCadForm.PCad.ActiveLayer = lnArch then
begin
GCadForm.BeginSaveForUndo(uat_None, False, False);
IsSaveForUndo := true;
if GCadForm.PCad.SelectedCount = 1 then
TempBlock := TFigure(GCadForm.PCad.Selection.Items[0])
else
if GCadForm.PCad.SelectedCount > 0 then
begin
//CommonNetIdx := GCadForm.PCad.Selection.IndexOf(GCadForm.FActiveNet);
//if CommonNetIdx <> -1 then
//begin
// GCadForm.FActiveNet.Selected := false;
// GCadForm.PCad.Selection.Delete(CommonNetIdx);
//end;
CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet);
FigHandle := GCadForm.PCad.GroupSelection;
SetProjectChanged(True);
TempBlock := TFigure(FigHandle);
if CommonNetIdx <> -1 then
begin
GCadForm.PCad.Selection.Add(GCadForm.FActiveNet);
GCadForm.FActiveNet.Selected := true;
end;
end;
GPopupFigure := TempBlock;
end;
end;
if GPopupFigure <> nil then
begin
F_BlockParams.Execute(GPopupFigure);
end;
if (TempBlock <> nil) and (TempBlock is TFigureGrp) then
begin
GCadForm.PCad.UnGroupSelection;
SetProjectChanged(True);
end;
finally
if IsSaveForUndo then
GCadForm.EndSaveForUndo;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aBlockParamsExecute', E.Message);
end;}
end;
procedure TFSCS_Main.aCabinetFalseFloorExecute(Sender: TObject);
var
Cabinet: TCabinet;
SCSID: Integer;
begin
try
if GPopupFigure <> nil then
begin
SCSID := -1;
if CheckFigureByClassName(GPopupFigure, cTCabinet) then
SCSID := TCabinet(GPopupFigure).FSCSID
else
if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then
SCSID := TCabinetExt(GPopupFigure).FSCSID;
ShowRoomPropsInCAD(GCadForm.FCADListID, SCSID);
// Cabinet := TCabinet(GPopupFigure);
// SetCabinetFalseFloor(Cabinet);
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCabinetFalseFloorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aLicenceTypeExecute(Sender: TObject);
var
CanRemotePath: Boolean;
begin
try
(*
{$IF NOT Defined(TRIAL_SCS)}
CheckProtectionBase(true);
GProtectionType := GetProtectionType;
if GProtectionType <> ltLocal then
begin
if AnsiLowerCase(F_NormBase.DM.Database_SCS.DatabaseName) <> AnsiLowerCase(GetStrFromRegistry(pnServerNameNB, '') + ':' + GetStrFromRegistry(pnLocalPathToNB, '')) then
begin
ShowMessage('Íåîáõîäèìî ïåðåçàïóñòèòü ïðîãðàììíûé êîìïëåêñ!');
ExitProcess(0);
end;
end;
{$IFEND} *)
{$IF Defined (TRIAL_SCS)}
CanRemotePath := false;
{$ELSE}
CanRemotePath := true;
{$IFEND}
ConnecToNBWizard(true, false, true, CanRemotePath);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aLicenceTypeExecute', E.Message);
end;
end;
procedure TFSCS_Main.aToolMultiLineExecute(Sender: TObject);
begin
try
if ActiveMDIChild <> nil then
begin
aSetSCSLayer.Execute;
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GDefaultNum := 2;
GDefaultGap := 4;
GCurrentConnectorType := ct_Clear;
F_OrthoLineParams.ShowModal;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aToolMultiLineExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowDisconnectedObjectsExecute(Sender: TObject);
begin
try
if aShowDisconnectedObjects.Checked = True then
begin
GCadForm.FShowDisconnectedObjects := True;
end
else
begin
GCadForm.FShowDisconnectedObjects := False;
end;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aShowDisconnectedObjectsExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMasterUpdateComponPriceFromXFExecute(Sender: TObject);
begin
try
ShowMasterUpdatePriceInNB;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMasterUpdateComponPriceFromXFExecute', E.Message);
end;
end;
procedure TFSCS_Main.aRefreshDesignListExecute(Sender: TObject);
var
vList: TF_CAD;
vBox: TConnectorObject;
begin
try
vList := GetListByID(GCadForm.FJoinedListIDForDesignList);
if vList <> nil then
begin
vBox := TConnectorObject(GetFigureByID(vList, GCadForm.FJoinedBoxIDForDesignList));
if vBox <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndoDesignList(uat_None, false, false);
GCadForm.FCanSaveForUndo := False;
end;
UpdateDesignList(GCadForm, vBox);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aRefreshDesignListExecute', E.Message);
end;
end;
procedure TFSCS_Main.aBackUpBaseExecute(Sender: TObject);
begin
BackUpBase(bkNone);
end;
procedure TFSCS_Main.aRestoreBaseExecute(Sender: TObject);
begin
RestoreBase;
end;
procedure TFSCS_Main.aExpertModeExecute(Sender: TObject);
var
i: integer;
CAD: TF_CAD;
begin
try
GSCSIni.Controls.F_SCSMain_IsPanelExpertMode := aExpertMode.Checked; //01.04.2009
WriteControls(GSCSIni.Controls); //#From Oleg#
//19.12.2011 -
//for i := 0 to FSCS_Main.MDIChildCount - 1 do
//begin
// CAD := TF_CAD(FSCS_Main.MDIChildren[i]);
// CAD.OnResize := nil;
//end;
cbMainPanel.DisableAlign;
try
//cbMainPanel.
if aExpertMode.Checked then
begin
tbCADToolsExpert.Visible := True;
tbSCSToolsExpert.Visible := True;
// Tolik 24/01/2017 --
tbCADToolsNoob2.Visible := False;
tbCalc.Visible := true;
//
tbCADToolsNoob.Visible := False;
tbSCSToolsNoob.Visible := False;
if Assigned(tbSCSToolsExpert) and Assigned(cbMainPanel) then
begin
tbSCSToolsExpert.Width := cSCSExpert;
tbSCSToolsExpert.Left := cbMainPanel.Width - tbSCSToolsExpert.Width;
end;
//Tolik 13/08/2021 --
ToolButton9.Visible := True;
ToolButton10.Visible := True;
//tbSCSToolsNoob.Visible := True;
//
end
else
begin
//Tolik 13/08/2021 --
ToolButton9.Visible := False;
ToolButton10.Visible := False;
tbSCSToolsNoob.Visible := False;
tbCalc.Visible := false;
//
tbCADToolsExpert.Visible := False;
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsExpert.Visible := True;
{$else}
tbSCSToolsExpert.Visible := False;
{$ifend}
tbCADToolsNoob2.Visible := False;
tbCADToolsNoob.Visible := False;
tbCADToolsNoob.Visible := True;
// Tolik 24/01/2017 - -
tbCADToolsNoob2.Visible := True;
//
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsNoob.Visible := False;
{$else}
//tbSCSToolsNoob.Visible := True;
{$ifend}
if Assigned(tbSCSToolsNoob) and Assigned(cbMainPanel) then
begin
{$IF Defined(SCS_PE) or Defined(SCS_SPA)}
tbCADToolsNoob.Width := cCADNoob_PE;
tbCADToolsNoob2.Width := cCADNoob_PE;
tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 32;
// Tolik -- 24/01/2017
// tbSCSToolsNoob.Width := cSCSNoob_PE;
tbSCSToolsNoob.Width := cSCSNoob_PE + 20;
//
{$ELSEIF Defined(TELECOM)}
tbCADToolsNoob.Width := cCADNoob_TEL;
tbCADToolsNoob2.Width := cCADNoob_TEL;
tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 30;
// Tolik 24/01/2017 --
// tbSCSToolsNoob.Width := cSCSNoob_SCS;
tbSCSToolsNoob.Width := cSCSNoob_SCS + 20;
//
{$ELSE}
// Tolik -- 01/02/2017 --
{$if Defined(ES_GRAPH_SC)}
tbCADToolsNoob.Width := 600;
tbCADToolsNoob2.Width := 300;
{$ELSE}
//
tbCADToolsNoob.Width := cCADNoob_SCS;
//Tolik 17/08/2021 --
//tbCADToolsNoob2.Width := cCADNoob_SCS;
tbCADToolsNoob2.Width := cCADNoob_SCS;
//
tbCADToolsNoob2.Top := tbCADToolsNoob.Top + 30;
{$ifend}
// Tolik -- 24/01/2017 --
// tbSCSToolsNoob.Width := cSCSNoob_SCS;
tbSCSToolsNoob.Width := cSCSNoob_SCS + 20;
//
{$IFEND}
// Tolik -- 24/01/2017 --
// tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width;
tbSCSToolsNoob.Left := cbMainPanel.Width - tbSCSToolsNoob.Width;
//
end;
end;
if tbCADToolsNoob.Visible then
begin
tbCADToolsNoob.Top := tbCADToolsExpert.Top;
tbCADToolsNoob.Left := tbCADToolsExpert.Left;
// Tolik -- 01/02/2017 --
tbCADToolsNoob2.Visible := False;
tbCADToolsNoob.visible := False;
{$if Defined(ES_GRAPH_SC)}
tbCADToolsNoob2.Left := tbCADToolsNoob.Left + tbCADToolsNoob.width + 10;
tbCADToolsNoob2.Top := tbCADToolsExpert.Top;
{$else}
tbCADToolsNoob2.Top := tbCADToolsExpert.Top + 30;
tbCADToolsNoob2.Left := tbCADToolsExpert.Left;
{$ifend}
tbCADToolsNoob.Visible := True;
tbCADToolsNoob2.Visible := True;
//
end;
if tbSCSToolsNoob.Visible then
begin
tbSCSToolsNoob.Top := tbSCSToolsExpert.Top;
end;
if tbCADToolsExpert.Visible then
begin
tbSelectExpert.Down := True;
tbSelectNoob.Down := False;
end
else
begin
tbSelectExpert.Down := False;
tbSelectNoob.Down := True;
end;
finally
cbMainPanel.EnableAlign;
//19.12.2011 -
//for i := 0 to FSCS_Main.MDIChildCount - 1 do
//begin
// CAD := TF_CAD(FSCS_Main.MDIChildren[i]);
// CAD.OnResize := CAD.FormResize;
//end;
end;
if GCadForm <> nil then
GCadForm.FormActivate(GCadForm);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aExpertModeExecute', E.Message);
end;
end;
procedure TFSCS_Main.cbLayersPropertiesInitPopup(Sender: TObject);
var
i: integer;
begin
if (GCadForm.PCad.Layers.Count - 1) <> cbLayers.Properties.Items.Count then
begin
cbLayers.Properties.Items.Clear;
for i := 1 to GCadForm.PCad.LayerCount - 1 do
cbLayers.Properties.Items.Add(GCadForm.PCad.GetLayerName(i));
end;
end;
procedure TFSCS_Main.aShowPMUsersExecute(Sender: TObject);
begin
try
ShowPMUsers;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.Act_ShowPMUsersExecute', E.Message);
end;
end;
procedure TFSCS_Main.aLoginUserToProManExecute(Sender: TObject);
begin
try
LoginUserToProMan;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aLoginUserToProManExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowCurrUserInfoExecute(Sender: TObject);
begin
try
ShowCurrUserInfo;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aShowCurrUserInfoExecute', E.Message);
end;
end;
procedure TFSCS_Main.aExpertNewsExecute(Sender: TObject);
var
temps : string;
t : word;
innt: integer;
tmr: integer;
s : string;
begin
try
if PROG_NEWSID <> '-1' then
begin
temps := ExtractFilePath(application.ExeName)+'news\mess.txt';
t := 11;
case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 1, t) of
0:begin
end;
end;
case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 2, t) of
0:begin
innt:=t*60*1000;
tmr:=innt;
TimerNews.Interval := tmr;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aExpertNewsExecute', E.Message);
end;
end;
procedure TFSCS_Main.TimerNewsTimer(Sender: TObject);
var
temps : string;
t : word;
innt: integer;
tmr: integer;
begin
TimerNews.OnTimer := nil;
TimerNews.Enabled := False;
if PROG_NEWSID <> '-1' then
begin
try
temps := ExtractFilePath(application.ExeName)+'news\mess.txt';
case Get_News(application.Handle, PROG_NEWSID, SiteUrlNews + 'expert_news/expert_news' + IDESerialG + '.html', SiteUrlNews + 'expert_news/expert_news.html', temps, 0, t) of
0:begin
TimerNews.Enabled := True;
end;
1:begin TimerNews.Enabled := False;
// ShowMessage('Îøèáêà çàãðóçêè áèáëèîòåêè');
end;
// 2:begin ShowMessage('Îøèáêà âûçîâà ïðîöåäóðû'); end;
// 3:begin ShowMessage('Îøèáî÷íûé ïàðàìåòð âûçîâà'); end;
// 4:begin ShowMessage('Îøèáêà âûïîëíåíèÿ ïðîöåäóðû'); end;
end;
except
end;
TimerNews.OnTimer := TimerNewsTimer;
end;
end;
procedure TFSCS_Main.tbCalcClick(Sender: TObject);
begin
try
{$IF Defined(OEM_NIKOMAX)}
MessageBox(Application.Handle, 'Íåäîñòóïíî â äàííîé ñáîðêå!', 'Âíèìàíèå!', MB_OK);
{$ELSE}
ShowKalc;
{$IFEND}
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.tbCalcClick', E.Message);
end;
end;
procedure TFSCS_Main.aMarkingPagesExecute(Sender: TObject);
begin
try
RepMarkPages;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aMarkingPagesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMarkForDisableTracingExecute(Sender: TObject);
var
vLine: TOrthoLine;
begin
try
if GPopupFigure <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
vLine := TOrthoLine(GPopupFigure);
vLine.FDisableTracing := not vLine.FDisableTracing;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aMarkForTracingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aMasterAutoTraceElectricExecute(Sender: TObject);
begin
try
F_NormBase.Act_AutoTraceByRayMode.Execute;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aMasterAutoTraceElectricExecute', E.Message);
end;
end;
//ôóíêöèÿ âûçîâà
function RunPresentation: boolean;
var
RunPre: procedure(); stdcall;
begin
Result := false;
if phandle = 0 then
phandle := LoadLibrary(PChar('ep.dll'));
try
if phandle <> 0 then
begin
Result := true;
@RunPre:=GetProcAddress(phandle,'RExecute');
@SetHook:=GetProcAddress(phandle,'SetHook');
@DropHook:=GetProcAddress(phandle,'UnHook');
if (@SetHook <> nil) and (@DropHook <> nil) then
is_hook:=true;
if @RunPre <> nil then
begin
try
// SetHook;
RunPre();
except
Result := false;
Exit;
end;
end;
end;
finally
end;
end;
procedure TFSCS_Main.ExpertPresentation1Click(Sender: TObject);
begin
if RunPresentation then
begin
end
else
begin
// Tolik --10/09/2018 -*-
(*
{$IF Defined(SCS_PE)}
ShowMessage('Error load presentation module');
{$ELSE}
ShowMessage('Îøèáêà çàãðóçêè ìîäóëÿ ïðåçåíòàöèè');
{$IFEND}
*)
ShowMessage(cPresentation_err1);
//
end;
end;
procedure TFSCS_Main.WMGetSysCommand(var msg: TMessage);
//var
// OldReadOnly: boolean;
begin
if (msg.wParam = SC_CLOSE) then
begin
GNotNeedCheckRaisesBeforeClose := True;
//if Assigned(F_ProjMan) then
//begin
// OldReadOnly := F_ProjMan.GSCSBase.CurrProject.ReadOnly;
// F_ProjMan.GSCSBase.CurrProject.ReadOnly := true;
//end;
GCloseProg := True;
try
inherited;
finally
GNotNeedCheckRaisesBeforeClose := False;
GCloseProg := False;
// if Assigned(F_ProjMan) then
// F_ProjMan.GSCSBase.CurrProject.ReadOnly := OldReadOnly;
end;
end
else
inherited;
end;
procedure TFSCS_Main.aCreateFloorRaiseUpExecute(Sender: TObject);
var
RaiseOnFigure: TConnectorObject;
ID_Floor: Integer;
i: integer;
ConnForPassage: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseConnPassage: TConnectorObject;
ListForPassage: TF_CAD;
CurGCadFrom: TF_CAD;
LayHandle: Integer;
ObjParams: TObjectParams;
CreatePoints: TDoublePoint;
z: double;
vLists: TList;
SavedGCadForm: TF_CAD;
SavedGPopupFigure: TFigure;
begin
// Tolik 09/02/2017 --
vLists := nil;
//
try
RaiseOnFigure := nil; //#From Oleg# //14.09.2010
if (not ShowCreateRaiseQuery) or F_CreateRaiseQuery.Execute then
begin
// èñêàòü ýòàæ
ID_Floor := GetListIDForCreatePassage(GCadForm.FCADListID, 1);
ListForPassage := nil;
if ID_Floor > 0 then
if Not CheckListExist(ID_Floor) then
begin
SavedGCadForm := GCadForm;
SavedGPopupFigure := GPopupFigure;
Application.ProcessMessages;
ReopenListInCAD(ID_Floor, '');
Application.ProcessMessages;
GCadForm := SavedGCadForm;
GPopupFigure := SavedGPopupFigure;
end;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = ID_Floor then
begin
ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]);
Break;
end;
end;
// Íàéäåííûé ýòàæ
if ListForPassage = nil then
begin
ShowMessage(cMain_Mes45);
GCadForm.mProtocol.Lines.Add(cMain_Mes45);
Exit;
end
else
begin
// òèï ëèñòà íå îáû÷íûé
if ListForPassage.FListType <> lt_Normal then
begin
ShowMessage(cMain_Mes46);
Exit;
end;
// òèï ñåòè âíåøíÿÿ
if ListForPassage.FSCSType = st_External then
begin
ShowMessage(cMain_Mes101);
Exit;
end;
end;
if GPopupFigure = nil then
Exit;
// *UNDO*
vLists := TList.Create;
vLists.Add(GCadForm);
vLists.Add(ListForPassage);
SaveForProjectUndo(vLists, True, False);
// if GCadForm.FCanSaveForUndo then
// begin
// GCadForm.SaveForUndo(uat_Floor);
// GCadForm.FCanSaveForUndo := False;
// end;
// if ListForPassage.FCanSaveForUndo then
// begin
// ListForPassage.SaveForUndo(uat_Floor);
// ListForPassage.FCanSaveForUndo := False;
// end;
if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then
begin
if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then
begin
CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y);
z := TOrthoLine(GPopupFigure).ActualZOrder[1];
end
else
begin
CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2;
CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2;
z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2;
end;
{//25.06.2013
RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseOnFigure.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False);
RaiseOnFigure.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name);
ObjParams := GetFigureParams(RaiseOnFigure.ID);
RaiseOnFigure.Name := ObjParams.Name;
RaiseOnFigure.FIndex := ObjParams.MarkID;}
RaiseOnFigure := GCadForm.CreateConnForFloorRaise(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle);
SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure));
end
else
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
begin
RaiseOnFigure := TConnectorObject(GPopupFigure);
end;
// ñîçäàòü ì-ý ïîäúåì ñ ýòàæà íà îáúåêòå
if RaiseOnFigure.ConnectorType = ct_Clear then
RaiseConn := CreateBetweenFloorRaiseOnConnector(RaiseOnFigure, lrt_Up)
else
RaiseConn := CreateBetweenFloorRaiseOnPointObject(RaiseOnFigure, lrt_Up);
ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]);
CurGCadFrom := GCadForm;
GCadForm := ListForPassage;
GCadForm.BringToFront;
// Ñîçäàòü îáúåêò íà íàéäåíîì ýòàæå
LayHandle := GCadForm.PCad.GetLayerHandle(2);
//24.10.2012 ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight,
//24.10.2012 LayHandle, mydsNormal, GCadForm.PCad);
ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FLineHeight,
LayHandle, mydsNormal, GCadForm.PCad);
ConnForPassage.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False);
ConnForPassage.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name);
ObjParams := GetFigureParams(ConnForPassage.ID);
ConnForPassage.Name := ObjParams.Name;
ConnForPassage.FIndex := ObjParams.MarkID;
// ñîçäàòü ì-ý ñïóñê îò òîãî îáúåêòà
RaiseConnPassage := CreateBetweenFloorRaiseOnConnector(ConnForPassage, lrt_Down);
GCadForm := CurGCadFrom;
GCadForm.BringToFront;
// Çàïîëíèòü ïîëÿ ñîåäèíåíèé òî÷åê ïåðåõîäà
RaiseConn.FID_ListToPassage := ListForPassage.FCADListID;
RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID;
RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID;
RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID;
SetConnBringToFront(RaiseOnFigure);
SetConnBringToFront(ConnForPassage);
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
ListForPassage.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseUpExecute', E.Message);
end;
// Tolik 09/02/2017 --
if vLists <> nil then
FreeAndNil(vLists);
//
end;
procedure TFSCS_Main.aCreateFloorRaiseDownExecute(Sender: TObject);
var
RaiseOnFigure: TConnectorObject;
ID_Floor: Integer;
i: integer;
ConnForPassage: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseConnPassage: TConnectorObject;
ListForPassage: TF_CAD;
CurGCadFrom: TF_CAD;
LayHandle: Integer;
ObjParams: TObjectParams;
CreatePoints: TDoublePoint;
z: double;
vLists: TList;
SavedGCadForm: TF_CAD;
SavedGPopupFigure: TFigure;
begin
// Tolik -- 09/02/2017 --
vLists := Nil;
//
try
RaiseOnFigure := nil; //#From Oleg# //14.09.2010
if (not ShowCreateRaiseQuery) or F_CreateRaiseQuery.Execute then
begin
// èñêàòü ýòàæ
ID_Floor := GetListIDForCreatePassage(GCadForm.FCADListID, -1);
ListForPassage := nil;
if ID_Floor > 0 then
if Not CheckListExist(ID_Floor) then
begin
SavedGCadForm := GCadForm;
SavedGPopupFigure := GPopupFigure;
Application.ProcessMessages;
ReopenListInCAD(ID_Floor, '');
Application.ProcessMessages;
GCadForm := SavedGCadForm;
GPopupFigure := SavedGPopupFigure;
end;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
if TF_CAD(FSCS_Main.MDIChildren[i]).FCADListID = ID_Floor then
begin
ListForPassage := TF_CAD(FSCS_Main.MDIChildren[i]);
Break;
end;
end;
// Íàéäåííûé ýòàæ
if ListForPassage = nil then
begin
ShowMessage(cMain_Mes47);
GCadForm.mProtocol.Lines.Add(cMain_Mes47);
Exit;
end
else
begin
// òèï ëèñòà íå îáû÷íûé
if ListForPassage.FListType <> lt_Normal then
begin
ShowMessage(cMain_Mes48);
Exit;
end;
// òèï ñåòè âíåøíÿÿ
if ListForPassage.FSCSType = st_External then
begin
ShowMessage(cMain_Mes102);
Exit;
end;
end;
if GPopupFigure = nil then
Exit;
// *UNDO*
vLists := TList.Create;
vLists.Add(GCadForm);
vLists.Add(ListForPassage);
SaveForProjectUndo(vLists, True, False);
if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then
begin
if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then
begin
CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y);
z := TOrthoLine(GPopupFigure).ActualZOrder[1];
end
else
begin
CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2;
CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2;
z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2;
end;
{//19.06.2013
RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseOnFigure.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False);
RaiseOnFigure.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name);
ObjParams := GetFigureParams(RaiseOnFigure.ID);
RaiseOnFigure.Name := ObjParams.Name;
RaiseOnFigure.FIndex := ObjParams.MarkID;}
RaiseOnFigure := GCadForm.CreateConnForFloorRaise(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle);
SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure));
end
else
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
begin
RaiseOnFigure := TConnectorObject(GPopupFigure);
end;
if RaiseOnFigure.ConnectorType = ct_Clear then
RaiseConn := CreateBetweenFloorRaiseOnConnector(RaiseOnFigure, lrt_Down)
else
RaiseConn := CreateBetweenFloorRaiseOnPointObject(RaiseOnFigure, lrt_Down);
CurGCadFrom := GCadForm;
GCadForm := ListForPassage;
GCadForm.BringToFront;
// Ñîçäàòü îáúåêò íà íàéäåíîì ýòàæå
LayHandle := GCadForm.PCad.GetLayerHandle(2);
//24.10.2012 ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight,
//24.10.2012 LayHandle, mydsNormal, GCadForm.PCad);
ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FLineHeight,
LayHandle, mydsNormal, GCadForm.PCad);
ConnForPassage.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False);
ConnForPassage.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name);
ObjParams := GetFigureParams(ConnForPassage.ID);
ConnForPassage.Name := ObjParams.Name;
ConnForPassage.FIndex := ObjParams.MarkID;
// ñîçäàòü ì-ý ïîäúåì îò òîãî îáúåêòà
RaiseConnPassage := CreateBetweenFloorRaiseOnConnector(ConnForPassage, lrt_Up);
GCadForm := CurGCadFrom;
GCadForm.BringToFront;
// Çàïîëíèòü ïîëÿ ñîåäèíåíèé òî÷åê ïåðåõîäà
RaiseConn.FID_ListToPassage := ListForPassage.FCADListID;
RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID;
RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID;
RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
ListForPassage.FCanSaveForUndo := True;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aCreateFloorRaiseDownExecute', E.Message);
end;
// Tolik 09/02/2017 --
if VLists <> nil then
FreeAndNil(vLists);
//
end;
procedure TFSCS_Main.aCreateTrunkExecute(Sender: TObject);
var
i: Integer;
Item: TListItem;
FList: TF_CAD;
//
RaiseOnFigure: TConnectorObject;
ID_Floor: Integer;
ConnForPassage: TConnectorObject;
RaiseConn: TConnectorObject;
RaiseConnPassage: TConnectorObject;
ListForPassage: TF_CAD;
CurGCadFrom: TF_CAD;
LayHandle: Integer;
ObjParams: TObjectParams;
CreatePoints: TDoublePoint;
z: double;
vLists: TList;
SavedGCadForm: TF_CAD;
SavedGPopupFigure: TFigure;
RaiseType1, RaiseType2: TLineRaiseType;
ListOfListsInt: TIntList;
ListOfLists: TList;
SetLen: Double;
begin
// Tolik 07/02/2017 --
ListOfLists := Nil;
vLists := Nil;
ListOfListsInt := Nil;
//
try
RaiseOnFigure := nil; //#From Oleg# //14.09.2010
F_ChooseListForTrunk.lvCadLists.Items.Clear;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
FList := TF_CAD(FSCS_Main.MDIChildren[i]);
Item := F_ChooseListForTrunk.lvCadLists.Items.Add;
Item.Caption := FList.FCADListName + ' ' + IntToStr(FList.FCADListIndex);
Item.Data := FList;
if (FList.FListType <> lt_Normal) or (FList = GCadForm) then
Item.ImageIndex := 180
else
Item.ImageIndex := 0;
end;
if F_ChooseListForTrunk.ShowModal = mrOK then
begin
if F_ChooseListForTrunk.lvCadLists.Selected <> nil then
begin
ListForPassage := TF_CAD(F_ChooseListForTrunk.lvCadLists.Selected.Data);
if GPopupFigure = nil then
Exit;
// *UNDO*
vLists := TList.Create;
vLists.Add(GCadForm);
vLists.Add(ListForPassage);
SaveForProjectUndo(vLists, True, False);
if CheckFigureByClassName(GPopupFigure, cTOrthoLine) then
begin
if TOrthoLine(GPopupFigure).ActualZOrder[1] = TOrthoLine(GPopupFigure).ActualZOrder[2] then
begin
CreatePoints := GetCoordsWithSnapToGrid(GCurrMousePos.x, GCurrMousePos.y);
z := TOrthoLine(GPopupFigure).ActualZOrder[1];
end
else
begin
CreatePoints.x := (TOrthoLine(GPopupFigure).ActualPoints[1].x + TOrthoLine(GPopupFigure).ActualPoints[2].x) / 2;
CreatePoints.y := (TOrthoLine(GPopupFigure).ActualPoints[1].y + TOrthoLine(GPopupFigure).ActualPoints[2].y) / 2;
z := (TOrthoLine(GPopupFigure).ActualZOrder[1] + TOrthoLine(GPopupFigure).ActualZOrder[2]) / 2;
end;
RaiseOnFigure := TConnectorObject.Create(CreatePoints.x, CreatePoints.y, z, GPopupFigure.LayerHandle, mydsNormal, GCadForm.PCad);
RaiseOnFigure.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(GPopupFigure.LayerHandle), RaiseOnFigure, False);
RaiseOnFigure.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(RaiseOnFigure.ID, RaiseOnFigure.Name);
ObjParams := GetFigureParams(RaiseOnFigure.ID);
RaiseOnFigure.Name := ObjParams.Name;
RaiseOnFigure.FIndex := ObjParams.MarkID;
SnapConnectorToOrtholine(RaiseOnFigure, TOrthoLine(GPopupFigure));
end
else
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) then
begin
RaiseOnFigure := TConnectorObject(GPopupFigure);
end;
SetLen := 0;
// òåêóùèé íàõîäèòñÿ âûøå
if GetUpperList(GCadForm.FCADListID, ListForPassage.FCADListID) = GCadForm.FCADListID then
begin
RaiseType1 := lrt_Down;
RaiseType2 := lrt_Up;
ListOfListsInt := GetSortedListIDsByBounds(ListForPassage.FCADListID, GCadForm.FCADListID);
end
else
// òåêóùèé íàõîäèòñÿ íèæå
begin
RaiseType1 := lrt_Up;
RaiseType2 := lrt_Down;
ListOfListsInt := GetSortedListIDsByBounds(GCadForm.FCADListID, ListForPassage.FCADListID);
end;
// Âû÷èñëèòü äëèííó ìàãèñòðàëè
if ListOfListsInt <> nil then
begin
ListOfLists := IntCadsToCads(ListOfListsInt);
for i := 0 to ListOfLists.Count - 1 do
begin
if (TF_CAD(ListOfLists[i]) <> GCadForm) and (TF_CAD(ListOfLists[i]) <> ListForPassage) then
SetLen := SetLen + TF_CAD(ListOfLists[i]).FRoomHeight;
end;
end;
SetLen := StrToFloat_My(F_ChooseListForTrunk.edTrunkLength.Text);
SetLen := UOMToMetre(SetLen);
if RaiseOnFigure.ConnectorType = ct_Clear then
RaiseConn := CreateTrunkRaiseOnConnector(RaiseOnFigure, RaiseType1, SetLen)
else
RaiseConn := CreateTrunkRaiseOnPointObject(RaiseOnFigure, RaiseType1, SetLen);
CurGCadFrom := GCadForm;
GCadForm := ListForPassage;
GCadForm.BringToFront;
// Ñîçäàòü îáúåêò íà íàéäåíîì ýòàæå
LayHandle := GCadForm.PCad.GetLayerHandle(2);
ConnForPassage := TConnectorObject.Create(RaiseConn.ActualPoints[1].x, RaiseConn.ActualPoints[1].y, ListForPassage.FConnHeight,
LayHandle, mydsNormal, GCadForm.PCad);
ConnForPassage.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(LayHandle), ConnForPassage, False);
ConnForPassage.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnForPassage.ID, ConnForPassage.Name);
ObjParams := GetFigureParams(ConnForPassage.ID);
ConnForPassage.Name := ObjParams.Name;
ConnForPassage.FIndex := ObjParams.MarkID;
// ñîçäàòü ì-ý ïîäúåì îò òîãî îáúåêòà
RaiseConnPassage := CreateTrunkRaiseOnConnector(ConnForPassage, RaiseType2, 0);
GCadForm := CurGCadFrom;
GCadForm.BringToFront;
// Çàïîëíèòü ïîëÿ ñîåäèíåíèé òî÷åê ïåðåõîäà
RaiseConn.FID_ListToPassage := ListForPassage.FCADListID;
RaiseConn.FID_ConnToPassage := RaiseConnPassage.ID;
RaiseConnPassage.FID_ListToPassage := GCadForm.FCADListID;
RaiseConnPassage.FID_ConnToPassage := RaiseConn.ID;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
ListForPassage.FCanSaveForUndo := True;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateTrunkExecute', E.Message);
end;
// Tolik -- 07/02/2017 --
if ListOfLists <> nil then
FreeAndNil(ListOfLists);
if ListOfListsInt <> nil then
ListOfListsInt.Free;
if vLists <> nil then
FreeAndNil(vLists);
//
end;
(*
procedure TFSCS_Main.BitBtn1Click(Sender: TObject);
begin
try
GCadForm.PCad.SaveAsBitmap('123.bmp');
GCadForm.PCad.View3D;
except
end;
end;
*)
procedure TFSCS_Main.miShowConnectedConnComponsClick(Sender: TObject);
begin
ShowConnDisconnComponsForList(GCadForm.FCADListID, cdConnConCompons);
end;
procedure TFSCS_Main.miShowConnectedLineComponsClick(Sender: TObject);
begin
ShowConnDisconnComponsForList(GCadForm.FCADListID, cdConnlineCompons);
end;
procedure TFSCS_Main.mnuReservClick(Sender: TObject);
begin
F_Reserv.ShowModal;
end;
procedure TFSCS_Main.pmConnectedPointsPopup(Sender: TObject);
begin
miShowConnectedConnCompons.Caption := F_ProjMan.Act_ConnectedConCompons.Caption;
end;
procedure TFSCS_Main.pmiSCSObjAutoCreateTracesAdvancedDrawItem(Sender: TObject;
ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState);
var
OutText: String;
begin
OutText := (Sender as TMenuItem).Caption;
if (odFocused in State) or (odSelected in State) then
begin
end
else
begin
{if Sender = N33 then
begin
OutText := 'AUTOROUTE';
end;
if Sender = N46 then
begin
OutText := 'LAY OUT ON SELECTED ROUTES';
end;}
ACanvas.Font.Style := [fsBold];
ARect.Left := 32;
ARect.Right := ARect.Right - 32;
ACanvas.brush.color := clWhite; //Tolik 26/01/2021 --
ACanvas.FillRect(ARect);
DrawText(ACanvas.Handle,
PChar(OutText),
-1,
ARect,
DT_VCENTER or dt_LEFT or dt_singleline);
end;
end;
procedure TFSCS_Main.pmConnectedLinesPopup(Sender: TObject);
begin
miShowConnectedLineCompons.Caption := F_ProjMan.Act_ConnectedLineCompons.Caption;
end;
procedure SetDefaultActiveLayer;
begin
if (GCadForm <> nil) and (GCadForm.PCad <> nil) then
begin
{$IF Defined(ES_GRAPH_SC)}
if GCadForm.CurrentLayer <> lnArch then
GCadForm.CurrentLayer := lnArch;
{$ELSE}
if GCadForm.CurrentLayer <> lnSCSCommon then
GCadForm.CurrentLayer := lnSCSCommon;
{$IFEND}
try
if (Application.Active) and (GCadForm <> nil) and (GCadForm.PCad <> nil) then
if Not GCadForm.PCad.Focused then
begin
SendMessage(GCadForm.PCad.Handle, WM_ACTIVATE, MakewParam(WA_ACTIVE, 0), 0);
SendMessage(GCadForm.PCad.Handle, WM_SETFOCUS, 0, 0);
GCadForm.PCad.SetFocus;
end;
except
ShowMessage('EXCEPTION: TFSCS_Main.cbLayersPropertiesCloseUp (Set PCAD focus)');
end;
end;
end;
procedure TFSCS_Main.tb3DClick(Sender: TObject);
var
CtrlDown: boolean;
// 2011-05-10
xModelNode: TTreeNode;
OldMapScale: Integer;
begin
{$ifdef 3D}
if ActiveMDIChild <> nil then
begin
{$IF Not Defined(ES_GRAPH_SC)}
SaveSubstrateArchPlan(GetPathToSCSTmpDir + '\3d.jpg');
{$IFEND}
GCurrentRoom3DView := nil;
{$IF Defined(ES_GRAPH_SC)}
ctrlDown:=(IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL));
if ctrlDown then
if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then
begin
try
DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D);
except
end;
end;
{$IFEND}
// 22.07.2011
G3DModelForProject := False;
BeginProgress;
if not Assigned(frm3D) then
Application.CreateForm(Tfrm3D, frm3d);
if Assigned(frm3D.F3DModel) then
FreeAndNil(frm3D.F3DModel);
frm3D.F3DModel := T3DModel.Create;
frm3D.FIdsStream.Clear;
frm3D.FFilesStream.Clear;
frm3D.ModelTree.Items.Clear;
frm3D.ScsModelTree.Items.Clear;
xModelNode := frm3D.ModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName);
xModelNode.Data := frm3D.F3DModel;
xModelNode.HasChildren := True;
xModelNode := frm3D.ScsModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName);
xModelNode.Data := frm3D.F3DModel;
xModelNode.HasChildren := True;
frm3D.FZOrder := 0;
if GCadForm.FListType = lt_Normal then
GCadForm.View3D;
EndProgress;
frm3d.FCAD := GCadForm;
Application.ProcessMessages;
frm3d.ShowModal;
FreeAndNil(frm3D);
// Tolik 23/07/2018 --
GCadForm.PCad.Refresh;
//
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
SetDefaultActiveLayer;
{$endif 3D}
end;
procedure TFSCS_Main.aInsertKnotForHouseExecute(Sender: TObject);
var
House: THouse;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTHouse) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
House := THouse(GPopupFigure);
House.InsertKnot(House.SelectedPoint);
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aInsertKnotExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDeleteKnotForHouseExecute(Sender: TObject);
var
House: THouse;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTHouse) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
House := THouse(GPopupFigure);
House.DeleteKnot(House.SelectedPoint);
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteKnotExecute', E.Message);
end;
end;
procedure TFSCS_Main.aAddApproachExecute(Sender: TObject);
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), cTHouse) then
begin
GCadForm.FActiveHouse := THouse(GCadForm.PCad.Selection[0]);
GCadForm.PCad.SetTool(toFigure, 'TApproachTool');
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aAddApproachExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDeleteHouseExecute(Sender: TObject);
var
i: integer;
CurHouse: THouse;
CurPath: TNetPath;
mess: string;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), cTHouse) then
begin
CurHouse := THouse(GCadForm.PCad.Selection[0]);
mess := cMain_Mes115;
//if MessageBoxA(FSCS_Main.Handle, PAnsiChar(mess), cMain_Mes116, MB_YESNO) = IDYes then
if MessageBox(FSCS_Main.Handle, PChar(mess), PChar(cMain_Mes116), MB_YESNO) = IDYes then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
CurHouse.Delete;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteHouseExecute', E.Message);
end;
end;
procedure TFSCS_Main.aEditApproachExecute(Sender: TObject);
var
i: Integer;
vCaption: TRichText;
vBound: TRectangle;
approach: TConnectorObject;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Approach := TConnectorObject(GPopupFigure);
vCaption := nil;
vBound := nil; //#From Oleg# //14.09.2010
for i := 0 to Approach.DrawFigure.InFigures.Count - 1 do
begin
if CheckFigureByClassName(TFigure(Approach.DrawFigure.InFigures[i]), 'TRichText') then
vCaption := TRichText(Approach.DrawFigure.InFigures[i])
else
if CheckFigureByClassName(TFigure(Approach.DrawFigure.InFigures[i]), 'TRectangle') then
vBound := TRectangle(Approach.DrawFigure.InFigures[i]);
end;
if vCaption.edit then
begin
ReCreateApproachText(Approach.DrawFigure, vCaption, vBound);
end;
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aEditApproachExecute', E.Message);
end;
end;
procedure TFSCS_Main.aRotateApproachExecute(Sender: TObject);
var
Approach: TConnectorObject;
begin
try
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Approach := TConnectorObject(GPopupFigure);
GCadForm.PCad.SetTool(toSelect, 'TFigure');
Approach.DrawFigure.LockModify := False;
Approach.DrawFigure.fRMode := True;
Approach.DrawFigure.RotateSelect;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aRotateApproachExecute', E.Message);
end;
end;
procedure TFSCS_Main.aModApproachExecute(Sender: TObject);
var
Approach: TConnectorObject;
begin
try
if CheckFigureByClassName(GPopupFigure, cTConnectorObject) and (TConnectorObject(GPopupFigure).FIsApproach) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Approach := TConnectorObject(GPopupFigure);
Approach.DrawFigure.LockModify := False;
Approach.DrawFigure.fTraceMod := True;
Approach.DrawFigure.select;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aModApproachExecute', E.Message);
end;
end;
procedure TFSCS_Main.aToolCabinetExtExecute(Sender: TObject);
begin
try
if ActiveMDIChild <> nil then
begin
DropDownFirstToolbar; // Tolik 10/02/2021 --
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.CurrentLayer := 9;
GCadForm.PCad.SetTool(toFigure, 'TCabinetExt');
tbCabinetExtNoob.Down := True; // Tolik 10/02/2021 --
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aToolCabinetExtExecute', E.Message);
end;
end;
procedure TFSCS_Main.aConvertSegmentToArcExecute(Sender: TObject);
var
Cabinet: TCabinetExt;
Segment: TPlSegment;
Poly: TPolyline;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Cabinet := TCabinetExt(GPopupFigure);
Segment := TPlSegment(Cabinet.Segments[Cabinet.SelectedPoint - 1]);
Cabinet.ArrangeSelectedSegment(sArc);
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aConvertSegmentToArcExecute', E.Message);
end;
end;
procedure TFSCS_Main.aInsertKnotForCabinetExecute(Sender: TObject);
var
Cabinet: TCabinetExt;
CP: TDoublePoint;
MaxX, MaxY, MinX, MinY: Double;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Cabinet := TCabinetExt(GPopupFigure);
Cabinet.InsertKnot(Cabinet.SelectedPoint);
if Cabinet.FNumberObject <> nil then
begin
Cabinet.getbounds(MaxX, MaxY, MinX, MinY);
CP.x := (MinX + MaxX) / 2;
CP.y := (MinY + MaxY) / 2;
Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y);
end;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aInsertKnotForCabinetExecute', E.Message);
end;
end;
procedure TFSCS_Main.aDeleteKnotForCabinetExecute(Sender: TObject);
var
Cabinet: TCabinetExt;
CP: TDoublePoint;
MaxX, MaxY, MinX, MinY: Double;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Cabinet := TCabinetExt(GPopupFigure);
Cabinet.DeleteKnot(Cabinet.SelectedPoint);
if Cabinet.FNumberObject <> nil then
begin
Cabinet.getbounds(MaxX, MaxY, MinX, MinY);
CP.x := (MinX + MaxX) / 2;
CP.y := (MinY + MaxY) / 2;
Cabinet.FNumberObject.move(CP.x - Cabinet.FNumberObject.CenterPoint.x, CP.y - Cabinet.FNumberObject.CenterPoint.y);
end;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aDeleteKnotForCabinetExecute', E.Message);
end;
end;
procedure TFSCS_Main.aShowDefectObjectsExecute(Sender: TObject);
begin
try
if aShowDefectObjects.Checked = True then
begin
GCadForm.FShowDefectObjects := True;
// aShowConnFullnessExecute(Sender: TObject);
// aShowCableFullnessExecute(Sender: TObject);
// aShowCableChannelFullnessExecute(Sender: TObject);
end;
if aShowDefectObjects.Checked = False then
GCadForm.FShowDefectObjects := False;
RefreshCAD(GCadForm.PCad);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aShowDefectObjectsExecute', E.Message);
end;
end;
procedure TFSCS_Main.aInvertArcSegmentExecute(Sender: TObject);
var
Cabinet: TCabinetExt;
Segment: TPlSegment;
Poly: TPolyline;
begin
try
if GPopupFigure = nil then
exit;
if CheckFigureByClassName(GPopupFigure, cTCabinetExt) then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
Cabinet := TCabinetExt(GPopupFigure);
Segment := TPlSegment(Cabinet.Segments[Cabinet.SelectedPoint - 1]);
if Segment.SType = sArc then
Segment.Inverted := not Segment.Inverted;
RefreshCAD(GCadForm.PCad);
// *UNDO*
GCadForm.FCanSaveForUndo := true;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aConvertSegmentToArcExecute', E.Message);
end;
end;
procedure TFSCS_Main.aOpenVectorDrawingExecute(Sender: TObject);
var
FName: string;
FDir: string;
OpenPictureDialog: TSavePictureDialog;
begin
try
if ActiveMDIChild <> nil then
begin
GisUserDimLine := true;
LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124);
// Tolik 11/08/2021 - -
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenVectorDrawingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSaveVectorDrawingExecute(Sender: TObject);
var
FName: string;
FDir: string;
SavePictureDialog: TSavePictureDialog;
begin
try
if ActiveMDIChild <> nil then
begin
SaveDXFFile(GCadForm.PCad, cMain_Mes122, cMain_Mes124_2);
GCadForm.PCad.SetFocus;// Tolik 09/04/2020 -- òóò íàäî, à òî îñòàþòñÿ áåëûå çîíû íà êàäå ïîñëå îòîáðàæåíèÿ
// ýêñïîðòèðóåìîãî ëèñòà â ëåâîì âåðõíåì óãëó êàäà
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aSaveVectorDrawingExecute', E.Message);
end;
end;
procedure TFSCS_Main.aOpenRasterDrawingExecute(Sender: TObject);
var
FName: string;
FDir: string;
OpenPictureDialog: TOpenPictureDialog;
Jpeg: TJpegImage;
Bmp: TBMPObject;
BmpHandle: TFigHandle;// Tolik 09/08/2019 --
begin
Bmp := Nil; // Tolik 09/08/2019 - -
GLoadPCadBackGroundImage := True; // Tolik 29/01/2020 --
try
if ActiveMDIChild <> nil then
begin
OpenPictureDialog := TOpenPictureDialog.Create(Self);
OpenPictureDialog.Title := cMain_Mes121;
OpenPictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir;
//Tolik 10/08/2021 --
//OpenPictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg';
//OpenPictureDialog.Filter := cMain_Mes125;
OpenPictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg, *.png';
OpenPictureDialog.Filter := cMain_Mes125_;
//
if OpenPictureDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctPictures, ExtractFileDir(OpenPictureDialog.FileName));
//
FName := OpenPictureDialog.FileName;
aSetSubstrateLayer.Execute;
if pos('.bmp', OpenPictureDialog.FileName) <> 0 then
begin
// Tolik 09/08/2019 - -
//Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
BmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if BmpHandle <> -1 then
Bmp := TBMPObject(BmpHandle);
//
end
else
begin
// Tolik 09/08/2019 --
//Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
BmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if BmpHandle <> -1 then
Bmp := TBMPObject(BmpHandle);
//
// TODO ????
{
Jpeg := TJpegImage.create;
Jpeg.LoadFromFile(FName);
Bmp.Picture.Width := Jpeg.Width;
Bmp.Picture.Height := Jpeg.Height;
Bmp.Picture.Canvas.Draw(0, 0, Jpeg);
Bmp.Picture.PixelFormat := pf24bit;
FreeAndNil(Jpeg);
}
end;
if bmp <> nil then // Tolik 09/08/2019 --
AutoFitBitMap(Bmp);
except
end;
{
FSCS_Main.tbSelectExpert.Down := False;
FSCS_Main.tbSelectNoob.Down := False;
FSCS_Main.tbPanExpert.Down := True;
FSCS_Main.tbPanNoob.Down := True;
FSCS_Main.aToolPan.Execute;
}
RefreshCAD(GCadForm.PCad);
end;
OpenPictureDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenRasterDrawingExecute', E.Message);
end;
GLoadPCadBackGroundImage := False; // Tolik 29/01/2020 --
// Tolik 12/08/2021
GIsUserDimLine := (bmp <> nil);
SetHScale;
//
end;
procedure TFSCS_Main.aSaveRasterDrawingExecute(Sender: TObject);
var
FName: string;
FDir: string;
SavePictureDialog: TSavePictureDialog;
BmpFileName: string;
Bmp: TBitmap;
Jpeg: TJPEGImage;
PDFDoc: TPDFDocument;
begin
try
if ActiveMDIChild <> nil then
begin
SavePictureDialog := TSavePictureDialog.Create(Self);
SavePictureDialog.Title := cMain_Mes123;
SavePictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir;
SavePictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg';
SavePictureDialog.Filter := cMain_Mes125 + '|'+ cProgressExp_Msg9_1;
SavePictureDialog.Options := SavePictureDialog.Options + [ofOverwritePrompt];
if SavePictureDialog.Execute then
begin
try
// Tolik 01/08/2019 -- ñîõðàíèòü ïîñëåäíèé ïóòü
if GStoreLastPaths then
WriteEnvironmentDir(dctPictures, ExtractFileDir(SavePictureDialog.FileName));
//
FName := SavePictureDialog.FileName;
if ExtractFileExt(SavePictureDialog.FileName) = '.pdf' then //06.03.2012
begin
PDFDoc := CreatePDFObject(Self, GetListParams(GCadForm.FCADListID).Caption, SavePictureDialog.FileName, nil);
PDFDoc.BeginDoc;
SetCADPageParamsToPDF(GCadForm, PDFDoc, false);
PDFDoc.EndDoc;
PDFDoc.Free;
end
else if pos('.bmp', SavePictureDialog.FileName) <> 0 then
begin
GCadForm.PCad.SaveAsBitmap(FName);
end
else
begin
BmpFileName := ChangeFileExt(FName, '.bmp');
GCadForm.PCad.SaveAsBitmap(BmpFileName);
Bmp := TBitmap.Create;
Bmp.LoadFromFile(BmpFileName);
ConvertBMPToJpeg(Bmp, FName);
FreeAndNil(Bmp);
DeleteFile(BmpFileName);
end;
except
ShowMessage(cMain_Mes8);
end;
end;
SavePictureDialog.Free;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aSaveRasterDrawingExecute', E.Message);
end;
end;
procedure TFSCS_Main.SetLayerForDraw;
begin
if GCadForm <> nil then
begin
if (GCadForm.PCad.ActiveLayer <> lnSubstrate) and (GCadForm.PCad.ActiveLayer <> lnArch) then
aSetSubstrateLayer.Execute;
end;
end;
procedure TFSCS_Main.SetMenuStatus(aStatus: Boolean);
var
aStatusArch: boolean;
i: integer;
begin
{$if Defined(ES_GRAPH_SC)}
aStatusArch := false;
{$else}
aStatusArch := aStatus;
{$ifend}
try
//Tolik 13/08/2021 --
if aStatus then
tbCalc.Visible := aExpertMode.Checked
else
tbCalc.Visible := aStatus;
//
// ãëàâíîå ìåíþ
mainEdit.Visible := aStatus;
mainObject.Visible := aStatus;
mainFormat.Visible := aStatus;
mainOptions.Visible := aStatus;
mainTools.Visible := aStatus;
//mainSCS.Visible := aStatus;
mainWindow.Visible := aStatus;
// ïóíêòû îòêðûòûõ ìåíþ
// nOpen.Enabled := aStatus;
aLoadSubstrate.Enabled := aStatus;
aLoadFPlan.Enabled := aStatus;
aLoadStamp.Enabled := aStatus;
aOpenVectorDrawing.Enabled := aStatus;
aOpenRasterDrawing.Enabled := aStatus;
nSave.Enabled := aStatus;
aCloseCurrProject.Enabled := aStatus;
aClose.Enabled := aStatus;
aExport.Enabled := aStatus;
aExportDWG.Enabled := aStatus;
aImport.Enabled := aStatus;
aPrevView.Enabled := aStatus;
aPrint.Enabled := aStatus;
aPrintRect.Enabled := aStatus;
aAllScreen.Enabled := aStatus;
a50.Enabled := aStatus;
a75.Enabled := aStatus;
a100.Enabled := aStatus;
a150.Enabled := aStatus;
a200.Enabled := aStatus;
a400.Enabled := aStatus;
aInc.Enabled := aStatus;
aInc1pt.Enabled := aStatus;
aDec1pt.Enabled := aStatus;
aViewLayers.Enabled := aStatus;
aViewNavigator.Enabled := aStatus;
aViewSCSObjectsProp.Enabled := aStatus;
aExpertMode.Enabled := aStatus;
// Add
aCurrProjectProperties.Enabled := aStatus;
aListProperties.Enabled := aStatus;
aSaveRevision.Enabled := aStatus;
aViewRevs.Enabled := aStatus;
aProjectSchedule.Enabled := aStatus;
aBillWork.Enabled := aStatus;
aShowCableRule.Enabled := aStatus;
aCreateProjectPlan.Enabled := aStatus;
aCreateNormsOnCad.Enabled := aStatus;
aConnectionsConfigurator.Enabled := aStatus;
// 2011-05-10
n3DModelForList.Enabled := aStatus;
n3DModelForProject.Enabled := aStatus;
aMasterAutoTrace.Enabled := aStatus;
aMasterAutoTraceElectric.Enabled := aStatus;
aMasterCableTracing.Enabled := aStatus;
aMasterCableChannel.Enabled := aStatus;
aShowRepResources.Enabled := aStatus;
aBlocksEditor.Enabled := aStatus;
aRepWizard.Enabled := aStatus;
aMarkingPages.Enabled := aStatus;
//aManual_Interfaces.Enabled := aStatus;
//
// Ïàíåëè èíòðóìåíòîâ
cbMainPanel.DisableAlign; //20.12.2011
try
tbObject.Visible := aStatus;
tbLayers.Visible := aStatus;
tbOther.Visible := aStatus;
if aStatus then
begin
if aExpertMode.Checked then
begin
tbSCSToolsExpert.Visible := True;
tbCADToolsExpert.Visible := True;
tbSCSToolsNoob.Visible := False;
tbCADToolsNoob2.Visible := False;
tbCADToolsNoob.Visible := False;
end
else
begin
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsExpert.Visible := True;
{$else}
tbSCSToolsExpert.Visible := False;
{$ifend}
tbCADToolsExpert.Visible := False;
{$if Defined(ES_GRAPH_SC)}
tbSCSToolsNoob.Visible := False;
{$else}
//tbSCSToolsNoob.Visible := True;
{$ifend}
tbCADToolsNoob.Visible := True;
tbCADToolsNoob2.Visible := True;
end;
end
else
begin
tbSCSToolsExpert.Visible := aStatusArch;
tbCADToolsExpert.Visible := aStatusArch;
//tbSCSToolsNoob.Visible := aStatusArch;
// Tolik 24/01/2017
if aStatusArch then
begin
tbCADToolsNoob.Visible := aStatusArch;
tbCADToolsNoob2.Visible := aStatusArch;
end
else
if not aStatusArch then
begin
tbCADToolsNoob2.Visible := aStatusArch;
tbCADToolsNoob.Visible := aStatusArch;
end;
// tbCADToolsNoob.Visible := aStatusArch;
// tbCADToolsNoob2.Visible := aStatusArch;
//
end;
// Êíîïêè íà ïàíåëè èíñòðóìåíòîâ "Ôàéë"
tbNewList.Visible := aStatus;
tbLoadSubstrate.Visible := aStatus;
tbSaveProject.Visible := aStatus;
tbPrevView.Visible := aStatus;
tbPrint.Visible := aStatus;
tbPrintRect.Visible := aStatus;
ToolButton35.Visible := aStatus;
{$if Not Defined(ES_GRAPH_SC)}
tbArch.Visible := False;
{$ifend}
{$if Defined(ES_GRAPH_SC)}
// tbCreateOnClickModeExpert.Visible := False
tbArch.Visible := aStatus;
tbProjectPlan.Visible := False;
FSCS_Main.aBillWork.Visible := False;
FSCS_Main.aSaveRevision.Visible := False;
FSCS_Main.aViewRevs.Visible := False;
FSCS_Main.aProjectSchedule.Visible := False;
FSCS_Main.aShowCableRule.Visible := False;
FSCS_Main.N70.Visible := False;
FSCS_Main.aConnectionsConfigurator.Visible := False;
FSCS_Main.aMasterCableTracing.Visible := False;
FSCS_Main.aMasterCableChannel.Visible := False;
FSCS_Main.aToolCabinet.Visible := False;
//12.04.2012 FSCS_Main.aToolWallRect.Visible := False;
//12.04.2012 FSCS_Main.aToolWallPath.Visible := False;
FSCS_Main.aToolHouse.Visible := False;
FSCS_Main.aToolOrthoLine.Visible := False;
FSCS_Main.aToolOrthoLineExt.Visible := False;
//tbOther.Visible := False;
//tbCalc.Visible := False;
tbExtProtocol.Visible := False;
mainHelp.Enabled := False;
aViewSCSObjectsProp.Visible := False;
tbChm.Visible := False;
aToolCabinetExt.Visible := False;
aCreateProjectPlan.Visible := False;
aCreateNormsOnCad.Visible := False;
aConnectionsConfigurator.Visible := False;
// 2011-05-10
n3DModelForList.Enabled := True;
n3DModelForProject.Enabled := True;
aMasterAutoTraceElectric.Visible := False;
aMasterAutoTrace.Visible := False;
aMasterCableChannel.Visible := False;
aMasterCableTracing.Visible := False;
aShowRepResources.Visible := False;
aBlocksEditor.Visible := False;
aRepWizard.Visible := False;
aMarkingPages.Visible := False;
{$IF Defined (FINAL_SCS)}
nManuals.Visible := False;
{$IFEND}
aUpdateNormBase.Visible := False;
aMasterUpdateComponPriceFromXF.Visible := False;
aChoiceBaseOptions.Visible := False;
aToolCabinet.Visible := False;
aToolCabinetExt.Visible := False;
{$IF Defined (FINAL_SCS)}
aToolWallRect.Visible := False;
aToolWallPath.Visible := False;
{$IFEND}
aToolHouse.Visible := False;
tbCabinetExpert.Visible := False;
tbCabinetExtExpert.Visible := False;
tbCabinetNoob.Visible := False;
tbCabinetExtNoob.Visible := False;
aToolHouse.Visible := False;
tbHouseExpert.Visible := False;
tbHouseNoob.Visible := False;
aCreateObjectOnClickTool.Visible := False;
aCreateObjectOnClickTool.Visible := True;
tbCreateOnClickModeExpert.Visible := False;
tbCreateOnClickModeExpert.Visible := True;
tbCreateOnClickModeNoob.Visible := False;
tbCreateOnClickModeNoob.Visible := True;
{$ifend}
finally
cbMainPanel.EnableAlign;
tbFile.AutoSize := false;
tbFile.AutoSize := true;
end;
{$if Defined(ES_GRAPH_SC)}
// Tolik -- 01/02/2017 --
//tbFile.Width := 400;
tbFile.Width := 450;
//
tbObject.Left := tbFile.Left + tbFile.Width + 10;
tbLayers.Left := tbObject.Left + tbObject.Width + 10;
tbOther.Left := tbLayers.Left + tbLayers.Width + 10;
tbOther.Width := 30;
tbArch.Left := tbOther.Left + tbOther.Width + 10;
//Tolik -- 01/02/2017 --
tbArch.Width := 150;
//
tbCADToolsExpert.Width := 780;
//Tolik -- 01/02/2017 --
//tbCADToolsNoob.Width := 700;
tbCADToolsNoob.Width := 600;
//tbCADToolsNoob2.Width := 700;
tbCADToolsNoob2.Width := 300;
//
{$ifend}
tbInteractive.Visible := FInteractiveStep > 0;
if tbInteractive.Visible then
tbCADToolsExpert.Left := 91
else
tbCADToolsExpert.Left := 11;
DisableActForReadOnlyMode;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.SetMenuStatus', E.Message);
end;
end;
// Tolik -- 17/03/2017 -- ïåðåïèñàíà ñîâñåì, ñòàðàÿ çàêîììåí÷åíà - ñìîòðè íèæå
procedure TFSCS_Main.aCreateVerticalExecute(Sender: TObject);
var
VertOnFigure: TConnectorObject;
VertHeight: Double;
VLineToSnap: TOrthoLine;
ConnToSnap: TConnectorObject;
DirectionUp, DirectionDown: Boolean;
Nb_Conn: TConnectorObject;
procedure CreateConnToSnap;
var ObjParams: TObjectParams;
begin
ConnToSnap := TConnectorObject.Create(VertOnFigure.ActualPoints[1].x, VertOnFigure.ActualPoints[1].y,
VertHeight, VertOnFigure.LayerHandle, mydsNormal, GCadForm.PCad);
ConnToSnap.ConnectorType := ct_Clear;
GCadForm.PCad.AddCustomFigure (GLN(VertOnFigure.LayerHandle), ConnToSnap, False);
ConnToSnap.Name := cCadClasses_Mes12;
SetNewObjectNameInPM(ConnToSnap.ID, ConnToSnap.Name);
ObjParams := GetFigureParams(ConnToSnap.ID);
ConnToSnap.Name := ObjParams.Name;
ConnToSnap.FIndex := ObjParams.MarkID;
end;
procedure CheckCanSnapToVLine;
var i, j: integer;
CanCheckVLine: Boolean;
currConn: TConnectorObject;
VLineFound: boolean;
JoinedLine: TOrthoLine;
LineList: TList;
function getLineConnByDirection(aLine: tOrthoLine): TConnectorObject;
begin
Result := TConnectorObject(aLine.JoinConnector1);
if DirectionUP then
begin
if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1],
TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1 then
Result := TConnectorObject(aLine.JoinConnector2);
end
else
if DirectionDown then
begin
if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1],
TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = 1 then
Result := TConnectorObject(aLine.JoinConnector2);
end;
end;
function GetNextConn(aLine: TOrthoLine): TConnectorObject;
begin
Result := Nil;
if aLine.FIsVertical then
begin
if DirectionUP then
begin
if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector1)) = -1) and
(CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]) = -1) then
begin
Result := TConnectorObject(aLine.JoinConnector1);
LineList.Add(aLine);
VLineToSnap := aLine;
end
else
if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector2)) = -1) and
(CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1) then
begin
Result := TConnectorObject(aLine.JoinConnector2);
LineList.Add(aLine);
VLineToSnap := aLine;
end;
end
else
if DirectionDown then
begin
if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector1)) = -1) and
(CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector1).ActualZOrder[1]) = -1) then
begin
Result := TConnectorObject(aLine.JoinConnector1);
LineList.Add(aLine);
VLineToSnap := aLine;
end
else
if (VertOnFigure.JoinedConnectorsList.IndexOf(TConnectorObject(aLine.JoinConnector2)) = -1) and
(CompareValue(VertOnFigure.ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1) then
begin
Result := TConnectorObject(aLine.JoinConnector2);
LineList.Add(aLine);
VLineToSnap := aLine;
end;
end;
end;
end;
begin
currConn := nil;
LineList := TList.create;
if VertOnFigure.ConnectorType = ct_Clear then
begin
for i := 0 to VertOnFigure.JoinedOrthoLinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(VertOnFigure.JoinedOrthoLinesList[i]);
currConn := GetNextConn(JoinedLine);
if currConn <> nil then
Break; //// BREAK ////;
end;
end
else
if VertOnFigure.ConnectorType = ct_NB then
begin
for i := 0 to VertOnFigure.JoinedConnectorsList.Count - 1 do
begin
currConn := TConnectorObject(VertOnFigure.JoinedConnectorsList[i]);
for j := 0 to currConn.JoinedOrtholinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(currConn.JoinedOrtholinesList[j]);
if JoinedLine.FIsVertical then
begin
currConn := GetNextConn(JoinedLine);
if currConn <> nil then
break
else
currConn := TConnectorObject(VertOnFigure.JoinedConnectorsList[i]);
end;
end;
if (currConn <> nil) and (Vertonfigure.JoinedConnectorsList.IndexOf(currConn) = -1) then
break;
end;
end;
if (currConn <> nil) and (VLineToSnap <> nil) then
begin
CanCheckVLine := True;
While CanCheckVLine do
begin
CanCheckVLine := False;
if currConn.ConnectorType = ct_clear then
begin
for i := 0 to currConn.JoinedOrthoLinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(currConn.JoinedOrthoLinesList[i]);
if JoinedLine.FIsVertical then
begin
if LineList.IndexOf(JoinedLine) = -1 then
begin
LineList.Add(JoinedLine);
if TConnectorObject(JoinedLine.JoinConnector1).Id = currConn.Id then
currConn := TConnectorObject(JoinedLine.JoinConnector2)
else
if TConnectorObject(JoinedLine.JoinConnector2).Id <> currConn.Id then
currConn := TConnectorObject(JoinedLine.JoinConnector1);
if currConn <> nil then
begin
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedCOnnectorsList[0]);
CanCheckVLine := True;
end;
break;
end;
end;
end;
end
else
if currConn.ConnectorType = ct_NB then
begin
NB_Conn := currConn;
for i := 0 to NB_Conn.JoinedConnectorsList.Count - 1 do
begin
currConn := TConnectorObject(Nb_Conn.JoinedConnectorsList[i]);
for j := 0 to currConn.JoinedOrthoLinesList.Count - 1 do
begin
JoinedLine := TOrthoLine(currConn.JoinedOrthoLinesList[j]);
if JoinedLine.FIsVertical then
begin
if LineList.IndexOf(JoinedLine) = -1 then
begin
LineList.Add(JoinedLine);
if TConnectorObject(JoinedLine.JoinConnector1).Id = currConn.Id then
currConn := TConnectorObject(JoinedLine.JoinConnector2)
else
if TConnectorObject(JoinedLine.JoinConnector2).Id <> currConn.Id then
currConn := TConnectorObject(JoinedLine.JoinConnector1);
if currConn <> nil then
begin
if currConn.JoinedConnectorsList.Count > 0 then
currConn := TConnectorObject(currConn.JoinedCOnnectorsList[0]);
CanCheckVLine := True;
end;
break;
end;
end;
end;
if (currConn <> nil) and (NB_Conn.JoinedConnectorsList.IndexOf(currConn) = -1 ) then
break;
end;
end;
end;
if LineList.Count > 0 then
begin
for i := 0 to LineList.Count - 1 do
begin
VLineToSnap := TOrthoLine(LineList[i]);
connToSnap := getLineConnByDirection(VLineToSnap);
if DirectionUP then
begin
VLineToSnap := Nil;
if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = 1 then
begin
VLineToSnap := TOrthoLine(LineList[i]);
CreateConnToSnap;
break;
end;
end
else
if DirectionDown then
begin
VLineToSnap := Nil;
if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = -1 then
begin
VLineToSnap := TOrthoLine(LineList[i]);
CreateConnToSnap;
break;
end;
end;
if CompareValue(connTosnap.ActualZOrder[1], VertHeight) = 0 then
break;
end;
end;
LineList.free;
end;
end;
procedure CreateVLineOnConnector;
var vLine: TOrthoLine; // Tolik 27/03/2018 --
begin
if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = 1 then
DirectionUP := True
else
if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = -1 then
DirectionDown := True
else
if CompareValue(VertHeight, VertOnFigure.ActualZOrder[1]) = 0 then
Exit;
VLineToSnap := nil;
ConnToSnap := Nil;
CheckCanSnapToVLine;
if VLineToSnap <> nil then
SnapConnectorToVertical(ConnToSnap, VLineToSnap)
else
if ConntoSnap <> nil then
begin
if CompareValue(ConnToSnap.ActualZOrder[1], VertHeight) <> 0 then
//CreateVerticalOnConnector(ConnToSnap, VertHeight)
vLine := CreateVerticalOnConnector(ConnToSnap, VertHeight)
end
else
begin
if VertOnFigure.ConnectorType = ct_Clear then
//CreateVerticalOnConnector(VertOnFigure, VertHeight)
VLine := CreateVerticalOnConnector(VertOnFigure, VertHeight)
else
//CreateVerticalOnPointObject(VertOnFigure, VertHeight);
vLine := CreateVerticalOnPointObject(VertOnFigure, VertHeight);
end;
end;
begin
try
if GPopupFigure = nil then
exit;
try
VertOnFigure := TConnectorObject(GPopupFigure);
except
VertOnFigure := nil;
end;
if VertOnFigure = nil then
exit;
DirectionUp := False;
DirectionDown := False;
F_RaiseHeight.cbApplyToAll.Visible := False; //Tolik 04/08/2021 --
F_RaiseHeight.Caption := cMain_Mes126;
F_RaiseHeight.lbMessage.Caption := cMain_Mes126;
// íà ñîåäèíèòåëå
if F_RaiseHeight.Showmodal = mrOK then
begin
VertHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
VertHeight := UOMToMetre(VertHeight);
if VertHeight > GCadForm.FRoomHeight then
VertHeight := GCadForm.FRoomHeight;
if CompareValue(VertOnFigure.ActualZOrder[1], VertHeight) <> 0 then // òàê íàäåæíåå
//if VertHeight <> VertOnFigure.ActualZOrder[1] then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
CreateVLineOnConnector;
{
if VertOnFigure.ConnectorType = ct_Clear then
CreateVerticalOnConnector(VertOnFigure, VertHeight)
else
CreateVerticalOnPointObject(VertOnFigure, VertHeight);
}
// *UNDO*
GCadForm.FCanSaveForUndo := True;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes128);
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateVerticalExecute', E.Message);
end;
end;
(*
procedure TFSCS_Main.aCreateVerticalExecute(Sender: TObject);
var
VertOnFigure: TConnectorObject;
VertHeight: Double;
begin
try
if GPopupFigure = nil then
exit;
try
VertOnFigure := TConnectorObject(GPopupFigure);
except
VertOnFigure := nil;
end;
F_RaiseHeight.Caption := cMain_Mes126;
F_RaiseHeight.lbMessage.Caption := cMain_Mes126;
// íà ñîåäèíèòåëå
if F_RaiseHeight.Showmodal = mrOK then
begin
VertHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
VertHeight := UOMToMetre(VertHeight);
if VertHeight > GCadForm.FRoomHeight then
VertHeight := GCadForm.FRoomHeight;
if VertHeight <> VertOnFigure.ActualZOrder[1] then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
if VertOnFigure.ConnectorType = ct_Clear then
CreateVerticalOnConnector(VertOnFigure, VertHeight)
else
CreateVerticalOnPointObject(VertOnFigure, VertHeight);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
SetProjectChanged(True);
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes128);
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aCreateVerticalExecute', E.Message);
end;
end;
*)
procedure TFSCS_Main.TimerFindSnapTimer(Sender: TObject);
begin
try
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.TimerFindSnapTimer', E.Message);
end;
end;
procedure TFSCS_Main.AddDoorObj(aDoorObjType: TDoorObjType);
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := false;
end;
TNet(GCadForm.PCad.Selection[0]).AddDoor(aDoorObjType);
TNet(GCadForm.PCad.Selection[0]).RefreshPaths;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
GCadForm.FCanSaveForUndo := true;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.AddDoorObj', E.Message);
end;
end;
procedure TFSCS_Main.AddDoorEmbrasure;
begin
AddDoorObj(dotEmbrasure);
end;
procedure TFSCS_Main.AddDoorNiche;
begin
AddDoorObj(dotNiche);
end;
procedure TFSCS_Main.ToolButton1Click(Sender: TObject);
begin
if Assigned(GSCStream) then
begin
if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then
begin
try
ExpProjToStroyCalcStream(F_ProjMan.GSCSBase.CurrProject, GSCStream);
except
GSCStream.Clear;
end;
end;
end;
if SaveCurrentProject then
begin
CloseCurrProject(false, false);
FSCS_Main.OnClose := nil;
FSCS_Main.OnCloseQuery := nil;
ModalResult := mrOk;
FSCS_Main.Hide;
end;
end;
procedure TFSCS_Main.ToolButton4Click(Sender: TObject);
begin
ShowInvoice;
end;
procedure TFSCS_Main.aNetPathToArcExecute(Sender: TObject);
begin
NetPathToArc;
end;
procedure TFSCS_Main.aInvertNetPathArcExecute(Sender: TObject);
begin
NetArcInvert;
end;
{TODO}
(*
procedure TFSCS_Main.bDelModelClick(Sender: TObject);
begin
Remove3DModelStream;
end;
*)
// 2011-05-10
{procedure TFSCS_Main.Button1Click(Sender: TObject);
var
tmpdir: string;
FName: string;
begin
tmpdir := ExtractDirByCategoryType(dctPictures);
FName := tmpdir + '\' + 'ModelAddParams.temp';
frm3D.SaveModelAddParamsToStream(FName);
end;}
{procedure TFSCS_Main.Button2Click(Sender: TObject);
var
tmpdir: string;
FName: string;
begin
tmpdir := ExtractDirByCategoryType(dctPictures);
FName := tmpdir + '\' + 'ModelAddParams.temp';
frm3D.LoadModelAddParamsFromStream(FName);
end;}
procedure TFSCS_Main.n3DModelForProjectClick(Sender: TObject);
var
i, j: integer;
Cad: TF_CAD;
CtrlDown: boolean;
xModelNode: TTreeNode;
SavedGCadForm, TmpCad: TF_Cad;
ProjectParams: TProjectParams;
ListParams: TListParams;
HLists, LLists: TList;
PrevIndex, NextIndex: Integer;
SubstrateFileName: String;
currGLPlane: TGLPlane;
SubstrateFileList: TStringList;
{
procedure InsertIntoHList(Cad: TF_CAD);
var
i, j: integer;
Inserted: Boolean;
xCad: TF_CAD;
begin
Inserted := False;
for i := 0 to HLists.Count - 1 do
begin
xCad := TF_CAD(HLists[i]);
if Cad.FCADListIndex < xCad.FCADListIndex then
begin
HLists.Insert(i, Cad);
Inserted := True;
break;
end;
end;
if not Inserted then
HLists.Add(Cad);
end;
procedure InsertIntoLList(Cad: TF_CAD);
var
i, j: integer;
Inserted: Boolean;
xCad: TF_CAD;
begin
Inserted := False;
for i := 0 to LLists.Count - 1 do
begin
xCad := TF_CAD(LLists[i]);
if Cad.FCADListIndex > xCad.FCADListIndex then
begin
LLists.Insert(i, Cad);
Inserted := True;
break;
end;
end;
if not Inserted then
LLists.Add(Cad);
end;
}
// Tolik 02/05/2018 --
procedure GetSortModelLists;
var
i: integer;
CadLevelAchieved: Boolean;
currCatalog: TSCSCatalog;
currList: TSCSList;
SortIndex: Integer;
currCad: TF_CAD;
ReverseListSortOrder: Boolean;
procedure InsertIntoHList(Cad: TF_CAD);
var
i, j: integer;
Inserted: Boolean;
xCad: TF_CAD;
xCadCatalog: TSCSCatalog;
begin
Inserted := False;
for i := 0 to HLists.Count - 1 do
begin
xCad := TF_CAD(HLists[i]);
xCadCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(xCad.FCadListID);
if xCadCatalog <> nil then
begin
if ReverseListSortOrder then
begin
if xCadCatalog.SortID > currList.SortID then
begin
HLists.Insert(i, Cad);
Inserted := True;
break;
end;
end
else
begin
if xCadCatalog.SortID > currList.SortID then
begin
HLists.Insert(i, Cad);
Inserted := True;
break;
end;
end;
end;
end;
if not Inserted then
HLists.Add(Cad);
end;
procedure InsertIntoLList(Cad: TF_CAD);
var
i, j: integer;
Inserted: Boolean;
xCad: TF_CAD;
xCadCatalog: TSCSCatalog;
begin
Inserted := False;
for i := 0 to LLists.Count - 1 do
begin
xCad := TF_CAD(LLists[i]);
xCadCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(xCad.FCadListID);
if xCadCatalog <> nil then
begin
if ReverseListSortOrder then
begin
if xCadCatalog.SortID < currList.SortID then
begin
LLists.Insert(i, Cad);
Inserted := True;
break;
end;
end
else
begin
if xCadCatalog.SortID < currList.SortID then
begin
LLists.Insert(i, Cad);
Inserted := True;
break;
end;
end;
end;
end;
if not Inserted then
LLists.Add(Cad);
end;
begin
CadLevelAchieved := False;
HLists := TList.Create;
LLists := TList.Create;
HLists.Add(GCadForm); // òèïà ïåðâûé ýòàæ (òîò íà êîòîðîì ñòîèì â ÏÌ)
ReverseListSortOrder := F_ProjMan.GSCSBase.CurrProject.Setting.ListsInReverseOrder;
currCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(SavedGCadForm.FCADListID);
if currCatalog <> nil then
begin
for i := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 downto 0 do
begin
currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i];
if currList <> nil then
begin
CurrCad := GetListByID(currList.SCSID);
if currCad <> nil then
if CurrCad.FListType = lt_Normal then
begin
if ReverseListSortOrder then
begin
if CurrList.SortID > currCatalog.SortID then
InsertIntoHList(CurrCad)
else
if CurrList.SortID < currCatalog.SortID then
InsertIntoLList(CurrCad);
end
else
begin
if CurrList.SortID > currCatalog.SortID then
InsertIntoHList(CurrCad)
else
if CurrList.SortID < currCatalog.SortID then
InsertIntoLList(CurrCad);
end;
end;
end;
end;
end
end;
{
procedure GetSortModelLists;
var
i: integer;
begin
HLists := TList.Create;
LLists := TList.Create;
for i := 0 to FSCS_Main.MDIChildCount - 1 do
begin
Cad := TF_CAD(FSCS_Main.MDIChildren[i]);
if Cad.FListType = lt_Normal then
begin
if Cad.FCADListIndex > 0 then
InsertIntoHList(Cad);
if Cad.FCADListIndex <= 0 then
InsertIntoLList(Cad);
end;
end;
end;
}
// Tolik 04/05/2018 --
Function CadListCount: Integer; // ïîñ÷èòàòü êîëè÷åñòâî ëèñòîâ äëÿ 3Ä ìîäåëè
var i: Integer;
currList: TSCSList;
CurrCad: TF_Cad;
begin
Result := 0;
for i := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 downto 0 do
begin
currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i];
if currList <> nil then
begin
CurrCad := GetListByID(currList.SCSID);
if currCad <> nil then
if CurrCad.FListType = lt_Normal then
Inc(Result);
end;
end;
end;
begin
// Tolik 04/05/2018 -- åñëè ëèñòîâ ïðîåêòà áîëüøå îäíîãî -- âûäàòü ñîîáùåíèå, ÷òî òåêóùèé ëèñò áóäåò ðàñïîëîæåí íà íóëåâîì óðîâíå
// -- è, åñëè ïîëüçîâàòåëü íàæìåò îòìåíó -- íàõ îòñþäà, ìîäåëü íå ñòðîèì
if CadListCount > 1 then
if MessageBox(FSCS_Main.Handle, {PAnsiChar}PChar(cMain_Mes144), PChar(cCommon_Mes29), MB_OKCANCEL) <> IDOK then
exit;
//
// Tolik -- 09/02/2017 --
HLists := nil;
LLists := Nil;
SubstrateFileList := TStringList.Create; // ñïèñîê ïîäëîæåê (÷òîáû ïîòîì óäàëèòü ñîçäàííûå jpeg, äàáû íå çàñîðÿòü äèñê)
//
{$ifdef 3D}
ctrlDown:=(IsKeyDown(VK_LCONTROL) or IsKeyDown(VK_RCONTROL));
if ActiveMDIChild <> nil then
begin
{$IF Not Defined(ES_GRAPH_SC)}
SaveSubstrateArchPlan(GetPathToSCSTmpDir + '\3d.jpg');
{$IFEND}
GCurrentRoom3DView := nil;
if not isMapScaleDifferent then
begin
G3DModelForProject := True;
BeginProgress;
if not Assigned(frm3D) then
Application.CreateForm(Tfrm3D, frm3d);
// 22.07.2011
if Assigned(frm3D.F3DModel) then
FreeAndNil(frm3D.F3DModel);
frm3D.F3DModel := T3DModel.Create;
// Tolik 26/04/2018 --
frm3D.isProjectModel := True;
//
frm3D.FIdsStream.Clear;
frm3D.FFilesStream.Clear;
frm3D.ModelTree.Items.Clear;
frm3D.ScsModelTree.Items.Clear;
xModelNode := frm3D.ModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName);
xModelNode.Data := frm3D.F3DModel;
xModelNode.HasChildren := True;
xModelNode := frm3D.ScsModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName);
xModelNode.Data := frm3D.F3DModel;
xModelNode.HasChildren := True;
SavedGCadForm := GCadForm;
F3DSavedCad := GCadForm;// Tolik 05/05/2018 --
F3DPlaneNotLoaded := False; // Tolik 04/05/2018 --
GetSortModelLists;
// Tolik 26/04/2018 --
ListOfCadsFor3DModel := TList.Create;
if HLists.Count > 0 then
begin
HListOfCadsFor3DModel := TList.Create;
HListOfCadsFor3DModel.Assign(HLists, laCopy);
ListOfCadsFor3DModel.Assign(HLists, laCopy);
end;
if LLists.Count > 0 then
begin
LListOfCadsFor3DModel := TList.Create;
LListOfCadsFor3DModel.Assign(LLists, laCopy);
for i := 0 to LListOfCadsFor3DModel.Count - 1 do
begin
Cad := TF_CAD(LListOfCadsFor3DModel[i]);
ListOfCadsFor3DModel.Insert(0, Cad);
end;
end;
//
// Ýòàæè âûøå óðîâíÿ çåìëè
frm3D.FZOrder := 0;
for i := 0 to HLists.Count - 1 do
begin
SubstrateFileName := '';
GCadForm := TF_CAD(HLists[i]);
if i < HLists.Count - 1 then
NextIndex := TF_CAD(HLists[i+1]).FCADListIndex
else
NextIndex := -32001;
{$IF Defined(ES_GRAPH_SC)}
if ctrlDown then
if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then
begin
try
DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D);
except
end;
end;
{$IFEND}
// Tolik 04/05/2018 --
if GCadForm.FCadListID <> SavedGCadForm.FCadListID then
begin
begin
SubstrateFileName := GetPathToSCSTmpDir + '\GLPlane' + inttostr(GCadForm.FCadListID + 100) + 'd.jpg';
if FileExists(SubstrateFileName) then
DeleteFile(SubstrateFileName);
SaveSubstrateArchPlan(SubstrateFileName);
end;
if FileExists(SubstrateFileName) then
begin
NotBase3DPlane := TGLPlane.Create(frm3D);
//NotBase3DPlane.Parent := frm3D.DummyCube1;
NotBase3DPlane.Direction.x := 0;
NotBase3DPlane.Direction.y := 1;
NotBase3DPlane.Direction.z := 0;
NotBase3DPlane.Style := [];
//NotBase3DPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName);
NotBase3DPlane.Name := 'GLPlane' + inttostr(GCadForm.FCadListID + 100);
end;
end;
//
if SubstrateFileName <> '' then
SubstrateFileList.Add(SubstrateFileName);
GCadForm.View3D;
NotBase3DPlane := nil;
if GCadForm.FCADListIndex <> NextIndex then
begin
if NextIndex <> -32001 then // Tolik 20/09/2021 - -
begin
ListParams := GetListParams(GCadForm.FCADListID);
frm3D.FZOrder := frm3D.FZOrder + MetreToUOM(ListParams.Settings.HeightRoom + 0.01);
end;
end
else
begin
//frm3D.FZOrder := frm3D.FZOrder + 0.5;
end;
end;
// Ýòàæè íèæå óðîâíÿ çåìëè
frm3D.FZOrder := 0;
PrevIndex := -32001;
for i := 0 to LLists.Count - 1 do
begin
GCadForm := TF_CAD(LLists[i]);
if GCadForm.FCADListIndex <> PrevIndex then
begin
ListParams := GetListParams(GCadForm.FCADListID);
//Tolik 29/09/2021 --
//frm3D.FZOrder := frm3D.FZOrder - ListParams.Settings.HeightRoom - 0.01;
frm3D.FZOrder := frm3D.FZOrder - MetreToUOM(ListParams.Settings.HeightRoom - 0.01);
//
end
else
begin
//frm3D.FZOrder := frm3D.FZOrder - 0.5;
end;
// 22.07.2011
PrevIndex := GCadForm.FCADListIndex;
{$IF Defined(ES_GRAPH_SC)}
if ctrlDown then
if FileExists(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D) then
begin
try
DeleteFile(F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(GCadForm.FCADListID).File3D);
except
end;
end;
{$IFEND}
// Tolik 04/05/2018 --
if GCadForm.FCadListID <> SavedGCadForm.FCadListID then
begin
begin
SubstrateFileName := GetPathToSCSTmpDir + '\GLPlane' + inttostr(GCadForm.FCadListID + 100) + 'd.jpg';
if FileExists(SubstrateFileName) then
DeleteFile(SubstrateFileName);
SaveSubstrateArchPlan(SubstrateFileName);
end;
if FileExists(SubstrateFileName) then
begin
NotBase3DPlane := TGLPlane.Create(frm3D);
//NotBase3DPlane.Parent := frm3D.glDummyCube1;
NotBase3DPlane.Direction.x := 0;
NotBase3DPlane.Direction.y := 1;
NotBase3DPlane.Direction.z := 0;
NotBase3DPlane.Style := [];
//NotBase3DPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName);
NotBase3DPlane.Name := 'GLPlane' + inttostr(GCadForm.FCadListID + 100);
end;
end;
//
GCadForm.View3D;
if SubstrateFileName <> '' then
SubstrateFileList.Add(SubstrateFileName);
NotBase3DPlane := nil;
end;
// Tolik 03/05/2018 --
{ if ListOfCadsFor3DModel.Count > 0 then
begin
F3DFloors := TList.Create;
for i := 0 to ListOfCadsFor3DModel.Count - 1 do
begin
GCadForm := TF_CAD(ListOfCadsFor3DModel[i]);
if GCadForm.FCadListID <> SavedGCadForm.FCadListID then
begin
SubstrateFileName := GetPathToSCSTmpDir + '\' + inttostr(GCadForm.FCadListID) + 'd.jpg';
if FileExists(SubstrateFileName) then
DeleteFile(SubstrateFileName);
SaveSubstrateArchPlan(SubstrateFileName);
end;
if FileExists(SubstrateFileName) then
begin
currGLPlane := TGLPlane.Create(frm3D);
currGLPlane.Parent := frm3D.DummyCube;
currGLPlane.Material.Texture.Image.LoadFromFile(SubstrateFileName);
currGLPlane.Name := 'GLPlane' + inttostr(i+2);
F3DFloors.Add(currGLPlane);
end;
end;
end;
}
//
GCadForm := SavedGCadForm;
EndProgress;
frm3d.FCAD := GCadForm;
frm3d.ShowModal;
FreeAndNil(frm3D);
end
else
begin
// Tolik 10/05/2018 -*-
ShowMessage(cForm3D_Mes13); // òàê ïðîùå è áûñòðåå
(*
{$IF Defined(SCS_PE)}
ShowMessage('Scales of pages (floors) are different. ' + #13#10 +
'To view the entire project 3D model scales of pages should be equal.' + #13#10 +
'But anyway you can open a single page in 3D mode.');
{$ELSEIF Defined(SCS_UKR)} //Tolik 10/05/2018 -- äëÿ óêðàèíñêîé âåðñèè òîæå íàäî!!!
ShowMessage('Ìàøòàáè íà àðêóøàõ â³äð³çíÿþòüñÿ! Ïîòð³áíî âñòàíîâèòè îäíàêîâèé ìàøòàá.' + #13#10 +
'Àëå, â ëþáîìó âèïàäêó, âè ìîæåòå â³äêðèòè 3Ä ìîäåëü îäíîãî àðêóøà (ïîâåðõó).');
{$ELSE}
ShowMessage('Ìàñøòàáû íà ëèñòàõ ðàçëè÷àþòñÿ! Íóæíî óñòàíîâèòü îäèíàêîâûé ìàñøòàá.' + #13#10 +
'Íî, â ëþáîì ñëó÷àå, âû ìîæåòå îòêðûòü 3Ä ìîäåëü îäíîãî ëèñòà (ýòàæà).');
{$IFEND}
*)
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
SetDefaultActiveLayer;
{$endif 3D}
// Tolik -- 09/02/2017 --
if HLists <> nil then
FreeAndNil(HLists);
if LLists <> Nil then
FreeAndNil(LLists);
if LListOfCadsFor3DModel <> nil then
FreeAndNil(LListOfCadsFor3DModel); // Tolik 24/06/2018 --
if HListOfCadsFor3DModel <> nil then
FreeAndNil(HListOfCadsFor3DModel); // Tolik 24/06/2018 --
if ListOfCadsFor3DModel <> nil then
FreeAndNil(ListOfCadsFor3DModel); // Tolik 24/06/2018 --
F3DPlaneNotLoaded := True; // Tolik 04/05/2018 --
F3DSavedCad := Nil; // 04/05/2018 --
if NotBase3DPlane <> nil then // Tolik -- 10/05/2018 -- íà âñÿêèé...
NotBase3DPlane := Nil;
// Tolik -- 10/05/2018 -- ïî÷èñòèòü ìóñîð (óäàëèòü ñîçäàííûå êàðòèíêè ïîäëîæåê â òåìïàõ)//
for i := 0 to SubstrateFileList.Count - 1 do
begin
SubstrateFileName := SubstrateFileList.Strings[i];
if FileExists(SubstrateFileName) then
begin
try
DeleteFile(SubstrateFileName);
except
end;
end;
end;
SubstrateFileList.Free;
//
end;
// Ïðè ïðîâåðêå íà ñîîòâåòñòâèå ìàñøòàáîâ èíîãäà âîçíèêàþò êàçóñû â ïëàíå ñîîòâåòñòâèÿ "íà ãëàç" è
// íåñîîòâåòñòâèÿ ìàñøòàáîâ èç-çà îêðóãëåíèÿ âåëè÷èí... ÷òî âûçûâàåò íåîäíîêðàòíûå ñåòîâàíèÿ ïîëüçîâàòåëåé
// ÏÎýòîìó ââåäåí íåáîëüøîé ëþôò... Ñòàðàÿ çàêîììåí÷åíà -- ñì íèæå
function TFSCS_Main.isMapScaleDifferent: Boolean;
var
i: integer;
mapscale, currMapScale, MapDelta: double;
begin
try
mapscale := -100;
Result := False;
for i := 0 to MDIChildCount - 1 do
begin
if TF_CAD(MDIChildren[i]).FListType = lt_Normal then
begin
if mapscale = -100 then
mapscale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale)
else
begin
currMapScale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale);
MapDelta := Abs(currMapScale - mapscale);
if CompareValue(MapDelta, 0.05) = 1 then // ñîáñòâåííî, âîò çäåñü è ïðîâåðêà è ëþôòèê...
begin
Result := True;
break;
end;
//if not EQD(Round2(TF_CAD(MDIChildren[i]).PCad.MapScale), mapscale) then
//Result := True;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.isMapScaleDifferent', E.Message);
end;
end;
{
function TFSCS_Main.isMapScaleDifferent: Boolean;
var
i: integer;
mapscale: double;
begin
try
mapscale := -100;
Result := False;
for i := 0 to MDIChildCount - 1 do
begin
if TF_CAD(MDIChildren[i]).FListType = lt_Normal then
begin
if mapscale = -100 then
mapscale := Round2(TF_CAD(MDIChildren[i]).PCad.MapScale)
else
begin
if not EQD(Round2(TF_CAD(MDIChildren[i]).PCad.MapScale), mapscale) then
Result := True;
end;
end;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.isMapScaleDifferent', E.Message);
end;
end;
}
procedure TFSCS_Main.aAutoCreateTracesExecute(Sender: TObject);
begin
AutoCreateTracesMaster(GPopupFigure); //29.06.2013 AutoCreateTraces;
GCadForm.PCad.Refresh; // Tolik 28/10/2019 --
end;
procedure TFSCS_Main.aDivTracesOnRoowWallsExecute(Sender: TObject);
begin
DivideTracesOnRoowWalls(GCadForm);
end;
procedure TFSCS_Main.aPathLengthTypePointsExecute(Sender: TObject);
begin
SetShowPathLengthType(sltPoints);
end;
procedure TFSCS_Main.aPathLengthTypeInnerExecute(Sender: TObject);
begin
SetShowPathLengthType(sltInner);
end;
procedure TFSCS_Main.aPathLengthTypeOuterExecute(Sender: TObject);
begin
SetShowPathLengthType(sltOuter);
end;
procedure TFSCS_Main.aPathTraceLengthTypePointsExecute(Sender: TObject);
begin
SetShowPathTraceLengthType(sltPoints);
end;
procedure TFSCS_Main.aPathTraceLengthTypeInnerExecute(Sender: TObject);
begin
SetShowPathTraceLengthType(sltInner);
end;
procedure TFSCS_Main.aPathTraceLengthTypeOuterExecute(Sender: TObject);
begin
SetShowPathTraceLengthType(sltOuter);
end;
procedure TFSCS_Main.aMirrorFigureExecute(Sender: TObject);
var
fig: TFigure;
i: Integer;
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
MirrorFigure(TFigure(GCadForm.PCad.Selection[i]));
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'aMirrorFigureExecute', E.Message);
end;
end;
procedure TFSCS_Main.aTransparentFigureExecute(Sender: TObject);
var
i: Integer;
Figure: TFigure;
begin
try
if GCadForm.PCad.Selection.Count > 0 then
begin
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, False, False);
GCadForm.FCanSaveForUndo := False;
end;
for i := 0 to GCadForm.PCad.Selection.Count - 1 do
begin
Figure := TFigure(GCadForm.PCad.Selection[i]);
if Figure is TBMPObject then
TBMPObject(Figure).Transparent := aTransparentFigure.Checked;
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
// *UNDO*
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'aTransparentFigureExecute', E.Message);
end;
end;
procedure TFSCS_Main.aNetPropsExecute(Sender: TObject);
begin
NetProps;
end;
procedure TFSCS_Main.DefinePMItemsRoofHipTypes;
var
InsIdx: Integer;
MenuItem: TMenuItem;
Types: TStringList;
i: Integer;
begin
if FPMItemsRoofHipTypes = nil then
begin
FPMItemsRoofHipTypes := TList.Create;
Types := TStringList.Create;
FillPropValuesByDataType(Types, dtRoofHipType);
Types.Add('-');
InsIdx := pmArchDesign.Items.IndexOf(pmiArchDesignSplit2);
if InsIdx = -1 then
InsIdx := pmArchDesign.Items.Count - 1
else
InsIdx := InsIdx + 1;
for i := 0 to Types.Count - 1 do
begin
//if Types[i] <> '' then
begin
MenuItem := TMenuItem.Create(pmArchDesign);
MenuItem.Caption := Types[i];
MenuItem.OnClick := OnPMItemsRoofHipTypeClick;
MenuItem.Tag := GetIDFromStrings(Types, i);
if (MenuItem.Tag = rhtNone) and (MenuItem.Caption = '') then
MenuItem.Caption := cArchCommon_Msg06;
//if MenuItem.Tag <> 0 then
//begin
// MenuItem.AutoCheck := true;
// MenuItem.GroupIndex := 2;
// MenuItem.RadioItem := true;
//end;
pmArchDesign.Items.Insert(InsIdx, MenuItem);
FPMItemsRoofHipTypes.Add(MenuItem);
InsIdx := InsIdx + 1;
end;
end;
Types.Free;
end;
end;
procedure TFSCS_Main.C1Click(Sender: TObject);
var i: integer;
LineList, PointList, ShieldList, AutoSwitchList, JoinedSwitchCompons, CableList: TSCSComponents;
ShieldCompon, AVR_Compon, SwitchCompon: TSCSComponent;
ShieldLines, Switch_List: TList;
PassedComponList, EndCompons: TSCSComponents;
CableComponent: TSCSComponent;
Procedure GetSwitchList(var aList: TSCSComponents; aLookList: TSCSComponents);
var i: Integer;
ChildCompon: TSCSComponent;
begin
for i := 0 to aLookList.Count - 1 do
begin
ChildCompon := aLookList[i];
if ChildCompon.ComponentType.SysName = ctsnAutoSwitch then
if aList.IndexOf(childCompon) = -1 then
aList.Add(ChildCompon);
end;
end;
Procedure CollectConnections(aCompon: TSCSComponent; var aList: TSCSComponents; aCypher: string);
var i, j, k: integer;
ParentCompon, ChildCompon, JoinedCompon: TSCSComponent;
begin
if aList.IndexOf(aCompon) = -1 then
aList.Add(aCompon);
if PassedComponList.IndexOf(aCompon) = -1 then
begin
PassedComponList.Add(aCompon);
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if aCompon.JoinedComponents[i].IsLine = biTrue then // Ïîäêëþ÷åí êàáåëü
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].Cypher = aCypher then
begin
if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then
CollectConnections(aCompon.JoinedComponents[i], aList, aCypher);
end;
end
else
begin // Point Connection
if PassedComponList.IndexOf(aCompon.JoinedComponents[i]) = -1 then
begin
PassedComponList.Add(aCompon.JoinedComponents[i]);
if aList.IndexOf(aCompon.JoinedComponents[i]) = -1 then // òóò äîïîëíèòåëüíó ïðîâåðêó âîòêíóòü, íà÷èíàÿ ñ ïàðåíòà äîíèçó íà âõîæäåíèå
begin
ParentCompon := aCompon.JoinedComponents[i].GetTopComponent;
if ParentCompon <> nil then
begin
if aList.IndexOf(ParentCompon) = -1 then
aList.Add(ParentCompon);
if ParentCompon.ComponentType.SysName <> ctsnTerminalBox then
if EndCompons.IndexOf(ParentCompon) = -1 then
EndCompons.Add(ParentCompon);
for j := 0 to ParentCompon.JoinedComponents.Count - 1 do
begin
JoinedCompon := ParentCompon.JoinedComponents[j];
if PassedComponList.IndexOf(JoinedCompon) = -1 then
if JoinedCompon.IsLine = biTrue then
if isCableComponent(JoinedCompon) then
if JoinedCompon.Cypher = aCypher then
CollectConnections(JoinedCompon, aList, aCypher);
end;
for j := 0 to ParentCompon.ChildReferences.Count - 1 do
begin
ChildCompon := ParentCompon.ChildReferences[j];
if PassedComponList.IndexOf(ChildCompon) = -1 then
PassedComponList.Add(ChildCompon);
for k := 0 to ChildCompon.JoinedComponents.Count - 1 do
begin
JoinedCompon := ChildCompon.JoinedComponents[k];
if PassedComponList.IndexOf(JoinedCompon) = -1 then
if JoinedCompon.IsLine = biTrue then
if isCableComponent(JoinedCompon) then
if JoinedCompon.Cypher = aCypher then
CollectConnections(JoinedCompon, aList, aCypher);
end;
end;
end;
end;
end;
end;
end;
end;
end;
function GetConnectedToSwitch(aCompon: TSCSComponent): TSCSComponents;
var i: integer;
JoinedCompon: TSCSComponent;
HasNoCableConnection: Boolean;
HasPointConnections: Boolean;
begin
Result := nil;
HasNoCableConnection := true;
HasPointConnections := False;
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].IDNetType = 3 then
HasNoCableConnection := false;
end;
if HasNoCableConnection then
exit;
Result := TSCSComponents.Create(false);
if PassedComponList.IndexOf(aCompon) = -1 then
PassedComponList.Add(aCompon);
for i := 0 to aCompon.JoinedComponents.Count - 1 do
begin
if IsCableComponent(aCompon.JoinedComponents[i]) then
if aCompon.JoinedComponents[i].IDNetType = 3 then
begin
CollectConnections(aCompon.JoinedComponents[i], Result, aCompon.JoinedComponents[i].Cypher);
if CableComponent = nil then
CableComponent := aCompon.JoinedComponents[i];
end;
end;
end;
begin
LineList := nil;
PointList := nil;
AVR_Compon := nil;
ShieldList := nil;
AutoSwitchList := Nil;
ShieldLines := Nil;
Switch_List := Nil;
CableList := TSCSComponents.Create(False);
if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then
begin
if F_ProjMan.GSCSBase.CurrProject.CurrList.OpenedInCAD then
begin
PointList := TSCSComponents.Create(false); // òî÷êè
LineList := TSCSComponents.Create(false); // êàáåëü
for I := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences.Count - 1 do
begin
if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IDNetType = 3 then
begin
if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IsLine = biTrue then
begin
if LineList.IndexOf(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]) = -1 then
LineList.Add(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]);
end
else
if F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i].IsLine = biFalse then
begin
if PointList.IndexOf(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]) = -1 then
PointList.Add(F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]);
end;
end;
end;
end;
end;
if ((PointList.Count = 0) or (LineList.Count = 0)) then
ShowMessage('There is no Objects to display!!!')
else
begin
//ïîñòðîèòü ñïèñîê ùèòîâ
ShieldList := TSCSComponents.Create(false);
for i := 0 to PointList.Count - 1 do
begin
if PointList[i].ComponentType.SysName = ctsnShield then
if ShieldList.IndexOf(PointList[i]) = -1 then
ShieldList.Add(PointList[i]);
end;
end;
if ShieldList.Count > 0 then
begin
ShieldCompon := ShieldList[0];
// ïîñòðîèòü ñïèñîê àâòîìàòîâ ùèòêà
if ShieldCompon.ChildReferences.Count > 0 then
begin
AutoSwitchList := TSCSComponents.Create(false);
GetSwitchList(AutoSwitchList, ShieldCompon.ChildReferences);
end;
end
else; // íå îáíàðóæåíî íè îäíîãî ùèòêà ....
ShieldLines := TList.Create;
if AutoSwitchList.Count > 0 then
begin
// ïîñòðîèòü ñïèñêè ïîäêëþ÷åíèé íà êàæäûé àâòîìàò
PassedComponList := TSCSComponents.Create(false);
PassedComponList.Add(ShieldCompon);
for i := AutoSwitchList.Count - 1 downto 0 do
begin
SwitchCompon := AutoSwitchList[i];
PassedComponList.Add(SwitchCompon);
EndCompons := TSCSComponents.Create(false);
CableComponent := nil;
JoinedSwitchCompons := GetConnectedToSwitch(SwitchCompon);
//PassedComponList.Clear;
if EndCompons.Count > 0 then
begin
if CableComponent <> nil then
begin
ShieldLines.Insert(0, EndCompons);
CableList.Add(CableComponent);
end;
end
else
begin
AutoSwitchList.delete(i);
EndCompons.Free;
end;
end;
if Switch_List = nil then
Switch_List := TList.Create;
if AutoSwitchList.Count > 0 then
Switch_List.Add(AutoSwitchList);
end
else
begin // íå îáíàðóæåíî àâòîìàòîâ â ùèòêå!!! -- ìîæå ñîîáùåíèå êàêîå âûäàòü òóò.....
end;
if ShieldLines.Count > 0 then //
BuildElectricianChemeList(AVR_Compon, ShieldList, Switch_List, ShieldLines, CableList, nil);
if PassedComponList <> nil then
PassedComponList.free;
if LineList <> nil then
LineList.Free;
if PointList <> nil then
PointList.Free;
if ShieldList <> nil then
ShieldList.Free;
if AutoSwitchList <> nil then
AutoSwitchList.free;
freeList(ShieldLines);
CableList.Free;
end;
function TFSCS_Main.CanResizePanelForm(AForm: TForm; ADeltaSize: Integer): Boolean;
begin
Result := true;
if Assigned(AForm) then
if AForm.Constraints.MinWidth > (AForm.Width + ADeltaSize) then
Result := false;
end;
procedure TFSCS_Main.OnSplitterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{if Sender = sDiv1 then
begin
if Assigned(F_ProjMan) then
F_ProjMan.Panel_Tree.DisableAlign;
end
else
if Sender = sDiv2 then
begin
if Assigned(F_NormBase) then
F_NormBase.Panel_Tree.DisableAlign;
end; }
end;
procedure TFSCS_Main.OnSplitterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
{if Sender = sDiv1 then
begin
if Assigned(F_ProjMan) then
F_ProjMan.Panel_Tree.EnableAlign;
end
else
if Sender = sDiv2 then
begin
if Assigned(F_NormBase) then
F_NormBase.Panel_Tree.EnableAlign;
end;}
end;
procedure TFSCS_Main.OnPMItemsRoofHipTypeClick(Sender: TObject);
begin
if {(TMenuItem(Sender).Tag <> 0) and} (TMenuItem(Sender).Caption <> '') and (GCadForm.PCad.Selection.Count > 0) then
begin
SetSelPathRoofHipType(GCadForm.PCad.Selection[0], TMenuItem(Sender).Tag);
end;
end;
procedure TFSCS_Main.SDCreateBlockToFileCanClose(Sender: TObject; var CanClose: Boolean);
var
i: Integer;
FileName: String;
begin
if TSaveDialog(Sender).Files.Count > 0 then
begin
// Ïðîâåðÿåì åñòü ëè ñ òàêèì èìåíåíì bmp êàê blk
FileName := TSaveDialog(Sender).Files[0];
FileName := ExtractFilePathOnly(FileName) +'.bmp';
if FileExists(FileName) then
if MessageQuastYN(FileName+' '+cMain_Mes131) <> IDYES then
CanClose := false;
end;
end;
procedure TFSCS_Main.ShowBlockParamsForPopupFigure(aAllowPersent: Boolean=true; aAllowProportion: Boolean=true);
var
TempBlock: TFigure;
FigHandle: Integer;
//SelFigure: TFigure;
//SelFigureObj: TSCSComponent;
CommonNetIdx: Integer;
IsSaveForUndo: Boolean;
begin
try
TempBlock := nil;
IsSaveForUndo := false;
try
if (GPopupFigure = nil) then
begin
if GCadForm.PCad.ActiveLayer = lnArch then
begin
GCadForm.BeginSaveForUndo(uat_None, False, False);
IsSaveForUndo := true;
if GCadForm.PCad.SelectedCount = 1 then
TempBlock := TFigure(GCadForm.PCad.Selection.Items[0])
else
if GCadForm.PCad.SelectedCount > 0 then
begin
//CommonNetIdx := GCadForm.PCad.Selection.IndexOf(GCadForm.FActiveNet);
//if CommonNetIdx <> -1 then
//begin
// GCadForm.FActiveNet.Selected := false;
// GCadForm.PCad.Selection.Delete(CommonNetIdx);
//end;
CommonNetIdx := GCadForm.RemoveFigureFromSelected(GCadForm.FActiveNet);
//SelFigure := TFigure(GCadForm.PCad.Selection[0]);
//10.05.2012 Åñëè TNet, òî åñëè âûäåëåíû âñå ñåãìåíòû êðûøè (ñâÿçàííûå), òî âûâîäèì äèàëîã ñ ó÷åòîì âûñîòû êðûøè
{if (SelFigure.ClassName = TNet.ClassName) and (TNet(SelFigure).FComponID <> 0) then
begin
SelFigureObj := GetArchObjByCADObj(SelFigure);
if SelFigureObj <> nil then
if SelFigureObj.IsLine = ctArhRoofSeg then
begin
if IsAllRelatedNetsInList(TNet(SelFigure), GCadForm.PCad.Selection, true) then
begin
end;
end;
end; }
FigHandle := GCadForm.PCad.GroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
TempBlock := TFigure(FigHandle);
if CommonNetIdx <> -1 then
begin
GCadForm.PCad.Selection.Add(GCadForm.FActiveNet);
GCadForm.FActiveNet.Selected := true;
end;
end;
F_BlockParams.cbProportions.Checked := false;
GPopupFigure := TempBlock;
end;
end;
if GPopupFigure <> nil then
begin
F_BlockParams.Execute(GPopupFigure, aAllowPersent, aAllowProportion);
end;
if (TempBlock <> nil) and (TempBlock is TFigureGrp) then
begin
GCadForm.PCad.UnGroupSelection;
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
finally
if IsSaveForUndo then
GCadForm.EndSaveForUndo;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'ShowBlockParamsForPopupFigure', E.Message);
end;
end;
procedure TFSCS_Main.RecreateHandle;
begin
RecreateWnd;
//07.05.2013 Ïîñëå ïåðåêëþ÷åíèÿ ÿçûêà, ÷òîáû ïîäòÿíóëèñü õèíòû
SetHints;
end;
procedure TFSCS_Main.SetHints;
begin
aInteractiveNextStep.Hint := aInteractiveNextStep.Caption;
aInteractiveStop.Hint := aInteractiveStop.Caption;
end;
procedure TFSCS_Main.aConvertToPolygonExecute(Sender: TObject);
var
CADCoordKoeff: Double;
Circle: TCircle;
CornerCount: Integer;
PolygonPoints: TDoublePointArr;
PolygonFigure: TPolyline;
Points: TDoublePointArr;
LayerHandle: Integer;
ObjType: Integer;
CurrPt, CenterPt, TempPt, SrcPt1, SrcPt2: TDoublePoint;
StartPt: PDoublePoint;
ObjProps: TSCSComponent;
i, j, ptIdx: Integer;
ObjHeight: Double;
BaseRadius, BaseCircleLen: Double;
BaseCornerCount: Integer;
ArchNet: TSCSComponent;
Net: TNet;
Path: TNetPath;
NewPaths: TList;
NewPoints: TList;
pt: PDoublepoint;
LinePoints: TDoublePointArr;
begin
// Tolik 13/01/2020
Circle := nil;
try
if (GCadForm.PCad.Selection.Count = 1) then
begin
CADCoordKoeff := 1000/GCadForm.PCad.MapScale;
StartPt := nil;
CurrPt := DoublePoint(GCadForm.CurrX, GCadForm.CurrY);
ObjProps := nil;
ObjType := ctNone;
Circle := nil;
if TFigure(GCadForm.PCad.Selection[0]) is TCircle then
begin
Circle := TCircle(GCadForm.PCad.Selection[0]);
if (GCadForm.CurrentLayer = lnArch) and IsArchTopComponByIsLine(F_NormBase.GSCSBase.SCSComponent.IsLine) then
begin
ObjType := F_NormBase.GSCSBase.SCSComponent.IsLine;
ObjProps := TSCSComponent.Create(F_ProjMan);
ObjProps.AddSimpleProperty(pnCornerCount, 'Êîëè÷åñòâî óãëîâ', '6', dtInteger);
if ObjType = ctArhRoofSeg then
begin
ObjProps.AddSimpleProperty(pnHeight, 'Âûñîòà', '2', dtFloat);
ObjProps.AddSimpleProperty(pnAllowEaves, 'Ñ êàðíèçíûì ñâåñîì', '1', dtBoolean);
ObjProps.AddSimpleProperty(pnRoofBaseRadius, 'Ðàäèóñ îñíîâàíèÿ', FloatToStrU(Circle.radius * GCadForm.PCad.MapScale / 1000), dtFloat);
ObjProps.AddSimpleProperty(pnLength, 'Ïðèáëèçèòåëüíàÿ äëèíà ðåáåð íà îñíîâàíèè', '1', dtFloat);
end;
end;
end;
CornerCount := 0;
if ObjProps <> nil then
begin
if EditObjectProps(F_ProjMan, ObjProps, false) then
CornerCount := ObjProps.GetPropertyValueAsInteger(pnCornerCount);
end
else
CornerCount := InputForm(F_ProjMan, ApplicationName, cMain_Mes129, 6, dtInteger);
if CornerCount > 0 then
begin
BeginProgress;
GCadForm.BeginSaveForUndo(uat_None, True, False);
try
LayerHandle := GCadForm.PCad.GetLayerHandle(GCadForm.CurrentLayer);
if TFigure(GCadForm.PCad.Selection[0]) is TCircle then
begin
CenterPt := Circle.actualpoints[1];
if IspointInCircle(CurrPt.x, CurrPt.y, CenterPt.x, CenterPt.y, Circle.radius) then
StartPt := @CurrPt;
PolygonPoints := GetPolylineFromArc(CornerCount, CenterPt, Circle.radius, 360, StartPt, nil);
ObjType := ctNone;
if IsArchTopComponByIsLine(F_NormBase.GSCSBase.SCSComponent.IsLine) then
begin
ObjType := F_NormBase.GSCSBase.SCSComponent.IsLine;
SetLength(Points, 4);
for i := 0 to Length(PolygonPoints) - 1 do
begin
Points[0] := PolygonPoints[i];
if i < (Length(PolygonPoints) - 1) then
Points[1] := PolygonPoints[i+1]
else
Points[1] := PolygonPoints[0];
Points[2] := CenterPt;
Points[3] := Points[0];
ArchNet := CreateArchRoomByWallInfo(nil, nil, GCadForm, ObjType, nil, Points, nil, nil, true, true);
Net := TNet(GetCADObjByArchObj(ArchNet, GCadForm));
if ObjType = ctArhRoofSeg then
begin
// Ó÷èòûâàòü êàðíèçû
if ObjProps.GetPropertyValueAsBooleanDef(pnAllowEaves, false) then
for j := 0 to Net.Paths.Count - 1 do
begin
Path := TNetPath(Net.Paths[j]);
if Net.CmpIntersectPaths(Path.p1, Path.p2, @Points[0], @Points[1]) = citEqual then
SetPathRoofHipType(Net, Path, rhtEaves)
else
SetPathRoofHipType(Net, Path, rhtRoofHip);
end;
// Ó÷èòûâàòü âûñîòó òî÷êè
ObjHeight := ObjProps.GetPropertyValueAsFloat(pnHeight);
if ObjHeight > 0 then
begin
F_ProjMan.SetComponPropValue(
GetArchCornerByPoint(Net, Net.GetPointByNear(CenterPt)),
pnHeight, FloatToStr(ObjHeight)
);
end;
end;
end;
// Äîáàâëÿåì îñíîâàíèå
BaseRadius := ObjProps.GetPropertyValueAsFloat(pnRoofBaseRadius) * CADCoordKoeff;
if BaseRadius > 0 then
begin
{SetLength(Points, Length(PolygonPoints)+1);
for i := 0 to Length(PolygonPoints) - 1 do
begin
if Abs(BaseRadius - Circle.radius) > 0.1 then
Points[i] := MPoint(CenterPt, PolygonPoints[i], BaseRadius)
else
Points[i] := PolygonPoints[i];
end;
Points[Length(PolygonPoints)] := Points[0];}
if Abs(BaseRadius - Circle.radius) > 0.1 then
TempPt := MPoint(CenterPt, PolygonPoints[0], BaseRadius)
else
TempPt := PolygonPoints[0];
//CornerCount*7
// Îïðåäåëÿåì êîëâî óãëîâ, òàê ÷òîáû ðàçìåð ðåáåð áûë 20ñì
BaseCircleLen := 2 * pi * BaseRadius;
BaseCornerCount := Round(BaseCircleLen / (ObjProps.GetPropertyValueAsFloat(pnLength)*CADCoordKoeff ));
Points := GetPolylineFromArc(BaseCornerCount, CenterPt, BaseRadius, 360, @TempPt, nil);
SetLength(Points, Length(Points)+1);
Points[Length(Points)-1] := Points[0];
ArchNet := CreateArchRoomByWallInfo(nil, nil, GCadForm, ObjType, nil, Points, nil, nil, true, true);
F_ProjMan.SetComponPropValue(ArchNet, pnMaterialType, IntToStr(pmtRoofBase));
end;
end
else
begin
PolygonFigure := TPolyline.create(PolygonPoints, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, true, LayerHandle, mydsNormal, GCadForm.PCad);
GCadForm.PCad.AddCustomFigure(GCadForm.CurrentLayer, PolygonFigure, False);
end;
end
else if TFigure(GCadForm.PCad.Selection[0]) is TNet then
begin
Net := TNet(GCadForm.PCad.Selection[0]);
Path := Net.SelPath;
if Assigned(Path) and (Path.isArc) then
begin
PolygonPoints := GetPolylineFromArc(CornerCount+1, Path.ArcCenter, GetLineLength(Path.ArcCenter, Path.p1^), Path.ArcAng*180/pi, Path.p1, Path.p2);
Path.isArc := false;
Net.RefreshPaths;
SrcPt1 := Path.p1^;
SrcPt2 := Path.p2^;
NewPoints := TList.Create;
for i := 0 to Length(PolygonPoints) - 1 do
begin
pt := nil;
if Not EQDP(PolygonPoints[i], Path.p1^) and Not EQDP(PolygonPoints[i], Path.p2^) then
begin
//pt := Net.DivPath(Path, MPoint(Path.p1^, Path.p2^, GetLineLength(Path.p1^, Path.p2^)/2));
//pt := Net.DivPath(Path, PolygonPoints[i]);
TempPt := PolygonPoints[i];
PointToLineByAngle(SrcPt1,SrcPt2,TempPt);
//PolygonPoints[i] := TempPt;
pt := Net.DivPath(Path, TempPt);
end;
NewPoints.Add(pt);
end;
for i := 0 to NewPoints.Count - 1 do
begin
pt := NewPoints[i];
if pt <> nil then
pt^ := PolygonPoints[i];
end;
NewPoints.Free;
Net.RefreshPaths;
{NewPaths := TList.Create;
NewPaths.Add(Path);
for i := 0 to Length(PolygonPoints) - 1 do
begin
ptIdx := i;
// Åñëè èíâåðòèðîâàíà äóãà, òî ñìîòðèì ñ êîíöà
if Not Path.Inverted then
ptIdx := Length(PolygonPoints) - 1 - i;
if Not EQDP(PolygonPoints[ptIdx], Path.p1^) and Not EQDP(PolygonPoints[ptIdx], Path.p2^) then
begin
for j := 0 to NewPaths.Count - 1 do
begin
pt := Net.DivPath(TNetPath(NewPaths[j]), PolygonPoints[ptIdx]);
if pt <> nil then
begin
pt^ := PolygonPoints[ptIdx];
NewPaths.Add(Net.Paths[Net.Paths.Count - 1]);
Break; //// BREAK ////
end;
end;
//if Net.DivPath(Path, PolygonPoints[ptIdx]) = nil then
// Net.DivPath(TNetPath(Net.Paths[Net.Paths.Count - 1]), PolygonPoints[ptIdx]);
//PDoublePoint(Net.Points[Net.Points.Count - 1])^ := PolygonPoints[ptIdx];
end;
end;
Net.RefreshPaths;
NewPaths.Free; }
//PolygonFigure := TPolyline.create(PolygonPoints, 1, ord(psSolid), clBlack, ord(bsClear), clBlack, 0, true, LayerHandle, mydsNormal, GCadForm.PCad);
//GCadForm.PCad.AddCustomFigure(GCadForm.CurrentLayer, PolygonFigure, False);
end;
end;
// Tolik -- 13/01/2020
if Circle <> nil then
//
GCadForm.FRemFigures.Add(Circle);
RefreshCAD_T(GCadForm.PCad);
finally
GCadForm.EndSaveForUndo;
EndProgress;
end;
RefreshCAD(GCadForm.PCad);
end;
if ObjProps <> nil then
ObjProps.Free;
end;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'aConvertToPolygonExecute', E.Message);
end;
end;
procedure TFSCS_Main.aToolSCSArcDimLineExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
DropDownNextToolbar; // Tolik 10/02/2021
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
SetLayerForDraw;
GCadForm.PCad.SetTool(toFigure, 'TArcDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.FormDestroy(Sender: TObject);
begin
FreeAndNil(FCADsInProgress);
if Assigned(FInteractiveActions) then
FreeAndNil(FInteractiveActions);
end;
procedure TFSCS_Main.aPrintRectExecute(Sender: TObject);
var
i: integer;
begin
{$IF Defined (TRIAL_SCS) or Defined (FINAL_SCS)}
if Not IsVista then
begin
BuildFHash;
GetLic;
for i := 0 to 15 do
begin
if ((ord(bufflic[i mod 16]) - (Digest[i mod 16] XOR $3A))) > 0 then
Close;
end;
end;
{$IFEND}
{$IF Defined(TRIAL_SCS) and not Defined(PROCAT_SCS) and not Defined(SCS_PE)}
ShowMessage(cMain_Mes9);
{$ELSE}
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
GCadForm.PCad.SetTool(toFigure, 'TPrintRect');
tbSelectNoob.Down := false;
tbSelectExpert.Down := false;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
{$IFEND}
end;
procedure TFSCS_Main.aSegActionExecute(Sender: TObject);
var
Polyline: TPolyline;
MenuCmd: Integer;
Rad: Double;
begin
if (GPopupFigure <> nil) and (GCadForm.PCad.Figures.IndexOf(GPopupFigure) <> -1) and (GPopupFigure is TPolyline) then
if Not TAction(Sender).Checked or (Sender = aSegDimLine) then
begin
GCadForm.BeginSaveForUndo(uat_None, False, False);
try
Polyline := TPolyline(GPopupFigure);
MenuCmd := -1;
if Sender = aSegCurveAll then
Polyline.ConvertToBezier
else if Sender = aSegLineAll then
Polyline.ConvertToPolyLine
else if Sender = aSegClose then
Polyline.Closed := true
else if Sender = aSegOpen then
Polyline.Closed := false
else if Sender = aSegInsertKnot then
MenuCmd := 7
else if Sender = aSegDeleteKnot then
MenuCmd := 8
else if Sender = aSegLine then
MenuCmd := 9
else if Sender = aSegCurve then
MenuCmd := 10
else if Sender = aSegArc then
MenuCmd := 11
else if Sender = aSegInverArc then
MenuCmd := 12
else if Sender = aSegDimLine then
MenuCmd := 15
else if Sender = aSegDivTo3 then
MenuCmd := 14
else if Sender = aSegRoundCornerByArc then
begin
//MenuCmd := 16
Rad := 5;
//if InputDouble(aSegRoundCornerByArc.Caption, cMain_Mes130, Rad) then //if InputDouble('Round Corner By Arc','Ener Arc Corner',Rad) then begin
Rad := InputForm(F_ProjMan, aSegRoundCornerByArc.Caption, cMain_Mes130, Rad, dtFloat);
if Rad > 0 then
Polyline.RoundCornerByArc(Polyline.SelectedPoint, Rad);
end
else if Sender = aSegPenNone then
MenuCmd := 13
else if Sender = aSegPenZigZag then
MenuCmd := 17+0
else if Sender = aSegPenFlower then
MenuCmd := 17+1
else if Sender = aSegPenSinus then
MenuCmd := 17+2
else if Sender = aSegPenButtons then
MenuCmd := 17+3
else if Sender = aSegPenSquare then
MenuCmd := 17+4
else if Sender = aSegPenMiniSinus then
MenuCmd := 17+5;
if MenuCmd <> -1 then
begin
Polyline.MenuClicked(MenuCmd);
end;
finally
GCadForm.EndSaveForUndo;
end;
RefreshCAD_T(GCadForm.PCad);
end;
end;
procedure TFSCS_Main.aSaveProjectToPDFExecute(Sender: TObject);
var
SaveDialog: TSaveDialog;
i: Integer;
CAD: TF_CAD;
PDFDoc: TPDFDocument;
O, B: TPDFOutlineNode;
CADIdx: Integer;
SCSList: TSCSList;
ProjLists: TList;
SaveAll: Boolean;
Form: TForm; // Tolik 22/12/2020 --
begin
try
if MessageBox(FSCS_Main.Handle, cMain_Mes143, cMain_Mes143_c, MB_YESNO) = IDYes then
GExportUSeScale := True;
SaveDialog := TSaveDialog.Create(Self);
SaveDialog.Title := aSaveProjectToPDF.Caption;
SaveDialog.InitialDir := ExtractSaveDir;
SaveDialog.DefaultExt := 'pdf';
SaveDialog.Filter := cProgressExp_Msg9_1;
SaveDialog.Options := SaveDialog.Options + [ofOverwritePrompt];
SaveDialog.FileName := FileNameCorrect(F_ProjMan.GSCSBase.CurrProject.Name);
if SaveDialog.Execute then
begin
// Tolik 16/07/2019 -- äîáàâèë íåáîëüøóþ ôîðìî÷êó, ÷òîáû ìîæíî áûëî âûáðàòü, êàêèå èìåííî ëèñòû ïðîåêòà ñîõðàíÿòü, à òî
// âàëèò âñå ëèñòû, à íå âñåì ïîëüçîâàòåëÿì òàêîå íðàâèòñÿ (âîò, ïî ïðîñüáàì òðóäÿùèõñÿ ... è)
if not Assigned(F_SelLists) then
Application.CreateForm(TF_SelLists, F_SelLists);
F_SelLists.CheckList1.Clear;
for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count -1 do
begin
F_SelLists.CheckList1.Items.Add(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].GetNameForVisible(false));
F_SelLists.CheckList1.ItemState[i] := cbChecked;
end;
if F_SelLists.ShowModal = mrOk then
begin
i := F_SelLists.CheckList1.ItemsChecked;
if i > 0 then
begin
//
PDFDoc := CreatePDFObject(Self, F_ProjMan.GSCSBase.CurrProject.Name, SaveDialog.FileName, nil);
PDFDoc.Compression := PDF.ctNone;
PDFDoc.JPEGQuality := 100;
//PDFDoc.Resolution := 70;
if not GExportUSeScale then // Tolik 22/12/2020
PDFDoc.Resolution := 300
else
begin
if GCadForm <> nil then
begin
if GCadForm.PCad <> nil then
begin
Form := GCadForm.PCad.GetForm;
if Form <> nil then
PDFDoc.Resolution := Form.PixelsPerInch;
end;
end;
end;
PDFDoc.PageMode := pmUseOutlines;
PDFDoc.PageLayout := plSinglePage;
PdfDoc.EMFImageAsJpeg := True; // Tolik 22/12/2020
PDFDoc.Compression := ctFlate; // Tolik 22/12/2020
PDFDoc.BeginDoc;
//PDFDoc.Outlines.Add()
//B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create);
{$IF Defined(SCS_PE)}
B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create);
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
B := PDFDoc.Outlines.Add(nil, F_ProjMan.GSCSBase.CurrProject.Name, TPDFGoToPageAction.Create, RUSSIAN_CHARSET);
{$IFEND}
B.Expanded := True;
//B.Charset := DEFAULT_CHARSET;
//B.Charset := ANSI_CHARSET;
{$IF Defined(SCS_PE)}
B.Charset := DEFAULT_CHARSET;
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
B.Charset := RUSSIAN_CHARSET;
{$IFEND}
O := nil;
CADIdx := 0;
for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do
begin
if F_SelLists.CheckList1.ItemChecked[i] then
begin
SCSList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i];
CAD := GetListByID(SCSList.CurrID);
if CAD <> nil then
begin
if CADIdx > 0 then
PDFDoc.NewPage;
SetCADPageParamsToPDF(CAD, PDFDoc, false);
//O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create);
{$IF Defined(SCS_PE)}
O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create);
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create, RUSSIAN_CHARSET);
{$IFEND}
TPDFGoToPageAction(O.Action).PageIndex := CADIdx;
TPDFGoToPageAction(O.Action).TopOffset := 0;
{$IF Defined(SCS_PE)}
O.Charset := DEFAULT_CHARSET;
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
O.Charset := RUSSIAN_CHARSET;
{$IFEND}
O.Expanded := True;
Inc(CADIdx);
end;
end;
end;
(*
for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do
begin
SCSList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i];
CAD := GetListByID(SCSList.CurrID);
if CAD <> nil then
begin
if CADIdx > 0 then
PDFDoc.NewPage;
SetCADPageParamsToPDF(CAD, PDFDoc, false);
//O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create);
{$IF Defined(SCS_PE)}
O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create);
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
O := PDFDoc.Outlines.AddChild(B, SCSList.GetParams.Caption, TPDFGoToPageAction.Create, RUSSIAN_CHARSET);
{$IFEND}
TPDFGoToPageAction(O.Action).PageIndex := CADIdx;
TPDFGoToPageAction(O.Action).TopOffset := 0;
{$IF Defined(SCS_PE)}
O.Charset := DEFAULT_CHARSET;
{$ELSE}
//ÍÓÆÍÎ ÞÇÀÒÜ RUSSIAN_CHARSET
O.Charset := RUSSIAN_CHARSET;
{$IFEND}
O.Expanded := True;
Inc(CADIdx);
end;
end;
*)
PDFDoc.EndDoc;
PDFDoc.Free;
end;
end;
end;
SaveDialog.Free;
FreeAndNil(F_SelLists);
except
on E: Exception do AddExceptionToLogExt(ClassName, 'aSaveProjectToPDFExecute', E.Message);
end;
GExportUSeScale := False;
end;
procedure TFSCS_Main.aLinesToTracesExecute(Sender: TObject);
var
CmpPointDelta: Double;
Figure: TFigure;
Line: TLine;
PolyLine: TPolyline;
Seg: TPlSegment;
Trace, CTrace: TOrthoLine;
FigureList: TList;
NewTraces: TList;
TracesHeight: Double;
i, j, k, l: Integer;
Conn1, Conn2: TConnectorObject;
SnappedInfo: TStringList;
SnapInfo: String;
procedure CollectFigures(AFigures: TList);
var
i: integer;
begin
for i := 0 to AFigures.Count - 1 do
begin
Figure := TFigure(AFigures[i]);
if CheckFigureByClassName(Figure, TPolyline.ClassName) then
begin
// ïðîâåðÿåì ñåãìåíòû ïîëèëèíèè, ÷òîáû áûëè òèïà ëèí
// ----
FigureList.Add(Figure);
end
else if CheckFigureByClassName(Figure, TLine.ClassName) then
begin
if Not PointNear(TLine(Figure).ActualPoints[1], TLine(Figure).ActualPoints[2], CmpPointDelta) then
FigureList.Add(Figure);
end
else if CheckFigureByClassName(Figure, TRectangle.ClassName) then
FigureList.Add(Figure)
else if CheckFigureByClassName(Figure, TFigureGrp.ClassName) then
CollectFigures(TFigureGrp(Figure).InFigures);
end;
end;
procedure CreateTrace(p1, p2: TDoublePoint);
begin
if Not PointNear(p1, p2, CmpPointDelta) then
begin
Trace := CreateTraceByPoints(GCadForm.PCad, p1, p2);
RaiseLineOnHeight(Trace, TracesHeight, nil);
NewTraces.Add(Trace);
end;
end;
begin
try
F_RaiseHeight.cbApplyToAll.Visible := False; // Tolik 04/08/2021 --
GPopupFigure := nil;
CmpPointDelta := 1/5;
FigureList := TList.Create;
{for i := 0 to GCadForm.PCad.Selection.Count - 1 do
begin
Figure := TFigure(GCadForm.PCad.Selection[i]);
if CheckFigureByClassName(Figure, TPolyline.ClassName) then
begin
// ïðîâåðÿåì ñåãìåíòû ïîëèëèíèè, ÷òîáû áûëè òèïà ëèí
// ----
FigureList.Add(Figure);
end
else if CheckFigureByClassName(Figure, TLine.ClassName) then
begin
if Not EQDP(TLine(Figure).ActualPoints[1], TLine(Figure).ActualPoints[2]) then
FigureList.Add(Figure);
end
else if CheckFigureByClassName(Figure, TFigureGrp.ClassName) then
begin
end;
end;}
CollectFigures(GCadForm.PCad.Selection);
if FigureList.Count > 0 then
begin
if MessageQuastYN(cMain_Mes134) = IDYES then
begin
F_RaiseHeight.Caption := cMain_Mes32;
F_RaiseHeight.lbMessage.Caption := cMain_Mes33;
F_RaiseHeight.SetVal(GCadForm.FLineHeight);
if F_RaiseHeight.Showmodal = mrOK then
begin
NewTraces := TList.Create;
//GCadForm.SaveForUndo(uat_None, true, False);
GCadForm.ClearUndoList(false);
GCadForm.ClearRedoList(false);
GCadForm.PCad.ClearUndoList;
GCadForm.FCanSaveForUndo := false;
try
BeginProgress('', FigureList.Count * 2);
try
TracesHeight := StrToFloat_My(F_RaiseHeight.edRaiseHeight.Text);
TracesHeight := UOMToMetre(TracesHeight);
if TracesHeight > GCadForm.FRoomHeight then
TracesHeight := GCadForm.FRoomHeight;
// Create Traces
for i := 0 to FigureList.Count - 1 do
begin
Figure := TFigure(FigureList[i]);
//if Figure is TRectangle then
// EmptyProcedure;
for j := 1 to Figure.PointCount -1 do
CreateTrace(Figure.ActualPoints[j], Figure.ActualPoints[j+1]);
// Åñëè îáúåêò çàìêíóòûé, òî äîáàâëÿåì çàìûêàþùóþ òðàññó
if Figure.PointCount > 2 then
begin
if CheckFigureByClassName(Figure, TPolyline.ClassName) then
begin
if TPolyline(Figure).Closed then
CreateTrace(Figure.ActualPoints[1], Figure.ActualPoints[Figure.PointCount]);
end
else if CheckFigureByClassName(Figure, TRectangle.ClassName) then
CreateTrace(Figure.ActualPoints[1], Figure.ActualPoints[Figure.PointCount]);
end;
StepProgress;
end;
RefreshCAD(GCadForm.PCad);
// Connect Traces
SnappedInfo := CreateStringListSorted;
for i := 0 to NewTraces.Count - 1 do
begin
Trace := TOrthoLine(NewTraces[i]);
for j := 0 to NewTraces.Count - 1 do
begin
CTrace := TOrthoLine(NewTraces[j]);
if Trace <> CTrace then
begin
for k := 1 to 2 do
for l := 1 to 2 do
if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then
begin
Conn1 := Trace.ConnectorByNum(k);
Conn2 := CTrace.ConnectorByNum(l);
if Assigned(Conn1) and Assigned(Conn2) then
if Conn1 <> Conn2 then
begin
SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID));
if SnappedInfo.IndexOf(SnapInfo) = -1 then
begin
if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then
// Tolik -- 29/03/2018 --
//Conn1 := SnapConnectorToConnector(Conn1, Conn2)
CheckingSnapConnectorToConnector(Conn1, Conn2)
//
else
EmptyProcedure;
SnappedInfo.Add(SnapInfo);
end;
end;
end;
end;
end;
StepProgress;
end;
FreeAndNil(SnappedInfo);
RefreshCAD(GCadForm.PCad);
finally
EndProgress;
end;
// Óäàëèòü èñõîäíûå ëèíèè
if MessageQuastYN(cMain_Mes133) = IDYES then
begin
BeginProgress('', FigureList.Count * 2);
try
GCadForm.PCad.DeselectAll(0);
for i := 0 to FigureList.Count - 1 do
begin
//Line := TLine(FigureList[i]);
//Line.Select;
Figure := TFigure(FigureList[i]);
// Åñëè íå â ãðóïïå
if Figure.Parent = nil then
Figure.Select
else if CheckFigureByClassName(Figure.Parent, TFigureGrp.ClassName) then
if TFigureGrp(Figure.Parent).InFigures.IndexOf(Figure) <> -1 then
begin
//EmptyProcedure;
TFigureGrp(Figure.Parent).RemoveFromGrp(Figure);
Figure.Free;
FigureList[i] := nil;
end;
//TFigure(FigureList[i]).Select;
end;
// Ñîõðàíÿåì ñ ïîäëîæêîé äëÿ îòêàòà
//GCadForm.PCad.RecordUndo := True;
//GCadForm.PCad.RecordModifyUndo(nil);
//GCadForm.PCad.RecordUndo := False;
GCadForm.FCanSaveForUndo := false; // ÷òîáû íå âûçâàëñÿ SaveForProjectUndo íà PCadBeforeDelete
GCadForm.RemoveSelectedWithoutCheck;
RefreshCAD(GCadForm.PCad);
finally
EndProgress;
end;
end;
// Âûäåëÿåì íîâûå òðàññû
GCadForm.PCad.DeselectAll(0);
for i := 0 to NewTraces.Count - 1 do
begin
//TOrthoLine(NewTraces[i]).Select;
Trace := TOrthoLine(NewTraces[i]);
Trace.Select;
Trace.JoinConnector1.Select;
Trace.JoinConnector2.Select;
end;
RefreshCAD(GCadForm.PCad);
finally
GCadForm.FCanSaveForUndo := true;
NewTraces.Free;
end;
end;
end;
end
else
MessageInfo(cMain_Mes132);
FigureList.Free;
except
on E: Exception do AddExceptionToLogExt(ClassName, 'aLinesToTracesExecute', E.Message);
end;
end;
procedure TFSCS_Main.aTurnObjectExecute(Sender: TObject);
var
Path: TNetPath;
Niche: TNetDoor;
begin
Path := NetGetSelPath;
if Path <> nil then
begin
Niche := NetDoorRotate(Path);
if Niche <> nil then
begin
if Niche.FComponID <> 0 then
begin
Path := Niche.GetPath;
if Path <> nil then
if Not Path.IsInnerNiche(Niche, true) then
begin
Sleep(100);
Application.ProcessMessages;
//ShowHintInCursorPos(cMain_Mes135, 2000);
ShowHintRz(cMain_Mes135, 4000, @GCadForm.FPopupScrPoint);
end;
//NetDoorShowOutNicheMessage(Path.Net, cMain_Mes135);
end;
end
else
begin
//22.05.2012 Èíà÷å ñåãìåíòó ìåíÿåì ñòîðîíó îòîáðàæàíèÿ ïåðïåíäèêóëÿðíûõ òî÷åê
NetPathPerpendSideRotate(Path);
end;
end;
end;
procedure TFSCS_Main.aLoadSubstrateFromPDFExecute(Sender: TObject);
var
Bmp: TBitmap;
Jpg: TJPEGImage;
FName: String;
bmpHandle: TFigHandle; // Tolik 09/08/2019 --
Fig: TFigure;
UserDimLine: boolean;//Tolik 12/08/2021 --
begin
if ActiveMDIChild <> nil then
begin
UserDimLine := False;
Bmp := CreateFPDFView.GetDocBitmap(cMain_Mes136);
if Bmp <> nil then
begin
try
FName := ExtractSCSTempDir + GetUniqueFileName('', enBmp);
Bmp.SaveToFile(FName);
Bmp.Free;
aSetSubstrateLayer.Execute;
// Tolik
//Fig := TFigure(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false));
bmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false);
if bmpHandle <> -1 then
begin
Fig := TFigure(bmpHandle);
if Fig <> nil then // Tolik 12/08/2021 --
begin
if not Fig.Deleted then // Tolik 12/08/2021 --
begin
Fig.width := 0; // Óáèðàåì ðàìêó
GCadForm.PCad.DeselectAll(0);
DeleteFile(FName);
AutoFitBitMap(TBMPObject(Fig));
UserDimLine := True; // Tolik 12/08/2021 --
end;
end;
end
else
begin
ShowMessage(cMain_Mes6);
end;
except
ShowMessage(cMain_Mes6);
end;
{
FSCS_Main.tbSelectExpert.Down := False;
FSCS_Main.tbSelectNoob.Down := False;
FSCS_Main.tbPanExpert.Down := True;
FSCS_Main.tbPanNoob.Down := True;
FSCS_Main.aToolPan.Execute;
}
RefreshCAD(GCadForm.PCad);
end;
GisUserDimLine := UserDimLine; // Tolik 12/08/2021 --
SetHScale; // Tolik 12/08/2021 --
end
else
MessageInfo(CActiveListNotExistMessage);
end;
procedure TFSCS_Main.InteractiveTest;
var
Pt: TPoint;
begin
{//ShowMessage('11');
Pt.X := tbNew.Left+5;
Pt.Y := tbNew.Top+tbNew.Height-5;
Pt := tbNew.Parent.ClientToScreen(Pt);
//Pt.X := Pt.X + tbNew.Width-5;
//Pt.Y := Pt.Y + tbNew.Height-5;
Sleep(100);
Application.ProcessMessages;
GOldOnActionExecute := Application.OnActionExecute;
GInteractiveAction := TBasicAction(tbNew.Action);
Application.OnActionExecute := InteractiveActionExecute;
//ShowHintInCursorPos(cMain_Mes135, 2000);
ShowHintES('Create a new project', 1000*300, @Pt);
//ShowHintRz('Create a new project', 0, @Pt); }
RunInteractive(1);
end;
procedure TFSCS_Main.InteractiveActionExecute(Action: TBasicAction; var Handled: Boolean);
begin
if FInteractiveActions.IndexOf(Action) <> -1 then
begin
if FInteractiveStepHitsCount > 0 then
begin
Dec(FInteractiveStepHitsCount);
if FInteractiveStepHitsCount = 0 then
begin
// Âîññòàíàâëèâàåì ñòàðûé îáðàáîò÷èê
Application.OnActionExecute := FOldOnActionExecute;
FInteractiveActions.Clear; //11.05.2013
StepInteractive;
end;
end;
end;
end;
procedure TFSCS_Main.FInteractiveMsg(var Msg: TMsg; var Handled: boolean);
begin
case Msg.message of
WM_LBUTTONUP:
begin
if Msg.hwnd = FInteractiveControlHandler then
begin
if FInteractiveStepHitsCount > 0 then
begin
Dec(FInteractiveStepHitsCount);
if FInteractiveStepHitsCount = 0 then
begin
if Assigned(FInteractiveMsgOrig) then
FInteractiveMsgOrig(Msg, Handled);
// Âîññòàíàâëèâàåì ñòàðûé îáðàáîò÷èê
Application.OnMessage := FInteractiveMsgOrig;
FInteractiveMsgOrig := nil;
FInteractiveControlHandler := 0; //11.05.2013
StepInteractive;
end;
end;
end;
end;
end;
if Assigned(FInteractiveMsgOrig) then
FInteractiveMsgOrig(Msg, Handled);
end;
procedure TFSCS_Main.RunInteractive(aScene: Integer);
var
Pt: TPoint;
NodeComp: TTreeNode;
begin
if FInteractiveActions = nil then
FInteractiveActions := TList.Create;
// Create forms - in Win7
//F_ProjMan.CreateFResourceReport;
aInteractiveStopExecute(nil);
FInteractiveStep := 1;
FInteractiveScene := aScene;
if FInteractiveScene = 1 then
FInteractiveStepCount := 10;
FInteractiveStepShowed := false;
tbCADToolsExpert.Left := 91;//Tolik 02/102/2022 --
tbInteractive.Visible := true;
//aInteractiveNextStep.Enabled := false;
aInteractiveStop.Enabled := true;
// ïîêàçàòü õèíò âîçëå êíîïîê óïðàâëåíèÿ èíòåðàêòèâíûì ðåæèìîì
Application.ProcessMessages;
// Pt := GetControlScreenPt(tbInteractiveNextStep, ctLeftMiddle);
// ShowHintES(cMain_Mes137, 1500, @Pt);
// Application.ProcessMessages;
// Sleep(2000);
//TimerInteractive.Interval := 1000;
//FInteractiveTimerExecution := false; //11.05.2013
TimerInteractive.Enabled := True;
NodeComp := F_NormBase.FindTreeNodeByDat(280410, [itComponCon]);
if NodeComp <> nil then
begin
PObjectData(NodeComp.Data).FontColor := clGreen;
FInteractiveWorkColorSet := True;
F_NormBase.Tree_Catalog.Repaint;
end;
NodeComp := F_NormBase.FindTreeNodeByDat(280414, [itComponCon]);
if NodeComp <> nil then
begin
PObjectData(NodeComp.Data).FontColor := clGreen;
FInteractiveRackColorSet := True;
F_NormBase.Tree_Catalog.Repaint;
end;
//if Not Assigned(FInteractiveMsgOrig) then
//begin
// FInteractiveMsgOrig := Application.OnMessage;
// Application.OnMessage := FInteractiveMsg;
//end;
end;
procedure TFSCS_Main.StepInteractive;
begin
Inc(FInteractiveStep);
FInteractiveStepShowed := false;
HideHintES;
TimerInteractive.Enabled := False;
TimerInteractive.Enabled := True;
Sleep(100);
Application.ProcessMessages;
end;
procedure TFSCS_Main.TimerInteractiveTimer(Sender: TObject);
var
Pt: TPoint;
HintMessage: String;
SCSComponent: TSCSComponent;
SCSComponents: TSCSComponents;
SprComponentType: TNBComponentType;
TestCnt: Integer;
Figure: TFigure;
SavedHandler: TNotifyEvent; //11.05.2013
begin
if FInteractiveStep > FInteractiveStepCount then
aInteractiveStopExecute(nil) //TTimer(Sender).Enabled := False
else
begin
SavedHandler := TTimer(Sender).OnTimer; //11.05.2013
TTimer(Sender).OnTimer := nil; //11.05.2013
try //11.05.2013
if Not IsVisibleHintES then
begin
if Not FInteractiveStepShowed then
begin
FInteractiveActions.Clear;
FInteractiveControlHandler := 0;
HintMessage := '';
FInteractiveStepHitsCount := 1;
if FInteractiveScene = 1 then
begin
case FInteractiveStep of
1: // Ñîçäàíèå ïðîåêòà
begin
//Pt := tbNew.
//Pt := tbNew.Parent.ClientToScreen(Pt);
Pt := GetControlScreenPt(tbNew, ctBottomMiddle);
FInteractiveActions.Add(tbNew.Action);
Pt.X := Pt.X+5;
Pt.Y := Pt.Y-5; //+tbNew.Height -5;
HintMessage := 'Create a new project';
end;
2: // Óñòàíîâêà ïàðàìåòðîâ ïðîåêòà
begin
if F_MasterNewList.Visible then
begin
FInteractiveControlHandler := F_MasterNewList.bOk.Handle;
Pt := GetControlScreenPt(F_MasterNewList.bOk);
HintMessage := 'Set basic project options and press OK. You may leave everything as is.';
end
else if F_MasterNewListLite.Visible then
begin
FInteractiveControlHandler := F_MasterNewListLite.bNext.Handle;
Pt := GetControlScreenPt(F_MasterNewListLite.bNext);
FInteractiveStepHitsCount := 4; // Êíîïêà "äàëåå" íàæèìàåòñÿ 4 ðàçà
HintMessage := 'Set basic project options and press Next/Done';
end;
end;
3: // Çàãðóçêà ïîäëîæêè
begin
if IsWindowEnabled(Handle) and Not GetIsActiveFormProgress then // Åñëè íåò ìîäàëüíîãî îêíà, äèàëîãà
if CheckIsOpenProject(false) then
if tbLoadSubstrate.Visible and tbLoadSubstrate.Enabled then
begin
//Pt := GetControlScreenPt(tbLoadSubstrate, ctBottomLeft);
//FInteractiveActions.Add(tbLoadSubstrate.Action);
//Pt.X := Pt.X+5;
//Pt.Y := Pt.Y-5; //+tbLoadSubstrate.Height -5;
//HintMessage := 'Load a floor plan in DWG or PDF';
Pt := Point(17, 0);
Pt := Self.ClientToScreen(Pt);
FInteractiveActions.Add(tbLoadSubstrate.Action);
FInteractiveActions.Add(aLoadSubstrate);
FInteractiveActions.Add(aOpenVectorDrawing);
FInteractiveActions.Add(aLoadSubstrateFromPDF);
//HintMessage := 'Load from main menu (File->Load) a floor plan in DWG (Vector drawing) or PDF';
HintMessage := 'Load a Floor plan in DWG. Click on the FILE menu, then LOAD and pick VECTOR DRAWING (DWG, DXF...). Load the file “SAMPLE FLOOR PLAN”';
end;
end;
4: // Ïîèñê Ðàá.Ìåñò â ÍÁ
begin
if IsWindowEnabled(Handle) then // Åñëè íåò ìîäàëüíîãî îêíà, äèàëîãà
begin
//Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle);
Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft);
Pt.X := Pt.X + 45;
Pt.Y := Pt.Y + 145;
//Pt.X := pt.x + trunc(F_NormBase.Tree_Catalog.Width/2);
//Pt.Y := pt.Y + trunc(F_NormBase.Tree_Catalog.Height/2);
//FInteractiveControlHandler := F_NormBase.Tree_Catalog.Handle;
//HintMessage := 'Find Jacks (work areas) in the Library - “Panduit” folder - “Examples - Work areas” folder';
//+snNextRow+cMain_Mes137_2;
//HintMessage := 'Find Jacks (work areas) in the Libraryþ. Folder “Panduit” - “SAMPLES” - “Work areas” - ' +
// 'locate “WA rj45+rj45 for T-45” and click over it';
HintMessage := 'Find jacks (work areas) in the Library. Folder “PANDUIT - SAMPLES - WORK AREAS”. Locate “WA rj45+rj45 for T-45” and click on it';
aInteractiveNextStep.Enabled := true;
FInteractiveActions.Add(aInteractiveNextStep);
end;
end;
5: // Óñòàíîâêà 3-õ ðàá.ìåñò
begin
if GCadForm <> nil then
begin
Pt := GetControlScreenPt(GCadForm, ctMiddle);
//HintMessage := 'Drag and drop 3 jacks on the drawing'; //+snNextRow+cMain_Mes137_2;
HintMessage := 'Drag and drop 3 set of jacks “WA rj45+rj45 for T-45” on the drawing';
aInteractiveNextStep.Enabled := true;
FInteractiveActions.Add(aInteractiveNextStep);
end;
end;
6: // Ïîèñê øêàôà â ÍÁ
begin
//HintMessage := 'Find a Rack "PANNET CABLE MANAGEMENT RACK" in the Library and drag and drop on the drawing'; //+snNextRow+cMain_Mes137_2;
HintMessage := 'Find a Rack “PANNET CABLE MANAGEMENT” in the “SAMPLES - RACKS AND CABINETS” folder and drag and drop on the drawing';
//Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle);
Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft);
Pt.X := Pt.X + 45;
Pt.Y := Pt.Y + 145;
aInteractiveNextStep.Enabled := true;
FInteractiveActions.Add(aInteractiveNextStep);
end;
7: // Øêàô êàê êîíå÷íûé îáúåêò
begin
SCSComponent := F_ProjMan.GSCSBase.CurrProject.ComponentReferences.GetComponentByType(ctsnCupboard);
if SCSComponent <> nil then
begin
Figure := GetFigureByID(GCadForm, SCSComponent.GetFirstParentCatalog.SCSID);
if Figure <> nil then
begin
Pt := GCadForm.PCad.PointToScreen(Figure.ActualPoints[1]);
//HintMessage := 'Set the Rack as a destination and all the cables from jacks will be layed out down to this Rack. Right-clicking on the Rack and check “As terminal object” in the context menu. The Rack should hightlight red.';
HintMessage := 'Set the Rack as a destination and all the cables from jacks will be layed out down to this Rack. Right-clicking on the Rack and check “Set as destination for cables” in the context menu. The Rack should hightlight red.';
FInteractiveActions.Add(aServerAsDefault);
end;
end;
end;
8: // Ïðîêëàäêà òðàññ
begin
//HintMessage := 'Lay out routes. Click this button and connect every jack with the Rack. Click mouse over jacks and right-click it on the Rack to finish the route';
//+snNextRow+cMain_Mes137_2;
//HintMessage := 'Lay out routes. Click the button <Route> and connect every jack with the Rack.' +
// ' When moving route over jacks click the mouse and at the end right-click on the Rack to finish the route';
HintMessage := 'Lay out routes. Click this button and connect every jack with the Rack. Click mouse over every jacks. Make sure the jack is highlighted when mouse is over, otherwise the connection will fail. ' +
'Then ñlick over the Rack and finally right-click to finish the route';
if tbCADToolsExpert.Visible then
Pt := GetControlScreenPt(tbToolOrtholineExtExpert, ctBottomMiddle)
else
Pt := GetControlScreenPt(tbToolOrtholineExtNoob, ctBottomMiddle);
Pt.y := Pt.y - 10;
aInteractiveNextStep.Enabled := true;
//FInteractiveActions.Add(aToolOrthoLine);
FInteractiveActions.Add(aInteractiveNextStep);
end;
9: // Ïðîêëàäêà êàáåëÿ
begin
if GCadForm.PCad.ToolInfo = 'TSelected' then // Åñëè òðàññû óæå ïðîëîæèëè
begin
//Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctLeftMiddle);
Pt := GetControlScreenPt(F_NormBase.Tree_Catalog, ctTopLeft);
Pt.X := Pt.X + 45;
Pt.Y := Pt.Y + 145;
//HintMessage := 'Now that we have layed out routes, please find a cable in the Library to lay out between jacks and a Rack. Right-click on the cable and execute Autoroute';
HintMessage := 'Now that we have layed out routes, please find a cable “UTP CAT5E PVC CABLE” in ' +
'the “SAMPLES-CABLES” folder to lay out it between jacks and the Rack. ' +
'Right-click on the cable and click on the AUTOROUTE command. After that confirm OK in the following windows.';
//FInteractiveActions.Add(F_NormBase.Act_AutoTraceCable);
//aInteractiveNextStep.Enabled := true;
FInteractiveActions.Add(aInteractiveNextStep);
end;
end;
10: // Ïðîñìîòð îò÷åòà
begin
Pt := GetControlScreenPt(tbRepWizard, ctBottomMiddle);
Pt.y := Pt.y - 10;
Pt.x := Pt.x - 10;
HintMessage := 'Check out the deliverables in Reports section. Open Specification first and see the resources calculated for the project';
FInteractiveActions.Add(F_ProjMan.CreateFResourceReport.Act_ShowWizardReport);
end;
end;
end;
if (FInteractiveActions.Count > 0) or (FInteractiveControlHandler <> 0) then
begin
if FInteractiveActions.Count > 0 then
begin
FOldOnActionExecute := Application.OnActionExecute;
Application.OnActionExecute := InteractiveActionExecute;
end
else if FInteractiveControlHandler <> 0 then
begin
FInteractiveMsgOrig := Application.OnMessage;
Application.OnMessage := FInteractiveMsg;
end;
FInteractiveStepShowed := true;
//Sleep(100);
//Application.ProcessMessages;
ShowHintES(HintMessage, 0, @Pt);
end;
end;
end
else
// Åñëè Õèíò âèñèò - îïðåäåëÿåì ìîæíî ëè ïðååõîäèòü ê ñëåäóþùåìó øàãó
begin
if FInteractiveScene = 1 then
begin
case FInteractiveStep of
5: // Óñòàíîâêà 3-õ ðàá.ìåñò
begin
if IsWindowEnabled(Handle) then
begin
if GCadForm <> nil then
if Not GCadForm.PCad.IsDragging then
begin
SprComponentType := F_ProjMan.GetSpravochnik.GetComponentTypeObjBySysName(ctsnWorkPlace);
if SprComponentType <> nil then
begin
SCSComponents := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentsByType(SprComponentType.ComponentType.GUID, true);
TestCnt := SCSComponents.Count;
FreeAndNil(SCSComponents);
if TestCnt = 3 then
StepInteractive; // Âàæíî äî ýòîãî ñäåëàòü FreeAndNil(SCSComponents);, òàê êàê â StepInteractive åñòü Application.ProcessMessages
end;
end;
end;
end;
8: // Ïðîêëàäêà òðàññ
if GCadForm.PCad.ToolInfo = 'TSelected' then
begin
// Ïðîâîäèì ñèìóëÿöèþ àâòîñîçäàíèÿ òðàññ, äëÿ ïðîâåðêè åñòü ëè ÷òî ñ ÷åì ñîåäèíÿòü
TestCnt := AutoCreateTraces(true, true, true);
if TestCnt = 0 then
StepInteractive;
end;
end;
end;
end;
finally //11.05.2013
TTimer(Sender).OnTimer := SavedHandler; //11.05.2013
end; //11.05.2013
end;
end;
procedure TFSCS_Main.aInteractiveNextStepExecute(Sender: TObject);
begin
aInteractiveNextStep.Enabled := false;
end;
procedure TFSCS_Main.aInteractiveStopExecute(Sender: TObject);
begin
TimerInteractive.Enabled := false;
FInteractiveStep := 0;
if FInteractiveStepShowed then
begin
// Åñëè íå âîñòàíîâëåíû, òî âîññòàíîâèòü ïðåæíèå îáðàáîò÷èêè - íà ñëó÷àé åñëè ïðåäûäóùèå øàãè âûïîëíåíû íå âñå è çàïóùåíî ïîâòîðíî
if Assigned(FInteractiveMsgOrig) then
begin
Application.OnMessage := FInteractiveMsgOrig;
FInteractiveMsgOrig := nil;
end;
if Assigned(FOldOnActionExecute) then
begin
Application.OnActionExecute := FOldOnActionExecute;
FOldOnActionExecute := nil;
end;
end;
tbInteractive.Visible := false;
tbCADToolsExpert.Left := 11; // Tolik 02/12/2022 --
aInteractiveNextStep.Enabled := false;
aInteractiveStop.Enabled := false;
if IsVisibleHintES then
HideHintES;
end;
procedure TFSCS_Main.pnHintBarHotSpotClick(Sender: TObject);
begin
//pnHintBarPaint(Self);
pnHintBar.Height := pnHintBar.Height + 1;
pnHintBar.Height := pnHintBar.Height - 1;
end;
procedure TFSCS_Main.pnHintBarPaint(Sender: TObject);
var
Bnd: TRect;
begin
Bnd := pnHintBar.BoundsRect;
Bnd.Right := Bnd.Right - 10;
Bnd.Bottom := Bnd.Bottom - 10;
//DrawDropShadow( pnHintBar.Canvas, Bnd, 6);
end;
procedure TFSCS_Main.pmListPopup(Sender: TObject);
var i, j: Integer;
HasDoors, HasWindows: Boolean;
procedure InsertActToPopupMenu(APopupMenu: TPopupMenu; AIndex: Integer; AAction: TAction);
var pmnuItem: TMenuItem;
begin
if Not Assigned(APopupMenu) then
Exit; ///// EXIT /////
pmnuItem := TMenuItem.Create(APopupMenu);
pmnuItem.Action := AAction;
if Not Assigned(AAction) then
pmnuItem.Caption := '-';
APopupMenu.Items.Insert(AIndex, pmnuItem);
if Assigned(AAction) then
begin
APopupMenu.Items[AIndex].Caption := AAction.Caption;
APopupMenu.Items[AIndex].ImageIndex := AAction.ImageIndex;
end;
end;
begin
//F_ProjMan.Act_CopyCurrList.Visible := true;
//F_ProjMan.Act_CopyCurrListWithoutCompons.Visible := true;
//Tolik 16/06/2021 -- ýòî ïðèâîäèò ê ìåðöàíèþ ìåíþ íà êàäå ... ïåðåíåñåíî â TF_CAD.FormCADPopupMenu
{
if PmList.Items[1].Action <> F_ProjMan.Act_CopyCurrListWithoutCompons then
begin
InsertActToPopupMenu(PmList, 1, F_ProjMan.Act_CopyCurrList);
InsertActToPopupMenu(PmList, 1, F_ProjMan.Act_CopyCurrListWithoutCompons);
PmList.Items[1].ImageIndex := 209;
PmList.Items[2].ImageIndex := 209;
end;
}
FSCS_Main.aSetAllListDoorsHeight.Visible := False;
FSCS_Main.aSetAllListWndHeight.Visible := False;
FSCS_Main.aSetAllListDoorsPlacementHeight.Visible := False;
FSCS_Main.aSetAllListWndPlacement.Visible := False;
//Tolik 06/09/218 -- äëÿ àðõèòåêòóðíîãî ïðîåêòèðîâàíèÿ
{$if Defined (ES_GRAPH_SC)} // -- ãðàôìîäóëü
{$else} // ÑÊÑ
if GCadForm.CurrentLayer = 8 then
begin
if GCadForm.FActiveNet <> nil then
begin
HasDoors := False;
HasWindows :=False;
for i := 0 to GCadForm.FActiveNet.Paths.Count - 1 do
begin
for j := 0 to TNetPath(GCadForm.FActiveNet.Paths[i]).Doors.Count - 1 do
begin
if TNetDoor(TNetPath(GCadForm.FActiveNet.Paths[i]).Doors[j]).DoorObjType = dotDoor then
HasDoors := True
else
if TNetDoor(TNetPath(GCadForm.FActiveNet.Paths[i]).Doors[j]).DoorObjType = dotWindow then
HasWindows := True
end;
end;
if HasDoors then
begin
FSCS_Main.aSetAllListDoorsHeight.Visible := True;
FSCS_Main.aSetAllListDoorsPlacementHeight.Visible := True;
end;
if HasWindows then
begin
FSCS_Main.aSetAllListWndHeight.Visible := True;
FSCS_Main.aSetAllListWndPlacement.Visible := True;
end;
end;
end;
{$ifEnd}
//
end;
procedure TFSCS_Main.aExportDWGExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
SaveDXFFile(GCadForm.PCad, cExport_Mes2, cImport_Mes12_2, '*.dwg');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aSaveRevisionExecute(Sender: TObject);
begin
F_ProjMan.SaveProjectRevision;
end;
procedure TFSCS_Main.aViewRevsExecute(Sender: TObject);
begin
F_ProjMan.CreateFProjectRev.Execute;
end;
procedure TFSCS_Main.aProjectScheduleExecute(Sender: TObject);
begin
if Assigned(F_ProjMan.GSCSBase) and Assigned(F_ProjMan.GSCSBase.CurrProject) and F_ProjMan.GSCSBase.CurrProject.Active then
F_ProjMan.CreateFNormsComplete.Execute(F_ProjMan.GSCSBase.CurrProject, true, true, true)
else
F_ProjMan.CreateFNormsComplete.Execute(F_ProjMan.GetActualSelectedCatalog, true, true, true);
end;
procedure TFSCS_Main.aBillWorkExecute(Sender: TObject);
begin
CheckCloseReportForm;//Tolik 15/02/2022 --
F_ProjMan.CreateFNormsGroups.Execute(F_ProjMan.GetActualSelectedCatalog, true, true, true);
end;
procedure TFSCS_Main.aShowCableRuleClick(Sender: TObject);
begin
F_ProjMan.Act_CablesNoHitToCanalsExecute(Sender);
end;
procedure TFSCS_Main.aAutoDivExecute(Sender: TObject);
begin
ApplySectionSideForTraces(GCADForm);
end;
procedure TFSCS_Main.N70Click(Sender: TObject);
var WAReport : TF_ResourceReport;
ReportForm : TForm;
SCSCatalog : TSCSCatalog;
begin
// Åñëè ñòîèì íà ïðîåêòå èëè íà ëèñòå,
SCSCatalog := nil;
SCSCatalog := F_ProjMan.GetActualSelectedCatalog;
if ( (SCSCatalog.ItemType <> itNone) and (SCSCatalog.ItemType <> itProjMan) and (SCSCatalog.ItemType <> itDir) ) then
begin
if (SCSCatalog <> nil) then // and ((SCSCatalog.ItemType = itList) or (SCSCatalog.ItemType = itProject)) then
begin
//òî ìîæåì ïîêàçàòü îò÷åò
Application.CreateForm(TF_ChooseComponTypesForReport,F_ChooseComponTypesForReport);
if F_ChooseComponTypesForReport.Execute then;
end;
end;
end;
// Tolik 25/03/2021 -- ïîäêëþ÷èòü êàáåëåì -- äëÿ ýëåêòðèêè
procedure TFSCS_Main.Act_ConnectByCableAllExecute(Sender: TObject);
begin
GDropPcadTool := True;
GConnectEndPoints := False;
Act_ConnectByCable.Execute;
end;
procedure TFSCS_Main.Act_ConnectByCableExecute(Sender: TObject);
var i: integer;
SavedEndpoint: TFigure;
SelList: TList;
isEndPointShield, EndPointSameList, SavedFlag: Boolean;
TraceList: TList;
WasEndPoint: Boolean;
WasSaveForUndo: Boolean;
function GetAllTraceInCadToEndPoint(aServer, aWS: TConnectorObject): TList;
var
RaiserThisList: TConnectorObject;
RaiserOtherList: TConnectorObject;
CurrentWS: TConnectorObject;
CurrentServer: TConnectorObject;
AllTrace: TList;
i, j, k: integer;
CurGCadForm: TF_CAD;
isTrace: boolean;
RaiseType: TConnRaiseType;
ListOfLists: TIntList;
ListOfRaises: TList;
CurrentCAD: TF_CAD;
ConnFrom: TConnectorObject;
ConnTo: TConnectorObject;
PrevConn: TConnectorObject;
PrevCAD: TF_CAD;
ListOfAllTraces: TList;
EndPoint: TConnectorObject;
TracesLength: Double;
begin
ListOfRaises := Nil;
ListOfLists := nil;
Result := TList.Create;
try
CurrentServer := aServer;
CurrentWS := aWS;
BeginProgress('', -1, False);
//F_Progress.BringToFront;
AllTrace := nil;
ListOfAllTraces := nil;
TracesLength := 0;
GCadForm.FDeselectUpDown := True;
// â ïðåäåëàõ îäíîãî ëèñòà
if GListWithEndPoint = GCadForm then
begin
if ((GetKeyState(VK_SHIFT) and 128) = 128) then
ListOfAllTraces := GetAllTraceInCADByMarked_New1(CurrentServer, CurrentWS)
else
ListOfAllTraces := GetAllTraceInCADByMarked(CurrentServer, CurrentWS);
if ListOfAllTraces.Count > 0 then
begin
//if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then
GCadForm.FTracingListIndex := 0;
//Tolik 09/10/2017 --
// AllTrace := ListOfAllTraces[GCadForm.FTracingListIndex];
//AllTrace := TList.Create;
// ïðîâåðî÷êà -- íà âñÿêèé --
//if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and
// (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then
// AllTrace.Assign(TList(ListOfAllTraces[GCadForm.FTracingListIndex]), laCopy);
//
//FreeAndNil(AllTrace);
Result.Assign(ListOfAllTraces[0], laCopy);
end
else
// Tolik -- 08/02/2017 --
// GCadForm.FTracingList := TList.Create;
begin
if GCadForm.FTracingList = nil then
GCadForm.FTracingList := TList.Create
else
GCadForm.FTracingList.Clear;
end;
//
end
else
if GListWithEndPoint <> nil then
begin
RaiseType := crt_OnFloor; //#From Oleg# //14.09.2010
// äðóãîé ëèñò ñ ÊÎ
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GCadForm.FCADListID then
RaiseType := crt_BetweenFloorDown;
if GetUpperList(GListWithEndPoint.FCADListID, GCadForm.FCADListID) = GListWithEndPoint.FCADListID then
RaiseType := crt_BetweenFloorUp;
ListOfLists := GetSortedListIDsByBounds(GCadForm.FCADListID, GListWithEndPoint.FCADListID);
if ListOfLists.Count >= 2 then
begin
ListOfRaises := GetSortedListOfRaisesFromCurr(ListOfLists, RaiseType, CurrentWS, CurrentServer);
if CheckCanTracingBetweenFloor(ListOfLists, ListOfRaises) then
begin
PrevCAD := nil;
PrevConn := nil;
for i := 0 to ListOfLists.Count - 1 do
begin
CurrentCAD := GetListByID(ListOfLists[i]);
// âçÿòü íàéäåííûé ì-ý ñ-ï
if i < ListOfLists.Count - 1 then
begin
ConnTo := TConnectorObject(ListOfRaises[i]);
end
else
begin
ConnTo := CurrentServer;
end;
CurGCadForm := GCadForm;
GCadForm := CurrentCAD;
if i = 0 then
begin
ConnFrom := CurrentWS;
end
else
begin
ConnFrom := TConnectorObject(GetFigureByID(GCadForm, PrevConn.FID_ConnToPassage));
end;
//ListOfAllTraces := GetAllTraceInCADByMarked(ConnTo, ConnFrom{ConnFrom, ConnTo});
ListOfAllTraces := GetAllTraceInCADByMarked(ConnFrom, ConnTo);
if ListOfAllTraces.Count > 0 then
begin
//if GCadForm.FTracingListIndex > ListOfAllTraces.Count - 1 then
// GCadForm.FTracingListIndex := 0;
AllTrace := TList.Create;
// ïðîâåðî÷êà -- íà âñÿêèé --
//if ((GCadForm.FTracingListIndex < ListOfAllTraces.Count) and
// (TList(ListOfAllTraces[GCadForm.FTracingListIndex]) <> nil)) then
AllTrace.Assign(TList(ListOfAllTraces[0]), laCopy);
if AllTrace.Count > 0 then
begin
GCadForm := CurGCadForm;
PrevCAD := CurrentCAD;
PrevConn := ConnTo;
for j := 0 to AllTrace.Count - 1 do
Result.Add(AllTrace[j]);
end;
FreeAndNil(AllTrace);
//Result.Assign(TList(ListOfAllTraces[0]), laCopy);
end
else
begin
if GCadForm.FTracingList = nil then
GCadForm.FTracingList := TList.Create
else
GCadForm.FTracingList.Clear;
end;
end;
end;
end;
if ListOfLists <> nil then
FreeAndNil(ListOfLists);
if ListOfRaises <> nil then
FreeAndNil(ListOfRaises);
end;
if ListOfAllTraces <> nil then
begin
for i := 0 to ListOfAllTraces.Count - 1 do
begin
if TList(ListOfAllTraces[i]) <> nil then
TList(ListOfAllTraces[i]).Free;
end;
FreeAndNil(ListOfAllTraces);
end;
EndProgress;
RefreshCAD(GCadForm.PCad);
GCadForm.FDeselectUpDown := false;
except
on E: Exception do addExceptionToLogEx('USCS_Main.aSelectTracetoServerExecute', E.Message);
end;
if Result.Count = 0 then
FreeAndNil(Result);
end;
function CheckCanConnectByCable: Boolean;
var i: integer;
currFigure: TFigure;
figCatalog: TSCSCatalog;
FigCompon: TSCSComponent;
begin
Result := False;
if GEndPoint = nil then
begin
for i := 0 to SelList.Count - 1 do
begin
currFigure := TFigure(SelList[i]);
if currFigure is TConnectorObject then
begin
if TConnectorObject(currFigure).ConnectorType = ct_NB then
begin
figCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(currFigure.ID);
if FigCatalog <> nil then
begin
figCompon := FigCatalog.GetFirstComponent;
if FigCompon <> nil then
begin
if FigCompon.IDNetType = 3 then
if FigCompon.ComponentType.SysName = ctsnShield then
begin
Result := True;
// *UNDO*
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
WasSaveForUndo := True;
end;
SetFigureAsEndObject(GCadForm, currFigure);
break;
end;
end;
end;
end;
end;
end;
end;
//No shield Selected
if not Result then
Result := EndPointSameList;
if not Result then
begin
for i := 0 to SelList.Count - 1 do
begin
TraceList := GetAllTraceInCadToEndPoint(TConnectorObject(GEndPoint), TConnectorObject(TFigure(SelList[i])));
if TraceList <> nil then
begin
Result := True;
TraceList.Free;
break;
end;
end;
end;
end;
function checkEndPointShield: Boolean;
var SCSCatalog: TSCSCatalog;
SCSCompon: TSCSComponent;
begin
Result := False;
if GEndPoint <> nil then
begin
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GEndPoint.ID);
if SCSCatalog <> nil then
begin
SCSCompon := SCSCatalog.GetFirstComponent;
if SCSCompon <> nil then
if SCSCompon.ComponentType.SysName = ctsnSHIELD then
if SCSCompon.IDNetType = 3 then
Result := True;
end;
end;
end;
function CheckEndPointSameList: boolean;
begin
Result := False;
if GEndPoint <> nil then
begin
if GEndPoint.Owner <> nil then
if GEndPoint.Owner.Owner <> nil then
if TF_Cad(GEndPoint.Owner.Owner).FCADListID = GCadForm.FCADListID then
Result := True;
end;
end;
Procedure TraceByCable;
var Point: TPoint;
begin
aToolOrthoLine.Execute;
//GetCursorPos(Point);
//GCadForm.PCad.SimulateDown(GPopupPoint.X, GPopupPoint.Y);
//GCadForm.PCad.SimulateUp(GPopupPoint.X, GPopupPoint.Y);
GCadForm.PCad.SimulateDown(GPopupFigure.ap1.X, GPopupFigure.ap1.Y);
GCadForm.PCad.SimulateUp(GPopupFigure.ap1.X, GPopupFigure.ap1.Y);
GFigureTraceTo := nil;
{GPrevFigureSnap := nil;
GFigureSnap := GPopupFigure;}
if GSnapFiguresList.Count > 0 then
begin
if GSnapFiguresList[0] = nil then
GSnapFiguresList[0] := GPopupFigure;
end;
GPrevFigureSnap := GPopupFigure;
GFigureSnap := nil;
//GPrevFigureSnap := GPopupFigure;
//GFigureSnap := GPopupFigure;
//GPrevFigureSnap := TFigure(GCadForm.PCad.Selection[0]);
{GPrevFigureSnap := nil;
// GFigureSnap := TFigure(SelList[0]);//TFigure(GCadForm.PCad.Selection[0]);
GFigureSnap := GPopupFigure;}
//GPrevFigureSnap := GPopupFigure;
//GFigureSnap := nil;
//GPrevFigureSnap := nil;
//GFigureSnap := GPopupFigure;
end;
begin
WasEndPoint := GEndPoint <> nil;
WasSaveForUndo := False;
GFigureTraceTo := nil;
GFigureSnap := nil;
GPrevFigureSnap := nil;
GCadForm.cbManualCableTracingMode.Down := True;
GAutoAddCableAfterDragDrop := true;
if GCadForm.PCad.Selection.Count > 1 then
begin
SelList := TList.Create;
isEndPointShield := checkEndPointShield;
EndPointSameList := False;
//if isEndPointShield then
EndPointSameList := CheckEndPointSameList;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
if TFigure(GCadForm.FSCSFigures[i]).Selected then
if TFigure(GCadForm.FSCSFigures[i]) is TConnectorObject then
if TConnectorObject(GCadForm.FSCSFigures[i]).ConnectorType = ct_NB then
if SelList.IndexOf(TFigure(GCadForm.FSCSFigures[i])) = -1 then
SelList.Add(TFigure(GCadForm.FSCSFigures[i]));
end;
if EndPointSameList then
GEndPoint.Select;
if GCadForm.PCad.Selection.IndexOf(GEndPoint) = -1 then
GCadForm.PCad.Selection.Add(GEndPoint);
if CheckCanConnectByCable then
begin
Act_ConnectSelectedPoints.Execute;
for i := 0 to SelList.Count - 1 do
begin
TFigure(SelList[i]).Select;
if GCadForm.PCad.Selection.IndexOf(TFigure(SelList[i])) = -1 then
GCadForm.PCad.Selection.Add(TFigure(SelList[i]));
end;
SavedEndpoint := GEndPoint;
SavedFlag := GCallAutoTraceElectricMaster;
GCallAutoTraceElectricMaster := True;
try
TF_MAIN(F_NormBase).Act_AutoTraceByRayModeExecute(nil);
except
on E: Exception do;
end;
{if not GCallAutoTraceElectricMaster then
GCadForm.SCSUndoNormalList;}
GCallAutoTraceElectricMaster := SavedFlag;
if GEndPoint <> nil then
begin
if not WasEndPoint then
begin
TConnectorObject(GEndPoint).AsEndPoint := False;
GEndPoint := Nil;
GListWithEndPoint := Nil;
end;
end;
GCadForm.PCad.Refresh;
end
else
TraceByCable;
end
else // IF Only one Selected - Draw By Cable
TraceByCable;
if WasSaveForUndo then
GCadForm.FCanSaveForUndo := True;
GCadForm.PCad.DeselectAll(2);
end;
procedure TFSCS_Main.Act_ConnectByCableOnEndsExecute(Sender: TObject);
begin
GConnectEndPoints := True;
GDropPcadTool := True;
Act_ConnectByCable.Execute;
end;
//Tolik
// ñîåäèíèòü âûáðàííûå òî÷å÷íûå òðàññàìè
Procedure TFSCS_Main.Act_ConnectSelectedPointsExecute(Sender: TObject);
Var
i,j,k, currIndex: Integer;
FiguresList, FiguresPassedList, ThisPointFigures, BeforePointFigures: TList;
ListCad: TF_CAD;
ConnectedLine: TSCSComponent;
Figure1, Figure2, currFigure: Tfigure;
LineLength: double;
x,y,z : Double;
Trace: TOrtholine;
TraceList: TList;
DirectionUP: boolean;
ThisPointFiguresPassed: TList;
currLength: double;
isVerticalCreated: Boolean;
//Tolik -- 27/02/2017 --
UserQuotaReached_Message: String;
ObjCounter : Integer;
OldCadFigCounter: Integer;
GCadFlag: Boolean;
ConnectFigure1, ConnectFigure2: TConnectorObject;
//
Procedure FindAllNearestFigures(Figure: TFigure);
Var
i: Integer;
WasChanged: Boolean;
currFigure, tmpFigure: TConnectorObject;
Begin
ThisPointFigures.Clear;
//ôîðìèðóåì ñïèñîê
for i := 0 to FiguresList.Count - 1 do
begin
if TConnectorObject(Figure).ID <> TConnectorObject(FiguresList[i]).ID then
begin
if ( ((TConnectorObject(Figure).ActualPoints[1].x = TConnectorObject(FiguresList[i]).ActualPoints[1].x) and
(TConnectorObject(Figure).ActualPoints[1].y = TConnectorObject(FiguresList[i]).ActualPoints[1].y))
or
((abs(TConnectorObject(Figure).ActualPoints[1].x - TConnectorObject(FiguresList[i]).ActualPoints[1].x) < 3)
and
(abs(TConnectorObject(Figure).ActualPoints[1].y - TConnectorObject(FiguresList[i]).ActualPoints[1].y) < 3))
) then
ThisPointFigures.Add(FiguresList[i]);
end;
end;
ThisPointFigures.Add(Figure);
if ThisPointFigures.Count = 1 then
ThisPointFigures.Clear;
if ThisPointFigures.Count > 1 then
begin
// ñîðòèðóåì ïî âûñîòå ðàçìåùåíèÿ
WasChanged := true;
while WasChanged do
begin
WasChanged := false;
for i := 0 to ThisPointFigures.Count - 2 do
begin
if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] > TConnectorObject(ThisPointFigures[i+1]).ActualZOrder[1] then
begin
WasChanged := true;
currFigure := TConnectorObject(ThisPointFigures[i]);
ThisPointFigures[i] := ThisPointFigures[i+1];
ThisPointFigures[i+1] := currFigure;
end;
end;
end;
end;
End;
Procedure SortFigures(Figure: Tfigure);
Var currFigure: TFigure;
currIndex, i: integer;
WasChange: Boolean;
currLength: double;
Begin
WasChange := true;
while WasChange do
begin
WasChange := false;
currFigure := ThisPointFigures[0];
currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(currFigure).ActualPoints[1]);
// âåðõíèå
for i := 1 to ThisPointFigures.Count - 1 do
begin
if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] <> TConnectorObject(currFigure).ActualZOrder[1] then
break
else
begin
if currLength < GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]) then
begin
WasChange := true;
currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]);
currFigure := ThisPointFigures[i - 1];
ThisPointFigures[i - 1] := ThisPointFigures[i];
ThisPointFigures[i] := currFigure;
end;
end;
end;
end;
// íèæíèå
while WasChange do
begin
WasChange := false;
currFigure := ThisPointFigures[ThisPointFigures.Count - 1];
currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(currFigure).ActualPoints[1]);
for i := (ThisPointFigures.Count - 2) downto 0 do
begin
if TConnectorObject(ThisPointFigures[i]).ActualZOrder[1] <> TConnectorObject(currFigure).ActualZOrder[1] then
break
else
begin
if currLength < GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]) then
begin
WasChange := true;
currLength := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(ThisPointFigures[i]).ActualPoints[1]);
currFigure := ThisPointFigures[i + 1];
ThisPointFigures[i + 1] := ThisPointFigures[i];
ThisPointFigures[i] := currFigure;
end;
end;
end;
end;
End;
// âûñòàâëÿåò ôèãóðó â íà÷àëî èëè â êîíåö ñïèñêà
Procedure PointToZeroPosition(Figure: TFigure; var FigList: Tlist);
Var
currIndex: Integer;
Begin
if FigList.Count > 2 then
begin
if FigList.IndexOf(Figure) <> -1 then
begin
currIndex := FigList.IndexOf(Figure);
if ((currIndex <> 0) or (currIndex <> FigList.Count - 1)) then
begin
FigList.Delete(FigList.IndexOf(Figure));
if TConnectorObject(Figure).ActualZOrder[1] <= TConnectorObject(FigList[0]).ActualZOrder[1] then
FigList.Insert(0, Figure)
else
FigList.Add(Figure);
end;
end;
end;
End;
// èùåò áëèæàéøóþ òî÷êó ê òî÷å÷íîé ôèãóðå (èç âûáðàííûõ)
Function FindNearestFigure(Figure: TFigure): TFigure;
Var
Figure1_, Figure2_: TFigure;
Dist, Dist1: double;
LineLen : double;
currIndex: integer;
currFigure: TFigure;
Function FindNearest(Figure: TFigure; var Dist: double): TFigure;
Var
i: Integer;
LineLenght: double;
PointFigures1, PointFigures2: TList;
Begin
PointFigures1 := nil;
PointFigures2 := nil;
Dist := -1;
Result := nil;
// åñëè íà÷àëüíàÿ ôèãóðà îäíà
// if ThisPointFigures.Count = 0 then
begin
for i := 0 to FiguresList.Count - 1 do
begin
if FiguresPassedList.IndexOf(FiguresList[i]) = -1 then
begin
if TConnectorObject(Figure).ID <> TConnectorObject(FiguresList[i]).ID then
// if Figure <> FiguresList[i] then
begin
LineLenght := GetLineLenght(TConnectorObject(Figure).ActualPoints[1],TConnectorObject(FiguresList[i]).ActualPoints[1]);
if ((dist > LineLenght) or (dist = -1)) then
begin
dist := LineLenght;
Result := FiguresList[i];
if Dist = 0 then // ñèäÿò â îäíîé òî÷êå
break;
end;
end;
end;
end;
end
End;
Begin
Figure1_ := nil; // Tolik 05/08/2021 --
Figure2_ := nil; // Tolik 05/08/2021 --
if BeforePointFigures.Count = 0 then
Result := FindNearest(Figure1, Dist)
else
begin
Figure1_ := FindNearest(BeforePointFigures[0], Dist);
Figure2_ := FindNearest(BeforePointFigures[BeforePointFigures.Count - 1], Dist1);
Result := Figure1_;
if (Figure2_ <> nil) and (Result <> nil) then // Tolik 05/08/2021 --
begin
if ((TConnectorObject(Result).ID <> TConnectorObject(Figure2_).ID) and (Dist1 < Dist)) then
Result := Figure2_;
end
else
begin // Tolik 05/08/2021 --
if Result = nil then
begin
if Figure2_ <> nil then
Result := Figure2_;
end;
end;
end;
// îïðåäåëÿåì áëèæàéøèå â äàííîé òî÷êå (åñëè åñòü â ïðåäåëàõ äîïóñòèìîãî)
if Result = nil then
begin
ThisPointFigures.Clear;
exit;
end;
FindAllNearestFigures(Result);
// îïðåäåëÿåì áëèæàéøèå òî÷êè äëÿ ïîäêëþ÷åíèÿ òðàññîé (ñàìûé êîðîòêèé ïóòü)
// 1. Åñëè ïîäêëþ÷àåì äâå "êó÷êè"
if (BeforePointFigures.Count > 0) and (ThisPointFigures.Count > 0) then
begin
Figure1 := BeforePointFigures[0];
Figure2 := ThisPointFigures[0];
// ñàìûé êîðîòêèé ïóòü îò íèçà ïåðâîé "êó÷êè" äî âòîðîé (èç äâóõ - ê íèçó è âåðõó âòîðîé "êó÷êè")
LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(ThisPointFigures[0]).ActualPoints[1]);
Dist := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1]);
if LineLen > Dist then
begin
Result := ThisPointFigures[ThisPointFigures.Count - 1];
PointToZeroPosition(Result, ThisPointFigures);
end
else
Dist := LineLen;
// ñìîòðèì ââåðõó
LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(ThisPointFigures[0]).ActualPoints[1]);
Dist1 := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1]);
if ((LineLen < Dist) and (LineLen <= Dist1)) then
begin
Figure1 := BeforePointFigures[BeforePointFigures.Count - 1];
Result := ThisPointFigures[0];
PointToZeroPosition(Result, ThisPointFigures);
end
else
begin
if ((Dist1 < Dist) and (Dist1 < LineLen)) then
begin
Figure1 := BeforePointFigures[BeforePointFigures.Count - 1];
Result := ThisPointFigures[ThisPointFigures.Count - 1];
PointToZeroPosition(Result, ThisPointFigures);
end;
end;
end;
// 2. Âïåðåäè "êó÷êà", ïîäêëþ÷àåìñÿ ê òî÷å÷íîìó
if ((BeforePointFigures.Count > 0) and (ThisPointFigures.Count = 0)) then
begin
Figure1 := BeforePointFigures[0];
if Figure2 <> nil then // Tolik 05/08/2021 --
begin
LineLen := GetLineLenght(TConnectorObject(BeforePointFigures[0]).ActualPoints[1],TConnectorObject(Figure2).ActualPoints[1]);
Dist := GetLineLenght(TConnectorObject(BeforePointFigures[BeforePointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure2).ActualPoints[1]);
if LineLen > Dist then
Figure1 := BeforePointFigures[BeforePointFigures.Count - 1];
end;
end;
// 3. Îäèí òî÷å÷íûé ïîäêëþ÷àåì ê "êó÷êå"
if ((BeforePointFigures.Count = 0) and (ThisPointFigures.Count > 0)) then
begin
Result := ThisPointFigures[0];
LineLen := GetLineLenght(TConnectorObject(ThisPointFigures[0]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]);
Dist := GetLineLenght(TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]);
if LineLen > Dist then
Result := ThisPointFigures[ThisPointFigures.Count - 1];
PointToZeroPosition(Result, ThisPointFigures);
end;
End;
// âîçâðàùàåò íà÷àëüíóþ òî÷å÷íóþ ôèãóðó èç âûáðàííûõ (áëèæå âñåãî ê íà÷àëó êîîðäèíàò)
Function FindBeginFigure : TFigure;
Var i : Integer;
Begin
Result := FiguresList[0];
for i := 1 to FiguresList.Count - 1 do
begin
if sqrt(sqr(TConnectorObject(Result).ActualPoints[1].x)+ sqr(TConnectorObject(Result).ActualPoints[1].y)+
sqr(TConnectorObject(Result).ActualZOrder[1]))
>
sqrt(sqr(TConnectorObject(FiguresList[i]).ActualPoints[1].x)+ sqr(TConnectorObject(FiguresList[i]).ActualPoints[1].y)+
sqr(TConnectorObject(FiguresList[i]).ActualZOrder[1])) then
Result := FiguresList[i];
end;
End;
{ // Äëÿ äâóõ òî÷å÷íûõ ïðîâåðÿåì, íå ñèäÿò ëè â îäíîé òî÷êå (x,y - îäèíàêîâûå)
Function CheckTheSamePoint(Figure1, Figure2: TFigure): Boolean;
Begin
Result := false;
if (TConnectorObject(Figure1).ActualPoints[1].x = TConnectorObject(Figure2).ActualPoints[1].x) and
(TConnectorObject(Figure1).ActualPoints[1].y = TConnectorObject(Figure2).ActualPoints[1].y)
then
Result := true;
End;}
//âåðòèêàëüíàÿ òðàññà ìåæäó äâóìÿ òî÷å÷íûìè
Procedure CreateVertTraceBetweenTwoPoints(Figure1, Figure2: TConnectorObject);
Var
VertOnFigure: TConnectorObject;
VertHeight: Double;
Begin
try
VertOnFigure := Figure1;
if Figure2 <> nil then
begin
VertHeight := TConnectorObject(Figure2).ActualZOrder[1];//(abs(TConnectorObject(Figure1).ActualZOrder[1] - TConnectorObject(Figure2).ActualZOrder[1]));
VertHeight := UOMToMetre(VertHeight);
{ if VertHeight > GCadForm.FRoomHeight then
VertHeight := GCadForm.FRoomHeight;}
CreateVerticalOnTwoPointObjects(TConnectorObject(Figure1), TConnectorObject(Figure2), VertHeight);
// CreateVerticalOnPointObject(VertOnFigure, Figure2, VertHeight);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
isVerticalCreated := True;
end
else
GCadForm.mProtocol.Lines.Add(cMain_Mes128);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.CreateVertTraceBetweenTwoPoints', E.Message);
end;
End;
Function CheckIsRaiseOrVLine(aConn: TConnectorObject): Boolean;
var i, j: Integer;
Joinedconn: TConnectorObject;
begin
Result := False;
if aConn.ConnectorType = ct_Clear then
begin
for i := 0 to aConn.JoinedOrthoLinesList.Count - 1 do
begin
if (TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsRaiseUpDown or
TOrthoLine(aConn.JoinedOrthoLinesList[i]).FIsVertical) then
begin
Result := True;
exit;
end;
end;
end
else
begin
for i := 0 to aConn.JoinedconnectorsList.Count - 1 do
begin
JoinedConn := TconnectorObject(aConn.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedOrthoLinesList.Count - 1 do
begin
if (TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]).FIsVertical or
TOrthoLine(JoinedConn.JoinedOrthoLinesList[j]).FIsRaiseUpDown) then
begin
Result := True;
exit;
end;
end;
end;
end;
end;
Function DrawOneTrace(Figure1, Figure2: TFigure; AddResult: Boolean = true): TFigure;
var Catalog1, Catalog2: TSCSCatalog;
CanNotDrawTraceOnConn1, CanNotDrawTraceOnConn2: Boolean;
ClearConn: TConnectorObject;
LHandle: integer;
RaiseLine: TOrthoLine;
i, j: Integer;
Old_Flag: Boolean;
Begin
Result := nil;
if (Figure1 = nil) or (Figure2 = nil) then
exit;
// ïðîâåðÿåì, íåò ëè ìåæäó íèìè òðàññû
TraceList := GetAllTraceInCAD(Figure1, Figure2);
// åñëè òðàññû íåò, òî íàðèñóåì
if TraceList = nil then
begin
//08/11/2019 -- ïðîâåðÿåì íà èñïîëüçîâàíèå âåðòèêàëüíûõ òðàññ
if GUseVerticalTraces = False then
begin
// åñëè çàïðåùåíû âåðòèêàëüíûå òðàññû è õîòü íà îäíîì èç íèõ åñòü ðàéç -- ìîæåò
// áûòü òðàáëà, íóæíî ïðîâåðèòü ïîïàäàíèå
// ÎÁßÇÀÒÅËÜÍÎ áåðåì âî âíèìàíèå, ÷òî òðàññû ñîçäàþòñÿ íà óðîâíå ñîçäàíèÿ òðàññ (â íàñòðîéêàõ Êàäà)
CanNotDrawTraceOnConn1 := CheckCanDrawOneTrace(TConnectorObject(Figure1));
CanNotDrawTraceOnConn2 := CheckCanDrawOneTrace(TConnectorObject(Figure2));
//åñëè íåëüçÿ ïðîëîæèòü òðàññó ....
if (CanNotDrawTraceOnConn1 or CanNotDrawTraceOnConn2) then
begin
try
old_Flag := GCadForm.FAutoPosTraceBetweenRM;
GCadForm.FAutoPosTraceBetweenRM := True;
Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True);
GCadForm.FAutoPosTraceBetweenRM := Old_Flag;
except
on E: Exception do
GCadForm.FAutoPosTraceBetweenRM := Old_Flag;
end;
(*if CanNotDrawTraceOnConn1 then
begin
if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);
Result := Figure2;
end
else
begin
if FiguresPassedList.IndexOf(Figure2) = -1 then
FiguresPassedList.Add(Figure2);
Result := Figure1;
end;
// ... çàíåñòè â ïðîòîêîë, ÷òî òðàññà ìåæäó ýòèìè îáúåêòàìè íå áûëà ïðîâåäåíà, ïî ïðè÷èíå òîãî, ÷òî
//â íàñòðîéêàõ ïðîãðàììû âûêëþ÷åíà îïöèÿ èñïîëüçîâàíèÿ âåðòèêàëüíûõ òðàññ
Catalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure1.ID);
Catalog2 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure2.ID);
if Catalog1 <> nil then
if Catalog2 <> nil then
GCadForm.mProtocol.Lines.Add(CantConnMess1 + Catalog1.GetNameForVisible(false) + CantConnMess2 + Catalog2.GetNameForVisible(false) + CantConnMess4);
*)
Result := Figure2;
exit;
end;
end;
// ðèñóåì òðàññó
// åñëè íå ñèäÿò â îäíîé òî÷êå
if not CheckTheSamePoint(Figure1, Figure2) then
begin
//Trace := CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True, False)
Trace := CreateTraceByPoints(GCadForm.PCad, TConnectorObject(Figure1).AP1, TConnectorObject(Figure2).AP2);
if TConnectorObject(Figure1).ConnectorType = ct_Clear then
CheckingSnapConnectorToConnector(TConnectorObject(Figure1), TConnectorObject(Trace.JoinConnector1))
else
CheckingSnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector1), TConnectorObject(Figure1), False);
if TConnectorObject(Figure2).ConnectorType = ct_Clear then
CheckingSnapConnectorToConnector(TConnectorObject(Figure2), TConnectorObject(Trace.JoinConnector2))
else
CheckingSnapConnectorToPointObject(TConnectorObject(Trace.JoinConnector2), TConnectorObject(Figure2), False);
end
else
begin
// åñëè òî÷å÷íûå ñèäÿò â îäíîé òî÷êå,
// ðàçðåøåíî èñïîëüçîâàíèå âåðòèêàëüíûõ ëèíèé è âûñîòà ðàçìåùåíèÿ ðàçíàÿ
if ( (TConnectorObject(Figure1).ActualZOrder[1] <> TConnectorObject(Figure2).ActualZOrder[1]) and
(GUseVerticalTraces = true)
) then
// ðèñóåì âåðòèêàëüíóþ òðàññó
CreateVertTraceBetweenTwoPoints(TConnectorObject(Figure1),TConnectorObject(Figure2))
else
begin
// íå ñèäÿò òî÷íî â îäíîé òî÷êå, íå ðàçðåøåíî èñïîëüçîâàíèå âåðòèêàëüíûõ ëèíèé(èëè ðàçðåøåíî,
// íî âûñîòà ðàçìåùåíèÿ îáúåêòîâ - îäèíàêîâàÿ èëè âêëþ÷åíà îïöèÿ, ðàçðåøàþùàÿ ðàçìåùåíèå òðàññû
// íà âûñîòå ðàáî÷èõ ìåñò) - ðèñóåì ïðîñòóþ òðàññó
if (CompareValue(TConnectorObject(Figure1).ActualZOrder[1], TConnectorObject(Figure2).ActualZOrder[1]) = 0) then
Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True)
else
// ðàéç
begin
if (CheckIsRaiseOrVLine(TConnectorObject(Figure1)) or CheckIsRaiseOrVLine(TConnectorObject(Figure2))) then
begin
try
old_Flag := GCadForm.FAutoPosTraceBetweenRM;
GCadForm.FAutoPosTraceBetweenRM := True;
Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True);
GCadForm.FAutoPosTraceBetweenRM := Old_Flag;
except
on E: Exception do
GCadForm.FAutoPosTraceBetweenRM := Old_Flag;
end;
//Trace:= CreateTraceByConnectors(GCADForm, TConnectorObject(Figure1), TConnectorObject(Figure2), False, True)
end
else
begin
LHandle := GCadForm.PCad.GetLayerHandle(2);
CreateRaiseOnPointObjectNew(TConnectorObject(Figure1), TConnectorObject(Figure2).ActualZOrder[1]);
RaiseLine := Nil;
ClearConn := Nil;
for i := 0 to TConnectorObject(Figure1).JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList[j]).FIsRaiseUpDown then
begin
RaiseLine := TOrthoLine(TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).JoinedOrtholinesList[j]);
if RaiseLine.JoinConnector1.ID = TConnectorObject(TConnectorObject(Figure1).JoinedConnectorsList[i]).Id then
ClearConn := TConnectorObject(RaiseLine.JoinConnector2)
else
ClearConn := TconnectorObject(RaiseLine.JoinConnector1);
end;
end;
end;
if ClearConn <> nil then
CheckingSnapConnectorToPointObject(ClearConn, TConnectorObject(Figure2), False);
end;
end;
end;
end;
end
else
begin
{if TraceList.count > 0 then
begin
for i := 0 to TraceList.count - 1 do
begin
TList(TraceList[i]).Free;
TraceList[i] := Nil;
end;
end;}
// 03/08/2018 --
Catalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure1.ID);
Catalog2 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure2.ID);
if Catalog1 <> nil then
if Catalog2 <> nil then
GCadForm.mProtocol.Lines.Add(CantConnMess1 + Catalog1.GetNameForVisible(false) + CantConnMess2 + Catalog2.GetNameForVisible(false) + CantConnMess3);
//
FreeAndNil(TraceList);
end;
if addResult then
begin
if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);
Result := Figure2;
end;
End;
// 25/04/2016 -- ïðåîáðàçîâàíèå Ñ/Ï â âåðòèêàëü
procedure CheckConvertRaiseToVertLine(aList: TList);
var i, j, k: Integer;
Conn, ConnectedConn: TConnectorObject;
Figure: TFigure;
RaiseLine, vLine: TOrthoLine;
CanBreak: Boolean;
begin
CanBreak := False;
for i := 0 to aList.Count - 1 do
begin
Figure := TFigure(aList[i]);
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
Conn := TConnectorObject(Figure);
RaiseLine := Nil;
vLine := Nil;
if Conn.ConnectorType = ct_NB then
begin
for j := 0 to Conn.JoinedConnectorsList.Count - 1 do
begin
ConnectedConn := TConnectorObject(Conn.JoinedConnectorsList[j]);
for k := 0 to ConnectedConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]).FIsRaiseUpDown then
RaiseLine := TOrthoLine(ConnectedConn.JoinedOrtholinesList[k])
else
if TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]).FIsVertical then
vLine := TOrthoLine(ConnectedConn.JoinedOrtholinesList[k]);
end;
end;
end
else
if Conn.ConnectorType = ct_Clear then
begin
for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsRaiseUpDown then
RaiseLine := TOrthoLine(Conn.JoinedOrtholinesList[j])
else
if TOrthoLine(Conn.JoinedOrtholinesList[j]).FIsVertical then
vLine := TOrthoLine(Conn.JoinedOrtholinesList[j]);
end;
end;
end;
if RaiseLine <> nil then
if vLine <> nil then
ConvertRaiseToVertical(RaiseLine);
end;
end;
// ïîïûòàòüñÿ íàéòè ïîäõîäÿùèé êîííåêòîð äëÿ ñîåäèíåíèÿ òðàññàìè
function GetPointToConnectFromList(aList: TList; aConn: TConnectorObject): TConnectorObject;
var i: Integer;
PointList: TList;
NextConn: TConnectorObject;
Procedure GetLinesFromPoint(aPoint: TConnectorObject; var aRaiseLine, avLine1, avLine2: TOrthoLine);
var JoinedConn: TConnectorObject;
j, k: Integer;
begin
if aPoint.ConnectorType = ct_NB then
begin
JoinedConn := nil;
for j := 0 to aPoint.JoinedConnectorsList.Count - 1 do
begin
JoinedConn := TConnectorObject(aPoint.JoinedConnectorsList[j]);
for k := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).FIsRaiseUpDown then
aRaiseLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[k])
else
if TOrthoLine(JoinedConn.JoinedOrtholinesList[k]).FIsVertical then
begin
if avLine1 = nil then
avLine1 := TOrthoLine(JoinedConn.JoinedOrtholinesList[k])
else
avLine2 := TOrthoLine(JoinedConn.JoinedOrtholinesList[k]);
end;
end;
end;
end
else
if aPoint.ConnectorType = ct_Clear then
begin
for j := 0 to aPoint.JoinedOrtholinesList.Count - 1 do
begin
if TOrthoLine(aPoint.JoinedOrtholinesList[j]).FIsRaiseUpDown then
aRaiseLine := TOrthoLine(aPoint.JoinedOrtholinesList[j])
else
if TOrthoLine(aPoint.JoinedOrtholinesList[j]).FIsVertical then
begin
if avLine1 = nil then
avLine1 := TOrthoLine(aPoint.JoinedOrtholinesList[j])
else
avLine2 := TOrthoLine(aPoint.JoinedOrtholinesList[j]);
end;
end;
end;
end;
Procedure GetConnList(aConn: TConnectorObject);
var i: Integer;
RaiseLine, vLine1, vLine2: TOrthoLine;
currConn: TConnectorObject;
begin
RaiseLine := nil;
vLine1 := Nil;
vLine2 := Nil;
if PointList.IndexOf(aConn) = -1 then
begin
PointList.Add(aConn);
GetLinesFromPoint(aConn, RaiseLine, vLine1, vLine2);
if RaiseLine <> nil then
begin
CurrConn := TConnectorObject(RaiseLine.JoinConnector1);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
CurrConn := TConnectorObject(RaiseLine.JoinConnector2);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
end;
if vLine1 <> nil then
begin
CurrConn := TConnectorObject(vLine1.JoinConnector1);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
CurrConn := TConnectorObject(vLine1.JoinConnector2);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
end;
if vLine2 <> nil then
begin
CurrConn := TConnectorObject(vLine2.JoinConnector1);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
CurrConn := TConnectorObject(vLine2.JoinConnector2);
if currConn <> nil then
begin
if CurrConn.JoinedConnectorsList.Count > 0 then
CurrConn := TConnectorObject(CurrConn.JoinedConnectorsList[0]);
if PointList.IndexOf(currConn) = -1 then
begin
GetConnList(currConn);
end;
end;
end;
end;
end;
Procedure SortPointList(aList: TList);
Var i: Integer;
CanSort: Boolean;
currConn: TConnectorObject;
begin
CanSort := true;
while CanSort do
begin
CanSort := False;
for i := 0 to aList.Count - 2 do
begin
if CompareValue(ABS(TConnectorObject(aList[i]).ActualZOrder[1] - GCadForm.FLineHeight),
ABS(TConnectorObject(aList[i+1]).ActualZOrder[1] - GCadForm.FLineHeight)) = 1 then
begin
currConn := TConnectorObject(aList[i]);
aList[i] := AList[i + 1];
aList[i + 1] := currConn;
CanSort := True;
end;
end;
end;
end;
begin
// åñëè êîííåêòîð - íà âûñîòå àâòîìàòè÷åñêîãî ðàñïîëîæåíèÿ òðàññ -- áåðåì åãî
Result := nil;
PointList := TList.Create;
if aList <> nil then
begin
//îïðåäåëÿåì âñå âîçìîæíûå êîííåêòîðû â ýòîé òî÷êå äëÿ êîííåêòà
for i := 0 to aList.Count - 1 do
begin
NextConn := TConnectorObject(aList[i]);
if NextConn.ConnectorType = ct_Clear then
if NextConn.JoinedConnectorsList.Count > 0 then
NextConn := TConnectorObject(NextConn.JoinedConnectorsList[0]);
if PointList.IndexOf(NextConn) = -1 then
GetConnList(NextConn);
end;
end
else
GetConnList(aConn);
// ïðîâåðÿåì åñëè åñòü êîííåêòîð(ïî âûñîòå) - óðà
for i := 0 to PointList.Count - 1 do
begin
if CompareValue(TConnectorObject(PointList[i]).ActualZOrder[1], GCadForm.FLineHeight) = 0 then
begin
Result := TConnectorObject(PointList[i]);
break;
end;
end;
//íà êîííåêòîðû íå ïîïàäåì
if Result = nil then
begin
SortPointList(PointList); // ñîðòèðîâêà ñïèñêà ïî ðàññòîÿíèþ îò âûñîòû ðàñïîëîæåíèÿ òðàññ
//if (GCadForm.FAutoPosTraceBetweenRM or GUseVerticalTraces) then // åñëè âêëþ÷åíà îïöèÿ ðàñïîëàãàòü òðàññó íà âûñîòå ðàáî÷èõ ìåñò
// èëè äîïóñòèìî èñïîëüçîâàíèå âåðòèêàëüíûõ òðàññ --
begin
for i := 0 to PointList.Count - 1 do
begin
if TConnectorObject(PointList[i]).ConnectorType = ct_NB then
begin
Result := TConnectorObject(PointList[i]); // áëèæàéøèé ê âûñîòå ðàñïîëîæåíèÿ(àâòîñîçäàíèÿ) òðàññ íà Êàäå
break;
end;
end;
end;
end;
PointList.free;
end;
Begin
if GDropComponent <> nil then
begin
if isCableComponent(GDropComponent) then
begin
if GEndPoint <> nil then
begin
if GCadForm.PCad.Selection.IndexOf(GEndPoint) = -1 then
begin
GEndPoint.Selected := True;
GCadForm.PCad.Selection.Add(GEndPoint);
end;
end;
end;
end;
GCadFlag := GCanRefreshCad;
ProcessMessagesEx;
BeginProgress;
Figure1 := nil; // Tolik 05/08/2021 --
Figure2 := nil; // Tolik 05/08/2021 --
try
if GUserOBjectsQuotaLimit_Message_Counter >= 3 then
Exit;
UserQuotaReached_Message := '';
ObjCounter := 0;
OldCadFigCounter := GCadForm.FSCSFigures.Count;
// åñëè âûáðàíî áîëåå 2-õ òî÷å÷íûõ íà êàäå
if GCADForm.PCad.Selection.Count > 1 then
begin
// UNDO
if GCadForm.FCanSaveForUndo then
begin
GCadForm.SaveForUndo(uat_None, True, False);
GCadForm.FCanSaveForUndo := False;
end;
UserQuotaReached_Message := '';
UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(1), cMess_Quota);
if UserQuotaReached_Message = '' then
begin
// Tolik -- 28/02/2017 -- ÷òîáû íå âûëåç PCadGuiEVENT
GCanRefreshCad := False;
//
FiguresPassedList := TList.Create;
FiguresList := TList.Create;
ThisPointFigures := TList.Create;
ThisPointFiguresPassed := TList.Create;
BeforePointFigures := TList.Create;
isVerticalCreated := False; // åñëè ñîçäàíà âåðòèêàëü
//ñîáèðàåì âûáðàííûå ôèãóðû â ñïèñîê
for i := 0 to GCADForm.PCad.Selection.Count - 1 do
begin
currFigure := TFigure(GCADForm.PCad.Selection[i]);
if CheckFigureByClassName(currFigure, cTConnectorObject) then
// åñëè òî÷å÷íûé - íå ïóñòîé êîííåêòîð(ïðîñòî ïóñòîé, êîíå÷íûé êîííåòîð òðàññû è ò.ï.) èëè íå êîííåêòîð ìàãèñòðàëè,
if (TConnectorObject(currFigure).ConnectorType = ct_NB) and (TConnectorObject(currFigure).FTrunkName = '') then
// òî äîáàâëÿåì â ñïèñîê òî÷å÷íûõ
FiguresList.Add(GCADForm.PCad.Selection[i]);
end;
// Åñëè òî÷êè âñåãî äâå, òî íåò íè÷åãî ïðîùå
if FiguresList.Count = 2 then
begin
// ïåðâàÿ
Figure1 := FiguresList[0];
// âòîðàÿ
Figure2 := FiguresList[1];
// òðàññà
Figure2 := DrawOneTrace(Figure1, Figure2);
end;
// Åñëè òî÷åê áîëüøå äâóõ
If FiguresList.Count > 2 then
begin
try
// èùåì òî÷êó áëèæå âñåãî ê íà÷àëó êîîðäèíàò (îò íåå íà÷íåì)
Figure1 := FindBeginFigure;
ThisPointFigures.Clear; // íà âñÿêèé
// âñå ïðèáëèæåííûå ê íåé èç âûáðàííûõ
FindAllNearestFigures(Figure1);
// åñëè â ýòîé òî÷êå åñòü åùå òî÷å÷íûå (èëè ïðèáëèçèòåëüíî â îäíîé)
// ïîäêëþ÷àåì èõ ìåæäó ñîáîé ñíèçó ââåðõ ïîäðÿä
if ThisPointFigures.Count <> 0 then
begin
Figure1 := ThisPointFigures[0];
for i := 1 to ThisPointFigures.Count - 1 do
begin
Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]);
if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);
end;
Figure1 := ThisPointFigures[0];
end;
while FiguresPassedList.Count < FiguresList.Count do
begin
if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);
BeforePointFigures.Clear;
// åñëè èäåì îò êó÷êè, òî ñîõðàíèì åå
if ThisPointFigures.Count > 0 then
begin
for i := 0 to ThisPointFigures.Count - 1 do
BeforePointFigures.Add(ThisPointFigures[i]);
end;
Figure2 := FindNearestFigure(Figure1); // áëèæàéøàÿ òî÷êà ê òåêóùåé, íà êîòîðîé ñòîèì (èç âûáðàííûõ)
if Figure2 = nil then
break;
// âñå ïðèáëèçèòåëüíî â îäíîé òî÷êå ñî âòîðîé ôèãóðîé
// çàîäíî ñêîððåêòèðóåòñÿ è ïåðâàÿ â çàâèñèìîñòè îò ìèíèìàëüíîé äèñòàíöèè ïîäêëþ÷åíèÿ
FindAllNearestFigures(Figure2);
// åñëè â ýòîé òî÷êå åñòü åùå òî÷å÷íûå (èëè ïðèáëèçèòåëüíî â îäíîé)
// ïîäêëþ÷àåì èõ ìåæäó ñîáîé ñíèçó ââåðõ ïîäðÿä
if ThisPointFigures.Count <> 0 then
begin
Figure2 := ThisPointFigures[0];
for i := 1 to ThisPointFigures.Count - 1 do
begin
Figure2 := DrawOneTrace(Figure2, ThisPointFigures[i]);
if FiguresPassedList.IndexOf(Figure2) = -1 then
FiguresPassedList.Add(Figure2);
end; // Çäåñü Figure2 -- ñàìàÿ âûñîêàÿ òî÷êà
Figure2 := ThisPointFigures[0]; // ñïðûãèâàåì âíèç
end;
// ïîëó÷àåì òî÷êè ñîåäèíåíèÿ
if BeforePointFigures.Count = 0 then
ConnectFigure1 := GetPointToConnectFromList(nil, TConnectorObject(Figure1))
else
ConnectFigure1 := GetPointToConnectFromList(BeforePointFigures, nil);
if ThisPointFigures.Count = 0 then
ConnectFigure2 := GetPointToConnectFromList(nil, TConnectorObject(Figure2))
else
ConnectFigure2 := GetPointToConnectFromList(ThisPointFigures, nil);
DrawOneTrace(ConnectFigure1, ConnectFigure2, False); // ðåçóëüòàò çäåñü íåèíòåðåñåí, ò.ê. òî÷êè ìîãóò áûòü è íå òå...
// ïåðåõîäèì íà ñëåäóþùóþ ôèãóðó
if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);
Figure1 := Figure2;
// åñëè ïîäêëþ÷àåì îäíó òî÷êó
(*if ThisPointFigures.Count = 0 then
begin
Figure1 := DrawOneTrace(Figure1,Figure2);
end
else
// åñëè ïîäêëþ÷àåì "êó÷êó"
begin
// SortFigures(Figure1);
//Figure2 := ThisPointFigures[0];
DirectionUp := true; // ñîåäèíÿòü òî÷êè â "êó÷êå" ñíèçó ââåðõ
{
if (TConnectorObject(ThisPointFigures[0]).ActualZOrder[1] <> TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualZOrder[1]) then
begin
if GetLineLenght(TConnectorObject(ThisPointFigures[0]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]) >
GetLineLenght(TConnectorObject(ThisPointFigures[ThisPointFigures.Count - 1]).ActualPoints[1],TConnectorObject(Figure1).ActualPoints[1]) then
begin
Figure2 := ThisPointFigures[ThisPointFigures.Count - 1];
DirectionUp := false; // ñîåäèíÿòü òî÷êè â "êó÷êå" ñâåðõó âíèç
end
end;}
if Figure2 <> ThisPointFigures[0] then
DirectionUP := false;
Figure1 := DrawOneTrace(Figure1, Figure2); // çäåñü â ôèãóðà 1 - óæå íà÷àëüíàÿ òî÷êà "êó÷êè"
// èäåì ïî "êó÷êå" ñíèçó ââåðõ
if DirectionUP then
begin
for i := 1 to ThisPointFigures.Count - 1 do
begin
Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]) // figure1 = Figure2 è òðàññà ïðîëîæåíà
end;
end
// èäåì ïî êó÷êå ñâåðõó âíèç
else
begin
for i := (ThisPointFigures.Count - 2) downto 0 do
begin
Figure1 := DrawOneTrace(Figure1, ThisPointFigures[i]) // figure1 = Figure2 è òðàññà ïðîëîæåíà
end;
end;
end; *)
{if FiguresPassedList.IndexOf(Figure1) = -1 then
FiguresPassedList.Add(Figure1);}
// Tolik -- 28/02/2017 -*- ïðîâåðêà íà ïðåâûøåíèå êâîòû îáúåêòîâ USER
ObjCounter := GCadForm.FSCSFigures.Count - OldCadFigCounter;
if ObjCounter > 49 then
begin
UserQuotaReached_Message := '';
UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(1),cMess_Quota);
if UserQuotaReached_Message <> '' then
begin
PauseProgress(True);
Showmessage(UserQuotaReached_Message);
PauseProgress(False);
Break; //// BREAK ////;
end
else
OldCadFigCounter := GCadForm.FSCSFigures.Count;
end;
end; // end while
except
on E: exception do AddExceptionToLogEX('TFSCS_Main.Act_ConnectSelectedPointsExecute', E.Message);
end;
end;
// åñëè ñîçäàíà âåðòèêàëü, íóæíî ïåðåñìîòðåòü ñïèñîê òî÷å÷íûõ è, åñëè íà íèõ ïîïàäåòñÿ Ñ/Ï -
// òî ïðåîáðàçîâàòü åãî â âåðòèêàëü
if isVerticalCreated then
CheckConvertRaiseToVertLine(FiguresList);
if FiguresList <> nil then
FreeAndNil(FiguresList);
if FiguresPassedList <> nil then
FreeAndNil(FiguresPassedList);
FreeAndNil(ThisPointFigures);
FreeAndNil(ThisPointFiguresPassed);
FreeAndNil(BeforePointFigures);
// FreeAndNil(TraceList);
// ðàçðåøèòü UNDO
end
else
ShowMessage(UserQuotaReached_Message);
GCadForm.FCanSaveForUndo := True;
end;
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.Act_ConnectSelectedPointsExecute', E.Message);
end;
EndProgress;
GCanRefreshCad := GCadFlag;
GCadForm.PCad.Refresh;
End;
//Tolik 17/08/2021 --
procedure TFSCS_Main.Act_ConnectToAnotherRackExecute(Sender: TObject);
var SavedEndPoint : Tfigure;
begin
GRackToRack := True;
SavedEndPoint := nil;
//EndPoint
if GEndPoint <> nil then
begin
SavedEndPoint := GEndPoint;
try
if CheckFigureByClassName(GEndPoint, cTConnectorObject) then
TConnectorObject(GEndPoint).AsEndPoint := False
else
if CheckFigureByClassName(GEndPoint, cTHouse) then
THouse(GEndPoint).AsEndPoint := False;
if (GListWithEndPoint <> GCadForm) and (GListWithEndPoint <> nil) then
begin
RefreshCAD(GListWithEndPoint.PCad);
RefreshCAD(GListWithEndPoint.PCad);
end
else
RefreshCAD(GCadForm.PCad);
GListWithEndPoint := Nil;
GEndPoint := nil;
except
on E: Exception do addExceptionToLogEx('Act_ConnectToAnotherRackExecute(Drop EndPoint): ', E.Message);
end;
end;
try
F_NormBase.Act_AutoTraceCableExecute(nil);
except
on E: Exception do addExceptionToLogEx('Act_ConnectToAnotherRackExecute: ', E.Message);
end;
GRackToRack := True;
if SavedEndPoint <> nil then
SetFigureAsEndObject(GCadForm, SavedEndPoint);
end;
//
procedure TFSCS_Main.Act_ReindexMasterExecute(Sender: TObject);
var aCad: TF_CAD;
begin
if not Assigned(F_ReindexMaster) then
Application.CreateForm(TF_ReindexMaster, F_ReindexMaster);
F_ReindexMaster.ShowModal;
end;
// Tolik
procedure TFSCS_Main.Act_SelectCableToTraceExecute(Sender: TObject); // Tolik 24/03/2021 -- âûáðàòü êàáåëü â ÍÁ äëÿ òðàññèðîâêè (ýëåêòðèêà)
begin
if GSelNodeColor = -1 then
begin
GSelNodeColor := clRed;
try
F_NormBase.FindComponentByGUIDWithBlink('{0D22B88D-6739-4A5D-A2D8-E1DA74EEBF5F}');
Except
on E: Exception do;
end;
GSelNodeColor := -1;
end;
end;
procedure TFSCS_Main.Act_SelectFiberCableToTraceExecute(Sender: TObject);
begin
if GSelNodeColor = -1 then
begin
GSelNodeColor := clRed;
try
{$if defined(SCS_PE)}
F_NormBase.FindComponentByGUIDWithBlink('{15A46B67-2A90-4459-8130-E04D752DCF54}');
{$ELSE}
F_NormBase.FindComponentByGUIDWithBlink('{2C158417-0736-42D4-9EDD-E638C4305391}');
{$IFEND}
Except
on E: Exception do;
end;
GSelNodeColor := -1;
end;
end;
procedure TFSCS_Main.Act_SetAsEndObjectExecute(Sender: TObject);
begin
SetFigureAsEndObject(GCadForm, GPopupFigure);
end;
//
procedure Select_clearConnectors;
var i, j: Integer;
currList: TSCSList;
aCAd: TF_CAD;
ConnList: TList;
Figure: TFigure;
currCatalog : TSCSCatalog;
Function GetEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList;
var j: Integer;
conn1: TConnectorObject;
begin
Result := TList.Create;
if ((acurrList <> nil) and (CadList <> nil)) then
begin
for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do
begin
currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]);
if currCatalog <> nil then
begin
Figure := GetFigureByID(CADList, currCatalog.SCSID);
if Figure <> nil then
begin
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
Conn1 := TConnectorObject(Figure);
if ((Conn1.ConnectorType = ct_Clear) and (TConnectorObject(Conn1).JoinedConnectorsList.Count = 0) and
(TConnectorObject(Conn1).JoinedFigures.Count = 0) and (TConnectorObject(Conn1).JoinedOrtholinesList.Count = 0) and
(TConnectorObject(Conn1).FIsHouseJoined = false) and (Length(TConnectorObject(Conn1).FJoinedConnectorsIndexes) = 0)
and ((TConnectorOBject(Conn1).FConnFullness = cif_Empty) or (TConnectorOBject(Conn1).FConnFullness = cif_None))
) then
Result.Add(Conn1);
end;
end;
end;
end;
end;
end;
Begin
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
if currList <> nil then
begin
aCad := GetListByID(currList.SCSID);
if aCad <> nil then
begin
ConnList := GetEmptyConnectorsList(currList, aCad);
if ConnList.Count > 0 then
begin
aCad.PCad.SelectFigures(ConnList);
aCad.PCad.FAnySelected := True;
aCAd.PCad.ReDrawSelection;
aCAd.PCad.SyncEnv;
// RefreshCAD(aCAd.PCad);
end;
ConnList.Free;
end;
end;
End;
procedure TFSCS_Main.aSetLeftRightDoorExecute(Sender: TObject);
var
CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.DoorIndex = -1 then
exit;
if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight then
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight := False;
GArchEngine.SetLastObjParam(aoskPathDoorLeftRight,'FALSE');
end
else
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).LeftRight := True;
GArchEngine.SetLastObjParam(aoskPathDoorLeftRight,'TRUE');
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message);
end;
end;
Function PointNear3D(p1,p2: TDoublePoint; ZCoord1, ZCoord2: Double; delta: Double=1):Boolean;
var pp1, pp2: Double;
begin
pp1 := ZCoord1;
pp2 := ZCoord2;
//result := (abs(p1.x - p2.x) <= 1) and (abs(p1.y - p2.y) <= 1);
result := (abs(p1.x - p2.x) <= delta) and (abs(p1.y - p2.y) <= delta) and (abs(ZCoord1 - ZCoord2) <= delta);
end;
procedure TFSCS_Main.aSetMirroredDoorExecute(Sender: TObject);
var
CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.DoorIndex = -1 then
exit;
if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored then
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored := False;
GArchEngine.SetLastObjParam(aoskPathDoorMirrored,'FALSE');
end
else
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Mirrored := True;
GArchEngine.SetLastObjParam(aoskPathDoorMirrored,'TRUE');
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetMirroredDoorExecute', E.Message);
end;
end;
procedure TFSCS_Main.N150Click(Sender: TObject);
var i, j, k, l: Integer;
TracesList, ConnectorsList: TList;
SCSComponent: TSCScomponent;
aJoinConnector, JoinedConnector: TConnectorObject;
CADList: TF_CAD;
currList: TSCSList;
Figure: TFigure;
currCatalog: TSCSCatalog;
SnappedInfo: TStringList;
SnapInfo: String;
Trace, CTrace: TOrthoLine;
CmpPointDelta: double;
Conn1, Conn2 : TConnectorObject;
p1, p2:TDoublePoint;
TraceIndex: Integer;
NewTraces : TList;
CanCreateList: TIntList;
TracesHeight: Double;
ClearConnectorsList: TList;
PointList1, PointList2: TDoublePointArr;
PointCount: Integer;
Candel: Boolean;
CanBuildList: TIntList;
aSnapToGreed_Status, aSnapToGuides_Status, aSnapToNearObject_Status: Boolean;
procedure CreateTrace(p1, p2: TDoublePoint);
begin
if Not PointNear(p1, p2, CmpPointDelta) then
begin
Trace := CreateTraceByPoints(GCadForm.PCad, p1, p2);
// RaiseLineOnHeight(Trace, TracesHeight, nil);
NewTraces.Add(Trace);
end;
end;
function CheckNearConnectors(AConn1, AConn2: TConnectorObject): Boolean;
var i: Integer;
x,y,z,x1,y1,z1 : Double;
IsOnOneLine: Boolean;
JoinLine: TOrthoLine;
Difference: Double;
begin
Result := True;
// çäåñü ïðîâåðÿåì òàêæå, ÷òîáû íå ñîåäèíèòü êîííåêòîðû îäíîé îðòîëèíèè
// äàæå åñëè åå äëèíà = 0 (ìîæåò áûòü è òàêîå)
if (aConn1.JoinedOrtholinesList.Count > 0) and (AConn2.JoinedOrtholinesList.Count > 0) then
begin
IsOnOneLine := False;
for i := 0 to AConn1.JoinedOrtholinesList.Count - 1 do
begin
JoinLine := TOrthoLine(AConn1.JoinedOrtholinesList[i]);
if AConn2.JoinedOrtholinesList.IndexOf(JoinLine) <> -1 then
begin
IsOnOneLine := True;
Result := False;
break;
end;
end;
if Not IsOnOneLine then
begin
Result := (Abs(AConn1.ActualPoints[1].x - AConn2.ActualPoints[1].x) < ConnectorDifference ) and
(Abs(AConn1.ActualPoints[1].y - AConn2.ActualPoints[1].y) < ConnectorDifference ) and
(Abs(AConn1.ActualZOrder[1] - AConn2.ActualZOrder[1]) < ConnectorDifference );
end;
end;
end;
Function GetEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList;
var j: Integer;
conn1: TConnectorObject;
begin
Result := TList.Create;
if ((acurrList <> nil) and (CadList <> nil)) then
begin
for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do
begin
currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]);
if currCatalog <> nil then
begin
Figure := GetFigureByID(CADList, currCatalog.SCSID);
if Figure <> nil then
begin
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
Conn1 := TConnectorObject(Figure);
if ((Conn1.ConnectorType = ct_Clear) and (TConnectorObject(Conn1).JoinedConnectorsList.Count = 0) and
(TConnectorObject(Conn1).JoinedFigures.Count = 0) and (TConnectorObject(Conn1).JoinedOrtholinesList.Count = 0) and
(TConnectorObject(Conn1).FIsHouseJoined = false) and (Length(TConnectorObject(Conn1).FJoinedConnectorsIndexes) = 0)
and ((TConnectorOBject(Conn1).FConnFullness = cif_Empty) or (TConnectorOBject(Conn1).FConnFullness = cif_None))
) then
Result.Add(Conn1);
end;
end;
end;
end;
end;
end;
// ñîåäèíÿåò êîííåêòîðû òðàññ íà ëèñòå
procedure JoinTracesOnList(aTracesList: TList);
var i, j, k, l : Integer;
Catalog, Catalog1 : TSCSCatalog;
begin
{ SnappedInfo := CreateStringListSorted;
for i := 0 to aTracesList.Count - 1 do
begin
Trace := TOrthoLine(aTracesList[i]);
Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Trace.ID);
for j := 0 to aTracesList.Count - 1 do
begin
CTrace := TOrthoLine(aTracesList[j]);
Catalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CTrace.ID);
if Trace <> CTrace then
begin
try
for k := 1 to 2 do
for l := 1 to 2 do
if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then
begin
Conn1 := Trace.ConnectorByNum(k);
Conn2 := CTrace.ConnectorByNum(l);
if Assigned(Conn1) and Assigned(Conn2) then
if Conn1 <> Conn2 then
begin
if PointNear3D(Conn1.ActualPoints[1], Conn2.ActualPoints[1], Conn1.ActualZOrder[1], Conn2.ActualZOrder[1], CmpPointDelta) then
begin
SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID));
if SnappedInfo.IndexOf(SnapInfo) = -1 then
begin
if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then
SnapConnectorToConnector(Conn1, Conn2)
else
EmptyProcedure;
SnappedInfo.Add(SnapInfo);
end;
end;
end;
end;
except
end;
end;
end;
end; }
SnappedInfo := CreateStringListSorted;
for i := 0 to aTracesList.Count - 2 do
begin
Trace := TOrthoLine(aTracesList[i]);
Catalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(Trace.ID);
for j := (i+1) to aTracesList.Count - 2 do
begin
CTrace := TOrthoLine(aTracesList[j]);
Catalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(CTrace.ID);
if Trace <> CTrace then
begin
try
for k := 1 to 2 do
for l := 1 to 2 do
if PointNear(Trace.ActualPoints[k], CTrace.ActualPoints[l], CmpPointDelta) then
begin
Conn1 := Trace.ConnectorByNum(k);
Conn2 := CTrace.ConnectorByNum(l);
if Assigned(Conn1) and Assigned(Conn2) then
if Conn1 <> Conn2 then
begin
if PointNear3D(Conn1.ActualPoints[1], Conn2.ActualPoints[1], Conn1.ActualZOrder[1], Conn2.ActualZOrder[1], CmpPointDelta) then
begin
SnapInfo := IntToStr(Min(Conn1.ID, Conn2.ID))+'_'+IntToStr(Max(Conn1.ID, Conn2.ID));
if SnappedInfo.IndexOf(SnapInfo) = -1 then
begin
if Conn1.JoinedConnectorsList.IndexOf(Conn2) = -1 then
begin
if ((TOrthoLine(Trace).FIsRaiseUpDown = False) and (TOrthoLine(CTrace).FIsRaiseUpDown = False)) then
// Tolik 29/03/2018
//Conn1 := SnapConnectorToConnector(Conn1, Conn2)
CheckingSnapConnectorToConnector(Conn1, Conn2)
//
else
begin
if TOrthoLine(Trace).FIsRaiseUpDown then
// Tolik 29/03/2018
//Conn1 := SnapConnectorToConnector(Conn2, Conn1, True)
CheckingSnapConnectorToConnector(Conn1, Conn2)
//
else
begin
if TOrthoLine(CTrace).FIsRaiseUpDown then
// Tolik 29/03/2018
//Conn1 := SnapConnectorToConnector(Conn1, Conn2, True);
CheckingSnapConnectorToConnector(Conn1, Conn2);
//
end;
end;
end
else
EmptyProcedure;
SnappedInfo.Add(SnapInfo);
end;
end;
end;
end;
except
end;
end;
end;
end;
FreeAndNil(SnappedInfo);
end;
begin
TracesList := TList.Create;
ConnectorsList := TList.Create;
ClearConnectorsList := Nil;
CmpPointDelta := 1/5;
{ for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do
begin}
//currList := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i];
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
if currList <> nil then
begin
CadList := GetListByID(currList.SCSID);
if CadList <> nil then
begin
for j := 0 to currList.ChildCatalogReferences.Count - 1 do
begin
currCatalog := TSCSCatalog(currList.ChildCatalogReferences[j]);
if currCatalog <> nil then
begin
Figure := GetFigureByID(CADList, currCatalog.SCSID);
if Figure <> nil then
begin
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
TracesList.Add(Figure);
aJoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector1);
//if ConnectorsList.IndexOf(aJoinConnector) = -1 then
if aJoinConnector <> nil then
ConnectorsList.Add(aJoinConnector)
else
ShowMessage(cMain_Msg202);
aJoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector2);
//if ConnectorsList.IndexOf(aJoinConnector) = -1 then
if aJoinConnector <> nil then
ConnectorsList.Add(aJoinConnector)
else
ShowMessage(cMain_Msg202);
end;
end;
end;
end;
end;
end;
if TracesList.Count > 0 then
begin
// Èùåì ïóñòûå êîííåêòîðû íà ïðîåêòå äëÿ óäàëåíèÿ
ClearConnectorsList := GetEmptyConnectorsList(currList, CadList);
// Óäàëÿåì ïóñòûå êîííåêòîðû ñ ëèñòà
(* if ClearConnectorsList.Count > 0 then
begin
for i := 0 to ClearConnectorsList.Count - 1 do
begin
Conn1 := TConnectorObject(ClearConnectorsList[i]);
if Assigned(TConnectorObject(Conn1).CaptionsGroup) then
TConnectorObject(Conn1).CaptionsGroup.delete;
if Assigned(TConnectorObject(Conn1).NotesGroup) then
TConnectorObject(Conn1).NotesGroup.Delete;
if Assigned(TConnectorObject(Conn1).DrawFigure) then
TConnectorObject(Conn1).DrawFigure.Delete;
TConnectorObject(Conn1).Delete;
end;
end;*)
// ñîõðàíÿåì ñîñòîÿíèå ïðèâÿçîê
aSnapToGreed_Status := FSCS_Main.aSnaptoGrid.Checked;
aSnapToGuides_Status := FSCS_Main.aSnaptoGuides.Checked;
aSnapToNearObject_Status := FSCS_Main.aSnaptoNearObject.Checked;
// ñáðàñûâàåì ïðèâÿçêè
CadList.PCad.SnapToGrids := False;
CadList.PCad.SnapToGuides := False;
CadList.PCad.SnapToNearPoint := False;
FSCS_Main.aSnaptoGrid.Checked := False;
FSCS_Main.aSnaptoGuides.Checked := False;
FSCS_Main.aSnaptoNearObject.Checked := False;
// ñîåäèíÿåì âñå òðàññû
JoinTracesOnList(TracesList); // TracesList - óæå âñå òðàññû ëèñòà ñèäÿò
// âîçâðàùàåì, êàê áûëî
CadList.PCad.SnapToGrids := aSnapToGreed_Status;
CadList.PCad.SnapToGuides := aSnapToGuides_Status;
CadList.PCad.SnapToNearPoint := aSnapToNearObject_Status;
FSCS_Main.aSnaptoGrid.Checked := aSnapToGreed_Status;
FSCS_Main.aSnaptoGuides.Checked := aSnapToGuides_Status;
FSCS_Main.aSnaptoNearObject.Checked := aSnapToNearObject_Status;
FreeAndNil(TracesList);
RefreshCAD(CadList.PCad);
end;
// åñëè âäðóã ïîòðåáóåòñÿ òðàññû ïåðåñîçäàòü, òî ìîæíî è òàê
(*
NewTraces := TList.Create;
{PointList1 := TList.Create;
PointList2 := TList.Create;}
SetLength(PointList1, 0);
SetLength(PointList2, 0);
PointCount := 0;
CanBuildList := TIntList.Create;
// ñòðîèì ñïèñîê òî÷åê è óäàëÿåì òðàññû
for i := 0 to TracesList.Count - 1 do
begin
Trace := TOrthoLine(TracesList[i]);
p1 := Trace.JoinConnector1.ActualPoints[1];
p2 := Trace.JoinConnector2.ActualPoints[1];
Inc(PointCount);
SetLength(PointList1,PointCount);
SetLength(PointList2,PointCount);
PointList1[PointCount - 1] := p1;
PointList2[PointCount - 1] := p2;
if (Trace.FIsRaiseUpDown = false) then
begin
CanBuildList.Add(1);
// ñáðàñûâàåì ñïèñêè ïðèñîåäèíåííûõ ôèãóð, ÷òîáû óäàëèëîñü, êàê åñòü
Trace.JoinedFigures.Clear;
Trace.JoinConnector1.JoinedFigures.Clear;
Trace.JoinConnector2.JoinedFigures.Clear;
TConnectorObject(Trace.JoinConnector1).JoinedConnectorsList.Clear;
TConnectorObject(Trace.JoinConnector2).JoinedConnectorsList.Clear;
TConnectorObject(Trace.JoinConnector1).JoinedOrtholinesList.Clear;
TConnectorObject(Trace.JoinConnector2).JoinedOrtholinesList.Clear;
// óäàëÿåì òðàññó
Trace.Delete;
//Trace.JoinConnector1.Select;
if Assigned(TConnectorObject(Trace.JoinConnector1).CaptionsGroup) then
TConnectorObject(Trace.JoinConnector1).CaptionsGroup.delete;
if Assigned(TConnectorObject(Trace.JoinConnector1).NotesGroup) then
TConnectorObject(Trace.JoinConnector1).NotesGroup.Delete;
if Assigned(TConnectorObject(Trace.JoinConnector1).DrawFigure) then
TConnectorObject(Trace.JoinConnector1).DrawFigure.Delete;
if Assigned(TConnectorObject(Trace.JoinConnector2).CaptionsGroup) then
TConnectorObject(Trace.JoinConnector2).CaptionsGroup.delete;
if Assigned(TConnectorObject(Trace.JoinConnector2).NotesGroup) then
TConnectorObject(Trace.JoinConnector2).NotesGroup.Delete;
if Assigned(TConnectorObject(Trace.JoinConnector2).DrawFigure) then
TConnectorObject(Trace.JoinConnector2).DrawFigure.Delete;
TConnectorObject(Trace.JoinConnector1).Delete;
TConnectorObject(Trace.JoinConnector2).Delete;
end
else
CanBuildList.Add(0);
end;
//CadList.DeleteSelection(false);
RefreshCAD(CadList.PCad);
// ñòðîèì òðàññû çàíîâî
for i := 0 to Length(PointList1) - 1 do
begin
if CanBuildList[i] > 0 then
begin
p1 := TDoublePoint(PointList1[i]);
p2 := TDoublePoint(PointList2[i]);
CreateTrace(p1, p2);
end
else
NewTraces.Add(TOrthoLine(TracesList[i]));
end;
// ñîåäèíÿåì òðàññû íà ïðîåêòå
// Ýòî åñëè ïîñëå ïåðåñîçäàíèÿ
JoinTracesOnList(NewTraces);
*)
//CADList.PCad.MoveAll(0.001, 0.001);
// 09/02/2017 --
FreeAndNil(ConnectorsList);
if ClearConnectorsList <> nil then
FreeAndNil(ClearConnectorsList);
//
end;
//Tolik 26/02/2022 --
procedure TFSCS_Main.N272AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas;
ARect: TRect; State: TOwnerDrawState);
var OutText: String;
begin
OutText := (Sender as TMenuItem).Caption;
if (odFocused in State) or (odSelected in State) then
begin
end
else
begin
{if Sender = N33 then
begin
OutText := 'AUTOROUTE';
end;
if Sender = N46 then
begin
OutText := 'LAY OUT ON SELECTED ROUTES';
end;}
ACanvas.Font.Style := [fsBold];
ARect.Left := 32;
ARect.Right := ARect.Right - 32;
ACanvas.brush.color := clWhite; //Tolik 26/01/2021 --
ACanvas.FillRect(ARect);
DrawText(ACanvas.Handle,
PChar(OutText),
-1,
ARect,
DT_VCENTER or dt_LEFT or dt_singleline);
end;
end;
procedure TFSCS_Main.EmptyConnSelectExecute(Sender: TObject);
begin
Select_clearConnectors;
end;
procedure TFSCS_Main.EmptyRaiseVertSelectExecute(Sender: TObject);
Var i: integer;
TraceList: TList;
SCSCatalog: TSCSCatalog;
Figure: TFigure;
begin
if GCadForm <> nil then
begin
TraceList := TList.Create;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
Figure := TFigure(GCadForm.FSCSFigures[i]);
//if TFigure is TOrthoLine then
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
if (TOrthoLine(Figure).FIsRaiseUpDown or TOrthoLine(Figure).FIsVertical) then
begin
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID);
if SCSCatalog <> nil then
begin
if SCSCatalog.ComponentReferences.Count = 0 then
if TraceList.IndexOf(Figure) = -1 then
TraceList.Add(Figure);
end;
end;
end;
end;
if TraceList.Count > 0 then
begin
GCadForm.PCad.DeselectAll(2);
GCadForm.PCad.SelectFigures(TraceList);
GCadForm.PCad.Refresh;
{
GCadForm.PCad.FAnySelected := True;
GCadForm.PCad.ReDrawSelection;
GCadForm.PCad.SyncEnv;
}
end;
TraceList.Free;
end;
end;
procedure TFSCS_Main.EmptyTracesSelectExecute(Sender: TObject);
Var i: integer;
TraceList: TList;
SCSCatalog: TSCSCatalog;
Figure: TFigure;
begin
if GCadForm <> nil then
begin
TraceList := TList.Create;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
Figure := TFigure(GCadForm.FSCSFigures[i]);
//if TFigure is TOrthoLine then
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID);
if SCSCatalog <> nil then
begin
if SCSCatalog.ComponentReferences.Count = 0 then
if TraceList.IndexOf(Figure) = -1 then
TraceList.Add(Figure);
end;
end;
end;
if TraceList.Count > 0 then
begin
GCadForm.PCad.DeselectAll(2);
GCadForm.PCad.SelectFigures(TraceList);
GCadForm.PCad.Refresh;
{GCadForm.PCad.FAnySelected := True;
GCadForm.PCad.ReDrawSelection;
GCadForm.PCad.SyncEnv;}
end;
TraceList.Free;
end;
end;
procedure TFSCS_Main.SelectAllPointObjectsExecute(Sender: TObject);
var i, j: Integer;
currList: TSCSList;
aCAd: TF_CAD;
ConnList: TList;
Figure: TFigure;
currCatalog : TSCSCatalog;
Function GetNotEmptyConnectorsList(acurrList: TSCSList; CadList: TF_CAD) : TList;
var j: Integer;
conn1: TConnectorObject;
begin
Result := TList.Create;
if ((acurrList <> nil) and (CadList <> nil)) then
begin
for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do
begin
currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]);
if currCatalog <> nil then
begin
Figure := GetFigureByID(CADList, currCatalog.SCSID);
if Figure <> nil then
begin
if CheckFigureByClassName(Figure, cTConnectorObject) then
begin
Conn1 := TConnectorObject(Figure);
if Conn1.ConnectorType = ct_NB then
Result.Add(Conn1);
end;
end;
end;
end;
end;
end;
Begin
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
if currList <> nil then
begin
aCad := GetListByID(currList.SCSID);
if aCad <> nil then
begin
ConnList := GetNotEmptyConnectorsList(currList, aCad);
if ConnList.Count > 0 then
begin
aCad.PCad.SelectFigures(ConnList);
aCad.PCad.FAnySelected := True;
aCAd.PCad.ReDrawSelection;
aCAd.PCad.SyncEnv;
// RefreshCAD(aCAd.PCad);
FreeAndNil(ConnList);
end
else
ConnList.Free;
end;
end;
end;
procedure TFSCS_Main.SelectAllLineObjsExecute(Sender: TObject);
var i, j: Integer;
currList: TSCSList;
aCAd: TF_CAD;
FigList: TList;
Figure: TFigure;
currCatalog : TSCSCatalog;
TakeRaises: Boolean;
Function GetLineList(acurrList: TSCSList; CadList: TF_CAD) : TList;
var j: Integer;
conn1: TConnectorObject;
function CheckSelectConnector(aConnector: TConnectorObject): Boolean;
var i: Integer;
begin
Result := True;
for i := 0 to aConnector.JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(aConnector.JoinedConnectorsList[i]).ConnectorType = ct_NB then
begin
Result := false;
break;
end;
end;
end;
begin
Result := TList.Create;
if ((acurrList <> nil) and (CadList <> nil)) then
begin
for j := 0 to acurrList.ChildCatalogReferences.Count - 1 do
begin
currCatalog := TSCSCatalog(acurrList.ChildCatalogReferences[j]);
if currCatalog <> nil then
begin
Figure := GetFigureByID(CADList, currCatalog.SCSID);
if Figure <> nil then
begin
if CheckFigureByClassName(Figure, cTOrthoLine) then
begin
if ( (TOrthoLine(Figure).FIsRaiseUpDown = False) or ((TOrthoLine(Figure).FIsRaiseUpDown = True) and TakeRaises ) )then
begin
Result.Add(Figure);
if TOrthoLine(Figure).JoinConnector1 <> nil then
begin
if CheckSelectConnector(TConnectorObject(TOrthoLine(Figure).JoinConnector1)) then
Result.Add(TOrthoLine(Figure).JoinConnector1);
end;
if TOrthoLine(Figure).JoinConnector2 <> nil then
begin
if CheckSelectConnector(TConnectorObject(TOrthoLine(Figure).JoinConnector2)) then
Result.Add(TOrthoLine(Figure).JoinConnector2);
end;
end
end;
end;
end;
end;
end;
end;
Function ShiftDown : Boolean;
Var
State : TKeyboardState;
Begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
End;
Begin
TakeRaises := ShiftDown; // íàæàòà ëè êëàâèøà Shift
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
if currList <> nil then
begin
aCad := GetListByID(currList.SCSID);
if aCad <> nil then
begin
FigList := GetLineList(currList, aCad);
if FigList.Count > 0 then
begin
aCad.PCad.SelectFigures(FigList);
aCad.PCad.FAnySelected := True;
aCAd.PCad.ReDrawSelection;
aCAd.PCad.SyncEnv;
// RefreshCAD(aCAd.PCad);
//FreeAndNil(FigList);
end;
//else
FreeAndNil(FigList);
{
if TakeRaises then
aCAD.SelectTracesAndRaisers
else
aCAd.SelectTraces;
}
end;
end;
End;
// Tolik
procedure TFSCS_Main.Act_Magistral_Channel_IndexExecute(Sender: TObject);
var i, j, NewIndex: Integer;
SCSComponent: TSCSComponent;
SCSCatalog, SCSCatalog1: TSCSCatalog;
TraceList, PassedTraceList, currChannelList: TList;
aCad: TF_CAD;
currList: TSCSList;
Figure: TFigure;
ChannelTypeList: TStringList;
ActLayer: Integer;
selectedCypher: String;
AllChannelList: TSCSComponents;
JoinConnector, JoinedConn: TConnectorObject;
// added by Tolik
Function GetAngleXYZ(Line1,Line2 : TSCSCatalog; Connector : TConnectorObject) : double;
Var i : integer;
x,y,z,x1,y1,z1 : double; // êîîðäèíàòû âåêòîðîâ
vector1, vector2 : TFigure;
ListOwner : TList;
ListCad : TF_Cad;
connector1, connector2 : TConnectorObject;
angle : double;
angle2 : double;
Begin
// ïåðâûé âåêòîð
ListCad := GetListByID(Line1.GetListOwner.SCSID);
// ëèíèÿ
vector1 := TOrthoLine(GetFigureByID(ListCad,Line1.SCSID));
connector1 := TConnectorObject(Tortholine(vector1).JoinConnector1);
// îïðåäåëÿåì íàïðàâëåíèå âåêòîðà
// if (connector1.ActualPoints[0] = Connector.ActualPoints[0]) and (connector1.ActualPoints.y = Connector.ActualPoints.y) and (connector1.ActualPoints.z = Connector.ActualPoints.z) then
if connector1 = Connector then
begin
connector2 := TConnectorObject(Tortholine(vector1).JoinConnector2);
end
else
begin
connector2 := TConnectorObject(Tortholine(vector1).JoinConnector1);
connector1 := TConnectorObject(Tortholine(vector1).JoinConnector2);
end;
//êîîðäèíàòû âåêòîðà 1
x := RoundX((Connector2.AP1.x - connector1.AP1.x),2);
y := RoundX((connector2.AP1.y - Connector1.AP1.y),2);
z := MetreToUOM(TOrthoLine(vector1).ActualZOrder[1])/ListCad.PCad.MapScale*1000 - MetreToUOM(TOrthoLine(vector1).ActualZOrder[2])/ListCad.PCad.MapScale*1000;
// âòîðîé âåêòîð
ListCad := GetListByID(Line1.GetListOwner.SCSID);
// ëèíèÿ
vector2 := TOrthoLine(GetFigureByID(ListCad,Line2.SCSID));
connector1 := TConnectorObject(Tortholine(vector2).JoinConnector1);
// îïðåäåëÿåì íàïðàâëåíèå âåêòîðà
if ((connector1.ActualPoints[0].x = Connector.ActualPoints[0].x) and (connector1.ActualPoints[0].y = Connector.ActualPoints[0].y) and (connector1.ActualPoints[0].z = Connector.ActualPoints[0].z)) then
begin
connector1 := TConnectorObject(Tortholine(vector2).JoinConnector1);
connector2 := TConnectorObject(Tortholine(vector2).JoinConnector2);
end
else
begin
connector2 := TConnectorObject(Tortholine(vector2).JoinConnector1);
connector1 := TConnectorObject(Tortholine(vector2).JoinConnector2);
end;
//êîîðäèíàòû âåêòîðà 2
x1 := (connector2.AP1.x - Connector1.AP1.x);
y1 := (connector2.AP1.y - Connector1.AP1.y);
z1 := MetreToUOM(TOrthoLine(vector2).ActualZOrder[1])/ListCad.PCad.MapScale*1000 - MetreToUOM(TOrthoLine(vector2).ActualZOrder[2])/ListCad.PCad.MapScale*1000;
//íà âñÿêèé, ÷òîá íå ïîëó÷èòü äåëåíèå íà 0
if (((x<>0) or (y<>0) or (z<>0)) and ((x1<>0) or (y1<>0) or (z1<>0))) then
begin
//angle2 := !!!!abs!!!!((x*x1+y*y1+z*z1)/(sqrt(sqr(x)+sqr(y)+sqr(z))*sqrt(sqr(x1)+sqr(y1)+sqr(z1))));
//Result := Roundx(RadToDeg(arccos(angle2)),1);
angle := arccos((x*x1+y*y1+z*z1)/(sqrt(sqr(x)+sqr(y)+sqr(z))*sqrt(sqr(x1)+sqr(y1)+sqr(z1))));
//óãîë ìåæäó ëèíèÿìè â ãðàäóñàõ
Result := Roundx(RadToDeg(angle),1);
if Result > 180 then
Result := 360 - Result;
end;
End;
procedure RemarkLineComponList(var ComponList: TSCSComponents; var PassedComponList: TList; var counter: Integer);
var i, j: Integer;
SCSComponent: TSCSComponent;
begin
if ComponList.Count > 0 then
begin
for i := 0 to ComponList.Count - 1 do
begin
SCSComponent := TSCSComponent(ComponList[i]);
if PassedComponList.IndexOf(SCSComponent) = -1 then
begin
SCSComponent.MarkID := counter;
// Inc(counter);
SCSComponent.SaveComponent;
PassedComponList.Add(SCSComponent);
ApplyChangeComponMarkID(SCSComponent, true, false, nil);
end;
end;
end;
end;
Function CheckCanTraceRaizeUpDown(ALine : TOrthoLine) : Boolean;
var i : Integer;
begin
Result := true;
if ALine.FIsRaiseUpDown then
begin
if Assigned(ALine.JoinConnector1) then
begin
for i := 0 to TConnectorObject(ALine.JoinConnector1).JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(TConnectorObject(ALine.JoinConnector1).JoinedConnectorsList[i]).ConnectorType = ct_Nb then
begin
Result := False;
break;
end;
end;
end;
if Result then
begin
if Assigned(ALine.JoinConnector2) then
begin
for i := 0 to TConnectorObject(ALine.JoinConnector2).JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(TConnectorObject(ALine.JoinConnector2).JoinedConnectorsList[i]).ConnectorType = ct_Nb then
begin
Result := False;
break;
end;
end;
end;
end;
end;
end;
procedure GetComponsFromTraces(aConnector: TConnectorObject; aCypher: string; var PassedList: TList; var ComponList: TSCSComponents; aLine: TOrthoLine);
var i, j, k, l: Integer;
Figure: TFigure;
BeginLine, JoinLine: TOrthoLine;
TempComponList, TempTraceList, TempConnectorsList: TList;
CanTraceNextStep: Boolean;
SCSCatalog : TSCSCatalog;
SCSComponent: TSCSComponent;
currConnector, LineConnector: TConnectorObject;
BetweenLineAngle: Double;
begin
CanTraceNextStep := True;
TempComponList := TList.Create;
TempTraceList := TList.Create;
TempConnectorsList := TList.Create;
currConnector := TConnectorObject(aConnector);
BeginLine := ALine;
while CanTraceNextStep do
begin
for i := 0 to currConnector.JoinedConnectorsList.Count - 1 do
begin
// åñëè ê êîííåêòîðó ïîäêëþ÷åí òî÷å÷íûé - äàëüøå íå èäåì
if TConnectorObject(currConnector.JoinedConnectorsList[i]).ConnectorType = ct_NB then
begin
CanTraceNextStep := False;
// SCSCatalog := //F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TConnectorObject(currConnector.JoinedConnectorsList[i]).ID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TConnectorObject(currConnector.JoinedConnectorsList[i]).ID);
if SCSCatalog <> nil then
begin
for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[j]);
// åñëè òî÷å÷íûé - ýëåìåíò êàáåëüíîãî êàíàëà - èäåì äàëüøå
if SCSComponent.ComponentType.SysName = ctsnCableChannelElement then
begin
CanTraceNextStep := True;
break;
end;
end;
end;
if not CanTraceNextStep then
Break;
end;
end;
// åñëè òî÷å÷íûõ íåò - èùåì íå ïðîéäåííûå òðàññû
if CanTraceNextStep then
begin
if TempComponList.Count > 0 then
TempComponList.Clear;
if TempTraceList.Count > 0 then
TempTraceList.Clear;
for i := 0 to currConnector.JoinedOrtholinesList.Count - 1 do
begin
JoinLine := TOrthoLine(currConnector.JoinedOrtholinesList[i]);
if CheckCanTraceRaizeUpDown(JoinLine) and (JoinLine <> BeginLine) then
begin
if PassedList.IndexOf(JoinLine) = -1 then
begin
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
if SCSCatalog <> nil then
begin
for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[j]);
if SCSComponent.Cypher = aCypher then
begin
TempTraceList.Add(JoinLine);
TempComponList.Add(SCSComponent);
LineConnector := TConnectorObject(JoinLine.JoinConnector1);
if LineConnector = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1))
else
begin
LineConnector := TConnectorObject(JoinLine.JoinConnector2);
if LineConnector = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2));
end;
PassedList.Add(JoinLine);
break;
end;
end;
end;
end;
end;
end;
for i := 0 to currConnector.JoinedConnectorsList.Count - 1 do
begin
for j := 0 to TConnectorObject(currConnector.JoinedConnectorsList[i]).JoinedOrtholinesList.Count - 1 do
begin
JoinLine := TOrthoLine(TConnectorObject(currConnector.JoinedConnectorsList[i]).JoinedOrtholinesList[j]);
if CheckCanTraceRaizeUpDown(JoinLine) and (JoinLine <> BeginLine) then
begin
if PassedList.IndexOf(JoinLine) = -1 then
begin
if TempTraceList.IndexOf(JoinLine) = -1 then
begin
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
if SCSCatalog <> nil then
begin
for k := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[k]);
if SCSComponent.Cypher = aCypher then
begin
TempTraceList.Add(JoinLine);
TempComponList.Add(SCSComponent);
if TConnectorObject(JoinLine.JoinConnector1) = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1))
else
if TConnectorObject(JoinLine.JoinConnector2) = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2));
break;
end;
end;
end;
end;
end;
end;
end;
JoinedConn := TConnectorObject(currConnector.JoinedConnectorsList[i]);
for j := 0 to JoinedConn.JoinedConnectorsList.Count - 1 do
begin
for k := 0 to TConnectorObject(JoinedConn.JoinedConnectorsList[j]).JoinedOrtholinesList.Count - 1 do
begin
JoinLine := TOrthoLine(TConnectorObject(JoinedConn.JoinedConnectorsList[j]).JoinedOrtholinesList[k]);
if CheckCanTraceRaizeUpDown(JoinLine) then
begin
if PassedList.IndexOf(JoinLine) = -1 then
begin
if TempTraceList.IndexOf(JoinLine) = -1 then
begin
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(JoinLine).ID);
if SCSCatalog <> nil then
begin
for l := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[l]);
if SCSComponent.Cypher = aCypher then
begin
TempTraceList.Add(JoinLine);
TempComponList.Add(SCSComponent);
if TConnectorObject(JoinLine.JoinConnector1) = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector1))
else
if TConnectorObject(JoinLine.JoinConnector2) = currConnector then
TempConnectorsList.Add(TConnectorObject(JoinLine.JoinConnector2));
break;
end;
end;
end;
end;
end;
end;
end;
end;
end;
end;
// åñëè òðàññ äàëüøå íåò - ñáðîñ
if TempTraceList.Count = 0 then
CanTraceNextStep := False
else
begin
// åñëè òðàññà äàëüøå îäíà - áåðåì ñðàçó è ïðîäîëæàåì
if TempTraceList.Count = 1 then
begin
ComponList.Add(TSCSComponent(TempComponList[0]));
JoinLine := TOrthoLine(TempTraceList[0]);
if CheckCanTraceRaizeUpDown(JoinLine) then
begin
currConnector := nil;
if TempConnectorsList.IndexOf(TConnectorObject(JoinLine.JoinConnector1)) = -1 then
currConnector := TConnectorObject(JoinLine.JoinConnector1)
else
if TempConnectorsList.IndexOf(TConnectorObject(JoinLine.JoinConnector2)) = -1 then
currConnector := TConnectorObject(JoinLine.JoinConnector2);
if currConnector = nil then
CanTraceNextStep := False;
BeginLine := TOrthoLine(TempTraceList[0]);
end;
end
else
// åñëè òðàññ íåñêîëüêî - èùåì (åñëè íàéäåì) òó, êîòîðàÿ ÿâëÿåòñÿ ïðîäîëæåíèåì òåêóùåé òðàññû (180 ãðàä)
if TempTraceList.Count > 1 then
begin
BetweenLineAngle := -1;
//SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(BeginLine).ID);
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(BeginLine).ID);
for i := 0 to TempTraceList.Count - 1 do
begin
//SCSCatalog1 := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(TFigure(TempTraceList[i]).ID);
SCSCatalog1 := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(TempTraceList[i]).ID);
BetweenLineAngle := GetAngleXYZ(SCSCatalog, SCSCatalog1, currConnector);
if BetweenLineAngle = 180 then
begin
// ïðîäîëæàåì ïóòü
CanTraceNextStep := True;
// èñõîäíàÿ òðàññà
BeginLine := TOrthoLine(TempTraceList[i]);
// èñõîäíûé êîííåêòîð
if TConnectorObject(BeginLine.JoinConnector1) <> currConnector then
currConnector := TConnectorObject(BeginLine.JoinConnector1)
else
if TConnectorObject(BeginLine.JoinConnector2) <> currConnector then
currConnector := TConnectorObject(BeginLine.JoinConnector2);
// êîìïîíåíò äëÿ èíäåêñàöèè - â îáùèé ñïèñîê
ComponList.Add(TSCSComponent(TempComponList[i]));
break;
end;
end;
end;
end;
end;
FreeAndNil(TempComponList);
FreeAndNil(TempTraceList);
FreeAndNil(TempConnectorsList);
end;
begin
ActLayer := GCadForm.PCad.ActiveLayer;
currList := F_ProjMan.GSCSBase.CurrProject.CurrList;
aCad := GetListByID(currList.SCSID);
selectedCypher := '';
if aCad <> nil then
begin
TraceList := nil;
PassedTraceList := nil;
ChannelTypeList := nil;
AllChannelList := nil;
currChannelList := nil;
NewIndex := -1;
if aCad.PCad.Selection.Count > 0 then
begin
TraceList := TList.Create;
PassedTraceList := TList.Create;
Figure := TFigure(aCad.PCAD.Selection[0]);
if CheckFigureByClassName(Figure, cTOrthoLine) then // íà âñÿêèé
begin
SCSCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(Figure.ID);
if SCSCatalog <> nil then
begin
try
NewIndex := StrToInt(InputBox('', '','1'));
except
NewIndex := -1;
end;
if NewIndex <> -1 then
begin
// ñòðîèì ñïèñîê êàá êàíàëîâ íà òðàññå
AllChannelList := TSCSComponents.Create(false);
ChannelTypeList := TStringList.Create;
for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do
begin
if TSCSComponent(SCSCatalog.ComponentReferences[i]).ComponentType.SysName = ctsnCableChannel then
begin
SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences[i]);
if ChannelTypeList.IndexOf(SCSComponent.Cypher) = -1 then
begin
ChannelTypeList.Add(SCSComponent.Cypher);
AllChannelList.Add(SCSComponent);
end;
end;
end;
// åñëè êàáêàíàë íà òðàññå òîëüêî îäèí
if AllChannelList.Count = 1 then
selectedCypher := ChannelTypeList[0]
else
if AllChannelList.Count > 1 then
begin
SCSComponent := nil;
SCSComponent := F_ProjMan.SelectComponentFromList(AllChannelList, '', '1', '2', '', 0, [], nil, nil, 0);
end;
if SCSComponent <> nil then
begin
selectedCypher := SCSComponent.Cypher;
AllChannelList.Clear;
PassedTraceList.Add(Figure); // ïðîéäåííûå ôèãóðû - ÷òîáû íå âåðíóòüñÿ íàçàä
AllChannelList.Add(SCSComponent); // ñïèñîê êîìïîíåíò äëÿ ïåðåèíäåêñàöèè
// åñòü âûáðàííûé êîìïîíåíò - øóðóåì ïî òðàññàì â îáå ñòîðîíû, èùåì òàêèå æå, ïîêà ïðèñîåäèíåííàÿ òðàññà òîëüêî îäíà,
// òîëüêî îäíà èç ïðèñîåäèíåííûõ ñ òàêèì æå êîìïîíåíòîì(áåðåì ïåðâûé ïîïàâøèéñÿ), èëè íå çàêîí÷èòñÿ òî÷å÷íûì èëè îáðûâîì
if assigned(TConnectorObject(TOrthoLine(Figure).JoinConnector1)) then
JoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector1);
GetComponsFromTraces(JoinConnector, selectedCypher, PassedTraceList, AllChannelList, TOrthoLine(Figure));
if assigned(TConnectorObject(TOrthoLine(Figure).JoinConnector2)) then
JoinConnector := TConnectorObject(TOrthoLine(Figure).JoinConnector2);
GetComponsFromTraces(JoinConnector, selectedCypher, PassedTraceList, AllChannelList, TOrthoLine(Figure));
PassedTraceList.Clear;
RemarkLineComponList(AllChannelList, PassedTraceList, NewIndex);
end;
FreeAndNil(ChannelTypeList);
AllChannelList.Clear;
FreeAndNil(AllChannelList);
end
else
begin
ShowMessage(hReindex_Msg1);
FreeAndNil(TraceList);
FreeAndNil(PassedTraceList);
EXIT;
end;
end;
end;
aCad.PCad.DeselectAll(ActLayer);
aCad.Pcad.Refresh;
end;
end;
end;
procedure TFSCS_Main.actLoadPictasRastrExecute(Sender: TObject);
var
FName: string;
FDir: string;
OpenPictureDialog: TSavePictureDialog;
begin
try
if ActiveMDIChild <> nil then
begin
GisUserDimLine := True;
LoadDXFFileNew(GCadForm.PCad, cMain_Mes120, cMain_Mes124,'', True, True);
//Tolik 11/08/2021 --
if GisUserDimLine then
begin
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
//
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
except
on E: Exception do AddExceptionToLogEx('TFSCS_Main.aOpenVectorDrawingExecute', E.Message);
end;
end;
procedure TFSCS_Main.Act_AlignSelectionExecute(Sender: TObject);
begin
//
end;
procedure TFSCS_Main.aToolPieExecute(Sender: TObject);
begin
if ActiveMDIChild <> nil then
begin
GCadForm.FCreateObjectOnClick := False;
RestoreCadGridStatus; // Tolik 04/03/2021 --
//if (GCadForm.PCad.ActiveLayer = 0) or CheckOneOfSCSlayers(GCadForm.PCad.ActiveLayer) then
aSetSubstrateLayer.Execute;
GCadForm.PCad.SetTool(toFigure, 'TPie');
//GCadForm.PCad.SetTool(toFigure, 'TArcDimLine');
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.SetSefaultAllowTransparensyExecute(Sender: TObject);
var CurListParams: TListParams;
begin
if ActiveMDIChild <> nil then
begin
try
{GCadForm.FListSettings.AllowTransparency := True;
GCadForm.tbShowTransparency.Down := True;}
CurListParams := GetListParams(GCadForm.FCADListID);
CurListParams.Settings.AllowTransparency := True;
//SaveCADListParams(GCadForm.FCADListID, CurListParams);
RefreshCAD(GCadForm.PCad);
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.a100Execute', E.Message);
end;
end
else
MessageBox(Application.Handle, CActiveListNotExistMessage, cMain_Mes1, MB_OK);
end;
procedure TFSCS_Main.aSetDoubleDoorExecute(Sender: TObject);
var
CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.DoorIndex = -1 then
exit;
if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled then
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled := False;
GArchEngine.SetLastObjParam(aoskPathDoorDoubled,'FALSE')
end
else
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Doubled := True;
GArchEngine.SetLastObjParam(aoskPathDoorDoubled,'TRUE');
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoubleDoorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetOpenedDoorExecute(Sender: TObject);
Var CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.DoorIndex = -1 then
exit;
if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened then
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := False;
GArchEngine.SetLastObjParam(aoskPathDoorOpened,'FALSE');
end
else
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := True;
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := False;
GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'FALSE');
GArchEngine.SetLastObjParam(aoskPathDoorOpened,'TRUE');
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetHalfOpenedDoorExecute(Sender: TObject);
Var CurSelPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurSelPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurSelPath.DoorIndex = -1 then
exit;
if TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened then
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := False;
GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'FALSE');
end
else
begin
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).HalfOpened := True;
TNetDoor(CurSelPath.doors[CurSelPath.DoorIndex]).Opened := False;
GArchEngine.SetLastObjParam(aoskPathDoorOpened,'FALSE');
GArchEngine.SetLastObjParam(aoskPathDoorHalfOpened,'TRUE');
end;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetLeftRightDoorExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetCornHeightExecute(Sender: TObject);
var dist1, dist2, zCoord: Double;
currPath, JoinedPath: TNetPath;
i, currPathIndex: Integer;
NewZ: String;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
if TNet(GCadForm.PCad.Selection[0]).SelPath <> nil then
begin
CurrPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if CurrPath <> nil then
if CurrPath.p1 <> nil then
if CurrPath.p2 <> nil then
begin
//currPathIndex := TNet(GCadForm.PCad.Selection[0]).Paths.IndexOf(CurrPath);
dist1 := Sqrt(Sqr(CurrPath.p1.x - GMouseDownPos.x) + Sqr(CurrPath.p1.y - GMouseDownPos.y));
dist2 := Sqrt(Sqr(CurrPath.p2.x - GMouseDownPos.x) + Sqr(CurrPath.p2.y - GMouseDownPos.y));
{PathPoint.x := CurrPath.P1.x;
PathPoint.y := CurrPath.P1.y;
PathPoint.z := CurrPath.P1.z;}
i := 1;
zCoord := CurrPath.P1H;
if CompareValue(dist1, dist2) = 1 then
begin
{PathPoint.x := CurrPath.P2.x;
PathPoint.y := CurrPath.P2.y;
PathPoint.z := CurrPath.P2.z;}
//zCoord := CurrPath.P2.z;
zCoord := CurrPath.P2H;
i := 2;
end;
if zCoord < 0 then
NewZ := '-1'
else
NewZ := FloatToStr(zCoord);
if InputQuery(SetAngleHMsg,'', NewZ) then
begin
Try
zCoord := StrToFloat_My(NewZ);
except
Showmessage(IncorrInpVal);
exit;
end;
if zCoord < 0 then
exit
else
if CompareValue(F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom, zCoord) = -1 then
zCoord := F_ProjMan.GSCSBase.CurrProject.CurrList.Setting.HeightRoom;
if i = 1 then
currPath.p1H := zCoord
else
if i = 2 then
currPath.p2H := zCoord;
currPath.Refresh;
RefreshCAD(GCadForm.PCad);
if not GProjectChanged then // Tolik 28/08/2019 --
SetProjectChanged(True);
end;
{if TNet(GCadForm.PCad.Selection[0]).Paths.Count > 1 then
begin
for i := 0 to TNet(GCadForm.PCad.Selection[0]).Paths.Count - 1 do
begin
if i <> currPathIndex then
begin
currPath := TNetPath(TNet(GCadForm.PCad.Selection[0]).Paths[i]);
if CompareValue(currPath.p1.x, PathPoint.x) = 0 then
if CompareValue(currPath.p1.y, PathPoint.y) = 0 then
begin
currPath.p1.z := zCoord;
currPath := nil;
end;
if currPath <> nil then
begin
if CompareValue(currPath.p2.x, PathPoint.x) = 0 then
if CompareValue(currPath.p2.y, PathPoint.y) = 0 then
begin
currPath.p2.z := zCoord;
currPath := nil;
end;
end;
end;
end;
end;
}
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetCornHeightExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetDoorWndHExecute(Sender: TObject);
var
nDoor: TNetDoor;
DWHeight: Double;
DWHeightStr, MStr: string;
SPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
SPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if SPath <> nil then
begin
nDoor := SPath.Net.SelDoor;
MStr := SetDoorH;
if nDoor = nil then
begin
MStr := SetWndH;
nDoor := SPath.Net.SelWindow;
end;
if nDoor <> nil then
begin
DWHeightStr := FloatToStr(nDoor.Height);
if InputQuery(MStr,'', DWHeightStr) then
begin
try
DWHeight := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DWHeight < 0 then
exit
else
begin
nDoor.Height := DWHeight;
SPath.refresh;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoorWndHExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetDoorWindowPllacementHeightExecute(Sender: TObject);
var
nDoor: TNetDoor;
DWHeight: Double;
DWHeightStr, MStr: string;
SPath: TNetPath;
begin
try
if CheckFigureByClassName(TFigure(GCadForm.PCad.Selection[0]), 'TNet') then
begin
SPath := TNet(GCadForm.PCad.Selection[0]).SelPath;
if SPath <> nil then
begin
nDoor := SPath.Net.SelDoor;
MStr := SetDoorPLHMsg;
if nDoor = nil then
begin
MStr := SetWinPLHMsg;
nDoor := SPath.Net.SelWindow;
end;
if nDoor <> nil then
begin
DWHeightStr := FloatToStr(nDoor.WndPlacementHeight);
if InputQuery(MStr,'', DWHeightStr) then
begin
try
DWHeight := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DWHeight < 0 then
exit
else
begin
nDoor.WndPlacementHeight := DWHeight;
SPath.refresh;
end;
end;
end;
end;
end;
except
on E: Exception do addExceptionToLogEx('TFSCS_Main.aSetDoorWindowPllacementHeightExecute', E.Message);
end;
end;
procedure TFSCS_Main.aSetAllListDoorsPlacementHeightExecute(Sender: TObject);
var i, j: Integer;
Net: TNet;
DWHeightStr: String;
DoorH: Double;
currPath: TNetPath;
Door: TNetDoor;
begin
if GCadForm.FactiveNet <> nil then
begin
Net := GCadForm.FActiveNet;
DWHeightStr:= FloatToStr(MetreToUom(0.1));
if InputQuery(SetListDoorPLHMsg,'', DWHeightStr) then
begin
try
DoorH := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DoorH >= 0 then
begin
for i := 0 to Net.Paths.count - 1 do
begin
currPath := TNetpath(net.Paths[i]);
for j := 0 to currPath.Doors.Count - 1 do
begin
Door := TNetDoor(currPath.Doors[j]);
if Door.DoorObjType = dotDoor then
Door.WndPlacementHeight := DoorH;
end;
end;
Net.RefreshPaths(false);
end;
end;
end;
end;
procedure TFSCS_Main.aSetAllListWndPlacementExecute(Sender: TObject);
var i, j: Integer;
Net: TNet;
DWHeightStr: String;
DoorH: Double;
currPath: TNetPath;
Door: TNetDoor;
begin
if GCadForm.FactiveNet <> nil then
begin
Net := GCadForm.FActiveNet;
DWHeightStr:= FloatToStr(MetreToUom(0.7));
if InputQuery(SetListWinPLHMsg,'', DWHeightStr) then
begin
try
DoorH := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DoorH >= 0 then
begin
for i := 0 to Net.Paths.count - 1 do
begin
currPath := TNetpath(net.Paths[i]);
for j := 0 to currPath.Doors.Count - 1 do
begin
Door := TNetDoor(currPath.Doors[j]);
if Door.DoorObjType = dotWindow then
Door.WndPlacementHeight := DoorH;
end;
end;
Net.RefreshPaths(false);
end;
end;
end;
end;
procedure TFSCS_Main.aSetAllListDoorsHeightExecute(Sender: TObject);
var i, j: Integer;
Net: TNet;
DWHeightStr: String;
DoorH: Double;
currPath: TNetPath;
Door: TNetDoor;
begin
if GCadForm.FactiveNet <> nil then
begin
Net := GCadForm.FActiveNet;
DWHeightStr:= FloatToStr(MetreToUom(2));
if InputQuery(SetListDoorH,'', DWHeightStr) then
begin
try
DoorH := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DoorH >= 0 then
begin
for i := 0 to Net.Paths.count - 1 do
begin
currPath := TNetpath(net.Paths[i]);
for j := 0 to currPath.Doors.Count - 1 do
begin
Door := TNetDoor(currPath.Doors[j]);
if Door.DoorObjType = dotDoor then
Door.Height := DoorH;
end;
end;
Net.RefreshPaths(false);
end;
end;
end;
end;
procedure TFSCS_Main.aSetAllListWndHeightExecute(Sender: TObject);
var i, j: Integer;
Net: TNet;
DWHeightStr: String;
DoorH: Double;
currPath: TNetPath;
Door: TNetDoor;
begin
if GCadForm.FactiveNet <> nil then
begin
Net := GCadForm.FActiveNet;
DWHeightStr:= FloatToStr(MetreToUom(1.4));
if InputQuery(SetListWndH,'', DWHeightStr) then
begin
try
DoorH := StrToFloat_My(DWHeightStr);
except
Showmessage(IncorrInpVal);
exit;
end;
if DoorH >= 0 then
begin
for i := 0 to Net.Paths.count - 1 do
begin
currPath := TNetpath(net.Paths[i]);
for j := 0 to currPath.Doors.Count - 1 do
begin
Door := TNetDoor(currPath.Doors[j]);
if Door.DoorObjType = dotWindow then
Door.Height := DoorH;
end;
end;
Net.RefreshPaths(false);
end;
end;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink