unit U_MAIN; interface uses Windows, U_LNG, Messages, SysUtils, StrUtils, Variants, Classes, Graphics, Controls, Contnrs, Forms, inifiles, Dialogs, Dlgs, ShlObj, cxControls, cxContainer, Menus, ExtCtrls, DBCtrls, Grids, DBGrids, ComCtrls, CommCtrl, StdCtrls, DB, ImgList, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxGridCustomView, cxGrid, Buttons, ActnList, FIBDatabase, pFIBDatabase,FIBDataSet, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, ToolWin, cxTextEdit, cxMaskEdit, cxSpinEdit, cxCurrencyEdit, cxButtonEdit, Gauges, Mask, ActnMan, cxCheckBox, cxImage, PCPanel, PCDrawBox, PCDrawing, PowerCad, pcMsbar, XP_Panel, DrawObjects, DlgBase, ExtDlgs, PCLayerDlg, OleCtnrs, PCgui, GuiStrings, DrawEngine, XP_PopUpMenu, RzBHints, XPMenu, RapTree, Treecoll, LibJpeg, FlytreePro, U_ProtectionBase, U_UsersEditor, U_BaseCommon, U_BaseConstants, U_BaseSettings, U_BaseOptions, U_BaseUpdate, //RzSplit, cxDropDownEdit, cxImageComboBox,, cxColorComboBox, RzPanel, U_SCSLists, U_SCSComponent, U_SCSClasses, Unit_DM_SCS, U_DMCommon, U_AddComponent, U_ActiveCurrency, U_AddInterface, U_Animate, U_AnswerToQuast, U_CanDelete, U_CaseForm, U_Connect, U_ImageShow, U_InputBox, U_MakeCurrency, U_MakeProperty, U_NDS, cxColorComboBox, cxDBLookupComboBox, cxDropDownEdit, cxImageComboBox, U_ConfGroups, U_ConfiguratorUpdateInfo, U_FilterConfigurator, U_FindParams, U_LoginUser, U_MakeEditObjectIcons, U_ChoiceConnectSide, U_Norms, U_MakeNorm, U_ResourceReport, U_InterfaceInfo, U_MakeEditComponentType, U_MakeMarkPage, U_MakeUpdateBlock, U_MarkMask, U_ComponTypesMarkMask, U_MakeEditInterface, U_MakeEditInterfaceAccordance, U_MakeEditInterfNorm, U_MakeEditCrossConnection, U_MakeEditObjCurrency, U_MakeEditPortInterfRel, U_MakeEditProducer, U_MakeEditPropRel, U_MakeEditSupplyKind, U_MasterCableCanalTracing, U_MasterComponToCAD, U_MasterComplCommon, U_MasterDefectAct, U_MasterUpdatePrice, U_NormsComplete, U_NormsGroups, U_ObjectParams, U_ReportForm, U_ConnectComplWith, U_UpdateNormBaseDialog, U_Common, U_Constants, PCTypesUtils, cxMemo, RzPanel, RzSplit, RzTabs, U_CurrencyPreparer, U_BackUpBase, U_Kalc, U_PECommon, U_ObjsProp, U_CADObjectView, U_BlockParams, U_ProjectRev, kbmMemTable, Math, fplan, U_ItemsSelector, U_HintW, {U_MsgDlg,} U_Preview, U_ProgressExp, RzShellDialogs, cxCalc, siComp, siLngLnk, RzLabel, FileCtrl, ShellApi, CommDlg, RzButton, RzRadChk, RzListVw, exgrid, RzLstBox, RzCmboBx, RzChkLst, RzGroupBar, Keyboard, U_Common_Classes, cxCalendar, cxLookAndFeels, cxLookAndFeelPainters, cxNavigator; // FastReport //cxDropDownEdit, cxImageComboBox, cxColorComboBox, //cxDBLookupComboBox; type //Tolik 16/11/2021 - - TubeConnection = record ConnID: Integer; TubeCompon_ID: Integer; end; PTubeConnection = ^TubeConnection; // TFMainMode = (fmNormal, fmComplects, fmConnections, fmNewFolder); // Tolik 12/04/2021 -- THackTreeNodes = class(TPersistent) //"Privat Field Hack" private //anders kommen wir nicht an FUpDateCount heran FOwner: TCustomTreeView; FUpdateCount: Integer; FNodeCache: TNodeCache; FReading: Boolean; end; // TComponGrpData = class(TMyObject) FFilterBlock: TFilterBlock; FComponData: PObjectData; PropValue: string; PropDataType: ShortInt; constructor Create; overload; destructor Destroy; override; end; TTemplateGrpData = class(TMyObject) FOwner: TRzGroup; FID: Integer; FType: ShortInt; FListView: TRzListView; constructor create; // Tolik 13/12/2019 -- destructor destroy; override; // Tolik 13/102/2019 -- end; TTVMoveNodeEvent = procedure(Sender: TObject; Source, Destination: TTreeNode; Mode: TNodeAttachMode) of Object; //TF_Main = class; TESTreeView = class(TTreeView) private FLastOnMoveNode: TTreeNode; FUserExpand: Boolean; //02.02.2011 - признак того что экспанд вызван юзером, а не программно FEditingNode: Boolean; FOnAfterMoveNode: TTVMoveNodeEvent; FOnBeforeMoveNode: TTVMoveNodeEvent; FOnEditCancelled: TNotifyEvent; procedure Edit(const Item: TTVItem); override; procedure SetNodeSate(ANode: TTreeNode; AFlags: Integer); //procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN; published property OnAfterMoveNode: TTVMoveNodeEvent read FOnAfterMoveNode write FOnAfterMoveNode; property OnBeforeMoveNode: TTVMoveNodeEvent read FOnBeforeMoveNode write FOnBeforeMoveNode; property OnEditCancelled: TNotifyEvent read FOnEditCancelled write FOnEditCancelled; public MouseButtonAfterUp: TMouseButton; //property UpdateCount: Integer read GetUpdateCount; property UserExpand: Boolean read FUserExpand write FUserExpand; //property ManualNotify: Boolean read FManualNotify; constructor Create(AOwner: TComponent); override; procedure EditNode(Node: TTreeNode); procedure MoveNode(Source, Destination: TTreeNode; Mode: TNodeAttachMode); virtual; procedure SetItemBold(ANode: TTreeNode; Value: Boolean); procedure Select(Nodes: TList); overload; //28.02.2012 end; TF_MAIN = class(TForm) PopupMenu_Catalog: TPopupMenu; pmnu_DelDir: TMenuItem; N4: TMenuItem; ActionList: TActionList; Act_EditComponent: TAction; Act_AddCompRelation: TAction; Act_DelCompRelation: TAction; Act_MakeNewitemType: TAction; Act_DelDir: TAction; Act_MakeComponent: TAction; Act_DelComponent: TAction; Act_RenameDir: TAction; pmnu_Edit: TMenuItem; Act_MoveDir: TAction; Act_DropFGridAddComp: TAction; Act_AddProperty: TAction; Act_RemoveProperty: TAction; Act_EditProperty: TAction; Act_AddInterface: TAction; Act_DelInterface: TAction; Act_EditInterface: TAction; Act_EditCompRelation: TAction; Act_EditTree: TAction; Act_DelTree: TAction; N6: TMenuItem; pmnu_Copy: TMenuItem; pmnu_Paste: TMenuItem; Act_CopyDir: TAction; Act_PasteDir: TAction; Act_ChoiceTree: TAction; Act_ChoiceFind: TAction; Act_CutDir: TAction; pmnu_Cut: TMenuItem; Act_MaximizeDir: TAction; Act_MinimizeDir: TAction; Act_MoveUP: TAction; Act_MoveDOWN: TAction; Act_ClearCopyBuf: TAction; N1: TMenuItem; Panel_OKCancel: TPanel; Label_Kolvo: TLabel; BitBtn_OK: TBitBtn; BitBtn_Cancel: TBitBtn; SpinEdit_Kolvo: TcxSpinEdit; Act_HideHints: TAction; Act_MakeDir: TAction; Act_MakeList: TAction; Act_MakeSCSLine: TAction; Act_MakeSCSConnector: TAction; BalloonHints: TRzBalloonHints; PopUpMenu_DropNew: TPopupMenu; pmnu_DropMakeDir: TMenuItem; pmnu_DropMakeList: TMenuItem; pmnu_DropMakeSCSLine: TMenuItem; pmnu_DropMakeSCSConnector: TMenuItem; pmnu_DropMakeComponent: TMenuItem; Panel_Main: TPanel; ToolBar_CompData: TToolBar; ToolButton_Add: TToolButton; ToolButton_Change: TToolButton; ToolButton_Remove: TToolButton; Grid_CompData: TcxGrid; GT_Compon_Relation: TcxGridDBTableView; GT_Compon_RelationName: TcxGridDBColumn; GT_Compon_RelationKolvo: TcxGridDBColumn; GT_Compon_RelationPrice1: TcxGridDBColumn; GT_Compon_RelationCost1: TcxGridDBColumn; GT_Compon_RelationPrice2: TcxGridDBColumn; GT_Compon_RelationCost2: TcxGridDBColumn; GT_PROPERTY: TcxGridDBTableView; GT_PROPERTYNAME: TcxGridDBColumn; GT_PROPERTYVALUE: TcxGridDBColumn; GT_PROPERTYIZM: TcxGridDBColumn; GT_PROPERTYDESCRIPTION: TcxGridDBColumn; GT_PROPERTYDBColumn1: TcxGridDBColumn; GT_Interface: TcxGridDBTableView; GT_InterfaceNAME: TcxGridDBColumn; GT_InterfaceTYPE: TcxGridDBColumn; GT_InterfaceISBusy: TcxGridDBColumn; GL_Compon_Relation: TcxGridLevel; GL_PROPERTY: TcxGridLevel; GL_Interface: TcxGridLevel; GT_InterfaceGender: TcxGridDBColumn; GT_InterfaceisNative: TcxGridDBColumn; Act_EditComplect: TAction; pmnu_MaxMinAllDir: TMenuItem; pmnu_MaximizeDir: TMenuItem; pmnu_MinimizeDir: TMenuItem; N8: TMenuItem; pmnu_GoToOriginalCompon: TMenuItem; PageScroller_Cost: TPageScroller; Panel_Cost: TPanel; GroupBox_Cost: TGroupBox; Label2: TLabel; CurrencyEdit_Cost1: TcxCurrencyEdit; CurrencyEdit_Cost2: TcxCurrencyEdit; GroupBox_Price: TGroupBox; Label1: TLabel; CurrencyEdit_Price1: TcxCurrencyEdit; CurrencyEdit_Price2: TcxCurrencyEdit; Act_Switch: TAction; PopupMenu_ComponData: TPopupMenu; pmnu_AddComponData: TMenuItem; pmnu_EditComponData: TMenuItem; pmnu_DelComponData: TMenuItem; PopupMenu_DropInTree: TPopupMenu; Act_DropTreeCopy: TAction; Act_DropTreeMove: TAction; pmnu_DropTreeCopy: TMenuItem; pmnu_DropTreeMove: TMenuItem; N7: TMenuItem; N10: TMenuItem; Act_NormsShow: TAction; PopupMenu_TBMenu: TPopupMenu; Act_mnuComponData: TAction; GL_Connections: TcxGridLevel; GT_Connections: TcxGridDBTableView; GT_ConnectionsName: TcxGridDBColumn; Act_GoToConnectCompon: TAction; pmnu_ComponDataL1: TMenuItem; pmnu_GoToConnectCompon: TMenuItem; Act_AddConnection: TAction; Act_DelConnection: TAction; Act_DropTreeConnect: TAction; pmnu_DropTreeConnect: TMenuItem; pmnu_DropAct_View: TMenuItem; pmnu_DropAct_Guides: TMenuItem; pmnu_DropAct_Settings: TMenuItem; pmnu_DropAct_ComponData: TMenuItem; pmnu_DropAct_Currency: TMenuItem; pmnu_DropAct_NetType: TMenuItem; pmnu_DropAct_Interface: TMenuItem; pmnu_DropAct_Property: TMenuItem; pmnu_DropAct_CompStateType: TMenuItem; N16: TMenuItem; pmnu_DropAct_Norms: TMenuItem; pmnu_DropAct_Resources: TMenuItem; pmnu_ChoiseNormBase: TMenuItem; pmnu_NDS: TMenuItem; N13: TMenuItem; N15: TMenuItem; GT_InterfaceMultiple: TcxGridDBColumn; N12: TMenuItem; Act_SetComponAsDefault: TAction; pmnu_SetComponAsDefault: TMenuItem; Act_DeselectSelectComponInCAD: TAction; Act_ListObjectReport: TAction; Act_TurnToDefLineCompon: TAction; Act_TurnToDefNoLineCompon: TAction; Act_DropDefLineCompon: TAction; Act_DropDefNoLineCompon: TAction; N22: TMenuItem; N23: TMenuItem; N24: TMenuItem; GT_InterfaceValueI: TcxGridDBColumn; GT_InterfaceCoordZ: TcxGridDBColumn; mnu_File: TMenuItem; pmnu_TurnToDefLineCompon: TMenuItem; pmnu_TurnToDefNoLineCompon: TMenuItem; N20: TMenuItem; mnu_ChoiceFind: TMenuItem; mnu_Exit: TMenuItem; GT_InterfaceNumPairsStr: TcxGridDBColumn; GT_InterfaceColor: TcxGridDBColumn; GT_InterfaceSide: TcxGridDBColumn; Act_TurnToConnectedComponByInterf: TAction; N18: TMenuItem; pmnu_ChoiseProjManBase: TMenuItem; pmnu__Test1: TMenuItem; pmnu__Test2: TMenuItem; Act_ListResourceReport: TAction; Act_ApplyPropHeightForObjects: TAction; Act_CableReport: TAction; Act_ConnectedLineCompons: TAction; Act_NoConnectedLineCompons: TAction; Act_ConnectedConCompons: TAction; Act_NoConnectedConCompons: TAction; N25: TMenuItem; N26: TMenuItem; N27: TMenuItem; N28: TMenuItem; Act_FreeMultipleInterface: TAction; N29: TMenuItem; GT_InterfaceKind: TcxGridDBColumn; Timer_TreeContr: TTimer; Act_SettIsAdministration: TAction; N31: TMenuItem; N32: TMenuItem; N35: TMenuItem; pmnu__Test3: TMenuItem; Act_SettAutoInsertingCompons: TAction; N5: TMenuItem; Act_GuideComponentTypes: TAction; N36: TMenuItem; Act_GuideProducers: TAction; N37: TMenuItem; GT_PROPERTYTakeIntoConnect: TcxGridDBColumn; GT_PROPERTYTakeIntoJoin: TcxGridDBColumn; GL_Port: TcxGridLevel; GT_PORT: TcxGridDBTableView; GT_PORTNAME: TcxGridDBColumn; GT_PORTTYPE: TcxGridDBColumn; GT_PORTKind: TcxGridDBColumn; GT_PORTGender: TcxGridDBColumn; GT_PORTISBusy: TcxGridDBColumn; GT_PORTMultiple: TcxGridDBColumn; GT_PORTisNative: TcxGridDBColumn; GT_PORTValueI: TcxGridDBColumn; GT_PORTCoordZ: TcxGridDBColumn; GT_PORTNumPair: TcxGridDBColumn; GT_PORTColor: TcxGridDBColumn; GT_PORTSide: TcxGridDBColumn; Act_AddPort: TAction; Act_EditPort: TAction; Act_DelPort: TAction; GT_PORTNppPort: TcxGridDBColumn; Act_MakeRoom: TAction; pmnu_MakeRoom: TMenuItem; Act_RCableExceedLength: TAction; Act_RCableCanal: TAction; Act_RDisparityCompColor: TAction; Act_RDisparityComponProducer: TAction; Act_RCableJournal: TAction; Act_RTypeComponents: TAction; pmnu_Reports: TMenuItem; Act_RSpecification: TAction; Timer_PostProperty: TTimer; Act_TraceLineComponlBySelectedLines: TAction; N46: TMenuItem; Act_AutoTraceCable: TAction; GT_PORTNameConnected: TcxGridDBColumn; pmnu_Actions: TMenuItem; Act_DeleteAllCables: TAction; Act_DeleteAllCableCanals: TAction; N17: TMenuItem; N48: TMenuItem; pmnu_DA_InterfaceAccordance: TMenuItem; Act_ConnectComplWith: TAction; N30: TMenuItem; pmnu_CadActions: TMenuItem; N33: TMenuItem; Act_ReplaceComponent: TAction; ActReplaceComponent1: TMenuItem; Act_ReplaceCableCanals: TAction; N34: TMenuItem; GT_InterfaceNpp: TcxGridDBColumn; GT_PORTNpp: TcxGridDBColumn; Act_RCableJournalExt: TAction; GT_InterfaceNotice: TcxGridDBColumn; GT_PORTNotice: TcxGridDBColumn; Act_ClearList: TAction; N56: TMenuItem; Act_SetCableCanalConnectors: TAction; N57: TMenuItem; GT_PORTNameConnectCable: TcxGridDBColumn; Act_MakeProject: TAction; Act_OpenProject: TAction; Act_CloseProject: TAction; N58: TMenuItem; SaveDialog_Project: TSaveDialog; Act_SaveProjectToFile: TAction; Act_LoadProjectFromFile: TAction; OpenDialog_Project: TOpenDialog; pmDevTools: TPopupMenu; Act_MnuActions: TAction; Act_MnuCADActions: TAction; Act_MnuReports: TAction; pmnu_DropAct_Report: TMenuItem; Act_RNorms: TAction; Act_EditingNode: TAction; N9: TMenuItem; GT_ConnectionsIsNative: TcxGridDBColumn; Act_SaveToAlPlan: TAction; sdAlPlan: TSaveDialog; N14: TMenuItem; Timer_CreepingNode: TTimer; N3: TMenuItem; Panel_Addition: TRzSizePanel; Act_ChoiceNBPath: TAction; Act_ChoicePMPath: TAction; pmnu_MakeUpdateFile: TMenuItem; pmnu_Admin: TMenuItem; GL_CrossConnection: TcxGridLevel; GT_CrossConnection: TcxGridDBTableView; Act_AddCrossConnection: TAction; Act_EditCrossConnection: TAction; Act_DelCrossConnection: TAction; tcGridData: TRzTabControl; Act_ConnectConfigurator: TAction; N19: TMenuItem; Act_CupBoardDesigner: TAction; N21: TMenuItem; pmnu_DefineNumPairs: TMenuItem; Timer_RefreshNode: TTimer; Act_TurnToConnectedComponByPort: TAction; N38: TMenuItem; Timer_NodeHint: TTimer; Act_DefineNumPairs: TAction; Act_ConfiguratorUpdateInfo: TAction; N11: TMenuItem; Act_SaveNBNodeToFile: TAction; N39: TMenuItem; Act_PackBase: TAction; ActPackBase1: TMenuItem; Act_LoadNBNodeFromFile: TAction; N40: TMenuItem; Act_ImportDBF: TAction; DBF1: TMenuItem; pmnuNBTrueing: TMenuItem; Act_DefineNodesCountFields: TAction; N41: TMenuItem; Act_ClearComponsFromGarbage: TAction; N42: TMenuItem; Act_DublicatePortInterface: TAction; N2: TMenuItem; Act_ClearSpareComponPropertues: TAction; N43: TMenuItem; Act_CopyCurrList: TAction; ActCopyCurrList1: TMenuItem; Act_CablesNoHitToCanals: TAction; N44: TMenuItem; N45: TMenuItem; Act_IndexingComponPrice: TAction; N47: TMenuItem; pmTcGridData: TPopupMenu; Act_MasterCableCanalTracing: TAction; N49: TMenuItem; pmnu_Turning: TMenuItem; Act_TurnToFirstCablePart: TAction; Act_TurnToLastCablePart: TAction; Act_TurnToPrevCablePart: TAction; Act_TurnToNextCablePart: TAction; ActTurnToPrevCablePart1: TMenuItem; ActTurnToNextCablePart1: TMenuItem; ActTurnToFirstCablePart1: TMenuItem; ActTurnToLastCablePart1: TMenuItem; Act_TurnToFirstCablePoint: TAction; Act_TurnToLastCablePoint: TAction; ActTurnToFirstCablePoint1: TMenuItem; ActTurnToLastCablePoint1: TMenuItem; Act_TurnFromMemTableToSpravochnik: TAction; N50: TMenuItem; GL_CableCanalConnectors: TcxGridLevel; GT_CableCanalConnectors: TcxGridDBTableView; GT_CableCanalConnectorsName: TcxGridDBColumn; GT_CableCanalConnectorsConnectorType: TcxGridDBColumn; Act_AddCableChannelElement: TAction; Act_EditCableChannelElement: TAction; Act_DelCableChannelElement: TAction; Act_FindComponInNB: TAction; N51: TMenuItem; Act_ShowProjectPlan: TAction; N52: TMenuItem; Act_ShowLineComponsWithoutVolume: TAction; N53: TMenuItem; tbTest: TToolButton; N54: TMenuItem; Act_SaveCurrListToFile: TAction; Act_LoadListFromFile: TAction; N55: TMenuItem; Act_DropTreeConnectChoicingInterfaces: TAction; N59: TMenuItem; GT_InterfaceKolvo: TcxGridDBColumn; GT_PORTKolvo: TcxGridDBColumn; Act_PairLineInterfaces: TAction; N60: TMenuItem; GT_PORTKolvoBusy: TcxGridDBColumn; GT_InterfaceKolvoBusy: TcxGridDBColumn; Act_MakeEmptyNB: TAction; N62: TMenuItem; Act_ChangeComponArtProducerByTemplate: TAction; N63: TMenuItem; Act_DefineDirTypeItemContentCounts: TAction; N64: TMenuItem; Act_DelSameComponInList: TAction; N65: TMenuItem; GL_ObjectCurrency: TcxGridLevel; GT_ObjectCurrency: TcxGridDBTableView; Act_MakeObjectCurrency: TAction; Act_EditObjectCurrency: TAction; Act_DelObjectCurrency: TAction; GT_ObjectCurrencyName: TcxGridDBColumn; GT_ObjectCurrencyNameBrief: TcxGridDBColumn; GT_ObjectCurrencyKolvo: TcxGridDBColumn; GT_ObjectCurrencyRatio: TcxGridDBColumn; GT_ObjectCurrencyMain: TcxGridDBColumn; pmnuComponDirectoryData: TMenuItem; Act_ShowComponTypeInDirectory: TAction; Act_ShowComponNetTypeInDirectory: TAction; Act_ShowComponProducerInDirectory: TAction; Act_ShowComponSupplKindInDirectory: TAction; Act_ShowComponTypeInProjectDirectory: TAction; N66: TMenuItem; N67: TMenuItem; N68: TMenuItem; N69: TMenuItem; ActShowComponTypeInProjectDirectory1: TMenuItem; Act_SetCableCanalConnectorsToSelected: TAction; N70: TMenuItem; Act_DelAllTracesFromList: TAction; N71: TMenuItem; Act_ReindexComponentByType: TAction; N72: TMenuItem; Act_OpenBeatenProject: TAction; N61: TMenuItem; Act_DefineNewPropsFromDefault: TAction; N73: TMenuItem; Act_AllComponsNorms: TAction; N74: TMenuItem; Act_FindComponInNBFromComponData: TAction; N75: TMenuItem; Act_ComponFilter: TAction; Act_FindComponsByFilter: TAction; Act_AddComplectToComponent: TAction; GT_InterfaceSideSection: TcxGridDBColumn; N76: TMenuItem; pmnuCurrencyPreparer: TMenuItem; pmnuRecalcComponPrices: TMenuItem; GL_NormsRerources: TcxGridLevel; GT_NormsResources: TcxGridDBTableView; GT_NormsResourcesNPP: TcxGridDBColumn; GT_NormsResourcesIsOn: TcxGridDBColumn; GT_NormsResourcesCypher: TcxGridDBColumn; GT_NormsResourcesName: TcxGridDBColumn; GT_NormsResourcesWork_Kind: TcxGridDBColumn; GT_NormsResourcesIZM: TcxGridDBColumn; GT_NormsResourcesCost: TcxGridDBColumn; GT_NormsResourcesKolvo: TcxGridDBColumn; GT_NormsResourcesTotalCost: TcxGridDBColumn; GT_NormsResourcesZarplat: TcxGridDBColumn; GT_NormsResourcesRType: TcxGridDBColumn; GT_NormsResourcesExpenseForLength: TcxGridDBColumn; Act_MakeNorm: TAction; ToolButton_AddResource: TToolButton; Act_MakeResource: TAction; Act_EditNormResource: TAction; Act_DelNormResource: TAction; Timer_PostGridTableView: TTimer; Timer_TreeCatalogChange: TTimer; Timer_SelectNodeAtCursor: TTimer; Timer_TreePopupMenu: TTimer; Act_SaveProjectFromNodeToFile: TAction; N77: TMenuItem; tbTest2: TToolButton; Act_AddComponToFavorites: TAction; Act_DelComponFromFavorites: TAction; N78: TMenuItem; N79: TMenuItem; lng_Forms: TsiLangLinked; Act_ExportAllComponentsToNB: TAction; N80: TMenuItem; Act_ProjUsers: TAction; N81: TMenuItem; Act_SelectSameComponsInCAD: TAction; N82: TMenuItem; Act_DelSameComponInSelObj: TAction; N83: TMenuItem; Timer_Changing: TTimer; Act_AutoTraceByRayMode: TAction; N84: TMenuItem; GT_PROPERTYSysName: TcxGridDBColumn; GT_NormsResourcesCountForPoint: TcxGridDBColumn; GT_NormsResourcesStepOfPoint: TcxGridDBColumn; tbAddResourceCompon: TToolButton; Act_MakeResourceCompon: TAction; Act_ApplyComponForListResources: TAction; Act_ApplyComponForProjResources: TAction; N85: TMenuItem; N86: TMenuItem; GT_NormsResourcesIsResource: TcxGridDBColumn; GT_NormsResourcesGUIDNBCompon: TcxGridDBColumn; GT_NormsResourcesTotalKolvo: TcxGridDBColumn; pmMakeResource: TMenuItem; pmMakeResourceCompon: TMenuItem; Act_MasterCompl: TAction; N87: TMenuItem; pmiCreateNBUpdate: TMenuItem; Act_DeleteAllCCE: TAction; N88: TMenuItem; Act_MasterDefectAct: TAction; N89: TMenuItem; pcObjects: TRzPageControl; tsTemplates: TRzTabSheet; tsComponents: TRzTabSheet; Panel_Tree: TPanel; splFindInTree: TSplitter; ControlBar_Tools: TControlBar; ToolBar_Tree: TToolBar; ToolButton_MakeInTree: TToolButton; ToolButton9: TToolButton; pmnu_ChoiceFind: TToolButton; ToolButton12: TToolButton; ToolButton13: TToolButton; ToolButton_TMnuActions: TToolButton; ToolButton_TMnuMenu: TToolButton; tbDevTools: TToolButton; Tree_Catalog: TTreeView; Panel_New: TPanel; Label3: TLabel; Label5: TLabel; Label6: TLabel; ComboBox_FolderTypes: TcxImageComboBox; CheckBox_asDefault: TcxCheckBox; Edit_NewName: TcxTextEdit; pcFind: TRzPageControl; tsFind: TRzTabSheet; Panel2: TPanel; Label7: TLabel; Gauge: TGauge; ButtonEdit_Find: TcxButtonEdit; ListView_Find: TListView; tsFilter: TRzTabSheet; gbFilterType: TRzGroupBox; rbFilterTypeUser: TRzRadioButton; rbFilterTypeFavorites: TRzRadioButton; rbFilterTypeTop: TRzRadioButton; RzPanel4: TRzPanel; SpeedButton2: TSpeedButton; cbUseFilter: TRzCheckBox; RzGroupBox1: TRzGroupBox; pnConfigCustomFilter: TRzPanel; btComponFilterConfigurator: TSpeedButton; cbFindComponsAfterFilterConfigurator: TRzCheckBox; pnCustomFilter: TRzPanel; lbFilterUserValue: TLabel; RzPanel2: TRzPanel; pnFilterIsOn: TRzPanel; lbFilterIsOn: TRzLabel; lbFilterType: TRzLabel; lvTemplates: TRzListView; Timer_ShowHidepcObjects: TTimer; Timer_StartHidepcObjects: TTimer; cbTemplates: TControlBar; ToolBar1: TToolBar; Act_MakeTemplate: TAction; ToolButton1: TToolButton; ilTemplateIcons: TImageList; Act_EditTemplate: TAction; ToolButton2: TToolButton; Act_DelTemplate: TAction; ToolButton3: TToolButton; pmTemplates: TPopupMenu; N90: TMenuItem; N91: TMenuItem; N92: TMenuItem; ilObjects: TImageList; Act_DuplicateTemplate: TAction; ToolButton4: TToolButton; ToolButton5: TToolButton; N93: TMenuItem; N94: TMenuItem; N95: TMenuItem; N96: TMenuItem; N97: TMenuItem; tsComponGroups: TRzTabSheet; pnGroupConf: TRzPanel; pnGroupCompType: TRzPanel; cbGroupCompType: TRzComboBox; Label4: TLabel; btcbGroupsCategorySettings: TSpeedButton; Splitter1: TSplitter; pmComponGroup: TPopupMenu; N98: TMenuItem; N99: TMenuItem; N100: TMenuItem; Act_TurnToComponFromGroups: TAction; pmiTurnToComponFromGroups1: TMenuItem; N101: TMenuItem; RzGroupBox2: TRzGroupBox; pnUpDownGroupProps: TRzPanel; btCriterionGroupUp: TSpeedButton; CriterionGroupDown: TSpeedButton; clGroupProps: TRzCheckList; gbTemplateGroups: TRzGroupBar; Act_View3D: TAction; ActView3D1: TMenuItem; tbDrawModeRect: TToolButton; tbDrawModePoly: TToolButton; Act_DrawModeRect: TAction; Act_DrawModePoly: TAction; Act_DrawBasement: TAction; tbDrawBasement: TToolButton; Act_ReindexComponentByTypeInList: TAction; N110: TMenuItem; Timer_NodeShow: TTimer; pmiInterfPath: TMenuItem; Act_CablePath: TAction; N102: TMenuItem; Act_SetActiveToAllCompons: TAction; N103: TMenuItem; sbSelectFromSearchInCAD: TSpeedButton; pnSearchResultTools: TPanel; sbSelectFromFilteredInCAD: TSpeedButton; Act_SaveModelToNB: TAction; N104: TMenuItem; Act_SendModelToProject: TAction; N105: TMenuItem; GT_ConnectionsRelType: TcxGridDBColumn; GT_ConnectionsFixed: TcxGridDBColumn; Act_ShowCADObjectView: TAction; N106: TMenuItem; pmnu_Props: TMenuItem; Act_SetProjectibleToAllCompons: TAction; Act_SetActiveToASelCompons: TAction; Act_SetProjectibleToSelCompons: TAction; N107: TMenuItem; N108: TMenuItem; N109: TMenuItem; Act_SetComponGrpName: TAction; N111: TMenuItem; Act_SelectSameComponsInProj: TAction; N112: TMenuItem; Act_ReindexComponentPorts: TAction; N113: TMenuItem; Act_ShowRepResources: TAction; pmnuShowRepResources: TMenuItem; Act_CrossConnection: TAction; N114: TMenuItem; Act_CopyCurrListWithoutCompons: TAction; ActCopyCurrListWithoutCompons1: TMenuItem; GT_NormsResourcesLaborTime: TcxGridDBColumn; GT_NormsResourcesPricePerTime: TcxGridDBColumn; Act_AutoSetGraphicObjects: TAction; N115: TMenuItem; pmPatternMarking: TMenuItem; Act_PatternMarking: TAction; Act_SelAllWithSimilarProps: TAction; SelAllWithSimilarProps: TMenuItem; Act_ShowIntersections: TAction; Act_HideIntersections: TAction; N116: TMenuItem; N117: TMenuItem; N118: TMenuItem; Act_ShowCritIntersections: TAction; N119: TMenuItem; Act_NoConnectedRoutes: TAction; Noconnobjs: TMenuItem; Act_SetCurrencies: TAction; N120: TMenuItem; tvComponGroups: TRapidTree; XPMenu: TXPMenu; Act_AddTubeElement: TAction; // Tolik 13/11/2021 -- Act_EditTubeElement: TAction; // Tolik 13/11/2021 -- Act_DelTubeElement: TAction; Act_SetTubesElements: TAction; N121: TMenuItem; Act_CupBoard_Ports: TAction; CupBoardPorts1: TMenuItem; // Tolik 13/11/2021 -- procedure FormCreate(Sender: TObject); procedure Tree_CatalogEnter(Sender: TObject); procedure Tree_CatalogChange(Sender: TObject; Node: TTreeNode); procedure Tree_CatalogEdited(Sender: TObject; Node: TTreeNode; var S: String); procedure Tree_CatalogEditCancelled(Sender: TObject); procedure Tree_CatalogBeforeMoveNode(Sender: TObject; Source, Destination: TTreeNode; Mode: TNodeAttachMode); procedure mnu_ExitClick(Sender: TObject); procedure Act_EditComponentExecute(Sender: TObject); procedure Act_AddCompRelationExecute(Sender: TObject); procedure Act_DelCompRelationExecute(Sender: TObject); procedure GT_InterfaceTYPEGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Tree_Catalog_DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Tree_Catalog_DragDrop(Sender, Source: TObject; X, Y: Integer); procedure Act_MakeNewitemTypeExecute(Sender: TObject); procedure Act_DelDirExecute(Sender: TObject); procedure Act_MakeComponentExecute(Sender: TObject); procedure Act_DelComponentExecute(Sender: TObject); Procedure DeleteCableFromList(ASCSCompon: TSCSCOmponent; Node: TTreeNode); procedure Tree_CatalogMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Act_RenameDirExecute(Sender: TObject); procedure mnu_NDSClick(Sender: TObject); procedure mnu_ActiveCurrencyClick(Sender: TObject); procedure Act_MoveDirExecute(Sender: TObject); procedure Act_AddPropertyExecute(Sender: TObject); procedure Act_RemovePropertyExecute(Sender: TObject); procedure Act_EditPropertyExecute(Sender: TObject); procedure Act_AddInterfaceExecute(Sender: TObject); procedure Act_DelInterfaceExecute(Sender: TObject); procedure Act_EditInterfaceExecute(Sender: TObject); procedure Act_EditCompRelationExecute(Sender: TObject); procedure FormShow(Sender: TObject); procedure Tree_CatalogClick(Sender: TObject); procedure Tree_CatalogGetSelectedIndex(Sender: TObject; Node: TTreeNode); procedure Act_EditTreeExecute(Sender: TObject); procedure Act_DelTreeExecute(Sender: TObject); procedure Act_CopyDirExecute(Sender: TObject); procedure Act_PasteDirExecute(Sender: TObject); procedure Tree_CatalogEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean); procedure mnu_CurrencyClick(Sender: TObject); procedure mnu_NetTypeClick(Sender: TObject); procedure mnu_InterfaceClick(Sender: TObject); procedure mnu_PropertyClick(Sender: TObject); procedure GT_Compon_RelationFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); procedure ButtonEdit_FindPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure Act_ChoiceFindExecute(Sender: TObject); procedure Tree_CatalogAddition(Sender: TObject; Node: TTreeNode); procedure ButtonEdit_FindKeyPress(Sender: TObject; var Key: Char); procedure Act_CutDirExecute(Sender: TObject); procedure Act_MaximizeDirExecute(Sender: TObject); procedure Act_MinimizeDirExecute(Sender: TObject); procedure Act_MoveUPExecute(Sender: TObject); procedure Act_MoveDOWNExecute(Sender: TObject); procedure GT_PROPERTYVALUEGetProperties(Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AProperties: TcxCustomEditProperties); procedure Tree_CatalogDblClick(Sender: TObject); procedure Tree_CatalogExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); procedure Grid_CompDataActiveTabChanged(Sender: TcxCustomGrid; ALevel: TcxGridLevel); procedure Tree_CatalogCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); procedure Act_ClearCopyBufExecute(Sender: TObject); procedure Panel_TreeStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure Panel_TreeEndDock(Sender, Target: TObject; X, Y: Integer); procedure Panel_Main1Click(Sender: TObject); procedure FormStartDock(Sender: TObject; var DragObject: TDragDockObject); procedure FormEndDock(Sender, Target: TObject; X, Y: Integer); procedure FormPaint(Sender: TObject); procedure Tree_Catalog_EndDrag(Sender, Target: TObject; X, Y: Integer); procedure Tree_CatalogStartDrag(Sender: TObject; var DragObject: TDragObject); procedure Act_HideHintsExecute(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Act_MakeDirExecute(Sender: TObject); procedure Act_MakeListExecute(Sender: TObject); procedure Act_MakeSCSLineExecute(Sender: TObject); procedure Act_MakeSCSConnectorExecute(Sender: TObject); procedure FormActivate(Sender: TObject); procedure Panel_MainUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean); procedure ToolButton_MakeInTreeClick(Sender: TObject); procedure BitBtn_OKClick(Sender: TObject); procedure GT_InterfaceGenderGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_InterfaceFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); procedure Tree_CatalogKeyPress(Sender: TObject; var Key: Char); procedure Grid_CompDataEnter(Sender: TObject); procedure Act_EditComplectExecute(Sender: TObject); procedure pmnu_GoToOriginalComponClick(Sender: TObject); procedure PopupMenu_CatalogPopup(Sender: TObject); procedure ListView_FindChange(Sender: TObject; Item: TListItem; Change: TItemChange); procedure PageScroller_CostScroll(Sender: TObject; Shift: TShiftState; X, Y: Integer; Orientation: TPageScrollerOrientation; var Delta: Integer); procedure GT_Compon_RelationKolvoPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure Act_SwitchExecute(Sender: TObject); procedure mnu_CompStateTypeClick(Sender: TObject); procedure Act_DropTreeCopyExecute(Sender: TObject); procedure Act_DropTreeMoveExecute(Sender: TObject); procedure Act_NormsShowExecute(Sender: TObject); procedure Pict1Click(Sender: TObject); procedure mnu_NormsClick(Sender: TObject); procedure mnu_ResourcesClick(Sender: TObject); procedure Act_mnuComponDataExecute(Sender: TObject); procedure Act_GoToConnectComponExecute(Sender: TObject); procedure PopupMenu_ComponDataPopup(Sender: TObject); procedure Act_AddConnectionExecute(Sender: TObject); procedure Act_DelConnectionExecute(Sender: TObject); procedure Act_DropTreeConnectExecute(Sender: TObject); procedure pmnu_Test2Click(Sender: TObject); procedure Act_SetComponAsDefaultExecute(Sender: TObject); procedure pmnu_test4Click(Sender: TObject); procedure Tree_CatalogKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Act_DeselectSelectComponInCADExecute(Sender: TObject); procedure Act_TurnToDefLineComponExecute(Sender: TObject); procedure Act_TurnToDefNoLineComponExecute(Sender: TObject); procedure Act_DropDefLineComponExecute(Sender: TObject); procedure Act_DropDefNoLineComponExecute(Sender: TObject); procedure Tree_CatalogChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); procedure GT_INTERFACECoordZPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure Tree_CatalogExit(Sender: TObject); procedure Grid_CompDataExit(Sender: TObject); procedure Act_TurnToConnectedComponByInterfExecute(Sender: TObject); procedure GT_InterfaceNumPairsStrGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_InterfaceSideGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure pmnu__Test1Click(Sender: TObject); procedure pmnu__Test2Click(Sender: TObject); procedure GT_InterfaceValueIGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Act_ConnectedLineComponsExecute(Sender: TObject); procedure Act_NoConnectedLineComponsExecute(Sender: TObject); procedure Act_ConnectedConComponsExecute(Sender: TObject); procedure Act_NoConnectedConComponsExecute(Sender: TObject); procedure Act_FreeMultipleInterfaceExecute(Sender: TObject); procedure GT_InterfaceKindGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Timer_TreeContrTimer(Sender: TObject); procedure Act_SettIsAdministrationExecute(Sender: TObject); procedure pmnu__Test3Click(Sender: TObject); procedure Act_SettAutoInsertingComponsExecute(Sender: TObject); procedure Act_GuideComponentTypesExecute(Sender: TObject); procedure Act_GuideProducersExecute(Sender: TObject); procedure GT_PROPERTYEditValueChanged(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); procedure Act_AddPortExecute(Sender: TObject); procedure Act_EditPortExecute(Sender: TObject); procedure Act_DelPortExecute(Sender: TObject); procedure Act_MakeRoomExecute(Sender: TObject); procedure Timer_PostPropertyTimer(Sender: TObject); procedure Act_TraceLineComponlBySelectedLinesExecute(Sender: TObject); procedure Act_AutoTraceCableExecute(Sender: TObject); procedure Tree_CatalogDeletion(Sender: TObject; Node: TTreeNode); procedure Act_DeleteAllCablesExecute(Sender: TObject); procedure Act_DeleteAllCableCanalsExecute(Sender: TObject); procedure PopupMenu_DropInTreePopup(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure pmnu_DA_InterfaceAccordanceClick(Sender: TObject); procedure Act_ConnectComplWithExecute(Sender: TObject); procedure Act_ReplaceComponentExecute(Sender: TObject); procedure Act_ReplaceCableCanalsExecute(Sender: TObject); procedure GT_InterfaceNppGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_PORTNppGetDisplayText(Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Act_ClearListExecute(Sender: TObject); procedure Act_SetCableCanalConnectorsExecute(Sender: TObject); procedure Act_MakeProjectExecute(Sender: TObject); procedure Act_OpenProjectExecute(Sender: TObject); procedure Act_CloseProjectExecute(Sender: TObject); procedure Tree_CatalogMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Tree_CatalogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Grid_CompDataMouseLeave(Sender: TObject); procedure Act_SaveProjectToFileExecute(Sender: TObject); procedure Act_LoadProjectFromFileExecute(Sender: TObject); procedure Act_MnuActionsExecute(Sender: TObject); procedure Act_MnuCADActionsExecute(Sender: TObject); procedure Act_MnuReportsExecute(Sender: TObject); procedure Act_EditingNodeExecute(Sender: TObject); procedure Act_SaveToAlPlanExecute(Sender: TObject); procedure Timer_CreepingNodeTimer(Sender: TObject); procedure GT_PROPERTYInitEdit(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem; AEdit: TcxCustomEdit); { procedure Grid_CompDataMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);} procedure Act_ChoiceNBPathExecute(Sender: TObject); procedure Act_ChoicePMPathExecute(Sender: TObject); procedure pmnu_MakeUpdateFileClick(Sender: TObject); procedure Act_AddCrossConnectionExecute(Sender: TObject); procedure Act_EditCrossConnectionExecute(Sender: TObject); procedure Act_DelCrossConnectionExecute(Sender: TObject); procedure tcGridDataChange(Sender: TObject); procedure Tree_CatalogGetImageIndex(Sender: TObject; Node: TTreeNode); procedure Act_ConnectConfiguratorExecute(Sender: TObject); procedure Act_CupBoardDesignerExecute(Sender: TObject); procedure Timer_RefreshNodeTimer(Sender: TObject); procedure LoadProjectFromFile(aFileName: String); procedure Act_TurnToConnectedComponByPortExecute(Sender: TObject); procedure SaveDialog_ProjectCanClose(Sender: TObject; var CanClose: Boolean); procedure sdAlPlanCanClose(Sender: TObject; var CanClose: Boolean); procedure Timer_NodeHintTimer(Sender: TObject); procedure Tree_CatalogMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Act_DefineNumPairsExecute(Sender: TObject); procedure Act_ConfiguratorUpdateInfoExecute(Sender: TObject); procedure Act_SaveNBNodeToFileExecute(Sender: TObject); procedure Act_PackBaseExecute(Sender: TObject); procedure Tree_CatalogCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); procedure Act_LoadNBNodeFromFileExecute(Sender: TObject); procedure Act_ImportDBFExecute(Sender: TObject); procedure Act_DefineNodesCountFieldsExecute(Sender: TObject); procedure Act_ClearComponsFromGarbageExecute(Sender: TObject); procedure Act_DublicatePortInterfaceExecute(Sender: TObject); procedure Act_ClearSpareComponPropertuesExecute(Sender: TObject); procedure Act_CopyCurrListExecute(Sender: TObject); procedure Act_CablesNoHitToCanalsExecute(Sender: TObject); procedure Act_IndexingComponPriceExecute(Sender: TObject); procedure pmTcGridDataPopup(Sender: TObject); procedure Act_MasterCableCanalTracingExecute(Sender: TObject); procedure pmnu_TurningClick(Sender: TObject); procedure Act_TurnToFirstCablePartExecute(Sender: TObject); procedure Act_TurnToLastCablePartExecute(Sender: TObject); procedure Act_TurnToPrevCablePartExecute(Sender: TObject); procedure Act_TurnToNextCablePartExecute(Sender: TObject); procedure Act_TurnToFirstCablePointExecute(Sender: TObject); procedure Act_TurnToLastCablePointExecute(Sender: TObject); procedure Act_TurnFromMemTableToSpravochnikExecute(Sender: TObject); procedure Act_AddCableChannelElementExecute(Sender: TObject); procedure Act_EditCableChannelElementExecute(Sender: TObject); procedure Act_DelCableChannelElementExecute(Sender: TObject); procedure GT_CableCanalConnectorsConnectorTypeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Act_FindComponInNBExecute(Sender: TObject); procedure Act_ShowProjectPlanExecute(Sender: TObject); procedure Act_ShowLineComponsWithoutVolumeExecute(Sender: TObject); procedure tbTestClick(Sender: TObject); procedure Panel_TreeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure Act_SaveCurrListToFileExecute(Sender: TObject); procedure Act_LoadListFromFileExecute(Sender: TObject); procedure Act_DropTreeConnectChoicingInterfacesExecute( Sender: TObject); procedure Act_PairLineInterfacesExecute(Sender: TObject); procedure Act_MakeEmptyNBExecute(Sender: TObject); procedure Act_ChangeComponArtProducerByTemplateExecute( Sender: TObject); procedure Act_DefineDirTypeItemContentCountsExecute(Sender: TObject); procedure Act_DelSameComponInListExecute(Sender: TObject); procedure FormDeactivate(Sender: TObject); procedure Act_MakeObjectCurrencyExecute(Sender: TObject); procedure Act_EditObjectCurrencyExecute(Sender: TObject); procedure Act_DelObjectCurrencyExecute(Sender: TObject); procedure GT_ObjectCurrencyMainGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_ObjectCurrencyDblClick(Sender: TObject); procedure Act_ShowComponTypeInDirectoryExecute(Sender: TObject); procedure Act_ShowComponNetTypeInDirectoryExecute(Sender: TObject); procedure Act_ShowComponProducerInDirectoryExecute(Sender: TObject); procedure Act_ShowComponSupplKindInDirectoryExecute(Sender: TObject); procedure Act_ShowComponTypeInProjectDirectoryExecute(Sender: TObject); procedure pmnuComponDirectoryDataClick(Sender: TObject); procedure Act_SetCableCanalConnectorsToSelectedExecute( Sender: TObject); procedure Act_DelAllTracesFromListExecute(Sender: TObject); procedure Act_ReindexComponentByTypeExecute(Sender: TObject); procedure Act_OpenBeatenProjectExecute(Sender: TObject); procedure tcGridDataClick(Sender: TObject); procedure Act_DefineNewPropsFromDefaultExecute(Sender: TObject); procedure Act_AllComponsNormsExecute(Sender: TObject); procedure Act_FindComponInNBFromComponDataExecute(Sender: TObject); procedure Act_ComponFilterExecute(Sender: TObject); procedure Act_FindComponsByFilterExecute(Sender: TObject); procedure cbUseFilterPropertiesChange(Sender: TObject); procedure Act_AddComplectToComponentExecute(Sender: TObject); procedure lbFilterIsOnClick(Sender: TObject); procedure pmnuCurrencyPreparerClick(Sender: TObject); procedure pmnuRecalcComponPricesClick(Sender: TObject); procedure Act_MakeNormExecute(Sender: TObject); procedure Act_MakeResourceExecute(Sender: TObject); procedure Act_EditNormResourceExecute(Sender: TObject); procedure Act_DelNormResourceExecute(Sender: TObject); procedure GT_NormsResourcesNPPGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesCellClick(Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); procedure GT_NormsResourcesFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); procedure GT_NormsResourcesCostPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesKolvoPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesRTypeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Timer_PostGridTableViewTimer(Sender: TObject); procedure GT_NormsResourcesEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); procedure Timer_TreeCatalogChangeTimer(Sender: TObject); procedure Timer_SelectNodeAtCursorTimer(Sender: TObject); procedure Timer_TreePopupMenuTimer(Sender: TObject); procedure Act_SaveProjectFromNodeToFileExecute(Sender: TObject); procedure tbTest2Click(Sender: TObject); procedure rbFilterTypeClick(Sender: TObject); procedure Act_AddComponToFavoritesExecute(Sender: TObject); procedure Act_DelComponFromFavoritesExecute(Sender: TObject); procedure Act_ExportAllComponentsToNBExecute(Sender: TObject); procedure pcFindClick(Sender: TObject); procedure Act_ProjUsersExecute(Sender: TObject); procedure Act_SelectSameComponsInCADExecute(Sender: TObject); procedure Act_DelSameComponInSelObjExecute(Sender: TObject); procedure Timer_ChangingTimer(Sender: TObject); procedure Act_AutoTraceByRayModeExecute(Sender: TObject); procedure GT_PROPERTYVALUEGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_PROPERTYIZMGetDisplayText(Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesExpenseForLengthGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesExpenseForLengthPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesInitEdit(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem; AEdit: TcxCustomEdit); procedure GT_InterfaceCoordZGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesCountForPointPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesStepOfPointPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesStepOfPointGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure Act_MakeResourceComponExecute(Sender: TObject); procedure Act_ApplyComponForListResourcesExecute(Sender: TObject); procedure Act_ApplyComponForProjResourcesExecute(Sender: TObject); procedure GT_NormsResourcesCustomDrawCell( Sender: TcxCustomGridTableView; ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean); procedure GT_NormsResourcesTotalKolvoGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesDblClick(Sender: TObject); procedure Act_MasterComplExecute(Sender: TObject); procedure pmiCreateNBUpdateClick(Sender: TObject); procedure Act_DeleteAllCCEExecute(Sender: TObject); procedure Act_MasterDefectActExecute(Sender: TObject); procedure Timer_ShowHidepcObjectsTimer(Sender: TObject); procedure Timer_StartHidepcObjectsTimer(Sender: TObject); procedure pcObjectsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lvTemplatesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure pcObjectsChange(Sender: TObject); procedure Act_MakeTemplateExecute(Sender: TObject); procedure Act_EditTemplateExecute(Sender: TObject); procedure lvTemplatesDblClick(Sender: TObject); procedure Act_DelTemplateExecute(Sender: TObject); procedure lvTemplatesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure lvTemplatesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure lvTemplatesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure lvTemplatesStartDrag(Sender: TObject; var DragObject: TDragObject); procedure lvTemplatesContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure lvTemplatesItemContextMenu(Sender: TObject; Item: TListItem; var Pos: TPoint; var Menu: TPopupMenu); procedure lvTemplatesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lvTemplatesEdited(Sender: TObject; Item: TListItem; var S: String); procedure lvTemplatesResize(Sender: TObject); procedure lvTemplatesEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); procedure Act_DuplicateTemplateExecute(Sender: TObject); procedure lvTemplatesExit(Sender: TObject); procedure lvTemplatesDragDrop(Sender, Source: TObject; X, Y: Integer); procedure lvTemplatesEndDrag(Sender, Target: TObject; X, Y: Integer); procedure Panel_MainResize(Sender: TObject); procedure tvComponGroupsExpanding(Sender: TObject; Node: TFlyNode; var AllowExpansion: Boolean); procedure tvComponGroupsCollapsing(Sender: TObject; Node: TFlyNode; var AllowCollapse: Boolean); procedure cbGroupCompTypeChange(Sender: TObject); procedure btCriterionGroupUpClick(Sender: TObject); procedure CriterionGroupDownClick(Sender: TObject); procedure clGroupPropsChange(Sender: TObject; Index: Integer; NewState: TCheckBoxState); procedure btcbGroupsCategorySettingsClick(Sender: TObject); procedure tvComponGroupsChange(Sender: TObject; Node: TFlyNode); procedure tvComponGroupsStartDrag(Sender: TObject; var DragObject: TDragObject); procedure tvComponGroupsEndDrag(Sender, Target: TObject; X, Y: Integer); procedure tvComponGroupsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure Act_TurnToComponFromGroupsExecute(Sender: TObject); procedure lvTemplatesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure tvComponGroupsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure clGroupPropsChanging(Sender: TObject; Index: Integer; NewState: TCheckBoxState; var AllowChange: Boolean); procedure pmTemplatesPopup(Sender: TObject); procedure pmComponGroupPopup(Sender: TObject); procedure GT_PROPERTYDblClick(Sender: TObject); procedure tbAngleChange(Sender: TObject); procedure TplGrpOpen(Sender: TObject); procedure lvTemplatesClick(Sender: TObject); procedure Act_View3DExecute(Sender: TObject); procedure Act_DrawModeRectExecute(Sender: TObject); procedure Act_DrawModePolyExecute(Sender: TObject); procedure Act_DrawBasementExecute(Sender: TObject); procedure Act_ReindexComponentByTypeInListExecute(Sender: TObject); procedure Timer_NodeShowTimer(Sender: TObject); procedure pmiInterfPathClick(Sender: TObject); procedure Act_CablePathExecute(Sender: TObject); procedure Act_SetActiveToAllComponsExecute(Sender: TObject); procedure sbSelectFromSearchedInCADClick(Sender: TObject); procedure sbSelectFromFilteredInCADClick(Sender: TObject); procedure ButtonEdit_FindDblClick(Sender: TObject); procedure Act_SaveModelToNBExecute(Sender: TObject); procedure Act_SendModelToProjectExecute(Sender: TObject); procedure GT_ConnectionsRelTypePropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_ConnectionsEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); procedure Act_ShowCADObjectViewExecute(Sender: TObject); procedure Act_SetActiveToASelComponsExecute(Sender: TObject); procedure Act_SetProjectibleToSelComponsExecute(Sender: TObject); procedure Act_SetProjectibleToAllComponsExecute(Sender: TObject); procedure tsComponentsResize(Sender: TObject); procedure Act_SetComponGrpNameExecute(Sender: TObject); procedure Act_SelectSameComponsInProjExecute(Sender: TObject); procedure BalloonHintsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo); procedure Act_ReindexComponentPortsExecute(Sender: TObject); procedure Act_ShowRepResourcesExecute(Sender: TObject); procedure Act_CrossConnectionExecute(Sender: TObject); procedure Act_CopyCurrListWithoutComponsExecute(Sender: TObject); procedure N33AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); procedure GT_NormsResourcesLaborTimeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure GT_NormsResourcesLaborTimePropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure GT_NormsResourcesPricePerTimePropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); procedure Act_AutoSetGraphicObjectsExecute(Sender: TObject); procedure Act_CableSwervesExecute(Sender: TObject); procedure Act_PatternMarkingExecute(Sender: TObject); procedure Act_SelAllWithSimilarPropsExecute(Sender: TObject); procedure Act_ShowIntersectionsExecute(Sender: TObject); procedure Act_HideIntersectionsExecute(Sender: TObject); procedure Act_ShowCritIntersectionsExecute(Sender: TObject); Procedure Act_NoConnectedRoutesExecute(Sender: TObject); procedure Act_SetCurrenciesExecute(Sender: TObject); procedure tvCompomGroupsStartDrag(Sender: TObject; var DragObject: TDragObject); procedure tvCompomGroupsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure tvComponGroupsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure ControlBar_ToolsBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); procedure cbTemplatesBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); procedure Act_AddTubeElementExecute(Sender: TObject); procedure Act_EditTubeElementExecute(Sender: TObject); procedure Act_DelTubeElementExecute(Sender: TObject); //Tolik 16/11/2021 -- установка трубных соединений procedure Act_SetTubesElementsExecute(Sender: TObject); procedure SetTubesElements; procedure Act_CupBoard_PortsExecute(Sender: TObject); // private { Private declarations } FParentControl: TWinControl; FLockTreeAndGreedCount: Integer; FTreeClickNode: TTreeNode; FTreeExpandNode: TTreeNode; FTreeExpandNodeCountBefore: Integer; // Количество чайлдов ветки перед раскрытием FTreeMouseDownNode: TTreeNode; FTreeNodeToShow: TTreeNode; // Tolik 28/08/2019 -- //FTreeNodeExpandTick: Cardinal; FTreeNodeExpandTick: DWord; // FCreepNode: TTreeNode; FCreepIndex: integer; FNodeCreepingText: String; FNativeNodeText: String; FEditingPropertyValue: Boolean; GImageDifference: TRect; GTree_Contr: TTreeView; FIsBufferedList: Boolean; FEnabledRefreshNode: Boolean; FLoadedComponElements: TIntList; FLastOnHintNode: TTreeNode; FLastOnHintObject: TObject; FQueryModeByGDBMode: TQueryMode; FHandledTVOnChange: Boolean; FSelCount: integer; FTimerPostGrid: TcxCustomGridTableView; FTimerPostDataSet: TDataSet; ShowCount: Integer; FIsReadOnlyLVTemplates: Boolean; FbtStayOnToppcObjects: TSpeedButton; FPanelForDialog: TPanel; FCheckBoxForDialog: TRzCheckBox; // Tolik 30/04/2021 -- OoldProc: TWndMethod; ToolBar_Tree_oldProc: TWndMethod; ToolBar1_oldProc: TWndMethod; // Procedure NNewProc(var message: TMessage); Procedure ToolBar_Tree_NewProc(var message: TMessage); Procedure ToolBar1_NewProc(var message: TMessage); // //FpmnuActions: TPopupMenu; //procedure WMMove(var M: TWMMove); // message WM_Move; procedure WMMouseWheel(var Msg: TMessage); message WM_MOUSEWHEEL; procedure WMEnterSizeMove(var Message:TMessage); message WM_ENTERSIZEMOVE; //23.12.2011 procedure WMExitSizeMove(var Message:TMessage); message WM_EXITSIZEMOVE; //23.12.2011 procedure WMMove(var Message: TMessage); message WM_MOVE; procedure tcGridDataMenuClick(Sender: TObject); function GetComponIDsWithNoPairInterfaces(AObjectID, AItemType: Integer): TIntList; procedure OnNodeExit(ANode, ANewNode: TTreeNode; ADeactivCabinet: Boolean); procedure WaitForTVChange; function CheckComponComplectBeforeCopy(ASrcForm, ATrgForm: TForm; ASrcCompon: TSCSComponent; ATrgObject: TSCSCatalog; var ATrgCompon: TSCSComponent; ATargetObjNode: TTreeNode; AFromHuman: Boolean): Integer; public { Public declarations } FNormBase: TF_Main; FProjectMan: TF_Main; DM: TDm; //F_ActiveCurrency: TF_ActiveCurrency; F_AddComponent: TF_AddComponent; F_AddInterface: TF_AddInterface; F_Animate: TF_Animate; F_AnswerToQuast: TF_AnswerToQuast; F_BaseOptions: TF_BaseOptions; F_BackUpBase: TF_BackUpBase; F_CanDelete: TF_CanDelete; F_CaseForm: TF_CaseForm; F_ConfiguratorUpdateInfo: TF_ConfiguratorUpdateInfo; F_Connect: TF_Connect; F_FindParams: TF_FindParams; F_ImageShow: TF_ImageShow; F_InputBox: TF_InputBox; F_ItemsSelector: TF_ItemsSelector; F_MakeCurrency: TF_MakeCurrency; F_MakeMarkPage: TF_MakeMarkPage; F_MakeProperty: TF_MakeProperty; F_MakeEditCrossConnection: TF_MakeEditCrossConnection; F_MakeEditComponentType: TF_MakeEditComponentType; F_MakeEditInterface: TF_MakeEditInterface; F_MakeEditInterfaceAccordance: TF_MakeEditInterfaceAccordance; F_MakeEditInterfNorm: TF_MakeEditInterfNorm; F_MakeEditObjectIcons: TF_MakeEditObjectIcons; F_MakeEditObjCurrency: TF_MakeEditObjCurrency; F_MakeEditPortInterfRel: TF_MakeEditPortInterfRel; F_MakeEditProducer: TF_MakeEditProducer; F_MakeEditPropRel: TF_MakeEditPropRel; F_MakeEditSupplyKind: TF_MakeEditSupplyKind; F_MasterCableCanalTracing: TF_MasterCableCanalTracing; F_MasterUpdatePrice: TF_MasterUpdatePrice; F_NDS: TF_NDS; F_ChoiceConnectSide: TF_ChoiceConnectSide; //04.01.2011 F_Norms: TF_Norms; F_MakeNorm: TF_MakeNorm; F_NormsComplete: TF_NormsComplete; F_NormsGroups: TF_NormsGroups; F_ObjectParams: TF_ObjectParams; F_ReportForm: TF_ReportForm; F_ResourceReport: TF_ResourceReport; F_InterfaceInfo: TF_InterfaceInfo; F_MarkMask: TF_MarkMask; //F_ComponTypesMarkMask: TF_ComponTypesMarkMask; F_ConnectComplWith: TF_ConnectComplWith; //05.01.2011 F_UpdateNormBaseDialog: TF_UpdateNormBaseDialog; //*** FastReport //F_MsgDlg: TF_MsgDlg; F_Preview: TF_Preview; F_ProgressExp: TF_ProgressExp; F_CurrencyPreparer: TF_CurrencyPreparer; F_ProjectRev: TF_ProjectRev; GDBMode: TDBKind; Docking: Bool; GConnected : Boolean; //GCreatedDMAIN: Boolean; GPrewSelect: TTreeNode; GFormMode: TFMainMode; GComboIndex: Integer; GCheck_asDefault: Boolean; FAllowTreeCatalogChange: Boolean; GNDS: Double; // Значение НДС,% GCurrencyM: TCurrency; // Главная валюта GCurrencyS: TCurrency; // Вторая валюта GLocalCurrencyM: TObjectCurrencyRel; // Главная валюта GLocalCurrencyS: TObjectCurrencyRel; // Вторая валюта FUOM: Integer; // Ед изм FUOMMin: Integer; FUOMSupplKind: Integer; GCompon : TComponent; GDmainID_Compon : Integer; GDmainID_Catalog: Integer; GDmainFindCompon: Boolean; GDmainIsLine : Integer; GID_DropCatalog: Integer; GID_DropComponent : Integer; GActiveLevelIndex: Integer; GEditKind : TEditKind; GSDat : TObjectData; // Скопированная ветвь GSNotDel: TObjectData; // Не удалать SNotDel, и все что есть в нем (Если ObjID > 0 ) GSNode : TTreeNode; // Source Node GTNode : TTreeNode; // Target Node GSNodes : TList; // Source Nodes FLastNodeDat: TObjectData; FPrevSelectedNodeDat: TObjectData; FPrevSelectionCount: Integer; FIsRefreshNodeObject: Boolean; FIsDefineInterfaceNormsOnChangeNode: Boolean; GNodeXY: TTreeNode; GNewItemType: TItemType; GIDCompForPict: Integer; GFlag_MouseButton : TMouseButton; GFalg_DisableEditTree: Boolean; GKolvoKeyDown: Char; GisBuildedTree: Boolean; GisEditingTree: Boolean; GisFindingNode: Boolean; GisDragTree: Boolean; GisAddEditingComplect : Boolean; GisInitEdit: Boolean; //GisShowDelMessage: Boolean; GSCSBase: TSCSBase; FTraccaLength: Double; //FFilterBlock: TFilterBlock; //FFilterType: TFilterType; FFilterParams: TFilterParams; FGroupFilterBlock: TFilterBlock; //фильтр для группировки FGroupFieldValues: TObjectList; FModsCountBeforeShowGroup: Integer; FCurrUserInfo: TUserInfo; FProjUserInfo: TUserInfo; //GListSetting: TListSettings; //GProjectSettings: TProjectSettings; GCanClearListView: Boolean; GWhoChange: TWhoChange; FCanCallCADOnCopingCompon: Boolean; FTemplateGrp: TTemplateGrpData; FlvTemplate: TRzListView; FQuastAdditButtonsPlaceToConduitMaxCompons: TMsgDlgButtons; FQuastLastResPlaceToConduitMaxCompons: Integer; BkgImages: TList; FOnSetPropValue: TOnSetPropValue; FMultipleAction: Boolean; FMultipleDelComponMode: TDelComponMode; FMultipleCanDelCADGroup: Integer; FMultipleCanDelCablesFromOtherList: Integer; // TOLIk -- 03/07/2017 -- CashedCompon: TSCSComponent; // для ускорения выполнения групповых действий //(например, прокладки кабеля) // function CreateFAddComponent: TF_AddComponent; function CreateFAddInterface: TF_AddInterface; function CreateFBackUpBase: TF_BackUpBase; function CreateFBaseOptions: TF_BaseOptions; function CreateFConnect: TF_Connect; function CreateFConnectComplWith: TF_ConnectComplWith; function CreateFFindParams: TF_FindParams; function CreateFImageShow: TF_ImageShow; function CreateFItemsSelector: TF_ItemsSelector; function CreateFInterfaceInfo: TF_InterfaceInfo; function CreateFMakeEditCrossConnection: TF_MakeEditCrossConnection; function CreateFMakeEditInterface: TF_MakeEditInterface; function CreateFMakeEditInterfaceAccordance: TF_MakeEditInterfaceAccordance; function CreateFMakeEditInterfNorm: TF_MakeEditInterfNorm; function CreateFMakeEditObjCurrency: TF_MakeEditObjCurrency; function CreateFMakeEditObjectIcons: TF_MakeEditObjectIcons; function CreateFMakeEditPortInterfRel: TF_MakeEditPortInterfRel; function CreateFMakeEditProducer: TF_MakeEditProducer; function CreateFMakeEditPropRel: TF_MakeEditPropRel; function CreateFMakeEditSupplyKind: TF_MakeEditSupplyKind; function CreateFMakeNorm: TF_MakeNorm; function CreateFMakeProperty: TF_MakeProperty; function CreateFMarkMask: TF_MarkMask; function CreateFMakeMarkPage: TF_MakeMarkPage; function CreateFMasterCableCanalTracing: TF_MasterCableCanalTracing; function CreateFMasterUpdatePrice: TF_MasterUpdatePrice; function CreateFNormsComplete: TF_NormsComplete; function CreateFNormsGroups: TF_NormsGroups; function CreateFObjectParams: TF_ObjectParams; function CreateFReportForm: TF_ReportForm; function CreateFResourceReport: TF_ResourceReport; function CreateFProjectRev: TF_ProjectRev; Procedure AddNodes(AParentNode: TTreeNode); procedure AfterConnectToBase; procedure ConnectToBase(APath: string=''); procedure DefineCatalogNodeChildNodeExists(ACatalogNode: TTreeNode; AChildCatalogCount, AComponCount: Integer); procedure DefineCatalogNodeHasChildren(ACatalogNode: TTreeNode; AChildCatalogCount, AComponCount: Integer); procedure DefineChildNodes(ANode: TTreeNode); procedure DefineFTraceLength; procedure DefineImageIndexComponNode(AIDComponent: Integer); procedure DefineNodesFontColorByZeroPriceComponents(AColorZeroPriceComponent: TColor); procedure DefineNodesFromAndTo(AParentNode: TTreeNode); procedure DelAllNodes; function DeleteNodes(ANodes: TList): Boolean; function GetComponIDAtCursor(AObjectAtCursor: Pointer): Integer; procedure RefreshNode(ARefreshObject: Boolean = false); procedure RefreshNodeText(ANode: TTreeNode; AObject: TObject; AFullName: Boolean=true; AKolChild: Boolean=true); //07.10.2010 procedure StartDragCompon(AComponID: Integer); procedure EndDragCompon; procedure ReloadNodes(AParentNode: TTreeNode); procedure ReselectNode; procedure SelectNodeAtCursor; procedure SelectNodeDirect(ANode: TTreeNode); function DefineObjectGroupForCatalogData(ASCSList: TSCSList; aListNode: TTreeNode; aData: PObjectData; const AComponentType: String; ASprComponentType: TNBComponentType; AIsLineObject: Integer): TTreeNode; procedure DefineObjectNodeGroup(AObjectNode: TTreeNode; AGUIDComponType: String; AIsLine: Integer); procedure DefineObjectGroupForCatalog(ACatalog: TSCSCatalog); procedure DefineUniversalInterfacesByProperty(AComponent: TSCSComponent; AProp: PProperty); procedure ReDefineConstrInterfacesByProperty(AComponent: TSCSComponent; AProp: PProperty; aAutoAdd: boolean); procedure StepNodes(AParentN : TTreeNode; AParentCatalog: TSCSCatalog; AisSecondLevel: Boolean); procedure FillCompons(ADirNode: TTreeNode; ADefChildCount: Boolean; AQueryMode: TQueryMode); function GetCatalogNodeChildCatalogCount(ANode: TTreeNode): Integer; function GetCatalogNodeComponCount(ANode: TTreeNode): Integer; procedure ExchNodes(ANode1, ANode2: TTreeNode; AMode: TNodeAttachMode); function GetImageIndexByObjectData(AObjectData: PObjectData; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone; AObject: TObject = nil): Integer; procedure SetListItemImageIndex(AListItem: TListItem; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone); procedure SetNodeState(ANode: TTreeNode; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone; AObject: TObject = nil); function GetFirstSiblingNodeByItemType(ANode, ANotAllowNode: TTreeNode; AItemType: Integer): TTreeNode; function GetTopNode: TTreeNode; function GetTopNodeByNBMode(ANBMode: TNBMode; AItemType: Integer): TTreeNode; function CanParantNodeHaveChildItemInTreeView(AParentNode: TTreeNode; AChildItem: TItemType; AChildQueryMode: TQueryMode): Boolean; function CanEditNode(ANodeDat: PObjectData): Boolean; function GetParentNodeByItemType(ANode: TTreeNode; AItemTypes: TIntSet): TTreeNode; function GetTargetNodeForItemType(ACurrTrgNode: TTreeNode; AChldItemType: TItemType; AChildQueryMode: TQueryMode): TTreeNode; function GetTopCatalogID: Integer; Procedure LoadCatalogs(AParentID, AParentLevel: Integer; var ACatalogs: TSCSCatalogs; AQueryMode: TQueryMode); function FindChildNodeByIDCompRel(ANode: TTreeNode; AIDCompRel: Integer): TTreeNode; //function FindComponOrDirInTree(AFindID: Integer; AComponent: Boolean; AQueryMode: TQueryMode = qmUndef): TTreeNode; function FindComponOrDirInTree(AFindID: Integer; AComponent: Boolean; AQueryMode: TQueryMode = qmUndef; ffTopNode: TTreeNode = nil): TTreeNode; function FindComponOrDirInTreeByList(AListID, AFindID: Integer; AComponent: Boolean; AQueryMode: TQueryMode = qmUndef): TTreeNode; function FindTreeNodeByDat(AFindID: Integer; AFindViewType: TIntSet; AFromNode: TTreeNode = nil): TTreeNode; procedure PasteNode(ASrcNode, ATrgNode: TTreeNode; ASrcDat: PObjectData; AEditKind: TEditKind); procedure MoveNodeTo(ASrcNode, ADestNode: TTreeNode; AMode: TNodeAttachMode); function GetComponentFromNode(ANode: TTreeNode): TSCSComponent; function GetActualSelectedComponent: TSCSComponent; function GetActualSelectedCatalog: TSCSCatalog; function GetActualSelectedObj: TSCSComponCatalogClass; function SelectComponByGUIDInTree(AGUIDComponent: String): TTreeNode; function SelectComponByIDInTree(AIDComponent: Integer): TTreeNode; function SelectObjByIDInTree(AIDObj: Integer): TTreeNode; function FindComponentByGUIDWithBlink(AGUIDComponent: String): TTreeNode; procedure SaveComplects(AComponent: TSCSComponent; AComponID: Integer; AOnlyIOfIRel: Boolean = false); function SaveComponent(ASrcCompon, ATrgCompon: TSCSComponent; ATrgNode: TTreeNode; ASrcForm, ATrgForm: TForm; ASrcObject, ATrgObject: TSCSCatalog; ADefineMark, ALoadTopComponToNode: boolean; AComponKind: TComponKind): TSCSComponent; procedure AfterSaveComponent(AIDSrcCompon: Integer; ACompon: TSCSComponent; ATrgObject: TSCSCatalog; ASrcForm, ATrgForm: TForm; AComponKind: TComponKind; ACheckVolumeResult: TModalResult; ATrgFemaleCompon: TSCSComponent; AFromHuman: Boolean); function CopyComponentFromNbToPm(ASourceForm, ATargetForm: TForm; ASrcNode, ATargetNode: TTreeNode; AID_NBCompon: Integer; AComponKind: TComponKind; AFromHuman: Boolean = false; ALeaveComplects: Boolean = false): Integer; Procedure CreateAndConnectNewSCSCompon(ASourceForm, ATargetForm: TForm; //From Dimon ;) ASrcNode: TTreeNode; AID_NBCompon: Integer; var ComponentToSave: TSCSComponent; TargetObject: TSCSCatalog; CanDevideComplects: Boolean; var NewComponList: TList); procedure CopyCurrList(aCopyCompons: Boolean=true); function AppendRemoveComponInterfacesInCAD(AID_Component: Integer; AppendRemove: TAppendRemove): Boolean; procedure AppendRemoveComponInterfacesInCADByAllParams(ACatalog: TSCSCatalog; ACompon: TSCSComponent; AIDInterfList: TList; AppendRemove: TAppendRemove); function CanExpandOnDoubleClick(ANode: TTreeNode): Boolean; function OpenNode(ANode: TTreeNode): Boolean; //Tolik 18/06/2021 -- //function SwitchInCAD(ANode: TTreeNode; AClickCount: TClickCount): Boolean; function SwitchInCAD(ANode: TTreeNode; AClickCount: TClickCount; aReSelectNode: Boolean = True): Boolean; // procedure SelectTraceInCADByIDCompon(AIDComponent: Integer); function CreateNBCatalog(AParentCatalog: TSCSCatalog; const AName: String): TSCSCatalog; function MakeDir(ACallFrom: TCallFrom; AParentNode: TTreeNode; ACaption: String; AItemType: TItemType; ADataPointer: Pointer; ASCS_ID: Integer = -1; AKolCompon: Integer = -1; ASortID: Integer = -1; AFullMaking: Boolean = true): TTreeNode; function MakeNodeForNewComponent(ACatalogNode: TTreeNode; ANewComponent: TSCSComponent): TTreeNode; procedure MakeEditCrossConnection(AMakeEdit: TMakeEdit); procedure AddCrossConnectionToParentComponent(AParentComponent, AComponent: TSCSComponent); procedure MakeEditObjectCurrency(AMakeEdit: TMakeEdit; AObjectID: Integer); //procedure MakeSCS procedure FillCompl(AID_Compon: Integer; ACompNode: TTreeNode; ACompon: TSCSComponent=nil; AStepIndex: Integer = 0); procedure DelCompon(AComponent: TSCSComponent; ANode: TTreeNode; ADisconnect, ACanOnAfterDel, ARemoveInterfFromCAD, ADeletedAsComplect: Boolean); function DelComponByNode(ANode: TTreeNode): Boolean; //14.02.2012 - портировано из Act_DelComponentExecute procedure DelComponsByTypeFromList(AIDList: Integer; AComponentTypeSysName: String); procedure DelComponentsFromList(AList: TSCSList; AComponents: TSCSComponents; AlookOtherLists: Boolean; ADelComponsFromOtherList: integer=biNone; ASaveToUnoStack: Boolean=true; ASCSListIDs: TIntList=nil); // Удалит все объекты группы procedure DeleteObjectGroup(AGroupNode: TTreeNode); // Вернет список Id листов от компонентов function GetSCSListsIDsByCompons(AAtList: TSCSList; ACompons: TSCSComponents; AServToDel: Boolean=false; ARes: TIntList=nil; ADelComponsFromOtherList: integer = biNone): TIntList; //14.02.2012 function SelectComponentFromList(AComponents: TSCSComponents; APropSysNameToShow, ACaption, AMessgLabel, AMessgCheckBox: String; AControlTypeApplyForAll: Integer; AButtons: TibButtons; AModalResult: PInteger; ACheckBoxRes: PInteger; aIDToSel: Integer=0 ): TSCSComponent; procedure ShowComponentsInList(AComponents: TSCSComponents; ACaption, AMessg: String); procedure ShowComponentsInListByIDList(AIDComponents: TIntList; ACaption, AMessg: String); procedure ShowCurrComponProperties; procedure SetInterfacesCoordZ(AInterfaces: TList; ACoordZ: Double); procedure ChangeLineObjectSideCoordZ(AIDCatalog: Integer; AInterfaces: TList; ACoordZ: Double); procedure ChangeConObjectCoordZ(ASCSCatalog: TSCSCatalog; ACoordZ: Double); procedure ChangeLineObjectLength(ASCSObject: TSCSCatalog; ALength: Double); Procedure EnableEditDel(AViewType: TItemType); procedure EnableDisableCost(AEnable: Boolean); procedure EnableDisableListActions(AEnable: Boolean); procedure EnableDisablePopupMenuCatalogItems; Procedure EnableDisableEdit(AEnabled: Boolean); procedure EnablePaste; procedure EnableDragPanels; procedure EnableDisableActsWithDefCompons; procedure LockTreeAndGrid(ALock: Boolean); Procedure RollBackCut; procedure AddInterfacePort(AIsPort: Integer); procedure EditInterfacePort(AIsPort: Integer); procedure DelInterfacePort(AIsPort: Integer); procedure ShowPrice; procedure SetPriceCostPanel; procedure LoadCurrencyFormat; procedure SortByVetv(AParentNode: TTreeNode); procedure DefineLocalCurrency; procedure LoadLocalCurrencyFromDefault; procedure SetCurrencyBriefToControls; procedure SetUOMToControls; function CreateSecondForm(AGDBMode: TDBKind; AFMainMode: TFMainMode; ACaption: String; AConnectType: TConnectType): TModalResult; function CreateNewForm(ACaption: String): TModalResult; procedure ShowAddComplError(Messg: String); //function ChoiceAddCompl(var AComponNode: TTreeNode; var ACanAdd: Boolean; // var AID_Component: Integer; AID_Child: Integer; AText: String): Boolean; procedure DelNodeWithClearFieldInObject(ANode: TTreeNode); procedure MoveDir(ASrcNode, ATrgNode: TTreeNode); procedure MoveCompl(ASrcNode, ATrgNode: TTreeNode; AShowMessageType: TShowMessageType; AIsFromUser: Boolean=false); function DeleteDirByNode(ANode: TTreeNode): Boolean; procedure DeleteCatalog(ACatalog: TSCSCatalog; ANode: TTreeNode; AIgnoreCADConditions: Boolean=false); function AddComplectToComponByIDs(AIDCompon, AIDComplect, AKolvo, AIDTopComponent, AIDParentCompRel: Integer; ASelectNode, ACanConnectWithoutInterf: Boolean): Boolean; function AddComplect(AFormBase: TForm; ASrcNode, ATargetNode: TTreeNode; AComplect: TSCSComponent; AConnectType: TConnectType; ACount: Integer; ACanManualJoin: Boolean; ASelectNode: Boolean = true; ACanConnectWithoutInterf: Boolean = false): Boolean; procedure DelComplect(AID_CompRel, AIDTopCompon, AIDCurrCompon, AIDChild: Integer; AComponNode: TTreeNode; AConnectType: TConnectType); procedure DelComplFromTreeOrGrid(AWhoChange: TWhoChange; ATreeNode: TTreeNode=nil); procedure JoinComponentsByTreeNodes(ASrcNode, ATrgNode: TTreeNode; ASrcComponent: TSCSComponent; ACanManualChoiceInterface: Boolean); procedure RefreshNodesText(AParentNode: TTreeNode; AItemTypes: TIntSet); procedure RememberIDLastNBDir(ANode: TTreeNode); function RenameNode(ACallFrom: TCallFrom; ANode: TTreeNode; AObject: TBasicSCSClass; ANewName: String): String; procedure RenameAllComplNodes(AID_Component: Integer; ANewName: String); procedure AddEditComplect(AFormBase: TForm; AParam: TComplectFormMode; AisMemTable: Boolean; AConnectType: TConnectType); function CanCycleCompon(AID_Component, AID_CanChild: Integer): Boolean; procedure AppendToCatalRel(AID_Cat, AID_Compon: Integer); function AppendToComponRel(AID_Compon, AID_Child, AKolvo, AIDTopComponent, AIDParentCompRel, AKolSubComplect: Integer; AConnectType: TConnectType): integer; procedure AddEditProperty(AMakeEdit: TMakeEdit); procedure AddEditCableCanalConnector(AMakeEdit: TMakeEdit); //Tolik 15/11/2021 -- procedure AddEditTubeElement(AMakeEdit: TMakeEdit); // procedure OnAddEditPropertyRel(AMakeEdit: TMakeEdit; APropKind: TPropKind; AMasterID: Integer; var AProperty: TProperty); procedure OnChangeComponPriceCalc(AIDComponent: Integer; AOldPrice, ANewPrice: Double); procedure OnChangeComponPropertyVal(AProperty: PProperty; ACompon: TSCSComponent; AOldProperty: PProperty=nil); procedure OnChangeComponProperty(ACompon: TSCSComponent; const ASysName: String); function OnCheckPropRelFormValue(ASender: TObject; AProp: PProperty; aDataSetProps: TDataSet): Boolean; procedure OnSetComponPropertyVal(AMakeEdit: TMakeEdit; AProperty: PProperty; ACompon: TSCSComponent; AOldProperty: PProperty=nil); procedure OnSetPropValueForm(ASender, AObj: TObject; AProp: PProperty; const AOldVal: String; AChecked: Boolean); procedure OnClickCompon(ACompon: TSCSComponent); procedure OnpmiInterfPathClick(Sender: TObject); procedure OnSelectCompon(ACompon: TSCSComponent); procedure OnUpdateComponent(AMakeEdit: TMakeEdit; AOldComponent, ANewComponent: TSCSComponent; AChangedComponIndex, AChangedNameShort: Boolean); function SetComponPropValue(ACompon: TSCSComponent; const APropSN, AValue: String): Boolean; function RefreshTreeNodeComponent(ANode: TTreeNode): TSCSComponent; procedure ShowComponObjects(ANode: TTreeNode; ACompon: TSCSComponent); //function GetIDPropertyBySysName(ATableKind: TTableKind; AID: Integer; APropSysName: String; AIDItemType: Integer): Integer; //procedure SetPropertyValue(ATableKind: TTableKind; AID: Integer; APropSysName, AValue: String; AQueryMode: TQueryMode; AIDProperty: Integer); //procedure SetPropertyValueAsFloat(ATableKind: TTableKind; AID: Integer; APropSysName: String; AValue: Double; AQueryMode: TQueryMode; AIDProperty: Integer); //function GetPropertyValue(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): String; //function GetPropertyValueAsFloat(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): Double; //function GetPropertyValueAsInteger(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): Integer; procedure WriteOptionsToINI; procedure CalcPriceForParents(AID_Component: Integer; ALookedComponIDs: TIntList=nil); function CalcPrice(AID_Component: Integer): Double; function GetComponPrice(AIDComponent, AIDCompRel, AIDTopComponent: Integer): Double; function GetCompSquare: Double; function GetColCompINDir(ADir: TTreeNode): Integer; procedure MoveTreeNode(AMoveType: TMoveType); procedure SetSortID(ANode: TTreeNode; AObject: TObject); procedure SetKol(ANode: TTreeNode; AObject: TObject); procedure OnAddDeleteNode(ANode: TTreeNode; AObject, AParentObject: TBasicSCSClass; AAdding: Boolean); function OnAddDeleteObject(AObject: TBasicSCSClass; AAdding: Boolean): Boolean; function GetNameNode(ANode: TTreeNode; AObject: TObject; AFullName, AKolChild: Boolean): String; procedure GetNameNodeType(ANode: TTreeNode; var ANameType, ANameTypes, ANameTypeGnd: String); function GetNextSelNodeAfterDel(ANode: TTreeNode): TTreeNode; function GetNodeByObj(AObject: TObject; aTopNode: TTreeNode = nil): TTreeNode; //function GetNodeByObj(AObject: TObject): TTreeNode; function GetObjNameForVisible(ASCSObject: TSCSCatalog; AProjPart: TProjPart): String; function DefineConnectorObjectNodeName(ASCSObject: TSCSCatalog): String; function MakeNameMarkCatalog(AIDCatalog: Integer; AUpdateInBase: Boolean; AQueryMode: TQueryMode): String; function MakeNameMarkComponent(AComponent: TSCSComponent; AObject: TSCSCatalog; AUpdateInBase: Boolean; AMarkTemplate: String = ''): String; function GenComponentMarkID(AComponent: TSCSComponent): Integer; function GetNameConnectFromAndTo(APartComponent: TSCSComponent): String; procedure ShowKolForDir(ANode: TTreeNode; AKol: Integer); procedure SetSql(ParamID: Integer); function GetSCSComponType(AisLine: integer; AAsLinkToCompon: Boolean = false): Integer; function GetisLine(ACompItemType: TItemType): Integer; //function CheckInterfForUnion(AInterf1, Ainterf2: TInterface; // AConnectKinds: TConnectKind): TCheckInterfForUnionResult; procedure ShowCheckInterfForUnionResult(ACheckInterfForUnionResult: TCheckInterfForUnionResult); function UnionInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AConnectKind: TConnectKind): Boolean; // Соединяет интерфейсы function ConnectInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AIDCompRel: Integer; AConnectType: TConnectType; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; AIsFinalConnection: Boolean): TSCSIOfIRel; // Соединяет интерфейсы с учетом соответствующих function ConnectInterfacesWithAccordance(AInterfRel1, AInterfRel2: TSCSInterface; AInterfCount1, AInterfCount2, AIDCompRel, AConnectType: Integer; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; AIsFinalConnection: Boolean; AInterfList1, AInterfList2: TSCSInterfaces): Boolean; procedure FreeCompRel(AIDCompRel: Integer; ACompon, AChild: TSCSComponent); // подгружает путь из ID связей компонент от ANode к AIDTopCompon procedure LoadCompRelPathIDsToListFromNode(APathList: TIntList; AIDTopCompon: Integer; ANode: TTreeNode); function DisconnectInterfaces(AIDInterfRel1, AIDInterfRel2: Integer; AIDCompRel: Integer = -1): Boolean; //function ConnectCompons(ACompon1, ACompon2: TSCSComponent; AConnectKind: TConnectKind; // AConnectType: TConnectType; AID_CompRel: Integer = -1): Boolean; //function SynthesisInterf(ACompon1, ACompon2: TSCSComponent; AInterfLists: TInterfLists; // AConnectKind: TConnectKind; AConnectType: TConnectType): TCanConnectKind; function CanFemaleHaveMale(AFemaleInterface: TSCSInterface; AAdditionMaleValue, ACableCanalFullnessKoef: Double): TCanFemaleHaveMaleRes; function CheckGender(AInterf1, AInterf2: TSCSInterface; AConnectType: Integer): Boolean; function CheckInterf(AInterface1, AInterface2: TSCSInterface; AConnectType: TConnectType; AKolvoInterf1, AKolvoInterf2: PInteger): Boolean; function GetConnectKind(AGender1, AGender2: TGenderType): TConnectKind; // Проверяет возможность контроля по этому свойству function CanConnectControlByProperty(AProperty: PProperty; AConnectType: TConnectType; ACheckControlComplect, ACheckControlJoin: Boolean): Boolean; // Проверяет возможность контроля по этим свойствам function CheckCanConnectProperties(AProperty1, AProperty2: PProperty; AConnectType: TConnectType; ACheckControlComplect, ACheckControlJoin, AForEndPointCompons: Boolean; AMessgNotAgreeProps: PString): Boolean; // Проверка на возможность подключения двух конечных точечных компонент линейным по свойствам function CheckCanJoinEndComponsByProps(APointCompon1, APointCompon2: TSCSComponent; AMessgNotAgreeProps: PString): Boolean; function CanConnCompon(ACompon1, ACompon2: TSCSComponent; AConnectType: TConnectType; AShowMessageType: TShowMessageType; ACheckVariousObject: Boolean = true; AIDCompRelToSkip: Integer=-1): Boolean; //function CanConnComponByinterf(AFormBase: TForm; ACompon, ACompl: TSCSComponent; // AConnectKind: TConnectkind; AConnectType: TConnectType; ATakeBusy: Boolean = false): TCanConnectKind; procedure FillInterfList(var AInterfList: TList; AID_Compon: Integer; AConnectType: TConnectType; ATakeBusy: Boolean = false); function GetInterfPortMemTable: TkbmMemTable; procedure DisconnectCompon(AIDCompon: Integer; ACompon: TSCSComponent); function ReplaceComponent(AFolder: TSCSCatalog; AReplaceCompon: TSCSComponent): Boolean; function ReplaceComponents(AComponentsToReplace: TSCSComponents; ANBComponent: TSCSComponent): Boolean; //Tolik 22/11/2021-- //procedure SetCableCanalConnectors(AForSelectedTraces: Boolean); procedure SetCableCanalConnectors(AForSelectedTraces: Boolean; aInstallTubesElements: Boolean = false); // procedure ApplyComponPropsForRelatedResources(ADestCatalog: TSCSCatalog; ASrcCompon: TSCSComponent); function GetComponNode(AComplNode: TTreeNode): TTreeNode; function AddComplNode(AComponNode: TTreeNode; AComplData: TSCSComponent): TTreeNode; // вернет список всех парентов для текущей комплектующей в дереве function GetComplNodeParentIDs(AComponNode: TTreeNode): TIntList; function GetComponNodeNBConnections(AComponNode: TTreeNode): TSCSObjectList; // вернет общую ветвь-компоненту для компонент function GetCommonParentComponNode(ANode1, ANode2: TTreeNode): TTreeNode; function GetIDCompRelFromNode(ANode: TTreeNode): Integer; function GetTopComponIDByNode(AComponNode: TTreeNode): Integer; function GetTopComponNode(ACurrComponNode: TTreeNode): TTreeNode; function HaveConnect(AComponent: TSCSComponent; AShowList: Boolean): Boolean; function CheckComponVolumeBeforeCopy(ASrcForm, ATrgForm: TForm; ASrcCompon: TSCSComponent; ATrgObject: TSCSCatalog; var ATrgCompon: TSCSComponent; ATargetObjNode: TTreeNode; AFromHuman: Boolean): Integer; function InsertComplectInObject(AInsComponentNode: TTreeNode; ATrgObject: TSCSCatalog; AInsCompon, ATrgCompon: TSCSComponent; AFromHuman: Boolean): Boolean; procedure MoveComponComplectsToUp(ACompon: TSCSComponent; AComponNode: TTreeNode); function isComplect(AIDComponent: Integer; AQuery: TSCSQuery): Boolean; function isComplectWhere(AComponent: TSCSComponent; AMess1, AMess2: String): Boolean; procedure ShowConnDisconnCompons(ACatalog: TSCSCatalog; AModeConnDisconnCompons: TModeConnDisconnCompons); // added by Tolik // показать повороты (изгибы) кабеля procedure ShowCableSwerves(ACatalog : TSCSCatalog); // function CheckDefaultCompon(AID_Component: Integer; AComponType: TComponType): Integer; function CheckList(AListID: Integer): Integer; function CheckIsCloseProject: Boolean; procedure CheckBackUpBase; function CloseProject(ACloseApplication: Boolean; AMessageIfClosed: Boolean = true): Integer; function SaveProjectFromNodeToFile(ANode: TTreeNode): Boolean; procedure SaveProjectRevision; procedure StartStopProgress(AStartStop: TStartStop; ACaption: String = ''); function IsCurrProjectNode(ANode: TTreeNode): Boolean; function GetCatalogExtendedFromCurrNode: TSCSCatalogExtended; function GetSpravochnik: TSpravochnik; procedure StartCreepingNode(ANode: TTreeNode; ACreepText: String); procedure StopCreepingNode; procedure AddComponInfoToStrings(AID, AIsLine: Integer; AName: string; AStrings: TStringList); procedure LoadItemsToListViewFromStringList(AStringList: TStringList); procedure ApplyComponentFilter(AOldFilter, ANewFilter: TFilterParams; ADefineUserParams: Boolean); procedure ApplyComponFilterToListIDs(AComponIDList: TIntList); procedure DefineComponentFilterUserParams(AFilter: TFilterBlock); procedure SaveComponFilter; procedure SetFilterBlockForCompType(AComponTypeSysNames: TStringList); procedure AddEditNorm(AMakeEdit: TMakeEdit); procedure AddEditResource(AMakeEdit: TMakeEdit; AMakeFromCompon: Boolean); procedure SaveSelectedConnection; procedure SaveSelectedNormResource; function BrowseNewDirName(aTitle, aDirPath, aDefNewDirName: string): string; procedure BrowseNewDirCanClose(Sender: TObject; var CanClose: Boolean); procedure BrowseNewDirShow(Sender: TObject); procedure BrowseNewDirSelectionChange(Sender: TObject); procedure DialogWithCheckBoxOnShow(Sender: TObject); procedure DialogWithCheckBoxOnClose(Sender: TObject); function ExecuteDialogWithCheckBox(ADialog: TCommonDialog; ACheckBoxCaption: String; ACheckState: PBoolean): Boolean; function CheckAdminPM(AShowMessage: Boolean): Boolean; function CheckWriteNB(AShowMessage: Boolean): Boolean; function CheckWriteNBByUser: Boolean; function CheckWritePM(AShowMessage: Boolean=true): Boolean; function CheckWriteProj(AProjID: integer; AShowMessage: Boolean=true): Boolean; procedure ClearProjUserInfo; function LoginUserToPM(ALoginByDefAdminUser, AReadFromRegister: Boolean): Boolean; function LoginUserToProject(AProjID: Integer): Boolean; function ShowProjUsers(AProjID: Integer): Boolean; function AddTemplateItem(AListView: TRZListView; AComponent: TSCSComponent): TListItem; procedure ArrangeLVTemplates(AListView: TRZListView); procedure ComponDrawModeChange(AModeIndex: Integer); procedure ComponToTemplateItem(AMakeEdit: TMakeEdit; AComponent: TSCSComponent; AItem: TListItem); procedure ClearTemplateGroups; procedure CreateTemplateControls(AStayOnTopButton: Boolean); procedure DeleteTemplateItem(AItem: TListItem); function GetSelectedComponGroups: string; function GetTemplateMaxSortID: Integer; procedure EditingTemplateName; procedure EnableEditDelTemplate; procedure EnableEditDelComponGroup; procedure HideTemplateControls; procedure HideTemplateEditingControls; procedure HideTemplateItems(AExcludedCompType: TStringList; AExcludeWithSysNames: Boolean); function GetSelectedObjectData(var AObjID, AObjItemType: Integer): PObjectData; function GetTemplateItemByComponID(AListView: TRZListView; AIDCompon: Integer): TListItem; function GetTemplateGrpByID(AID: Integer): TTemplateGrpData; function GetTemplateGrpByType(AType: Integer): TTemplateGrpData; function GetTemplateGrpType: Integer; procedure InitComponGroup(const ASelectedComponGrp: String); procedure LoadDataToComponGroup(AGroupNode: TFlyNode); procedure LoadSelectedComponGroups(AGroupFilterBlock: TFilterBlock); procedure LoadTypeComponGroups(const ACompTypeSysName: string; AGroupFilterBlock: TFilterBlock); procedure LoadTemplatesToListView(AGroupType: Integer; AListView: TRZListView); procedure LoadTemplateGroups; procedure MoveGroupProp(AMoveSteps: Integer); procedure MoveTemplateItem(ASrc, ATrg: TListItem); procedure PostGridTableView(AGridDBTableView: TcxCustomGridTableView; ADataSet: TDataSet); procedure SaveReloadTypeComponGroups; procedure SaveTypeComponGroups(const ACompTypeSysName: string; AGroupFilterBlock: TFilterBlock); procedure OpenTemplateGroup; // Переиндексация однотипных компонентов procedure ReindexComponsByType(ACatalog: TSCSCatalogExtended; const AComponTypeGUID: string; AStartIndex:Integer=0; ACorrectCompTypeComponIdx: Boolean=false; aOnlySelected: boolean = False); function SelectTemplateItemByComponID(ATemplateID, AIDCompon: Integer): TListItem; function SelectComponInPCObjects(AIDComponent: Integer): TObject; function SelectComponInPCObjectsByGUID(AGUIDComponent: string): TObject; procedure SetComponGroupsToCombo(ACombo: TRzComboBox); procedure SetComponGroupsToComboFromCompTypes(ACombo: TRzComboBox; ACompTypes: TStringList); procedure SetComponGroupsToForm(const ASelectedComponGrp: String); procedure SetComponsPropValByCurrNode(const APropSN, AVal, AQuestMsg: String; AOnlySelected: Boolean); procedure SetControlsByUseLiteFunctional(ALiteVersion, AUseLiteFunctional, ARefresh: Boolean); procedure SetControlsByArhOnlyMode; procedure SetEventsToLVTemplate(AOnSelectItem: TLVSelectItemEvent; AOnDBLClick: TNotifyEvent); procedure SetFullRepaint(AVal: Boolean); procedure SetSelectedComponGroups(const ACompType: string); procedure SetpcObjectsTab(AIndex: Integer); procedure SetpcObjectsTabWidth(ATabWidth: Integer); procedure ShowCADObjectView(AContinue: Boolean=true; AComponent: TSCSComponent=nil); procedure ShowMenuItems(aItem: TMenuItem; const aControlName: string); procedure FbtStayOnToppcObjectsClick(Sender: TObject); constructor Create(AOwner: TComponent; AGDBMode: TDBKind; AFormMode: TFMainMode; AParent: TWinControl = nil); //destructor Destroy; override; procedure IdleEventHandler(Sender: TObject; var Done: Boolean); procedure SettingChangeEventHandler(Sender: TObject; Flag: Integer; const Section: string; var Result: Longint); procedure OpenBackgrImages; procedure CorrectSILFile; end; //function CompareComponGroupNodes(Item1, Item2: TTreeCollection): Integer; stdcall; var F_ProjMan, F_NormBase: TF_Main; F_DMAIN: TF_MAIN; GGDBMode: TDBKind; GDropComponent: TSCSComponent; GTestComponent: TSCSComponent; GLog: TStringList; //GCurrNBComponent: TSCSComponent; //GSCSComponent: TSCSComponent; implementation Uses //Types, SQLMemMain, {$IF Not Defined (FINAL_SCS)} U_ImportDBF, {$IFEND} // 2011-05-10 USCS_MAIN, U_Progress, U_ESCadClasess, U_ArchCommon, U_ArchClasses, cxButtons, U_ProtectionCommon, {U_Arch3D} U_Arch3DNew, Form3D, U_CAD, U_MasterNewList, U_PEAutoTraceDialog, U_PortsReIndex; {$R *.dfm} { TComponGrpData } constructor TComponGrpData.Create; begin inherited; FFilterBlock := nil; FComponData := nil; PropValue := ''; PropDataType := dtNone; end; destructor TComponGrpData.Destroy; begin if FFilterBlock <> nil then FreeAndNil(FFilterBlock); if FComponData <> nil then FreeMem(FComponData); inherited; end; constructor TTemplateGrpData.create; begin inherited; end; Destructor TTemplateGrpData.Destroy; begin inherited; end; { TESTreeView } constructor TESTreeView.Create(AOwner: TComponent); begin inherited Create(AOwner); FLastOnMoveNode := nil; FUserExpand := true; FEditingNode := false; end; procedure TESTreeView.EditNode(Node: TTreeNode); begin FEditingNode := true; Node.EditText; end; procedure TESTreeView.MoveNode(Source, Destination: TTreeNode; Mode: TNodeAttachMode); begin if Assigned(FOnBeforeMoveNode) then FOnBeforeMoveNode(Self, Source, Destination, Mode); Source.MoveTo(Destination, Mode); if Assigned(FOnAfterMoveNode) then FOnAfterMoveNode(Self, Source, Destination, Mode); end; procedure TESTreeView.Edit(const Item: TTVItem); begin inherited Edit(Item); //if Item.pszText = nil then FOnEditCancelled(Self); FEditingNode := False; end; procedure TESTreeView.SetItemBold(ANode: TTreeNode; Value: Boolean); var Item: TTVItem; Template: Integer; begin if ANode = nil then Exit; if Value then Template := -1 else Template := 0; Item.mask := TVIF_STATE; Item.hItem := ANode.ItemId; Item.stateMask := TVIS_BOLD; Item.state := Item.stateMask and Template; TreeView_SetItem(Handle, Item); end; procedure TESTreeView.Select(Nodes: TList); var i: integer; Node: TTreeNode; begin for i := 0 to Nodes.Count - 1 do begin Node := Nodes[i]; while Not Node.IsVisible do begin Node.Parent.Expanded := true; Node := Node.Parent; if Node = nil then Break; //// BREAK //// end; end; inherited Select(Nodes); end; procedure TESTreeView.SetNodeSate(ANode: TTreeNode; AFlags: Integer); var Item: TTVItem; begin end; { procedure TESTreeView.WMLButtonDown(var Message: TWMLButtonDown); begin SendCancelMode(Self); if csCaptureMouse in ControlStyle then MouseCapture := True; if csClickEvents in ControlStyle then Include(ControlState, csClicked); DoMouseDown(Message, mbLeft, []); inherited; end; } // ######################### Собственные функции ############################### // ############################################################################# // Procedure TF_Main.NNewProc(var message: TMessage); var CControl: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin CControl := ToolBar_CompData.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(CControl) then if CControl is TToolButton then CheckCloseReportForm; end; end; OoldProc(Message); end; Procedure TF_Main.ToolBar_Tree_NewProc(var message: TMessage); var CControl: TControl; begin if GDBMode = bkProjectManager then begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin CControl := ToolBar_Tree.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(CControl) then if CControl is TToolButton then CheckCloseReportForm; end; end; end; ToolBar_Tree_OldProc(Message); end; Procedure TF_Main.ToolBar1_NewProc(var message: TMessage); var CControl: TControl; begin case message.Msg of WM_LBUTTONDOWN, WM_LBUTTONDBLCLK: begin CControl := ToolBar1.ControlAtPos(SmallPointToPoint(TWMMouse(Message).Pos), False); if Assigned(CControl) then if CControl is TToolButton then CheckCloseReportForm; end; end; ToolBar1_OldProc(Message); end; function TF_MAIN.CreateFAddComponent: TF_AddComponent; begin if F_AddComponent = nil then begin F_AddComponent := TF_AddComponent.Create(Self, TForm(Self)); SetCurrencyBriefToControls; // Применяем тек. валюту на контролы формы end; Result := F_AddComponent; end; function TF_MAIN.CreateFAddInterface: TF_AddInterface; begin if F_AddInterface = nil then F_AddInterface := TF_AddInterface.Create(Self, TForm(Self) ); Result := F_AddInterface; end; function TF_MAIN.CreateFBackUpBase: TF_BackUpBase; begin if F_BackUpBase = nil then F_BackUpBase := TF_BackUpBase.Create(Self, TForm(Self)); Result := F_BackUpBase; end; function TF_MAIN.CreateFBaseOptions: TF_BaseOptions; begin if F_BaseOptions = nil then begin F_BaseOptions := TF_BaseOptions.Create(Self, TForm(Self)); {$IF Defined(SCS_RF)} //*** Убрать панель с украинским переключателем F_BaseOptions.HideTabSheet(F_BaseOptions.tsReportDesigner); {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_SPA)} //*** Убрать панель с украинским переключателем F_BaseOptions.HideTabSheet(F_BaseOptions.tsReportDesigner); {$IFEND} end; Result := F_BaseOptions; end; function TF_MAIN.CreateFConnect: TF_Connect; begin if F_Connect = nil then F_Connect := TF_Connect.Create(Self, TForm(Self)); Result := F_Connect; end; function TF_MAIN.CreateFConnectComplWith: TF_ConnectComplWith; begin if F_ConnectComplWith = nil then F_ConnectComplWith := TF_ConnectComplWith.Create(Self, TForm(Self)); Result := F_ConnectComplWith; end; function TF_MAIN.CreateFFindParams: TF_FindParams; begin if F_FindParams = nil then F_FindParams := TF_FindParams.Create(Self, TForm(Self)); Result := F_FindParams; end; function TF_MAIN.CreateFImageShow: TF_ImageShow; begin if F_ImageShow = nil then F_ImageShow := TF_ImageShow.Create(Self, TForm(Self)); Result := F_ImageShow; end; function TF_MAIN.CreateFItemsSelector: TF_ItemsSelector; begin if F_ItemsSelector = nil then F_ItemsSelector := TF_ItemsSelector.Create(Self, TForm(Self)); Result := F_ItemsSelector; end; function TF_MAIN.CreateFInterfaceInfo: TF_InterfaceInfo; begin if F_InterfaceInfo = nil then F_InterfaceInfo := TF_InterfaceInfo.Create(Self, TForm(Self)); Result := F_InterfaceInfo; end; function TF_MAIN.CreateFMakeEditCrossConnection: TF_MakeEditCrossConnection; begin if F_MakeEditCrossConnection = nil then F_MakeEditCrossConnection := TF_MakeEditCrossConnection.Create(Self, TForm(Self)); Result := F_MakeEditCrossConnection; end; function TF_MAIN.CreateFMakeEditInterface: TF_MakeEditInterface; begin if F_MakeEditInterface = nil then F_MakeEditInterface := TF_MakeEditInterface.Create(Self, TForm(Self)); Result := F_MakeEditInterface; end; function TF_MAIN.CreateFMakeEditInterfaceAccordance: TF_MakeEditInterfaceAccordance; begin if F_MakeEditInterfaceAccordance = nil then F_MakeEditInterfaceAccordance := TF_MakeEditInterfaceAccordance.Create(Self, TForm(Self)); Result := F_MakeEditInterfaceAccordance; end; function TF_MAIN.CreateFMakeEditInterfNorm: TF_MakeEditInterfNorm; begin if F_MakeEditInterfNorm = nil then F_MakeEditInterfNorm := TF_MakeEditInterfNorm.Create(Self, TForm(Self)); Result := F_MakeEditInterfNorm; end; function TF_MAIN.CreateFMakeEditObjCurrency: TF_MakeEditObjCurrency; begin if F_MakeEditObjCurrency = nil then F_MakeEditObjCurrency := TF_MakeEditObjCurrency.Create(Self, TForm(Self)); Result := F_MakeEditObjCurrency; end; function TF_MAIN.CreateFMakeEditObjectIcons: TF_MakeEditObjectIcons; begin if F_MakeEditObjectIcons = nil then F_MakeEditObjectIcons := TF_MakeEditObjectIcons.Create(Self, TForm(Self)); Result := F_MakeEditObjectIcons; end; function TF_MAIN.CreateFMakeEditPortInterfRel: TF_MakeEditPortInterfRel; begin if F_MakeEditPortInterfRel = nil then F_MakeEditPortInterfRel := TF_MakeEditPortInterfRel.Create(Self, TForm(Self)); Result := F_MakeEditPortInterfRel; end; function TF_MAIN.CreateFMakeEditProducer: TF_MakeEditProducer; begin if F_MakeEditProducer = nil then F_MakeEditProducer := TF_MakeEditProducer.Create(Self, TForm(Self)); Result := F_MakeEditProducer; end; function TF_MAIN.CreateFMakeEditPropRel: TF_MakeEditPropRel; begin if F_MakeEditPropRel = nil then F_MakeEditPropRel := TF_MakeEditPropRel.Create(Self, TForm(Self)); Result := F_MakeEditPropRel; end; function TF_MAIN.CreateFMakeEditSupplyKind: TF_MakeEditSupplyKind; begin if F_MakeEditSupplyKind = nil then F_MakeEditSupplyKind := TF_MakeEditSupplyKind.Create(Self, TForm(Self)); Result := F_MakeEditSupplyKind; end; function TF_MAIN.CreateFMakeNorm: TF_MakeNorm; begin if F_MakeNorm = nil then begin F_MakeNorm := TF_MakeNorm.Create(Self, TForm(Self)); SetCurrencyBriefToControls; end; Result := F_MakeNorm; end; function TF_MAIN.CreateFMakeProperty: TF_MakeProperty; begin if F_MakeProperty = nil then F_MakeProperty := TF_MakeProperty.Create(Self, TForm(Self) ); Result := F_MakeProperty; end; function TF_MAIN.CreateFMarkMask: TF_MarkMask; begin if F_MarkMask = nil then F_MarkMask := TF_MarkMask.Create(Self, TForm(Self)); Result := F_MarkMask; end; function TF_MAIN.CreateFMakeMarkPage: TF_MakeMarkPage; begin if F_MakeMarkPage = nil then F_MakeMarkPage := TF_MakeMarkPage.Create(Self, TForm(Self)); Result := F_MakeMarkPage; end; function TF_MAIN.CreateFMasterCableCanalTracing: TF_MasterCableCanalTracing; begin if F_MasterCableCanalTracing = nil then F_MasterCableCanalTracing := TF_MasterCableCanalTracing.Create(Self, Self); Result := F_MasterCableCanalTracing; end; function TF_MAIN.CreateFMasterUpdatePrice: TF_MasterUpdatePrice; begin if F_MasterUpdatePrice = nil then F_MasterUpdatePrice := TF_MasterUpdatePrice.Create(Self, TForm(Self)); Result := F_MasterUpdatePrice; end; function TF_MAIN.CreateFNormsComplete: TF_NormsComplete; begin if F_NormsComplete = nil then F_NormsComplete := TF_NormsComplete.Create(Self, TForm(Self)); Result := F_NormsComplete; end; function TF_MAIN.CreateFNormsGroups: TF_NormsGroups; begin if F_NormsGroups = nil then F_NormsGroups := TF_NormsGroups.Create(Self, TForm(Self)); Result := F_NormsGroups; end; function TF_MAIN.CreateFObjectParams: TF_ObjectParams; begin if F_ObjectParams = nil then F_ObjectParams := TF_ObjectParams.Create(Self, TForm(Self)); Result := F_ObjectParams; end; function TF_MAIN.CreateFReportForm: TF_ReportForm; begin if F_ReportForm = nil then F_ReportForm := TF_ReportForm.Create(Self, TForm(Self)); Result := F_ReportForm; end; function TF_MAIN.CreateFResourceReport: TF_ResourceReport; begin if F_ResourceReport = nil then begin F_ResourceReport := TF_ResourceReport.Create(Self, TForm(Self)); {$IF Defined(SCS_RF)} F_ResourceReport.pnOtherProperties.Visible := false; {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_SPA)} F_ResourceReport.pnOtherProperties.Visible := false; {$IFEND} end; Result := F_ResourceReport; end; function TF_MAIN.CreateFProjectRev: TF_ProjectRev; begin // Tolik 05/05/2021 -- if GDBMode = bkNormBase then exit; // if F_ProjectRev = nil then begin F_ProjectRev := TF_ProjectRev.Create(Self, TForm(Self)); end; Result := F_ProjectRev; end; // ##### Загрузить в TList данные папок из запроса AQuery ##### procedure TF_MAIN.LoadCatalogs(AParentID, AParentLevel: Integer; var ACatalogs: TSCSCatalogs; AQueryMode: TQueryMode); var ParentCatalog: TSCSCatalog; ChildCatalog: TSCSCatalog; Catalog: TSCSCatalog; i, j: Integer; SCSObj: TSCSCatalog; //AddedCatalog: Boolean; ChildCatalogIDs: TIntList; CanAddCatalogToList: Boolean; ProjectOwner: TSCSCatalog; ListOwner: TSCSList; ChildCatalogs: TSCSCatalogs; WasCreareChildCatalogs: Boolean; UpperCatalogs: TSCSCatalogs; CatalogItemsCount: Integer; ComponCount: Integer; LookedComponCountInFilter: Integer; LoadedComponsLists: Boolean; begin //ParentCatalog := nil; ChildCatalogIDs := nil; case AQueryMode of qmPhisical: begin {ChildCatalogIDs := DM.GetChildCatalogsID(AParentID, fnIDItemType+', '+fnSortID, qmPhisical); for i := 0 to ChildCatalogIDs.Count - 1 do begin Catalog := TSCSCatalog.Create(TForm(Self)); Catalog.QueryMode := AQueryMode; Catalog.LoadCatalogByID(ChildCatalogIDs[i], false); //if Catalog.ItemType = itProjMan then begin CatalogItemsCount := DM.GetCatalogItemsCntByID(Catalog.ID, Catalog.ItemType, qmPhisical); if Catalog.ItemsCount <> CatalogItemsCount then begin Catalog.ItemsCount := CatalogItemsCount; DM.UpdateCatalogFieldAsInteger(Catalog.ID, Catalog.ItemsCount, fnID, fnItemsCount, qmPhisical); end; ComponCount := DM.GetCatalogKolCompon(Catalog.ID, qmPhisical); if Catalog.KolCompon <> ComponCount then begin Catalog.KolCompon := ComponCount; DM.UpdateCatalogFieldAsInteger(Catalog.ID, Catalog.KolCompon, fnID, fnKolCompon, qmPhisical); end; end; ACatalogs.Add(Catalog); end; FreeAndNil(ChildCatalogIDs);} LoadedComponsLists := false; //*** Определить список подпапок case GDBMode of bkNormBase: begin ChildCatalogIDs := DM.GetChildCatalogsIDFromLists(AParentID); //*** подгрузка данных компонент для оптимизации //if (AParentLevel = 0) and (FFilterParams.FFilterBlock <> nil) and FFilterParams.FFilterBlock.IsOn then if ((AParentLevel = 0) or (FFilterParams.FFilterType <> fltCustom)) and FFilterParams.IsUseFilter then if DM.ComponIDs.Count = 0 then begin DM.LoadIDsToComponLists(FFilterParams); LoadedComponsLists := true; end; end; bkProjectManager: ChildCatalogIDs := DM.GetChildCatalogsID(AParentID, fnIDItemType+', '+fnSortID, qmPhisical); end; try //*** Профильтровать ID-ки LookedComponCountInFilter := 0; i := ChildCatalogIDs.Count - 1; while i >= 0 do begin if (AParentID <> 0) and Not DM.CanShowCatalogByFilter(ChildCatalogIDs[i], FFilterParams, @LookedComponCountInFilter) then ChildCatalogIDs.Delete(i); Dec(i); end; finally if LoadedComponsLists then DM.ClearComponLists; end; for i := 0 to ChildCatalogIDs.Count - 1 do begin Catalog := TSCSCatalog.Create(TForm(Self)); Catalog.QueryMode := AQueryMode; Catalog.LoadCatalogByID(ChildCatalogIDs[i], false, false, i=0); ACatalogs.Add(Catalog); end; FreeAndNil(ChildCatalogIDs); //*** Определить количества подпаплк в подпапках и кол-во компонент в подпапках for i := 0 to ACatalogs.Count - 1 do begin Catalog := ACatalogs[i]; //if Catalog.ItemType = itProjMan then begin CatalogItemsCount := DM.GetCatalogItemsCntByIDFromList(Catalog.ID); if Catalog.ItemsCount <> CatalogItemsCount then begin Catalog.ItemsCount := CatalogItemsCount; DM.UpdateCatalogFieldAsInteger(Catalog.ID, Catalog.ItemsCount, fnID, fnItemsCount, qmPhisical); end; ComponCount := DM.GetCatalogKolComponFromLists(Catalog.ID); if Catalog.KolCompon <> ComponCount then begin Catalog.KolCompon := ComponCount; DM.UpdateCatalogFieldAsInteger(Catalog.ID, Catalog.KolCompon, fnID, fnKolCompon, qmPhisical); end; end; end; if GDBMode = bkNormBase then ACatalogs.SortBySortID; end; qmMemory: begin UpperCatalogs := nil; if GSCSBase.CurrProject.CurrID = AParentID then ParentCatalog := GSCSBase.CurrProject else ParentCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(AParentID); if Assigned(ParentCatalog) then begin WasCreareChildCatalogs := false; ChildCatalogs := nil; if ParentCatalog.ItemType in [itProject, itDir] then //*** Если здесь может присутствовать лист begin ChildCatalogs := TSCSCatalogs.Create(false); ChildCatalogs.Assign(ParentCatalog.ChildCatalogs); WasCreareChildCatalogs := true; ProjectOwner := nil; if ParentCatalog.ItemType = itProject then ProjectOwner := ParentCatalog else ProjectOwner := ParentCatalog.GetTopParentCatalog; if (ProjectOwner <> nil) and (ProjectOwner.ItemType = itProject) then if (ProjectOwner is TSCSProject) and (TSCSProject(ProjectOwner).Setting.ListsInReverseOrder) then SortCatalogListInItemType(ChildCatalogs, itList, true); end else ChildCatalogs := ParentCatalog.ChildCatalogs; for i := 0 to ChildCatalogs.Count - 1 do begin ChildCatalog := ChildCatalogs[i]; if ChildCatalog.ItemsCount <> ChildCatalog.ChildCatalogs.Count then ChildCatalog.ItemsCount := ChildCatalog.ChildCatalogs.Count; if ChildCatalog.KolCompon <> ChildCatalog.SCSComponents.Count then ChildCatalog.KolCompon := ChildCatalog.SCSComponents.Count; CanAddCatalogToList := true; //*** Если комната, то учитывать режим группировки case ChildCatalog.ItemType of itDir: begin CanAddCatalogToList := false; if Not Assigned(UpperCatalogs) then UpperCatalogs := TSCSCatalogs.Create(false); UpperCatalogs.Add(ChildCatalog); end; itRoom: begin ListOwner := ChildCatalog.GetListOwner; if Assigned(ListOwner) then begin CanAddCatalogToList := false; if ListOwner.Setting.GroupListObjectsByType = True then begin for j := 0 to ChildCatalog.ChildCatalogs.Count - 1 do begin SCSObj := ChildCatalog.ChildCatalogs[j]; if SCSObj.ItemType in [itSCSConnector, itSCSLine] then ACatalogs.Add(SCSObj); end; end else begin if Not Assigned(UpperCatalogs) then UpperCatalogs := TSCSCatalogs.Create(false); UpperCatalogs.Add(ChildCatalog); end; end; end; end; if CanAddCatalogToList then ACatalogs.Add(ChildCatalog); end; if Assigned(UpperCatalogs) then begin for i := UpperCatalogs.Count - 1 downto 0 do ACatalogs.Insert(0, UpperCatalogs[i]); FreeAndNil(UpperCatalogs); end; if WasCreareChildCatalogs then ChildCatalogs.Free; end; end; end; { for i := 0 to ACatalogsID.Count - 1 do begin Catalog := nil; case AQueryMode of qmPhisical: begin Catalog := TSCSCatalog.Create(TForm(Self)); Catalog.QueryMode := AQueryMode; Catalog.LoadCatalogByID(Integer(ACatalogsID[i]^), false); end; qmMemory: Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(Integer(ACatalogsID[i]^)); end; AddedCatalog := false; if Assigned(Catalog) then begin if Catalog.ItemType = itRoom then for j := 0 to ACatalogs.Count - 1 do begin SCSObj := ACatalogs[j]; if SCSObj.ItemType in [itSCSLine, itSCSConnector] then begin ACatalogs.Insert(j, Catalog); AddedCatalog := true; Break; //// BREAK /// end; end; if Not AddedCatalog then ACatalogs.Add(Catalog); end; end; } end; procedure TF_MAIN.SetSql(ParamID: Integer); begin DM.scsQ.Close; DM.scsQ.SQL.Clear; DM.scsQ.SQL.Add(' SELECT * FROM COMPONENT ' + ' WHERE ID in (SELECT ID_COMPONENT FROM CATALOG_RELATION '+ ' WHERE ID_CATALOG = '''+IntToStr(ParamID)+''') '+ ' ORDER BY SORT_ID '); DM.scsQ.ExecQuery; end; // ##### Обновляет ветвь дерева с восстановл-м тек-х позиций в Гридах ##### procedure TF_MAIN.RefreshNode(ARefreshObject: Boolean = false); begin //Exit; //#Del if (GBaseBeginUpdateCount = 0) and FEnabledRefreshNode then begin //28.08.2013 - если таймер еще не запущен, или нужно сделать refresh после определенных действий (чтобы потом при вызове не поставили false когда таймер запущен) if Not Timer_RefreshNode.Enabled or ARefreshObject then FIsRefreshNodeObject := ARefreshObject; RestartTimer(Timer_RefreshNode); end; //begin //if Timer_RefreshNode.Enabled then // Timer_RefreshNode.Enabled := false; //Timer_RefreshNode.Enabled := true; //end; end; procedure TF_MAIN.RefreshNodeText(ANode: TTreeNode; AObject: TObject; AFullName: Boolean=true; AKolChild: Boolean=true); begin if ANode = nil then ANode := GetNodeByObj(AObject); if ANode <> nil then ANode.Text := GetNameNode(ANode, AObject, AFullName, AKolChild); end; procedure TF_MAIN.StartDragCompon(AComponID: Integer); begin if AComponID <> 0 then begin GID_CopingCompon := AComponID; if GDropComponent = nil then begin GDropComponent := TSCSComponent.Create(Self); end; GDropComponent.Clear; GDropComponent.ActiveForm := F_NormBase; GDropComponent.Clear; GDropComponent.IDTopComponent := 0; GDropComponent.IDCompRel := 0; GDropComponent.LoadComponentByID(AComponID, true, true, false); GDropComponent.IDCompRel := 0; GDropComponent.TreeViewNode := nil; //21.05.2009 CreateShadowObject; // На CAD if GSCSBase.SCSComponent.ID <> GDropComponent.ID then begin GSCSBase.SCSComponent.Assign(GDropComponent, false, true); RefreshNode(true); end; if Assigned(GDropComponent) then begin GDropComponent.Count := 1; if (GDBMode = bkNormBase) {and (GDropComponent.HaveMinimumInterfaces(false))} then begin GCanCopyComponToCAD := true; if FProjectMan <> nil then if FProjectMan.GSCSBase.CurrProject.Active then if FProjectMan.GSCSBase.CurrProject.CurrList <> nil then if FProjectMan.GSCSBase.CurrProject.CurrList.Setting.SCSType = st_Internal then if IsTrunkComponent(GDropComponent) then begin GCanCopyComponToCAD := false; end; end else GCanCopyComponToCAD := false; GisLineCopingCompon := GDropComponent.IsLine; end; end else if GDropComponent <> nil then begin GDropComponent.Clear; GCanCopyComponToCAD := false; end; if GCanCopyComponToCAD then CreateShadowObject; // На CAD end; procedure TF_MAIN.EndDragCompon; begin case GDBMode of bkNormBase: begin DestroyShadowObject; end; bkProjectManager: ; end; end; procedure TF_MAIN.ReloadNodes(AParentNode: TTreeNode); var Node: TTreeNode; ParentNode: TTreeNode; FindedParentNode: Boolean; NodeToSelect: TTreeNode; PrevLevel: Integer; ListIDs: TIntList; ListItemTypes: TIntList; ListExpanded: TIntList; SelectedID: Integer; SelectedItemType: Integer; EndNode: TTreeNode; CurrID: Integer; CurrItemType: Integer; CanClearComponLists: Boolean; i: Integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin OldTick := GetTickCount; //*** определить папки, для которых нужно переопределить компоненты, и удалить компоненты из дерева Node := nil; EndNode := nil; if AParentNode <> nil then begin Node := AParentNode.getFirstChild; EndNode := AParentNode.getNextSibling; end else if Tree_Catalog.Items.Count > 0 then Node := Tree_Catalog.Items[0]; if Node <> nil then begin ListIDs := TIntList.Create; ListItemTypes := TIntList.Create; ListExpanded := TIntList.Create; CanClearComponLists := false; LockTreeAndGrid(true); try if (FFilterParams.IsUseFilter) and (DM.ComponIDs.Count = 0) then begin CanClearComponLists := true; DM.LoadIDsToComponLists(FFilterParams); end; //*** Определить видимые ветви PrevLevel := -1; while Node <> nil do begin if Node.Level <> PrevLevel then // Если компонента, то не брать комплектующее if Not IsComponentNode(Node) or (PObjectData(Node.Data).ComponKind <> ckCompl) then begin ListIDs.Add(PObjectData(Node.Data).ObjectID); ListItemTypes.Add(PObjectData(Node.Data).ItemType); ListExpanded.Add(BoolToInt(Node.Expanded)); //*** Если в списке нету парента, то внести его туда ParentNode := Node.Parent; if ParentNode <> nil then begin FindedParentNode := false; for i := 0 to ListIDs.Count - 1 do if (PObjectData(ParentNode.Data).ObjectID = ListIDs[i]) and (PObjectData(ParentNode.Data).ItemType = ListItemTypes[i]) then begin FindedParentNode := false; end; if Not FindedParentNode then begin ListIDs.Add(PObjectData(ParentNode.Data).ObjectID); ListItemTypes.Add(PObjectData(ParentNode.Data).ItemType); ListExpanded.Add(BoolToInt(ParentNode.Expanded)); end; end; end; PrevLevel := Node.Level; Node := Node.GetNextVisible; if (Node <> nil) and (EndNode <> nil) then if (Node = EndNode) or (Node.Level <= EndNode.Level) then Break; //// BREAK //// end; //*** Определить выделенную ветвь SelectedID := -1; SelectedItemType := -1; if F_ProjMan.Tree_Catalog.Selected <> nil then begin SelectedID := PObjectData(F_ProjMan.Tree_Catalog.Selected.Data).ObjectID; SelectedItemType := PObjectData(F_ProjMan.Tree_Catalog.Selected.Data).ItemType; end; //*** Очистка в дереве if AParentNode <> nil then begin DeleteChildNodes(AParentNode); end else begin ClearTreeView(Tree_Catalog, true, true); AddNodes(nil); end; //*** Восстановить ранее видимые папки NodeToSelect := nil; for i := 0 to ListIDs.Count - 1 do begin CurrID := ListIDs[i]; CurrItemType := ListItemTypes[i]; Node := nil; if IsCatalogItemType(CurrItemType) then begin //if DM.CanShowCatalogByFilter(CurrID, FFilterParams, nil) then if DM.ComponCatalogsNoShowByFilter.IndexOf(CurrID) = -1 then Node := FindComponOrDirInTree(CurrID, false); end else //if (DM.ComponIDs.Count = 0) or (DM.ComponIDs.IndexOf(CurrID) <> -1) then if (DM.ComponIDs.Count = 0) or (GetValueIndexFromSortedIntList(CurrID, DM.ComponIDs) <> -1) then Node := FindComponOrDirInTree(CurrID, true); if Node <> nil then begin ParentNode := Node.Parent; while (Not Node.IsVisible) and (ParentNode <> nil) do begin ParentNode.Expanded := true; ParentNode := ParentNode.Parent; end; if (SelectedID = CurrID) and (SelectedItemType = CurrItemType) then NodeToSelect := Node; if Not Node.Expanded then Node.Expanded := IntToBool(ListExpanded[i]); end; end; if NodeToSelect = nil then NodeToSelect := AParentNode; if NodeToSelect <> nil then begin ShowNode(Tree_Catalog, NodeToSelect); Tree_Catalog.Selected := NodeToSelect; end; finally LockTreeAndGrid(false); if CanClearComponLists then DM.ClearComponLists; end; FreeAndNil(ListIDs); FreeAndNil(ListItemTypes); FreeAndNil(ListExpanded); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; (* procedure TF_MAIN.RefreshNode; var Dat: PObjectData; ListRecNo: Tlist; //*** Список с текущеми позициями в MemTabl-ах ListMemTable: Tlist; //*** Список MemTabl-ов i: Integer; procedure AddMemTableToList(AMemTable: TkbmMemTable); var ptrRecNo: ^Integer; begin if AMemTable = nil then Exit; //// EXIT //// New(ptrRecNo); ptrRecNo^ := AMemTable.RecNo; ListRecNo.Add(ptrRecNo); ListMemTable.Add(AMemTable); end; begin //Exit; //#Del if GBaseBeginUpdateCount = 0 then try try ListRecNo := nil; ListMemTable := nil; if Tree_Catalog.Selected = nil then Exit; ///// EXIT ///// Dat := Tree_Catalog.Selected.Data; //ANode.Data; if Dat = nil then Exit; ///// EXIT ///// ListRecNo := Tlist.Create; ListMemTable := Tlist.Create; try LockTreeAndGrid(true); case Dat.ItemType of itComponCon, itComponLine: begin AddMemTableToList(DM.MemTable_Complects); AddMemTableToList(DM.MemTable_Property); AddMemTableToList(DM.MemTable_InterfaceRel); AddMemTableToList(DM.MemTable_Port); if GDBMode = bkProjectManager then AddMemTableToList(DM.MemTable_Connections); DM.SelectCompSub(Tree_Catalog.Selected); //ShowPrice; end; else if GDBMode = bkProjectManager then begin AddMemTableToList(DM.MemTable_Property); DM.SelectCatalogProperty; end; end; //*** Восстановление тек-х позиций в Гридах for i := 0 to ListMemTable.Count - 1 do if TkbmMemTable(ListMemTable.Items[i]).Active then TkbmMemTable(ListMemTable.Items[i]).RecNo := Integer(ListRecNo.Items[i]^); finally LockTreeAndGrid(false); end; except on E: Exception do AddExceptionToLog('TF_MAIN.RefreshNode: '+E.Message); end; finally //GT_INTERFACE.EndUpdate; //GT_Compon_Relation.EndUpdate; //GT_PROPERTY.EndUpdate; //GT_Connections.EndUpdate; FreeList(ListRecNo); if ListMemTable <> nil then FreeAndNil(ListMemTable); end; end; *) procedure TF_MAIN.ReselectNode; begin if Tree_Catalog.Selected <> nil then Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); end; // Tolik 15/06/2021 -- старая закомменчена -- см ниже procedure TF_MAIN.SelectNodeAtCursor; var TargetNode : TTreeNode; PosScr: TPoint; PosTree: TPoint; SelList: TList; NodeInList: Boolean; i: integer; begin GetCursorPos(PosScr); PosTree := Tree_Catalog.ScreenToClient(PosScr); SelList := TList.Create; Tree_Catalog.GetSelections(SelList); TargetNode := Tree_Catalog.GetNodeAt(PosTree.X, PosTree.Y); if TargetNode <> nil Then begin //TargetNode.SelectedIndex := TargetNode.ImageIndex; Screen.Cursor := crHourGlass; try Tree_Catalog.Selected := TargetNode; finally Screen.Cursor := crDefault; NodeInList := False; for i := 0 to SelList.Count - 1 do begin if TTreeNode(SelList[i]) = TargetNode then begin NodeInList := True; break; end; end; if NodeInList then begin SelList.Remove(TargetNode); SelList.Add(TargetNode); for i := 0 to SelList.Count - 1 do begin if TTreeNode(SelList[i]) <> TargetNode then TtreeNode(SelList[i]).Selected := True; end; end; end; SelList.Free; end; end; // { procedure TF_MAIN.SelectNodeAtCursor; var TargetNode : TTreeNode; PosScr: TPoint; PosTree: TPoint; begin GetCursorPos(PosScr); PosTree := Tree_Catalog.ScreenToClient(PosScr); TargetNode := Tree_Catalog.GetNodeAt(PosTree.X, PosTree.Y); if TargetNode <> nil Then begin //TargetNode.SelectedIndex := TargetNode.ImageIndex; Screen.Cursor := crHourGlass; try Tree_Catalog.Selected := TargetNode; finally Screen.Cursor := crDefault; end; end; end; } procedure TF_MAIN.SelectNodeDirect(ANode: TTreeNode); var SavedOnChange: TTVChangedEvent; begin try if ANode <> nil then begin if Tree_Catalog.Selected <> ANode then begin SavedOnChange := Tree_Catalog.OnChange; Tree_Catalog.OnChange := nil; try Tree_Catalog.Selected := ANode; Timer_TreeCatalogChangeTimer(nil); //WaitForTVChange; FPrevSelectedNodeDat := PObjectData(ANode.Data)^; FPrevSelectionCount := Tree_Catalog.SelectionCount; finally Tree_Catalog.OnChange := SavedOnChange; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.SelectNodeFull', E.Message); end; end; function TF_MAIN.DefineObjectGroupForCatalogData(ASCSList: TSCSList; aListNode: TTreeNode; aData: PObjectData; const AComponentType: String; ASprComponentType: TNBComponentType; AIsLineObject: Integer): TTreeNode; var SavedExpanded: Boolean; ObjectToMove: TSCSCatalog; FirstCompon: TSCSComponent; ComponTypeName: String; GroupNode: TTreeNode; NodeDat: PObjectData; ComponentType: TComponentType; TrgGroupNode: TTreeNode; begin Result := nil; if ASCSList.Setting.GroupListObjectsByType then begin //*** Проверить, если в объекте первый компонент не соответствует типу AComponentType ObjectToMove := nil; FirstCompon := nil; ComponTypeName := AComponentType; if (aData^.ItemType in [itSCSLine, itSCSConnector]) then ObjectToMove := GSCSBase.CurrProject.GetCatalogFromReferences(aData^.ObjectID); if Assigned(ObjectToMove) then if ObjectToMove.SCSComponents.Count > 0 then begin FirstCompon := ObjectToMove.GetFirstComponent; if Assigned(FirstCompon) and (ComponTypeName <> '') then begin if AnsiCompareText(FirstCompon.ComponentType.NamePlural, ComponTypeName) <> 0 then //13.05.2009 if FirstCompon.GUIDComponentType <> AComponentType then if (aData^.ChildNodesCount <> 0) and (ComponTypeName <> ogtEmpty) then //*** Не в пустые объекты Exit; ///// EXIT ///// end else if ComponTypeName = '' then begin if ASprComponentType = nil then ASprComponentType := ASCSList.Spravochnik.GetComponentTypeByGUID(FirstCompon.GUIDComponentType); if ASprComponentType <> nil then ComponTypeName := ASprComponentType.ComponentType.NamePlural; end; end else begin if ComponTypeName = '' then ComponTypeName := ogtEmpty; end; //if ANodeToMove.Count > 0 then if ComponTypeName <> '' then begin GroupNode := nil; GroupNode := aListNode.GetFirstChild; TrgGroupNode := nil; while GroupNode <> nil do begin if ((PObjectData(GroupNode.Data).ItemType = itSCSLineGroup) and (AIsLineObject = biTrue)) or ((PObjectData(GroupNode.Data).ItemType = itSCSConnGroup) and (AIsLineObject = biFalse)) or (PObjectData(GroupNode.Data).ItemType = itSCSEmptyGroup) then if AnsiCompareText(PObjectData(GroupNode.Data).GroupType, ComponTypeName) = 0 then //13.05.2009 if PObjectData(GroupNode.Data).GroupType = AComponentType then begin TrgGroupNode := GroupNode; Break; end; GroupNode := GroupNode.getNextSibling; end; //*** Если не найдена ветвь с нужной группой, то создать такую ветвь if TrgGroupNode = nil then begin if (ComponTypeName = ogtEmpty) or (FirstCompon = nil) then begin ComponentType.NamePlural := ognEmpty; ComponentType.IsLine := AIsLineObject; TrgGroupNode := Tree_Catalog.Items.AddChild(aListNode, ComponentType.NamePlural); end else if FirstCompon <> nil then begin ZeroMemory(@ComponentType, SizeOf(ComponentType)); //13.05.2009 SprComponentType := SCSList.Spravochnik.GetComponentTypeByGUID(AComponentType); if ASprComponentType <> nil then ComponentType := ASprComponentType.ComponentType; TrgGroupNode := Tree_Catalog.Items.AddChildFirst(aListNode, ComponentType.NamePlural); end; if Assigned(TrgGroupNode) then begin NewData(NodeDat, ttComponents); if ComponTypeName <> ogtEmpty then case ComponentType.IsLine of biTrue: NodeDat.ItemType := itSCSLineGroup; biFalse: NodeDat.ItemType := itSCSConnGroup; end else NodeDat.ItemType := itSCSEmptyGroup; NodeDat.ObjectID := -1; NodeDat.QueryMode := qmUndef; NodeDat.ComponKind := ckNone; NodeDat.ChildNodesCount := 0; NodeDat.SortID := -1; NodeDat.NBMode := nbmNone; NodeDat.GroupType := AnsiUpperCase(ComponTypeName); TrgGroupNode.Data := NodeDat; SetNodeState(TrgGroupNode, NodeDat.ItemType, ekNone); end; end; Result := TrgGroupNode; end; end; end; // ##### Определяет и вкидывает ветвь объекта в группу ##### procedure TF_MAIN.DefineObjectNodeGroup(AObjectNode: TTreeNode; AGUIDComponType: String; AIsLine: Integer); var SCSObject: TSCSCatalog; NodeDat: PObjectData; SCSList: TSCSList; ListNode: TTreeNode; ParentNode: TTreeNode; ParentDat: PObjectData; GroupNode: TTreeNode; GroupNodeDat: PObjectData; TrgGroupNode: TTreeNode; SprComponentType: TNBComponentType; ComponentType: TComponentType; IsLineObject: Integer; GUIDCompType: String; procedure MoveToGroup(ANodeToMove: TTreeNode; const AComponentType: String; AIsLineObject: Integer); var SavedExpanded: Boolean; ObjectToMove: TSCSCatalog; FirstCompon: TSCSComponent; begin {//04.04.2012 //*** Проверить, если в объекте первый компонент не соответствует типу AComponentType ObjectToMove := nil; FirstCompon := nil; if (PObjectData(ANodeToMove.Data).ItemType in [itSCSLine, itSCSConnector]) then ObjectToMove := GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(ANodeToMove.Data).ObjectID); if Assigned(ObjectToMove) then if ObjectToMove.SCSComponents.Count > 0 then begin FirstCompon := ObjectToMove.GetFirstComponent; if Assigned(FirstCompon) then if AnsiCompareText(FirstCompon.ComponentType.NamePlural, AComponentType) <> 0 then //13.05.2009 if FirstCompon.GUIDComponentType <> AComponentType then if (PObjectData(ANodeToMove.Data).ChildNodesCount <> 0) and (AComponentType <> ogtEmpty) then //*** Не в пустые объекты Exit; ///// EXIT ///// end; //if ANodeToMove.Count > 0 then begin GroupNode := nil; GroupNode := ListNode.GetFirstChild; TrgGroupNode := nil; while GroupNode <> nil do begin if ((PObjectData(GroupNode.Data).ItemType = itSCSLineGroup) and (AIsLineObject = biTrue)) or ((PObjectData(GroupNode.Data).ItemType = itSCSConnGroup) and (AIsLineObject = biFalse)) or (PObjectData(GroupNode.Data).ItemType = itSCSEmptyGroup) then if AnsiCompareText(PObjectData(GroupNode.Data).GroupType, AComponentType) = 0 then //13.05.2009 if PObjectData(GroupNode.Data).GroupType = AComponentType then begin TrgGroupNode := GroupNode; Break; end; GroupNode := GroupNode.getNextSibling; end; //*** Если не найдена ветвь с нужной группой, то создать такую ветвь if TrgGroupNode = nil then begin if (AComponentType = ogtEmpty) or (FirstCompon = nil) then begin ComponentType.NamePlural := ognEmpty; ComponentType.IsLine := AIsLineObject; TrgGroupNode := Tree_Catalog.Items.AddChild(ListNode, ComponentType.NamePlural); end else if FirstCompon <> nil then begin ZeroMemory(@ComponentType, SizeOf(ComponentType)); //13.05.2009 SprComponentType := SCSList.Spravochnik.GetComponentTypeByGUID(AComponentType); if SprComponentType <> nil then ComponentType := SprComponentType.ComponentType; //ComponentType := SCSList.Spravochnik.GetComponentTypeByID(AComponentType); //FNormBase.DM.GetComponentType(AComponentType); TrgGroupNode := Tree_Catalog.Items.AddChildFirst(ListNode, ComponentType.NamePlural); end; if Assigned(TrgGroupNode) then begin NewData(NodeDat, ttComponents); if AComponentType <> ogtEmpty then case ComponentType.IsLine of biTrue: NodeDat.ItemType := itSCSLineGroup; biFalse: NodeDat.ItemType := itSCSConnGroup; end else NodeDat.ItemType := itSCSEmptyGroup; NodeDat.ObjectID := -1; NodeDat.QueryMode := qmUndef; NodeDat.ComponKind := ckNone; NodeDat.ChildNodesCount := 0; NodeDat.SortID := -1; NodeDat.NBMode := nbmNone; NodeDat.GroupType := AnsiUpperCase(AComponentType); TrgGroupNode.Data := NodeDat; SetNodeState(TrgGroupNode, NodeDat.ItemType, ekNone); end; end;} TrgGroupNode := DefineObjectGroupForCatalogData(SCSList, ListNode, PObjectData(ANodeToMove.Data), AComponentType, SprComponentType, AIsLineObject); //04.04.2012 //*** Вкинуть объект в группу if TrgGroupNode <> nil then begin SavedExpanded := TrgGroupNode.Expanded; try Tree_Catalog.OnExpanding := nil; MoveNodeTo(ANodeToMove, TrgGroupNode, naAddChild); Inc(PObjectData(TrgGroupNode.Data).ChildNodesCount); finally Tree_Catalog.OnExpanding := Tree_CatalogExpanding; TrgGroupNode.Expanded := SavedExpanded; end; end; //end; end; begin try try if GDBMode <> bkProjectManager then Exit; //// EXIT //// SCSObject := nil; NodeDat := nil; SCSList := nil; ListNode := nil; TrgGroupNode := nil; if AObjectNode <> nil then if AObjectNode.Data <> nil then NodeDat := AObjectNode.Data; if NodeDat = nil then Exit; ///// EXIT ///// if Not (NodeDat.ItemType in [itRoom, itSCSLine, itSCSConnector]) then Exit; ///// EXIT ///// ParentNode := AObjectNode.Parent; ParentDat := ParentNode.Data; SCSList := GSCSBase.CurrProject.GetListBySCSID(NodeDat.ListID); if SCSList <> nil then if SCSList.Setting.GroupListObjectsByType then begin ListNode := GetParentNodeByItemType(AObjectNode, [itList]); if ListNode <> Nil then begin GUIDCompType := ''; if AGUIDComponType <> ogtEmpty then begin SprComponentType := SCSList.Spravochnik.GetComponentTypeByGUID(AGUIDComponType); //13.05.2009 if SprComponentType <> nil then GUIDCompType := SprComponentType.ComponentType.NamePlural; end else GUIDCompType := AGUIDComponType; //*** Если объект уже находится в группе if ParentDat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin //*** Если нет компонентов в объекте if PObjectData(AObjectNode.Data).ChildNodesCount = 0 then begin IsLineObject := biFalse; case PObjectData(AObjectNode.Data).ItemType of itSCSLine: IsLineObject := biTrue; itSCSConnector: IsLineObject := biFalse; end; MoveToGroup(AObjectNode, ogtEmpty, IsLineObject); //AObjectNode.MoveTo(ListNode, naAddChild); end else if AnsiCompareText(ParentDat.GroupType, GUIDCompType) <> 0 then //13.05.2009 if ParentDat.GroupType <> AGUIDComponType then MoveToGroup(AObjectNode, GUIDCompType, AIsLine); //13.05.2009 MoveToGroup(AObjectNode, AGUIDComponType, AIsLine); if ParentNode.Count = 0 then DeleteNode(ParentNode); end else MoveToGroup(AObjectNode, GUIDCompType, AIsLine); //13.05.2009 MoveToGroup(AObjectNode, AGUIDComponType, AIsLine); end; {//13.05.2009 - Группировка по GUID ListNode := GetParentNodeByItemType(AObjectNode, [itList]); if ListNode <> Nil then begin //*** Если объект уже находится в группе if ParentDat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin //*** Если нет компонентов в объекте if PObjectData(AObjectNode.Data).ChildNodesCount = 0 then begin IsLineObject := biFalse; case PObjectData(AObjectNode.Data).ItemType of itSCSLine: IsLineObject := biTrue; itSCSConnector: IsLineObject := biFalse; end; MoveToGroup(AObjectNode, ogtEmpty, IsLineObject); //AObjectNode.MoveTo(ListNode, naAddChild); end else if ParentDat.GroupType <> AGUIDComponType then MoveToGroup(AObjectNode, AGUIDComponType, AIsLine); if ParentNode.Count = 0 then DeleteNode(ParentNode); end else MoveToGroup(AObjectNode, AGUIDComponType, AIsLine); end;} end; except on E: Exception do AddExceptionToLog('TF_MAIN.DefineObjectNodeGroup: '+E.Message); end; finally end; end; procedure TF_MAIN.DefineObjectGroupForCatalog(ACatalog: TSCSCatalog); var GroupType: string; FirsComponent: TSCSComponent; begin if GDBMode = bkProjectManager then begin if Assigned(ACatalog.TreeViewNode) then begin GroupType := ogtEmpty; FirsComponent := nil; if ACatalog.SCSComponents.Count > 0 then begin FirsComponent := ACatalog.GetFirstComponent; if Assigned(FirsComponent) then GroupType := FirsComponent.GUIDComponentType; end; DefineObjectNodeGroup(ACatalog.TreeViewNode, GroupType, ACatalog.IsLine); end; end; end; procedure TF_MAIN.ReDefineConstrInterfacesByProperty(AComponent: TSCSComponent; AProp: PProperty; aAutoAdd: boolean); var Spravochnik: TSpravochnik; InterfRel: TSCSInterface; InterfFinded: Boolean; Prop: PProperty; Port: TSCSInterface; PropGender: ShortInt; InterfSection: Double; InterfGuid: String; InterfRelCount: Integer; KeyValues: OleVariant; PropSysNamesConduitElmtSideDimensions: TStringList; IDChangedInterfaces: TIntList; FoundNum: integer; FoundNum2: integer; PropFinded: Boolean; FoundPropNum: integer; i, j: Integer; function GetNewInterfPortRel(const AGUID: string): TSCSInterface; var SprInterface: TNBInterface; begin Result := TSCSInterface.Create(Self); Result.ID := 0; Result.ID_COMPONENT := AComponent.ID; Result.Color := clWhite; Result.ID_INTERFACE := 0; Result.IsBusy := biFalse; Result.SignType := oitProjectible; Result.IsPort := biFalse; Result.IsLineCompon := AComponent.IsLine; SprInterface := Spravochnik.CreateInterfaceByStandartGUID(AGUID); Result.AssignFromSpr(SprInterface); end; begin try if AProp <> nil then begin Spravochnik := GetSpravochnik; PropSysNamesConduitElmtSideDimensions := CreateStringListSorted; //TStringList.Create; PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSideDimensions); // Размеры стороны элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide1Dimensions); // Размеры стороны 1 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide2Dimensions); // Размеры стороны 2 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide3Dimensions); // Размеры стороны 3 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide4Dimensions); // Размеры стороны 4 элемента канала try // Внешний/внутренний сечение - для кабеля и каб канала if (AProp.SysName = pnInSection) or (AProp.SysName = pnOutSection) then begin InterfSection := StrToFloatDef_My(AProp.Value, 0); InterfSection := FloatInUOM(InterfSection, umMM, umSM, 2); InterfFinded := false; FoundNum := -1; // Добавляем/изменяем интерфейс InterfGuid := guidUniversalInConstr; PropGender := gtFemale; if AProp.SysName = pnOutSection then begin InterfGuid := guidUniversalOutConstr; PropGender := gtMale; end; // Найти емкостной интерфейc c GUID КК - конструктив, род=PropGender, родной, многократный //if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then for i := 0 to AComponent.Interfaces.Count - 1 do begin if (AComponent.Interfaces[i].GUIDInterface = InterfGuid) and (AComponent.Interfaces[i].TypeI = itConstructive) and (AComponent.Interfaces[i].Gender = PropGender) and (AComponent.Interfaces[i].ID_Component = AComponent.ID) then begin InterfFinded := True; FoundNum := i; break; end; end; if not InterfFinded then begin // Найти емкостной интерфейc КК - конструктив, род=PropGender, родной, многократный //if Not MemTableInterfRel.Locate(fnTypeI+';'+fnGender+';'+fnIsNative+';'+fnMultiple, KeyValues, []) then for i := 0 to AComponent.Interfaces.Count - 1 do begin if (AComponent.Interfaces[i].TypeI = itConstructive) and (AComponent.Interfaces[i].Gender = PropGender) and (AComponent.Interfaces[i].ID_Component = AComponent.ID) and (AComponent.Interfaces[i].Multiple = 1) then begin InterfFinded := True; FoundNum := i; break; end; end; end; if (Not InterfFinded) and aAutoAdd then begin InterfRel := GetNewInterfPortRel(InterfGuid); InterfRel.IsPort := biFalse; InterfRel.TypeI := itConstructive; InterfRel.Kind := ikNoSplit; InterfRel.Gender := PropGender; InterfRel.Multiple := biTrue; InterfRel.Kolvo := 1; InterfRel.ValueI := InterfSection; InterfRel.IOfIRelOut.Clear; // никаких соединений InterfRel.IsBusy := biFalse; InterfRel.IsNew := true; AComponent.Interfaces.Add(InterfRel); end; if InterfFinded and (FoundNum >= 0) then begin InterfRel := AComponent.Interfaces[FoundNum]; if RoundX(InterfRel.ValueI, 7) <> RoundX(InterfSection, 7) then InterfRel.IsModified := True; InterfRel.ValueI := RoundX(InterfSection, 7); end; end else // Размеры сторон кабельного канала - применяется на каб канале if (AProp.SysName = pnConduitSideDimensions) or (AProp.SysName = pnCableChannelSideSection) then begin //18.01.2011 // Если применяется свойство "Сечение стороны кабельного канала" // и в компонента есть более приоритетное своствой "Размеры сторон кабельного канала", то игнорируем InterfFinded := False; for i := 0 to AComponent.Properties.Count - 1 do begin if PProperty(AComponent.Properties[i]).SysName = pnConduitSideDimensions then begin InterfFinded := True; break; end; end; //if (AProp.SysName = pnCableChannelSideSection) and MemTableProp.Locate(fnSysName, pnConduitSideDimensions, []) then // Exit; if (AProp.SysName = pnCableChannelSideSection) and InterfFinded then exit; InterfFinded := false; FoundNum := -1; FoundNum2 := -1; PropGender := gtMale; // Если компонент точечный, то интерфейс будет мама if AComponent.IsLine = biFalse then PropGender := gtFemale; // Добавляем/изменяем интерфейс // Найти универсальный интерфейс //if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then for i := 0 to AComponent.Interfaces.Count - 1 do begin if (AComponent.Interfaces[i].GUIDInterface = guidUniversalChannelSide) and (AComponent.Interfaces[i].TypeI = itFunctional) and (AComponent.Interfaces[i].Gender = PropGender) and (AComponent.Interfaces[i].ID_Component = AComponent.ID) then begin InterfFinded := True; if AComponent.IsLine = biFalse then begin FoundNum := i; break; end else begin if FoundNum = -1 then FoundNum := i else begin FoundNum2 := i; break; end; end; end; end; if not InterfFinded then begin // Найти интерфейc стороны КК - функционал, папа, родной, немногократный //if Not MemTableInterfRel.Locate(fnTypeI+';'+fnGender+';'+fnIsNative+';'+fnMultiple, KeyValues, []) then for i := 0 to AComponent.Interfaces.Count - 1 do begin if (AComponent.Interfaces[i].TypeI = itFunctional) and (AComponent.Interfaces[i].Gender = gtMale) and (AComponent.Interfaces[i].ID_Component = AComponent.ID) and (AComponent.Interfaces[i].Multiple = 0) then begin InterfFinded := True; if AComponent.IsLine = biFalse then begin FoundNum := i; break; end else begin if FoundNum = -1 then FoundNum := i else begin FoundNum2 := i; break; end; end; end; end; end; if (Not InterfFinded) and aAutoAdd then begin // Если подходящий не нашли, то создаем универсальный "" InterfRel := GetNewInterfPortRel(guidUniversalChannelSide); InterfRel.IsPort := biFalse; InterfRel.TypeI := itFunctional; InterfRel.Kind := ikNoSplit; InterfRel.Gender := PropGender; InterfRel.Multiple := biFalse; InterfRel.Kolvo := 1; InterfRel.IOfIRelOut.Clear; // никаких соединений InterfRel.IsBusy := biFalse; InterfRel.SideSection := AProp.Value; InterfRel.IsNew := true; AComponent.Interfaces.Add(InterfRel); // Для линейного компонента создаем парный интерфейс if AComponent.IsLine = biTrue then begin InterfRel.NumPair := 1; AComponent.Interfaces.Add(InterfRel); //InterfRel.Count := 2; // создаем универсальный еще один InterfRel := GetNewInterfPortRel(guidUniversalChannelSide); InterfRel.IsPort := biFalse; InterfRel.TypeI := itFunctional; InterfRel.Kind := ikNoSplit; InterfRel.Gender := PropGender; InterfRel.Multiple := biFalse; InterfRel.Kolvo := 1; InterfRel.IOfIRelOut.Clear; // никаких соединений InterfRel.IsBusy := biFalse; InterfRel.SideSection := AProp.Value; InterfRel.IsNew := true; InterfRel.NumPair := 1; AComponent.Interfaces.Add(InterfRel); end else AComponent.Interfaces.Add(InterfRel); end; if InterfFinded and (FoundNum >= 0) then begin InterfRel := AComponent.Interfaces[FoundNum]; if InterfRel.SideSection <> AProp.Value then InterfRel.IsModified := True; InterfRel.SideSection := AProp.Value; end; if InterfFinded and (FoundNum2 >= 0) then begin InterfRel := AComponent.Interfaces[FoundNum2]; if InterfRel.SideSection <> AProp.Value then InterfRel.IsModified := True; InterfRel.SideSection := AProp.Value; end; end else // Размеры стороны элемента канала if PropSysNamesConduitElmtSideDimensions.IndexOf(AProp.SysName) <> -1 then begin IDChangedInterfaces := TIntList.Create; try // Для каждого свойства, определяющего размерность, определяем интерфейс for i := 0 to PropSysNamesConduitElmtSideDimensions.Count - 1 do begin PropFinded := false; FoundPropNum := -1; //if MemTableProp.Locate(fnSysName, PropSysNamesConduitElmtSideDimensions[i], []) then for j := 0 to AComponent.Properties.Count - 1 do begin if PProperty(AComponent.Properties[j]).SysName = PropSysNamesConduitElmtSideDimensions[i] then begin PropFinded := True; FoundPropNum := j; break; end; end; if PropFinded then begin InterfFinded := false; FoundNum := -1; // //MemTableInterfRel.First; //while Not MemTableInterfRel.Eof do for j := 0 to AComponent.Interfaces.Count - 1 do begin //if (MemTableInterfRel.FieldByName(fnGuidInterface).AsString = guidUniversalChannelSide) and // (MemTableInterfRel.FieldByName(fnIsPort).AsInteger = biFalse) and // (IDChangedInterfaces.IndexOf(MemTableInterfRel.FieldByName(fnID).AsInteger) = -1) and // (MemTableInterfRel.FieldByName(fnGender).AsInteger = gtFemale) and // (MemTableInterfRel.FieldByName(fnTypeI).AsInteger = itFunctional) and // (MemTableInterfRel.FieldByName(fnIsNative).AsBoolean = True) then if (AComponent.Interfaces[j].GUIDInterface = guidUniversalChannelSide) and (AComponent.Interfaces[j].IsPort = biFalse) and (IDChangedInterfaces.IndexOf(j) = -1) and (AComponent.Interfaces[j].Gender = gtFemale) and (AComponent.Interfaces[j].TypeI = itFunctional) and (AComponent.Interfaces[j].ID_Component = AComponent.ID) then begin InterfRel := AComponent.Interfaces[j]; InterfRel := AComponent.Interfaces[FoundNum]; if InterfRel.SideSection <> PProperty(AComponent.Properties[FoundPropNum]).Value then InterfRel.IsModified := True; InterfRel.SideSection := PProperty(AComponent.Properties[FoundPropNum]).Value; InterfFinded := true; FoundNum := j; Break; end; end; if (Not InterfFinded) and aAutoAdd then begin InterfRel := GetNewInterfPortRel(guidUniversalChannelSide); InterfRel.IsPort := biFalse; InterfRel.TypeI := itFunctional; InterfRel.Kind := ikNoSplit; InterfRel.Gender := gtFemale; InterfRel.Multiple := biFalse; InterfRel.Kolvo := 1; InterfRel.IOfIRelOut.Clear; // никаких соединений InterfRel.IsBusy := biFalse; InterfRel.IsNew := true; InterfRel.SideSection := PProperty(AComponent.Properties[FoundPropNum]).Value; AComponent.Interfaces.Add(InterfRel); FoundNum := AComponent.Interfaces.Count - 1; end; if FoundNum >= 0 then IDChangedInterfaces.Add(FoundNum); end; end; finally FreeAndNil(IDChangedInterfaces); end; end; finally FreeAndNil(PropSysNamesConduitElmtSideDimensions); end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.ReDefineConstrInterfacesByProperty', E.Message); end; end; procedure TF_MAIN.DefineUniversalInterfacesByProperty(AComponent: TSCSComponent; AProp: PProperty); var MemTableProp: TkbmMemTable; //MemTablePropBookmark: string; MemTablePropBookmark, MemTablePortBookmark, memTableInterfRelBookmark: TBookMark; MemTablePort: TkbmMemTable; //MemTablePortBookmark: string; MemTableInterfRel: TkbmMemTable; //emTableInterfRelBookmark: string; MemTablePortInterfRel: TkbmMemTable; MemTableInterfInternalConn: TkbmMemTable; Spravochnik: TSpravochnik; mePortRel: TmeInterfaceRel; meInterfRel: TmeInterfaceRel; //meInterfRelEd: PmeInterfaceRel; InterfFinded: Boolean; Prop: PProperty; Port: TSCSInterface; PortCount: Integer; PortWireCount: Integer; WireCount: Integer; PropGender: ShortInt; InterfSection: Double; InterfGuid: String; InterfRelCount: Integer; KeyValues: OleVariant; PropSysNamesConduitElmtSideDimensions: TStringList; IDChangedInterfaces: TIntList; FindedInterf: Boolean; i: Integer; function GetNewInterfPortRel(const AGUID: string): TmeInterfaceRel; var SprInterface: TNBInterface; begin //Tolik Result.Notice := ''; Result.DataSource := nil; Result.mtInterfaces := nil; Result.mtPortInterfRel := nil; Result.mtInterfInternalConnect := nil; Result.mtPorts := nil; Result.ValueI := 0; // Result.ID := 0; Result.ID_COMPONENT := AComponent.ID; Result.IsLineCompon := AComponent.IsLine; Result.Color := clWhite; Result.ID_INTERFACE := 0; Result.IsBusy := biFalse; Result.SignType := oitProjectible; Result.Count := 1; SprInterface := Spravochnik.CreateInterfaceByStandartGUID(AGUID); Result.ID_INTERFACE := SprInterface.ID; Result.GUIDInterface := AGUID; Result.Name := SprInterface.Name; end; begin try if AProp <> nil then begin MemTableProp := DM.MemTable_Property; //MemTablePropBookmark := MemTableProp.Bookmark; MemTablePropBookmark := MemTableProp.GetBookmark; MemTablePort := DM.MemTable_Port; //MemTablePortBookmark := MemTablePort.Bookmark; MemTablePortBookmark := MemTablePort.GetBookmark; MemTableInterfRel := DM.MemTable_InterfaceRel; //MemTableInterfRelBookmark := MemTableInterfRel.Bookmark; MemTableInterfRelBookmark := MemTableInterfRel.GetBookmark; MemTablePortInterfRel := DM.MemTable_PortInterfRel; MemTableInterfInternalConn := DM.mtInterfInternalConn; Spravochnik := GetSpravochnik; PropSysNamesConduitElmtSideDimensions := CreateStringListSorted; //TStringList.Create; PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSideDimensions); // Размеры стороны элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide1Dimensions); // Размеры стороны 1 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide2Dimensions); // Размеры стороны 2 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide3Dimensions); // Размеры стороны 3 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide4Dimensions); // Размеры стороны 4 элемента канала MemTableProp.DisableControls; try ZeroMemory(@mePortRel, SizeOf(TmeInterfaceRel)); ZeroMemory(@meInterfRel, SizeOf(TmeInterfaceRel)); // Количество портов и количество жил на порт if (AProp.SysName = pnPortCount) or (AProp.SysName = pnPortWireCount) then begin {IGOR} //D0000006314 // оставим пока только в полностью лайт версии if GLiteVersion or GAllowConvertInterfToUniversal then begin PortCount := -1; PortWireCount := -1; if AProp.SysName = pnPortCount then begin // Количество портов и жил на порт //PortCount := StrToIntDef(AProp.Value, 0); //Prop := AComponent.GetPropertyBySysName(pnPortWireCount); //if Prop <> nil then // PortWireCount := StrToIntDef(Prop.Value, 0); PortCount := StrToIntDef(AProp.Value, 0); if MemTableProp.Locate(fnSysName, pnPortWireCount, []) then PortWireCount := StrToIntDef(MemTableProp.FieldByName(fnPValue).AsString, 0); // Добавляем/изменяем порт //Port := GetComponInterfacesByParams(AComponent, guidUniversalPort); //if Not Port then KeyValues := VarArrayCreate([0, 1], varVariant); KeyValues[0] := guidUniversalPort; KeyValues[1] := True; //IsNative if Not MemTablePort.Locate(fnGuidInterface+';'+fnIsNative, KeyValues, []) then begin mePortRel := GetNewInterfPortRel(guidUniversalPort); mePortRel.IsPort := biTrue; mePortRel.TypeI := itFunctional; mePortRel.Kind := ikSplit; mePortRel.Gender := gtFemale; mePortRel.Multiple := biFalse; mePortRel.Kolvo := PortCount; DM.MakeEditInterfRel(mePortRel, meMake); mePortRel.ID := MemTablePort.FieldByName(fnID).AsInteger; end else begin mePortRel := DM.GetInterfaceRel(nil, MemTablePort); mePortRel.Kolvo := PortCount; DM.MakeEditInterfRel(mePortRel, meEdit); end; end else if AProp.SysName = pnPortWireCount then begin // Количество жил на порт и портов PortWireCount := StrToIntDef(AProp.Value, 0); if MemTableProp.Locate(fnSysName, pnPortCount, []) then PortCount := StrToIntDef(MemTableProp.FieldByName(fnPValue).AsString, 0); // Ищем ID порта if MemTablePort.Locate(fnGuidInterface, guidUniversalPort, []) then mePortRel.ID := MemTablePort.FieldByName(fnID).AsInteger; end; // Добавляем/изменяем интерфейс + его привязку к порту if PortWireCount <> -1 then begin InterfRelCount := PortWireCount; if PortCount <> -1 then InterfRelCount := PortCount * PortWireCount; // Добавляем/изменяем интерфейс KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := guidUniversalWire; KeyValues[1] := itFunctional; KeyValues[2] := gtFemale; KeyValues[3] := True; //IsNative if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then begin meInterfRel := GetNewInterfPortRel(guidUniversalWire); meInterfRel.IsPort := biFalse; meInterfRel.TypeI := itFunctional; meInterfRel.Kind := ikNoSplit; meInterfRel.Gender := gtFemale; meInterfRel.Multiple := biFalse; meInterfRel.Kolvo := InterfRelCount; DM.MakeEditInterfRel(meInterfRel, meMake); meInterfRel.ID := MemTableInterfRel.FieldByName(fnID).AsInteger; end else begin meInterfRel := DM.GetInterfaceRel(nil, MemTableInterfRel); meInterfRel.Kolvo := InterfRelCount; DM.MakeEditInterfRel(meInterfRel, meEdit); end; // Добавляем/изменяем привязку интерфейса к порту if (mePortRel.ID <> 0) and (meInterfRel.ID <> 0) then begin if MemTablePort.Locate(fnID, mePortRel.ID, []) then begin mePortRel := DM.GetInterfaceRel(nil, MemTablePort); KeyValues := VarArrayCreate([0, 2], varVariant); KeyValues[0] := mePortRel.ID; //fnIDPort KeyValues[1] := meInterfRel.ID; //fnIDInterfRel KeyValues[2] := rtPortInterfRel; //fnRelType if Not MemTablePortInterfRel.Locate(fnIDPort+';'+fnIDInterfRel+';'+fnRelType, KeyValues, []) then begin MemTablePortInterfRel.Append; MemTablePortInterfRel.FieldByName(fnRelType).AsInteger := rtPortInterfRel; MemTablePortInterfRel.FieldByName(fnIDPort).AsInteger := mePortRel.ID; MemTablePortInterfRel.FieldByName(fnIDInterfRel).AsInteger := meInterfRel.ID; MemTablePortInterfRel.FieldByName(fnUnitInterfKolvo).AsInteger := PortWireCount; MemTablePortInterfRel.FieldByName(fnName).AsString := meInterfRel.Name; MemTablePortInterfRel.FieldByName(fnIsNew).AsBoolean := true; MemTablePortInterfRel.Post; end else begin MemTablePortInterfRel.Edit; MemTablePortInterfRel.FieldByName(fnUnitInterfKolvo).AsInteger := PortWireCount; MemTablePortInterfRel.FieldByName(fnIsModified).AsBoolean := true; MemTablePortInterfRel.Post; end; DM.MakeEditInterfRel(mePortRel, meEdit); end; end; end; end; end else //Количество жил if AProp.SysName = pnWireCount then begin {IGOR} //D0000006314 // оставим пока только в полностью лайт версии if GLiteVersion or GAllowConvertInterfToUniversal then begin WireCount := StrToIntDef(AProp.Value, 0); PropGender := gtMale; // Если компонент точечный (мало ли), то интерфейс будет мама if AComponent.IsLine = biFalse then PropGender := gtFemale; // Добавляем/изменяем интерфейс KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := guidUniversalWire; KeyValues[1] := itFunctional; KeyValues[2] := PropGender; KeyValues[3] := True; //IsNative if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then begin meInterfRel := GetNewInterfPortRel(guidUniversalWire); meInterfRel.IsPort := biFalse; meInterfRel.TypeI := itFunctional; meInterfRel.Kind := ikNoSplit; meInterfRel.Gender := PropGender; meInterfRel.Multiple := biFalse; meInterfRel.Kolvo := WireCount; // Для линейного компонента создаем парный интерфейс if AComponent.IsLine = biTrue then begin meInterfRel.Count := 2; meInterfRel.ServiceIsPair := true; end; DM.MakeEditInterfRel(meInterfRel, meMake); end else begin meInterfRel := DM.GetInterfaceRel(nil, MemTableInterfRel); meInterfRel.Kolvo := WireCount; DM.MakeEditInterfRel(meInterfRel, meEdit); end; end; end else // Внешний/внутренний сечение - для кабеля и каб канала if (AProp.SysName = pnInSection) or (AProp.SysName = pnOutSection) then begin InterfSection := StrToFloatDef_My(AProp.Value, 0); InterfSection := FloatInUOM(InterfSection, umMM, umSM, 2); InterfFinded := false; // Добавляем/изменяем интерфейс InterfGuid := guidUniversalInConstr; PropGender := gtFemale; if AProp.SysName = pnOutSection then begin InterfGuid := guidUniversalOutConstr; PropGender := gtMale; end; KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := InterfGuid; KeyValues[1] := itConstructive; KeyValues[2] := PropGender; KeyValues[3] := True; //IsNative if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then begin // Найти емкостной интерфейc КК - конструктив, род=PropGender, родной, многократный KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := itConstructive; KeyValues[1] := PropGender; KeyValues[2] := True; //IsNative KeyValues[3] := biTrue; // Multiple if Not MemTableInterfRel.Locate(fnTypeI+';'+fnGender+';'+fnIsNative+';'+fnMultiple, KeyValues, []) then begin meInterfRel := GetNewInterfPortRel(InterfGuid); meInterfRel.IsPort := biFalse; meInterfRel.TypeI := itConstructive; meInterfRel.Kind := ikNoSplit; meInterfRel.Gender := PropGender; meInterfRel.Multiple := biTrue; meInterfRel.Kolvo := 1; meInterfRel.ValueI := InterfSection; DM.MakeEditInterfRel(meInterfRel, meMake); end else InterfFinded := true; end else InterfFinded := true; if InterfFinded then begin meInterfRel := DM.GetInterfaceRel(nil, MemTableInterfRel); meInterfRel.ValueI := InterfSection; DM.MakeEditInterfRel(meInterfRel, meEdit); end; end else // Размеры сторон кабельного канала - применяется на каб канале if (AProp.SysName = pnConduitSideDimensions) or (AProp.SysName = pnCableChannelSideSection) then begin //18.01.2011 // Если применяется свойство "Сечение стороны кабельного канала" // и в компонента есть более приоритетное своствой "Размеры сторон кабельного канала", то игнорируем if (AProp.SysName = pnCableChannelSideSection) and MemTableProp.Locate(fnSysName, pnConduitSideDimensions, []) then Exit; ///// EXIT ///// InterfFinded := false; PropGender := gtMale; // Если компонент точечный, то интерфейс будет мама if AComponent.IsLine = biFalse then PropGender := gtFemale; // Добавляем/изменяем интерфейс KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := guidUniversalChannelSide; KeyValues[1] := itFunctional; KeyValues[2] := PropGender; KeyValues[3] := True; //IsNative // Найти универсальный интерфейс if Not MemTableInterfRel.Locate(fnGuidInterface+';'+fnTypeI+';'+fnGender+';'+fnIsNative, KeyValues, []) then begin // Найти интерфейc стороны КК - функционал, папа, родной, немногократный KeyValues := VarArrayCreate([0, 3], varVariant); KeyValues[0] := itFunctional; KeyValues[1] := gtMale; KeyValues[2] := True; //IsNative KeyValues[3] := biFalse; // Multiple if Not MemTableInterfRel.Locate(fnTypeI+';'+fnGender+';'+fnIsNative+';'+fnMultiple, KeyValues, []) then begin // Если подходящий не нашли, то создаем универсальный "" meInterfRel := GetNewInterfPortRel(guidUniversalChannelSide); meInterfRel.IsPort := biFalse; meInterfRel.TypeI := itFunctional; meInterfRel.Kind := ikNoSplit; meInterfRel.Gender := PropGender; meInterfRel.Multiple := biFalse; meInterfRel.Kolvo := 1; meInterfRel.SideSection := AProp.Value; // Для линейного компонента создаем парный интерфейс if AComponent.IsLine = biTrue then begin meInterfRel.Count := 2; meInterfRel.ServiceIsPair := true; end; DM.MakeEditInterfRel(meInterfRel, meMake); end else InterfFinded := true; end else InterfFinded := true; if InterfFinded then begin meInterfRel := DM.GetInterfaceRel(nil, MemTableInterfRel); meInterfRel.SideSection := AProp.Value; DM.MakeEditInterfRel(meInterfRel, meEdit); end; end else // Размеры стороны элемента канала if PropSysNamesConduitElmtSideDimensions.IndexOf(AProp.SysName) <> -1 then begin IDChangedInterfaces := TIntList.Create; try // Для каждого свойства, определяющего размерность, определяем интерфейс for i := 0 to PropSysNamesConduitElmtSideDimensions.Count - 1 do begin if MemTableProp.Locate(fnSysName, PropSysNamesConduitElmtSideDimensions[i], []) then begin FindedInterf := false; MemTableInterfRel.First; while Not MemTableInterfRel.Eof do begin if (MemTableInterfRel.FieldByName(fnGuidInterface).AsString = guidUniversalChannelSide) and (MemTableInterfRel.FieldByName(fnIsPort).AsInteger = biFalse) and (IDChangedInterfaces.IndexOf(MemTableInterfRel.FieldByName(fnID).AsInteger) = -1) and (MemTableInterfRel.FieldByName(fnGender).AsInteger = gtFemale) and (MemTableInterfRel.FieldByName(fnTypeI).AsInteger = itFunctional) and (MemTableInterfRel.FieldByName(fnIsNative).AsBoolean = True) then begin meInterfRel := DM.GetInterfaceRel(nil, MemTableInterfRel); meInterfRel.SideSection := MemTableProp.FieldByName(fnPValue).AsString; DM.MakeEditInterfRel(meInterfRel, meEdit); FindedInterf := true; Break; //// BREAK //// end; MemTableInterfRel.Next; end; if Not FindedInterf then begin meInterfRel := GetNewInterfPortRel(guidUniversalChannelSide); meInterfRel.IsPort := biFalse; meInterfRel.TypeI := itFunctional; meInterfRel.Kind := ikNoSplit; meInterfRel.Gender := gtFemale; meInterfRel.Multiple := biFalse; meInterfRel.Kolvo := 1; meInterfRel.SideSection := MemTableProp.FieldByName(fnPValue).AsString; DM.MakeEditInterfRel(meInterfRel, meMake); end; IDChangedInterfaces.Add(MemTableInterfRel.FieldByName(fnID).AsInteger); end; end; finally FreeAndNil(IDChangedInterfaces); end; end; finally MemTableProp.EnableControls; {MemTableProp.Bookmark := MemTablePropBookmark; MemTablePort.Bookmark := MemTablePortBookmark; MemTableInterfRel.Bookmark := MemTableInterfRelBookmark;} if MemTablePropBookmark <> nil then begin MemTableProp.GotoBookMark(MemTablePropBookmark); MemTableProp.FreeBookMark(MemTablePropBookmark); end; if MemTablePortBookmark <> nil then begin MemTablePort.GotoBookMark(MemTablePortBookmark); MemTablePort.FreeBookMark(MemTablePortBookmark); end; if MemTableInterfRelBookmark <> nil then begin MemTableInterfRel.GotoBookMark(MemTableInterfRelBookmark); MemTableInterfRel.FreeBookMark(MemTableInterfRelBookmark); end; FreeAndNil(PropSysNamesConduitElmtSideDimensions); end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.DefineUniversalInterfacesByProperty', E.Message); end; end; procedure TF_MAIN.StepNodes(AParentN: TTreeNode; AParentCatalog: TSCSCatalog; AisSecondLevel: Boolean); //Recurse var //ChildListID: TList; //SubNodes: TList; //*** Дочерние ветки дерева //ComponList: TList; //*** Список Компонент папки //ComponData: PComponData; //*** Элемент этого списка ChildCatalogs: TSCSCatalogs; CatalogComponents: TSCSComponents; SCSComponent: TSCSComponent; ComponCount: Integer; ParentCatalog: TSCSCatalog; Catalog: TSCSCatalog; Parent_ID: Integer; ParentLevel: Integer; SCSList: TSCSList; NewNode: TTreeNode; NodeComp: TTreeNode; NewDat: PObjectData; ParentDat: PObjectData; DatCompon: PObjectData; NodeTxt: String; //SCSObjNode: TTreeNode; LineGroupNode: TTreeNode; ConnGroupNode: TTreeNode; SCSID: Integer; //ListSettings: TListSettings; WasSelectQuery: Boolean; i, j: Integer; NCount: Integer; //*** Количество дочерних папок CCount: Integer; //*** Количество компонентов в папке CanLoadCompon: Boolean; ParentNode: TTreeNode; //QueryModeForParent: TQueryMode; QueryMode: TQueryMode; //scsQ: TSCSQuery; //scsQ1: TSCSQuery; begin ParentDat := nil; LineGroupNode := nil; ConnGroupNode := nil; ParentCatalog := AParentCatalog; SCSList := nil; //ChildListID := nil; //*** Определить режим работы запросов // с физ. или мем. базой QueryMode := GetQueryModeByParentNode(GDBMode, AParentN, GetQueryModeByGDBMode(GDBMode)); //QueryModeForParent := GetQueryModeByParentNode(GDBMode, AParentN, GetQueryModeByGDBMode(GDBMode)); //SCSListMakeHere := false; ParentLevel := -1; if AParentN = nil then Parent_ID := 0 else begin ParentDat := AParentN.Data; Parent_ID := ParentDat.ObjectID; ParentLevel := AParentN.Level; if ParentCatalog = nil then if QueryMode = qmMemory then ParentCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Parent_ID); end; WasSelectQuery := false; //if (GDBMode = bkProjectManager) and (AParentN <> nil) then //begin // if ParentDat.ItemType = itProject then // Parent_ID := 0; //*** Группировка объектов //if ParentDat.ItemType = itList then //begin // SCSList := nil; // SCSList := GSCSBase.CurrProject.GetListBySCSID(ParentDat.ListID); // if SCSList <> nil then // if SCSList.Setting.GroupListObjectsByType then // begin // ChildListID := DM.GetListObjectsID(ParentDat.ListID, 'SORT_ID'); // WasSelectQuery := true; // end; //end; //end; //if Not WasSelectQuery then // ChildListID := DM.GetChildCatalogsID(Parent_ID, 'SORT_ID', QueryMode); //SubNodes := TList.Create; ChildCatalogs := TSCSCatalogs.Create(false); LoadCatalogs(Parent_ID, ParentLevel, ChildCatalogs, QueryMode); //LoadCatalogs(ChildCatalogs, ChildListID, QueryMode); //FreeList(ChildListID); // Загрузка Подпапок папки ParentN //NCount := SubNodes.Count; for i := 0 to ChildCatalogs.Count - 1 do if Assigned(ChildCatalogs[i]) then begin Catalog := ChildCatalogs[i]; if Not((Catalog.ItemType = itRoom) and (LineGroupNode <> nil)) then begin NewData(NewDat, ttComponents); NewDat.ObjectID:= Catalog.ID; NewDat.QueryMode := QueryMode; NewDat.ComponKind := ckNone; NewDat.SortID := Catalog.SortID; //04.04.2012 - для объектов определяем группу сразу ParentNode := nil; if Catalog.ItemType in [itSCSLine, itSCSConnector] then begin NewDat.ItemType := Catalog.ItemType; ParentNode := DefineObjectGroupForCatalogData(Catalog.GetListOwner, GetParentNodeByItemType(AParentN, [itList]), NewDat, '', nil, Catalog.IsLine); end; if ParentNode = nil then ParentNode := AParentN; if AParentN = nil then NewNode := Tree_Catalog.Items.Add(ParentNode, Catalog.Name) else NewNode := Tree_Catalog.Items.AddChild(ParentNode, Catalog.Name); case GDBMode of bkNormBase: begin if AParentN = nil then begin if Tree_catalog.Items.Count = 1 then NewDat.NBMode := nbmNorm else NewDat.NBMode := nbmUser; end else NewDat.NBMode := PObjectData(AParentN.Data).NBMode; NewDat.ItemType := itDir; //NewNode.ImageIndex := GetNodeImageIndex(itDir, ekNone, NewDat.ObjectID); //NewNode.ImageIndex := 0; if Parent_ID <> 0 then NewNode.Text := GetNameAndKol(Catalog.Name, Catalog.KolCompon); end; bkProjectManager: begin NewDat.NBMode := nbmNone; NewDat.ItemType := Catalog.ItemType; if Catalog.ItemType = itList then NewDat.ListID := Catalog.ListID; if Catalog.ItemType in [itRoom, itSCSLine, itSCSConnector] then if ParentDat <> nil then NewDat.ListID := ParentDat.ListID; NewNode.Text := Catalog.GetNameForVisible(true); end; end; NewDat.Expanded := false; NewNode.Data := NewDat; //NewDat.ChildNodesCount := Catalog.ItemsCount + Catalog.KolCompon; DefineCatalogNodeChildNodeExists(NewNode, Catalog.ItemsCount, Catalog.KolCompon); Catalog.TreeViewNode := NewNode; SetNodeState(NewNode, NewDat.ItemType, ekNone); //*** Учесть группировку //04.04.2012 if Catalog.ItemType in [itSCSLine, itSCSConnector] then //04.04.2012 DefineObjectGroupForCatalog(Catalog); //*** Учесть группировку (если объект пустой, то добавить в группу пустых) //if Catalog.ItemType in [itSCSLine, itSCSConnector] then // if Catalog.KolCompon = 0 then // DefineObjectGroup(NewNode, ogtEmpty, Catalog.IsLine); //*** Если в папке есть папки, То засыпать в Папку один уровень if {(Catalog.ItemsCount > 0) and} Not(AisSecondLevel) and (PObjectData(NewNode.Data).ItemType <> itProject) then //if (Catalog.ItemsCount > 0) or (Catalog.KolCompon > 0) then if NewDat.ChildNodesCount > 0 then begin NewNode.HasChildren := true; //StepNodes(NewNode, Catalog, true); end; end; end; //*** Определить количество компонентов ComponCount := 0; if ParentCatalog = nil then begin if QueryMode = qmPhisical then ComponCount := DM.GetCatalogKolCompon(Parent_ID, QueryMode); end else ComponCount := ParentCatalog.KolCompon; //*** Добавление компонент if (GFormMode <> fmNewFolder) and (ComponCount > 0) then begin FillCompons(AParentN, false, QueryMode); { CatalogComponents := DM.GetCatalogComponents(Parent_ID, fnSortID); for i := 0 to CatalogComponents.Count - 1 do if Assigned(CatalogComponents[i]) then begin SCSComponent := CatalogComponents[i]; NodeTxt := GetComponNameForVisible(SCSComponent.Name, SCSComponent.NameMark); NodeTxt := GetNameAndKol(NodeTxt, SCSComponent.KolComplect); if GDBMode = bkProjectManager then if SCSComponent.isLine = biTrue then NodeTxt := NodeTxt + GetNameConnectFromAndTo(SCSComponent); //#2006_03_29 NodeComp := Tree_Catalog.Items.AddChild(AParentN, NodeTxt); NewData(DatCompon, ttComponents); DatCompon.ObjectID:= SCSComponent.ID; DatCompon.SortID := SCSComponent.SortID; DatCompon.ItemType := GetSCSComponType(SCSComponent.isLine); //*** itComponent; DatCompon.QueryMode := QueryMode; DatCompon.ComponKind := ckCompon; DatCompon.ChildNodesCount := SCSComponent.KolComplect; DatCompon.Expanded := false; DatCompon.NBMode := PObjectData(AParentN.Data).NBMode; DatCompon.ListID := PObjectData(AParentN.Data).ListID; //NodeComp.ImageIndex := GetNodeImageIndex(DatCompon.ItemType, ekNone, DatCompon.ObjectID); NodeComp.Data := DatCompon; if SCSComponent.KolComplect > 0 then begin NodeComp.HasChildren := true; end; SCSComponent.TreeViewNode := NodeComp; SetNodeState(NodeComp, DatCompon.ItemType, ekNone, SCSComponent); //*** Если первый компонент в объекте, то добавить его в группу //DefineObjectGroup(AParentN, SCSComponent.ID_ComponentType, SCSComponent.isLine); //*** Добавить комплектующие //if Not AisSecondLevel then // if ComponData.Kol_Complect > 0 then // FillCompl(ComponData.ID, NodeComp, DM.scsQ); end; FreeAndNil(CatalogComponents); } end; if LineGroupNode <> nil then LineGroupNode.Expanded := false; if ConnGroupNode <> nil then ConnGroupNode.Expanded := false; {if SCSListMakeHere then if SCSList <> nil then SCSList.Free;} for i := 0 to ChildCatalogs.Count - 1 do begin Catalog := ChildCatalogs[i]; if Catalog.QueryMode = qmPhisical then FreeAndNil(Catalog); end; FreeAndNil(ChildCatalogs); //SubNodes.Free; //*** Очистка SubNodes //FreeList(SubNodes); end; procedure TF_MAIN.FillCompons(ADirNode: TTreeNode; ADefChildCount: Boolean; AQueryMode: TQueryMode); var CatalogComponents: TSCSComponents; SCSComponent: TSCSComponent; ParentID: Integer; SkipCount: Integer; NodeTxt: String; NodeComp: TTreeNode; DatCompon: PObjectData; i: Integer; ChildCatalogCount: Integer; LoadedComponsLists: Boolean; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin ParentID := PObjectData(ADirNode.Data).ObjectID; OldTick := GetTickCount; CatalogComponents := nil; LoadedComponsLists := false; if (FFilterParams.FFilterType <> fltCustom) and FFilterParams.IsUseFilter then if DM.ComponIDs.Count = 0 then begin DM.LoadIDsToComponLists(FFilterParams); LoadedComponsLists := true; end; try CatalogComponents := DM.GetCatalogComponents(ParentID, fnSortID, FFilterParams, SkipCount, false); finally if LoadedComponsLists then DM.ClearComponLists; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; for i := 0 to CatalogComponents.Count - 1 do if Assigned(CatalogComponents[i]) then begin SCSComponent := CatalogComponents[i]; NodeTxt := GetComponNameForVisible(SCSComponent.Name, SCSComponent.NameMark); NodeTxt := GetNameAndKol(NodeTxt, SCSComponent.KolComplect); if GDBMode = bkProjectManager then if SCSComponent.isLine = biTrue then NodeTxt := NodeTxt + GetNameConnectFromAndTo(SCSComponent); //#2006_03_29 NodeComp := Tree_Catalog.Items.AddChild(ADirNode, NodeTxt); NewData(DatCompon, ttComponents); DatCompon.ObjectID:= SCSComponent.ID; DatCompon.SortID := SCSComponent.SortID; DatCompon.ItemType := GetSCSComponType(SCSComponent.isLine); //*** itComponent; DatCompon.QueryMode := AQueryMode; DatCompon.ComponKind := ckCompon; DatCompon.ChildNodesCount := SCSComponent.KolComplect; if GFormMode <> fmNormal then DatCompon.ChildNodesCount := 0; DatCompon.Expanded := false; DatCompon.NBMode := PObjectData(ADirNode.Data).NBMode; DatCompon.ListID := PObjectData(ADirNode.Data).ListID; //NodeComp.ImageIndex := GetNodeImageIndex(DatCompon.ItemType, ekNone, DatCompon.ObjectID); NodeComp.Data := DatCompon; if (SCSComponent.KolComplect > 0) and (GFormMode = fmNormal) then NodeComp.HasChildren := true; SCSComponent.TreeViewNode := NodeComp; SetNodeState(NodeComp, DatCompon.ItemType, ekNone, SCSComponent); //*** Если первый компонент в объекте, то добавить его в группу //DefineObjectGroup(AParentN, SCSComponent.ID_ComponentType, SCSComponent.isLine); //*** Добавить комплектующие //if Not AisSecondLevel then // if ComponData.Kol_Complect > 0 then // FillCompl(ComponData.ID, NodeComp, DM.scsQ); end; //*** Запомнить количество пропущеных компонент PObjectData(ADirNode.Data).SkipCount := SkipCount; if ADefChildCount then begin ChildCatalogCount := GetCatalogNodeChildCatalogCount(ADirNode); DefineCatalogNodeHasChildren(ADirNode, ChildCatalogCount, CatalogComponents.Count); end; FreeAndNil(CatalogComponents); end; function TF_MAIN.GetCatalogNodeChildCatalogCount(ANode: TTreeNode): Integer; var SCSCatalog: TSCSCatalog; Dat: PObjectData; begin Result := 0; Dat := ANode.Data; if IsCatalogItemType(Dat.ItemType) then begin if GDBMode = bkNormBase then Result := DM.GetIntFromTableByID(tnCatalog, fnItemsCount, Dat.ObjectID, qmPhisical) else if GDBMode = bkprojectManager then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if SCSCatalog <> nil then Result := SCSCatalog.ItemsCount; end; end; end; function TF_MAIN.GetCatalogNodeComponCount(ANode: TTreeNode): Integer; var Compons: TSCSComponents; SkipCount: Integer; Dat: PObjectData; begin Result := 0; Dat := ANode.Data; if IsCatalogItemType(Dat.ItemType) then begin Compons := DM.GetCatalogComponents(Dat.ObjectID, '', FFilterParams, SkipCount, false); Result := Compons.Count; FreeAndNil(Compons); end; end; // ##### Строит дерево ##### Procedure TF_MAIN.AddNodes(AParentNode: TTreeNode); var i, j: Integer; CurrNode: TTreeNode; ListWithSiblNodes: TList; //ParentDat: PObjectData; CurrDat: PObjectData; KolCatalogs: Integer; KolComponents: Integer; KolComplects: Integer; QueryMode: TQueryMode; //scsQ: TSCSQuery; //scsQ1: TSCSQuery; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin OldTick := GetTickCount; //try QueryMode := GetQueryModeByParentNode(GDBMode, AParentNode, GetQueryModeByGDBMode(GDBMode)); ListWithSiblNodes := nil; if (AParentNode <> nil) and (AParentNode.Count > 0) then begin { ListWithSiblNodes := Tlist.Create; try CurrNode := AParentNode.getFirstChild; while CurrNode <> nil do begin ListWithSiblNodes.Add(CurrNode); CurrNode := CurrNode.getNextSibling; end; //*** Пройти по всем подпапкам Папки ParentNode //CurrNode := AParentNode.getFirstChild; //while CurrNode <> nil do for i := 0 to ListWithSiblNodes.Count - 1 do begin CurrNode := ListWithSiblNodes[i]; CurrDat := CurrNode.Data; KolCatalogs := 0; KolComponents :=0; //*** Загрузка папок if CurrDat <> nil then if Not(CurrDat.ItemType in [itComponLine, itComponCon]) then begin //DM.GetCatalogItemsCountAndKolCompon(CurrDat.ObjectID, KolCatalogs, KolComponents, QueryMode); //if (CurrNode.Count = 0) and (KolCatalogs + KolComponents > 0) then // StepNodes(CurrNode, nil, true); end else //*** Загрузка комплектующих if (GFormMode = fmNormal) or (GFormMode = fmConnections) then begin KolComplects := CurrDat.ChildNodesCount; if (CurrNode.Count = 0) and (KolComplects > 0) then FillCompl(CurrDat.ObjectID, CurrNode); end; end; finally FreeAndNil(ListWithSiblNodes); end; } end else begin //if (AParentNode = nil) or Not(PObjectData(AParentNode.Data).ItemType in [itComponCon, itComponLine]) then if (AParentNode = nil) or Not IsComponItemType(PObjectData(AParentNode.Data).ItemType) then StepNodes(AParentNode, nil, false) else if AParentNode <> nil then FillCompl(PObjectData(AParentNode.Data).ObjectID, AParentNode, nil); end; //except // on E: Exception do AddExceptionToLog('TF_MAIN.AddNodes: '+E.Message); //end; (* try scsQ := TSCSQuery.Create(Self, DM.Query, DM.qSQL_Query); scsQ1 := TSCSQuery.Create(Self, DM.Query1, DM.qSQL_Query1); QueryMode := GetQueryModeByParentNode(GDBMode, AParentNode, scsQ.QueryMode); scsQ.QueryMode := QueryMode; scsQ1.QueryMode := QueryMode; try ListWithSiblNodes := nil; if (AParentNode <> nil) and (AParentNode.Count > 0) then begin ListWithSiblNodes := Tlist.Create; try CurrNode := AParentNode.getFirstChild; while CurrNode <> nil do begin ListWithSiblNodes.Add(CurrNode); CurrNode := CurrNode.getNextSibling; end; //*** Пройти по всем подпапкам Папки ParentNode //CurrNode := AParentNode.getFirstChild; //while CurrNode <> nil do for i := 0 to ListWithSiblNodes.Count - 1 do begin CurrNode := ListWithSiblNodes[i]; CurrDat := CurrNode.Data; KolCatalogs := 0; KolComponents :=0; //*** Загрузка папок if CurrDat <> nil then if Not(CurrDat.ItemType in [itComponLine, itComponCon]) then begin SetSQLToQuery(scsQ, ' SELECT KOL_COMPON, ITEMS_COUNT FROM KATALOG ' + ' WHERE ID = ''' +IntToStr(CurrDat.ObjectID)+ ''' '); KolCatalogs := scsQ.GetFNAsInteger('ITEMS_COUNT'); if GFormMode <> fmNewFolder then begin SetSQLToQuery(DM.scsQ, ' SELECT KOL_COMPON FROM KATALOG ' + ' WHERE ID = '''+IntToStr(CurrDat.ObjectID)+''' '); KolComponents := scsQ.GetFNAsInteger('KOL_COMPON'); end; if (CurrNode.Count = 0) and (KolCatalogs + KolComponents > 0) then StepNodes(CurrNode, nil, true); //if (CurrNode.Count > 0) and (CurrNode.Count < KolCatalogs + KolComponents) then // begin // CurrNode.DeleteChildren; // StepNodes(CurrNode, nil, true); // end; end else //*** Загрузка комплектующих if (GFormMode = fmNormal) or (GFormMode = fmConnections) then begin {SetSQLToQuery(DM.scsQ, ' SELECT COUNT(ID) As Cnt FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+ IntToStr(CurrDat.ObjectID) +''') and '+ ' (ID_COMPONENT in (SELECT ID FROM COMPONENT) ) '); KolComplects := DM.scsQ.FN('Cnt').AsInteger;} {SetSQLToQuery(DM.scsQSelect, ' select kol_complect from component where id = '''+IntTostr(CurrDat.ObjectID)+''' '); KolComplects := DM.scsQSelect.FN('kol_complect').AsInteger;} KolComplects := CurrDat.ChildNodesCount; if (CurrNode.Count = 0) and (KolComplects > 0) then FillCompl(CurrDat.ObjectID, CurrNode); end; //CurrNode := CurrNode.getNextSibling; end; finally ListWithSiblNodes.Free; end; end else StepNodes(AParentNode, nil, false); finally scsQ.Free; scsQ1.Free; end; except on E: Exception do AddExceptionToLog('TF_MAIN.AddNodes: '+E.Message); end; *) CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TF_MAIN.AfterConnectToBase; var Node: TTreeNode; begin if GFormMode = fmNormal then if GDBMode = bkNormBase then begin //*** Подгрузить фильтр из нормативной базы if FileExists(GetPathToNBComponFilter) then begin FFilterParams.FFilterBlock := TFilterBlock.Create(nil, btBlock); FFilterParams.FFilterBlock.LoadFromFile(GetPathToNBComponFilter, ftComponent, nil, false); if GDBMode = bkNormBase then begin if FFilterParams.FFilterType = fltNone then begin FFilterParams.FFilterType := fltCustom; FFilterParams.DefineIsUseFilterField; GSCSIni.NB.FilterType := FFilterParams.FFilterType; WriteNBIni(GSCSIni.NB); end else FFilterParams.IsUseFilter := GSCSIni.NB.IsUseFilter; FFilterParams.FFilterBlock.IsOn := true; end; ApplyComponentFilter(nil, FFilterParams, true); DM.DefineIsOnFilterBlocks(FFilterParams, true); end; end; case GDBMode of bkNormBase: begin if GSCSIni.NB.IDLastNBDir > 0 then begin Node := nil; if GSCSBase.Active then Node := FindComponOrDirInTree(GSCSIni.NB.IDLastNBDir, false); if Node <> nil then begin // Tolik 22/11/2019 -- Node.Expand(False); //Node.Expanded := true; // Tree_Catalog.Selected := Node; end; end; if GFormMode = fmNormal then InitComponGroup(''); pcObjectsChange(pcObjects); end; bkProjectManager: begin //*** Раскрыть папку "Менеджер проектов" и перейти на последний проект if Tree_Catalog.Items.Count > 0 then Tree_Catalog.Items[0].Expanded := true; if GIDLastProject > 0 then begin Node := nil; if GSCSBase.Active then Node := FindTreeNodeByDat(GIDLastProject, [itProject]); if Node = nil then Node := FindComponOrDirInTree(GIDLastProject, false, qmPhisical); if Node <> nil then Tree_Catalog.Selected := Node; end; end; end; end; procedure TF_MAIN.ConnectToBase(APath: string=''); var OpenBaseResult: TOpenBaseResult; CommonIni: TCommonIni; //Node: TTreeNode; DBPath: string; begin DBPath := APath; if DBPath = '' then begin case GDBMode of bkNormBase: begin CommonIni := GSCSIni.NB.Common; GSCSIni.NB.IsAdministration := false; {$IF Not Defined (FINAL_SCS) or Defined(BASEADM_SCS)} GSCSIni.NB.IsAdministration := true; {$IFEND} Act_SettIsAdministration.Checked := GSCSIni.NB.IsAdministration; if GFormMode = fmNormal then EnableDisableEdit(Not GSCSIni.NB.DisableEdit and CheckWriteNBByUser); end; bkProjectManager: begin CommonIni := GSCSIni.PM.Common; GIDLastProject := GSCSIni.PM.IDLastProject; end; end; DBPath := CommonIni.DBPath; end; {$IF Defined(FLASH_SCS)} if GDBMode = bkProjectManager then begin if not GSCSIni.NB.SaveConnParams then begin GSCSIni.PM.Common.DBPath := extractfilepath(paramstr(0)) + '\' + DefPMPath; GSCSIni.PM.SaveConnParams := false; DBPath := GSCSIni.PM.Common.DBPath; end; end; {$IFEND} OpenBaseResult := GSCSBase.Open(DBPath, GFormMode = fmNormal); {$IF Defined(FLASH_SCS)} //if GDBMode = bkProjectManager then // if obrFoul = OpenBaseResult then // OpenBaseResult := GSCSBase.Open('', GFormMode = fmNormal); {$IFEND} if GFormMode = fmNormal then OpenBaseResultHandler(OpenBaseResult, Self, true, true); {if obrSuccess = OpenBaseResult then begin if GFormMode = fmNormal then if GDBMode = bkNormBase then begin //*** Подгрузить фильтр из нормативной базы if FileExists(GetPathToNBComponFilter) then begin FFilterBlock := TFilterBlock.Create(nil, btBlock); FFilterBlock.LoadFromFile(GetPathToNBComponFilter, ftComponent, nil, false); ApplyComponentFilter(nil, FFilterBlock, true); DM.DefineIsOnFilterBlocks(FFilterBlock, true); end; end; case GDBMode of bkNormBase: begin if GSCSIni.NB.IDLastNBDir > 0 then begin Node := nil; if GSCSBase.Active then Node := FindComponOrDirInTree(GSCSIni.NB.IDLastNBDir, false); if Node <> nil then begin Node.Expanded := true; Tree_Catalog.Selected := Node; end; end; end; bkProjectManager: begin //*** Раскрыть папку "Менеджер проектов" и перейти на последний проект if Tree_Catalog.Items.Count > 0 then Tree_Catalog.Items[0].Expanded := true; if GIDLastProject > 0 then begin Node := nil; if GSCSBase.Active then Node := FindTreeNodeByDat(GIDLastProject, [itProject]); if Node = nil then Node := FindComponOrDirInTree(GIDLastProject, false, qmPhisical); if Node <> nil then Tree_Catalog.Selected := Node; end; end; end; end;} end; procedure TF_MAIN.ControlBar_ToolsBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); begin Options := []; end; procedure TF_MAIN.DefineCatalogNodeChildNodeExists(ACatalogNode: TTreeNode; AChildCatalogCount, AComponCount: Integer); var Dat: PObjectData; ComponCount: Integer; begin Dat := PObjectData(ACatalogNode.Data); if IsCatalogItemType(Dat.ItemType) then begin ComponCount := 0; {//21.11.2007 if (FFilterBlock <> nil) and (FFilterBlock.IsOn) then begin ComponCount := GetCatalogNodeComponCount(ACatalogNode); end else ComponCount := AComponCount; } ComponCount := AComponCount; if FFilterParams.IsUseFilter then //if (FFilterParams.FFilterBlock <> nil) and (FFilterParams.FFilterBlock.IsOn) then if GDBMode = bkProjectManager then ComponCount := GetCatalogNodeComponCount(ACatalogNode); //Dat.ChildNodesCount := TotalCount; //ACatalogNode.HasChildren := Dat.ChildNodesCount > 0; DefineCatalogNodeHasChildren(ACatalogNode, AChildCatalogCount, ComponCount); end; end; procedure TF_MAIN.DefineCatalogNodeHasChildren(ACatalogNode: TTreeNode; AChildCatalogCount, AComponCount: Integer); begin PObjectData(ACatalogNode.Data).ChildNodesCount := AChildCatalogCount + AComponCount; ACatalogNode.HasChildren := PObjectData(ACatalogNode.Data).ChildNodesCount > 0; end; procedure TF_MAIN.DefineChildNodes(ANode: TTreeNode); begin if ANode <> nil then if (ANode.Count = 0) and (ANode.HasChildren) then AddNodes(ANode); end; procedure TF_MAIN.DefineFTraceLength; var SCSCompon: TSCSComponent; SCSCatalog: TSCSCatalog; begin // преобразовать тек-ю единицу длины в метры FTraccaLength := FloatInUOM(1, FUOM, umMetr); if GDBMode = bkProjectManager then if GSCSBase.SCSComponent.ID <> 0 then begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); if SCSCompon <> nil then FTraccaLength := SCSCompon.GetPartLength; end else if GSCSBase.SCSCatalog.ID <> 0 then if GSCSBase.SCSCatalog.ItemType = itSCSLine then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(GSCSBase.SCSCatalog.ID); if SCSCatalog <> nil then FTraccaLength := SCSCatalog.GetPropertyValueAsFloat(pnLength); end; GT_NormsResourcesTotalKolvo.Caption := GetCaptionNormsResourcesTotalKolvo(FUOM, FTraccaLength); end; procedure TF_MAIN.DefineImageIndexComponNode(AIDComponent: Integer); var ComponNode: TTreeNode; SCSComponent: TSCSComponent; begin if GDBMode = bkNormBase then begin ComponNode := FindTreeNodeByDat(AIDComponent, [itComponCon, itComponLine]); if ComponNode <> nil then begin SCSComponent := TSCSComponent.Create(Self); try SCSComponent.LoadComponentByID(AIDComponent, false); SCSComponent.LoadComponentType; SetNodeState(ComponNode, -1, GEditKind, SCSComponent); finally SCSComponent.Free; end; end; end; end; procedure TF_MAIN.DefineNodesFontColorByZeroPriceComponents(AColorZeroPriceComponent: TColor); var i: Integer; Node: TTreeNode; begin try for i := 0 to Tree_Catalog.Items.Count - 1 do begin Node := Tree_Catalog.Items[i]; if Node.Data <> nil then if PObjectData(Node.Data).FontColor <> -1 then if PObjectData(Node.Data).ItemType in [itComponLine, itComponCon, itLinkCompLine, itLinkCompCon] then PObjectData(Node.Data).FontColor := AColorZeroPriceComponent; end; Tree_Catalog.Repaint; except on E: Exception do AddExceptionToLog('TF_MAIN.DefineNodesFontColorByZeroPriceComponents: '+E.Message); end; end; procedure TF_MAIN.DefineNodesFromAndTo(AParentNode: TTreeNode); var ChildNode: TTreeNode; begin if GDBMode = bkProjectManager then if Assigned(AParentNode) then if AParentNode.Data <> nil then if (PObjectData(AParentNode.Data).ItemType in [itSCSLine, itComponLine]) then begin ChildNode := nil; ChildNode := AParentNode.getFirstChild; while Assigned(ChildNode) do begin ChildNode.Text := GetNameNode(ChildNode, nil, true, true); ChildNode := ChildNode.getNextSibling; end; end; end; procedure TF_MAIN.DelAllNodes; var i: Integer; {procedure DelNodeData(ADelNode: TTreeNode); var CurrNode: TTreeNode; begin if ADelNode = nil then Exit; //// EXIT //// CurrNode := ADelNode.getFirstChild; if CurrNode <> nil then while CurrNode.getNextSibling <> nil do begin DelNodeData(CurrNode); CurrNode := CurrNode.getNextSibling; end; FreeMem(ADelNode.Data); end;} begin try try //DelNodeData(ANode); Tree_Catalog.OnChange := nil; for i := 0 to Tree_Catalog.Items.Count - 1 do FreeMem(Tree_Catalog.Items[i].Data); Tree_Catalog.Items.Clear; //ANode.Delete; except on E: Exception do AddExceptionToLog('TF_MAIN.DelAllNodes: '+E.Message); end; finally Tree_Catalog.OnChange := Tree_CatalogChange; end; end; //Tolik 18/11/2020 -- //Tolik -- короче, переписана совсем... старая -- ниже смотри закомменчена для истории... function TF_MAIN.DeleteNodes(ANodes: TList): Boolean; var i, j, k: Integer; Node: TTreeNode; Dat: PObjectData; CanDel: Boolean; NotDelNode, CopiedNode: TTreeNode; ComponList: TSCSComponents; Compon: TSCSComponent; LineComponCount: Integer; CurrList: TSCSList; SCSListsIDs: TIntList; StepCount: Integer; //Tolik SCSCompon, PartCompon : TSCSComponent; ComponsToDel : TSCSComponents; CanDelCompon, Checked, Marked : boolean; node1: TTreeNode; Dat1: PObjectData; CheckedList : TIntList; DelProjOnly: Boolean; // Если удаляем только проекты (чтобы не нарваться на АВ при попытке получить список компонент) // Tolik -- 27/01/2017 -- isOpenedProject: boolean; // -- если есть открытый проект - его и остальные проекты -- не удалять (ибо нех баловаться ) NodesList: TList; // список на удаление (подкорректируем) NodeDat: PObjectData; Refreshflag: Boolean; SCSListsForUndo: TList; ListCount, DirCount : integer; CadList: TF_CAD; PmList: TSCSCatalog; CancelByUser: Boolean; // procedure CollectCompons(ANode: TTreeNode); var Child: TTreeNode; begin //if Dat.ItemType = itRoom then if PObjectData(ANode.Data).ItemType = itRoom then exit; // при удалении кабинета компоненты, в него входящие, не удаляются автоматически!!! Dat := ANode.Data; if IsComponItemType(Dat.ItemType) then begin if Dat.ItemType = itComponLine then LineComponCount := LineComponCount + 1; Compon := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Compon <> nil then ComponList.Add(Compon); //end; Child := ANode.getFirstChild; // вот здесь может не вернуть, если узел свернут... if ((Child = nil) and (aNode.HasChildren = true)) then // так что проверяем begin if aNode.Count > 0 then Child := aNode.Item[0] else begin if not aNode.Expanded then begin aNode.Expand(true); Child := ANode.getFirstChild; end; end; end; while Child <> nil do begin CollectCompons(Child); Child := Child.getNextSibling; end; end; end; // Tolik -- 27/01/2017 -- function CheckIsOpenedProj: Boolean; var i: Integer; begin result := False; if F_ProjMan.GSCSBase.CurrProject <> nil then result := F_ProjMan.GSCSBase.CurrProject.Active; end; Function GetRelatedCadFromRaise(aRaiseLine: TOrthoLine): TF_Cad; var RaiseConn: TConnectorObject; RaiseLine: TOrthoLine; begin Result := nil; RaiseConn := Nil; if ((TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType = crt_BetweenFloorDown)or (TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(aRaiseLine.JoinConnector1).FConnRaiseType = crt_TrunkDown)) then RaiseConn := TConnectorObject(aRaiseLine.JoinConnector1) else if ((TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType = crt_BetweenFloorUp) or (TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType = crt_BetweenFloorDown) or (TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType = crt_TrunkUp) or (TConnectorObject(aRaiseLine.JoinConnector2).FConnRaiseType = crt_TrunkDown)) then RaiseConn := TConnectorObject(aRaiseLine.JoinConnector2); if RaiseConn <> nil then begin if RaiseConn.FID_ListToPassage > 0 then Result := GetListByID(RaiseConn.FID_ListToPassage); end; end; function CheckIsBetweenFloorTrunkRaise(aLine: TOrthoLine): Boolean; begin Result := False; if aLine.FisRaiseUpDown then begin if aLine.JoinConnector1 <> nil then begin if not TConnectorObject(aLine.JoinConnector1).Deleted then begin Result := (TConnectorObject(aLine.JoinConnector1).FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown]); end; end; if not Result then begin if aLine.JoinConnector2 <> nil then begin if not TConnectorObject(aLine.JoinConnector2).Deleted then begin Result := (TConnectorObject(aLine.JoinConnector2).FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown]); end; end; end; end; end; function GetListForUndoFromNodes: TList; // получить список листов для ундо по выбранным нодам ПМ var i,j, k, l: Integer; NodeData: PObjectData; ListCount: integer; // Количество выбранных листов SCSCatalog, SCSList, JoinedLineCatalog: TSCSCatalog; SCSCompon, childCompon, PartCompon: TSCSComponent; Figure: TFigure; RaiseLine, JoinedLine: TOrthoLine; ListCad, RelatedCad: TF_CAD; ProjListCount: Integer; PartsOfLineCompon: TSCSComponents; PassedIdList: TIntList; List_ID: Integer; PassedComponList: TSCSComponents; JoinedLineList: TSCSList; AllProjListsAddedForUndo: Boolean; LineList: TList; Procedure GetPartsOfLineCompon(aChildCompon: TSCSComponent; aChildCompon_Whole_ID: Integer; var aPartsOfLineCompon: TSCSComponents); var i: integer; Joinedcompon: TSCSComponent; begin if aChildCompon.IsLine = biTrue then begin if Assigned(aChildCompon.JoinedComponents) then begin for i := 0 to aChildCompon.JoinedComponents.Count - 1 do begin JoinedCompon := aChildCompon.JoinedComponents[i]; if JoinedCompon.IsLine = biTrue then begin if PassedComponList.IndexOf(JoinedCompon) = -1 then begin PassedComponList.Add(JoinedCompon); if JoinedCompon.Whole_ID = aChildCompon_Whole_ID then begin if aPartsOfLineCompon.IndexOf(JoinedCompon) = -1 then begin aPartsOfLineCompon.Add(JoinedCompon); GetPartsOfLineCompon(JoinedCompon, aChildCompon_Whole_ID, aPartsOfLineCompon); end; end; end; end; end; end; end; end; Procedure CheckComponsParentListsForUndo(aList: TSCSComponents; var aResultList: TList); var i, j: integer; ComponCad: TF_Cad; SCSCompon: TSCScomponent; begin if aList.Count > 0 then begin for i := 0 to aList.Count - 1 do begin SCSCompon := TSCSComponent(aList[i]); if PassedIdList.IndexOf(SCSCompon.Whole_ID) = -1 then begin PassedIdList.Add(SCSCompon.Whole_ID); PartsOfLineCompon.Clear; GetPartsOfLineCompon(SCSCompon, SCSCompon.Whole_ID, PartsOfLineCompon); ComponCad := GetListByID(aList[i].ListID); if ComponCad <> nil then begin if aResultList.IndexOf(ComponCad) = -1 then begin aResultList.Add(ComponCad); AllProjListsAddedForUndo := (aResultList.Count = ProjListCount); if AllProjListsAddedForUndo then //все листы проекта в списке на Ундо - сброс exit; end; if PartsOfLineCompon.Count > 1 then // для кабеля, если больше одного куска -- спросить, удалять ли по всей длине begin if isCableComponent(SCSCompon) then begin if FMultipleDelComponMode = dmNone then begin PauseProgressByMode(true); try FMultipleDelComponMode := F_InputBox.ChoiceDelComponMode('*'); finally PauseProgressByMode(false); end; if FMultipleDelComponMode = dmNone then begin FMultipleCanDelCablesFromOtherList := biFalse; CancelByUser := True; exit; end; if FMultipleDelComponMode = dmArea then FMultipleCanDelCablesFromOtherList := biFalse; end; end; end; for j := 0 to PartsOfLineCompon.Count - 1 do begin SCSCompon := PartsOfLineCompon[j]; ComponCad := GetListByID(SCSCompon.ListID); if ComponCad <> nil then begin if aResultList.IndexOf(ComponCad) = -1 then begin aResultList.Add(ComponCad); if FMultipleCanDelCablesFromOtherList = biNone then // вопрос по удалению кабелей с других этажей begin PauseProgressByMode(true); try case MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) of IDYES: FMultipleCanDelCablesFromOtherList := biTrue; else FMultipleCanDelCablesFromOtherList := biFalse; end; finally PauseProgressByMode(false); end; end; // AllProjListsAddedForUndo := (aResultList.Count = ProjListCount); // if AllProjListsAddedForUndo then //все листы проекта в списке на Ундо - сброс // exit; end; end; end; end; end; end; end; end; begin Result := TList.create; if GCadForm <> nil then Result.Add(GCadForm); ProjListCount := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count; //if ProjListCount > 1 then // Если на проекте только один лист - можно Валить отсюда... больше искать нечего... begin AllProjListsAddedForUndo := False; PartsOfLineCompon := TSCSComponents.Create(false); PassedIdList := TIntList.Create; PassedComponList := TSCSComponents.Create(False); List_ID := GCadForm.FCADListID; if ComponList.Count > 0 then CheckComponsParentListsForUndo(ComponList, Result); // с компонент по выбранным нодам { if AllProjListsAddedForUndo then begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; exit; end; } ListCount := 0; for i := 0 to NodesList.Count - 1 do begin if TTreeNode(NodesList[i]).Data <> nil then NodeData := TTreeNode(NodesList[i]).Data; SCSCatalog := nil; SCSCompon := nil; SCSList := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(NodeData.ListID); if SCSList <> nil then begin ListCad := GetListByID(SCSList.SCSID); if ListCad <> nil then begin if Result.IndexOf(ListCad) = -1 then Result.Add(ListCad); {if Result.Count = ProjListCount then // все листы проекта попали в список -- можно вывалиться begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; exit; end;} end; //if NodeData.ItemType = itDir then if NodeData.ItemType = itSCSLine then // ортолайна begin SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(NodeData.ObjectID); if SCSCatalog <> nil then begin if SCSCatalog.IsLine = biTrue then // только для линейных (если межэтажка или магистраль - подкинуть связанный этаж // а если есть кабели, то и этажи, по которым они проходят, если удалять кабель по // всей длине) begin if ListCad <> nil then begin Figure := GetFigureByID(ListCad, SCSCatalog.SCSId); if Figure <> nil then begin if Figure is TOrthoLine then begin if TOrthoLine(Figure).FIsRaiseUpDown then // сначала связь ... begin RelatedCad := GetRelatedCadFromRaise(TOrthoLine(Figure)); if RelatedCad <> nil then begin if Result.IndexOf(RelatedCad) = -1 then begin Result.Add(RelatedCad); { if Result.Count = ProjListCount then // все листы проекта попали в список -- можно вывалиться begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; exit; end; } end; end; end; //... потом через компоненты ComponList.Clear; for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin ChildCompon := SCSCatalog.ComponentReferences[j]; if ChildCompon.IsLine = biTrue then begin if ComponList.IndexOf(ChildCompon) = -1 then ComponList.Add(ChildCompon); end; end; if ComponList.Count > 0 then begin CheckComponsParentListsForUndo(ComponList, Result); // с компонент по выбранным нодам if CancelByUser then begin exit; end; { if AllProjListsAddedForUndo then begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; end; } end; end; end; end; end; end; end else begin if NodeData.ItemType in [itSCSConnector] then begin //здесь будем смотреть переход на другие этажи линейных компонент, только если удалять их по всей длине //if SCSList <> nil then // SCSCompon := SCSList.GetComponentFromReferences(NodeData.ObjectID) //else // SCSCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(NodeData.ObjectID); //if SCSCompon <> nil then //begin //end //else // не компонента - а фигура (каталог) begin if SCSList <> nil then SCSCatalog := SCSList.GetCatalogFromReferences(NodeData.ObjectID) else SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(NodeData.ObjectID); if SCSCatalog <> nil then begin if ListCad <> nil then begin Figure := nil; Figure := GetFigureById(ListCad, SCSCatalog.SCSID); if Figure <> nil then begin if not Figure.Deleted then begin if Figure is TConnectorObject then begin if TConnectorObject(Figure).ConnectorType = ct_Clear then // здесь может быть межэтажка или магистраль, соответственно, чвязь с другим листом... begin RaiseLine := nil; for j := 0 to TConnectorObject(Figure).JoinedOrtholinesList.Count - 1 do begin if TOrthoLine(TConnectorObject(Figure).JoinedOrtholinesList[j]).FIsRaiseUpDown then begin RaiseLine := TOrthoLine(TConnectorObject(Figure).JoinedOrtholinesList[j]); break; end; end; if RaiseLine <> nil then begin if not RaiseLine.Deleted then begin RelatedCad := GetRelatedCadFromRaise(RaiseLine); if RelatedCad <> nil then begin if Result.IndexOf(RelatedCad) = -1 then begin Result.Add(RelatedCad); { if Result.Count = ProjListCount then // все листы проекта попали в список -- можно вывалиться begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; exit; end; } end; end; end; end; // поход по кабелям for j := 0 to TConnectorObject(Figure).JoinedOrtholinesList.Count - 1 do begin if CancelByUser then EXIT; JoinedLine := TOrthoLine(TConnectorObject(Figure).JoinedOrtholinesList[j]); if not JoinedLine.Deleted then begin if Assigned(JoinedLine.Owner) then begin if Assigned(JoinedLine.Owner.Owner) then begin JoinedLineCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin ComponList.Clear; for k := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := JoinedLineCatalog.ComponentReferences[k]; if SCSCompon.IsLine = biTrue then begin if ComponList.IndexOf(SCSCompon) = -1 then ComponList.Add(SCSCompon); end; end; if ComponList.Count > 0 then begin CheckComponsParentListsForUndo(ComponList, Result); // с компонент по выбранным нодам { if AllProjListsAddedForUndo then begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; exit; end; } end; end; end; end; end; end; end else if TConnectorObject(Figure).ConnectorType = ct_NB then // здесь может быть межэтажка или магистраль, соответственно, чвязь с другим листом... then begin //тут удаление коннектора удаляет и райз заодно.... LineList := TList.Create; for j := 0 to TConnectorObject(Figure).JoinedConnectorsList.Count - 1 do begin for k := 0 to TConnectorObject(TConnectorObject(Figure).JoinedConnectorsList[j]).JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(TConnectorObject(Figure).JoinedConnectorsList[j]).JoinedOrtholinesList[k]); if not JoinedLine.deleted then begin if LineList.IndexOf(JoinedLine) = -1 then LineList.Add(JoinedLine); end; end; end; if LineList.Count = 1 then begin JoinedLine := TOrthoLine(LineList[0]); if JoinedLine.FisRaiseUpDown then begin if not CheckIsBetweenFloorTrunkRaise(JoinedLine) then begin JoinedLineCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin ComponList.Clear; for k := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin SCSCompon := JoinedLineCatalog.ComponentReferences[k]; if SCSCompon.IsLine = biTrue then begin if ComponList.IndexOf(SCSCompon) = -1 then ComponList.Add(SCSCompon); end; end; if ComponList.Count > 0 then begin CheckComponsParentListsForUndo(ComponList, Result); // с компонент по выбранным нодам if CancelByUser then exit; { if AllProjListsAddedForUndo then begin PartsOfLineCompon.free; PassedIdList.free; PassedComponList.free; LineList.Free; exit; end; } end; end; end; end; end; end; end; end; end; end; end; end; end; end; end; end; end; end; //Процедура для почистить список на удаление ... по типам Procedure DelFromListByType(var aNodesList: TList; aNodeType: integer; aDirToo: Boolean = False); var i: integer; Nod: TTreeNode; NodeDatas: PObjectData; begin for i := aNodesList.Count - 1 downto 0 do begin Nod := TTreeNode(ANodes[i]); NodeDatas := Nod.Data; if aDirToo then begin if ((NodeDatas.ItemType <> aNodeType) or (NodeDatas.ItemType <> itDir)) then NodesList.Delete(i); end else begin if (NodeDatas.ItemType <> aNodeType) then NodesList.Delete(i); end; end; end; // Function CheckRemoveNode(aNode: TTreeNode; aList: TList): boolean; var cNode: TTreeNode; begin Result := false; if aNode.Data = nil then exit; if PObjectData(aNode.Data).ItemType = itList then exit; if aNode.Parent <> nil then begin if PObjectData(aNode.Parent.Data).ItemType = itRoom then begin if assigned(aNode.Parent.Parent) then begin if PObjectData(aNode.Parent.Parent.Data).ItemType = itList then exit else CheckRemoveNode(aNode.Parent.Parent, aList); end; end else begin if aList.IndexOf(aNode.Parent) = -1 then Result := CheckRemoveNode(aNode.Parent, aList) else Result := True; end; end; end; Procedure CheckRemoveChildNodes(var aList: TList); var CanDelNode: Boolean; Counter: Integer; CurrNode: TTreeNode; i: integer; begin CanDelNode := True; Counter := 0; while CanDelNode do begin CanDelNode := False; for i := aList.Count - 1 downto 0 do begin CurrNode := TTreeNode(aList[i]); if CheckRemoveNode(CurrNode, aList) then begin aList.Delete(i); CanDelNode := True; end; inc(Counter); end; if Counter > 200000 then CandelNode := False; end; end; Procedure CollectGroupNodes (var aList: TList); var currNode, ChildNode: TTreeNode; i, j: integer; SCSCatalog: TSCSCatalog; CanCheckList: Boolean; Counter: integer; begin CanCheckList := True; Counter := 0; while CanCheckList do begin CanCheckList := False; inc(Counter); for i := aList.Count - 1 downto 0 do begin currNode := TTreeNode(aList[i]); if (PObjectData(currNode.Data).ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup, itArhContainer]) then begin begin CanCheckList := True; ChildNode := currNode.getFirstChild; aList.Delete(i); if ChildNode <> nil then begin if aList.IndexOf(ChildNode) = -1 then aList.Add(ChildNode); while ChildNode <> nil do begin ChildNode := ChildNode.getNextSibling; if ChildNode <> nil then if aList.IndexOf(ChildNode) = -1 then aList.Add(ChildNode); end; end; end; end; end; if Counter > 500000 then break; end; end; Procedure DelCableCompons(aList: TSCSComponents); var i, j, k: integer; delList, ComponListToDelFromList: TSCSComponents; currCompon, JoinedCompon: TSCSComponent; SavedCad, StartCad, currCad: TF_Cad; PassedList: TSCSComponents; procedure CollectConneсted(aCompon: TSCSComponent); var i: integer; begin if PassedList.IndexOf(aCompon) = -1 then PassedList.Add(ACompon) else exit; currCad := GetListByID(aCompon.ListID); if CurrCad <> nil then begin if (CurrCad = StartCad) or (FMultipleCanDelCablesFromOtherList = biTrue) then begin if delList.IndexOf(aCompon) = -1 then delList.Add(aCompon); for i := 0 to aCompon.JoinedComponents.Count - 1 do begin if aCompon.JoinedComponents[i].IsLine = biTrue then if aCompon.JoinedComponents[i].Whole_ID = aCompon.Whole_ID then if PassedList.IndexOf(aCompon.JoinedComponents[i]) = -1 then CollectConneсted(aCompon.JoinedComponents[i]); end; end; end; end; function GetComponListToDelFromList(aList: TSCSList; var aComponList: TSCSComponents): TSCSComponents; var i: integer; CurrCompon: TSCSComponent; begin Result := TSCSComponents.Create(False); for i := aComponList.Count - 1 downto 0 do begin currCompon := aComponList[i]; if CurrCompon.ListID = aList.SCSID then begin aComponList.Remove(currCompon); if Result.IndexOf(CurrCompon) = - 1 then Result.Add(currCompon); end; end; end; begin SavedCad := GCadForm; StartCad := GetListByID(aList[0].ListID); PassedList := TSCSComponents.Create(false); DelList := TSCSComponents.Create(false); if StartCad <> nil then begin for i := 0 to aList.Count - 1 do begin CurrCompon := aList[i]; PassedList.Clear; if FMultipleDelComponMode = dmTrace then // если удалять по всей длине CollectConneсted(CurrCompon); end; end; PassedList.Free; if DelList.Count > 0 then begin for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin ComponListToDelFromList := GetComponListToDelFromList(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i], delList); if ComponListToDelFromList.Count > 0 then F_ProjMan.DelComponentsFromList(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i], ComponListToDelFromList, false); ComponListToDelFromList.Free; if delList.Count = 0 then break; end; end; GCadForm := SavedCad; end; Procedure AddDeleteRelatedNodes(var aNodes: TList); var i, j, k: integer; CurrNode, RelatedNode: TTreeNode; CanDelNode: Boolean; ConnFigure, LineFigure: TFigure; ConnNodeList, LineList, ConnList: TList; ObjectList: TF_Cad; FigCatalog: TSCSCatalog; SCSList: TSCSList; JoinedLine: TOrthoLine; CabListForDelete: TSCSComponents; Procedure DeleteLineConnector(aConn: TConnectorObject); // Removing Connected RaiseLine var FigCatalog, connCatalog: TSCSCatalog; i: integer; JoinedLine, RaiseLine: TOrthoLine; RaiseCatalog: TSCSCatalog; SelJLineCounter: integer; CanDelRaiseFromList: Boolean; function CheckCanDelRaise: Boolean; begin Result := (TConnectorObject(RaiseLine.JoinConnector1).FConnRaiseType in [crt_None, crt_OnFloor]) and (TConnectorObject(RaiseLine.JoinConnector2).FConnRaiseType in [crt_None, crt_OnFloor]); end; begin if not aConn.Deleted then begin connCatalog := SCSList.GetCatalogFromReferencesBySCSID(aConn.ID); if connCatalog <> nil then begin if connCatalog.TreeViewNode <> nil then begin RaiseLine := nil; CanDelRaiseFromList := False; for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin if TorthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin RaiseLine := TorthoLine(aConn.JoinedOrtholinesList[i]); break; end; end; if RaiseLine <> nil then begin if aConn.JoinedOrtholinesList.Count < 3 then CanDelRaiseFromList := True else begin SelJLineCounter := 0; for i := 0 to aConn.JoinedOrtholinesList.Count - 1 do begin if not TorthoLine(aConn.JoinedOrtholinesList[i]).FIsRaiseUpDown then begin JoinedLine := TorthoLine(aConn.JoinedOrtholinesList[i]); FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if FigCatalog <> nil then begin if FigCatalog.TreeViewNode <> nil then begin if aNodes.IndexOf(FigCatalog.TreeViewNode) <> -1 then inc(SelJLineCounter); end; end; end; end; CanDelRaiseFromList := (SelJLineCounter = aConn.JoinedOrtholinesList.Count - 1); end; if CanDelRaiseFromList then begin FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(RaiseLine.ID); if FigCatalog <> nil then begin if FigCatalog.TreeViewNode <> nil then begin if CheckCanDelRaise then aNodes.Remove(FigCatalog.TreeViewNode); end; end; end; end; aNodes.Remove(connCatalog.TreeViewNode); end; end; end; end; begin ConnFigure := nil; LineFigure := nil; CanDelNode := False; CabListForDelete := nil; if aNodes.Count > 1 then begin ConnNodeList := TList.Create; LineList := TList.Create; ConnList := TList.Create; CanDelNode := True; //ConnNodeList.Assign(aNodes, laCopy); for i := 0 to aNodes.Count - 1 do begin CurrNode := TTreeNode(aNodes[i]); if PObjectData(CurrNode.Data).ItemType = itSCSLine then begin ObjectList := GetListByID(PObjectData(CurrNode.Data).ListID); if ObjectList <> nil then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListByID(ObjectList.FCADListID); if SCSList <> nil then begin FigCatalog := SCSList.GetCatalogFromReferences(PObjectData(CurrNode.Data).ObjectID); if FigCatalog <> nil then begin LineFigure := GetFigureByID(ObjectList, FigCatalog.SCSID); //if LineFigure <> nil then if Not TOrthoLine(LineFigure).FIsRaiseUpDown then begin if ConnList.IndexOf(TOrthoLine(LineFigure).JoinConnector1) = -1 then ConnList.Add(TOrthoLine(LineFigure).JoinConnector1); if ConnList.IndexOf(TOrthoLine(LineFigure).JoinConnector2) = -1 then ConnList.Add(TOrthoLine(LineFigure).JoinConnector2); end else begin if LineList.IndexOf(LineFigure) = -1 then LineList.Add(LineFigure); end; end; end; end; end; end; for i := 0 to ConnList.Count - 1 do DeleteLineConnector(TConnectorObject(ConnList[i])); ConnList.Free; for i := 0 to LineList.Count - 1 do begin JoinedLine := TOrthoLine(LineList[i]); if JoinedLine.Owner <> nil then begin if JoinedLine.Owner.Owner <> nil then begin ObjectList := TF_Cad(JoinedLine.Owner.Owner); SCSList := F_ProjMan.GSCSBase.CurrProject.GetListByID(ObjectList.FCADListID); if SCSList <> nil then begin FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.JoinConnector1.ID); if FigCatalog <> nil then begin if FigCatalog.TreeViewNode <> nil then aNodes.Remove(FigCatalog.TreeViewNode); end; FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.JoinConnector2.ID); if FigCatalog <> nil then begin if FigCatalog.TreeViewNode <> nil then aNodes.Remove(FigCatalog.TreeViewNode); end; end; end; end; end; LineList.Clear; for i := 0 to aNodes.Count - 1 do begin CurrNode := TTreeNode(aNodes[i]); if PObjectData(CurrNode.Data).ItemType = itSCSConnector then ConnNodeList.Add(CurrNode); end; //if ((ConnNodeList.Count > 0) and (LineNodeList.Count > 0)) then begin LineFigure := nil; for i := 0 to ConnNodeList.Count - 1 do begin ConnFigure := nil; CurrNode := TTreeNode(ConnNodeList[i]); ObjectList := GetListByID(PObjectData(CurrNode.Data).ListID); if ObjectList <> nil then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListByID(ObjectList.FCADListID); if SCSList <> nil then begin FigCatalog := SCSList.GetCatalogFromReferences(PObjectData(CurrNode.Data).ObjectID); if FigCatalog <> nil then begin ConnFigure := GetFigureByID(ObjectList, FigCatalog.SCSID); if not ConnFigure.Deleted then begin if ((ConnFigure <> nil) and (ConnFigure is TConnectorObject)) then begin if TConnectorObject(ConnFigure).ConnectorType = ct_Clear then begin if TConnectorObject(ConnFigure).JoinedConnectorsList.Count = 0 then // на всякий begin for j := 0 to TConnectorObject(ConnFigure).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(ConnFigure).JoinedOrtholinesList[j]); if not JoinedLine.Deleted then begin FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if FigCatalog <> nil then begin if FigCatalog.TreeViewNode <> nil then if aNodes.IndexOf(FigCatalog.TreeViewNode) = -1 then aNodes.Add(FigCatalog.TreeViewNode); end; end; // коннекторы с/п if JoinedLine.JoinConnector1 <> nil then DeleteLineConnector(TConnectorObject(JoinedLine.JoinConnector1)); if JoinedLine.JoinConnector2 <> nil then DeleteLineConnector(TConnectorObject(JoinedLine.JoinConnector2)); end; if TConnectorObject(ConnFigure).JoinedOrtholinesList.Count > 0 then aNodes.Remove(CurrNode); end; end else if TConnectorObject(ConnFigure).ConnectorType = ct_NB then begin // тут удаление коннектора удалит и райз, если это необходимо LineList.Clear; for j := 0 to TConnectorObject(ConnFigure).JoinedConnectorsList.Count - 1 do begin for k := 0 to TConnectorObject(TConnectorObject(ConnFigure).JoinedConnectorsList[j]).JoinedOrthoLinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(TConnectorObject(ConnFigure).JoinedConnectorsList[j]).JoinedOrthoLinesList[k]); if not JoinedLine.Deleted then begin if LineList.IndexOf(JoinedLine) = -1 then LineList.Add(JoinedLine); end; end; end; if LineList.Count = 1 then begin JoinedLine := TOrthoLine(LineList[0]); if JoinedLine.FisRaiseUpDown then begin if not CheckIsBetweenFloorTrunkRaise(JoinedLine) then begin FigCatalog := SCSList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); //если райз на поинте один, то его(райз) удалит процедура удаления коннектора... // поэтому лучше заранее удалить кабель, согласно тому как укажет пользователь... // а то потом хуйня получается.... т.е. здесь ноды не добавляем, а кабель нужно проанализировать... // и для ундо тоже (чтобы потом восстановить) if FigCatalog <> nil then begin CabListForDelete := TSCSComponents.Create(false); for j := 0 to FigCatalog.ComponentReferences.Count - 1 do begin if isCableComponent(FigCatalog.ComponentReferences[j]) then begin if CabListForDelete.IndexOf(FigCatalog.ComponentReferences[j]) = -1 then CabListForDelete.Add(FigCatalog.ComponentReferences[j]); end; end; if CabListForDelete.Count > 0 then DelCableCompons(CabListForDelete); CabListForDelete.Free; if FigCatalog.TreeViewNode <> nil then // с/п aNodes.Remove(FigCatalog.TreeViewNode); end; end; end; end; end; end; end; end; end; end; end; end; ConnNodeList.Free; LineList.Free; end; end; { Procedure DeleteRelatedNodes(var aNodes: TList); var i, j, k: integer; CurrNode, RelatedNode: TTreeNode; CanDelNode: Boolean; ConnFigure, LineFigure: TFigure; ConnNodeList, LineNodeList: TList; ObjectList: TF_Cad; FigCatalog: TSCSCatalog; SCSList: TSCSList; begin ConnFigure := nil; LineFigure := nil; if aNodes.Count > 1 then begin ConnNodeList := TList.Create; LineNodeList := TList.Create; for i := 0 to aNodes.Count - 1 do begin CurrNode := TTreeNode(aNodes[i]); if PObjectData(CurrNode.Data).ItemType = itSCSConnector then ConnNodeList.Add(CurrNode) else if PObjectData(CurrNode.Data).ItemType = itSCSLine then LineNodeList.Add(CurrNode); end; if ((ConnNodeList.Count > 0) and (LineNodeList.Count > 0)) then begin LineFigure := nil; for i := 0 to ConnNodeList.Count - 1 do begin ConnFigure := nil; CurrNode := TTreeNode(ConnNodeList[i]); ObjectList := GetListByID(PObjectData(CurrNode.Data).ListID); if ObjectList <> nil then begin SCSList := F_ProjMan.GSCSBase.CurrProject.GetListByID(ObjectList.FCADListID); if SCSList <> nil then begin FigCatalog := SCSList.GetCatalogFromReferences(PObjectData(CurrNode.Data).ObjectID); if FigCatalog <> nil then begin ConnFigure := GetFigureByID(ObjectList, FigCatalog.SCSID); if ((ConnFigure <> nil) and (ConnFigure is TConnectorObject)) then begin if TConnectorObject(ConnFigure).ConnectorType = ct_Clear then begin if TConnectorObject(ConnFigure).JoinedConnectorsList.Count = 0 then // на всякий begin for j := 0 to TConnectorObject(ConnFigure).JoinedOrtholinesList.Count - 1 do begin for k := LineNodeList.Count - 1 downto 0 do begin if PObjectData(TTreeNode(LineNodeList[k]).Data).ListID = PObjectData(CurrNode.Data).ListID then begin if PObjectData(TTreeNode(LineNodeList[k]).Data).ObjectID = TOrthoLine(TConnectorObject(ConnFigure).JoinedOrtholinesList[j]).ID then begin if aNodes.IndexOf(TTreeNode(LineNodeList[k])) > -1 then aNodes.Delete(aNodes.IndexOf(TTreeNode(LineNodeList[k]))); LineNodeList.Delete(k); end; end; end; end; end; end; end; end; end; end; if LineNodeList.Count = 0 then break; end; end; ConnNodeList.Free; LineNodeList.Free; end; end;} Procedure CheckAddConnectedOrthoLines(var aList: TList); var i, j, k: integer; Figure: TFigure; JoinedLine: TOrthoLine; CurrNode: TTreeNode; ConnNodesList, LineNodeList: TList; SCSCatalog: TSCSCatalog; CurrCad: TF_CAD; CurrList: TSCSList; begin ConnNodesList := TList.Create; LineNodeList := TList.Create; CurrList := Nil; Figure := Nil; // Просто коннекторы -- for i := 0 to aList.Count - 1 do begin if PObjectData(TTreeNode(aList[i]).Data).ItemType = itSCSConnector then if ConnNodesList.IndexOf(aList[i]) = -1 then ConnNodesList.Add(aList[i]); end; if ConnNodesList.Count > 0 then begin CurrNode := TTreeNode(ConnNodesList[0]); CurrCad := GetListById(PObjectData(CurrNode.Data).ListID); CurrList := F_ProjMan.GSCSBase.CurrProject.GetListByID(CurrCad.FCADListID); end; if CurrList <> nil then begin for i := 0 to ConnNodesList.Count - 1 do begin CurrNode := TTreeNode(ConnNodesList[i]); SCSCatalog := CurrList.GetCatalogFromReferences(PObjectData(CurrNode.Data).ObjectID); if SCSCatalog <> nil then begin if SCSCatalog.IsLine = biFalse then begin Figure := Nil; Figure := GetFigureByID(CurrCad, SCSCatalog.SCSID); if Figure <> nil then begin if (Figure is TConnectorObject) and (not TConnectorObject(Figure).Deleted) then begin if TConnectorObject(Figure).ConnectorType = ct_Clear then if TConnectorObject(Figure).JoinedConnectorsList.Count = 0 then begin for j := 0 to TConnectorObject(Figure).JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(TConnectorObject(Figure).JoinedOrtholinesList[j]); if not JoinedLine.Deleted then begin SCSCatalog := CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if SCSCatalog <> nil then begin if SCSCatalog.TreeViewNode <> nil then if LineNodeList.IndexOf(SCSCatalog.TreeViewNode) = -1 then LineNodeList.Add(SCSCatalog.TreeViewNode); end; end; end; if TConnectorObject(Figure).JoinedOrtholinesList.Count > 0 then aList.Remove(CurrNode); end; end; end; end; end; end; for i := 0 to LineNodeList.Count - 1 do begin if aList.IndexOf(LineNodeList[i]) = -1 then //aList.Add(LineNodeList[i]); aList.Insert(0, LineNodeList[i]); end; end; ConnNodesList.Free; LineNodeList.Free; end; Procedure CheckRemoveChildsFromCollapsedNodes; var i: integer; CanDelNode: Boolean; function CheckCanDel(aNode: TTreeNode): Boolean; var NodeDat: PObjectData; begin Result := False; NodeDat := PObjectData(aNode.Data); if NodeDat.ItemType in [itProjMan, itProject, itDir] then exit; if aNode.Parent <> nil then begin if not aNode.Parent.Expanded then begin Result := true; exit; end else Result := CheckCanDel(aNode.Parent); end; end; begin CanDelNode := True; while CanDelNode do begin CanDelNode := False; for i:= 0 to NodesList.Count - 1 do begin if CheckCanDel(NodesList[i]) then begin CanDelNode := True; NodesList.Delete(i); break; end; end; end; end; // begin //Tolik CheckedList := nil; ComponsToDel := nil; //DelProjOnly := True; DelProjOnly := False; NodesList := TList.Create; SCSListsForUndo := Nil; ComponList := nil; CancelByUser := False; // Tolik - 09-12-2020 -- если пользователь нажмет отмену на вопросе об удалении кабелей по всей длине // // Tolik -- 27/01/2017/ isOpenedProject := CheckIsOpenedProj; Refreshflag := GCanRefreshCad; GCanRefreshCad := False; Result := false; try NodesList.Assign(aNodes, laCopy); if NodesList.Count > 0 then begin CanDel := true; // Проверяем можно ли удалять if (GSNotDel.ObjectID > 0) or (GEditKind <> ekNone) then begin NotDelNode := nil; CopiedNode := nil; // Если SCSОбъект используется (является компонетой / папкой при выборе комплектующей ) if GSNotDel.ObjectID > 0 then NotDelNode := FindTreeNodeByDat(GSNotDel.ObjectID, [GSNotDel.ItemType]); // Если SCSОбъект Скопирован/Вырезан или в нем есть такой if GEditKind <> ekNone then CopiedNode := FindTreeNodeByDat(GSDat.ObjectID, [GSDat.ItemType]); if Assigned(NotDelNode) or Assigned(CopiedNode) then begin for i := 0 to NodesList.Count - 1 do begin Node := TTreeNode(NodesList[i]); if NotDelNode <> nil then if HaveNodeSub(Node, NotDelNode) then // является ли Node поптомком для NotDelNode begin MessageInfo(cMain_Msg193); GCanRefreshCad := RefreshFlag; NodesList.free; // Tolik 16/11/2020 -- утечка памяти --- GCanRefreshCad := Refreshflag; Exit; ///// EXIT ///// end; // Если SCSОбъект Скопирован/Вырезан или в нем есть такой if CopiedNode <> nil then begin if HaveNodeSub(Node, CopiedNode) then // является ли Node поптомком для CopiedNode begin if MessageQuastYN(cMain_Msg194) = IDYES then Act_ClearCopyBuf.Execute else begin CanDel := false; Break; //// BREAK //// end; end; end; end; end; end; if CanDel then begin if GDBMode = bkProjectManager then // менеджер проектов begin CheckRemoveChildsFromCollapsedNodes; // Tolik 14/12/2020 -- if isOpenedProject then // нет смысла делать ундо если нет открытого проекта -- нету для чего... begin //NodesList.Clear; DirCount := 0; ListCount := 0; //for i := 0 to ANodes.Count - 1 do for i := 0 to NodesList.Count - 1 do begin //Node := TTreeNode(ANodes[i]); Node := TTreeNode(NodesList[i]); NodeDat := Node.Data; if ((((NodeDat.ItemType = itProject) or (NodeDat.ItemType = itDir)) and (not isOpenedProject)) or (((NodeDat.ItemType <> itProject) or (NodeDat.ItemType <> itDir)) and (isOpenedProject = True)) or (NodeDat.ItemType <> itProjMan)) then //Менеджер проектов(корневой каталог) -- удалять НИЗЗЯ!!! begin //NodesList.Add(ANodes[i]); case NodeDat.ItemType of itProject: DelProjOnly := True ; // если проект или папка - можно ундо не делать itDir: inc(DirCount); itList: inc(ListCount); // если лист - посчитать листы (ундо тоже не будет...) end; end; end; // теперь расковырять групповые узлы(если в настройках листа уставлена опция группировки по типам...) CollectGroupNodes(NodesList); if NodesList.Count > 0 then begin if isOpenedProject then begin //if not DelProjOnly then //if ListCount = 0 then // CheckAddConnectedOrthoLines(NodesList); // при удалении пустых коннукторов, если к ним присоединены трассы, то -- // трассы добавить в список, а коннекторы - наоборот -- удалить if DelProjOnly then // Удаление Проекта не предусматривает его восстановление!!! begin if DirCount > 0 then DelFromListByType(NodesList, itProject, true) //сбросить все, кроме проектов и папок else DelFromListByType(NodesList, itProject) //сбросить все, кроме проектов end else begin if DirCount > 0 then DelFromListByType(NodesList, itDir) // сбросить все, кроме папок else if ListCount > 0 then // Удаление листа не предусматривает его восстановление!!! DelFromListByType(NodesList, itList) // сбросить все, кроме листов else // Сросить чилдов для узлов, которые тоже выделены (один х, если парент выбран - из него все удалится...) CheckRemoveChildNodes(NodesList); // здесь в списке не будет ни проектов ни листов...так что можно просматривать(парентов) до уровня листа end; end; end; end; end; StepCount := NodesList.Count; if GDBMode = bkProjectManager then StepCount := StepCount + 3; FMultipleAction := true; BeginProgress('', StepCount); try FMultipleDelComponMode := dmNone; FMultipleCanDelCADGroup := biNone; FMultipleCanDelCablesFromOtherList := biNone; // Определить для каких листов будут изменения, чтобы запомнить для отката // или для всего проекта записать ... // или вообще для отката ничего не писать, если удаляется проект или несколько, например if GDBMode = bkProjectManager then begin if isOpenedProject then // нет смысла делать ундо если нет открытого проекта -- нету для чего... begin if ((Not DelProjOnly) and (DirCount = 0)) then // Если удаляются НЕ проекты (потому что если удаляем проекты -- записывать для отмены нечего) begin if ListCount > 0 then // если удаляются листы begin end else // удаляются компоненты с одного листа begin ComponList := TSCSComponents.Create(false); LineComponCount := 0; for i := 0 to NodesList.Count - 1 do CollectCompons(TTreeNode(NodesList[i])); StepProgress; {if LineComponCount > 0 then begin PauseProgressByMode(true); try FMultipleDelComponMode := F_InputBox.ChoiceDelComponMode('*'); finally PauseProgressByMode(false); end; // Если только в пределах трасс. то снимаем вопрос о удалении кусков с других листов if FMultipleDelComponMode = dmArea then FMultipleCanDelCablesFromOtherList := biFalse end;} //end; // Tolik 27/01/2017 -- {SCSListsIDs := GetSCSListsIDsByCompons(GSCSBase.CurrProject.CurrList, ComponList, true, nil, biNone); FreeAndNil(ComponList);} StepProgress; //if isOpenedProject then //begin SCSListsForUndo := GetListForUndoFromNodes; if CancelByUser then begin NodesList.free; GCanRefreshCad := Refreshflag; exit; end; //SCSListsForUndo := GetListForUndo(ComponList); //SCSListsForUndo := GetListForUndoFromNodes; SaveForProjectUndo(SCSListsForUndo, True, False); end; end; end; end; FreeAndNil(SCSListsForUndo); //Tolik //список компонент на удаление ComponsToDel := TSCSComponents.Create(false); CheckedList := TIntList.Create; //BeginProgress; //for i := 0 to NodesList.Count - 1 do {NodesList.Clear; NodesList.Assign(aNodes, laCopy);} AddDeleteRelatedNodes(NodesList); //for i := 0 to ANodes.Count - 1 do for i := 0 to NodesList.Count - 1 do begin Node := TTreeNode(NodesList[i]); //Node := TTreeNode(ANodes[i]); Dat := Node.Data; if Dat <> nil then begin case Dat.ComponKind of ckCompon: DelComponByNode(Node); //Act_DelComponent.Execute; ckCompl: begin if (Dat.ItemType = itComponCon) or (GDBMode = bkNormBase) then DelComplFromTreeOrGrid(wcTree, Node) //DelComplFromTreeOrGrid(wcTree) else //*** Комплектующую линейного типа мржна удалить по всей трассе if (Dat.ItemType = itComponLine) or IsArchComponByItemType(Dat.ItemType) then DelComponByNode(Node); //Act_DelComponent.Execute; end; else begin //Tolik -- 27/01/2017 -- // if Not IsGroupObjectNode(Tree_catalog.Selected) then if Not IsGroupObjectNode(Node) then // DeleteDirByNode(Node) //Act_DelDir.Execute else DeleteObjectGroup(Node); end; end; end; StepProgress; end; finally FMultipleAction := false; if ComponList <> nil then ComponList.Free; //GCanRefreshCad := true; // Tolik -- 26/11/2020 -- // if GCadForm <> nil then // GCadForm.PCad.Refresh; EndProgress; end; Result := true; end; end; //Tolik if CheckedList <> nil then FreeAndNil(CheckedList); if ComponsToDel <> nil then begin ComponsToDel.Clear; FreeAndNil(ComponsToDel); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DeleteNodes', E.Message); end; GCanRefreshCad := Refreshflag; // Tolik -- 15/05/2017 -- if GCadForm <> nil then GCadForm.PCad.Refresh; j := 0; { for i := 0 to F_Projman.GSCSBase.CurrProject.CurrList.ComponentReferences.Count - 1 do begin if isCableComponent(F_Projman.GSCSBase.CurrProject.CurrList.ComponentReferences[i]) then begin for k := 0 to F_Projman.GSCSBase.CurrProject.CurrList.ComponentReferences[i].Joinedcomponents.Count - 1 do begin if F_Projman.GSCSBase.CurrProject.CurrList.ComponentReferences.IndexOf(F_Projman.GSCSBase.CurrProject.CurrList.ComponentReferences[i].Joinedcomponents[k]) = -1 then j := j + 1; end; end; end; } NodesList.Free; // Tolik -- 21/05/2018 // // Tolik 11/12/2020 -- переключиться не текущий кад в дереве, а то будет так, что, например, после удаления кабеля // с третьего этажа, указатель в дереве там и останется, хотя текущий кад, например -- первый лист(этаж) if GDBMode = bkProjectManager then begin if isOpenedProject then begin if Assigned(F_ProjMan.GSCSBase.CurrProject) then begin if Assigned(F_ProjMan.GSCSBase.CurrProject.CurrList) then begin if F_ProjMan.GSCSBase.CurrProject.CurrList.TreeViewNode <> nil then begin SelectNodeDirect(F_ProjMan.GSCSBase.CurrProject.CurrList.TreeViewNode); SwitchInCAD(F_ProjMan.GSCSBase.CurrProject.CurrList.TreeViewNode, ccOne); end; end else begin if F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count > 0 then begin SelectNodeDirect(F_ProjMan.GSCSBase.CurrProject.ProjectLists[0].TreeViewNode); SwitchInCAD(F_ProjMan.GSCSBase.CurrProject.ProjectLists[0].TreeViewNode, ccOne); end; end; end; end; end; // end; (* function TF_MAIN.DeleteNodes(ANodes: TList): Boolean; var i: Integer; Node: TTreeNode; Dat: PObjectData; CanDel: Boolean; NotDelNode, CopiedNode: TTreeNode; ComponList: TSCSComponents; Compon: TSCSComponent; LineComponCount: Integer; CurrList: TSCSList; SCSListsIDs: TIntList; StepCount: Integer; //Tolik SCSCompon, PartCompon : TSCSComponent; ComponsToDel : TSCSComponents; CanDelCompon, Checked, Marked : boolean; node1: TTreeNode; Dat1: PObjectData; j,k: integer; CheckedList : TIntList; DelProjOnly: Boolean; // Если удаляем только проекты (чтобы не нарваться на АВ при попытке получить список компонент) // Tolik -- 27/01/2017 -- isOpenedProject: boolean; // -- если есть открытый проект - его и остальные проекты -- не удалять (ибо нех баловаться ) NodesList: TList; // список на удаление (подкорректируем) NodeDat: PObjectData; Refreshflag: Boolean; SCSListsForUndo: TList; // procedure CollectCompons(ANode: TTreeNode); var Child: TTreeNode; begin Dat := ANode.Data; if IsComponItemType(Dat.ItemType) then begin if Dat.ItemType = itComponLine then LineComponCount := LineComponCount + 1; Compon := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Compon <> nil then ComponList.Add(Compon); end; Child := ANode.getFirstChild; while Child <> nil do begin CollectCompons(Child); Child := Child.getNextSibling; end; end; // Tolik -- 27/01/2017 -- function CheckIsOpenedProj: Boolean; var i: Integer; begin result := False; if F_ProjMan.GSCSBase.CurrProject <> nil then result := F_ProjMan.GSCSBase.CurrProject.Active; end; function GetListsForUndo: TIntList; var i: Integer; CurrNode: TTreeNode; CurrNodeDat: PObjectData; Procedure GetListIdFromNode(aNode: TTreeNode; aList: TIntList); var NodeDat: PObjectData; begin NodeDat := aNode.Data; if NodeDat.ItemType = itList then begin if aList.IndexOf(Nodedat.ListID) = -1 then aList.Add(NodeDat.ListID); end else begin GetListIdFromNode(aNode.Parent, aList); end; end; begin Result := TIntList.Create; for i := 0 to NodesList.Count - 1 do begin CurrNode := TTreeNode(NodesList[i]); CurrNodeDat := CurrNode.Data; if not (CurrNodeDat.ItemType in [itProject, itDir, itProjMan]) then GetListIdFromNode(currNode, Result); end; end; //Tolik -- 15/05/2017 -- function GetListForUndo(aComponList: TSCSComponents): TList; var i: Integer; ComponCatalog: TSCSCatalog; Compon: TSCSComponent; ListIdList: TIntList; //ComponList: TSCSComponents; ComponentList: TSCSComponents; function GetComponListTodel: TSCSComponents; var i, j: Integer; Component: TSCSComponent; PartCompon: TSCSComponent; begin Result := TSCSComponents.Create(false); if FMultipleDelComponMode = dmTrace then begin for i := 0 to aComponList.Count - 1 do begin Component := TSCSComponent(aComponList[i]); if (Component.IsLine = biTrue) then begin Component.LoadWholeComponent(true); for j := 0 to Component.WholeComponent.Count - 1 do begin PartCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(Component.WholeComponent[j]); if Assigned(PartCompon) then begin if Result.IndexOf(PartCompon) = -1 then Result.Add(PartCompon); end; end; end; if Result.IndexOf(Component) = -1 then Result.Add(Component); end; end else begin //if FMultipleDelComponMode = dmArea then begin for i := 0 to aComponList.Count - 1 do begin Component := TSCSComponent(aComponList[i]); if Result.IndexOf(Component) = -1 then Result.Add(Component); end; end end; end; begin //Result := TList.Create; ListIdList := TIntList.Create; //ComponList := GetComponListToDel; ComponentList := GetComponListToDel; for i := 0 to ComponList.Count - 1 do begin Compon := TSCSComponent(ComponentList[i]); ComponCatalog := Compon.GetFirstParentCatalog; if ComponCatalog <> nil then begin if ListIdList.IndexOf(ComponCatalog.ListID) = -1 then ListIdList.Add(ComponCatalog.ListID); end; end; Result := IntCadsToCads(ListIdList); ComponentList.Free;// Tolik 14/06/2018 -- ListIdList.Free; end; // begin //Tolik CheckedList := nil; ComponsToDel := nil; DelProjOnly := True; NodesList := TList.Create; ComponList := nil; // // Tolik -- 27/01/2017/ isOpenedProject := CheckIsOpenedProj; Refreshflag := GCanRefreshCad; GCanRefreshCad := False; // перенесено в блок ниже, а вдруг наебнется { for i := 0 to ANodes.Count - 1 do begin Node := TTreeNode(ANodes[i]); NodeDat := Node.Data; if ((NodeDat.ItemType = itProject) and (not isOpenedProject)) or (NodeDat.ItemType <> itProject) then NodesList.Add(ANodes[i]); end;} Result := false; try // Tolik 15/07/2019 -- на всякий вкинуто сюда for i := 0 to ANodes.Count - 1 do begin Node := TTreeNode(ANodes[i]); NodeDat := Node.Data; if ((NodeDat.ItemType = itProject) and (not isOpenedProject)) or (NodeDat.ItemType <> itProject) then NodesList.Add(ANodes[i]); end; // if NodesList.Count > 0 then begin CanDel := true; // Проверяем можно ли удалять if (GSNotDel.ObjectID > 0) or (GEditKind <> ekNone) then begin NotDelNode := nil; CopiedNode := nil; // Если SCSОбъект используется (является компонетой / папкой при выборе комплектующей ) if GSNotDel.ObjectID > 0 then NotDelNode := FindTreeNodeByDat(GSNotDel.ObjectID, [GSNotDel.ItemType]); // Если SCSОбъект Скопирован/Вырезан или в нем есть такой if GEditKind <> ekNone then CopiedNode := FindTreeNodeByDat(GSDat.ObjectID, [GSDat.ItemType]); if Assigned(NotDelNode) or Assigned(CopiedNode) then for i := 0 to NodesList.Count - 1 do begin Node := TTreeNode(NodesList[i]); if NotDelNode <> nil then if HaveNodeSub(Node, NotDelNode) then // является ли Node поптомком для NotDelNode begin MessageInfo(cMain_Msg193); GCanRefreshCad := RefreshFlag; NodesList.free; // Tolik 16/11/2020 -- утечка памяти --- Exit; ///// EXIT ///// end; // Если SCSОбъект Скопирован/Вырезан или в нем есть такой if CopiedNode <> nil then if HaveNodeSub(Node, CopiedNode) then // является ли Node поптомком для CopiedNode begin if MessageQuastYN(cMain_Msg194) = IDYES then Act_ClearCopyBuf.Execute else begin CanDel := false; Break; //// BREAK //// end; end; end; end; if CanDel then begin StepCount := NodesList.Count; if GDBMode = bkProjectManager then StepCount := StepCount + 3; FMultipleAction := true; BeginProgress('', StepCount); //BeginProgress; try FMultipleDelComponMode := dmNone; FMultipleCanDelCADGroup := biNone; FMultipleCanDelCablesFromOtherList := biNone; // Определить для каких листов будут изменения, чтобы запомнить для отката if GDBMode = bkProjectManager then begin ComponList := TSCSComponents.Create(false); LineComponCount := 0; for i := 0 to NodesList.Count - 1 do CollectCompons(NodesList[i]); StepProgress; if LineComponCount > 0 then begin PauseProgressByMode(true); try FMultipleDelComponMode := F_InputBox.ChoiceDelComponMode('*'); finally PauseProgressByMode(false); end; // Если только в пределах трасс. то снимаем вопрос о удалении кусков с других листов if FMultipleDelComponMode = dmArea then FMultipleCanDelCablesFromOtherList := biFalse end; // Tolik 27/01/2017 -- {SCSListsIDs := GetSCSListsIDsByCompons(GSCSBase.CurrProject.CurrList, ComponList, true, nil, biNone); FreeAndNil(ComponList);} StepProgress; {SaveListsToUndoStack(SCSListsIDs); FreeAndNil(SCSListsIDs);} //StepProgress; if isOpenedProject then begin SCSListsForUndo := GetListForUndo(ComponList); SaveForProjectUndo(SCSListsForUndo, True, False); FreeAndNil(SCSListsForUndo); end; end; // Tolik -- UNDO {SCSListsIDs := GetListsForUndo; SaveListsToUndoStack(SCSListsIDs); FreeAndNil(SCSListsIDs);} //Tolik //список компонент на удаление ComponsToDel := TSCSComponents.Create(false); CheckedList := TIntList.Create; (* for i := 0 to NodesList.Count - 1 do begin node := TTreeNode(NodesList[i]); Dat := Node.Data; if Dat.ComponKind = ckCompon then begin if node <> nil then begin SCSCompon := GetComponentFromNode(Node); SCSCompon.LoadWholeComponent(true); if SCSCompon.IsLine = biTrue then ComponsToDel.Add(SCSCompon); end; end; end; for i := 0 to ComponsToDel.Count - 1 do begin SCSCompon := ComponsToDel[i]; Checked := false; if CheckedList.Count = 0 then begin CheckedList.Add(SCSCompon.Whole_ID); Checked := false; end else begin for j := 0 to CheckedList.Count -1 do begin if SCSCompon.Whole_ID = CheckedList[j] then begin Checked := true; break; end; end; if not Checked then CheckedList.Add(SCSCompon.Whole_ID); end; if not checked then begin if SCSCompon.WholeComponent.Count > 1 then begin marked := false; for j := 0 to SCSCompon.WholeComponent.Count - 1 do begin PartCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(SCSCompon.WholeComponent[j]); CanDelCompon := false; //PartCompon.ServToMark := true; PartCompon.ServToDelete := false; for k := 0 to ComponsToDel.Count -1 do begin if PartCompon.ID = ComponsToDel[k].ID then begin CanDelCompon := true; PartCompon.ServToDelete := true; break; end end; // если не удалять этот кусок { if not CanDelCompon then begin if not Marked then begin Marked := true; //PartCompon.ServToMark := false; end else begin PartCompon.MarkID := -1; //PartCompon.ServToMark := true; end; PartCompon.ServToDelete := false; end; } end; end; end; end; *) // //BeginProgress; (* for i := 0 to NodesList.Count - 1 do begin Node := TTreeNode(NodesList[i]); Dat := Node.Data; if Dat <> nil then begin case Dat.ComponKind of ckCompon: DelComponByNode(Node); //Act_DelComponent.Execute; ckCompl: begin if (Dat.ItemType = itComponCon) or (GDBMode = bkNormBase) then DelComplFromTreeOrGrid(wcTree, Node) //DelComplFromTreeOrGrid(wcTree) else //*** Комплектующую линейного типа мржна удалить по всей трассе if (Dat.ItemType = itComponLine) or IsArchComponByItemType(Dat.ItemType) then DelComponByNode(Node); //Act_DelComponent.Execute; end; else begin //Tolik -- 27/01/2017 -- // if Not IsGroupObjectNode(Tree_catalog.Selected) then if Not IsGroupObjectNode(Node) then // DeleteDirByNode(Node) //Act_DelDir.Execute else DeleteObjectGroup(Node); end; end; end; StepProgress; end; finally FMultipleAction := false; EndProgress; end; Result := true; end; end; //Tolik if CheckedList <> nil then FreeAndNil(CheckedList); if ComponsToDel <> nil then begin ComponsToDel.Clear; FreeAndNil(ComponsToDel); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DeleteNodes', E.Message); end; GCanRefreshCad := Refreshflag; // Tolik -- 15/05/2017 -- if GCadForm <> nil then GCadForm.PCad.Refresh; NodesList.Free; // Tolik -- 21/05/2018 // end; *) function TF_MAIN.GetComponIDAtCursor(AObjectAtCursor: Pointer): Integer; var CurPos: TPoint; ListItem: TListItem; Node: TTreeNode; NodeDat: PObjectData; FlyNode: TFlyNode; FlyNodeDat: TComponGrpData; ObjectAtCursor: TObject; begin Result := 0; try GetCursorPos(CurPos); ObjectAtCursor := nil; if pcObjects.ActivePage = tsTemplates then begin CurPos := FlvTemplate.ScreenToClient(CurPos); ListItem := FlvTemplate.GetItemAt(CurPos.X, CurPos.Y); ObjectAtCursor := Listitem; if (ListItem <> nil) and (ListItem.Data <> nil) then Result := PTemplateData(ListItem.Data).IDComponent; end else if pcObjects.ActivePage = tsComponents then begin CurPos := Tree_Catalog.ScreenToClient(CurPos); Node := Tree_Catalog.GetNodeAt(CurPos.X, CurPos.Y); ObjectAtCursor := Node; if Assigned(Node) then begin NodeDat := Node.Data; if IsComponItemType(NodeDat.ItemType) then //24.05.2011 if NodeDat.ItemType in [itComponLine, itComponCon] then Result := NodeDat.ObjectID; end; end else if pcObjects.ActivePage = tsComponGroups then begin CurPos := tvComponGroups.ScreenToClient(CurPos); FlyNode := tvComponGroups.GetNodeAt(CurPos.X, CurPos.Y); ObjectAtCursor := FlyNode; if (FlyNode <> nil) and (FlyNode.Data <> nil) then begin FlyNodeDat := TComponGrpData(FlyNode.Data); if FlyNodeDat.FComponData <> nil then Result := FlyNodeDat.FComponData.ObjectID; end; end; if ObjectAtCursor <> nil then TObject(AObjectAtCursor^) := ObjectAtCursor; except on E: Exception do AddExceptionToLogExt(ClassName, 'GetComponIDAtCursor', E.Message); end; end; function TF_MAIN.GetFirstSiblingNodeByItemType(ANode, ANotAllowNode: TTreeNode; AItemType: Integer): TTreeNode; var i: Integer; ParentNode: TTreeNode; CurrNode: TTreeNode; begin Result := nil; ParentNode := ANode.Parent; CurrNode := nil; if ParentNode <> nil then CurrNode := ParentNode.getFirstChild; while CurrNode <> nil do begin if CurrNode <> ANotAllowNode then if PObjectData(CurrNode.Data).ItemType = AItemType then begin Result := CurrNode; Break; ///// BREAK ///// end; CurrNode := CurrNode.getNextSibling; end; end; // ##### Вернет самую верхнюю папку ##### function TF_MAIN.GetTopNode: TTreeNode; var Node: TTreeNode; Txt: String; begin Result := nil; try Txt := Tree_Catalog.Items[0].Text; except end; Node := Tree_Catalog.Items[0]; if Node <> nil then while Node.Parent <> nil do Node := Node.Parent; Result := Node; end; function TF_MAIN.GetTopNodeByNBMode(ANBMode: TNBMode; AItemType: Integer): TTreeNode; var TopNode: TTreeNode; CurrNode: TTreeNode; CurrNodeDat: PObjectData; begin Result := nil; TopNode := GetTopNode; CurrNode := TopNode; while CurrNode <> nil do begin CurrNodeDat := CurrNode.Data; if (CurrNodeDat.NBMode = ANBMode) and (CurrNodeDat.ItemType = AItemType) then begin Result := CurrNode; Break; //// BREAK //// end; CurrNode := CurrNode.getNextSibling; end; end; function TF_MAIN.CanParantNodeHaveChildItemInTreeView(AParentNode: TTreeNode; AChildItem: TItemType; AChildQueryMode: TQueryMode): Boolean; var ParentDat: PObjectData; ParentItem: Integer; begin Result := false; ParentDat := AParentNode.Data; ParentItem := ParentDat.ItemType; try case ParentItem of itProjMan: if (AChildItem = itProject) or ((AChildItem = itDir) and ((AChildQueryMode = qmPhisical) or (AChildQueryMode = qmUndef))) then Result := true; itDir: case GDBMode of bkNormBase: if (AChildItem in [itComponLine, itComponCon]) or (AChildItem = itDir) then Result := true; bkProjectManager: if ((AChildItem = itDir) and ((ParentDat.QueryMode = AChildQueryMode) or (AChildQueryMode = qmUndef))) or ((AChildItem = itProject) and (ParentDat.QueryMode = qmPhisical)) or (AChildItem = itList) and (ParentDat.QueryMode = qmMemory) then Result := true; end; itProject: if ((AChildItem = itDir) and ((AChildQueryMode = qmMemory) or (AChildQueryMode = qmUndef))) or (AChildItem = itList) then Result := true; itList: if (AChildItem = itRoom) or (AChildItem = itSCSLine) or (AChildItem = itSCSConnector) or ((AChildItem = itArhContainer)) then Result := true; itRoom: if (AChildItem = itSCSLine) or (AChildItem = itSCSConnector) then Result := true; itSCSConnector: if AChildItem = itComponCon then Result := true; itSCSLine: if AChildItem = itComponLine then Result := true else if AChildItem = itComponCon then // коннектор на специальную трассу можно if IsSpecialTrace(ParentDat.ListID, ParentDat.ObjectID, 0) then Result := true; itArhContainer: if (AChildItem = itArhRoom) or (AChildItem = itArhBrickWall) then Result := true; itComponCon, itComponLine: if (AChildItem = itComponLine) or (AChildItem = itComponCon) then Result := true; {itSCSConnector, itSCSLine, itComponCon, itComponLine: if (AChildItem = itComponLine) or (AChildItem = itComponCon) then Result := true;} itArhRoom, itArhBrickWall: if (AChildItem = itArhWall) or (AChildItem = itArhWallDivision) or (AChildItem = itArhWallCorner) then Result := true; itArhWall: if (AChildItem = itArhWindow) or (AChildItem = itArhDoor) or (AChildItem = itArhArc) or (AChildItem = itArhBalcony) or (AChildItem = itArhNiche) then Result := true; itArhWallDivision: if (AChildItem = itArhDoor) or (AChildItem = itArhArc) then Result := true; itArhWindow, itArhDoor, itArhArc: if (AChildItem = itArhInnerSlope) or (AChildItem = itArhOuterSlope) then Result := true; itArhBalcony: if (AChildItem = itArhWindow) or (AChildItem = itArhDoor) or (AChildItem = itArhInnerSlope) then Result := true; itArhRoofSeg: if (AChildItem = itArhRoofHip) or (AChildItem = itArhRoofHipCorner) then Result := true; itArhRoofHip, itArhRoofHipCorner: begin if (AChildItem = itArhRoofHip) or (AChildItem = itArhRoofHipCorner) then Result := true else if AChildItem = itArhRoofSeg then Result := true; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.CanParantNodeHaveChildItemInTreeView: '+E.Message); end; end; function TF_MAIN.CanEditNode(ANodeDat: PObjectData): Boolean; begin Result := true; if ANodeDat <> nil then if GDBMode = bkNormBase then begin if Not CheckWriteNB(false) or ((ANodeDat.NBMode = nbmNorm) and Not GSCSIni.NB.IsAdministration) then Result := false; end; end; // ##### Вернет вышестоящую ветвь по ее типу ##### function TF_MAIN.GetParentNodeByItemType(ANode: TTreeNode; AItemTypes: TIntSet): TTreeNode; var ParentNode: TTreeNode; NodeDat: PobjectData; begin Result := nil; try if ANode = nil then Exit; //// EXIT //// ParentNode := ANode; while (ParentNode <> nil) and Not(PobjectData(ParentNode.Data).ItemType in AItemTypes) do ParentNode := ParentNode.Parent; Result := ParentNode; except on E: Exception do AddExceptionToLog('TF_MAIN.GetParentNodeByItemType: '+E.Message); end; end; // ##### Вернет в дереве ветвь на которой м.б ATrgItemType относительно ACurrNode ##### function TF_MAIN.GetTargetNodeForItemType(ACurrTrgNode: TTreeNode; AChldItemType: TItemType; AChildQueryMode: TQueryMode): TTreeNode; var TrgMayHaveItemType: TItemType; ResNode: TTreeNode; ParamDat: PObjectData; TrgDat: PObjectData; ChldItemType: Integer; begin Result := nil; //Tolik 19/05/2021 -- if not Assigned(ACurrTrgNode) then exit; // try {case AChldItemType of itDir: TrgMayHaveItemType := itDir; itList: TrgMayHaveItemType := itDir; itSCSConnector: TrgMayHaveItemType := itList; itSCSLine: TrgMayHaveItemType := itList; itComponCon, itComponLine: case GDBMode of bkNormBase: TrgMayHaveItemType := itDir; bkProjectManager: TrgMayHaveItemType := itSCSConnector; end; end;} ParamDat := ACurrTrgNode.Data; ResNode := ACurrTrgNode; ChldItemType := 0; while ResNode <> nil do begin //TrgDat := ResNode.Data; //if Not IsComponItemType(TrgDat.ItemType) then //if Not (TrgDat.ItemType in [itComponLine, itComponCon]) then // //if CanParantItemHaveChildItemInTreeView(TrgDat.ItemType, AChldItemType) then // if CanParantNodeHaveChildItemInTreeView(ResNode, AChldItemType, AChildQueryMode) then // begin // Result := ResNode; // Exit; //// EXIT //// // end; //ResNode := ResNode.Parent; TrgDat := ResNode.Data; if CanParantNodeHaveChildItemInTreeView(ResNode, AChldItemType, AChildQueryMode) then if Not IsComponItemType(TrgDat.ItemType) then begin Result := ResNode; Exit; //// EXIT //// end else begin if AChldItemType = ChldItemType then AChldItemType := TrgDat.ItemType; end; ChldItemType := TrgDat.ItemType; ResNode := ResNode.Parent; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'GetTargetNodeForItemType', E.Message); end; end; function TF_MAIN.GetTopCatalogID: Integer; var ParentID: Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select id from katalog where parent_id = '''+IntToStr(0)+''' '); ParentId := DM.scsQSelect.GetFNAsInteger('id'); Result := ParentID; end; // ##### Возвращает тип компоненты ##### function TF_MAIN.GetSCSComponType(AisLine: integer; AAsLinkToCompon: Boolean = false): Integer; begin Result := -1; case AisLine of biFalse: begin if Not AAsLinkToCompon then Result := itComponCon else Result := itLinkCompCon; end; biTrue: begin if Not AAsLinkToCompon then Result := itComponLine else Result := itLinkCompLine; end; else begin Result := GetItemTypeByIsLine(AisLine); end; end; end; // ##### Вернет линейный, или не линейный тип ##### function TF_MAIN.GetisLine(ACompItemType: TItemType): Integer; begin Result := -1; case ACompItemType of itComponLine: Result := 1; itComponCon : Result := 0; end; end; function TF_MAIN.CreateNBCatalog(AParentCatalog: TSCSCatalog; const AName: String): TSCSCatalog; var NBTopUserNode: TTreeNode; NewNBDirNode: TTreeNode; begin Result := nil; NBTopUserNode := nil; if AParentCatalog <> nil then begin if AParentCatalog.TreeViewNode = nil then AParentCatalog.TreeViewNode := FindComponOrDirInTree(AParentCatalog.ID, false); NBTopUserNode := AParentCatalog.TreeViewNode; end else NBTopUserNode := GetTopNodeByNBMode(nbmUser, itDir); if NBTopUserNode <> nil then begin NewNBDirNode := MakeDir(cfBase, NBTopUserNode, AName, itDir, nil); if NewNBDirNode <> nil then begin Result := TSCSCatalog.Create(Self); Result.LoadCatalogByID(PObjectData(NewNBDirNode.Data).ObjectID); Result.TreeViewNode := NewNBDirNode; if AParentCatalog <> nil then AParentCatalog.AddChildCatalogToList(Result); end; end; end; // ##### Создает папку... ##### MakeDir(nil, ' Название ', тип, ID ); function TF_MAIN.MakeDir(ACallFrom: TCallFrom; AParentNode: TTreeNode; ACaption: String; AItemType: TItemType; ADataPointer: Pointer; ASCS_ID: Integer = -1; AKolCompon: Integer = -1; ASortID: Integer = -1; AFullMaking: Boolean = true): TTreeNode; var ParentNode: TTreeNode; Dat: PObjectData; ParentDat: POBjectData; ParentCatalog: TSCSCatalog; ParentSCSObject: TSCSCatalog; Node: TTreeNode; ProjNode: TTreeNode; FirstListSiblingNode: TTreeNode; AddProperty: Boolean; NewID: Integer; SCS_ID: Integer; NewSCSCatalog: TSCSCAtalog; IsStateForFieldName: String; IDCompStTypeProp: Integer; IDCompStType: Integer; QueryMode: TQueryMode; ProjectParams: TProjectParams; ListParams: TListParams; ObjectParams: TObjectParams; CanFreeNewSCSCatalog: Boolean; NBProperty: TNBProperty; SprProperty: TNBProperty; PropValue: String; i: Integer; begin Result := nil; try NewSCSCatalog := nil; ParentCatalog := nil; Node := nil; ProjNode := nil; IsStateForFieldName := ''; IsStateForFieldName := ItemTypeToIsOwnerFieldName(AItemType); QueryMode := GetQueryModeByParentNode(GDBMode, AParentNode, GetQueryModeByGDBMode(GDBMode)); //*** Проверка на существование ASCS_ID //if ASCS_ID > 0 then // if DM.GetCatalogItemsCntBySCSID(ASCS_ID, AItemType, QueryMode) > 0 then // Exit; ///// EXIT ///// if AItemType in [itSCSLine, itSCSConnector] then AddProperty := true else AddProperty := false; begin DefineChildNodes(AParentNode); Dat := AParentNode.Data; ParentNode := AParentNode; ParentNode := GetTargetNodeForItemType(AParentNode, AItemType, qmUndef); if ParentNode = nil then Exit; ///// EXIT ///// ParentDat := ParentNode.Data; case AItemType of itDir, itSCSConnector, itSCSLine, itRoom, itArhContainer: begin NewSCSCatalog := TSCSCatalog.Create(TForm(Self)); //if (AItemType = itDir) and (ParentDat.ItemType = itProjMan) then if (AItemType = itDir) and (ParentDat.ItemType <> itProject) and (ParentDat.QueryMode = qmPhisical) then NewSCSCatalog.QueryMode := qmPhisical; end; itProject: NewSCSCatalog := TSCSProject.Create(TForm(Self)); itList: NewSCSCatalog := TSCSList.Create(TForm(Self)); end; if NewSCSCatalog = nil then Exit; ///// EXIT ////// CanFreeNewSCSCatalog := true; try NewSCSCatalog.Name := ACaption; NewSCSCatalog.IsUserName := biFalse; //NewSCSCatalog.NameShort := ACaption; NewSCSCatalog.ParentID := ParentDat.ObjectID; NewSCSCatalog.ListID := 0; NewSCSCatalog.MarkID := 0; NewSCSCatalog.SCSID := ASCS_ID; if AKolCompon <> -1 then NewSCSCatalog.KolCompon := AKolCompon; if ASortID <> -1 then NewSCSCatalog.SortID := ASortID; NewSCSCatalog.ItemType := AItemType; if GDBMode = bkProjectManager then begin //*** Определить ID проекта if AItemType <> itProject then begin if AItemType <> itDir then begin //ProjNode := FindComponOrDirInTree(GSCSBase.CurrProject.CurrID, false); ProjNode := GSCSBase.CurrProject.TreeViewNode; //ParentCatalog := DM.GetCatalogByID(ParentDat.ObjectID, QueryMode); if PObjectData(AParentNode.Data).ItemType <> itProject then ParentCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ParentDat.ObjectID) else begin ParentCatalog := GSCSBase.CurrProject; NewSCSCatalog.ParentID := 0; end; //if ProjNode <> nil then // NewSCSCatalog.ProjectID := PObjectData(ProjNode.Data).ObjectID; ///ParentCatalog.Project_ID; if AItemType in [itRoom, itSCSConnector, itSCSLine, itArhContainer] then if Assigned(ParentCatalog) then NewSCSCatalog.ListID := ParentCatalog.ListID; if NewSCSCatalog.SCSID < 1 then NewSCSCatalog.SCSID := GSCSBase.CurrProject.GenIDByGeneratorIndex(giKatalogSCSID); //DM.LastKatalogID + 1; //*** определить поле Mark_ID //if Not(AItemType in [itSCSConnector, itSCSLine]) then //if Assigned(ParentCatalog) then // if AItemType <> itList then // NewSCSCatalog.MarkID := DM.GetCatalogMaxMarkID(AItemType, ParentCatalog.ProjectID, QueryMode) + 1; end; end else begin //NewSCSCatalog.MarkID := DM.GetCatalogMaxMarkID(AItemType, -1, QueryMode) + 1; if ADataPointer <> nil then begin ProjectParams := TProjectParams(ADataPointer^); NewSCSCatalog.MarkID := ProjectParams.MarkID; NewSCSCatalog.IsIndexWithName := ProjectParams.IsIndexWithName; TSCSProject(NewSCSCatalog).Setting := ProjectParams.Setting; TSCSProject(NewSCSCatalog).DefListSettings := ProjectParams.DefListSetting; end; //LoadMaskTemplatesFromFormToList(TSCSProject(NewSCSCatalog).MarkMasks); //TSCSProject(NewSCSCatalog).Spravochnik.Assign(FNormBase.GSCSBase.NBSpravochnik); LoadFromFormToSpravochnik(itProject, TSCSProject(NewSCSCatalog).Spravochnik, [vkAll] {[vkCurrency, vkInterface]}); LoadFromFormToSpravochnik(itList, TSCSProject(NewSCSCatalog).Spravochnik, [vkComponentType]); end; //*** Если создается Лист, то создать его на CAD-е if AItemType = itList then begin //if ACallFrom = cfBase then //begin // NewSCSCatalog.SCSID := GSCSBase.CurrProject.GenIDByGeneratorIndex(giKatalogSCSID); //DM.LastKatalogID + 1; //GenNewListID; // AddListInCAD(NewSCSCatalog.SCSID, NewSCSCatalog.Name); //end; NewSCSCatalog.ListID := NewSCSCatalog.SCSID; TSCSList(NewSCSCatalog).AssignSettings(GSCSBase.CurrProject.DefListSettings); //TSCSList(NewSCSCatalog).AssignMarkMasks(GSCSBase.CurrProject.MarkMasks, true); if ADataPointer <> nil then begin ListParams := TListParams(ADataPointer^); NewSCSCatalog.MarkID := ListParams.MarkID; NewSCSCatalog.IsIndexWithName := ListParams.IsIndexWithName; TSCSList(NewSCSCatalog).AssignSettings(ListParams.Settings); end; if ACallFrom = cfCAD then begin //LoadMaskTemplatesFromFormToList(TSCSList(NewSCSCatalog).MarkMasks); //TSCSList(NewSCSCatalog).Spravochnik.AssignComponentTypes(GSCSBase.CurrProject.Spravochnik.ComponentTypes); LoadFromFormToSpravochnik(itList, TSCSList(NewSCSCatalog).Spravochnik, [vkComponentType]); end; end; if AItemType = itRoom then if ADataPointer <> nil then begin ObjectParams := TObjectParams(ADataPointer^); NewSCSCatalog.NameShort := ObjectParams.NameShort; NewSCSCatalog.MarkID := ObjectParams.MarkID; end; end; //*** Сохранение case AItemType of itDir, itSCSConnector, itSCSLine, itRoom, itArhContainer: NewSCSCatalog.SaveAsNew; itProject: begin GSCSBase.CurrProject.Close; TSCSProject(NewSCSCatalog).SaveAsNew; end; itList: TSCSList(NewSCSCatalog).SaveAsNew; end; //NewSCSCatalog.SaveCatalogAsNew; NewID := NewSCSCatalog.NewID; NewSCSCatalog.ID := NewSCSCatalog.NewID; NewSCSCatalog.NotifyChange; FirstListSiblingNode := nil; Node := Tree_Catalog.Items.AddChild(ParentNode, NewSCSCatalog.GetNameForVisible(true)); if AItemType = itList then // Если Лист то учитывать обратное отображение листов if GSCSBase.CurrProject.Setting.ListsInReverseOrder then begin FirstListSiblingNode := GetFirstSiblingNodeByItemType(Node, Node, itList); if FirstListSiblingNode <> nil then MoveNodeTo(Node, FirstListSiblingNode, naInsert); end; NewData(Dat, ttComponents); Dat.ObjectID := NewID; Dat.QueryMode := NewSCSCatalog.QueryMode; Dat.ComponKind := ckNone; Dat.NBMode := PObjectData(AParentNode.Data).NBMode; Dat.ItemType := AItemType; Dat.ChildNodesCount := 0; Node.Data := Dat; SetNodeState(Node, Dat.ItemType, ekNone); ShowKolForDir(Node, 0); if AFullMaking then begin if GDBMode = bkNormBase then begin if Node.Level = dirCurrencyLevel then DM.CreateDefCurrenciesForObject(NewSCSCatalog.NewID); end else if GDBMode = bkProjectManager then begin //*** Отобрать свойства для объекта if IsStateForFieldName <> '' then if (AItemType <> itProject) and (AItemType <> itList) then begin for i := 0 to F_NormBase.GSCSBase.NBSpravochnik.Properties.Count - 1 do begin NBProperty := TNBProperty(F_NormBase.GSCSBase.NBSpravochnik.Properties[i]); if ((AItemType = itRoom) and (NBProperty.PropertyData.ISRoom = biTrue)) or ((AItemType = itSCSLine) and (NBProperty.PropertyData.ISSCSLine = biTrue)) or ((AItemType = itSCSConnector) and (NBProperty.PropertyData.ISSCSConnector = biTrue)) then begin PropValue := NBProperty.PropertyData.DefValue; SprProperty := GSCSBase.CurrProject.Spravochnik.GetPropertyByGUID(NBProperty.PropertyData.GUID); if SprProperty <> nil then PropValue := SprProperty.PropertyData.DefValue; NewSCSCatalog.AddProperty(NBProperty.PropertyData.ID, NBProperty.PropertyData.GUID, NBProperty.PropertyData.IDDataType, biTrue, PropValue, NBProperty.PropertyData.Name, NBProperty.PropertyData.SysName); if SprProperty = nil then begin AddStringToStringListOnce(GSCSBase.CurrProject.Spravochnik.NewGUIDsProperties, NBProperty.PropertyData.GUID); F_ChoiceConnectSide.DefineObjectParamsInFuture(NewSCSCatalog); end; end; end; {//SetSQLToQuery(F_NormBase.DM.scsQSelect, ' select id, "DEFAULT" from properties where (isstandart = 1) and ((id_item_type = '''+IntToStr(AItemType)+''' ) or (id_item_type = '''+IntToStr(itCommon)+''' )) '); SetSQLToQuery(F_NormBase.DM.scsQSelect, ' select ID, NAME, SYSNAME, DEF_VALUE from properties where '+IsStateForFieldName+' = '''+IntToStr(biTrue)+''' '); while Not F_NormBase.DM.scsQSelect.Eof do begin //DM.InsertToPropRelation(pkCatalog, NewID, F_NormBase.DM.scsQSelect.GetFNAsInteger('id'), F_NormBase.DM.scsQSelect.GetFNAsString(fnDefValue), biTrue, QueryMode); NewSCSCatalog.AddProperty(F_NormBase.DM.scsQSelect.GetFNAsInteger(fnID), biTrue, F_NormBase.DM.scsQSelect.GetFNAsString(fnDefValue), F_NormBase.DM.scsQSelect.GetFNAsString(fnName), F_NormBase.DM.scsQSelect.GetFNAsString(fnSysName)); F_NormBase.DM.scsQSelect.Next; end;} end; end; end; //*** Если создается проект if AItemType = itProject then begin //DM.UpdateCatalogFieldAsInteger(NewID, NewID, fnID, 'project_id', QueryMode); ChangeCurrProject(GIDLastProject, NewID); GSCSBase.CurrProject.TreeViewNode := Node; end; //*** Если создается Лист {if AItemType = itList then begin //GSCSBase.CurrProject.InsertListByID(NewSCSCatalog.SCSID); CanFreeNewSCSCatalog := false; NewSCSCatalog.TreeViewNode := Node; Dat.ListID := NewSCSCatalog.SCSID; GSCSBase.CurrProject.AddList(TSCSList(NewSCSCatalog)); TSCSList(NewSCSCatalog).Open(NewSCSCatalog.SCSID); ChangeCurrList(GIDLastList, NewSCSCatalog.SCSID); //GSCSBase.CurrProject.CurrList.TreeViewNode := Node; //SetSQLToQuery(DM.scsQOperat, ' update katalog set List_id = '''+IntToStr(NewID)+''' where id = '''+IntToStr(NewID)+''' '); end;} //*** Если Комната, или объект if AItemType in [itRoom, itSCSLine, itSCSConnector, itArhContainer] then Dat.ListID := ParentDat.ListID; //*** Создался объект. папка, комнта if GDBMode = bkProjectManager then if AItemType in [itDir, itList, itRoom, itSCSConnector, itSCSLine, itArhContainer] then begin ParentSCSObject := nil; if ParentDat.ItemType = itProject then ParentSCSObject := GSCSBase.CurrProject else ParentSCSObject := GSCSBase.CurrProject.GetCatalogFromReferences(ParentDat.ObjectID); if ParentSCSObject <> nil then begin CanFreeNewSCSCatalog := false; ParentSCSObject.AddChildCatalogToList(NewSCSCatalog); //ParentSCSObject.InsertCatalogByID(NewID).TreeViewNode := Node; NewSCSCatalog.TreeViewNode := Node; end; if AItemType = itList then begin Dat.ListID := NewSCSCatalog.SCSID; TSCSList(NewSCSCatalog).Open(NewSCSCatalog.SCSID); ChangeCurrList(GIDLastList, NewSCSCatalog.SCSID); end; if AItemType = itRoom then begin NewSCSCatalog.CreateRoomSetting; end; if AItemType in [itSCSConnector, itSCSLine] then DefineObjectNodeGroup(Node, ogtEmpty, NewSCSCatalog.IsLine); end; //Tree_Catalog.Selected := Node; //ShowSelectedNode(Tree_Catalog); SetSortID(Node, NewSCSCatalog); SortByVetv(Node.Parent); OnAddDeleteNode(Node, nil, nil, true); finally if CanFreeNewSCSCatalog then FreeAndNil(NewSCSCatalog); end; end; Result := Node; except on E: Exception do AddExceptionToLog('TF_MAIN.MakeDir: '+E.Message); end; end; function TF_MAIN.MakeNodeForNewComponent(ACatalogNode: TTreeNode; ANewComponent: TSCSComponent): TTreeNode; var ComponNodeDat: PObjectData; begin Result := nil; try DefineChildNodes(ACatalogNode); Result := Tree_Catalog.Items.AddChild(ACatalogNode, ANewComponent.Name); NewData(ComponNodeDat, ttComponents); ComponNodeDat.ObjectID := ANewComponent.ID; ComponNodeDat.ItemType := GetSCSComponType(ANewComponent.IsLine); ComponNodeDat.QueryMode := FQueryModeByGDBMode; ComponNodeDat.ComponKind := ckCompon; ComponNodeDat.NBMode := PObjectData(ACatalogNode.Data).NBMode; ComponNodeDat.SortID := 0; ComponNodeDat.ChildNodesCount := 0; Result.Data := ComponNodeDat; SetNodeState(Result, ComponNodeDat.ItemType, ekNone, ANewComponent); SetSortID(Result, ANewComponent); // Количество компонентов в Папке OnAddDeleteNode(Result, nil, nil, true); except on E: Exception do AddExceptionToLog('TF_MAIN.MakeNodeForNewComponent: '+E.Message); end; end; procedure TF_MAIN.MakeEditCrossConnection(AMakeEdit: TMakeEdit); var CrossConnection: TSCSCrossConnection; ptrCrossConnection: TSCSCrossConnection; begin try CrossConnection := nil; ptrCrossConnection := nil; if AMakeEdit = meMake then CrossConnection := TSCSCrossConnection.Create(Self) //ZeroMemory(@CrossConnection, SizeOf(TCrossConnection)) else begin CrossConnection := TSCSCrossConnection.Create(Self); DM.LoadCrossConnectionFromMemTable(DM.MemTable_CrossConnection, CrossConnection); end; CrossConnection.IDComponent := GSCSBase.SCSComponent.ID; if CreateFMakeEditCrossConnection.Execute(AMakeEdit, GSCSBase.SCSComponent, CrossConnection) then begin CrossConnection.Save(AMakeEdit, false); //DM.InsertUpdateCrossConnection(AMakeEdit, CrossConnection); DM.LoadCrossConnectionToMemTable(AMakeEdit, DM.MemTable_CrossConnection, CrossConnection); ptrCrossConnection := nil; if AMakeEdit = meMake then begin ptrCrossConnection := TSCSCrossConnection.Create(Self); //GetMem(ptrCrossConnection, SizeOf(TCrossConnection)); GSCSBase.SCSComponent.CrossConnections.Add(ptrCrossConnection); end else if AMakeEdit = meEdit then ptrCrossConnection := GSCSBase.SCSComponent.GetCrossConnectionByID(CrossConnection.ID); if ptrCrossConnection <> nil then begin ptrCrossConnection.Assign(CrossConnection); if AMakeEdit = meMake then ptrCrossConnection.ID := GenIDFromTable(DM.Query_Select, gnCrossConnectionID, 0); end; GSCSBase.SCSComponent.NotifyChange; end; FreeAndNil(CrossConnection); except on E: Exception do AddExceptionToLog('TF_MAIN.MakeEditCrossConnection: '+E.Message); end; end; procedure TF_MAIN.AddCrossConnectionToParentComponent(AParentComponent, AComponent: TSCSComponent); var ParentCompon: TSCSComponent; ComponOwner: TSCSCatalog; begin if Assigned(AComponent) and Assigned(AParentComponent) then if AComponent.IsCrossComponent then if AParentComponent.ComponentType.SysName = ctsnCupboard then case GDBMode of bkNormBase: begin ParentCompon := AComponent.GetParentComponent; if Assigned(ParentCompon) then if Assigned(ParentCompon.TreeViewNode) then begin Tree_Catalog.Selected := ParentCompon.TreeViewNode; WaitForTVChange; MakeEditCrossConnection(meMake); end; end; bkProjectManager: begin ComponOwner := AComponent.GetFirstParentCatalog; if Assigned(ComponOwner) then CreateFMakeEditCrossConnection.ShowConnectConfigurator(ComponOwner, fmCrossConfigurator, cmByLine, AComponent.ID); end; end; end; procedure TF_MAIN.MakeEditObjectCurrency(AMakeEdit: TMakeEdit; AObjectID: Integer); var OldObjectCurrency: TObjectCurrencyRel; ptrObjectCurrency: PObjectCurrencyRel; ptrObjCurrencyWithSameMain: PObjectCurrencyRel; ptrOldMainCurrency: PObjectCurrencyRel; ptrNewMainCurrency: PObjectCurrencyRel; ptrNewSecondCurrency: PObjectCurrencyRel; IDObjectCurrency: Integer; //mtBookMark: String; mtBookMark: TBookMark; CanEdit: Boolean; begin ptrObjectCurrency := nil; case AMakeEdit of meMake: begin GetZeroMem(ptrObjectCurrency, SizeOf(TObjectCurrencyRel)); ptrObjectCurrency.IDCatalog := AObjectID; end; meEdit: ptrObjectCurrency := DM.GetObjectCurrencyFromMemTable(DM.mtObjectCurrency); end; if ptrObjectCurrency <> nil then begin OldObjectCurrency := ptrObjectCurrency^; if CreateFMakeEditObjCurrency.Execute(AMakeEdit, ptrObjectCurrency) then begin CanEdit := true; DM.mtObjectCurrency.DisableControls; try ptrObjCurrencyWithSameMain := nil; //mtBookMark := DM.mtObjectCurrency.Bookmark; mtBookMark := DM.mtObjectCurrency.getBookmark; try //*** Не добавлять валюту, если такова уже есть if (AMakeEdit = meMake) and DM.mtObjectCurrency.Locate(fnIDCurrency, ptrObjectCurrency.IDCurrency, []) then begin MessageModal(cMain_Msg124_1+' '+ptrObjectCurrency.Data.Name+' '+cMain_Msg124_2, ApplicationName, MB_ICONINFORMATION or MB_OK); CanEdit := false; end; if CanEdit then if ptrObjectCurrency.Data.Main <> OldObjectCurrency.Data.Main then begin //*** Найти ID валюты с таки значением поля Main, как в ptrObjectCurrency.Main, и поставить туда // старое значение текущей редакруемой записи ptrObjCurrencyWithSameMain := DM.GetObjectCurrencyByMainFld(AObjectID, ptrObjectCurrency.Data.Main); if ptrObjCurrencyWithSameMain <> nil then begin DM.UpdateIntTableFieldByID(tnObjectCurrencyRel, fnMain, ptrObjCurrencyWithSameMain.ID, OldObjectCurrency.Data.Main, qmPhisical); if DM.mtObjectCurrency.Locate(fnID, ptrObjCurrencyWithSameMain.ID, []) then begin DM.mtObjectCurrency.Edit; DM.mtObjectCurrency.FieldByName(fnMain).AsInteger := OldObjectCurrency.Data.Main; DM.mtObjectCurrency.Post; end; end; end; finally if mtBookMark <> nil then begin DM.mtObjectCurrency.GotoBookmark(mtBookMark); DM.mtObjectCurrency.FreeBookmark(mtBookMark); end; end; if CanEdit then begin case AMakeEdit of meMake: DM.mtObjectCurrency.Append; meEdit: DM.mtObjectCurrency.Edit; end; if DM.mtObjectCurrency.State <> dsBrowse then begin DM.SaveObjectCurrency(AMakeEdit, ptrObjectCurrency); DM.SetObjectCurrencyToMemTable(ptrObjectCurrency, DM.mtObjectCurrency); DM.mtObjectCurrency.Post; end; //*** Переопределить цены, если была ищменена главная валюта if ptrObjCurrencyWithSameMain <> nil then begin //*** Если изменилась главная валюта if (ptrObjectCurrency.Data.Main = ctMain) or (ptrObjCurrencyWithSameMain.Data.Main = ctMain) then begin ptrOldMainCurrency := nil; ptrNewMainCurrency := nil; if ptrObjectCurrency.Data.Main = ctMain then begin ptrOldMainCurrency := ptrObjCurrencyWithSameMain; ptrNewMainCurrency := ptrObjectCurrency; end else if ptrObjCurrencyWithSameMain.Data.Main = ctMain then begin ptrOldMainCurrency := ptrObjectCurrency; ptrNewMainCurrency := ptrObjCurrencyWithSameMain; end; if (ptrOldMainCurrency <> nil) and (ptrNewMainCurrency <> nil) then begin ptrNewSecondCurrency := DM.GetObjectCurrencyByMainFld(AObjectID, ctSecond); //*** Обновить цены ChangeObjectCurrencyRatiosWithPrices(AObjectID, ptrOldMainCurrency, ptrNewMainCurrency, ptrNewSecondCurrency, DM.Query_Select, DM.Query_Operat); FreeMem(ptrNewSecondCurrency); //*** Полностью обновить список валют DM.SelectCatalogCurrency(ptrObjectCurrency.ID); mtBookMark := nil; end; end else //*** Если поменялась вторая валюта if (ptrObjectCurrency.Data.Main = ctSecond) or (ptrObjCurrencyWithSameMain.Data.Main = ctSecond) then DefineLocalCurrency; FreeMem(ptrObjCurrencyWithSameMain); end; end; {if mtBookMark <> '' then DM.mtObjectCurrency.Bookmark := mtBookMark;} if mtBookMark <> nil then begin DM.mtObjectCurrency.GotoBookmark(mtBookMark); DM.mtObjectCurrency.FreeBookmark(mtBookMark); end; finally DM.mtObjectCurrency.EnableControls; end; end; FreeMem(ptrObjectCurrency); end; end; (* // ##### Создает папку... ##### MakeDir(nil, ' Название ', тип, ID ); function TF_MAIN.MakeDir(ACallFrom: TCallFrom; AParentNode: TTreeNode; ACaption: String; AItemType: TItemType; ASCS_ID: Integer = -1; AKolCompon: Integer = -1; ASortID: Integer = -1; AFullMaking: Boolean = true): TTreeNode; var ParentNode: TTreeNode; Dat: PObjectData; ParentDat: POBjectData; ParentCatalog: TCatalog; Node: TTreeNode; ProjNode: TTreeNode; AddProperty: Boolean; NewID: Integer; SCS_ID: Integer; NewSCSCatalog: TSCSCAtalog; IDCompStTypeProp: Integer; IDCompStType: Integer; QueryMode: TQueryMode; scsQSelect: TSCSQuery; scsQOperat: TSCSQuery; begin Result := nil; try NewSCSCatalog := nil; Node := nil; ProjNode := nil; scsQSelect := TSCSQuery.Create(Self, DM.Query, DM.qSQL_Query); scsQOperat := TSCSQuery.Create(Self, DM.Query_Operat, DM.qSQL_QueryOperat); try QueryMode := GetQueryModeByParentNode(GDBMode, AParentNode, scsQSelect.QueryMode); scsQSelect.QueryMode := QueryMode; scsQOperat.QueryMode := QueryMode; //*** Проверка на существование ASCS_ID if ASCS_ID > 0 then begin SetSQLToQuery(scsQSelect, ' select count(id) As cnt_id from katalog '+ ' where (scs_id = '''+IntTostr(ASCS_ID)+''') and (id_item_type = '''+IntToStr(AItemType)+''') '); If scsQSelect.GetFNAsInteger('cnt_id') > 0 then Exit; ///// EXIT ///// end; if AItemType in [itSCSLine, itSCSConnector] then AddProperty := true else AddProperty := false; if ACaption <> '' Then begin Dat := AParentNode.Data; ParentNode := AParentNode; ParentNode := GetTargetNodeForItemType(AParentNode, AItemType); if ParentNode = nil then Exit; ///// EXIT ///// Node:=Tree_Catalog.Items.AddChild(ParentNode, ACaption); ParentDat := ParentNode.Data; case AItemType of itDir, itSCSConnector, itSCSLine, itRoom: NewSCSCatalog := TSCSCAtalog.Create(TForm(Self)); itProject: NewSCSCatalog := TSCSProject.Create(TForm(Self)); itList: NewSCSCatalog := TSCSList.Create(TForm(Self)); end; if NewSCSCatalog = nil then Exit; ///// EXIT ////// try NewSCSCatalog.Name := ACaption; NewSCSCatalog.IsUserName := biFalse; //NewSCSCatalog.NameShort := ACaption; NewSCSCatalog.ParentID := ParentDat.ObjectID; NewSCSCatalog.ListID := 0; if GDBMode = bkProjectManager then begin //*** Определить ID проекта if AItemType <> itProject then begin ProjNode := FindComponOrDirInTree(GSCSBase.CurrProject.CurrID, false); ParentCatalog := DM.GetCatalogByID(ParentDat.ObjectID); if ProjNode <> nil then NewSCSCatalog.ProjectID := PObjectData(ProjNode.Data).ObjectID; ///ParentCatalog.Project_ID; if AItemType in [itRoom, itSCSConnector, itSCSLine] then NewSCSCatalog.ListID := ParentCatalog.List_ID; //*** определить поле Mark_ID if Not(AItemType in [itSCSConnector, itSCSLine]) then begin SetSQLToQuery(scsQSelect, ' select Max(Mark_ID) As max_mark_id from katalog '+ ' where (project_id = '''+IntToStr(ParentCatalog.Project_ID)+''') and '+ ' (id_item_type = '''+IntToStr(AItemType)+''') '); NewSCSCatalog.MarkID := scsQSelect.GetFNAsInteger('max_mark_id') + 1; end; end else begin //Query_Select.Close; //Query_Select.SQL.Text := ' select Max(Mark_ID) from katalog '+ /// ' where (id_item_type = '''+IntToStr(AItemType)+''') '; //Query_Select.ExecQuery; //NewSCSCatalog.MarkID := DM.Query_Select.FN('MAX').AsInteger + 1; SetSQLToQuery(scsQSelect, ' select Max(Mark_ID) AS max_mark_id from katalog '+ ' where (id_item_type = '''+IntToStr(AItemType)+''') '); NewSCSCatalog.MarkID := scsQSelect.GetFNAsInteger('max_mark_id') + 1; end; NewSCSCatalog.SCSID := ASCS_ID; //*** Если создается Лист, то создать его на CAD-е if AItemType = itList then begin if ACallFrom = cfBase then begin NewSCSCatalog.SCSID := GenNewListID; AddListInCAD(NewSCSCatalog.SCSID, NewSCSCatalog.Name); end; NewSCSCatalog.ListID := NewSCSCatalog.SCSID; TSCSList(NewSCSCatalog).AssignSettings(GSCSBase.CurrProject.Setting.ListSettingRecord); TSCSList(NewSCSCatalog).AssignMarkMasks(GSCSBase.CurrProject.MarkMasks, true); end; NewSCSCatalog.ItemType := AItemType; end; if AKolCompon <> -1 then NewSCSCatalog.KolCompon := AKolCompon; if ASortID <> -1 then NewSCSCatalog.SortID := ASortID; case AItemType of itDir, itSCSConnector, itSCSLine, itRoom: NewSCSCatalog.SaveCatalogAsNew; itProject: begin GSCSBase.CurrProject.Close; TSCSProject(NewSCSCatalog).SaveAsNew; end; itList: TSCSList(NewSCSCatalog).SaveAsNew; end; //NewSCSCatalog.SaveCatalogAsNew; NewID := NewSCSCatalog.NewID; NewData(Dat, ttComponents); Dat.ObjectID := NewID; Dat.ComponKind := ckNone; Dat.NBMode := PObjectData(AParentNode.Data).NBMode; Dat.ItemType := AItemType; Node.Data := Dat; SetNodeImageIndex(Node, Dat.ItemType, ekNone); ShowKolForDir(Node, 0); SetSortID(Node); //*** Если создается проект if AItemType = itProject then begin SetSQLToQuery(scsQOperat, ' update katalog set project_id = '''+IntToStr(NewID)+''' where id = '''+IntToStr(NewID)+''' '); scsQOperat.Close; ChangeCurrProject(GIDLastPoject, NewID); end; //*** Если создается Лист if AItemType = itList then begin GSCSBase.CurrProject.InsertListByID(NewSCSCatalog.SCSID); ChangeCurrList(GIDLastList, NewSCSCatalog.SCSID); Dat.ListID := NewSCSCatalog.SCSID; //SetSQLToQuery(DM.scsQOperat, ' update katalog set List_id = '''+IntToStr(NewID)+''' where id = '''+IntToStr(NewID)+''' '); end; //*** Если Комната, или объект if AItemType in [itRoom, itSCSLine, itSCSConnector] then Dat.ListID := ParentDat.ListID; if AFullMaking and (GDBMode = bkProjectManager) then begin {if AddProperty then begin with F_NormBase.DM do begin //*** Найти ID свойства для типа условного обозначения SetSQLToQuery(scsQSelect, ' select id from properties where id_data_type = '''+ IntToStr(dtCompStateType) +''' '); IDCompStTypeProp := scsQSelect.FN('ID').AsInteger; //*** Найти ID первого условного обозначения (проектируемый по умолчанию) SetSQLToQuery(scsQSelect, ' select MIN(ID) from comp_state_type '); IDCompStType := scsQSelect.FN('MIN').AsInteger; end; //*** Создать свойство для объекта DM.scsQOperat.Close; DM.scsQOperat.SQL.Clear; DM.scsQOperat.SQL.Add(' insert into catalog_prop_relation (id_catalog, id_property, pvalue) '+ ' values(:id_catalog, :id_property, :pvalue) '); DM.scsQOperat.ParamByName('id_catalog').AsInteger := NewID; DM.scsQOperat.ParamByName('id_property').AsInteger := IDCompStTypeProp; DM.scsQOperat.ParamByName('pvalue').AsString := IntToStr(IDCompStType); DM.scsQOperat.ExecQuery; DM.scsQOperat.Close; end; end; if AItemType = itSCSConnector then begin } scsQOperat.Close; scsQOperat.SQL.Clear; scsQOperat.SQL.Add(' insert into catalog_prop_relation (id_catalog, id_property, pvalue) '+ ' values(:id_catalog, :id_property, :pvalue) '); //*** Отобрать свойства для объекта SetSQLToQuery(F_NormBase.DM.scsQSelect, ' select id, "DEFAULT" from properties where (isstandart = 1) and ((id_item_type = '''+IntToStr(AItemType)+''' ) or (id_item_type = '''+IntToStr(itCommon)+''' )) '); while Not F_NormBase.DM.scsQSelect.Eof do begin scsQOperat.SetParamAsInteger('id_catalog', NewID); scsQOperat.SetParamAsInteger('id_property', F_NormBase.DM.scsQSelect.GetFNAsInteger('id')); scsQOperat.SetParamAsString('pvalue', F_NormBase.DM.scsQSelect.GetFNAsString('default')); scsQOperat.ExecQuery; scsQOperat.Close; F_NormBase.DM.scsQSelect.Next; end; //*** Есои Лист, то установить свойства по умолчанию if AItemType = itList then begin //ChangeCurrList(GIDLastList, NewSCSCatalog.SCSID); //GListSetting.Setting := GProjectSettings.Setting.ListSettingRecord; //GListSetting.SaveSettings; SetPropertyValue(tkCatalog, NewID, pnHeightRoom, FloatToStr(GRoomHeight), -1); SetPropertyValue(tkCatalog, NewID, pnHeightCeiling, FloatToStr(GFalseFloorHeight), -1); SetPropertyValue(tkCatalog, NewID, pnHeightSocket, FloatToStr(GConnHeight), -1); SetPropertyValue(tkCatalog, NewID, pnHeightCorob, FloatToStr(GLineHeight), -1); SetPropertyValue(tkCatalog, NewID, pnLengthKoef, '0,01', -1); SetPropertyValue(tkCatalog, NewID, pnPortReserv, '0,5', -1); SetPropertyValue(tkCatalog, NewID, pnMultiPortReserv, '1', -1); end; end; Tree_Catalog.Selected := Node; SortByVetv(Node.Parent); OnAddDeleteNode(Node, true); finally NewSCSCatalog.Free; end; end; Result := Node; finally scsQSelect.Free; scsQOperat.Free; end; except on E: Exception do AddExceptionToLog('TF_MAIN.MakeDir: '+E.Message); end; end; *) // ##### Ищет ветвь по ID и Виду(Папка / Компонента) ##### function TF_MAIN.FindTreeNodeByDat(AFindID: Integer; AFindViewType: TIntSet; AFromNode: TTreeNode = nil): TTreeNode; var TopNode: TTreeNode; //CurrNode: TTreeNode; //CurrDat: PObjectData; procedure FindStep(ANode: TTreeNode); var NodeDat: PObjectData; CurrNode: TTreeNode; begin NodeDat := ANode.Data; // !!!! по идеи если bkProjectManager то проверка на ComponKind <> ckCompl // так как по итогу все одно будет далее в TF_MAIN.FindComponOrDirInTree по пути искаться ветка и вернется как с ckCompl if GDBMode = bkProjectManager then begin if (NodeDat <> nil) and (NodeDat.ObjectID = AFindID) and (NodeDat.ItemType in AFindViewType) then Result := ANode else begin CurrNode := ANode.GetFirstChild; while CurrNode <> nil do begin FindStep(CurrNode); CurrNode := CurrNode.getNextSibling; end; end; end else begin if (NodeDat <> nil) and (NodeDat.ObjectID = AFindID) and (NodeDat.ItemType in AFindViewType) and (NodeDat.ComponKind <> ckCompl) then Result := ANode else begin CurrNode := ANode.GetFirstChild; while CurrNode <> nil do begin FindStep(CurrNode); CurrNode := CurrNode.getNextSibling; end; end; end; end; procedure FindInItems; var i: Integer; NodeDat: PObjectData; CurrNode: TTreeNode; begin for i := 0 to Tree_Catalog.Items.Count - 1 do begin CurrNode := Tree_Catalog.Items[i]; NodeDat := CurrNode.Data; if (NodeDat <> nil) and (NodeDat.ObjectID = AFindID) and (NodeDat.ItemType in AFindViewType) and (NodeDat.ComponKind <> ckCompl) then begin Result := CurrNode; Break; //// BREAK //// end; end; end; begin Result := nil; case GDBMode of bkNormBase: begin FindInItems; end; bkProjectManager: begin TopNode := nil; if AFromNode <> nil then TopNode := AFromNode else TopNode := GetTopNode; if TopNode <> nil then FindStep(TopNode); end; end; {CurrNode := Tree_Catalog.TopItem; while CurrNode <> nil do begin CurrDat := CurrNode.Data; if (CurrDat.ObjectID = AFindID) and (CurrDat.ItemType in AFindViewType) then begin Result := CurrNode; Break; end; CurrNode := CurrNode.GetNext; end; } end; procedure TF_MAIN.PasteNode(ASrcNode, ATrgNode: TTreeNode; ASrcDat: PObjectData; AEditKind: TEditKind); var DatS: PObjectData; // Source DatT: PObjectData; // Target DatPT: PObjectData; // Parent Target DatPS: PObjectData; // Parent Source TrgName: String; SrcName: String; S : String; Catalog: TCatalog; Finded: Boolean; IDNode: Integer; Node: TTreeNode; //SrcNode: TTreeNode; NewTreeNode: TTreeNode; NewDat: PObjectData; NewID: Integer; ID_Cat: Integer; KolDir: Integer; KolCompon: Integer; SCSCatalog: TSCSCatalog; SCSList: TSCSList; SrcComponent: TSCSComponent; NewComponent: TSCSComponent; IDIndex: Integer; // Tolik 28/08/2019 -- //LastTick, CurrTick: Cardinal; LastTick, CurrTick: DWord; // STick: Cardinal; ETick: Cardinal; function CopyTreeCatalog(AID_SrcCatalog: Integer; AParentTrgNode: TTreeNode; ASrcComponIDs, ANewComponIDs: TIntList): TTreeNode; var ChildNodes: TIntList; Compons: TIntList; NewNode: TTreeNode; NewCompNode: TTreeNode; NewCatalogID: Integer; NewCompID: Integer; CompDat: PObjectData; SCS_ID: Integer; SCSCompon: TSCSComponent; i: Integer; CatalogCurrencies: TList; NewComponID: Integer; begin Result := nil; SetSQLToFIBQuery(DM.Query, ' select * from katalog where id = '''+ IntToStr(AID_SrcCatalog) +''' '); if GDBMode = bkProjectManager then SCS_ID := DM.Query.FN(fnSCSID).AsInteger else SCS_ID := 0; NewNode := MakeDir(cfBase, AParentTrgNode, DM.Query.FN('Name').AsString, DM.Query.FN(fnIDItemType).AsInteger, nil, -1, {DM.Query.FN(fnKolCompon).AsInteger,} 0, DM.Query.FN(fnSortID).AsInteger, false); NewCatalogID := PObjectData(NewNode.Data).ObjectID; // !!!!!!!!!!!!!!!!!!! ФАКТИЧЕСКИ НЕ ЮЗАЕТСЯ !!!!!!!!!!!!! // копировать свойства папок, если ProjectManager if GDBMode = bkProjectManager then begin SetSQLToFIBQuery(DM.Query, ' SELECT * FROM CATALOG_PROP_RELATION '+ ' WHERE ID_CATALOG = '''+ IntToStr(AID_SrcCatalog) +''' '); SetSQLToFIBQuery(DM.Query_Operat, ' insert into catalog_prop_relation (id_catalog, id_property, pvalue) '+ ' Values(:id_catalog, :id_property, :pvalue) ', false); while Not DM.Query.Eof do begin DM.Query_Operat.Close; DM.Query_Operat.ParamByName('id_catalog').AsInteger := NewCatalogID; DM.Query_Operat.ParamByName('ID_Property').AsInteger := DM.Query.FN('ID_Property').AsInteger; DM.Query_Operat.ParamByName('PValue').AsString := DM.Query.FN('PValue').AsString; DM.Query_Operat.ExecQuery; end; end else if GDBMode = bkNormBase then begin CatalogCurrencies := GetObjectCurrencies(AID_SrcCatalog, DM.Query_Select); if CatalogCurrencies <> nil then begin if CatalogCurrencies.Count > 0 then CreateDefCurrenciesForObject(NewCatalogID, DM.Query_Select, DM.Query_Operat, CatalogCurrencies); FreeList(CatalogCurrencies); end; end; //*** Копирование подпапок SetSQLToFIBQuery(DM.Query, ' select id from katalog where parent_id = '''+ IntToStr(AID_SrcCatalog) +''' order by sort_id '); ChildNodes := TIntList.Create; IntFIBFieldToIntList(ChildNodes, DM.Query, fnID); for i := 0 to ChildNodes.Count - 1 do CopyTreeCatalog(Integer(ChildNodes[i]), NewNode, ASrcComponIDs, ANewComponIDs); FreeandNil(ChildNodes); //*** Копирование компонент SetSQLToFIBQuery(DM.Query, 'SELECT Component.ID FROM COMPONENT, CATALOG_RELATION '+ 'WHERE (ID_CATALOG = '''+IntToStr(AID_SrcCatalog)+''') and '+ '(Component.ID = ID_Component) '+ 'ORDER BY SORT_ID '); Compons := TIntList.Create; IntFIBFieldToIntList(Compons, DM.Query, fnID); for i := 0 to Compons.Count - 1 do begin NewComponID := CopyComponentFromNbToPm(Self, self, nil, NewNode, Compons[i], ckCompon, true); ASrcComponIDs.Add(Compons[i]); ANewComponIDs.Add(NewComponID); end; FreeandNil(Compons); Result := NewNode; CurrTick := GetTickCount; if (CurrTick - LastTick) >= 1000 then begin LastTick := CurrTick; Application.ProcessMessages; //ProcessMessagesEx; end; end; function CopyTreeCatalogs(AID_SrcCatalog: Integer; AParentTrgNode: TTreeNode): TTreeNode; var SrcComponIDs: TIntList; NewComponIDs: TIntList; CompTypeIDs: TIntList; CableChannelIDs: TIntList; CCEIDs: TIntList; CCEOldNBConnectors: TIntList; CCENewNBConnectors: TIntList; CCECountToUpdate: Integer; IndexOfID: Integer; i: Integer; SavedQOperatOptions: TpFIBQueryOptions; begin try SrcComponIDs := TIntList.Create; NewComponIDs := TIntList.Create; Result := CopyTreeCatalog(AID_SrcCatalog, AParentTrgNode, SrcComponIDs, NewComponIDs); if GDBMode = bkNormBase then if NewComponIDs.Count > 0 then begin CompTypeIDs := TIntList.Create; CableChannelIDs := TIntList.Create; CCEIDs := TIntList.Create; CCEOldNBConnectors := TIntList.Create; CCENewNBConnectors := TIntList.Create; // Отбираем все ID типов компонент "Каб канал" CompTypeIDs.Clear; SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponentTypes, fnSysName+' = '''+ctsnCableChannel+'''', nil, fnID)); while Not DM.Query_Select.Eof do begin InsertValueToSortetIntList(DM.Query_Select.Fields[0].AsInteger, CompTypeIDs); DM.Query_Select.Next; end; DM.Query_Select.Close; // Из скопированных компонентов отбираем только каб каналы SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, nil, fnIDComponentType), false); for i := 0 to NewComponIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := NewComponIDs[i]; DM.Query_Select.ExecQuery; if GetValueIndexFromSortedIntList(DM.Query_Select.Fields[0].AsInteger, CompTypeIDs) <> -1 then CableChannelIDs.Add(NewComponIDs[i]); end; // Ищем ЭКК для каждого компонента CCECountToUpdate := 0; SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnCableCanalConnectors, fnIDComponent+' = :'+fnIDComponent, nil, fnID+', '+fnIDNBConnector), false); for i := 0 to CableChannelIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := CableChannelIDs[i]; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin CCEIDs.Add(DM.Query_Select.Fields[0].AsInteger); IndexOfID := SrcComponIDs.IndexOf(DM.Query_Select.Fields[1].AsInteger); if IndexOfID = -1 then CCENewNBConnectors.Add(0) else begin CCENewNBConnectors.Add(NewComponIDs[IndexOfID]); CCECountToUpdate := CCECountToUpdate + 1; end; DM.Query_Select.Next; end; end; DM.Query_Select.Close; if CCECountToUpdate > 0 then begin SavedQOperatOptions := DM.Query_Operat.Options; DM.Query_Operat.Options := DM.Query_Operat.Options - [qoAutoCommit, qoStartTransaction]; try SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnCableCanalConnectors, fnID+' = :'+fnID, nil, fnIDNBConnector), false); DM.Query_Operat.Transaction.StartTransaction; for i := 0 to CCENewNBConnectors.Count - 1 do begin if CCENewNBConnectors[i] <> 0 then begin DM.Query_Operat.Close; DM.Query_Operat.Params[0].AsInteger := CCENewNBConnectors[i]; DM.Query_Operat.Params[1].AsInteger := CCEIDs[i]; DM.Query_Operat.ExecQuery; end; end; DM.Query_Operat.Transaction.Commit; DM.Query_Operat.Close; finally DM.Query_Operat.Options := SavedQOperatOptions; end; end; FreeAndNil(CompTypeIDs); FreeAndNil(CableChannelIDs); FreeAndNil(CCEIDs); FreeAndNil(CCEOldNBConnectors); FreeAndNil(CCENewNBConnectors); end; FreeAndNil(SrcComponIDs); FreeAndNil(NewComponIDs); except on E: Exception do AddExceptionToLogEx('CopyTreeCatalogs', E.Message); end; end; begin try try NewTreeNode := nil; SrcComponent := nil; NewComponent := nil; ProcessMessagesEx; Act_HideHints.Execute; DatS := ASrcDat; if ASrcNode <> nil then DatS := ASrcNode.Data; DatT := ATrgNode.Data; LastTick := GetTickCount; TrgName := ATrgNode.Text; CutColFromStr(TrgName); SrcName := ''; if ASrcNode <> nil then SrcName := ASrcNode.Text; CutColFromStr(SrcName); if ATrgNode <> nil then begin ATrgNode := GetTargetNodeForItemType(ATrgNode, DatS.ItemType, qmUndef); if ATrgNode <> nil then DatT := ATrgNode.Data else MessageModal(cMain_Msg66_1+' "'+SrcName+'" '+cMain_Msg66_2+' "'+TrgName+'"', cMain_Msg65, MB_OK or MB_ICONERROR); end; if DatS.ItemType = itList then begin if GSCSBase.CurrProject.Active then begin if FIsBufferedList then begin BeginProgress; try if (DatT = nil) or (DatT.ItemType = itProject) then SCSCatalog := GSCSBase.CurrProject else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(DatT.ObjectID); IDIndex := GSCSBase.CurrProject.NoSaveListsToFiles.IndexOfByString(GetAnsiTempPath + fnBufferedList); if IDIndex <> -1 then begin SCSList := GSCSBase.CurrProject.GetListByID(GSCSBase.CurrProject.NoSaveListsToFiles.GetIDByIndex(IDIndex)); if SCSList <> nil then if Not SCSList.SaveToStreamOrFile(nil, GSCSBase.CurrProject.NoSaveListsToFiles.GetStringByIndex(IDIndex)) then AddExceptionToLog(cSCSComponent_Msg22_5, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_5); GSCSBase.CurrProject.NoSaveListsToFiles.Delete(IDIndex); end; GSCSBase.CurrProject.AddListFromFile(GetAnsiTempPath + fnBufferedList, true, SCSCatalog); finally EndProgress; end; end; end else MessageModal(CNoExistsActiveProject, ApplicationName, MB_ICONINFORMATION or MB_OK); end else begin if Not Assigned(ASrcNode) then begin ShowMessageByType(0, smtDisplay, cMain_Msg63, Application.Title, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; //GTNode := Tree_Catalog.Selected; //GTNode := GetTargetNodeForItemType(GTNode, PObjectData(SrcNode.Data).ItemType); //******** Проверки на возможность вставки if ATrgNode = nil then Exit; ///// EXIT //// DefineChildNodes(ATrgNode); TrgName := ATrgNode.Text; CutColFromStr(TrgName); SrcName := ASrcNode.Text; CutColFromStr(SrcName); if HaveNodeSub(ASrcNode, ATrgNode) then begin MessageModal(cMain_Msg64_1+' "'+SrcName+'"' + cMain_Msg64_2+' "'+TrgName+'"', cMain_Msg65, MB_OK or MB_ICONERROR); Tree_Catalog.SetFocus; Exit; //// EXIT //// end; if Not CanParantNodeHaveChildItemInTreeView(ATrgNode, PObjectData(ASrcNode.Data).ItemType, qmUndef) then begin MessageModal(cMain_Msg66_1+' "'+SrcName+'" '+cMain_Msg66_2+' "'+TrgName+'"', cMain_Msg65, MB_OK or MB_ICONERROR); Tree_Catalog.SetFocus; Exit; //// EXIT //// end; //Tolik // показать форму прогресcа (обязательно) BeginProgress(cProgress_Mes1, -1, true); //BeginProgress; // case AEditKind of ekCopy: begin //if DatT.ItemType in [itComponLine, itComponCon] then // GTNode := GTNode.Parent; //IDNode := DatS.ObjectID; KolDir := 0; KolCompon := 0; case DatS.ItemType of itDir, itProject, itRoom, itSCSLine,itSCSConnector: begin NewTreeNode := CopyTreeCatalogs(DatS.ObjectID, ATrgNode); end; itComponLine, itComponCon: begin //*** Если цель не компонент, а папка if Not (DatT.ItemType in [itComponLine, itComponCon]) then begin case GDBMode of bkNormBase: begin DatPS := ASrcNode.Parent.Data; NewID := CopyComponentFromNbToPm(Self, Self, ASrcNode, ATrgNode, DatS.ObjectID, ckCompon, true); NewTreeNode := FindComponOrDirInTree(NewID, true); NewDat := NewTreeNode.Data; end; bkProjectManager: begin // UNDO SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); NewID := CopyComponentFromNbToPm(Self, self, nil, ATrgNode, DatS.ObjectID, ckCompon, true); Node := FindComponOrDirInTree(NewID, true); if Node <> nil then NewTreeNode := Node; NewComponent := GSCSBase.CurrProject.GetComponentFromReferences(NewID); if Assigned(NewComponent) then begin if NewComponent.IsLine = biTrue then AutoConnectOnAppendCable(NewComponent.ListID, NewComponent.GetFirstParentCatalog.SCSID); F_ChoiceConnectSide.DefineObjectParamsInFuture(NewComponent.GetFirstParentCatalog); end; end; end; FillCompl(PObjectData(NewTreeNode.Data).ObjectID, NewTreeNode, nil); end else //Если цель компонент, то добавить комплектующую begin if GDBMode = bkNormBase then begin SrcComponent := TSCSComponent.Create(Self); SrcComponent.LoadComponentByID(DatS.ObjectID); end else if GDBMode = bkProjectManager then SrcComponent := GSCSBase.CurrProject.GetComponentFromReferences(DatS.ObjectID); if SrcComponent <> nil then begin PauseProgress(true); try AddComplect(Self, ASrcNode, ATrgNode, SrcComponent, cntComplect, 1, false); finally PauseProgress(false); end; if GDBMode = bkNormBase then FreeAndNil(SrcComponent); end; //Act_DropTreeCopy.Execute; end; end; end; if NewTreeNode <> nil then begin NewTreeNode.Expanded := false; Tree_Catalog.Selected := NewTreeNode; SortByVetv(ATrgNode); //Tree_Catalog.Selected := NewTreeNode; SetSortID(NewTreeNode, nil); //SetKol(NewTreeNode, nil); //SetKol(GTNode, nil); end; end; ekCut: begin //*** Если в НБ перемещается компонент в компонент, то переместить еего в папку if DatT.ItemType in [itComponLine, itComponCon] then if GDBMode = bkNormBase then begin ATrgNode := GetTargetNodeForItemType(ATrgNode, itDir, qmUndef); if ATrgNode <> nil then DatT := ATrgNode.Data; end; if ATrgNode <> nil then begin PauseProgress(true); try Act_MoveDir.Execute; // Перемещение и перещет количества finally PauseProgress(false); end; DatS := ASrcNode.Data; //GSNode.ImageIndex := GetNodeImageIndex(DatS.ItemType, ekNone, DatS.ObjectID); SetNodeState(ASrcNode, DatS.ItemType, ekNone); GEditKind := ekCopy; SortByVetv(ATrgNode); SetSortID(ASrcNode, nil); Tree_Catalog.Selected := ASrcNode; end; end; end; Tree_CatalogChange(Self, Tree_Catalog.Selected); Tree_Catalog.SetFocus; end; except case GEditKind of ekCopy : MessageModal(cMain_Msg67, cMain_Msg65, MB_OK or MB_ICONERROR); ekCut : MessageModal(cMain_Msg68, cMain_Msg65, MB_OK or MB_ICONERROR); end; end; finally EndProgress; end; end; procedure TF_MAIN.MoveNodeTo(ASrcNode, ADestNode: TTreeNode; AMode: TNodeAttachMode); var SaveExpanding: TTVExpandingEvent; TopItem: TTreeNode; // Tolik -- 25/05/2017 -- (* Procedure DropChildComponsNodes(aParentNode: TTreeNode); var i: Integer; ChildNode: TTreeNode; currCatalog: TSCSCatalog; currCompon: TSCSComponent; child_of_childNode: TTreeNode; begin if aParentNode <> nil then begin if aParentNode.HasChildren then begin ChildNode := aParentNode.getFirstChild; if ChildNode = nil then begin ChildNode := aParentNode.getFirstChild; end; if ChildNode <> nil then begin while ChildNode <> nil do begin case PobjectData(ChildNode.data).ItemType of itDir, itSCSLine, itSCSConnector: begin currCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(PObjectData(ChildNode.data).ObjectID); if currCatalog <> nil then currCatalog.TreeViewNode := nil; end; itComponLine, itComponCon: begin currCompon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(PObjectData(ChildNode.data).ObjectID); if currCompon <> nil then currCompon.TreeViewNode := nil; end; end; DropChildComponsNodes(ChildNode); ChildNode := ChildNode.getNextSibling; end; end; end; end; end; *) Procedure DropChildComponsNodes(aParentNode: TTreeNode); var i: Integer; NodeCatalog: TSCSCatalog; ChildCatalog: TSCSCatalog; Node: TTreeNode; begin if PObjectData(aParentNode.Data).ItemType in [itDir, itSCSLine, itSCSConnector] then begin NodeCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(aParentNode.Data).ObjectID); if NodeCatalog <> nil then begin for i := 0 to NodeCatalog.ComponentReferences.Count - 1 do begin Node := FindTreeNodeByDat(NodeCatalog.ComponentReferences[i].Id, [NodeCatalog.ComponentReferences[i].GetItemType], aSRCNode); NodeCatalog.ComponentReferences[i].TreeViewNode := nil; end; for i := 0 to NodeCatalog.ChildCatalogReferences.Count - 1 do begin ChildCatalog := NodeCatalog.ChildCatalogReferences[i]; ChildCatalog.TreeViewNode := nil; end; end; end; end; Procedure FillComponsNodesValues(aParentNode: TTreeNode; ParentCompon :TSCSComponent = nil); var I, j: Integer; ParentCatalog: TSCSCatalog; ChildComponent: TSCSComponent; ChildCatalog: TSCSCatalog; ComponTreeNode: TTreeNode; CatalogTreeNode: TTreeNode; childNode: TTreeNode; begin if aParentNode = nil then Exit; if aParentNode.HasChildren then begin ChildNode := AParentNode.GetFirstChild; while ChildNode <> nil do begin if PObjectData(ChildNode).ItemType in [itDir, itSCSLine, itSCSConnector] then begin ChildCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(ChildNode.data).ObjectID); if ChildCatalog <> nil then ChildCatalog.TreeViewNode := ChildNode; end else begin if PObjectData(ChildNode.Data).ItemType in [itComponLine, itComponCon] then begin ChildComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ChildNode.data).ObjectID); if ChildComponent <> nil then ChildComponent.TreeViewNode := ChildNode; end; end; if ChildNode.HasChildren then FillComponsNodesValues(ChildNode, nil); ChildNode := ChildNode.GetNextSibling; end; end; end; // begin if (AMode = naAddChild) or (AMode = naAddChildFirst) then DefineChildNodes(ADestNode); SaveExpanding := nil; if ASrcNode.TreeView <> nil then if ASrcNode.TreeView is TTreeView then begin //SaveExpanding := TTreeView(ASrcNode.TreeView).OnExpanding; //TTreeView(ASrcNode.TreeView).OnExpanding := nil end; // DropChildComponsNodes(ASrcNode); try TopItem := ASrcNode.TreeView.TopItem; ASrcNode.MoveTo(ADestNode, AMode); finally if Assigned(SaveExpanding) then TTreeView(ASrcNode.TreeView).OnExpanding := SaveExpanding; //if (TopItem <> nil) and (ASrcNode.TreeView.TopItem <> TopItem) then // ASrcNode.TreeView.TopItem := TopItem; end; // Tolik -- 26/05/2017 -- MoveTo может в некоторых случаях похерить связи узлов // дерева с объектами передвигаемого узла поэтому после перемещения узла // здесь выполнено восстановлени связей, иначе по клику не фигурке иногда не // будет отображаться соответствующий узел в ПМ if GGDBMode = bkprojectManager then begin F_ProjMan.Tree_Catalog.Items.BeginUpdate; ASrcNode.Expand(True); try FillComponsNodesValues(ASrcNode); except on E: Exception do AddExceptionToLog('TF_MAIN.MoveNodeTo: '+E.Message); end; ASrcNode.Collapse(True); F_ProjMan.Tree_Catalog.Items.EndUpdate; end; // end; function TF_MAIN.GetComponentFromNode(ANode: TTreeNode): TSCSComponent; var //CurrNode: TTreeNode; NodeDat: PObjectData; //SCSCable: TSCSComponent; begin Result := nil; //SCSCable := nil; //CurrNode := Tree_Catalog.Selected; if (ANode <> nil) and (ANode.Data <> nil) then begin NodeDat := ANode.Data; if IsComponItemType(NodeDat.ItemType) then //17.01.2012 if NodeDat.ItemType = itComponLine then begin if GDBMode = bkNormBase then begin Result := TSCSComponent.Create(Self); Result.LoadComponentByID(NodeDat.ObjectID); end else if GDBMode = bkProjectManager then Result := GSCSBase.CurrProject.GetComponentFromReferences(NodeDat.ObjectID); end; end; end; function TF_MAIN.GetActualSelectedComponent: TSCSComponent; begin Result := nil; if GDBMode = bkNormBase then begin if GSCSBase.SCSComponent.ID > 0 then Result := GSCSBase.SCSComponent; end else Result := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); end; function TF_MAIN.GetActualSelectedCatalog: TSCSCatalog; begin Result := nil; if GDBMode = bkNormBase then begin if GSCSBase.SCSCatalog.ID > 0 then Result := GSCSBase.SCSCatalog; end else begin if GSCSBase.CurrProject.ID = GSCSBase.SCSCatalog.ID then Result := GSCSBase.CurrProject else Result := GSCSBase.CurrProject.GetCatalogFromReferences(GSCSBase.SCSCatalog.ID); end; end; function TF_MAIN.GetActualSelectedObj: TSCSComponCatalogClass; begin Result := GetActualSelectedComponent; if Result = nil then Result := GetActualSelectedCatalog; end; function TF_MAIN.SelectComponByGUIDInTree(AGUIDComponent: String): TTreeNode; var IDComponent: Integer; begin Result := nil; IDComponent := -1; if GDBMode = bkNormBase then IDComponent := DM.GetIntFromTable(tnComponent, fnID, fnGUID, AGUIDComponent, qmPhisical); if IDComponent <> -1 then Result := SelectComponByIDInTree(IDComponent); end; function TF_MAIN.SelectComponByIDInTree(AIDComponent: Integer): TTreeNode; var ComponNode: TTreeNode; begin ComponNode := FindComponOrDirInTree(AIDComponent, true); if ComponNode <> nil then begin if pcObjects.ActivePage <> tsComponents then SetpcObjectsTab(tsComponents.TabIndex); //pcObjects.ActivePage := tsComponents; if pcObjects.ActivePage = tsComponents then begin //Tree_Catalog.Selected := ComponNode; SelectNodeDirect(ComponNode); if GDBMode = bkProjectManager then SwitchInCAD(ComponNode, ccOne); end; end; Result := ComponNode; end; function TF_MAIN.SelectObjByIDInTree(AIDObj: Integer): TTreeNode; var Node: TTreeNode; begin Node := FindComponOrDirInTree(AIDObj, false); if Node <> nil then begin if pcObjects.ActivePage <> tsComponents then SetpcObjectsTab(tsComponents.TabIndex); //pcObjects.ActivePage := tsComponents; if pcObjects.ActivePage = tsComponents then begin SelectNodeDirect(Node); if GDBMode = bkProjectManager then SwitchInCAD(Node, ccOne); end; end; Result := Node; end; function TF_MAIN.FindComponentByGUIDWithBlink(AGUIDComponent: String): TTreeNode; const BlinkCount = 3; SleepInterval = 250; var IDNBComponent: Integer; Node: TTreeNode; SavedOnChanged: TTVChangedEvent; i: Integer; begin Result := nil; if GDBMode = bkNormBase then begin if (Timer_TreeCatalogChange.Tag <> 0) or (not assigned(Tree_Catalog.OnChange)) then begin Result := nil; exit; end; ProcessMessagesEx; IDNBComponent := DM.GetIntFromTable(tnComponent, fnID, fnGUID, AGUIDComponent, qmPhisical); if IDNBComponent > 0 then begin Node := FindComponOrDirInTree(IDNBComponent, true); if Node <> nil then begin Result := Node; Tree_Catalog.Selected := Node; // IGOR Timer_TreeCatalogChangeTimer(nil); //WaitForTVChange; ShowSelectedNode(Tree_Catalog); SavedOnChanged := Tree_Catalog.OnChange; Tree_Catalog.OnChange := nil; // IGOR Timer_TreeCatalogChange.Tag := 999; try for i := 0 to BlinkCount - 1 do begin Tree_Catalog.Selected := nil; Sleep(SleepInterval); ProcessMessagesEx; Tree_Catalog.Selected := Node; Sleep(SleepInterval); ProcessMessagesEx; end; finally // IGOR Timer_TreeCatalogChange.Tag := 0; Tree_Catalog.OnChange := SavedOnChanged; end; end; end end; end; // ##### Загрузить название валют ##### procedure TF_MAIN.LoadCurrencyFormat; var DisplayFormatBaseCurrency: String; begin {DisplayFormatBaseCurrency := GetDisplayFormat(GCurrency.NameBrief); CurrencyEdit_Cost1.Properties.DisplayFormat := DisplayFormatBaseCurrency; CurrencyEdit_Cost2.Properties.DisplayFormat := GetDisplayFormat(GSCurrency.NameBrief); CurrencyEdit_Price1.Properties.DisplayFormat := CurrencyEdit_Cost1.Properties.DisplayFormat; CurrencyEdit_Price2.Properties.DisplayFormat := CurrencyEdit_Cost2.Properties.DisplayFormat; //*** Загрузить формат валют для норм и ресурсов with F_Norms do begin CurrencyEdit_ResourcesCost.Properties.DisplayFormat := DisplayFormatBaseCurrency; EditRepository_NormCurrency_NormCost.Properties.DisplayFormat := DisplayFormatBaseCurrency; EditRepository_NormCurrency_NormTotalCost.Properties.DisplayFormat := DisplayFormatBaseCurrency; EditRepository_NormCurrency_ResourcePrice.Properties.DisplayFormat := DisplayFormatBaseCurrency; EditRepository_NormCurrency_ResourceCost.Properties.DisplayFormat := DisplayFormatBaseCurrency; end; } end; // ##### Добавить интерфейс/порт ##### procedure TF_MAIN.AddInterfacePort(AIsPort: Integer); var ID_InterfRel: Integer; meInterfaceRel: TmeInterfaceRel; MakeEdit: TMakeEdit; SCSComponent: TSCSComponent; begin MakeEdit := meMake; ZeroMemory(@meInterfaceRel, SizeOf(TmeInterfaceRel)); meInterfaceRel.ID := GetLastInterfRelID(GDBMode) + 1; meInterfaceRel.ID_COMPONENT := GSCSBase.SCSComponent.ID; meInterfaceRel.IsPort := AIsPort; meInterfaceRel.IsLineCompon := GSCSBase.SCSComponent.IsLine; //if meInterfaceRel.IsPort = biTrue then begin meInterfaceRel.mtInterfaces := DM.MemTable_InterfaceRel; meInterfaceRel.mtPorts := DM.MemTable_Port; meInterfaceRel.mtPortInterfRel := DM.MemTable_PortInterfRel; meInterfaceRel.ServiceShowApplyForAllNoRelPorts := false; end; meInterfaceRel.mtInterfInternalConnect := DM.mtInterfInternalConn; if CreateFAddInterface.GetInterfRel(meInterfaceRel, fmMake) then begin meInterfaceRel.ID_COMPONENT := GSCSBase.SCSComponent.ID; //Grid_CompData.BeginUpdate; DM.MakeEditInterfRel(meInterfaceRel, MakeEdit); if AIsPort = biTrue then //*** Переопределить количества на интерфейсах DM.UpdateInterfacesFromMemTable(DM.MemTable_InterfaceRel, DM.DataSource_MT_InterfaceRel); //29.06.2013 SCSComponent := GetActualSelectedComponent; if SCSComponent <> nil then SCSComponent.ApplyChanges; GSCSBase.SCSComponent.NotifyChange; EnableEditDel(itAuto); //Grid_CompData.EndUpdate; end; end; // ##### Редактировать интерфейс/порт ##### procedure TF_MAIN.EditInterfacePort(AIsPort: Integer); var MemTable_InterfOrPort: TkbmMemTable; DataSource_InterfOrPort: TDataSource; //ID_InterfRel: Integer; meInterfaceRel: TmeInterfaceRel; MakeEdit: TMakeEdit; QueryMode: TQueryMode; //IDAdverse: Integer; //NumPair: Integer; Interf: TSCSInterface; i: Integer; SCSComponent: TSCSComponent; ReadOnlyMode: Boolean; begin try MemTable_InterfOrPort := nil; DataSource_InterfOrPort := nil; SCSComponent := GetActualSelectedComponent; //if (GDBMode = bkProjectManager) and (AIsPort = biFalse) then // Exit; ///// EXIT ///// case AIsPort of biTrue: begin MemTable_InterfOrPort := DM.MemTable_Port; DataSource_InterfOrPort := DM.DataSource_MT_Port; end; biFalse: begin MemTable_InterfOrPort := DM.MemTable_InterfaceRel; DataSource_InterfOrPort := DM.DataSource_MT_InterfaceRel; end; end; if (MemTable_InterfOrPort = nil) or (MemTable_InterfOrPort.Active = false) or (MemTable_InterfOrPort.RecordCount = 0) or (DataSource_InterfOrPort = nil) then Exit; ///// EXIT ///// //ID_InterfRel := MemTable_InterfOrPort.FieldByName('id').AsInteger; //IDAdverse := MemTable_InterfOrPort.FieldByName('id_adverse').AsInteger; //NumPair := MemTable_InterfOrPort.FieldByName('Num_Pair').AsInteger; ReadOnlyMode := false; if IsUseInterfRelInMemTable(TForm(Self), MemTable_InterfOrPort, meEdit, false) then ReadOnlyMode := true; //Exit; ///// EXIT ///// if AIsPort = biFalse then if IsUseInterfRelInPortInterfRels(DM.MemTable_InterfaceRel, DM.MemTable_PortInterfRel, meEdit, false) then ReadOnlyMode := true; //Exit; ///// EXIT ///// if ReadOnlyMode then MessageModal(CReadOnlyInterface, ApplicationName, MB_ICONINFORMATION or MB_OK); MakeEdit := meEdit; meInterfaceRel.IsPort := AIsPort; meInterfaceRel := DM.GetInterfaceRel(DataSource_InterfOrPort, nil); meInterfaceRel.IsLineCompon := GSCSBase.SCSComponent.IsLine; meInterfaceRel.ID_COMPONENT := GSCSBase.SCSComponent.ID; if meInterfaceRel.IsPort = biTrue then begin meInterfaceRel.mtPorts := DM.MemTable_Port; meInterfaceRel.mtPortInterfRel := DM.MemTable_PortInterfRel; meInterfaceRel.ServiceShowApplyForAllNoRelPorts := false; end; meInterfaceRel.mtInterfaces := DM.MemTable_InterfaceRel; meInterfaceRel.mtInterfInternalConnect := DM.mtInterfInternalConn; if CreateFAddInterface.GetInterfRel(meInterfaceRel, fmEdit, ReadOnlyMode) then begin QueryMode := GetQueryModeByGDBMode(GDBMode); //*** Убрать с объекта порта удалленые связи с интерфейсами case GDBMode of bkNormBase: DM.DeleteRecordsByIDList(tnPortInterfaceRelation, F_AddInterface.GDeletedPortInterfRelIDs, QueryMode); bkProjectManager: begin Interf := GSCSBase.CurrProject.CurrList.GetInterfaceByIDAndIDComponent(meInterfaceRel.ID, meInterfaceRel.ID_COMPONENT); if Assigned(Interf) then for i := 0 to F_AddInterface.GDeletedPortInterfRelIDs.Count - 1 do Interf.RemovePortInterfRelByID(F_AddInterface.GDeletedPortInterfRelIDs[i]); end end; DM.MakeEditInterfRel(meInterfaceRel, MakeEdit); //if AIsPort = biTrue then //*** Переопределить количества на интерфейсах DM.UpdateInterfacesFromMemTable(DM.MemTable_InterfaceRel, DM.DataSource_MT_InterfaceRel); //if GDBMode = bkProjectManafger then if meInterfaceRel.TYPEI = itFunctional then ShowMessageAboutCheckCableCanalElemnts(SCSComponent.GetNameForVisible, SCSComponent.CableCanalConnectors.Count) else if meInterfaceRel.TYPEI = itConstructive then begin //*** Учитывать подкл-й кросс к кабелю F_ChoiceConnectSide.DefineJoinedTrunkAfterChangeInFuture(SCSComponent); end; {//20.08.2012 - перенесено в DM.MakeEditInterfRel if AIsPort = biTrue then if GDBMode = bkProjectManager then RemarkComponAfterChangePort(SCSComponent);} //29.06.2013 if SCSComponent <> nil then SCSComponent.ApplyChanges; GSCSBase.SCSComponent.NotifyChange; { if GDBMode = bkProjectManager then begin Interf := GSCSBase.CurrProject.CurrList.GetInterfaceByIDAndIDComponent(meInterfaceRel.ID, meInterfaceRel.ID_COMPONENT); if Assigned(Interf) then begin Interf.LoadPortInterfaces; end; end;} end; except on E: Exception do AddExceptionToLog('TF_MAIN.EditInterfacePort: '+E.Message); end; end; // ##### Удалить интерфейс/порт ##### procedure TF_MAIN.DelInterfacePort(AIsPort: Integer); var MemTable_InterfOrPort: TkbmMemTable; SubstanceName: String; ComponName: String; InterfName: String; IDInterfRel: Integer; InterfType: Integer; //IDAdverse: Integer; NumPair: Integer; CanDel: Boolean; IDComponent: Integer; SCSComponent: TSCSComponent; DeletedInterfIDs: TIntList; InterfRelIDsForKolvo: TIntList; InterfRelKolvosForKolvo: TIntList; RecNo: Integer; i, j: integer; begin CanDel := false; MemTable_InterfOrPort := nil; SCSComponent := nil; { //GT_Port.DataController.GetItemByFieldName(fnID).i //GT_Port.DataController.ItemCount for i := 0 to GT_Port.Controller.SelectedRowCount - 1 do for j := 0 to GT_Port.Controller.SelectedRecords[i].ValueCount - 1 do begin GT_Port.Controller.SelectedRecords[i].Values[j]; //GT_Port.Controller.SelectedRecords[i]. GT_Port.DataController.GetItemByFieldName(fnID); //GT_Port.DataController.GetItemField(j); //GT_Port.DataController.GetItemField(j).DisplayName; GT_Port.DataController.GetItemFieldName(j); //GT_Port.GetColumnByFieldName(fnID); end; } //GT_Port.Controller.SelectedRecords[0].Values[GT_Port.GetColumnByFieldName(fnID).Index] DataController.get GetSelectedRowIndex InterfRelIDsForKolvo := nil; InterfRelKolvosForKolvo := nil; case AIsPort of biTrue: begin MemTable_InterfOrPort := DM.MemTable_Port; SubstanceName := cNamePort; end; biFalse: begin MemTable_InterfOrPort := DM.MemTable_InterfaceRel; SubstanceName := cNameInterface; end; end; if MemTable_InterfOrPort = nil then Exit; ///// EXIT ///// IDInterfRel := MemTable_InterfOrPort.FieldByName('Id').AsInteger; //IDAdverse := DM.MemTable_InterfaceRel.FieldByName('Id_Adverse').AsInteger; IDComponent := MemTable_InterfOrPort.FieldByName(fnIDComponent).AsInteger; NumPair := 0; if AIsPort = biFalse then NumPair := MemTable_InterfOrPort.FieldByName('Num_Pair').AsInteger; if IsUseInterfRelInMemTable(TForm(Self), MemTable_InterfOrPort, meDel, true) then Exit; //*** Если удаляется интерфейс, то проверить, не используется ли он в связях с портами if AIsPort = biFalse then if IsUseInterfRelInPortInterfRels(DM.MemTable_InterfaceRel, DM.MemTable_PortInterfRel, meDel, true) then Exit; ///// EXIT ///// InterfName := MemTable_InterfOrPort.FieldByName('Name').AsString; InterfType := MemTable_InterfOrPort.FieldByName(fnTypeI).AsInteger; if MessageModal(cMain_Msg1_1+' '+SubstanceName+' "' + InterfName +'" ?', cMain_Msg1_2+' '+SubstanceName+cSufixA, MB_YESNO or MB_ICONQUESTION) = IDYES then with DM do begin if GSCSBase.SCSComponent.ISComplect = biTrue then begin ComponName := GSCSBase.SCSComponent.Name; if MemTable_InterfOrPort.FieldByName(fnTypeI).AsInteger = itConstructive then begin if MessageModal(cMain_Msg2_1+' ' + ComponName + ' '+cMain_Msg2_2+ #13 + cMain_Msg2_3+' '+SubstanceName+cSufixA+' '+cMain_Msg2_4+'.' + #13+#13+ cMain_Msg2_5+' '+SubstanceName+' "' + InterfName +'" ?' , cMain_Msg2_6+' '+SubstanceName+cSufixA, MB_OKCANCEL or MB_ICONQUESTION) = IDOK then CanDel := true; end else CanDel := true; end else CanDel := true; if CanDel then begin RecNo := DM.MemTable_InterfaceRel.RecNo; DeletedInterfIDs := TIntList.Create; if AIsPort = biTrue then begin InterfRelIDsForKolvo := TIntList.Create; InterfRelKolvosForKolvo := TIntList.Create; DM.DefineInterfRelIDsForKolvo(false, InterfRelIDsForKolvo, InterfRelKolvosForKolvo, DM.MemTable_PortInterfRel); DM.DefineInterfacesKolvoByPortKolvo(0, DM.MemTable_PortInterfRel, DM.MemTable_InterfaceRel, InterfRelIDsForKolvo, InterfRelKolvosForKolvo); DM.UpdateInterfacesFromMemTable(DM.MemTable_InterfaceRel, DM.DataSource_MT_InterfaceRel); end; if GDBMode = bkProjectManager then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDComponent); ////*** Обновить магистраль // if MemTable_InterfOrPort.FieldByName(fnTypeI).AsInteger = itFunctional then // F_ChoiceConnectSide.DefineComponTrunkChangedInterfacesInFuture(SCSComponent, false); end; if GDBMode = bkNormBase then SCSComponent := GSCSBase.SCSComponent; if NumPair = 0 then begin if GDBMode = bkNormBase then DM.DeleteInterfRelByID(IDInterfRel); MemTable_InterfOrPort.Delete; if Assigned(SCSComponent) then SCSComponent.FreeInterfaceByID(IDInterfRel); DeletedInterfIDs.Add(IDInterfRel); end else begin if GDBMode = bkNormBase then DM.DeleteInterfRelByFilter('(id_component = '''+IntToStr(GSCSBase.SCSComponent.ID)+''') and '+ '(num_pair = '''+IntToStr(NumPair)+''') '); if Assigned(SCSComponent) then SCSComponent.FreeInterfacesByNumPair(NumPair); //DM.FillMemTableInterfRel(GSCSBase.SCSComponent, TRee_Catalog.Selected, AIsPort); //*** Очистить MemTable_InterfOrPort.Last; while not MemTable_InterfOrPort.Bof do begin if MemTable_InterfOrPort.FieldByName(fnNumPair).AsInteger = NumPair then begin if MemTable_InterfOrPort.FieldByName(fnIsNative).AsBoolean = true then DeletedInterfIDs.Add(MemTable_InterfOrPort.FieldByName(fnID).AsInteger); MemTable_InterfOrPort.Delete; end else MemTable_InterfOrPort.Prior; end; //*** Переопределить номера пар интерфейсов DM.DefineInterfaceNumPairs(MemTable_InterfOrPort, nil); DM.UpdateInterfacesFromMemTable(MemTable_InterfOrPort, DM.DataSource_MT_InterfaceRel); //*** Обновить изменения DM.FillMemTableInterfRel(GSCSBase.SCSComponent, TRee_Catalog.Selected, AIsPort); end; if AIsPort = biTrue then begin //20.08.2012 if Assigned(SCSComponent) then //20.08.2012 DefineComponNppPortsByPortMultiport(SCSComponent); //SelectPorts(Tree_Catalog.Selected); end; //*** Очистить междуинтерфейсную связь DM.DeleteInterfInternalConnFromMTByInterfIDs(DM.mtInterfInternalConn, DeletedInterfIDs); if InterfType = itFunctional then ShowMessageAboutCheckCableCanalElemnts(SCSComponent.GetNameForVisible, SCSComponent.CableCanalConnectors.Count); FreeAndNil(DeletedInterfIDs); //20.08.2012 - Учесть в маркировке компонента if Assigned(SCSComponent) then begin if GDBMode = bkProjectManager then if AIsPort = biTrue then RemarkComponAfterChangePort(SCSComponent); SCSComponent.ApplyChanges; //29.06.2013 end; end; GSCSBase.SCSComponent.NotifyChange; EnableEditDel(itAuto); if InterfRelIDsForKolvo <> nil then FreeAndNil(InterfRelIDsForKolvo); if InterfRelKolvosForKolvo <> nil then FreeAndNil(InterfRelKolvosForKolvo); end; end; // ##### Показать цену ##### procedure TF_MAIN.ShowPrice; var Price: Double; PriceCalc: Double; begin Price := GSCSBase.SCSComponent.Price; PriceCalc := GSCSBase.SCSComponent.PRICE_CALC; if GDBMode = bkNormBase then PriceCalc := GetComponPrice(GSCSBase.SCSComponent.ID, GSCSBase.SCSComponent.IDCompRel, GSCSBase.SCSComponent.IDTopComponent); if CheckPriceTransformToUOMByCompType(@GSCSBase.SCSComponent.ComponentType) then begin Price := FloatInUOM(Price, FUOM, umMetr); PriceCalc := FloatInUOM(PriceCalc, FUOM, umMetr); end; CurrencyEdit_Cost1.Value := RoundCP(PriceCalc); CurrencyEdit_Cost2.Value := GetPriceAfterChangeCurrency(PriceCalc, GLocalCurrencyM.Data, GLocalCurrencyS.Data); //CurrencyEdit_Cost1.Value := Round3(GSCSBase.SCSComponent.PRICE_CALC); //CurrencyEdit_Cost2.Value := GetPriceAfterChangeCurrency(GSCSBase.SCSComponent.PRICE_CALC, GLocalCurrencyM.Data, GLocalCurrencyS.Data); //*** Вывод цены CurrencyEdit_Price1.Value := RoundCP(Price); CurrencyEdit_Price2.Value := GetPriceAfterChangeCurrency(Price, GLocalCurrencyM.Data, GLocalCurrencyS.Data, 10); end; procedure TF_MAIN.SetPriceCostPanel; var VisiblePanel: Boolean; begin VisiblePanel := true; if GUseArhOnlyMode then VisiblePanel := false else begin if (GSCSBase <> nil) and (GSCSBase.SCSComponent <> nil) and IsArchComponByIsLine(GSCSBase.SCSComponent.IsLine) then VisiblePanel := false else if (pcObjects.ActivePage = tsTemplates) and (FTemplateGrp <> nil) and IsGraphModTemplate(FTemplateGrp.FType) then VisiblePanel := false; end; PageScroller_Cost.Visible := VisiblePanel; end; // ##### Разрешить / запретить перетасквание Панелей ##### procedure TF_MAIN.EnableDragPanels; begin if (Not Panel_Tree.Visible) or (Not Panel_Addition.Visible) then begin Panel_Tree.DragMode := dmManual; Panel_Addition.DragMode := dmManual; end else begin Panel_Tree.DragMode := dmAutomatic; Panel_Addition.DragMode := dmAutomatic; end; end; // ##### Разрешает / запрещает действия с компонентами по умолчанию ##### procedure TF_MAIN.EnableDisableActsWithDefCompons; var DefEnabled: Boolean; begin //*** Для линейного компоненты по умолчанию {if GDefaultLineCompon > 0 then begin Act_DropDefLineCompon.Enabled := false; Act_TurnToDefLineCompon.Enabled := false; end else begin Act_DropDefLineCompon.Enabled := true; Act_TurnToDefLineCompon.Enabled := true; end; //*** Для точечного компоненты по умолчанию if GDefaultNoLineCompon > 0 then begin Act_DropDefNoLineCompon.Enabled := false; Act_TurnToDefNoLineCompon.Enabled := false; end else begin Act_DropDefNoLineCompon.Enabled := true; Act_TurnToDefNoLineCompon.Enabled := true; end; } end; // ##### Разрешить Вставку ##### procedure TF_MAIN.EnablePaste; begin if GEditKind <> ekNone then Act_PasteDir.Enabled := true else Act_PasteDir.Enabled := false; end; // ##### Разрешить / Запретить обшее редактирование ##### procedure TF_MAIN.EnableDisableEdit(AEnabled: Boolean); begin //if (GDBMode = bkNormBase) and (GFormMode = fmNormal) then // GSCSIni.NB.DisableEdit := Not AEnabled; Tree_Catalog.ReadOnly := Not AEnabled; Act_ApplyComponForProjResources.Enabled := AEnabled; Act_ApplyComponForListResources.Enabled := AEnabled; Act_AutoSetGraphicObjects.Enabled := AEnabled; Act_IndexingComponPrice.Enabled := AEnabled; Act_ChangeComponArtProducerByTemplate.Enabled := AEnabled; Act_TraceLineComponlBySelectedLines.Enabled := AEnabled; Act_EditTree.Enabled := AEnabled; Act_DelTree.Enabled := AEnabled; Act_CutDir.Enabled := AEnabled; Act_CopyDir.Enabled := AEnabled; Act_PasteDir.Enabled := AEnabled; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false; //Act_PairLineInterfaces.Enabled := AEnabled; Act_ChangeComponArtProducerByTemplate.Enabled := AEnabled; Act_MakeNewitemType.Enabled := AEnabled; Act_MakeDir.Enabled := AEnabled; Act_EditingNode.Enabled := AEnabled; Act_LoadNBNodeFromFile.Enabled := AEnabled; Act_SaveNBNodeToFile.Enabled := AEnabled; Act_ChoiceFind.Enabled := AEnabled; Act_IndexingComponPrice.Enabled := AEnabled; Act_AutoSetGraphicObjects.Enabled := AEnabled; Act_RenameDir.Enabled := AEnabled; Act_DelDir.Enabled := AEnabled; Act_MakeComponent.Enabled := AEnabled; Act_EditComponent.Enabled := AEnabled; Act_DelComponent.Enabled := AEnabled; Act_MasterCompl.Enabled := AEnabled; Act_AddCompRelation.Enabled := AEnabled; Act_EditCompRelation.Enabled := AEnabled; Act_EditComplect.Enabled := AEnabled; Act_DelCompRelation.Enabled := AEnabled; Act_AddInterface.Enabled := AEnabled; Act_EditInterface.Enabled := AEnabled; Act_DelInterface.Enabled := AEnabled; Act_AddPort.Enabled := AEnabled; Act_EditPort.Enabled := AEnabled; Act_DelPort.Enabled := AEnabled; Act_AddProperty.Enabled := AEnabled; Act_EditProperty.Enabled := AEnabled; Act_RemoveProperty.Enabled := AEnabled; SelAllWithSimilarProps.Enabled := AEnabled; Act_AddConnection.Enabled := AEnabled; Act_DelConnection.Enabled := AEnabled; Act_AddCrossConnection.Enabled := AEnabled; Act_EditCrossConnection.Enabled := AEnabled; Act_DelCrossConnection.Enabled := AEnabled; Act_MakeObjectCurrency.Enabled := AEnabled; Act_EditObjectCurrency.Enabled := AEnabled; Act_DelObjectCurrency.Enabled := AEnabled; if AEnabled = true then begin EnableEditDel(itAuto); EnablePaste; end; EnableEditDelTemplate; EnableEditDelComponGroup; { case AEnabled of false: begin Act_EditTree.Enabled := AEnabled; Act_DelTree.Enabled := AEnabled; Act_MakeNewitemType.Enabled := AEnabled; Act_MakeDir.Enabled := AEnabled; Act_RenameDir.Enabled := AEnabled; Act_DelDir.Enabled := AEnabled; Act_MakeComponent.Enabled := AEnabled; Act_EditComponent.Enabled := AEnabled; Act_DelComponent.Enabled := AEnabled; Act_AddCompRelation.Enabled := AEnabled; Act_EditCompRelation.Enabled := AEnabled; Act_DelCompRelation.Enabled := AEnabled; Act_AddInterface.Enabled := AEnabled; Act_EditInterface.Enabled := AEnabled; Act_DelInterface.Enabled := AEnabled; Act_AddProperty.Enabled := AEnabled; Act_EditProperty.Enabled := AEnabled; Act_RemoveProperty.Enabled := AEnabled; Act_CutDir.Enabled := AEnabled; Act_CopyDir.Enabled := AEnabled; Act_PasteDir.Enabled := AEnabled; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false; end; true: begin EnableEditDel(itAuto); EnablePaste; end; end; } end; // ##### Разрешить / Запретить редактирование отдельных таблиц ##### procedure TF_MAIN.EnableEditDel(AViewType: TItemType); var Dat: PObjectData; ParentDat: PObjectData; S: String; ActList: TList; NBMode: TNBMode; ComponKind: TComponKind; IsArchItem: Boolean; procedure EnableDisableAct(AActList: TList; ARecordCount: Integer); var Enabl: Boolean; i: Integer; begin if (ARecordCount = 0) or ((NBMode = nbmNorm) and (Not GSCSIni.NB.IsAdministration)) or (GFormMode <> fmNormal) then Enabl := false else Enabl := true; for i := 0 to AActList.Count - 1 do TAction(AActList.Items[i]).Enabled := Enabl; AActList.Clear; end; begin if (GDBMode = bkNormBase) and (Not CheckWriteNB(false)) then Exit; if GFormMode <> fmNormal then Exit; ///// EXIT ///// ActList := TList.Create; Dat := nil; if AViewType = itAuto then if Tree_Catalog.Selected <> nil then if Tree_Catalog.Selected.Data <> nil then begin S :=Tree_Catalog.Selected.Text; Dat := Tree_Catalog.Selected.Data; AViewType := Dat.ItemType; end; if Tree_Catalog.Selected <> nil then if Tree_Catalog.Selected.Data <> nil then Dat := Tree_Catalog.Selected.Data; ComponKind := ckCompon; NBMode := nbmNorm; if Dat <> nil then begin ComponKind := Dat.ComponKind; NBMode := Dat.NBMode; end; IsArchItem := IsArchComponByItemType(AViewType); {if Tree_Catalog.Selected.AbsoluteIndex = 0 then Tree_Catalog.ReadOnly := true else Tree_Catalog.ReadOnly := false; } Act_MakeNewitemType.Enabled := true; Act_MakeDir.Enabled := true; Act_MakeComponent.Enabled := true; Act_MakeList.Enabled := true; Act_MakeSCSConnector.Enabled := true; Act_MakeSCSLine.Enabled := true; Act_EditingNode.Enabled := true; Act_EditTree.Enabled := true; Act_DelTree.Enabled := true; Act_CutDir.Enabled := true; Act_CopyDir.Enabled := true; Act_CutDir.Visible := Not IsArchItem; Act_CopyDir.Visible := Not IsArchItem; Act_ClearCopyBuf.Visible := Not IsArchItem; Act_IndexingComponPrice.Visible := false; Act_AutoSetGraphicObjects.Visible := false; Act_ApplyComponForProjResources.Enabled := True; Act_ApplyComponForListResources.Enabled := True; Act_LoadNBNodeFromFile.Enabled := True; Act_AutoSetGraphicObjects.Enabled := True; Act_IndexingComponPrice.Enabled := True; Act_ChangeComponArtProducerByTemplate.Enabled := True; Act_MasterCompl.Enabled := True; Act_TraceLineComponlBySelectedLines.Enabled := True; //Act_EditTree.Caption := 'Редактировать'; if GEditKind <> ekNone then begin Act_PasteDir.Enabled := true; Act_ClearCopyBuf.Enabled := true; end else begin Act_PasteDir.Enabled := false; Act_ClearCopyBuf.Enabled := false; end; with DM Do begin //case AViewType of // itDir, itProjMan, itProject, itList, itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup, // itRoom, itSCSLine, itSCSConnector: if IsCatalogItemType(AViewType) or IsSCSGroupItemType(AViewType) then begin // Если позиция на самой верхней ветви ActList.Add(Act_DelTree); ActList.Add(Act_EditingNode); ActList.Add(Act_EditTree); ActList.Add(Act_CutDir); ActList.Add(Act_MoveUP); ActList.Add(Act_MoveDOWN); if Tree_Catalog.Selected.Level = 0 then ActList.Add(Act_CopyDir); EnableDisableAct(ActList, Tree_Catalog.Selected.Level); Act_GoToConnectCompon.Enabled := false; Act_AddCompRelation.Enabled := false; Act_EditCompRelation.Enabled := false; Act_DelCompRelation.Enabled := false; Act_AddConnection.Enabled := false; Act_EditComplect.Enabled := false; Act_DelConnection.Enabled := false; Act_AddCrossConnection.Enabled := false; Act_EditCrossConnection.Enabled := false; Act_DelCrossConnection.Enabled := false; Act_AddProperty.Enabled := false; Act_EditProperty.Enabled := false; Act_RemoveProperty.Enabled := false; Act_AddInterface.Enabled := false; Act_EditInterface.Enabled := false; Act_DelInterface.Enabled := false; Act_AddPort.Enabled := false; Act_EditPort.Enabled := false; Act_DelPort.Enabled := false; Act_AddCableChannelElement.Enabled := false; Act_EditCableChannelElement.Enabled := false; Act_DelCableChannelElement.Enabled := false; //Tolik 13/11/2021 -- Act_AddTubeElement.Enabled := false; Act_EditTubeElement.Enabled := false; Act_DelTubeElement.Enabled := false; // Act_MakeNorm.Enabled := false; Act_MakeResource.Enabled := false; Act_MakeResourceCompon.Enabled := false; Act_EditNormResource.Enabled := false; Act_DelNormResource.Enabled := false; Act_MakeObjectCurrency.Enabled := false; Act_EditObjectCurrency.Enabled := false; Act_DelObjectCurrency.Enabled := false; DM.ClearMemTableCompl; if GDBMode = bkProjectManager then begin //Act_MakeP //Act_ApplyComponForProjResources.Visible := false; //Act_ApplyComponForListResources.Visible := false; Act_MakeList.Visible := false; Act_MakeRoom.Visible := false; Act_MakeDir.Visible := false; Act_MakeList.Enabled := false; Act_MakeRoom.Enabled := false; Act_MakeDir.Enabled := false; { Act_OpenProject.Visible := false; Act_OpenProject.Enabled := false; Act_CloseProject.Visible := false; Act_CloseProject.Enabled := false; Act_SaveProjectToFile.Visible := false; Act_SaveProjectToFile.Enabled := false; } Act_SaveProjectFromNodeToFile.Visible := false; EnableDisableListActions(false); if (AViewType = itProject) then begin Act_MakeList.Visible := true; // Tolik 20/11/2020 -- в общем, здесь запрещаю создание папок в проекте, чтобы на ломалась концепция этажей/листов //Act_MakeDir.Visible := true; Act_MakeDir.Visible := false; // //Act_OpenProject.Visible := true; //Act_CloseProject.Visible := true; //Act_SaveProjectToFile.Visible := true; Act_SaveProjectFromNodeToFile.Visible := true; if (Dat.ObjectID = GSCSBase.CurrProject.CurrID) and (GSCSBase.CurrProject.Active) then begin Act_MakeList.Enabled := true; // Tolik 20/11/2020 -- //Act_MakeDir.Enabled := true; Act_MakeDir.Enabled := false; // //Act_CloseProject.Enabled := true; //Act_SaveProjectToFile.Enabled := true; EnableDisableListActions(true); end; end; // Tolik 20/11/2020 -- //if (AViewType in [itList, itRoom, itSCSLine, itSCSConnector]) or // ((AViewType = itDir) and (Dat <> nil) and (Dat.QueryMode = qmMemory)) then if (AViewType in [itList, itRoom, itSCSLine, itSCSConnector]) then // begin //Act_CloseProject.Visible := true; //Act_CloseProject.Enabled := true; Act_MakeList.Visible := true; Act_MakeList.Enabled := true; // Tolik 20/11/2020 //Act_MakeDir.Visible := true; //Act_MakeDir.Enabled := true; Act_MakeDir.Visible := false; Act_MakeDir.Enabled := false; // if AViewType in [itList, itRoom, itSCSLine, itSCSConnector] then if Not GUseArhOnlyMode then begin Act_MakeRoom.Visible := true; Act_MakeRoom.Enabled := true; end; EnableDisableListActions(true); end else //Tolik 20/11/2020 -- только для ПМ и других папок ! //if (AViewType = itProjMan) or (AViewType = itProject) then if (AViewType in [itProjMan, itDir]) then // begin Act_MakeDir.Visible := true; Act_MakeDir.Enabled := true; end // Tolik 20/11/2020 -- else if (AViewType = itProject) then begin Act_MakeDir.Visible := false; Act_MakeDir.Enabled := false; end; // if AViewType in [itSCSLine, itSCSConnector] then Act_MakeComponent.Enabled := true else Act_MakeComponent.Enabled := false; //if Not(AViewType in [itProjMan, itProject, itList]) then if (AViewType in [itDir, itSCSConnector, itSCSLine]) or IsComponItemType(AViewType) then //if AViewType in [itDir, itSCSConnector, itSCSLine, itComponCon, itComponLine] then Act_AddProperty.Enabled := true; ActList.Add(Act_EditProperty); ActList.Add(Act_RemoveProperty); if (MemTable_Property.Active) and Not(AViewType in [itProjMan, itProject, itList]) then EnableDisableAct(ActList, MemTable_Property.RecordCount) else EnableDisableAct(ActList, 0); //04.11.2013 if AViewType in [itProject, itList] then if mtNorms.Active then begin Act_MakeNorm.Enabled := true; ActList.Add(Act_EditNormResource); ActList.Add(Act_DelNormResource); EnableDisableAct(ActList, mtNorms.RecordCount); end; (* if AViewType = itSCSConnector then begin Act_AddPort.Enabled := false; ActList.Add(Act_EditPort); ActList.Add(Act_DelPort); EnableDisableAct(ActList, 0{MemTable_Port.RecordCount}); end; *) if Not IsComponItemType(Dat.ItemType) then //if (Dat.ItemType <> itComponLine) or (Dat.ItemType <> itComponCon) then begin Act_CutDir.Enabled := false; Act_CopyDir.Enabled := false; end; if Dat.ItemType = itList then Act_CopyDir.Enabled := true; if Dat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin //Act_DelTree.Enabled := false; Act_EditTree.Enabled := false; Act_CutDir.Enabled := false; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false; end; //if AViewType in [itSCSLine, itSCSConnector] then // Act_EditTree.Caption := 'Свойства'; //EnableDisablePopupMenuCatalogItems; end else begin Act_AddProperty.Enabled := false; Act_EditProperty.Enabled := false; Act_RemoveProperty.Enabled := false; Act_MakeObjectCurrency.Enabled := true; if (NBMode = nbmNorm) and (Not GSCSIni.NB.IsAdministration) then begin Act_MakeComponent.Enabled := false; Act_MakeDir.Enabled := false; Act_PasteDir.Enabled := false; Act_ClearCopyBuf.Enabled := false; Act_MakeObjectCurrency.Enabled := false; end; Act_EditObjectCurrency.Enabled := false; Act_DelObjectCurrency.Enabled := false; ActList.Add(Act_EditObjectCurrency); ActList.Add(Act_DelObjectCurrency); if (mtObjectCurrency.Active) then EnableDisableAct(ActList, mtObjectCurrency.RecordCount) else EnableDisableAct(ActList, 0); //if GIsAdministration then Act_IndexingComponPrice.Visible := true; Act_AutoSetGraphicObjects.Visible := true; Act_AutoSetGraphicObjects.Enabled := true; end; end //itComponLine, itComponCon : else if IsComponItemType(AViewType) {and Not IsArchComponByItemType(AViewType)} then begin if (NBMode = nbmNorm) and (Not GSCSIni.NB.IsAdministration) then begin Act_DelTree.Enabled := false; Act_EditingNode.Enabled := false; Act_EditTree.Enabled := false; Act_CutDir.Enabled := false; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false; Act_PasteDir.Enabled := false; Act_ClearCopyBuf.Enabled := false; Act_AddCompRelation.Enabled := false; Act_AddProperty.Enabled := false; Act_AddInterface.Enabled := false; Act_AddPort.Enabled := false; Act_AddCrossConnection.Enabled := false; Act_AddCableChannelElement.Enabled := false; //Tolik 13/11/2021 -- Act_AddTubeElement.Enabled := false; // Act_MakeNorm.Enabled := false; Act_MakeResource.Enabled := false; Act_MakeResourceCompon.Enabled := false; Act_MakeComponent.Enabled := false; Act_MakeDir.Enabled := false; end else begin Tree_Catalog.ReadOnly := false; Act_AddCompRelation.Enabled := true; Act_AddConnection.Enabled := true; Act_AddProperty.Enabled := true; Act_AddInterface.Enabled := true; Act_AddPort.Enabled := true; Act_AddCrossConnection.Enabled := true; Act_AddCableChannelElement.Enabled := true; //Tolik 13/11/2021 -- Act_AddTubeElement.Enabled := True; // Act_MakeNorm.Enabled := true; Act_MakeResource.Enabled := true; Act_MakeResourceCompon.Enabled := true; Act_MoveUP.Enabled := true; Act_MoveDOWN.Enabled := true; end; {$IF Defined(NORMSCS_PE) or Defined(SCS_SPA)} Act_MakeNorm.Visible := false; {$IFEND} //*** Если нет компонентов в списке ActList.Add(Act_DelComponent); ActList.Add(Act_EditComponent); EnableDisableAct(ActList, GSCSBase.SCSComponent.ID); //*** Если нет интерфейсов в списке ActList.Add(Act_EditInterface); ActList.Add(Act_DelInterface); if MemTable_InterfaceRel.Active then EnableDisableAct(ActList, MemTable_InterfaceRel.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет портов в списке ActList.Add(Act_EditPort); ActList.Add(Act_DelPort); if MemTable_Port.Active then EnableDisableAct(ActList, MemTable_Port.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет комплектующих в списке ActList.Add(Act_DelCompRelation); ActList.Add(Act_EditCompRelation); if MemTable_Complects.Active then EnableDisableAct(ActList, MemTable_Complects.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет Свойств в списке ActList.Add(Act_EditProperty); ActList.Add(Act_RemoveProperty); if MemTable_Property.Active then EnableDisableAct(ActList, MemTable_Property.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет Соединений в списке ActList.Add(Act_GoToConnectCompon); ActList.Add(Act_DelConnection); if MemTable_Connections.Active then EnableDisableAct(ActList, MemTable_Connections.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет Элементов каб. каналов в списке ActList.Add(Act_EditCableChannelElement); ActList.Add(Act_DelCableChannelElement); // Tolik 15/11/2021 -- ActList.Add(Act_EditTubeElement); ActList.Add(Act_DelTubeElement); // if mtCableCanalConnectors.Active then EnableDisableAct(ActList, mtCableCanalConnectors.RecordCount) else EnableDisableAct(ActList, 0); //*** Если нет норм в списке ActList.Add(Act_EditNormResource); ActList.Add(Act_DelNormResource); if mtNorms.Active then EnableDisableAct(ActList, mtNorms.RecordCount) else EnableDisableAct(ActList, 0); if GDBMode = bkNormBase then begin ActList.Add(Act_EditCrossConnection); ActList.Add(Act_DelCrossConnection); if MemTable_CrossConnection.Active then EnableDisableAct(ActList, MemTable_CrossConnection.RecordCount) else EnableDisableAct(ActList, 0); ActList.Add(Act_DelConnection); if MemTable_Connections.Active then EnableDisableAct(ActList, MemTable_Connections.RecordCount) else EnableDisableAct(ActList, 0); end; if GDBMode = bkProjectManager then begin //Act_EditInterface.Enabled := false; //Act_DelInterface.Enabled := false; //Act_EditPort.Enabled := false; //Act_DelPort.Enabled := false; EnableDisablePopupMenuCatalogItems; end else if Dat <> nil then //*** если я стою на комплектующей if ComponKind = ckCompl then begin //*** запретить редактирование //Act_MakeNewitemType.Enabled := false; //Act_MakeComponent.Enabled := false; //Act_EditComponent.Enabled := false; //Act_EditTree.Enabled := false; //Act_DelTree.Enabled := false; //Act_DelComponent.Enabled := false; {#Act_AddInterface.Enabled := false; Act_EditInterface.Enabled := false; Act_DelInterface.Enabled := false; ToolButton_MakeInTree.Enabled := false; Act_CopyDir.Enabled := false; Act_CutDir.Enabled := false; Act_PasteDir.Enabled := false; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false;} {# ParentDat := Tree_Catalog.Selected.Parent.Data; if ParentDat <> nil then //*** Если я стою на комплектующей данной комплектующей if (ParentDat.ComponKind <> ckCompon) and (GDBMode = bkNormBase) then begin Act_AddCompRelation.Enabled := false; Act_AddProperty.Enabled := false; Act_EditComplect.Enabled := false; Act_EditProperty.Enabled := false; Act_DelCompRelation.Enabled := false; Act_RemoveProperty.Enabled := false; end; } {#Act_AddCompRelation.Enabled := false; Act_AddProperty.Enabled := false; Act_EditComplect.Enabled := false; Act_EditProperty.Enabled := false; Act_DelCompRelation.Enabled := false; Act_RemoveProperty.Enabled := false;} end else ToolButton_MakeInTree.Enabled := true; end; //end; end; {$IF Defined(FINAL_SCS)} if GUseArhOnlyMode then begin Act_AddProperty.Visible := false; Act_RemoveProperty.Visible := false; // Act_SelAllWithSimilarProps.Enabled := false; end; {$IFEND} EnableDisablePopupMenuCatalogItems; Act_AddConnection.Enabled := false; FreeAndNil(ActList); end; procedure TF_MAIN.EnableDisableCost(AEnable: Boolean); begin PageScroller_Cost.Enabled := AEnable; //GroupBox_Cost.Enabled := AEnable; CurrencyEdit_Cost1.Enabled := AEnable; CurrencyEdit_Cost2.Enabled := AEnable; CurrencyEdit_Price1.Enabled := AEnable; CurrencyEdit_Price2.Enabled := AEnable; end; procedure TF_MAIN.EnableDisableListActions(AEnable: Boolean); begin Act_ConnectedConCompons.Enabled := AEnable; Act_ConnectedLineCompons.Enabled := AEnable; Act_NoConnectedConCompons.Enabled := AEnable; Act_NoConnectedLineCompons.Enabled := AEnable; Act_CablesNoHitToCanals.Enabled := AEnable; Act_AllComponsNorms.Enabled := AEnable; Act_MasterDefectAct.Enabled := AEnable; Act_NoConnectedRoutes.Enabled := AEnable; end; procedure TF_MAIN.EnableDisablePopupMenuCatalogItems; var CurrNode: TTreeNode; Dat: PObjectData; List: TSCSList; ParentNode: TTreeNode; InterfFunctionCount: Integer; SCSList: TSCSList; IsNormalList: Boolean; IsOpenedList: Boolean; IsProjectNode: Boolean; ActualCompon: TSCSComponent; i: integer; //Tolik PointFiguresCount: Integer; //Tolik 23/08/2023 -- function CheckComponentHasPorts(aCompon: TSCSComponent): boolean; var i, j: integer; Compon: TSCSComponent; ComponCatalog: TSCSCatalog; begin result := false; Compon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(aCompon.ID); if Compon <> nil then begin Compon.LoadChildComplects(true, true, true); ComponCatalog := Compon.GetFirstParentCatalog; for I := 0 to aCompon.Interfaces.Count - 1 do begin if aCompon.Interfaces[i].TypeI = itFunctional then if aCompon.Interfaces[i].IsPort = bitrue then begin result := true; exit; end; end; for I := 0 to aCompon.ChildReferences.Count - 1 do begin for j := 0 to aCompon.ChildReferences[i].Interfaces.Count - 1 do begin if aCompon.ChildReferences[i].Interfaces[j].TypeI = itFunctional then begin if aCompon.ChildReferences[i].Interfaces[j].IsPort = bitrue then begin result := true; exit; end; end; end; end; end; end; begin if GReadOnlyMode then GSCSIni.NB.DisableEdit := True; if Tree_Catalog.Selected = nil then Exit; ///// EXIT ///// try Dat := Tree_Catalog.Selected.Data; List := nil; ParentNode := nil; if Dat = nil then Exit; /// EXIT /// CurrNode := Tree_Catalog.Selected; ParentNode := CurrNode.Parent; ActualCompon := nil; //if ParentNode = nil then // Exit; ///// EXIT ///// {//*** Пункт "Ведомость ресурсов компоненты" if Dat.ItemType in [itComponLine, itComponCon] then Act_NormsShow.Visible := true else Act_NormsShow.Visible := false;} //*** Пункт "Ведомость ресурсов компоненты" if Dat.ItemType in [itSCSLine, itSCSConnector, itComponLine, itComponCon] then Act_NormsShow.Visible := true else Act_NormsShow.Visible := false; //case Dat.ItemType of // itSCSLine, itSCSConnector: // Act_NormsShow.Caption := 'Ведомость ресурсов объекта'; // itComponLine, itComponCon: // Act_NormsShow.Caption := 'Ведомость ресурсов компоненты'; //end; //*** Свернуть/развернуть все папки не видимы //Act_MaximizeDir.Visible := false; //Act_MinimizeDir.Visible := false; //pmnu_MaxMinAllDir.Visible := false; //*** Пункт "Действия" Act_MnuActions.Enabled := false; Act_PatternMarking.Visible := False; pmnu_Actions.Visible := false; pmnu_CadActions.Visible := false; pmnu_Turning.Visible := false; pmnuComponDirectoryData.Visible := false; pmPatternMarking.visible := false; Act_ShowRepResources.Visible := false; Act_MnuReports.Visible := false; Act_ReplaceComponent.Visible := false; Act_CablePath.Visible := false; Act_CrossConnection.Visible := false; //*** Пункт "Соединить С..." Act_ConnectComplWith.Visible := false; Act_TraceLineComponlBySelectedLines.Visible := false; Act_AutoTraceCable.Visible := false; Act_AutoTraceByRayMode.Visible := false; Act_MasterCableCanalTracing.Visible := false; Act_ApplyComponForProjResources.Visible := false; Act_ApplyComponForListResources.Visible := false; Act_LoadNBNodeFromFile.Visible := false; Act_SaveNBNodeToFile.Visible := false; Act_ClearList.Visible := false; Act_DelAllTracesFromList.Visible := false; Act_DeleteAllCables.Visible := false; Act_DeleteAllCableCanals.Visible := false; Act_DeleteAllCCE.Visible := false; Act_SaveToAlPlan.Visible := false; Act_ConnectConfigurator.Visible := false; Act_CupBoardDesigner.Visible := false; Act_CupBoard_Ports.Visible := false; // Tolik 23/08/2023 -- Act_FindComponInNB.Visible := false; Act_CopyCurrList.Visible := false; Act_CopyCurrListWithoutCompons.Visible := false; Act_ShowProjectPlan.Visible := false; Act_DelSameComponInList.Visible := false; Act_DelSameComponInSelObj.Visible := false; Act_OpenBeatenProject.Enabled := false; Act_OpenBeatenProject.Visible := false; //Act_PairLineInterfaces.Visible := false; Act_ReindexComponentByType.Visible := false; Act_ReindexComponentByTypeInList.Visible :=false; Act_ReindexComponentPorts.Visible := false; Act_DefineNewPropsFromDefault.Visible := false; //Act_AllComponsNorms.Enabled := false; //Act_AllComponsNorms.Visible := false; //Act_MasterDefectAct.Enabled := false; //Act_MasterDefectAct.Visible := false; Act_ReplaceCableCanals.Visible := false; Act_SetCableCanalConnectors.Visible := false; Act_SetCableCanalConnectorsToSelected.Visible := false; Act_SetTubesElements.visible := False; // Tolik 16/11/2021 -- Act_AddComplectToComponent.Enabled := false; Act_AddComplectToComponent.Visible := false; Act_AddComponToFavorites.Visible := false; Act_DelComponFromFavorites.Visible := false; Act_ExportAllComponentsToNB.Visible := false; Act_ExportAllComponentsToNB.Enabled := false; Act_ProjUsers.Visible := false; Act_SelectSameComponsInCAD.Visible := false; Act_SelectSameComponsInProj.Visible := false; Act_MasterCompl.Visible := false; Act_EditTree.Caption := cMain_Msg3; pmnu_Props.Visible := false; //07.12.2011 Act_SetActiveToAllCompons.Visible := false; Act_SetActiveToASelCompons.Visible := false; Act_SetProjectibleToSelCompons.Visible := false; Act_SaveModelToNB.Visible := false; Act_ShowCADObjectView.Visible := false; Act_SetComponGrpName.Visible := false; // Tolik -- 04/09/2017 -- Act_ShowIntersections.Visible := False; Act_HideIntersections.Visible := False; Act_ShowCritIntersections.Visible := False; // //*** Пункт меню "Добавить комплектующую" if IsComponItemType(Dat.ItemType) and (GTemplateContCompl or Not IsTemplateImageIndex(CurrNode.ImageIndex)) and Not IsArchComponByItemType(Dat.ItemType) then begin Act_AddComplectToComponent.Visible := true; if CanEditNode(Dat) then Act_AddComplectToComponent.Enabled := true; end; if GDBMode = bkNormBase then begin Act_LoadListFromFile.Visible := false; Act_SaveCurrListToFile.Visible := false; IsOpenedList := CheckIsOpenListBeforeOperation(true, false); //*** Свернуть/развернуть все папки //Act_MaximizeDir.Visible := true; //Act_MinimizeDir.Visible := true; //pmnu_MaxMinAllDir.Visible := false; //*** Пункт "Перейти на компоненту" if Dat.ComponKind = ckCompl then pmnu_GoToOriginalCompon.Visible := true else pmnu_GoToOriginalCompon.Visible := false; //*** Пункт "Сделать по умолчанию" //if Dat.ItemType in [itComponLine, itComponCon] then // Act_SetComponAsDefault.Visible := true //else Act_SetComponAsDefault.Visible := false; if IsComponItemType(Dat.ItemType) then begin //*** Добавить/Удалить компонент из избранного if Not IsComponentNode(ParentNode) then begin if CheckExistsComponGUIDInNBFavorites(GSCSBase.SCSComponent.GuidNB) then Act_DelComponFromFavorites.Visible := true else Act_AddComponToFavorites.Visible := true; end; Act_ApplyComponForProjResources.Visible := CheckIsOpenProject(false); //01.07.2009 true; //Act_ApplyComponForProjResources.Enabled := false; Act_ApplyComponForListResources.Visible := IsOpenedList; //01.07.2009 true; //Act_ApplyComponForListResources.Enabled := false; if Not GLiteVersion then begin Act_MasterCompl.Visible := true; Act_MasterCompl.Enabled := false; if (Dat.NBMode <> nbmNorm) and (Not GSCSIni.NB.DisableEdit) then begin Act_MasterCompl.Enabled := true; end; end; end; //*** Проложить каб. канал по выдел. трассам if Dat.ItemType = itComponLine then begin //pmnu_CADActions.Visible := true; //if IsSelectedLinesExist then //*** Есть ли выдел. трассы на КАДе //18.03.2011 Act_TraceLineComponlBySelectedLines.Visible := IsOpenedList; //01.07.2009 true; Act_MasterCableCanalTracing.Visible := IsOpenedList; //01.07.2009 true; Act_MasterCableCanalTracing.Caption := GetMasterTracingCaption(GSCSBase.SCSComponent.ComponentType.SysName); if GSCSBase.SCSComponent.ComponentType.SysName <> ctsnCableChannel then begin Act_AutoTraceCable.Visible := IsOpenedList; //01.07.2009 true; Act_AutoTraceByRayMode.Visible := IsOpenedList; //01.07.2009 true; end; end; if IsComponItemType(Dat.ItemType) then Act_TraceLineComponlBySelectedLines.Visible := IsOpenedList; if IsComponentNode(Tree_Catalog.Selected) then begin pmnuComponDirectoryData.Visible := true; pmPatternMarking.visible := False; end; ////*** Пункт "Отчеты" //pmnu_Reports.Visible := false; //*** Пункты "Автопрокладывать как заглушку" и "Автопрокладывать как тройник" if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannelElement then begin InterfFunctionCount := 0; InterfFunctionCount := GSCSBase.SCSComponent.GetInterfcesCountByType(itFunctional); end; if (Dat.NBMode <> nbmNorm) or (GSCSIni.NB.IsAdministration) then begin Act_LoadNBNodeFromFile.Visible := true; Act_SaveNBNodeToFile.Visible := true; end; //if (Dat.ItemType = itComponLine) or (Dat.ItemType = itDir) then // Act_PairLineInterfaces.Visible := true; end else begin SCSList := nil; IsNormalList := false; IsProjectNode := IsCurrProjectNode(CurrNode); pmnu_GoToOriginalCompon.Visible := false; Act_SetComponAsDefault.Visible := false; //*** Дизайнер щкафа if Dat.ItemType = itComponCon then if GSCSBase.SCSComponent.isTemplate = biFalse then if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then begin Act_CupBoardDesigner.Visible := true; //Tolik 23/08/2023 -- если есть порты в шкафу - можно показать отчет по занятым/свободным портам //if CheckComponentHasPorts(GSCSBase.SCSComponent) then Act_CupBoard_Ports.Visible := true; // end; //*** Пункт "Ведомость объектов Листа" if Dat.ItemType = itList then begin SCSList := GSCSBase.CurrProject.GetListByID(Dat.ObjectID); if (SCSList <> nil) and (SCSList.Setting.ListType = lt_Normal) then IsNormalList := true; if IsNormalList then Act_ListObjectReport.Visible := true; if GUseArhOnlyMode then Act_SaveModelToNB.Visible := true; // Tolik -- 04/09/2017 -- Act_ShowIntersections.Visible := True; Act_HideIntersections.Visible := True; Act_ShowCritIntersections.Visible := True; // end else Act_ListObjectReport.Visible := false; Act_TraceLineComponlBySelectedLines.Visible := false; Act_AutoTraceCable.Visible := false; //Act_AllComponsNorms.Visible := true; //Act_MasterDefectAct.Visible := true; // Пункт "Действия" if (SCSList <> nil) or IsProjectNode then //if Not GUseArhOnlyMode then begin pmnu_Actions.Visible := true; pmnu_Actions.Enabled := true; end; // Содержимое пункта "Действия" if IsNormalList or IsProjectNode then begin if Not GUseArhOnlyMode then begin Act_ShowRepResources.Visible := true; Act_ShowRepResources.Enabled := true; Act_MnuReports.Visible := true; Act_MnuReports.Enabled := true; Act_IndexingComponPrice.Visible := true; Act_IndexingComponPrice.Enabled := true; end; //Act_AllComponsNorms.Enabled := true; //Act_MasterDefectAct.Enabled := true; //#### Act_SaveToAlPlan.Visible := true; // Стали на другой проект if (Dat.ItemType = itProject) and ((Dat.ObjectID <> GSCSBase.CurrProject.CurrID) or Not(GSCSBase.CurrProject.Active)) then begin Act_ShowRepResources.Enabled := false; pmnu_Actions.Enabled := false; Act_MnuReports.Enabled := false; Act_IndexingComponPrice.Enabled := false; Act_AutoSetGraphicObjects.Enabled := false; end; Act_CopyCurrList.Visible := true; Act_CopyCurrListWithoutCompons.Visible := true; if Dat.ItemType = itProject then begin {$if Not Defined(ES_GRAPH_SC)} Act_ShowProjectPlan.Visible := true; {$ifend} Act_DefineNewPropsFromDefault.Visible := true; //*** Открыть битый проект if Dat.ObjectID = GSCSBase.CurrProject.CurrID then begin Act_OpenBeatenProject.Visible := true; if GSCSBase.CurrProject.CanOpenFromBeatenBlock then Act_OpenBeatenProject.Enabled := true; end; Act_ExportAllComponentsToNB.Visible := true; if GSCSBase.CurrProject.ComponentReferences.Count > 0 then Act_ExportAllComponentsToNB.Enabled := true; // Tolik -- 04/09/2017 -- if ((Dat.ObjectID = GSCSBase.CurrProject.CurrID) and (GSCSBase.CurrProject.Active)) then begin Act_ShowIntersections.Visible := True; Act_HideIntersections.Visible := True; Act_ShowCritIntersections.Visible := True; end; // end; end; if (Dat.ItemType in [itComponLine, itComponCon]) then begin ActualCompon := GetActualSelectedComponent; //05.02.2013 pmnu_Actions.Visible := true; pmnu_Actions.Enabled := true; pmnuComponDirectoryData.Visible := true; pmPatternMarking.visible := true; if Dat.ItemType = itComponLine then begin pmnu_Turning.Visible := true; // Tolik if ActualCompon <> nil then if GCableCompTypes.IndexOf(ActualCompon.ComponentType.SysName) <> -1 then // if ActualCompon.ID_ComponentType = ctCable then Act_CablePath.Visible := true; end; //*** Пункт "Соединить С..." if Dat.ComponKind = ckCompl then if GSCSBase.SCSComponent.ComponentType.SysName = ctsnPatchPanel then Act_ConnectComplWith.Visible := true; //*** Найти компонент в НБ Act_FindComponInNB.Visible := true; // Удалить на выделенных объектах Act_DelSameComponInSelObj.Visible := true; //*** Удалить по всему листу Act_DelSameComponInList.Visible := true; //*** переиндексировать однотипные компоненты Act_ReindexComponentByType.Visible := true; if Dat.ItemType = itComponCon then begin Act_ReindexComponentByTypeInList.Visible := true; Act_ReindexComponentPorts.Visible := true; if ActualCompon <> nil then if ActualCompon.ExistsCrossComponInChilds then Act_CrossConnection.Visible := true; end; // Выделить однотипные компоненты на листе Act_SelectSameComponsInCAD.Visible := true; Act_SelectSameComponsInProj.Visible := true; end else if Dat.ItemType = itArhRoofSeg then begin Act_ShowCADObjectView.Visible := true; Act_ShowCADObjectView.Caption := cMain_Msg191; end else if Dat.ItemType = itProject then begin Act_ProjUsers.Visible := true; end; //if Dat.ItemType <> itProjMan then //pmnu_Actions.Visible := true; if IsNormalList then begin Act_ClearList.Visible := true; if Not GUseArhOnlyMode then begin Act_DelAllTracesFromList.Visible := true; Act_DeleteAllCables.Visible := true; Act_DeleteAllCableCanals.Visible := true; Act_DeleteAllCCE.Visible := true; Act_ConnectConfigurator.Visible := true; Act_SetActiveToASelCompons.Visible := true; Act_SetProjectibleToSelCompons.Visible := true; end; end; //*** Пункт "Соединить С..." //if (ParentNode <> nil) and (PObjectData(ParentNode.Data).ItemType = itComponCon) then // Act_ConnectComplWith.Visible := true //else // Act_ConnectComplWith.Visible := false; //*** Пункт "Заменить компонент на..." Act_ReplaceComponent.Visible := false; //if (Dat.ItemType = itComponCon) or (GSCSBase.SCSComponent.ID_ComponentType = ctCableCanal) then // if Dat.ComponKind = ckCompon then //Act_ReplaceComponent.Visible := true; if (Dat.ItemType = itComponCon) {and (Dat.ComponKind = ckCompon))} or (Dat.ItemType = itComponLine) then Act_ReplaceComponent.Visible := true; //*** Пунтк "Заменить кабельные канлы" //Act_ReplaceCableCanals.Visible := false; //Act_SetCableCanalConnectors.Visible := false; //Act_SetCableCanalConnectorsToSelected.Visible := false; if (Dat.ItemType in [itDir, itRoom]) or IsNormalList or IsProjectNode then begin if Not GUseArhOnlyMode then begin Act_ReplaceCableCanals.Visible := true; Act_SetCableCanalConnectors.Visible := true; Act_SetCableCanalConnectorsToSelected.Visible := true; Act_SetTubesElements.Visible := True; end; end; //*** Пункт "Ведомость ресурсов Листа" if ((Dat.ItemType in [itDir]) or IsNormalList) and IsProjectNode then begin //pmnu_Reports.Visible := true; {Act_ListResourceReport.Visible := true; Act_CableReport.Visible := true; Act_RCableExceedLength.Visible := true; Act_RCableCanal.Visible := true; Act_RDisparityCompColor.Visible := true; Act_RDisparityComponProducer.Visible := true; Act_RJoining.Visible := true; Act_RTypeComponents.Visible := true; } end else begin //pmnu_Reports.Visible := false; {Act_ListResourceReport.Visible := False; Act_CableReport.Visible := false; Act_RCableExceedLength.Visible := false; Act_RCableCanal.Visible := false; Act_RDisparityCompColor.Visible := false; Act_RDisparityComponProducer.Visible := false; Act_RJoining.Visible := false; Act_RTypeComponents.Visible := false;} end; //*** Пункт "Создать кабинет", (если не включен режим группировки) List := GSCSBase.CurrProject.GetListBySCSID(Dat.ListID); {if List <> nil then if Not List.Setting.GroupListObjectsByType then Act_MakeRoom.Enabled := true else Act_MakeRoom.Enabled := false; } if Dat.ItemType in [itSCSLine, itSCSConnector] then Act_EditTree.Caption := cMain_Msg4; if Not GUseArhOnlyMode then begin // Если ветка в пределах проекта if GetParentNodeByItemType(CurrNode, [itProject]) <> nil then begin if IsCatalogItemType(Dat.ItemType) then pmnu_Props.Visible := true; //07.12.2011 Act_SetActiveToAllCompons.Visible := true; Act_SetComponGrpName.Visible := true; end; end; if GReadOnlyMode then begin pmnu_Actions.Visible := False; Act_PatternMarking.Enabled := False; Act_IndexingComponPrice.Enabled := False; Act_MakeDir.Enabled := False; Act_ChangeComponArtProducerByTemplate.Enabled := False; Act_EditingNode.Enabled := False; Act_PasteDir.Enabled := False; Act_ShowProjectPlan.Enabled := False; Act_CupBoardDesigner.Enabled := False; Act_DelSameComponInSelObj.Enabled := False; Act_DelSameComponInList.Enabled := False; Act_CopyCurrListWithoutCompons.Enabled := False; Act_CopyCurrList.Enabled := False; Act_MakeList.Enabled := False; Act_DelTree.Enabled := False; Act_MakeRoom.Enabled := False; Act_ConnectConfigurator.Enabled := False; end; end; {$IF Defined(NORMSCS_PE) or Defined(SCS_SPA)} Act_MasterDefectAct.Visible := false; Act_AllComponsNorms.Visible := false; {$IFEND} if GReadOnlyMode then begin //for i := 0 to ActionList.ActionCount - 1 do //begin // (ActionList.Actions[i] as TAction).Enabled := False; //end; end; Act_View3D.Visible := false; if Dat.ItemType = itArhRoom then Act_View3D.Visible := true; except on E: Exception do AddExceptionToLog('TF_MAIN.EnableDisablePopupMenuCatalogItems: '+E.Message); end; {$IF Defined(OEM_NIKOMAX)} if GDBMode = bkNormBase then begin try Act_PasteDir.Enabled := False; Act_CopyDir.Enabled := False; Act_CutDir.Enabled := False; Act_LoadNBNodeFromFile.Enabled := False; Act_SaveNBNodeToFile.Enabled := False; except end; end; {$IFEND} {$IF Not Defined(ES_GRAPH_SC)} //Act_View3D.Visible := false; {$IFEND} end; // ##### меняет местами ветви дерева ##### procedure TF_MAIN.ExchNodes(ANode1, ANode2: TTreeNode; AMode: TNodeAttachMode); var Index: Integer; SelectedID: Integer; //*** ID текущей папки ParentNode: TTreeNode; Node: TTreeNode; ExpandedNode1: Boolean; ExpandedNode2: Boolean; HasChild1: Boolean; HasChild2: Boolean; begin HasChild1 := false; HasChild2 := false; ExpandedNode1 := false; ExpandedNode2 := false; //*** Если есть Child-ы, то удалить их из папки if ANode1.Count > 0 then begin ExpandedNode1 := ANode1.Expanded; DeleteChildNodes(ANode1); HasChild1 := true; end; if ANode2.Count > 0 then begin ExpandedNode2 := ANode2.Expanded; DeleteChildNodes(ANode2); HasChild2 := true; end; //*** Переместить ветви MoveNodeTo(ANode1, ANode2, AMode); //*** Если были Child-ы, то засыпать папки ими if HasChild1 then begin StepNodes(ANode1, nil, false); ANode1.Expanded := ExpandedNode1; end; if HasChild2 then begin StepNodes(ANode2, nil, false); ANode2.Expanded := ExpandedNode2; end; {ParentNode := ANode1.Parent; SelectedID := PObjectData(Tree_Catalog.Selected.Data).ObjectID; if PObjectData(ANode1.Parent.Data).ObjectID = PObjectData(ANode2.Parent.Data).ObjectID then begin ParentNode.DeleteChildren; StepNodes(ParentNode, false); ParentNode.Expanded := true; //*** Выйти на выделенную папку Node := ParentNode.getFirstChild; while Node <> nil do begin if PObjectData(Node.Data).ObjectID = SelectedID Then begin Tree_Catalog.Selected := Node; Break; end; Node := Node.getNextSibling; end; end; } end; function TF_MAIN.GetImageIndexByObjectData(AObjectData: PObjectData; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone; AObject: TObject = nil): Integer; const cmpDelta = 0.001; var NodeDat: PObjectData; ItemType: Integer; function GetSCSConnectorImageIndex(AUpIndex, ALoIndex: Integer): Integer; var SCSConnector: TSCSCatalog; List: TSCSList; StandartCOORDZ: Double; ConnectorCOORDZ: Double; strConnectorCOORDZ: string; begin Result := tciiSCSConNormal; StandartCOORDZ := 0; ConnectorCOORDZ := 0; SCSConnector := GSCSBase.CurrProject.GetCatalogFromReferences(NodeDat.ObjectID); if Assigned(SCSConnector) then ConnectorCOORDZ := SCSConnector.GetPropertyValueAsFloat(pnCoordZ); //strConnectorCOORDZ := DM.GetPropertyValue(tkCatalog, NodeDat.ObjectID, pnCoordZ, qmUndef, -1); //if strConnectorCOORDZ <> '' then begin List := nil; List := GSCSBase.CurrProject.GetListBySCSID(NodeDat.ListID); if List <> nil then begin //StandartCOORDZ := GetCurrListHeightSocket(GIDLastList); StandartCOORDZ := List.Setting.HeightSocket; //ConnectorCOORDZ := StrToFloat_My(strConnectorCOORDZ); if Abs(ConnectorCOORDZ - StandartCOORDZ) > cmpDelta then begin if ConnectorCOORDZ < StandartCOORDZ then Result := ALoIndex; if ConnectorCOORDZ > StandartCOORDZ then Result := AUpIndex; end; end; end; end; function GetSCSLineImageIndex: Integer; var SCSCatalog: TSCSCatalog; ObjInterfaces: TInterfLists; //Interf1: TInterface; //Interf2: TInterface; i, j: Integer; HeightSide1: Double; HeightSide2: Double; begin Result := tciiSCSLineNorm; SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(NodeDat.ObjectID); if Assigned(SCSCatalog) then begin HeightSide1 := SCSCatalog.GetSideHeight(1); HeightSide2 := SCSCatalog.GetSideHeight(2); if HeightSide1 <> HeightSide2 then Result := tciiSCSLineDif; end; end; begin Result := -1; try NodeDat := AObjectData; ItemType := -1; if AItemType <> -1 then ItemType := AItemType else ItemType := NodeDat.ItemType; case AEditKind of ekNone, ekCopy: case ItemType of itProjMan: Result := tciiProjMan; itDir: Result := tciiDir; itProject: begin if Assigned(GSCSBase.CurrProject) then if (NodeDat.ObjectID = GSCSBase.CurrProject.CurrID) and (GSCSBase.CurrProject.Active) then Result := tciiProject else Result := tciiProjectClose; end; itList: Result := tciiList; itRoom: Result := tciiRoom; itSCSLine: Result := GetSCSLineImageIndex;//tciiSCSLineNorm; itSCSConnector: Result := GetSCSConnectorImageIndex(tciiSCSConUp, tciiSCSConLo); itComponLine: begin Result := tciiComponLine; //if GUseComponTemplates then if (GDBMode = bkNormBase) and (AObject <> nil) and (AObject is TSCSComponent) then if TSCSComponent(AObject).ComponentType.IDComponTemplate = NodeDat.ObjectID then Result := tciiComponLineTemplate; if (AObject <> nil) and (AObject is TSCSComponent) then if TSCSComponent(AObject).IsTemplate = biTrue then Result := tciiTemplateLine; end; itComponCon: begin Result := tciiComponCon; //if GUseComponTemplates then if (GDBMode = bkNormBase) and (AObject <> nil) and (AObject is TSCSComponent) then if TSCSComponent(AObject).ComponentType.IDComponTemplate = NodeDat.ObjectID then Result := tciiComponConTemplate; if (AObject <> nil) and (AObject is TSCSComponent) then if TSCSComponent(AObject).IsTemplate = biTrue then Result := tciiTemplateCon; end; itLinkCompLine: Result := tciiLinkCompLine; itLinkCompCon: Result := tciiLinkCompCon; itSCSLineGroup: Result := tciiSCSLineGroup; itSCSConnGroup: Result := tciiSCSConnGroup; itSCSEmptyGroup: Result := tciiSCSEmptyGroup; end; ekCut: case ItemType of itDir: Result := tciiCutDir; itProject: Result := tciiCutProject; itList: Result := tciiCutList; itRoom: Result := tciiCutRoom; itSCSLine: Result := GetSCSLineImageIndex; //tciiCutSCSLineNorm; itSCSConnector: Result := GetSCSConnectorImageIndex(tciiCutSCSConUp, tciiCutSCSConLo); itComponLine: Result := tciiCutComponLine; itComponCon: Result := tciiCutComponCon; itLinkCompLine: Result := tciiCutLinkCompLine; itLinkCompCon: Result := tciiCutLinkCompCon; end; end; if Result = -1 then case ItemType of itArhRoom: Result := tciiArchRoom; itArhWall: Result := tciiArchWall; itArhWallDivision: Result := tciiArchWallDiv; itArhFloor: Result := tciiArchFloor; itArhCeiling: Result := tciiArchFloor; itArhEmbrasure: Result := tciiArchArc; itArhWindow: Result := tciiArchWindow; itArhDoor: Result := tciiArchDoor; itArhNiche: Result := tciiArchNiche; itArhInnerSlope: Result := tciiArchInnerSlope; itArhOuterSlope: Result := tciiArchInnerSlope; itArhArc: Result := tciiArchArc; itArhBalcony: Result := tciiArchBalcony; itArhBrickWall: Result := tciiArchBrickWall; itArhWallCorner: Result := tciiArhWallCorner; itArhRoofSeg: Result := tciiArhRoofSeg; itArhRoofHip: Result := tciiArhRoofHip; itArhRoofHipCorner: Result := tciiArhRoofHipCorner; end; if Result = -1 then case ItemType of itArhContainer: Result := tciiSCSEmptyGroup; else begin if IsArchComponByItemType(ItemType) then Result := tciiInterfaceFill; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.GetImageIndexByObjectData: '+E.Message); end; end; procedure TF_MAIN.SetListItemImageIndex(AListItem: TListItem; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone); var NewImageIndex: Integer; begin try if AListItem = nil then Exit; //// EXIT //// NewImageIndex := -1; NewImageIndex := GetImageIndexByObjectData(AListItem.Data, AItemType, AEditKind); AListItem.ImageIndex := NewImageIndex; except on E: Exception do AddExceptionToLog('TF_MAIN.SetListItemImageIndex: '+E.Message); end; end; procedure TF_MAIN.SetNodeState(ANode: TTreeNode; AItemType: TItemType = -1; AEditKind: TEditKind = ekNone; AObject: TObject = nil); var NewImageIndex: Integer; begin try if ANode = nil then Exit; //// EXIT //// NewImageIndex := -1; NewImageIndex := GetImageIndexByObjectData(ANode.Data, AItemType, AEditKind, AObject); ANode.ImageIndex := NewImageIndex; ANode.SelectedIndex := NewImageIndex; ANode.StateIndex := -1; if AObject <> nil then if AObject is TSCSComponent and (ANode.Data <> nil) then begin if (TSCSComponent(AObject).Price_Calc = 0) and Not IsArchComponByIsLine(TSCSComponent(AObject).IsLine) then begin if TSCSComponent(AObject).Name = 'Underfloor pathway' then PObjectData(ANode.Data).FontColor := -1 else PObjectData(ANode.Data).FontColor := GSCSIni.NB.ColorZeroPriceComponent; end else PObjectData(ANode.Data).FontColor := -1; if GDBMode = bkNormBase then //if Not FFilterParams.IsUseFilter and (FFilterParams.FFilterType <> fltFavorites) then if (TSCSComponent(AObject).GuidNB <> '') and Not IsComponentNode(ANode.Parent) then if CheckExistsComponGUIDInNBFavorites(TSCSComponent(AObject).GuidNB) then ANode.StateIndex := tcsiFavorite; end; except on E: Exception do AddExceptionToLog('TF_MAIN.SetNodeImageIndex: '+E.Message); end; end; // ##### Запретить / Разрешить прорисовку Дерева и Грида ##### procedure TF_MAIN.LockTreeAndGrid(ALock: Boolean); begin try case ALock of true: begin if FLockTreeAndGreedCount = 0 then begin // Tolik 13/04/2021 -- if Tree_Catalog.Parent <> nil then if TF_Main(Self).GdbMode = bkProjectManager then SendMessage(Tree_Catalog.Parent.Handle, WM_SETREDRAW, 0, 0); // Tree_Catalog.Items.BeginUpdate; //Tree_Catalog.OnCustomDrawItem := nil; if Not DM.MemTable_Complects.ControlsDisabled then DM.MemTable_Complects.DisableControls; if Not DM.MemTable_Property.ControlsDisabled then DM.MemTable_Property.DisableControls; if Not DM.MemTable_InterfaceRel.ControlsDisabled then DM.MemTable_InterfaceRel.DisableControls; if Not DM.MemTable_Connections.ControlsDisabled then DM.MemTable_Connections.DisableControls; if Not DM.MemTable_CrossConnection.ControlsDisabled then DM.MemTable_CrossConnection.DisableControls; if Not DM.mtObjectCurrency.ControlsDisabled then DM.mtObjectCurrency.DisableControls; {Grid_CompData.BeginUpdate; GT_Compon_Relation.BeginUpdate; GT_PROPERTY.BeginUpdate; GT_INTERFACE.BeginUpdate; GT_Connections.BeginUpdate;} // Tolik -- 21/04/2016 -- //Inc(FLockTreeAndGreedCount); end; // Tolik -- 21/04/2016 -- Inc(FLockTreeAndGreedCount); end; false: begin if FLockTreeAndGreedCount > 0 then Dec(FLockTreeAndGreedCount); if FLockTreeAndGreedCount = 0 then begin //Tree_Catalog.OnCustomDrawItem := Tree_CatalogCustomDrawItem; Tree_Catalog.Items.EndUpdate; // Tolik 13/04/2021 -- if Tree_Catalog.Parent <> nil then begin if TF_Main(Self).GdbMode = bkProjectManager then begin SendMessage(Tree_Catalog.Parent.Handle, WM_SETREDRAW, 1, 0); RedrawWindow(Tree_Catalog.Parent.Handle, nil, 0, RDW_INVALIDATE or RDW_UPDATENOW or RDW_ALLCHILDREN); end; end; // Tolik 23/11/2016 -- Tree_Catalog.Invalidate; // Try if DM.MemTable_Complects.ControlsDisabled then DM.MemTable_Complects.EnableControls; if DM.MemTable_Property.ControlsDisabled then DM.MemTable_Property.EnableControls; if DM.MemTable_InterfaceRel.ControlsDisabled then DM.MemTable_InterfaceRel.EnableControls; if DM.MemTable_Connections.ControlsDisabled then DM.MemTable_Connections.EnableControls; if DM.MemTable_CrossConnection.ControlsDisabled then DM.MemTable_CrossConnection.EnableControls; if DM.mtObjectCurrency.ControlsDisabled then DM.mtObjectCurrency.EnableControls; except on e: exception do showmessage('Unlock err!'); End; { Grid_CompData.EndUpdate; GT_Compon_Relation.EndUpdate; GT_PROPERTY.EndUpdate; GT_INTERFACE.EndUpdate; GT_Connections.EndUpdate; } end; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.LockTreeAndGrid: '+E.Message); end; end; // ##### Сортировать по папкам ##### procedure TF_Main.SortByVetv(AParentNode: TTreeNode); var PrevNode: TTreeNode; CurrNode: TTreeNode; ParentDat: PObjectData; Dat: PObjectData; i: Integer; IsMetElementForSecondPart: Boolean; begin ParentDat := AParentNode.Data; CurrNode := AParentNode.getFirstChild; PrevNode := nil; IsMetElementForSecondPart := false; for i:= 0 to AParentNode.Count - 1 do begin Dat := CurrNode.Data; case Dat.ItemType of itComponLine, itComponCon, itSCSLine, itSCSConnector, itList, itProject: begin if ((Dat.ItemType in [itComponLine, itComponCon]) and (ParentDat.ItemType = itDir)) or ((Dat.ItemType in [itSCSLine, itSCSConnector]) and (ParentDat.ItemType = itList)) or ((Dat.ItemType = itList) and (ParentDat.ItemType in [itProject, itDir])) or ((Dat.ItemType = itProject) and (ParentDat.ItemType in [itProjMan, itDir])) then begin IsMetElementForSecondPart := true; if PrevNode = nil then PrevNode := CurrNode; end; end; else if IsMetElementForSecondPart then MoveNodeTo(CurrNode, PrevNode, naInsert); //*** Вставит перед PrevNode end; CurrNode := CurrNode.getNextSibling; end; end; // ##### открыть форму для выбора папки в которой будет чтото создаваться ##### function TF_MAIN.CreateNewForm(ACaption: String): TModalResult; var i: Integer; LCount : Integer; Node, PrevNode: TTreeNode; Dat: PObjectData; ParentIDCatalog: Integer; NewItemType: TItemType; NewTextNode: String; begin Result := mrNone; (* ParentIDCatalog := -1; NewItemType := -1; //GCreatedDMAIN := true; GGDbMode := GDBMode; F_DMAIN := TF_Main.Create(Self, GDBMode, fmNewFolder); F_Dmain.Visible := false; F_DMAIN.Caption := 'Создание папки'; F_Dmain.Grid_CompData.BeginUpdate; Node := Tree_Catalog.Selected; if PObjectData(Node.Data).ItemType in [itComponLine, itComponCon] then Node := Node.Parent; {F_DMAIN.GDmainID_Catalog := PObjectData(Node).ObjectID; F_DMAIN.GDmainFindCompon := false;} //*** Выйти на на такую же папку как текущая Dat := Node.Data; F_Dmain.LockTreeAndGrid(True); Node := F_Dmain.FindComponOrDirInTree(Dat.ObjectID, false); F_Dmain.LockTreeAndGrid(False); F_Dmain.Tree_Catalog.Selected := Node; {//*** Убрать главное меню LCount := F_DMain.MainMenu.Items.Count; for i := 0 to LCount - 1 do F_DMain.MainMenu.Items[i].Visible := false; } F_DMain.Tree_Catalog.PopupMenu := nil; //*** Убрать нижнюю пнель F_DMain.Panel_Addition.Visible := false; F_DMain.Panel_Tree.DragMode := dmManual; F_DMain.Panel_Tree.ManualDock(nil, nil, alNone); F_DMain.Panel_Tree.Parent := F_DMain.Panel_Main; F_DMAIN.Panel_Main.DockSite := false; F_DMain.Height := F_DMain.Height - Round(Height / 3); F_DMain.Panel_Tree.Align := alClient; F_DMain.Panel_New.Align := alTop; F_DMAin.Panel_New.Visible := true; //*** переместить кнопки OK и Отмена F_DMain.Panel_OKCancel.Visible := true; F_DMain.SpinEdit_Kolvo.Visible := false; F_DMain.Label_Kolvo.Visible := false; F_DMain.BitBtn_OK.Visible := true; F_DMain.BitBtn_Cancel.Visible := true; F_DMain.Panel_Main.Height := F_DMain.Height; //F_DMain.GroupBox_Folders.Height := F_DMain.Height; F_DMain.BitBtn_OK.Top := 10; F_DMain.BitBtn_OK.Caption := 'OK'; F_DMain.BitBtn_Cancel.Top := 10; F_DMain.Panel_OKCancel.Height := F_DMain.BitBtn_OK.Top * 2 + F_DMain.BitBtn_OK.Height; F_DMain.ControlBar_Tools.Visible := false; F_Dmain.Position := poDesktopCenter; case GDBMode of bkNormBase : begin for i := 3 downto 1 do //*** Оставить только тип "Папка" F_DMain.ComboBox_FolderTypes.Properties.Items.Delete(i); F_Dmain.ComboBox_FolderTypes.ItemIndex := 0; F_Dmain.CheckBox_asDefault.Visible := false; end; bkProjectManager: begin //*** Поставить тип папки по умолчанию F_Dmain.ComboBox_FolderTypes.ItemIndex := GComboIndex; //*** установить CheckBox в сохраненное состояние F_Dmain.CheckBox_asDefault.Checked := GCheck_asDefault; end; end; F_Dmain.EnableDisableEdit(false); //*** Показать форму Result := F_DMain.ShowModal; if Result = mrOk then begin //*** Сделать текущий тип создаваемой папки по умолчанию if GDBMode = bkProjectManager then begin GCheck_asDefault := F_DMAIN.CheckBox_asDefault.Checked; if F_DMAIN.CheckBox_asDefault.Checked then GComboIndex := F_Dmain.ComboBox_FolderTypes.ItemIndex; end; ParentIDCatalog := PObjectData(F_DMain.Tree_Catalog.Selected.Data).ObjectID; NewItemType := F_DMain.ComboBox_FolderTypes.ItemIndex; NewTextNode := F_DMain.Edit_NewName.Text; end; F_DMAIN.Close; F_DMAIN.Release; if Result = mrOk then begin Node := FindComponOrDirInTree(ParentIDCatalog, false); MakeDir(cfBase, Node, NewTextNode, NewItemType, nil); end; *) end; // ##### Создает дубликат главной формы ##### Function TF_MAIN.CreateSecondForm(AGDBMode: TDBKind; AFMainMode: TFMainMode; ACaption: String; AConnectType: TConnectType): TModalResult; var i, j: Integer; SavedNode: TTreeNode; Node: TTreeNode; ID_Compon: Integer; Count: Integer; DatDupl: PObjectData; DatMain: PObjectData; {PrevDat: PObjectData; PrevID: Integer; PrevVT: TItemType;} begin Result := mrNone; try try Screen.Cursor := crHourGlass; SavedNode := Tree_Catalog.Selected; ID_Compon := GSCSBase.SCSComponent.ID; {F_MAIN.}GCreatedDMAIN := true; GGDBMode := AGDBMode; //GDBMode; F_DMAIN := TF_Main.Create(Self, AGDBMode, AFMainMode); F_DMAIN.FNormBase := F_NormBase; F_DMain.FProjectMan := F_ProjMan; F_DMAIN.Visible := false; if F_DMAIN.GDBMode = bkProjectManager then begin F_DMAIN.GSCSBase.CurrProject.Open(GSCSBase.CurrProject.CurrID); //F_DMAIN.GSCSBase.CurrProject.SetCurrListByID(GSCSBase.CurrProject.CurrList.CurrID); end else begin F_DMAIN.GSCSBase.NBSpravochnik.Assign(F_NormBase.GSCSBase.NBSpravochnik); end; { F_DMAIN.Tree_Catalog.Items.BeginUpdate; F_DMAIN.Tree_Catalog.Items := Tree_Catalog.Items; F_DMAIN.Tree_Catalog.Items.EndUpdate;} {F_DMAIN.BorderStyle := bsDialog; F_DMain.Update; } {# //*** Загрузка дерева F_DMain.Tree_Catalog.Selected := F_DMain.Tree_Catalog.TopItem; Node := F_DMain.FindComponInTree(GDmainID_Compon, true); if Node <> nil then F_DMain.Tree_Catalog.Selected := Node;} //*** Загрузка дерева //if GDBMode <> bkProjectManager then begin Node := F_DMain.FindComponOrDirInTree(GDmainID_Compon, true); if Node <> nil then F_DMain.Tree_Catalog.Selected := Node; end; F_DMAIN.GDmainFindCompon := true; F_Dmain.GDmainID_Catalog := {F_Main.}GDmainID_Catalog; F_DMAIN.Caption := ACaption; {F_DMAIN.Top := Top + 40; F_DMAIN.Left := Left + 30;} F_DMAIN.Position := poDesktopCenter; //F_DMAIN.BorderStyle := bsDialog; F_DMAIN.BorderStyle := bsSizeable; F_DMAIN.FormStyle := fsNormal; F_DMAIN.DragKind := dkDrag; F_DMAIN.DragMode := dmManual; {//*** Выкинуть Главное Меню for i := 0 to F_DMAIN.MainMenu.Items.Count - 1 do F_DMAIN.MainMenu.Items[i].Visible := false;} //*** Выкинуть Панель с кнопками F_DMAIN.ControlBar_Tools.Visible := false; F_DMAIN.HideTemplateControls; F_DMAIN.Panel_Addition.Visible := false; F_DMAIN.Panel_Tree.Align := alClient; F_DMAIN.Panel_OKCancel.Visible := true; F_DMAIN.SpinEdit_Kolvo.Value := SpinEdit_Kolvo.Value; if AConnectType = cntUnion then begin F_DMAIN.SpinEdit_Kolvo.Visible := false; F_DMAIN.Label_Kolvo.Visible := false; end else begin F_DMAIN.SpinEdit_Kolvo.Visible := true; F_DMAIN.Label_Kolvo.Visible := true; end; F_Dmain.Grid_CompData.ActiveLevel.Index := 0; F_Dmain.ToolBar_CompData.Visible := false; F_Dmain.Grid_CompData.Enabled := false; //F_AddComponent.CanModifiComplect := false; F_Dmain.GEditKind := {F_Main.}GEditKind; //F_Dmain.GEnableEdit := {F_Main.}GEnableEdit; F_Dmain.GSDat := {F_Main.}GSDat; F_Dmain.Act_ClearCopyBuf.Enabled := {F_Main.}Act_ClearCopyBuf.Enabled; F_Dmain.Act_PasteDir.Enabled := {F_Main.}Act_PasteDir.Enabled; F_Dmain.GSNotDel.ObjectID := GSCSBase.SCSComponent.ID; F_Dmain.GSNotDel.ItemType := GetSCSComponType(GSCSBase.SCSComponent.IsLine); //itComponent; Tree_Catalog.Selected := SavedNode; finally Screen.Cursor := crDefault; end; //*** Показать Дубликат Формы Result := F_DMAIN.ShowModal; if Result = mrOk then begin GDropComponent.Assign(F_DMain.GSCSBase.SCSComponent, true, true); //GDropComponent.LoadComponentByID(F_DMain.GTreeComponent.ID, false {F_DMain.DM.DataSet.FN('ID').AsInteger}); GDropComponent.Count := F_DMain.SpinEdit_Kolvo.Value;//F_DMain.DM.DataSet.FN('Kol_Complect').AsInteger; end; {F_Main.}GEditKind := F_DMain.GEditKind; {F_Main.}GSDat := F_DMain.GSDat; {F_Main.}Act_ClearCopyBuf.Enabled := F_DMain.Act_ClearCopyBuf.Enabled; {F_Main.}Act_PasteDir.Enabled := F_DMain.Act_PasteDir.Enabled; GDmainIsLine := F_Dmain.GSCSBase.SCSComponent.IsLine; SpinEdit_Kolvo.Value := F_DMain.SpinEdit_Kolvo.Value; F_DMAIN.Close; FreeAndNil(F_DMAIN); Act_HideHints.Execute; except on E: Exception do AddExceptionToLog('TF_MAIN.CreateSecondForm: '+E.Message); end; end; Procedure TF_Main.ShowAddComplError(Messg: String); begin //Tree_Catalog2Change(Self, GPrewSelect); MessageModal(Messg, cMain_Msg5, MB_OK or MB_ICONINFORMATION); end; { function TF_MAIN.ChoiceAddCompl(var AComponNode: TTreeNode; var ACanAdd: Boolean; var AID_Component: Integer; AID_Child: Integer; AText: String): Boolean; var KolCompl: Integer; ModalRes: TModalResult; KolConInterf: Integer; ListItem: TListItem; ID_Comp: ^Integer; procedure Search(AID_Compon: Integer); var ComplIDList: Tlist; ComplID: ^Integer; i: Integer; begin SetSQLToQuery(DM.scsQ, ' SELECT ID_CHILD FROM COMPONENT_RELATION '+ ' WHERE ID_COMPONENT = '''+ IntToStr(AID_Compon) +''' '); ComplIDList := TList.Create; while Not DM.scsQ.Eof do begin New(ComplID); ComplID^ := DM.scsQ.FN('ID_Child').AsInteger; ComplIDList.Add(ComplID); DM.scsQ.Next; end; for i := 0 to ComplIDList.Count - 1 do begin ComplID := ComplIDList.Items[i]; KolConInterf := GetConnectInterfaces(ComplID^, AID_Child, ckVarious); if KolConInterf > 0 then begin SetSQLToQuery(DM.scsQ, ' SELECT NAME, ISLINE FROM COMPONENT '+ ' WHERE ID = '''+ IntToStr(ComplID^) +''' '); New(ID_Comp); ID_Comp^ := ComplID^; ListItem := F_CanDelete.ListView_NotDel.Items.Add; ListItem.Caption := DM.scsQ.FN('Name').AsString; ListItem.ImageIndex := GetSCSComponType(DM.scsQ.FN('isLine').AsInteger); ListItem.Data := ID_Comp; end; Search(ComplID^); end; FreeList(ComplIDList); end; begin Result := false; SetSQLToQuery(DM.scsQ, ' SELECT COUNT(*) As Cnt FROM COMPONENT_RELATION '+ ' WHERE ID_COMPONENT = '''+ IntToStr(AID_Component) +''' '); KolCompl := DM.scsQ.FN('Count').AsInteger; if KolCompl = 0 then if MessageModal(GMainFormHandle, PChar(AText + #13 + #13 + ' Добавить комплектующее не учитывая интерфейсов?'), 'Нет интерфейсов для соединения', MB_ICONQUESTION or MB_YESNO) = IDNO then ACanAdd := false; if KolCompl > 0 then with F_InputBox do begin GInputFormMode := imChoiceAddCompl; Label_Text.Caption := AText; ModalRes := ShowModal; case ModalRes of mrYes: case RadioGroup_ChioceAdd.ItemIndex of 0: ACanAdd := true; 1: begin Search(AID_Component); with F_CanDelete do begin Button_Close.Visible := false; Button_Choice.Visible := true; Button_Cancel.Visible := true; ACanAdd := false; GMode := fkCompon; if ShowModal = mrYes then if GLastSelID > 0 then begin AComponNode := Tree_Catalog.Selected; AID_Component := GLastSelID; ACanAdd := true; Result := true; end; Button_Close.Visible := true; Button_Choice.Visible := false; Button_Cancel.Visible := false; end; end; end; mrNo: ACanAdd := false; end; end; end; } // ##### Удаляет комплктующую ##### procedure TF_MAIN.DelComplect(AID_CompRel, AIDTopCompon, AIDCurrCompon, AIDChild: Integer; AComponNode: TTreeNode; AConnectType: TConnectType); var //IDCompn: Integer; //IDChild: Integer; SCSCompon: TSCSComponent; SCSChild: TSCSComponent; SCSComponent: TSCSComponent; ID_CompRel: Integer; TopComponNode: TTreeNode; ComponNode: TTreeNode; ComplNode: TTreeNode; NodeToDefineName: TTreeNode; ParentNode: TTreeNode; //TempNode: TTreeNode; i: Integer; DelNodes: TList; NodesToDefineName: TObjectList; MemTable: TkbmMemTable; begin try {if AComplNode <> nil then ComponNode := GetComponNode(AComplNode); //AComplNode.Parent; } if (AID_CompRel = 0) or (AIDCurrCompon = 0) or (AIDChild = 0) {or (AComponNode = nil) }then Exit; //ComponNode := AComponNode; //SetSQLToQuery(DM.scsQ, ' SELECT ID_COMPONENT, ID_Child FROM COMPONENT_RELATION '+ // ' WHERE ID = '''+ IntToStr(AID_CompRel) +''''); //IDCompn := DM.scsQ.GetFNAsInteger('ID_Component'); //IDChild := DM.scsQ.GetFNAsInteger('ID_Child'); //IDCompn := DM.GetCompRelFieldValueAsIntByFilter(fnIDComponent, 'ID = '''+ IntToStr(AID_CompRel) +''''); //IDChild := DM.GetCompRelFieldValueAsIntByFilter('ID_Child', 'ID = '''+ IntToStr(AID_CompRel) +''''); TopComponNode := nil; ComponNode := nil; ComplNode := nil; SCSCompon := nil; SCSChild := nil; if GDBMode = bkNormBase then begin SCSCompon := TSCSComponent.Create(TForm(Self)); SCSChild := TSCSComponent.Create(TForm(Self)); //*** Загрузить компоненты SCSCompon.LoadComponentByID(AIDCurrCompon, false); SCSChild.LoadComponentByID(AIDChild, false); //*** SCSCompon.IDTopComponent := AIDTopCompon; SCSChild.IDTopComponent := AIDTopCompon; SCSChild.IDCompRel := AID_CompRel; end else begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(AIDCurrCompon); SCSChild := GSCSBase.CurrProject.GetComponentFromReferences(AIDChild); end; if Assigned(SCSCompon) and Assigned(SCSChild) then case AConnectType of cntComplect: begin ComponNode := FindComponOrDirInTree(AIDCurrCompon, true); ComplNode := FindComponOrDirInTree(AIDChild, true); if GDBMode = bkNormBase then begin TopComponNode := FindComponOrDirInTree(AIDTopCompon, true); DefineChildNodes(ComponNode); SCSCompon.TreeViewNode := ComponNode; SCSChild.TreeViewNode := FindChildNodeByIDCompRel(TopComponNode, AID_CompRel); SCSCompon.AddChildComponent(SCSChild); //SCSCompon.TreeViewNode := ComponNode; //SCSChild.TreeViewNode := ComplNode; //SCSCompon.IDTopComponent := AIDTopCompon; //SCSChild.IDTopComponent := AIDTopCompon; //SCSChild.IDCompRel := AID_CompRel; //16.12.2008 SCSCompon.DisComplectChildComponent(SCSChild); //16.12.2008 end; //16.12.2008 if GDBMode = bkProjectManager then //16.12.2008 SCSChild.DisJoinFromAll(true, true); //16.12.2008 SCSCompon.DisComplectChildComponent(SCSChild); //if GDBMode = bkNormBase then // SCSCompon.Price_Calc := DM.GetComponFieldValueAsFloat(SCSCompon.ID, fnPriceCalc); //SetNodeState(SCSCompon.TreeViewNode, PObjectData(SCSCompon.TreeViewNode.Data).ItemType, ekNone, SCSCompon); //FreeCompRel(AID_CompRel, AIDCurrCompon, AIDChild); if GDBMode = bkProjectManager then begin //F_ChoiceConnectSide.OnAfterDisConnectCompons(SCSCompon, SCSChild); { if Assigned(SCSChild.TreeViewNode) then ComplNode := SCSChild.TreeViewNode; if Not Assigned(ComplNode) then ComplNode := FindComponOrDirInTree(IDChild, true); if Assigned(ComplNode) then begin OnAddDeleteNode(ComplNode, SCSChild, false); //SetKol(ComponNode, nil); DeleteNode(ComplNode); end; } DelCompon(SCSChild, nil, true, true, true, true); end; //else //F_ChoiceConnectSide.OnAfterDisConnectCompons(SCSCompon, SCSChild); //FreeCompRel(AID_CompRel, AIDCurrCompon, AIDChild); //DM.DefineComponNppPorts(IDCompn); //DM.DefineComponObjectFullness(IDCompn); end; cntUnion: begin //DisconnectComp(AID_CompRel, AIDCurrCompon); SCSCompon.DisJoinFrom(SCSChild); ////*** Определить подсоединенные объекты //F_ChoiceConnectSide.OnAfterDisJoinCompons(SCSCompon, SCSChild); end; end; if GDBMode = bkNormBase then begin if Assigned(SCSCompon) then FreeAndNil(SCSCompon); if Assigned(SCSChild) then if Not((AConnectType = cntComplect) and (GDBMode = bkProjectManager)) then FreeAndNil(SCSChild); end; {if (GDBMode = bkProjectManager) and (AConnectType = cntComplect) then DelCompon(IDChild); DM.ExecuteQuery(' DELETE FROM COMPONENT_RELATION WHERE ID = '''+ IntToStr(AID_CompRel) +''' '); } MemTable := nil; case AConnectType of cntComplect : MemTable := DM.MemTable_Complects; cntUnion : MemTable := DM.MemTable_Connections; end; if (MemTable <> nil) and (MemTable.Active) then if MemTable.FieldByName('ID').AsInteger = AID_CompRel then MemTable.Delete; if AConnectType = cntComplect then begin (* //OnAddDeleteNode(ComplNode, false); //SetKol(ComponNode, nil); //DeleteNode(ComplNode); //*** Удалить Ветви с удаляемой комплектующей if AComponNode <> nil then begin ComponNode := AComponNode; DelNodes := Tlist.Create; NodesToDefineName := TObjectList.Create(false); for i := 0 to Tree_Catalog.Items.Count - 1 do begin ComplNode := Tree_Catalog.Items[i]; if ComponNode <> nil then if ComplNode.HasChildren and (ComplNode.Count = 0) then if (PObjectData(ComplNode.Data).ObjectID = PObjectData(ComponNode.Data).ObjectID) and (PObjectData(ComplNode.Data).ItemType = PObjectData(ComponNode.Data).ItemType) then NodesToDefineName.Add(ComplNode); if PObjectData(ComplNode.Data).ID_CompRel = AID_CompRel then begin ////*** Обновить верхнюю ветвь количеством //TempNode := ComplNode.Parent; //TempNode.Text := ComponNode.Text; //*** Занести удаляемую ветвь в список DelNodes.Add(ComplNode); end; end; for i := 0 to DelNodes.Count - 1 do begin if i = 0 then // обновить количество 1-н раз OnAddDeleteNode(TTreeNode(DelNodes.Items[i]), nil, false); ParentNode := TTreeNode(DelNodes.Items[i]).Parent; TTreeNode(DelNodes.Items[i]).Delete; if Assigned(ParentNode) then begin if SCSComponent.ID <> PObjectData(ParentNode.Data).ObjectID then begin SCSComponent.ID := PObjectData(ParentNode.Data).ObjectID; //SCSComponent.KolComplect := DM.GetComponFieldValueAsInteger(SCSComponent.ID, fnKolComplect); SCSComponent.LoadComponentByID(SCSComponent.ID, False); end; ParentNode.Text := GetNameNode(ParentNode, SCSComponent, true, true); PObjectData(ParentNode.Data).ChildNodesCount := SCSComponent.KolComplect; if SCSComponent.KolComplect = 0 then ParentNode.HasChildren := false; end; end; SCSComponent := TSCSComponent.Create(Self); for i := 0 to NodesToDefineName.Count - 1 do begin NodeToDefineName := TTreeNode(NodesToDefineName[i]); NodeToDefineName.Text := GetNameNode(NodeToDefineName, nil, true, true); SCSComponent.ID := PObjectData(NodeToDefineName.Data).ObjectID; SCSComponent.KolComplect := DM.GetComponFieldValueAsInteger(SCSComponent.ID, fnKolComplect); PObjectData(NodeToDefineName.Data).ChildNodesCount := SCSComponent.KolComplect; if SCSComponent.KolComplect = 0 then NodeToDefineName.HasChildren := false; //SetNodeState(NodeToDefineName, PObjectData(NodeToDefineName.Data).ItemType, ekNone, SCSComponent); end; SCSComponent.Free; DelNodes.Free; NodesToDefineName.Free; end; {ComplNode := GetTopNode; //Tree_Catalog.TopItem; while ComplNode <> nil do begin if PObjectData(ComplNode.Data).ID_CompRel = AID_CompRel then begin //*** Обновить верхнюю ветвь количеством TempNode := ComplNode.Parent; TempNode.Text := ComponNode.Text; TempNode := ComplNode; //*** Удалить ветвь с комплектующей ComplNode := ComplNode.GetNext; TempNode.Delete; end else ComplNode := ComplNode.getNext; end; } //CalcPriceForParents(IDCompn); *) end; GSCSBase.SCSComponent.NotifyChange; except on E: Exception do AddExceptionToLog('TF_MAIN.DelComplect: '+E.Message); end; end; // ##### Удаляет комплектующую с дерева или Грида ##### procedure TF_MAIN.DelComplFromTreeOrGrid(AWhoChange: TWhoChange; ATreeNode: TTreeNode); var ComplName: String; ID_ComplRel: Integer; IDTopCompon: Integer; ID_Compon: Integer; ID_Compl: Integer; ComponNode: TTreeNode; ComplectNode: TTreeNode; Compl: TSCSComponent; MesgRes: Integer; begin try ID_ComplRel := -1; IDTopCompon := -1; ID_Compon := -1; ID_Compl := -1; ComponNode := nil; //Compl := TSCSComponent.Create(TF_Main(Self)); //try case AWhoChange of wcTree: begin if ATreeNode = nil then ATreeNode := Tree_Catalog.Selected; if ATreeNode <> nil then begin ComponNode := ATreeNode.Parent; ComplectNode := ATreeNode; ComplName := ATreeNode.Text; CutColFromStr(ComplName); IDTopCompon := GetTopComponIDByNode(ComponNode); ID_ComplRel := PObjectData(ATreeNode.Data).ID_CompRel; if (ID_ComplRel = 0) and (GDBMode = bkNormBase) then ID_ComplRel := DM.GetIDCompRelByConnectCompons(PObjectData(ComponNode.Data).ObjectID, PObjectData(ComplectNode.Data).ObjectID, IDTopCompon, GetIDCompRelFromNode(ComponNode), cntComplect); //ID_ComplRel := PObjectData(ATreeNode.Data).ID_CompRel; ID_Compon := PObjectData(ATreeNode.Parent.Data).ObjectID; ID_Compl := PObjectData(ATreeNode.Data).ObjectID; end; end; wcGrid: begin ComponNode := Tree_Catalog.Selected; ComplName := DM.MemTable_Complects.FieldByName('Name').AsString; IDTopCompon := GetTopComponIDByNode(ComponNode); ID_ComplRel := DM.MemTable_Complects.FieldByName('ID').AsInteger; ID_Compon := GSCSBase.SCSComponent.ID; ID_Compl := DM.MemTable_Complects.FieldByName('ID_Child').AsInteger; end; end; if ComponNode = nil then Exit; ///// EXIT ///// //if ID_Compl <> 0 then // Compl.LoadComponentByID(ID_Compl, false); //if Not HaveConnect(Compl, true) then MesgRes := IDCANCEL; if FMultipleAction then MesgRes := IDYES else MesgRes := MessageModal(cMain_Msg6_1+' "' + ComplName + '" ?', cMain_Msg6_2, MB_YESNO or MB_ICONQUESTION); if MesgRes = IDYES then begin LockTreeAndGrid(True); try // UNDO if Not FMultipleAction and Not GIsProgress then begin if GDBMode = bkProjectManager then SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); end; // DelComplect(ID_ComplRel, IDTopCompon, ID_Compon, ID_Compl, ComponNode, cntComplect); finally LockTreeAndGrid(False); end; if Not FMultipleAction then begin RefreshNode(true); EnableEditDel(itAuto); end; end; //finally //FreeAndNil(Compl); //end; except on E: Exception do AddExceptionToLog('TF_MAIN.DelComplFromTreeOrGrid: '+E.Message); end; end; procedure TF_MAIN.JoinComponentsByTreeNodes(ASrcNode, ATrgNode: TTreeNode; ASrcComponent: TSCSComponent; ACanManualChoiceInterface: Boolean); var TargetDat: PObjectData; SourceDat: PObjectData; begin TargetDat := ATrgNode.Data; SourceDat := ASrcNode.Data; ASrcComponent.TreeViewNode := ASrcNode; case TargetDat.ItemType of itComponCon, itComponLine, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner: //Tolik 26/02/2021 -- { if SourceDat.ItemType in [itComponCon, itComponLine, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner] then AddComplect(Self, ASrcNode, ATrgNode, ASrcComponent, cntUnion, 1, ACanManualChoiceInterface); } if SourceDat.ItemType in [itComponCon, itComponLine, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner] then AddComplect(Self, ASrcNode, ATrgNode, ASrcComponent, cntUnion, 1, ACanManualChoiceInterface, False, True); // end; end; function TF_MAIN.AddComplectToComponByIDs(AIDCompon, AIDComplect, AKolvo, AIDTopComponent, AIDParentCompRel: Integer; ASelectNode, ACanConnectWithoutInterf: Boolean): Boolean; var ComponNode: TTreeNode; ChildComponent: TSCSComponent; begin Result := false; ComponNode := nil; if (AIDTopComponent <> 0) and (AIDParentCompRel <> 0) then begin ComponNode := FindComponOrDirInTree(AIDTopComponent, True); ComponNode := FindChildNodeByIDCompRel(ComponNode, AIDParentCompRel); end else ComponNode := FindComponOrDirInTree(AIDCompon, True); ChildComponent := nil; case GDBMode of bkNormBase: begin ChildComponent := TSCSComponent.Create(Self); ChildComponent.LoadComponentByID(AIDComplect, false); ChildComponent.TreeViewNode := FindComponOrDirInTree(AIDComplect, True); end; bkProjectManager: ChildComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDComplect); end; if (ComponNode <> nil) and (ChildComponent <> nil) then begin Result := AddComplect(Self, nil, ComponNode, ChildComponent, cntComplect, AKolvo, false, ASelectNode, ACanConnectWithoutInterf); end; if GDBMode = bkNormBase then FreeAndNil(ChildComponent); end; // ##### Добавить комплектующую ##### function TF_MAIN.AddComplect(AFormBase: TForm; ASrcNode, ATargetNode: TTreeNode; AComplect: TSCSComponent; AConnectType: TConnectType; ACount: Integer; ACanManualJoin: Boolean; ASelectNode: Boolean; ACanConnectWithoutInterf: Boolean): Boolean; var CanConnect: Boolean; CanConnectWithOutInterfaces: Boolean; ConnectInterfRes: TConnectInterfRes; SCSObject: TSCSCatalog; DesignBoxObject: TSCSCatalog; DesignBoxObjectListOwner: TSCSList; HaveInterfaces: Boolean; SuccessConnect: Boolean; WasConnect: Boolean; ConnectKind: TConnectKind; UnionConnKind: TConnectKind; MesgChoice: String; ID_CompRel: Integer; NewIDCompl: Integer; CanInterfConnectKind: TCanConnectKind; ComponName: String; ComplNode: TTreeNode; NewNode: TTreeNode; Node: TTreeNode; Dat: PObjectData; Expanded: Boolean; i, j, k: Integer; CalcCaption: PChar; NodeList: TList; //TakeBusyCompon: Boolean; //TakeBusyCompl: Boolean; CommonParentCompon: TSCSComponent; ComponParent: TSCSComponent; ComponChild: TSCSComponent; ptrComplect: PComplect; //isLineCompon: Integer; //isLineCompl: Integer; //NetTypeCompon: TNetType; //NetTypeCompl: TNetType; ConnBusyEmpty: Boolean; InterfRel1: Integer; InterfRel2: Integer; ConnectedCount: Integer; CopiedFromSrcBase: Boolean; //*** список подключаемых компонент ConnectingComponents: TSCSComponents; CurrConnectingCompon: TSCSComponent; //*** существующие внутрикомпонентые подключения в НБ ComponNBConnections: TSCSObjectList; ComplectNBConnections: TSCSObjectList; //*** расгруппированные компоненты RegroupedNBCompons: TSCSComponents; RegroupedNBComplects: TSCSComponents; RegroupedNBCompon: TSCSComponent; RegroupedNBComplect: TSCSComponent; NewNBConnection: TSCSCrossConnection; DisabledComponentsToJoin: TSCSComponents; CommonParentComponNode: TTreeNode; IDCommonParentCompon: Integer; CompRelFromPath: TIntList; CompRelToPath: TIntList; CrossConnection: TSCSCrossConnection; begin Result := false; GisAddEditingComplect := true; ComponName := ATargetNode.Text; CutColFromStr(ComponName); CanConnect := true; CanConnectWithOutInterfaces := false; HaveInterfaces := true; SuccessConnect := false; WasConnect := false; UnionConnKind := cnkNone; ConnectKind := cnkNone; CanInterfConnectKind := cckNone; ComponParent := nil; ComponChild := nil; SCSObject := nil; ConnectedCount := 0; NewNode := nil; //*** существующие внутрикомпонентые подключения в НБ ComponNBConnections := nil; ComplectNBConnections := nil; //*** расгруппированные компоненты RegroupedNBCompons := nil; RegroupedNBComplects := nil; CommonParentComponNode := nil; IDCommonParentCompon := -1; CompRelFromPath := nil; CompRelToPath := nil; case GDBMode of bkNormBase: begin ComponParent := TSCSComponent.Create(Self); ComponParent.IDTopComponent := GetTopComponIDByNode(ATargetNode); ComponParent.IDCompRel := GetIDCompRelFromNode(ATargetNode); //PObjectData(ATargetNode.Data).ID_CompRel; ComponParent.LoadComponentByID(PObjectData(ATargetNode.Data).ObjectID, true, true, false); ComponParent.TreeViewNode := ATargetNode; {ComponChild := TSCSComponent.Create(Self); ComponChild.Assign(AComplect); if ComponChild.Interfaces.Count = 0 then ComponChild.LoadInterfaces(-1, false);} end; bkProjectManager: begin ComponParent := GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ATargetNode.Data).ObjectID); if ComponParent <> nil then SCSObject := ComponParent.GetFirstParentCatalog; {case TF_Main(AFormBase).GDBMode of bkNormBase: ComponChild := nil; bkProjectManager: ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(AComplect.ID); end;} end; end; case TF_Main(AFormBase).GDBMode of bkNormBase: begin ComponChild := TSCSComponent.Create(Self); ComponChild.Assign(AComplect, true, true); ComponChild.IDTopComponent := GetTopComponIDByNode(ASrcNode); ComponChild.IDCompRel := GetIDCompRelFromNode(ASrcNode); if ComponChild.Interfaces.Count = 0 then ComponChild.LoadInterfaces(-1, false); //ComponChild.LoadChildComplects(true, false, false, ComponChild.IDTopComponent, ComponChild.IDCompRel); ComponChild.LoadChildComplectsQuick(true, false, true, ComponChild.IDTopComponent, ComponChild.IDCompRel); end; bkProjectManager: begin ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(AComplect.ID); end; end; UnionConnKind := GetConnectKind(ComponParent.isLine, AComplect.isLine); //*** Проверка на возможность соединения //CanConnect := CanConnCompon(ComponParent, AComplect, AConnectType, smtDisplay); CanConnect := CanConnCompon(ComponParent, ComponChild, AConnectType, smtDisplay); if CanConnect then begin CanInterfConnectKind := cckNone; ZeroMemory(@ConnectInterfRes, SizeOf(ConnectInterfRes)); case AConnectType of cntComplect: begin ConnectInterfRes := ComponParent.CheckComplectWith(ComponChild, false, true); if ConnectInterfRes.ConnectInterfCount > 0 then CanInterfConnectKind := cckAuto; ConnectKind := cnkVarious; end; cntUnion: begin if Not ACanConnectWithoutInterf then ACanConnectWithoutInterf := CheckJoinComponsWithoutInterf(ComponParent, ComponChild); //19.05.2011 if (GDBMode = bkProjectManager) and //Not CheckConnectedComponObjectsInCAD(ComponParent, ComponChild) then Not CheckJoinComponsByObjects(ComponParent, ComponChild) then begin CanConnect := false; MessageModal(cMain_Msg7_1+' "'+ComponParent.GetNameForVisible+'" '+cMain_Msg7_2+' "'+ComponChild.GetNameForVisible+ '" '+cMain_Msg7_3, ApplicationName, MB_OK or MB_ICONINFORMATION); end else begin ConnectInterfRes := ComponParent.CheckJoinTo(ComponChild, -1, -1, true); if ConnectInterfRes.ConnectInterfCount > 0 then begin if ACanManualJoin then CanInterfConnectKind := cckManual else CanInterfConnectKind := cckAuto; if GDBMode = bkNormBase then begin //*** определить количество в позиции ComponParent.Count := DM.GetIntFromTableByID(tnComponentRelation, fnKolvo, ComponParent.IDCompRel, qmPhisical); ComponChild.Count := DM.GetIntFromTableByID(tnComponentRelation, fnKolvo, ComponChild.IDCompRel, qmPhisical); if ComponParent.Count = 0 then ComponParent.Count := 1; if ComponChild.Count = 0 then ComponChild.Count := 1; CommonParentComponNode := GetCommonParentComponNode(ComponParent.TreeViewNode, AComplect.TreeViewNode); if CommonParentComponNode <> nil then IDCommonParentCompon := PObjectData(CommonParentComponNode.Data).ObjectID; if IDCommonParentCompon <> 0 then begin //*** Проверить, не находятся ли подключаемые компоненты в кросс-соединении ConnectingComponents := TSCSComponents.Create(false); ConnectingComponents.Add(ComponParent); ConnectingComponents.Add(ComponChild); CommonParentCompon := TSCSComponent.Create(Self); try CommonParentCompon.ID := IDCommonParentCompon; CommonParentCompon.LoadCrossConnections; for i := 0 to CommonParentCompon.CrossConnections.Count - 1 do begin CrossConnection := TSCSCrossConnection(CommonParentCompon.CrossConnections[i]); //*** Если это не обычное подключени, а кросс-соединение if CrossConnection.IDCompRelWith <> 0 then for j := 0 to ConnectingComponents.Count - 1 do begin CurrConnectingCompon := ConnectingComponents[j]; if CurrConnectingCompon.IsCrossComponent then if (CurrConnectingCompon.IDCompRel = CrossConnection.IDCompRelWith) or (CurrConnectingCompon.IDCompRel = CrossConnection.IDCompRelFrom) or (CurrConnectingCompon.IDCompRel = CrossConnection.IDCompRelTo) then begin MessageModal(cNameComponentB+' '+CurrConnectingCompon.Name+' '+cMain_Msg134, ApplicationName, MB_ICONINFORMATION or MB_OK); CanConnect := false; Break; //// BREAK //// end; end; if Not CanConnect then Break; //// BREAK //// end; finally FreeAndNil(CommonParentCompon); FreeAndNil(ConnectingComponents); end; end; if CanConnect then begin CompRelFromPath := TIntList.Create; CompRelToPath := TIntList.Create; LoadCompRelPathIDsToListFromNode(CompRelFromPath, IDCommonParentCompon, ComponParent.TreeViewNode); LoadCompRelPathIDsToListFromNode(CompRelToPath, IDCommonParentCompon, AComplect.TreeViewNode); //*** подгрузить внутрикомпонетные подключения ComponNBConnections := GetComponNodeNBConnections(ComponParent.TreeViewNode); ComplectNBConnections := GetComponNodeNBConnections(AComplect.TreeViewNode); //*** расгруппировать компоненты, учитывая подключения RegroupedNBCompons := GetRegroupedNBComponentByInternalConnections(ComponParent, ComponNBConnections, IDCommonParentCompon, CompRelFromPath); RegroupedNBComplects := GetRegroupedNBComponentByInternalConnections(ComponChild, ComplectNBConnections, IDCommonParentCompon, CompRelToPath); FreeAndNil(ComponNBConnections); FreeAndNil(ComplectNBConnections); end; end; end; ConnectKind := cnkVarious or cnkMaleMale; end; end; end; if CanConnect and (CanInterfConnectKind = cckNone) then begin if AConnectType = cntComplect then MesgChoice := ' '+cMain_Msg8_1+' "'+ ComponName +'" '+cMain_Msg8_2+' "'+ AComplect.Name +'" '+cMain_Msg8_3 else begin if GUseVisibleInterfaces then MesgChoice := cMain_Msg9_1+' "'+ ComponName +'" '+cMain_Msg9_2 else MesgChoice := cMain_Msg9_2_1; end; HaveInterfaces := false; CanConnect := false; CanConnectWithOutInterfaces := ACanConnectWithoutInterf; if (ACanConnectWithoutInterf) or (F_InputBox.ChoiceAddCompl(AFormBase, ATargetNode, CanConnectWithOutInterfaces, ComponParent, AComplect, AConnectType, ConnectKind, MesgChoice)) then begin HaveInterfaces := true; CanInterfConnectKind := cckAuto; CanConnect := true; end; if CanConnectWithOutInterfaces then CanConnect := true; end; if (HaveInterfaces) and (CanInterfConnectKind = cckManual) and (AConnectType = cntUnion) then begin WasConnect := F_ChoiceConnectSide.ChoiceSides(ComponParent, AComplect, ConnectKind); CanConnect := false; end; end; //*** Соединение интерфейсами if CanConnect = true then begin DefineChildNodes(ATargetNode); ptrComplect := nil; i := 0; case GDBMode of bkNormBase: for i := 0 to ACount - 1 do begin SuccessConnect := false; if CanConnect then begin case AConnectType of cntComplect: if ptrComplect = nil then begin ComponChild.TreeViewNode := nil; ptrComplect := ComponParent.ComplectWith(ComponChild, -1, CanConnectWithOutInterfaces); if ptrComplect <> nil then begin SuccessConnect := true; WasConnect := true; ComponChild.IDCompRel := ptrComplect.ID; NewNode := AddComplNode(ATargetNode, ComponChild); OnAddDeleteNode(NewNode, nil, nil, true); ComponChild.TreeViewNode := NewNode; NewNode.Text := GetNameNode(NewNode, ComponChild, true, true); //ATargetNode.Text := GetNameNode(ATargetNode, ComponParent, true, true); ATargetNode.Text := GetNameNode(ATargetNode, nil, true, true); end; end else begin SetChildComponInterfacesToNoBusy(ComponParent, ComponChild, ptrComplect.ID); //if ConnectCompons(ComponParent, ComponChild, cnkVarious, cntComplect, ptrComplect.ID) or // CanConnectWithOutInterfaces then if ComponParent.ComplectWith(ComponChild, ptrComplect.ID, CanConnectWithOutInterfaces) <> nil then begin SuccessConnect := true; WasConnect := true; //Inc(ptrComplect.Kolvo); ////Inc(ComponChild.Count); //DM.UpdateCompRelFieldAsInteger(ptrComplect.ID, ptrComplect.Kolvo, fnKolvo); end; end; cntUnion: begin WasConnect := false; if Assigned(RegroupedNBCompons) and Assigned(RegroupedNBComplects) and (IDCommonParentCompon <> -1) then begin DisabledComponentsToJoin := TSCSComponents.Create(false); for j := 0 to RegroupedNBCompons.Count - 1 do begin RegroupedNBCompon := RegroupedNBCompons[j]; if DisabledComponentsToJoin.IndexOf(RegroupedNBCompon) = -1 then for k := 0 to RegroupedNBComplects.Count - 1 do begin RegroupedNBComplect := RegroupedNBComplects[k]; if DisabledComponentsToJoin.IndexOf(RegroupedNBComplect) = -1 then if RegroupedNBCompon.CheckJoinTo(RegroupedNBComplect, -1, -1).CanConnect then begin //*** занять в объектах подключенные интерфейсы RegroupedNBCompon.JoinToAsNoFinal(RegroupedNBComplect, -1, -1); NewNBConnection := TSCSCrossConnection.Create(Self); //ZeroMemory(@NewNBConnection, SizeOf(NewNBConnection)); NewNBConnection.IDComponent := IDCommonParentCompon; NewNBConnection.IDCompRelFrom := ComponParent.IDCompRel; NewNBConnection.IDCompRelTo := ComponChild.IDCompRel; NewNBConnection.NppFrom := j; NewNBConnection.NppTo := k; NewNBConnection.IDComponFrom := ComponParent.ID; NewNBConnection.IDComponTo := ComponChild.ID; NewNBConnection.NameFrom := ComponParent.Name; NewNBConnection.NameTo := ComponChild.Name; //LoadCompRelPathIDsToListFromNode(NewNBConnection.CompRelFromPath, IDCommonParentCompon, ComponParent.TreeViewNode); //LoadCompRelPathIDsToListFromNode(NewNBConnection.CompRelToPath, IDCommonParentCompon, AComplect.TreeViewNode); NewNBConnection.CompRelFromPath.Assign(CompRelFromPath, laCopy); NewNBConnection.CompRelToPath.Assign(CompRelToPath, laCopy); NewNBConnection.Save(meMake, true); //DM.InsertUpdateCrossConnection(meMake, NewNBConnection); if GSCSBase.SCSComponent.ID = ComponParent.ID then DM.AddNBConnectionToMemTable(DM.MemTable_Connections, IDCommonParentCompon, ComponParent.ID, NewNBConnection) else if GSCSBase.SCSComponent.ID = ComponChild.ID then DM.AddNBConnectionToMemTable(DM.MemTable_Connections, IDCommonParentCompon, ComponChild.ID, NewNBConnection); DisabledComponentsToJoin.Add(RegroupedNBCompon); DisabledComponentsToJoin.Add(RegroupedNBComplect); WasConnect := true; SuccessConnect := true; Break; //// BREAK //// end; end; //if WasConnect then // Break; //// BREAK //// end; FreeAndNil(DisabledComponentsToJoin); end; end; end; end; if SuccessConnect then Inc(ConnectedCount) else begin //*** Небыло соединения по интерфейсам HaveInterfaces := false; if Not CanConnectWithOutInterfaces then CanConnect := false; Break; ///// BREAK ///// end; end; bkProjectManager: for i := 0 to ACount - 1 do begin // UNDO if i = 0 then begin if GSCSBase.CurrProject.CurrList.Setting.ListType = lt_Normal then SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID) else if GSCSBase.CurrProject.CurrList.Setting.ListType = lt_DesignBox then begin //DesignBoxObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(GSCSBase.CurrProject.CurrList.Setting.IDFigureForDesignList); //if DesignBoxObject <> nil then // SaveListToUndoStack(DesignBoxObject.ListID); end; end; CopiedFromSrcBase := false; //*** Подгрузить компоненту в "менеджер проектов" которая будет комплектующей if (AConnectType = cntComplect) and (ACount > 0) and (CanConnect = true) then begin ComponChild := nil; //if (CanConnComponByinterf(AFormBase, ComponParent, AComplect, // ConnectKind, AConnectType) = cckAuto) or (CanConnect) then if ComponParent.CheckComplectWith(ComponChild, false, true).CanConnect or CanConnect then begin //20.09.2010 NewIDCompl := CopyComponentFromNbToPm(AFormBase, FProjectMan, nil, ATargetNode, AComplect.ID, ckCompl, true); NewIDCompl := CopyComponentFromNbToPm(AFormBase, FProjectMan, ASrcNode, ATargetNode, AComplect.ID, ckCompl, true); //NewIDCompl := CopyComponentFromNbToPm(AFormBase, FProjectMan, SCSObject.TreeViewNode, AComplect.ID, ckCompon, true); ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(NewIDCompl); CopiedFromSrcBase := true; end; //*** После копирования указатель перейдет на 1-ю скопированную ветвь if Not Assigned(ComponChild) then begin CanConnect := false; HaveInterfaces := false; SuccessConnect := false; end; end; SuccessConnect := false; ptrComplect := nil; if CanConnect then //if HaveInterfaces then case AConnectType of cntComplect: ptrComplect := ComponParent.ComplectWith(ComponChild, -1, ComponChild.IsCrossComponent or (CanInterfConnectKind = cckNone)); cntUnion: begin //19.05.2011 ptrComplect := F_ChoiceConnectSide.JoinWithDefineSides(ComponParent, ComponChild, false).CompRel; if CheckJoinComponsWithoutObjSides(ComponParent, ComponChild) then ptrComplect := ComponParent.JoinTo(ComponChild, 0, 0, true, nil, nil, -1, true, CanConnectWithOutInterfaces).CompRel else ptrComplect := F_ChoiceConnectSide.JoinWithDefineSides(ComponParent, ComponChild, false, nil, nil, CanConnectWithOutInterfaces).CompRel; end; end; if ptrComplect <> nil then SuccessConnect := true; if SuccessConnect then Inc(ConnectedCount) else begin if CopiedFromSrcBase then DelCompon(ComponChild, nil, false, true, true, false); if Not CanConnectWithOutInterfaces then CanConnect := false; Break; ///// BREAK ///// end; end; end; if Not SuccessConnect then if GUseVisibleInterfaces then begin if i = 0 then begin MessageModal(cMain_Msg10_1+' "'+ ComponParent.GetNameForVisible +'" '+cMain_Msg10_2+' "'+AComplect.GetNameForVisible+'".'+#13, ApplicationName, MB_ICONINFORMATION or MB_OK); end else begin MessageModal(cMain_Msg11_1+' '+ IntToStr(i) +' '+cMain_Msg11_2, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; end; try LockTreeAndGrid(true); if ConnectedCount > 0 then case AConnectType of cntComplect: begin ComplNode := nil; ComplNode := FindComponOrDirInTree(ComponChild.ID, true); //*** Добавить комплектующую в нормативную базу if {CanConnect and} (GDBMode = bkNormBase) then begin //ComponParent.Price_Calc := DM.GetComponFieldValueAsFloat(ComponParent.ID, fnPriceCalc); if NewNode <> nil then begin FillCompl(PObjectData(NewNode.Data).ObjectID, NewNode, nil); if ASelectNode then Tree_Catalog.Selected := NewNode; end; end; if {CanConnect and} (GDBMode = bkProjectManager) then begin if (ComponParent <> nil) and (ComponParent.TreeViewNode = ATargetNode) then ClearTVNodeFieldInChildObjects(ComponParent, false); DeleteChildNodes(ATargetNode); FillCompl(PObjectData(ATargetNode.Data).ObjectID, ATargetNode, nil); if ASelectNode then Tree_Catalog.Selected := ATargetNode.GetLastChild; end; //SetNodeState(ComponParent.TreeViewNode, PObjectData(ComponParent.TreeViewNode.Data).ItemType, ekNone, ComponParent); //F_ChoiceConnectSide.OnAfterConnectCompons(ComponParent, ComponChild); // Выйти на прежнюю позицию компонента with DM do begin GisAddEditingComplect := false; (* //*** Обновить ветви добавленой комплектующей, где данная компонента //*** используется в качестве комплектующей if (GDBMode = bkNormBase) {and (CanConnect)} then begin //*** Занести в список нужные ветви дерева NodeList := TList.Create; for i := 0 to Tree_Catalog.Items.Count - 1 do begin Dat := Tree_Catalog.Items[i].Data; if Tree_Catalog.Items[i] <> ATargetNode then if Dat.ObjectID = ComponParent.ID then NodeList.Add(Tree_Catalog.Items[i]); end; for i := 0 to NodeList.Count - 1 do begin Node := NodeList.Items[i]; Expanded := Node.Expanded; DeleteChildNodes(Node); FillCompl(PObjectData(Node.Data).ObjectID, Node); Node.Expanded := Expanded; //Node.Text := ATargetNode.Text; Node.Text := GetNameNode(Node, nil, true, true); end; NodeList.Clear; FreeAndNil(NodeList); end; *) end; //DM.SelectCompRel(ComponParent); //DM.MemTable_Complects.Locate(fnID, ComponChild.IDCompRel, []); if ComponChild.IsCrossComponent then begin LockTreeAndGrid(false); if GIsProgress then PauseProgress(true); try AddCrossConnectionToParentComponent(ComponParent, ComponChild); finally if GIsProgress then PauseProgress(true); end; end; end; cntUnion: begin if (GDBMode = bkProjectManager) {and CanConnect and (SuccessConnect = true) }then begin F_ChoiceConnectSide.RefreshCurrListComponents; RefreshNode; end; EnableEditDel(itAuto); end; end; //if WasConnect then // EnableEditDel(itAuto); if GDBMode = bkNormBase then begin FreeAndNil(ComponChild); FreeAndNil(ComponParent); end; if RegroupedNBCompons <> nil then FreeAndNil(RegroupedNBCompons); if RegroupedNBComplects <> nil then FreeAndNil(RegroupedNBComplects); if CompRelFromPath <> nil then FreeAndNil(CompRelFromPath); if CompRelToPath <> nil then FreeAndNil(CompRelToPath); Result := CanConnect; finally LockTreeAndGrid(false); end; end; (* // ##### Добавить комплектующую ##### function TF_MAIN.AddComplect(AFormBase: TForm; ATargetNode: TTreeNode; AComplect: TSCSComponent; AConnectType: TConnectType): Boolean; var CanConnect: Boolean; HaveInterfaces: Boolean; SuccessConnect: Boolean; ConnectKind: TConnectKind; UnionConnKind: TConnectKind; MesgChoice: String; ID_CompRel: Integer; NewIDCompl: Integer; CanConnectKind: TCanConnectKind; ComponName: String; ComplNode: TTreeNode; NewNode: TTreeNode; Node: TTreeNode; Dat: PObjectData; Expanded: Boolean; i: Integer; CalcCaption: PChar; NodeList: TList; //TakeBusyCompon: Boolean; //TakeBusyCompl: Boolean; ComponParent: TSCSComponent; ComponChild: TSCSComponent; ptrComplect: PComplect; //isLineCompon: Integer; //isLineCompl: Integer; //NetTypeCompon: TNetType; //NetTypeCompl: TNetType; ConnBusyEmpty: Boolean; InterfRel1: Integer; InterfRel2: Integer; begin Result := false; GisAddEditingComplect := true; ComponName := ATargetNode.Text; CutColFromStr(ComponName); CanConnect := true; HaveInterfaces := true; SuccessConnect := false; UnionConnKind := cnkNone; ConnectKind := cnkNone; CanConnectKind := cckNone; ComponParent := nil; ComponChild := nil; case GDBMode of bkNormBase: begin ComponParent := TSCSComponent.Create(Self); ComponParent.LoadComponentByID(PObjectData(ATargetNode.Data).ObjectID); ComponChild := TSCSComponent.Create(Self); ComponChild.Assign(AComplect); end; bkProjectManager: begin ComponParent := GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ATargetNode.Data).ObjectID); case TF_Main(AFormBase).GDBMode of bkNormBase: ComponChild := nil; bkProjectManager: ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(AComplect.ID); end; end; end; UnionConnKind := GetConnectKind(ComponParent.isLine, AComplect.isLine); //*** Проверка на возможность соединения CanConnect := CanConnCompon(ComponParent, AComplect, AConnectType, smtDisplay); if CanConnect then begin case AConnectType of cntComplect: ConnectKind := cnkVarious; cntUnion : ConnectKind := cnkVarious or cnkMaleMale; end; CanConnectKind := CanConnComponByinterf(AFormBase, ComponParent, AComplect, ConnectKind, AConnectType); if CanConnectKind = cckNone then begin if AConnectType = cntComplect then MesgChoice := ' Компонент "'+ ComponName +'" и комплектующее "'+ AComplect.Name +'" не имеют общих интерфейсов для соединения' else MesgChoice := 'У компоненты "'+ ComponName +'" нет свободных подходящих интерфейсов для соединения'; HaveInterfaces := false; if F_InputBox.ChoiceAddCompl(AFormBase, ATargetNode, CanConnect, ComponParent, AComplect, AConnectType, ConnectKind, MesgChoice) then begin HaveInterfaces := true; CanConnectKind := cckAuto; end; end; if (HaveInterfaces) and (CanConnectKind = cckManual) and (AConnectType = cntUnion) then SuccessConnect := F_ChoiceConnectSide.ChoiceSides(ComponParent, AComplect, ConnectKind); end; //*** Соединение интерфейсами if CanConnect = true then for i := 0 to AComplect.Count - 1 do begin //*** Подгрузить компоненту в "менеджер проектов" которая будет комплектующей if (GDBMode = bkProjectManager) and (AConnectType = cntComplect) and (AComplect.Count > 0) and (CanConnect = true) then begin ComponChild := nil; if CanConnComponByinterf(AFormBase, ComponParent, AComplect, ConnectKind, AConnectType) = cckAuto then begin NewIDCompl := CopyComponentFromNbToPm(AFormBase, FProjectMan, ATargetNode, AComplect.ID, ckCompl); ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(NewIDCompl); end; //*** После копирования указатель перейдет на 1-ю скопированную ветвь //if NewIDCompl = 0 then //AComplect.ID := NewIDCompl if Not Assigned(ComponChild) then begin CanConnect := false; HaveInterfaces := false; SuccessConnect := false; end; end; if HaveInterfaces then begin if (CanConnectKind = cckAuto){# and (AConnectType = cntComplect) }then SuccessConnect := ConnectCompons(ComponParent, ComponChild, ConnectKind, AConnectType); end; if (Not SuccessConnect) and (GDBMode = bkNormBase) then begin //*** Небыло соединения по интерфейсам HaveInterfaces := false; if (i<>0) and (i < AComplect.Count - 1) then begin ShowAddComplError('В компонент "'+ ComponName +'" может быть добавлено только ' + IntToStr(i) + ' шт. комплектующих "'+ AComplect.Name +'"'); AComplect.Count := i; end; if GDBMode = bkProjectManager then DelCompon(ComponChild, false, true, true); break; end; if (GDBMode = bkprojectManager) and (CanConnectKind <> cckManual) and (CanConnect = true){# and (AConnectType = cntComplect) }then begin ID_CompRel := AppendToComponRel(ComponParent.ID, ComponChild.ID, 1, AConnectType); if GDBMode = bkprojectManager then if Assigned(ComponChild) then begin ptrComplect := ComponParent.ComplectWithOnlyObject(ComponChild); if ptrComplect <> nil then ptrComplect.ID := ID_CompRel; end; end; end; try LockTreeAndGrid(true); case AConnectType of cntComplect: begin ComplNode := nil; ComplNode := FindComponOrDirInTree(ComponChild.ID, true); //*** Добавить комплектующую в нормативную базу if CanConnect and (GDBMode = bkNormBase) then begin ID_CompRel := AppendToComponRel(ComponParent.ID, ComponChild.ID, AComplect.Count, AConnectType); //*** Добавленную комплектующую добавить в дерево ComponChild.IDCompRel := ID_CompRel; NewNode := AddComplNode(ATargetNode, ComponChild); OnAddDeleteNode(NewNode, nil, true); if NewNode <> nil then begin FillCompl(PObjectData(NewNode.Data).ObjectID, NewNode); Tree_Catalog.Selected := NewNode; end; end; if CanConnect and (GDBMode = bkProjectManager) then begin ATargetNode.DeleteChildren; FillCompl(PObjectData(ATargetNode.Data).ObjectID, ATargetNode); Tree_Catalog.Selected := ATargetNode.GetLastChild; end; //if CanConnect then // if ComplNode <> nil then // OnAddDeleteNode(ComplNode, true); //SetKol(ATargetNode, nil); F_ChoiceConnectSide.OnAfterConnectCompons(ComponParent, ComponChild); // Выйти на прежнюю позицию компонента with DM do begin GisAddEditingComplect := false; //*** Обновить ветви добавленой комплектующей, где данная компонента //*** используется в качестве комплектующей if (GDBMode = bkNormBase) and (CanConnect) then begin //*** Занести в список нужные ветви дерева NodeList := TList.Create; for i := 0 to Tree_Catalog.Items.Count - 1 do begin Dat := Tree_Catalog.Items[i].Data; if Tree_Catalog.Items[i] <> ATargetNode then if Dat.ObjectID = ComponParent.ID then NodeList.Add(Tree_Catalog.Items[i]); end; for i := 0 to NodeList.Count - 1 do begin Node := NodeList.Items[i]; Expanded := Node.Expanded; DeleteChildNodes(Node); FillCompl(PObjectData(Node.Data).ObjectID, Node); Node.Expanded := Expanded; //Node.Text := ATargetNode.Text; Node.Text := GetNameNode(Node, nil, true, true); end; NodeList.Clear; FreeAndNil(NodeList); end; {//*** Обновить ветвь комплектующими текущей компоненты if (GDBMode = bkProjectManager) and (CanEdit = true) then begin ATargetNode.DeleteChildren; FillCompl(PObjectData(ATargetNode.Data).ObjectID, ATargetNode, DM.scsQ1); end;} end; {//*** Установить позицию на добавленную омпл-ю Node := ATargetNode.getFirstChild; while Node <> nil do begin if PObjectData(Node.Data).ID_CompRel = ID_CompRel then begin ATargetNode := Node; Break; end; Node := Node.getNextSibling; end; } end; cntUnion: if (GDBMode = bkProjectManager) and CanConnect {and (SuccessConnect = true) }then begin F_ChoiceConnectSide.RefreshCurrListComponents; Tree_Catalog.OnChange(Tree_Catalog, Tree_Catalog.Selected); //DM.SelectInterfaces; //DM.select end; end; if CanConnect then EnableEditDel(itAuto); if GDBMode = bkNormBase then begin FreeAndNil(ComponParent); FreeAndNil(ComponChild); end; Result := CanConnect; finally LockTreeAndGrid(false); end; end; *) procedure TF_MAIN.RefreshNodesText(AParentNode: TTreeNode; AItemTypes: TIntSet); procedure StepRefreshText(ANode: TTreeNode); var CurrNode: TTreeNode; NodeDat: PObjectData; begin if ANode = nil then Exit; //// EXIT //// CurrNode := ANode.getFirstChild; while CurrNode <> nil do begin StepRefreshText(CurrNode); CurrNode := CurrNode.getNextSibling; end; NodeDat := ANode.Data; if NodeDat.ItemType in AItemTypes then ANode.Text := GetNameNode(ANode, nil, true, true); end; begin try if AParentNode = nil then Exit; //// EXIT ///// StepRefreshText(AParentNode); except on E: Exception do AddExceptionToLog('TF_MAIN.RefreshNodesText: '+E.Message); end; end; procedure TF_MAIN.RememberIDLastNBDir(ANode: TTreeNode); var Catalog: TCatalog; Dat: PobjectData; begin if (ANode = nil) or (ANode.Data = nil) then Exit; ///// EXIT ///// if GDBMode <> bkNormBase then Exit; ///// EXIT ///// Dat := ANode.Data; case Dat.ItemType of itDir: GSCSIni.NB.IDLastNBDir := Dat.ObjectID; itComponCon, itComponLine: begin Catalog := DM.GetCatalogByCompon(Dat.ObjectID); GSCSIni.NB.IDLastNBDir := Catalog.ID; end; end; end; // ##### Задает новое имя ветви (и в базе) ##### function TF_MAIN.RenameNode(ACallFrom: TCallFrom; ANode: TTreeNode; AObject: TBasicSCSClass; ANewName: String): String; var i, Len: Integer; ResName: String; ResNameCAD: String; OldName: String; Dat: PObjectData; SCSList: TSCSList; PartNode: TTreeNode; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; PartCompon: TSCSComponent; DesignList: TSCSList; CreatedObjectHere: Boolean; OldProjectParams: TProjectParams; OldListParams: TListParams; begin try Result := ''; if Assigned(ANode) then Result := ANode.Text; SCSCatalog := nil; SCSComponent := nil; DesignList := nil; CreatedObjectHere := false; //if ANewName = '' then // Exit; ///// EXIT ///// ResName := ANewName; //ANode.Text; Dat := ANode.Data; case Dat.ItemType of itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: begin SCSCatalog := nil; if (GDBMode = bkNormBase) or (Dat.QueryMode = qmPhisical) {(Dat.ItemType = itProject)} then begin CreatedObjectHere := true; SCSCatalog := TSCSCatalog.Create(TForm(Self)); SCSCatalog.QueryMode := qmPhisical; end; try if CreatedObjectHere then SCSCatalog.LoadCatalogByID(Dat.ObjectID, false, false) else if (AObject is TSCSCatalog) and (TSCSCatalog(AObject).ID = Dat.ObjectID) then SCSCatalog := TSCSCatalog(AObject) else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if SCSCatalog = nil then Exit; //// EXIT //// if SCSCatalog.ItemType = itProject then OldProjectParams := GetCurrProjectParams else if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then OldListParams := TSCSList(SCSCatalog).GetParams; OldName := SCSCatalog.Name; SCSCatalog.Name := ANewName; if ACallFrom = cfCAD then if CheckIsNameChanged(SCSCatalog.ListID, SCSCatalog.SCSID) then SCSCatalog.IsUserName := biTrue else SCSCatalog.IsUserName := biFalse; //SCSCatalog.NameShort := ANewName; //SCSCatalog.IsUserName := biTrue; SCSCatalog.Save; if ((GDBMode = bkNormBase) and (Dat.ItemType = itDir)) or ((GDBMode = bkProjectManager) and (Dat.ItemType in [itSCSLine, itSCSConnector]) ) then ResName := GetNameNode(ANode, SCSCatalog, true, false); if Dat.ItemType = itSCSConnector then F_ChoiceConnectSide.RefreshCurrListComponents; //*** Переименовать на Cad-e if GDBMode = bkProjectManager then if ACallFrom = cfBase then case Dat.ItemType of itSCSLine, itSCSConnector: begin ResNameCAD := SCSCatalog.Name; //GetObjNameForVisible(SCSCatalog, ppCAD); if OldName <> ResNameCAD then begin SCSList := SCSCatalog.GetListOwner; if (SCSList <> nil) and (SCSList.OpenedInCAD) then SetNewObjectNameInCad(SCSCatalog.ListID, SCSCatalog.SCSID, OldName, ResNameCAD); end; end; itList: begin if TSCSList(SCSCatalog).OpenedInCAD then RenameListInCAD(SCSCatalog.SCSID, OldName, SCSCatalog.GetNameForVisible, @OldListParams); //RenameListInCAD(SCSCatalog.SCSID, OldName, ResName); GSCSBase.CurrProject.UpdateDesignListsNamesByOwnerList(TSCSList(SCSCatalog)); end; itProject: begin SetListsNamesInProject(SCSCatalog.Name); if GSCSBase.CurrProject.Active then begin GSCSBase.CurrProject.Name := ANewName; RenameProjectOnFrame(OldProjectParams); end; end; end; ResName := GetNameAndKol(ResName, SCSCatalog.KolCompon); if GSCSBase.SCSCatalog.ID = Dat.ObjectID then GSCSBase.SCSCatalog.Assign(SCSCatalog); //GSCSBase.SCSCatalog.LoadCatalogByID(Dat.ObjectID, false, false); SCSCatalog.NotifyChange; finally if CreatedObjectHere then FreeAndNil(SCSCatalog); end; end; //itComponLine, itComponCon: else if IsComponItemType(Dat.ItemType) then begin SCSComponent := nil; if GDBMode = bkNormBase then SCSComponent := TSCSComponent.Create(TForm(Self)); try if GDBMode = bkNormBase then SCSComponent.LoadComponentByID(Dat.ObjectID, false) else if (AObject is TSCSComponent) and (TSCSComponent(AObject).ID = Dat.ObjectID) then SCSComponent := TSCSComponent(AObject) else SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if SCSComponent = nil then Exit; ///// EXIT ///// ResName := GetComponNameForVisible(ANewName, SCSComponent.NameMark); ResName := GetNameAndKol(ResName, SCSComponent.KolComplect); if Dat.ItemType = itComponLine then ResName := ResName + GetNameConnectFromAndTo(SCSComponent); SCSComponent.Name := ANewName; if GDBMode = bkProjectManager then if SCSComponent.IsLine = biTrue then SCSComponent.LoadWholeComponent(false); //WholeCompon := GetLineComponsInTrace(SCSComponent.ID, false); //ChangeSQLQuery(DM.scsQOperat, ' update component set name = '''+ANewName+''' where id = :id '); if SCSComponent.WholeComponent.Count = 0 then SCSComponent.SaveComponent else for i := 0 to SCSComponent.WholeComponent.Count - 1 do begin PartCompon := nil; PartCompon := GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.WholeComponent.Items[i]); if PartCompon <> nil then begin PartCompon.Name := ANewName; PartCompon.SaveComponent; PartNode := FindComponOrDirInTree(Integer(PartCompon.ID), true); if PartNode <> nil then PartNode.Text := GetNameNode(PartNode, nil, true, true); //PartNode.Text := ResName; end; end; if SCSComponent.ComponentType.SysName = ctsnCupBoard then if GDBMode = bkProjectManager then begin //if Assigned(SCSCatalog) then DesignList := GSCSBase.CurrProject.GetDesignListByComponent(SCSComponent); if Assigned(DesignList) then begin RenameNode(cfBase, DesignList.TreeViewNode, DesignList, GetListDesignedName(DesignList.Setting.IDFigureForDesignList)); DesignList.TreeViewNode.Text := GetNameNode(DesignList.TreeViewNode, DesignList, true, true); end; end; RefreshNode; if GSCSBase.SCSComponent.ID = Dat.ObjectID then GSCSBase.SCSComponent.AssignOnlyComponent(SCSComponent); //GSCSBase.SCSComponent.LoadComponentByID(Dat.ObjectID); SCSComponent.NotifyChange; if GDBMode = bkNormBase then RenameAllComplNodes(Dat.ObjectID, ResName) else if GDBMode = bkProjectManager then begin DefineArchWallCornersNames(SCSComponent); end; finally if GDBMode = bkNormBase then FreeAndNil(SCSComponent); end; end; end; Result := ResName; except on E: Exception do AddExceptionToLog('TF_MAIN.RenameCurrNode: '+E.Message); end; end; // ##### Переименовать все ветви переименованной комплектующей (компоненты) ##### procedure TF_MAIN.RenameAllComplNodes(AID_Component: Integer; // ID компл-й в компонентах ANewName: String); var i: Integer; Dat: PObjectData; begin for i := 0 to Tree_Catalog.Items.Count - 1 do if PObjectData(Tree_Catalog.Items[i].Data).ComponKind in [ckCompon, ckCompl] then if PObjectData(Tree_Catalog.Items[i].Data).ObjectID = AID_Component then begin Tree_Catalog.Items[i].Text := ANewName; end; end; // ##### Добавить / Редактировать комплектующую ##### procedure TF_MAIN.AddEditComplect(AFormBase: TForm; AParam: TComplectFormMode; AisMemTable: Boolean; AConnectType: TConnectType); Var RecNoComp: Integer; RecNoCat: Integer; ID_Catalog: Integer; ID_Component: Integer; ID_CompRel :Integer; ID_Child: Integer; ID_Compl: Integer; //*** ID компоненты которая будет комплектующей ComponName: String; KolConnectInterfaces: Integer; NewIDCompl: Integer; ItemType: TItemType; ModResOK : Boolean; Obj: PObjectData; CalcCaption: PAnsiChar; i: Integer; Node: TTreeNode; ComponNode: TTreeNode; ComplNode: TTreeNode; CanEdit: Boolean; FMainMode: TFMainMode; FCaption: String; begin Act_HideHints.Execute; GisAddEditingComplect := true; ID_Catalog := GSCSBase.SCSCatalog.ID; ID_Component := GSCSBase.SCSComponent.ID; ComponName := GSCSBase.SCSComponent.Name; ID_CompRel := 0; if DM.MemTable_Complects.RecordCount > 0 then ID_CompRel := DM.MemTable_Complects.FieldByName(fnID).AsInteger; ItemType := PObjectData(Tree_Catalog.Selected.Data).ItemType; //*** Запомнить позицию дерева ComponNode := Tree_Catalog.Selected; GPrewSelect := Tree_Catalog.Selected; FMainMode := fmComplects; ComplNode := nil; case AParam of cmAdd: begin SpinEdit_Kolvo.Value := 1; GDmainID_Compon := ID_Component; Obj := Tree_Catalog.Selected.Data; // ID Catalog GDmainID_Catalog := Obj.ObjectID; end; cmEdit: begin case AisMemTable of false : begin SpinEdit_Kolvo.Value := DM.MemTable_Complects.FieldByName(fnKolvo).AsInteger; GDmainID_Compon := DM.MemTable_Complects.FieldByName(fnIDChild).AsInteger; end; true: begin SpinEdit_Kolvo.Value := DM.MemTable_ComplectsEd.FieldByName(fnKolvo).AsInteger; GDmainID_Compon := DM.MemTable_ComplectsEd.FieldByName(fnIDChild).AsInteger; end; end; //*** Найти Индекс Папки в которой находится комплектующая DM.scsQ.Close; DM.scsQ.SQL.Clear; DM.scsQ.SQL.Add(' SELECT * FROM CATALOG_RELATION ' + ' WHERE ID_COMPONENT = '''+ IntToStr(GDmainID_Compon) + ''' '); DM.scsQ.ExecQuery; Obj := Tree_Catalog.Selected.Data; GDmainID_Catalog := DM.MemTable_Complects.FieldByName('ID_Child').AsInteger; end; end; case AConnectType of cntComplect: begin FMainMode := fmComplects; FCaption := cMain_Msg12_1; end; cntUnion: begin FMainMode := fmConnections; FCaption := cMain_Msg12_2; end; end; ModResOK := false; if CreateSecondForm(TF_Main(AFormBase).GDBMode, FMainMode, FCaption, AConnectType) = mrOK then begin CanEdit := true; ComplNode := FindComponOrDirInTree(GDropComponent.ID, true); // AConnectType = cntComplect then //GDropComponent.ActiveForm := F_NormBase; AddComplect(AFormBase, ComplNode, Tree_Catalog.Selected, GDropComponent, AConnectType, GDropComponent.Count, AConnectType = cntUnion); if (AParam = cmAdd) and (CanEdit = true) then begin ModResOK := true; end; end; end; procedure TF_MAIN.AppendToCatalRel(AID_Cat, AID_Compon: Integer); begin try case GDBMode of bkNormBase: begin ChangeSQLQuery(DM.scsQOperat, ' insert into catalog_relation (id_catalog, id_component) '+ ' values (:id_catalog, :id_component) '); DM.scsQOperat.SetParamAsInteger('id_catalog', AID_Cat); DM.scsQOperat.SetParamAsInteger('id_component', AID_Compon); DM.scsQOperat.ExecQuery; DM.AddComponToLists(AID_Cat, AID_Compon); end; bkProjectManager: begin DM.tSQL_CatalogRelation.Append; DM.tSQL_CatalogRelation.FieldByName(fnIDCatalog).AsInteger := AID_Cat; DM.tSQL_CatalogRelation.FieldByName(fnIDComponent).AsInteger := AID_Compon; DM.tSQL_CatalogRelation.Post; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.AppendToCatalRel: '+E.Message); end; end; // ##### Добавляет комплектующую в базу, и возвращает ID новой ссылки на комплектующую ##### function TF_MAIN.AppendToComponRel(AID_Compon, AID_Child, AKolvo, AIDTopComponent, AIDParentCompRel, AKolSubComplect: Integer; AConnectType: TConnectType): Integer; var NewSortID: Integer; strSQLInsert: String; begin Result := -1; try {SetSQLToQuery(DM.scsQSelect, ' select MAX(SORT_ID) from component_relation where id_component = '''+IntToStr(AID_Compon)+''' '); NewSortID := DM.scsQSelect.FN('MAX').AsInteger + 1; } NewSortID := GenNewCompRelSortID(TForm(Self), AID_Compon); case GDBMode of bkNormBase: begin setSQLToFIBQuery(DM.Query_Operat, GetSQLForInsertCompRel, false); DM.Query_Operat.ParamByName(fnIDComponent).AsInteger := AID_Compon; DM.Query_Operat.ParamByName(fnIDChild).AsInteger := AID_Child; DM.Query_Operat.ParamByName(fnKolvo).AsInteger := AKolvo; DM.Query_Operat.ParamByName(fnIDTopCompon).AsInteger := AIDTopComponent; SetParamAsInteger0AsNullToQuery(DM.Query_Operat, fnIDParentCompRel, AIDParentCompRel); DM.Query_Operat.ParamByName(fnKolSubComplect).AsInteger := AKolSubComplect; DM.Query_Operat.ParamByName(fnConnectType).AsInteger := AConnectType; DM.Query_Operat.ParamByName(fnSortID).AsInteger := NewSortID; DM.Query_Operat.ExecQuery; DM.Query_Operat.Close; Result := GenIDFromTable(DM.Query_Select, gnComponentRelationID, 0); {SetSQLToQuery(DM.scsQOperat, ' insert into component_relation(id_component, id_child, kolvo, connect_type, sort_id) '+ ' values('+ IntToStr(AID_Compon) +', '+ IntToStr(AID_Child) +', '+ IntToStr(AKolvo) +', '+ IntToStr(AConnectType) +', '+ IntToStr(NewSortID)+ ') '); SetSQLToQuery(DM.scsQSelect, ' select MAX(ID) As Max_ID from component_relation '); Result := DM.scsQSelect.GetFNAsInteger('Max_ID');} end; bkProjectManager: begin { DM.tSQL_ComponentRelation.Append; DM.tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger := AID_Compon; DM.tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger := AID_Child; DM.tSQL_ComponentRelation.FieldByName(fnKolvo).AsInteger := AKolvo; DM.tSQL_ComponentRelation.FieldByName(fnConnectType).AsInteger := AConnectType; DM.tSQL_ComponentRelation.FieldByName(fnSortID).AsInteger := NewSortID; DM.tSQL_ComponentRelation.Post; Result := DM.tSQL_ComponentRelation.FieldByName(fnID).AsInteger;} end; end; //SetSQLToQuery(DM.scsQSelect, ' select GEN_ID(GEN_COMPONENT_RELATION_ID, 0) from RDB$ '); except on E: Exception do AddExceptionToLog('TF_MAIN.AppendToComponRel: '+E.Message); end; end; // ##### Добавить/изменить значение свойства ##### procedure TF_MAIN.AddEditProperty(AMakeEdit: TMakeEdit); {var TableName: String; PropertyKind: TPropKind; TableKind: TTableKind; MasterField: String; //PropFields: TStringList; qrSQL: String; Dat: PObjectData; ItemType: TItemType; PropID: Integer; PValue: String; PropName: String; PropSysName: String; PTakeIntoConnect: Integer; PTakeIntoJoin: Integer; FormMode: TFormMode; NewID: Integer; IDPropRel: Integer; IDProperty: Integer; IDFigure: Integer; OwnerName: String; QueryMode: TQueryMode; SCSProperty: Tproperty; OldListHeightRoom: Double; OldListHeightCeiling: Double; OldListHeightSocket: Double; OldListHeightCorob: Double; SCSComponent: TSCSComponent;} var OldProperty: TProperty; PropFromMT: TProperty; Dat: PObjectData; ObjID: Integer; ObjItemType: Integer; TableKind: TTableKind; OwnerName: String; TableName: String; MasterField: String; PropertyKind: TPropKind; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; //WholeComponents: TSCSComponents; //PartComponent: TSCSComponent; ptrProperty: PProperty; //ptrPartProperty: PProperty; i: Integer; JoinedTrunkComponent: TSCSComponent; Sproavochnik: TSpravochnik; SCSListIDs: TIntList; begin ZeroMemory(@PropFromMT, SizeOf(TProperty)); TableKind := tkComponent; //ObjID := -1; // ObjItemType := -1; // if pcObjects.ActivePage = tsTemplates then // begin // ObjID := GSCSBase.SCSComponent.ID; // ObjItemType := GSCSBase.SCSComponent.GetItemType; // end // else // if pcObjects.ActivePage = tsComponents then // begin // Dat := Tree_Catalog.Selected.Data; // ObjID := Dat.ObjectID; // ObjItemType := Dat.ItemType; // end; Dat := GetSelectedObjectData(ObjID, ObjItemType); SCSCatalog := nil; SCSComponent := nil; ptrProperty := nil; Sproavochnik := nil; if AMakeEdit = meEdit then begin PropFromMT := DM.GetPropertyFromTable(DM.DataSource_MT_Property); // if GDBMode = bkProjectManager then // if Not DM.CanEditProperty(DM.MemTable_Property) then // begin // MessageModal(cMain_Msg13_1+' "'+PropFromMT.Name_+'" '+cMain_Msg13_2, // ApplicationName, MB_ICONINFORMATION or MB_OK); // Exit; ///// EXIT ///// // end; end; //case ObjItemType of // itComponCon, itComponLine: if IsComponItemType(ObjItemType) then begin OwnerName := GSCSBase.SCSComponent.Name; TableName := tnCompPropRelation; MasterField := fnIDComponent; PropertyKind := pkCompon; TableKind := tkComponent; case GDBMode of bkNormBase: begin SCSComponent := GSCSBase.SCSComponent; SCSComponent.LoadProperties; end; bkProjectManager: SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ObjID); end; if SCSComponent <> nil then begin if PropFromMT.ID <> 0 then ptrProperty := SCSComponent.GetPropertyByID(PropFromMT.ID); end; end //itDir, itProject, itList, itRoom, itSCSConnector, itSCSLine: else if IsCatalogItemType(ObjItemType) then begin OwnerName := GSCSBase.SCSCatalog.Name; TableName := tnCatalogPropRelation; MasterField := fnIDCatalog; PropertyKind := pkCatalog; TableKind := tkCatalog; case GDBMode of bkNormBase: begin SCSCatalog := GSCSBase.SCSCatalog; SCSCatalog.LoadProperties; end; bkProjectManager: SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ObjID); end; if SCSCatalog <> nil then if PropFromMT.ID <> 0 then ptrProperty := SCSCatalog.GetPropertyByID(PropFromMT.ID); end; //end; if GDBMode = bkNormBase then Sproavochnik := GSCSBase.NBSpravochnik else if GDBMode = bkProjectManager then Sproavochnik := GSCSBase.CurrProject.Spravochnik; //*** Корректировка структуры PropFromMT (на всекий який) if (ptrProperty <> nil) and (AMakeEdit = meEdit) then begin if GDBMode = bkProjectManager then if IsReadOnlyProp(ObjItemType, ptrProperty) then begin MessageInfo(cMain_Msg182); Exit; ///// EXIT ///// end; PropFromMT := ptrProperty^; end; OldProperty := PropFromMT; if CreateFMakeEditPropRel.Execute(AMakeEdit, TableKind, @PropFromMT, DM.MemTable_Property, ObjItemType, nil, Sproavochnik, OnCheckPropRelFormValue) then begin case AMakeEdit of meMake: DM.MemTable_Property.Append; meEdit: DM.MemTable_Property.Edit; end; if DM.MemTable_Property.State <> dsBrowse then begin case TableKind of tkCatalog: begin if AMakeEdit = meMake then ptrProperty := SCSCatalog.GetPropertyAsNew; if ptrProperty <> nil then begin PropFromMT.IDMaster := ptrProperty.IDMaster; ptrProperty^ := PropFromMT; SCSCatalog.SaveProperty(AMakeEdit, ptrProperty); //13.05.2009 SCSCatalog.NotifyChange; //if ptrProperty.SysName = pnPercentCableLengthReserv then // for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do // SCSCatalog.ComponentReferences[i].RefreshWholeLengthInFuture; end; end; tkComponent: begin // UNDO if PropFromMT.SysName = pnSignType then begin SCSListIDs := GetVariousListsIDsByComponWithWhole(GSCSBase.CurrProject, SCSComponent); SaveListsToUndoStack(SCSListIDs); FreeAndNil(SCSListIDs); end; if AMakeEdit = meMake then ptrProperty := SCSComponent.GetPropertyAsNew; if ptrProperty <> nil then begin PropFromMT.IDMaster := ptrProperty.IDMaster; ptrProperty^ := PropFromMT; SCSComponent.SaveProperty(AMakeEdit, ptrProperty); {//13.05.2009 OnChangeComponProperty(ptrProperty, SCSComponent); //12.05.2009 if GDBMode = bkProjectManager then begin //12.05.2009 OnChangeComponProperty(ptrProperty, SCSComponent); if OldProperty.Value <> PropFromMT.Value then begin DefineComponNormResByProperty(SCSComponent, ptrProperty); DM.SelectNorms(SCSComponent); end; //*** Значение свойства по всей длине MakeEditPropertyForWholeComponent(AMakeEdit, SCSComponent, ptrProperty); end; SCSComponent.NotifyChange; } end; end; end; // Сохраняем в MemTable if ptrProperty <> nil then PropFromMT.ID := ptrProperty.ID; DM.SetPropertyToTable(DM.DataSource_MT_Property, PropFromMT); DM.DataSource_MT_Property.DataSet.FieldByName(fnIDDataType).AsInteger := F_MakeEditPropRel.PropertyData.IDDataType; DM.MemTable_Property.Post; // Применить измененное свойство на другие объекты if ptrProperty <> nil then case TableKind of tkCatalog: begin SCSCatalog.NotifyChange; end; tkComponent: begin {//25.07.2011 OnChangeComponProperty(ptrProperty, SCSComponent, @OldProperty); //12.05.2009 if GDBMode = bkProjectManager then begin //12.05.2009 OnChangeComponProperty(ptrProperty, SCSComponent); if OldProperty.Value <> PropFromMT.Value then begin DefineComponNormResByProperty(SCSComponent, ptrProperty); DM.SelectNorms(SCSComponent); end; //*** Значение свойства по всей длине MakeEditPropertyForWholeComponent(AMakeEdit, SCSComponent, ptrProperty); end; SCSComponent.NotifyChange;} OnSetComponPropertyVal(AMakeEdit, ptrProperty, SCSComponent, @OldProperty); end; end; //GSCSBase.SCSComponent.NotifyChange; if AMakeEdit = meMake then EnableEditDel(itAuto); end; // Tolik 12/06/2017 -- if GDBMode = bkProjectManager then if TableKind = tkComponent then begin if SCSCatalog = nil then if SCSComponent <> nil then SCSCatalog := SCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then F_ChoiceConnectSide.DefineObjectIcon(SCSCatalog); end; // end; (* //PropFields := TStringList.Create; PropID := -1;; PValue := ''; PTakeIntoConnect := 0; PTakeIntoJoin := 0; FormMode := fmMake; PropertyKind := pkCatalog; TableKind := tkCatalog; NewID := -1; QueryMode := GetQueryModeByNode(GDBMode, Tree_Catalog.Selected, GetQueryModeByGDBMode(GDBMode)); try Dat := Tree_Catalog.Selected.Data; ItemType := Dat.ItemType; case AMakeEdit of meMake: FormMode := fmMake; meEdit: begin PropID := DM.MemTable_Property.FieldByName(fnIDProperty).AsInteger; PValue := DM.MemTable_Property.FieldByName(fnPValue).AsString; PropName := DM.MemTable_Property.FieldByName(fnName).AsString; PropSysName := DM.MemTable_Property.FieldByName(fnSYSNAME).AsString; PTakeIntoConnect := DM.MemTable_Property.FieldByName(fnTakeIntoConnect).AsInteger; PTakeIntoJoin := DM.MemTable_Property.FieldByName(fnTakeIntoJoin).AsInteger; if Dat.ItemType = itList then if (PropSysName = pnHeightRoom) or (PropSysName = pnHeightCeiling) or (PropSysName = pnHeightSocket) or (PropSysName = pnHeightCorob) then begin ShowMessage('Нельзя изменить текущее свойство листа'); Exit; ////// EXIT ////// end; FormMode := fmEdit; end; end; if ItemType = itLinkCompLine then ItemType := itComponLine; if ItemType = itLinkCompCon then ItemType := itComponCon; case ItemType of itComponCon, itComponLine: begin OwnerName := GSCSBase.SCSComponent.Name; TableName := tnCompPropRelation; MasterField := fnIDComponent; PropertyKind := pkCompon; TableKind := tkComponent; end; itDir, itProject, itList, itRoom, itSCSConnector, itSCSLine: begin OwnerName := GSCSBase.SCSCatalog.Name; TableName := tnCatalogPropRelation; MasterField := fnIDCatalog; PTakeIntoConnect := -1; PTakeIntoJoin := -1; PropertyKind := pkCatalog; TableKind := tkCatalog; end; end; //F_NormBase.F_CaseForm.GViewKind := vkProperty; //F_NormBase.F_CaseForm.GFormMode := FormMode; F_NormBase.F_CaseForm.GItemType := ItemType; F_NormBase.F_CaseForm.GIDToLocate := PropID; F_NormBase.F_CaseForm.GValue := PValue; F_NormBase.F_CaseForm.GTakeIntoConnect := PTakeIntoConnect; F_NormBase.F_CaseForm.GTakeIntoJoin := PTakeIntoJoin; //if F_NormBase.F_CaseForm.ShowModal = mrOK then if F_NormBase.F_CaseForm.Execute(vkProperty, FormMode) then with DM.MemTable_Property do begin try LockTreeAndGrid(true); IDProperty := F_NormBase.DM.DataSet_PROPERTIES.FN('ID').AsInteger; if AMakeEdit = meMake then if Not DM.CheckNoRepeatPropertyMT(DM.MemTable_Property, F_NormBase.DM.DataSet_PROPERTIES.FN('ID').AsInteger, OwnerName) then Exit; ///// EXIT ///// //*** Запомнить старые значения высот Листа { if Dat.ItemType = itList then begin OldListHeightRoom := GetCurrListHeightRoom(GIDLastList); OldListHeightCeiling := GetCurrListHeightCeiling(GIDLastList); OldListHeightSocket := GetCurrListHeightSocket(GIDLastList); OldListHeightCorob := GetCurrListHeightCorob(GIDLastList); end; } IDPropRel := 0; if GDBMode = bkNormBase then begin case AMakeEdit of meMake: begin DM.InsertToPropRelation(PropertyKind, Dat.ObjectID, IDProperty, F_NormBase.F_CaseForm.GValue, biFalse, QueryMode); SetSQLToQuery(DM.scsQ, ' Select Max(ID) As Max_ID FROM '+ TableName); NewID := DM.scsQ.GetFNAsInteger('Max_ID'); IDPropRel := NewID; end; meEdit: begin DM.SetPropertyValue(TableKind, Dat.ObjectID, PropSysName, F_NormBase.F_CaseForm.GValue, QueryMode, IDProperty); IDPropRel := FieldByName('ID').AsInteger; end; end; if TableKind = tkComponent then begin DM.UpdateCompPropRelFieldAsInteger(IDPropRel, F_NormBase.F_CaseForm.GTakeIntoConnect, fnTakeIntoConnect); DM.UpdateCompPropRelFieldAsInteger(IDPropRel, F_NormBase.F_CaseForm.GTakeIntoJoin, fnTakeIntoJoin); end; end; SCSProperty.ID := -1; //IDPropRel; if GDBMode = bkNormBase then SCSProperty.ID := IDPropRel; SCSProperty.IDMaster := Dat.ObjectID; SCSProperty.ID_Property := IDProperty; SCSProperty.Name := PropName; SCSProperty.SysName := PropSysName; if AMakeEdit = meMake then SCSProperty.IsDefault := biFalse else SCSProperty.IsDefault := DM.MemTable_Property.FieldByName(fnIsDefault).AsInteger; SCSProperty.TakeIntoConnect := F_NormBase.F_CaseForm.GTakeIntoConnect; SCSProperty.TakeIntoJoin := F_NormBase.F_CaseForm.GTakeIntoJoin; SCSProperty.Value := F_NormBase.F_CaseForm.GValue; OnAddEditPropertyRel(AMakeEdit, PropertyKind, Dat.ObjectID, SCSProperty); if GDBMode = bkProjectManager then IDPropRel := SCSProperty.ID; //*** Внести измененияв таблицу if AMakeEdit = meMake then begin Append; FieldByName(fnID).AsInteger := IDPropRel; end else Edit; PropSysName := F_NormBase.DM.DataSet_PROPERTIES.FN(fnSYSNAME).AsString; FieldByName(fnIDProperty).AsInteger := F_NormBase.DM.DataSet_PROPERTIES.FN(fnID).AsInteger; FieldByName(fnPValue).AsString := F_NormBase.F_CaseForm.GValue; FieldByName(fnIDDataType).AsInteger := F_NormBase.DM.DataSet_PROPERTIES.FN(fnIDDATATYPE).AsInteger; FieldByName(fnNAME).AsString := F_NormBase.DM.DataSet_PROPERTIES.FN(fnNAME).AsString; FieldByName(fnIZM).AsString := F_NormBase.DM.DataSet_PROPERTIES.FN(fnIZM).AsString; FieldByName(fnDescription).AsString := F_NormBase.DM.DataSet_PROPERTIES.FN(fnDESCRIPTION).AsString; if TableKind = tkComponent then begin FieldByName(fnTAKEINTOCONNECT).AsInteger := F_NormBase.F_CaseForm.GTakeIntoConnect; FieldByName(fnTAKEINTOJOIN).AsInteger := F_NormBase.F_CaseForm.GTakeIntoJoin; end; Post; { if (AMakeEdit = meEdit) and (GdbMode = bkProjectManager) then begin if Dat.ItemType = itSCSConnector then if AnsiUpperCase(PropSysName) = 'COORDZ' then begin ChangeConObjectCoordZ(Dat.ObjectID, StrToFloat_My(F_NormBase.F_CaseForm.GValue)); //*** Изменение высоты на CAD-е IDFigure := DM.GetScsIDByIDCatalog(Dat.ObjectID); if IDFigure <> 0 then SetConFigureCoordZInCAD(IDFigure, StrToFloat_My(F_NormBase.F_CaseForm.GValue)); end; if (Dat.ItemType in [itComponLine, itComponCon]) and (PropSysName = pnSignType) then begin SCSComponent := TSCSComponent.Create(Self); try SCSComponent.LoadComponentByID(Dat.ObjectID); SCSComponent.LoadOwnerCatalog(false); F_ChoiceConnectSide.DefineObjectIcon(SCSComponent.GetFirstParentCatalog); RefreshAllLists; finally FreeAndNil(SCSComponent); end; end; //if Dat.ItemType = itList then // ChangeCurrListHeight(OldListHeightRoom, OldListHeightCeiling, OldListHeightSocket, OldListHeightCorob); end; } finally EnableEditDel(itAuto); LockTreeAndGrid(false); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.AddEditProperty: '+E.Message); end; *) end; procedure TF_MAIN.AddEditCableCanalConnector(AMakeEdit: TMakeEdit); var SCSComponent: TSCSComponent; IDCableCanalConnector: Integer; NBComponent: TSCSComponent; //InterfCount: Integer; ConnectorType: Integer; IDCurrConnector: Integer; ptrCableCanalConnector: PCableCanalConnector; FieldNames: TStringList; begin try SCSComponent := GetActualSelectedComponent; FieldNames := nil; if Assigned(SCSComponent) then begin IDCableCanalConnector := 0; IDCurrConnector := 0; if AMakeEdit = meEdit then begin IDCableCanalConnector := DM.mtCableCanalConnectors.FieldByName(fnID).AsInteger; IDCurrConnector := DM.mtCableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger; end; NBComponent := CreateFConnectComplWith.DefineCableCanalConnector(SCSComponent, IDCurrConnector); if Assigned(NBComponent) then with DM do begin ConnectorType := -1; if NBComponent.Properties.Count = 0 then NBComponent.LoadProperties; ConnectorType := NBComponent.GetPropertyValueAsInteger(pnCableCanalElemetType); if ConnectorType <> -1 then begin //*** Захуячить в нормативную базу if GDBMode = bkNormBase then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDNBConnector); FieldNames.Add(fnConnectorType); case AMakeEdit of meMake: begin FieldNames.Add(fnIDComponent); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnCableCanalConnectors, '', FieldNames, ''), false); Query_Operat.ParamByName(fnIDComponent).AsInteger := SCSComponent.ID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnCableCanalConnectors, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := IDCableCanalConnector; end; end; Query_Operat.ParamByName(fnIDNBConnector).AsInteger := NBComponent.ID; Query_Operat.ParamByName(fnConnectorType).AsInteger := ConnectorType; Query_Operat.ExecQuery; FieldNames.Free; end; ptrCableCanalConnector := nil; if AMakeEdit = meMake then begin case GDBMode of bkNormBase: IDCableCanalConnector := GenIDFromTable(DM.Query_Select, gnCableCanalConnectorsID, 0); bkProjectManager: IDCableCanalConnector := GenCurrProjTableID(giCableCanalConnectorsID, 1); end; GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); SCSComponent.CableCanalConnectors.Add(ptrCableCanalConnector); mtCableCanalConnectors.Append; end; if AMakeEdit = meEdit then begin ptrCableCanalConnector := SCSComponent.GetCableCanalConnectorByID(IDCableCanalConnector); mtCableCanalConnectors.Edit; end; if (ptrCableCanalConnector <> nil) and (mtCableCanalConnectors.State <> dsBrowse) then begin ptrCableCanalConnector.ID := IDCableCanalConnector; ptrCableCanalConnector.IDCableCanal := SCSComponent.ID; ptrCableCanalConnector.IDNBConnector := NBComponent.ID; ptrCableCanalConnector.GuidNBConnector := NBComponent.GuidNB; ptrCableCanalConnector.ConnectorType := ConnectorType; SetCableCanalConnectorTokbmMemTable(mtCableCanalConnectors, ptrCableCanalConnector); mtCableCanalConnectors.Post; end; end; FreeAndNil(NBComponent); GSCSBase.SCSComponent.NotifyChange; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.AddEditCableCanalConnector: '+E.Message); end; end; //Tolik 15/11/2021 -- procedure TF_MAIN.AddEditTubeElement(AMakeEdit: TMakeEdit); var SCSComponent: TSCSComponent; IDCableCanalConnector: Integer; NBComponent: TSCSComponent; //InterfCount: Integer; ConnectorType: Integer; IDCurrConnector: Integer; ptrCableCanalConnector: PCableCanalConnector; FieldNames: TStringList; begin try SCSComponent := GetActualSelectedComponent; FieldNames := nil; if Assigned(SCSComponent) then begin IDCableCanalConnector := 0; IDCurrConnector := 0; if AMakeEdit = meEdit then begin IDCableCanalConnector := DM.mtCableCanalConnectors.FieldByName(fnID).AsInteger; IDCurrConnector := DM.mtCableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger; end; NBComponent := CreateFConnectComplWith.DefineTubeConnector(SCSComponent, IDCurrConnector); if Assigned(NBComponent) then with DM do begin ConnectorType := -1; if NBComponent.Properties.Count = 0 then NBComponent.LoadProperties; ConnectorType := NBComponent.GetPropertyValueAsInteger(pnCableCanalElemetType); if ConnectorType <> -1 then begin //*** Захуячить в нормативную базу if GDBMode = bkNormBase then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDNBConnector); FieldNames.Add(fnConnectorType); case AMakeEdit of meMake: begin FieldNames.Add(fnIDComponent); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnCableCanalConnectors, '', FieldNames, ''), false); Query_Operat.ParamByName(fnIDComponent).AsInteger := SCSComponent.ID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnCableCanalConnectors, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := IDCableCanalConnector; end; end; Query_Operat.ParamByName(fnIDNBConnector).AsInteger := NBComponent.ID; Query_Operat.ParamByName(fnConnectorType).AsInteger := ConnectorType; Query_Operat.ExecQuery; FieldNames.Free; end; ptrCableCanalConnector := nil; if AMakeEdit = meMake then begin case GDBMode of bkNormBase: IDCableCanalConnector := GenIDFromTable(DM.Query_Select, gnCableCanalConnectorsID, 0); bkProjectManager: IDCableCanalConnector := GenCurrProjTableID(giCableCanalConnectorsID, 1); end; GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); SCSComponent.CableCanalConnectors.Add(ptrCableCanalConnector); mtCableCanalConnectors.Append; end; if AMakeEdit = meEdit then begin ptrCableCanalConnector := SCSComponent.GetCableCanalConnectorByID(IDCableCanalConnector); mtCableCanalConnectors.Edit; end; if (ptrCableCanalConnector <> nil) and (mtCableCanalConnectors.State <> dsBrowse) then begin ptrCableCanalConnector.ID := IDCableCanalConnector; ptrCableCanalConnector.IDCableCanal := SCSComponent.ID; ptrCableCanalConnector.IDNBConnector := NBComponent.ID; ptrCableCanalConnector.GuidNBConnector := NBComponent.GuidNB; ptrCableCanalConnector.ConnectorType := ConnectorType; SetCableCanalConnectorTokbmMemTable(mtCableCanalConnectors, ptrCableCanalConnector); mtCableCanalConnectors.Post; end; end; FreeAndNil(NBComponent); GSCSBase.SCSComponent.NotifyChange; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.AddEditTubeElement: '+E.Message); end; end; // // ##### Получить количество компонентов в Папке ##### function TF_MAIN.GetColCompINDir(ADir: TTreeNode): Integer; var Count: Integer; Col: Integer; i: Integer; Dat: PObjectData; begin Col := 0; Count := ADir.Count; ADir := ADir.getFirstChild; for i := 0 to Count - 1 do begin Dat := ADir.Data; if Dat.ItemType in [itComponLine, itComponCon] then Col := Col + 1; ADir := ADir.getNextSibling; end; Result := Col; end; // ##### Получить сечение компоненты ##### function TF_MAIN.GetCompSquare: Double; var Width : Double; Height : Double; RecordNo: Integer; begin Result := 0; with DM do begin Width := 0; Height :=0; RecordNo := MemTable_Property.RecNo; if SearchRecordMT(MemTable_Property, 'SysName', 'WIDTH') then Width := StrToFloatU(CorrectStrToFloat(MemTable_Property.FieldByName('PValue').AsString)); if SearchRecordMT(MemTable_Property, 'SysName', 'HEIGHT') then Height := StrToFloatU(CorrectStrToFloat(MemTable_Property.FieldByName('PValue').AsString)); MemTable_Property.RecNo := RecordNo; if (Width <> 0) and (Height <> 0 ) then Result := Width * Height; end end; // ##### Вычисление стоимости компоненты (AID_Component) и ее отцовских компонентов ##### procedure TF_MAIN.CalcPriceForParents(AID_Component: Integer; ALookedComponIDs: TIntList=nil); var //ID_Parent: Integer; //ParentCompons: TList; //i: Integer; //ID_CurrCompon: Integer; //HaveParent: Boolean; CurrCompon: TSCSComponent; IDParent: Integer; ParentIDs: TIntList; i: Integer; LookedComponIDs: TIntList; begin CurrCompon := nil; if AID_Component < 1 then Exit; ///// EXIT ///// CalcPrice(AID_Component); LookedComponIDs := ALookedComponIDs; if LookedComponIDs = nil then LookedComponIDs := TIntList.Create; //*** Поиск Parent-ов case GDBMode of bkNormBase: begin ParentIDs := nil; ParentIDs := DM.GetParentIDsCompon(AID_Component); for i := 0 to ParentIDs.Count - 1 do begin IDParent := ParentIDs[i]; if LookedComponIDs.IndexOf(IDParent) = -1 then begin CalcPriceForParents(IDParent, LookedComponIDs); LookedComponIDs.Add(IDParent); end; end; //CalcPriceForParents(DM.GetCompRelFieldValueAsIntByFilter(fnIDComponent, '(ID_CHILD = '''+ IntToStr(AID_Component) +''') and (connect_type = '''+IntToStr(cntComplect)+''')')); ParentIDs.Free; end; bkProjectManager: begin CurrCompon := GSCSBase.CurrProject.GetComponentFromReferences(AID_Component); IDParent := 0; if Assigned(CurrCompon) then if Assigned(CurrCompon.Parent) then if CurrCompon.Parent is TSCSComponent then IDParent := TSCSComponent(CurrCompon.Parent).ID; if IDParent > 0 then CalcPriceForParents(IDParent, LookedComponIDs); end; end; if ALookedComponIDs = nil then FreeAndNil(LookedComponIDs); end; // ##### Вычисление стоимости компоненты ##### function TF_MAIN.CalcPrice(AID_Component: Integer): Double; var NewPriceCalc: Double; //*** Новая расчетная цена //ID_COMPONENT: integer; //PriceUser: Double; //*** Текущая пользовательская цена PriceCalc: Double; //*** Текущая расчетная цена //ComplectPrice: Double; //*** Цена комплектующих //CurrencyName: String; //Childs: TSCSComponents; //i, j: Integer; CurrComponent: TSCSComponent; //ChildCompon: TSCSComponent; //Kolvo : Integer; //*** Количество комплектующих ComponCurrencies: TList; begin Result := 0; PriceCalc := 0; CurrComponent := nil; case GDBMode of bkNormBase: begin PriceCalc := DM.GetComponFieldValueAsFloat(AID_Component, fnPriceCalc); end; bkProjectManager: begin CurrComponent := GSCSBase.CurrProject.GetComponentFromReferences(AID_Component); if Assigned(CurrComponent) then PriceCalc := CurrComponent.PRICE_CALC; end; end; NewPriceCalc := GetComponPrice(AID_Component, 0, AID_Component); Result := NewPriceCalc; if Round3(PriceCalc) <> Round3(NewPriceCalc) Then begin if GDBMode = bkNormBase then DM.UpdateComponFieldAsFloat(AID_COMPONENT, NewPriceCalc, fnPriceCalc); if Assigned(CurrComponent) then CurrComponent.PRICE_CALC := NewPriceCalc; OnChangeComponPriceCalc(AID_Component, PriceCalc, NewPriceCalc); end; { CalcPrice := 0; ComponCurrencies := nil; With DM do begin ID_COMPONENT := AID_Component; PriceUser := 0; PriceCalc := 0; CurrencyName := GCurrencyM.NameBrief; CurrComponent := nil; Childs := nil; case GDBMode of bkNormBase: begin Childs := GetComponChilds(AID_Component, AID_Component, 0, ''); PriceUser := DM.GetComponFieldValueAsFloat(AID_Component, fnPrice); PriceCalc := DM.GetComponFieldValueAsFloat(AID_Component, fnPriceCalc); ComponCurrencies := TList.Create; end; bkProjectManager: begin CurrComponent := GSCSBase.CurrProject.GetComponentFromReferences(AID_Component); if Assigned(CurrComponent) then begin PriceUser := CurrComponent.PRICE; PriceCalc := CurrComponent.PRICE_CALC; Childs := TSCSComponents.Create(false); Childs.Assign(CurrComponent.ChildComplects); end; end; end; if Assigned(Childs) then begin NewPriceCalc := 0; for i := 0 to Childs.Count - 1 do begin ChildCompon := Childs[i]; if Assigned(ChildCompon) then begin ComplectPrice := ChildCompon.Price_Calc; if GDBMode = bkNormBase then ComplectPrice := DM.GetChildComponPrice(AID_Component, ChildCompon.ID, ComplectPrice, ComponCurrencies); if ChildCompon.Count > 0 then begin NewPriceCalc := NewPriceCalc + Round3(ComplectPrice * ChildCompon.Count); end else NewPriceCalc := NewPriceCalc + Round3(ComplectPrice); end; end; NewPriceCalc := NewPriceCalc + Round3(PriceUser); CalcPrice:= NewPriceCalc; if Round3(PriceCalc) <> Round3(NewPriceCalc) Then begin if GDBMode = bkNormBase then UpdateComponFieldAsFloat(ID_COMPONENT, NewPriceCalc, fnPriceCalc); if Assigned(CurrComponent) then CurrComponent.PRICE_CALC := NewPriceCalc; OnChangeComponPriceCalc(AID_Component, PriceCalc, NewPriceCalc); end; FreeAndNil(Childs); end; if Assigned(ComponCurrencies) then FreeList(ComponCurrencies); end; } end; function TF_MAIN.GetComponPrice(AIDComponent, AIDCompRel, AIDTopComponent: Integer): Double; var CompRels: TList; ptrCompRel: PComplect; ComponIDs: TIntList; ComponKolvos: TIntList; ComponPrices: TStringList; ComponActualPrices: TStringList; TopComponDirCurrencies: TList; ComponID: Integer; ComponPrice: Double; ActualComponPrice: Double; i: Integer; CurrComponent: TSCSComponent; ChildComponent: TSCSComponent; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // procedure DefineComponAllChildIDs(AIDCompRelParent: Integer); var ptrComplect: PComplect; i: Integer; IndexID: Integer; begin for i := 0 to CompRels.Count - 1 do begin ptrComplect := CompRels[i]; if ptrComplect.ConnectType = cntComplect then //*** Если AIDCompRelParent = 0, то предполагается, что поиск идет для всей верхней кмпоненты if (AIDCompRelParent = 0) or (ptrComplect.IDParentCompRel = AIDCompRelParent) then begin //*** Если ID есть в списке, то докинуть количество IndexID := ComponIDs.IndexOf(ptrComplect.ID_Child); if IndexID = -1 then begin ComponIDs.Add(ptrComplect.ID_Child); //ComponKolvos.Add(ptrComplect.Kolvo); end; //else // ComponKolvos[IndexID] := ComponKolvos[IndexID] + ptrComplect.Kolvo; //*** Если поиск идет не для всей компоненты, а только для определенной ветаи комплектующей // то смотрим подкомплектующие if AIDCompRelParent <> 0 then DefineComponAllChildIDs(ptrComplect.ID); end; end; end; procedure DefineComponPriceWithAllChild(AIDCompRelParent, AParentCount, AStepIndex: Integer); var ptrComplect: PComplect; i: Integer; IndexID: Integer; ComponPrice: Double; begin // Если первая вложенность, то учитываем цену компоненты, для которой идет подсчет цен ее комплектующих if AStepIndex = 0 then begin ComponPrice := StrToFloat_My(ComponActualPrices[0]); if ComponPrice > 0 then Result := Result + RoundX(ComponPrice, FloatPrecision*2); end; for i := 0 to CompRels.Count - 1 do begin ptrComplect := CompRels[i]; if ptrComplect.ConnectType = cntComplect then //*** Если AIDCompRelParent = 0, то предполагается, что поиск идет для всей верхней кмпоненты if {(AIDCompRelParent = 0) or} (ptrComplect.IDParentCompRel = AIDCompRelParent) then begin //*** Если ID есть в списке, то докинуть количество IndexID := ComponIDs.IndexOf(ptrComplect.ID_Child); if IndexID <> -1 then begin ComponPrice := StrToFloat_My(ComponActualPrices[IndexID]); if ComponPrice > 0 then Result := Result + RoundX(ComponPrice * ptrComplect.Kolvo * AParentCount, FloatPrecision*2); end; //*** Если поиск идет не для всей компоненты, а только для определенной ветаи комплектующей // то смотрим подкомплектующие //if AIDCompRelParent <> 0 then DefineComponPriceWithAllChild(ptrComplect.ID, AParentCount * ptrComplect.Kolvo, AStepIndex + 1); end; end; end; begin Result := 0; OldTick := GetTickCount; try if GDBMode = bkNormBase then begin //*** Отобрать всю инфу о подключениях для AIDTopComponent //Tolik DM.Query_Select.Close; // SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponentRelation, fnIDTopCompon+' = :'+fnIDTopCompon, nil, fnAll), false); DM.Query_Select.Params[0].AsInteger := AIDTopComponent; DM.Query_Select.ExecQuery; CompRels := TList.Create; ComponIDs := TIntList.Create; ComponKolvos := TIntList.Create; ComponPrices := TStringList.Create; ComponActualPrices := TStringList.Create; TopComponDirCurrencies := TList.Create; while Not DM.Query_Select.Eof do begin GetZeroMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := DM.Query_Select.FN(fnID).AsInteger; ptrCompRel.ID_Component := DM.Query_Select.FN(fnIDComponent).AsInteger; ptrCompRel.ID_Child := DM.Query_Select.FN(fnIDChild).AsInteger; ptrCompRel.IDTopComponent := AIDTopComponent; ptrCompRel.IDParentCompRel := DM.Query_Select.FN(fnIDParentCompRel).AsInteger; ptrCompRel.KolSubComplect := DM.Query_Select.FN(fnKolSubComplect).AsInteger; ptrCompRel.Kolvo := DM.Query_Select.FN(fnKolvo).AsInteger; ptrCompRel.ConnectType := DM.Query_Select.FN(fnConnectType).AsInteger; ptrCompRel.SortID := DM.Query_Select.FN(fnSortID).AsInteger; CompRels.Add(ptrCompRel); DM.Query_Select.Next; end; ComponIDs.Add(AIDComponent); ComponKolvos.Add(1); DefineComponAllChildIDs(AIDCompRel); //*** Определить цены компонент без учета валюты SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, nil, fnPrice), false); for i := 0 to ComponIDs.Count - 1 do begin ComponPrice := 0; DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := ComponIDs[i]; DM.Query_Select.ExecQuery; if DM.Query_Select.RecordCount > 0 then ComponPrice := DM.Query_Select.Fields[0].AsFloat; ComponPrices.Add(FloatToStr(ComponPrice)); end; //*** Определить цены в такой валюте, в которой находится AIDTopComponent for i := 0 to ComponIDs.Count - 1 do begin ComponID := ComponIDs[i]; ComponPrice := StrToFloat_My(ComponPrices[i]); ActualComponPrice := ComponPrice; if ComponID <> AIDTopComponent then ActualComponPrice := DM.GetChildComponPrice(AIDTopComponent, ComponID, ComponPrice, TopComponDirCurrencies); //Result := Result + RoundX(ActualComponPrice * ComponKolvos[i], FloatPrecision*2); ComponActualPrices.Add(FloatToStr(ActualComponPrice)); end; DefineComponPriceWithAllChild(AIDCompRel, 1, 0); FreeAndNil(ComponIDs); FreeAndNil(ComponKolvos); FreeAndNil(ComponPrices); FreeAndNil(ComponActualPrices); FreeList(CompRels); FreeList(TopComponDirCurrencies); end else if GDBMode = bkProjectManager then begin CurrComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if CurrComponent <> nil then begin Result := Result + RoundCP(CurrComponent.Price); for i := 0 to CurrComponent.ChildComplects.Count - 1 do begin ChildComponent := CurrComponent.ChildComplects[i]; Result := Result + RoundCP(ChildComponent.Price_Calc); end; end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.GetComponPrice', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TF_MAIN.WriteOptionsToINI; //var ini: TIniFile; begin try if GConnected then begin //WritePnAdditionRestored(GDBMode, Not Panel_Addition.HotSpotClosed); //ini := TIniFile.Create(ExtractFilePath(paramstr(0)) + 'Scs.ini'); case GDBMode of bkNormBase: begin GSCSIni.NB.Common.PnAdditionRestored := Not Panel_Addition.HotSpotClosed; WriteNBIni(GSCSIni.NB); //ini.WriteString('NormBase', 'Path', DM.DataBase_SCS.DBName); {ini.WriteFloat(scNormBase, idtNDS, GNDS); ini.WriteBool(scNormBase, idtDisableEdit, GDisableTreeEdit); ini.WriteInteger(scNormBase, idtDefaultNoLineCompon, GDefaultNoLineCompon); ini.WriteInteger(scNormBase, idtDefaultLineCompon, GDefaultLineCompon); ini.WriteBool(scNormBase, idtIsAdministration, GIsAdministration); ini.WriteInteger(scNormBase, idtLastNBDir, GIDLastNBDir);} end; bkProjectManager: begin GSCSIni.PM.Common.PnAdditionRestored := Not Panel_Addition.HotSpotClosed; GSCSIni.PM.IDLastProject := GIDLastProject; WritePMIni(GSCSIni.PM); //ini.WriteString('ProjectManager', 'Path', DM.DataBase_SCS.DBName); //ini.WriteFloat('ProjectManager', 'NDS', {DM.GNDS}20); {ini.WriteBool(scProjMan, idtDisableEdit, Act_mnuDisableEditTree.Checked); ini.WriteInteger(scProjMan, idtDefNewItemType, GComboIndex); ini.WriteBool(scProjMan, idtDefCheckState, GCheck_asDefault); ini.WriteInteger(scProjMan, idtSavedList, GIDLastList); ini.WriteInteger(scProjMan, idtSavedProject, GIDLastProject);} end; end; //FreeAndNil(ini); end; except on E: Exception do AddExceptionToLog('TF_MAIN.WriteOptionsToINI: '+E.Message); end; end; // ##### Вернет ветвь компоненты, если параметр AComplNode явл. комплектующей ##### //*** Параметр Top (true - поднятся на самый верхний компонент, false - Поднятся к своему родительскому компоненту) function TF_MAIN.GetComponNode(AComplNode: TTreeNode): TTreeNode; var ComplNode: TTreeNode; ID_Compl: Integer; begin Result := nil; ComplNode := AComplNode.Parent; if PObjectData(ComplNode.Data).ComponKind <> ckNone then Result := ComplNode else Result := AComplNode; {while (ComplNode <> nil) and (PObjectData(ComplNode.Data).ComponKind <> ckCompon) do ComplNode := ComplNode.Parent; Result := ComplNode;} end; function TF_MAIN.GetComponIDsWithNoPairInterfaces(AObjectID, AItemType: Integer): TIntList; var DirComponIDs: TIntList; i, j, k: Integer; begin Result := TIntList.Create; DirComponIDs := nil; if AItemType = itDir then DirComponIDs := DM.GetCatalogAllComponIDs(AObjectID, true) else if AItemType = itComponLine then begin DirComponIDs := TIntList.Create; DirComponIDs.Add(AObjectID); end; for i := 0 to DirComponIDs.Count - 1 do begin SetSQLToFIBQuery(DM.Query_Select, 'select component.id from component, interface_relation '+ 'where (component.id = '''+IntToStr(DirComponIDs[i])+''') and '+ '(isLine = ''1'') and (id_component = component.id) and (typei = '''+IntToStr(itFunctional)+''') and '+ '(id_adverse is null)'); IntFIBFieldToIntList(Result, DM.Query_Select, fnID); j := 0; while j <= Result.Count - 1 do begin k := j+1; while k <= Result.Count - 1 do begin if Result[j] = Result[k] then Result.Delete(k) else Inc(k); end; inc(j); end; end; //Tolik FreeAndNil(DirComponIDs); // end; procedure TF_MAIN.OnNodeExit(ANode, ANewNode: TTreeNode; ADeactivCabinet: Boolean); var Dat: PObjectData; SCSCatalog: TSCSCatalog; SCSComonent: TSCSComponent; SCSList: TSCSList; TrunkComponent: TSCSComponent; JoinedTrunkComponent: TSCSComponent; TrunkComponobject: TSCSCatalog; begin Dat := nil; if ANode <> nil then Dat := ANode.Data; if Dat <> nil then begin if GDBMode = bkProjectManager then begin if ADeactivCabinet then if Dat.ItemType = itRoom then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if SCSCatalog <> nil then begin SCSList := SCSCatalog.GetListOwner; if (SCSList <> nil) and SCSList.OpenedInCAD then DeactivateCabinetOnCAD(SCSCatalog.ListID, SCSCatalog.SCSID); end; end; //*** Проверить, нужно ли переопределить кросс объект на КАДе if (Dat.ItemType in [itComponCon, itComponLine]) and (Not Assigned(ANewNode) or Not(PObjectData(ANewNode.Data).ItemType in [itComponCon, itComponLine]) ) then begin TrunkComponent := nil; SCSComonent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if SCSComonent <> nil then begin if IsTrunkComponent(SCSComonent) then TrunkComponent := SCSComonent else begin JoinedTrunkComponent := GetJoinedTrunkComponent(SCSComonent); if JoinedTrunkComponent <> nil then TrunkComponent := JoinedTrunkComponent; end; if TrunkComponent <> nil then begin TrunkComponobject := TrunkComponent.GetFirstParentCatalog; if TrunkComponobject <> nil then if dopTrunkChanged in TrunkComponobject.ServToDefineObjParams then begin BeginProgress; try F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(TrunkComponent, true); finally EndProgress; end; end; end; end; end; end; end; end; procedure TF_MAIN.WaitForTVChange; var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin if Not FHandledTVOnChange then begin Screen.Cursor := crHourGlass; Tree_Catalog.Items.BeginUpdate; try OldTick := GetTickCount; while Not FHandledTVOnChange do begin Application.ProcessMessages; CurrTick := GetTickCount - OldTick; //*** TimeOut 15 sec if CurrTick > 15000 then Break; //// BREAK //// end; finally Screen.Cursor := crDefault; Tree_Catalog.Items.EndUpdate; // Tolik 23/11/2016 -- Tree_Catalog.Invalidate; // end; end; end; // ##### Насыает в компоненту комплектующие в дереве ###### procedure TF_MAIN.FillCompl(AID_Compon: Integer; ACompNode: TTreeNode; ACompon: TSCSComponent=nil; AStepIndex: Integer = 0); var Compon: TSCSComponent; ComplectCompon: TSCSComponent; ComplList: TSCSComponents; OtherFields: String; i: Integer; NewChildNode: TTreeNode; TopComponNode: TTreeNode; IDTopCompon: Integer; IDCompRel: Integer; begin if Not Assigned(ACompNode) then Exit; //// EXIT //// if not (GFormMode in [fmNormal, fmConnections ]) then Exit; If ACompNode.Count > 0 then begin if GDBMode = bkProjectManager then begin Compon := GSCSBase.CurrProject.GetComponentFromReferences(AID_Compon); if Compon <> nil then ClearTVNodeFieldInChildObjects(Compon, false); end; DeleteChildNodes(ACompNode); end; IDTopCompon := 0; IDCompRel := 0; TopComponNode := GetTopComponNode(ACompNode); if TopComponNode <> nil then IDTopCompon := PObjectData(TopComponNode.Data).ObjectID; if PObjectData(ACompNode.Data).ComponKind = ckCompl then IDCompRel := PObjectData(ACompNode.Data).ID_CompRel; ComplList := DM.GetComponChilds(AID_Compon, IDTopCompon, IDCompRel, ACompon, fnSortID); for i := 0 to ComplList.Count - 1 do if Assigned(ComplList[i]) then begin ComplectCompon := ComplList[i]; if ComplectCompon.ComponentType.GUID = '' then ComplectCompon.LoadComponentType; NewChildNode := AddComplNode(ACompNode, ComplectCompon); //if AStepIndex = 0 then // begin // FillCompl(ComplectCompon.ID, NewChildNode, AStepIndex+1); // if NewChildNode.Count = 0 then // begin // PObjectData(NewChildNode.Data).ChildNodesCount := 0; // NewChildNode.HasChildren := false; // end; // end; //ComplData.Free; end; FreeAndNil(ComplList); { ComplData := TSCSComponent.Create(Self); try try //*** Комплектующие загружать только для главных форм (NormBase и ProjectManager) if not (GFormMode in [fmNormal, fmConnections ]) then Exit; If ACompNode.Count > 0 then ACompNode.DeleteChildren; OtherFields := ''; if GDBMode = bkProjectManager then OtherFields := ', Name_Mark, whole_id'; SetSQLToQuery(DM.scsQ, ' SELECT COMPONENT_RELATION.ID, Component.ID, NAME, ID_COMPONENT, ID_COMPONENT_TYPE, ID_CHILD, Kol_Complect, component_relation.Sort_ID ' + OtherFields + ' '+ ' FROM Component, COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+IntToStr(AID_Compon)+''' ) and ' + ' ( Component.ID = ID_Child) AND ' + ' (CONNECT_TYPE = '''+IntToStr(cntComplect)+''') and '+ ' ( ID_COMPONENT IN (SELECT ID FROM COMPONENT) ) '+ ' ORDER BY COMPONENT_RELATION.SORT_ID '); with F_NormBase do ChangeSQlQuery(DM.scsQSelect, ' select IsLine From Component_Types where id = :id '); while Not DM.scsQ.Eof do begin ComplData.ID := DM.scsQ.GetFNAsInteger('ID_Child'); //ComplData.ID_Child := ComplData.IDCompRel := DM.scsQ.GetFNAsInteger('ID'); //ComplData.isLine := ComplData.KolComplect := DM.scsQ.GetFNAsInteger('Kol_Complect'); ComplData.Name := DM.scsQ.GetFNAsString('Name'); if GDBMode = bkProjectManager then begin ComplData.NameMark := DM.scsQ.GetFNAsString('Name_Mark'); ComplData.Whole_ID := DM.scsQ.GetFNAsInteger('Whole_ID'); end; ComplData.SortID := DM.scsQ.GetFNAsInteger('Sort_ID'); with F_NormBase.DM do begin scsQSelect.Close; scsQSelect.SetParamAsInteger('id', DM.scsQ.GetFNAsInteger('id_component_type')); scsQSelect.ExecQuery; ComplData.isLine := scsQSelect.GetFNAsInteger('IsLine'); end; AddComplNode(ACompNode, ComplData); DM.scsQ.Next; end; except on E: Exception do AddExceptionToLog('TF_MAIN.FillCompl: '+E.Message); end; finally ComplData.Free; end; } end; // ##### Добавляет в дерево ветвь одной комплектующей ##### function TF_MAIN.AddComplNode(AComponNode: TTreeNode; AComplData: TSCSComponent): TTreeNode; var ComplNode: TTreeNode; ComplText: String; KolComplect: Integer; //*** Количество комплектующих в комплектующей ComplDat: PObjectData; LinkItemType: Integer; begin Result := nil; NewData(ComplDat, ttComponents); ComplDat.ObjectID := AComplData.ID; ComplDat.ID_CompRel := AComplData.IDCompRel; ComplDat.ItemType := GetSCSComponType(AComplData.isLine); ComplDat.ChildNodesCount := AComplData.KolComplect; ComplDat.QueryMode := FQueryModeByGDBMode; ComplDat.ComponKind := ckCompl; ComplDat.SortID := AComplData.CompRelSortID; ComplDat.Expanded := false; ComplDat.NBMode := PObjectData(AComponNode.Data).NBMode; ComplDat.ListID := PObjectData(AComponNode.Data).ListID; //ComplNode.Data := ComplDat; KolComplect := AComplData.KolComplect; ComplText := GetComponNameForVisible(AComplData.Name, AComplData.NameMark); ComplText := GetNameAndKol(ComplText, KolComplect); if GDBMode = bkProjectManager then if ComplDat.ItemType = itComponLine then ComplText := ComplText + GetNameConnectFromAndTo(AComplData); //#2006_03_29 ComplNode := Tree_Catalog.Items.AddChild(AComponNode, ComplText); ComplNode.Data := ComplDat; if GDBMode = bkNormBase then begin LinkItemType := ComplDat.ItemType; Case ComplDat.ItemType of itComponLine: LinkItemType := itLinkCompLine; itComponCon: LinkItemType := itLinkCompCon; end; //ComplDat.ItemType := LinkItemType; // Хуйня полная получается SetNodeState(ComplNode, LinkItemType, ekNone, AComplData); //Case ComplDat.ItemType of // itComponLine: // SetNodeState(ComplNode, itLinkCompLine, ekNone, AComplData); //ComplNode.ImageIndex := GetNodeImageIndex(itLinkCompLine, ekNone, ComplDat.ObjectID); // itComponCon: // SetNodeState(ComplNode, itLinkCompCon, ekNone, AComplData); //ComplNode.ImageIndex := GetNodeImageIndex(itLinkCompCon, ekNone, ComplDat.ObjectID); //end; end else SetNodeState(ComplNode, ComplDat.ItemType, ekNone, AComplData); //Case ComplDat.ItemType of // itComponLine: // SetNodeState(ComplNode, itComponLine, ekNone, AComplData); //ComplNode.ImageIndex := GetNodeImageIndex(itComponLine, ekNone, ComplDat.ObjectID); // itComponCon: // SetNodeState(ComplNode, itComponCon, ekNone, AComplData); //ComplNode.ImageIndex := GetNodeImageIndex(itComponCon, ekNone, ComplDat.ObjectID); //end; if AComplData.KolComplect > 0 then begin ComplNode.HasChildren := true; end; AComplData.TreeViewNode := ComplNode; Result := ComplNode; end; function TF_MAIN.GetComplNodeParentIDs(AComponNode: TTreeNode): TIntList; var CurrNode: TTreeNode; begin Result := TIntList.Create; CurrNode := AComponNode; while CurrNode <> nil do begin if IsComponentNode(CurrNode) then begin Result.Insert(0, PObjectData(CurrNode.Data).ObjectID); CurrNode := CurrNode.Parent; end else CurrNode := nil; end; end; function TF_MAIN.GetComponNodeNBConnections(AComponNode: TTreeNode): TSCSObjectList; var i: Integer; IDComponent: Integer; IDChild: Integer; NameConnection: String; ParentComponIDs: TIntList; IDCompRel: Integer; ptrNBConnection: TSCSCrossConnection; begin Result := TSCSObjectList.Create(false); if IsComponentNode(AComponNode) then begin IDCompRel := PObjectData(AComponNode.Data).ID_CompRel; if IDCompRel > 0 then begin //*** отобрать подключения SetSQLToFIBQuery(DM.Query_Select, 'select * from '+tnCrossConnection+' '+ 'where ('+fnIDComponent+' = :'+fnIDComponent+') and '+ '(('+fnIDCompRelFrom+' = '''+IntToStr(IDCompRel)+''') or ('+fnIDCompRelTo+' = '''+IntToStr(IDCompRel)+'''))', false); ParentComponIDs := GetComplNodeParentIDs(AComponNode); if ParentComponIDs.Count > 0 then begin DM.Query_Select.Close; DM.Query_Select.ParamByName(fnIDComponent).AsInteger := ParentComponIDs[0]; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin //*** отобрать не кросс соединения if DM.Query_Select.FieldByName(fnIDCompRelWith).AsInteger = 0 then begin //ptrNBConnection := DM.GetCrossConnectionFromQuery(DM.Query_Select); ptrNBConnection := TSCSCrossConnection.Create(Self); ptrNBConnection.LoadFromQuery(DM.Query_Select); Result.Add(ptrNBConnection); end; DM.Query_Select.Next; end; end; {for i := 0 to ParentComponIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.ParamByName(fnIDComponent).AsInteger := ParentComponIDs[i]; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin //*** отобрать не кросс соединения if DM.Query_Select.FieldByName(fnIDCompRelWith).AsInteger = 0 then begin //ptrNBConnection := DM.GetCrossConnectionFromQuery(DM.Query_Select); ptrNBConnection := TSCSCrossConnection.Create(Self); ptrNBConnection.LoadFromQuery(DM.Query_Select); Result.Add(ptrNBConnection); end; DM.Query_Select.Next; end; end;} //DM.LoadCrossConnectionsNames(Result); //DM.LoadCrossConnectionsPaths(Result); FreeAndNil(ParentComponIDs); end else // Если подключение к верхнему компоненту begin //*** отобрать подключения SetSQLToFIBQuery(DM.Query_Select, 'select * from '+tnCrossConnection+' '+ 'where ('+fnIDComponent+' = :'+fnIDComponent+')', false); DM.Query_Select.ParamByName(fnIDComponent).AsInteger := PObjectData(AComponNode.Data).ObjectID; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin //*** отобрать не кросс соединения if DM.Query_Select.FieldByName(fnIDCompRelWith).AsInteger = 0 then if (DM.Query_Select.FieldByName(fnIDCompRelFrom).AsInteger = 0) or (DM.Query_Select.FieldByName(fnIDCompRelTo).AsInteger = 0) then begin //ptrNBConnection := DM.GetCrossConnectionFromQuery(DM.Query_Select); ptrNBConnection := TSCSCrossConnection.Create(Self); ptrNBConnection.LoadFromQuery(DM.Query_Select); Result.Add(ptrNBConnection); end; DM.Query_Select.Next; end; end; DM.LoadCrossConnectionsNames(Result); DM.LoadCrossConnectionsPaths(Result); end; end; function TF_MAIN.GetCommonParentComponNode(ANode1, ANode2: TTreeNode): TTreeNode; var CurrParentNode: TTreeNode; begin Result := nil; if IsComponentNode(ANode1) and IsComponentNode(ANode2) then begin //*** компоненты на одном уровне if ANode1.Parent = ANode2.Parent then begin if IsComponentNode(ANode1.Parent) then Result := ANode1.Parent; end else begin CurrParentNode := ANode1; while Assigned(CurrParentNode) do begin if IsComponentNode(CurrParentNode) then begin if (CurrParentNode <> ANode1) and (CurrParentNode <> ANode2) and HaveNodeSub(CurrParentNode, ANode1) and HaveNodeSub(CurrParentNode, ANode2) then begin Result := CurrParentNode; Break; //// BREAK //// end else CurrParentNode := CurrParentNode.Parent; end else CurrParentNode := nil; end; end; end; if GIsConnChildToTopCompon then if Result = nil then begin if HaveNodeSub(ANode1, ANode2) then Result := ANode1 else if HaveNodeSub(ANode2, ANode1) then Result := ANode2; end; if Result <> nil then Result := GetTopComponNode(Result); end; function TF_MAIN.GetIDCompRelFromNode(ANode: TTreeNode): Integer; begin Result := 0; if ANode <> nil then begin if PObjectData(ANode.Data).ComponKind = ckCompl then Result := PObjectData(ANode.Data).ID_CompRel; end; end; function TF_MAIN.GetTopComponIDByNode(AComponNode: TTreeNode): Integer; var TopComponNode: TTreeNode; begin Result := 0; if AComponNode <> nil then begin TopComponNode := GetTopComponNode(AComponNode); if TopComponNode <> nil then Result := PObjectData(TopComponNode.Data).ObjectID; end; end; function TF_MAIN.GetTopComponNode(ACurrComponNode: TTreeNode): TTreeNode; var CurrParentNode: TTreeNode; begin Result := nil; CurrParentNode := ACurrComponNode; while Assigned(CurrParentNode) do begin if IsComponentNode(CurrParentNode) then begin Result := CurrParentNode; CurrParentNode := CurrParentNode.Parent; end else CurrParentNode := nil; end; end; // ##### Проверяет, имеет ли компонента соединения ##### function TF_MAIN.HaveConnect(AComponent: TSCSComponent; AShowList: Boolean): Boolean; var isLine: Integer; begin Result := false; if GDBMode = bkNormBase then Exit; ///// EXIT ///// if AComponent.IsLine = biTrue then Exit; ///// EXIT ///// SetSQLToQuery(DM.scsQSelect, ' select isline from component where id = '''+IntToStr(AComponent.ID)+''' '); isLine := DM.scsQSelect.GetFNAsInteger('isLine'); SetSQLToQuery(DM.scsQ, ' SELECT * FROM COMPONENT '+ ' WHERE Not(isLine = '''+IntToStr(IsLine)+''') and '+ ' ((ID in (SELECT ID_COMPONENT FROM COMPONENT_RELATION ' + ' WHERE (ID_CHILD = '''+IntToStr(AComponent.ID)+''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(cntUnion) +''') )) or '+ '(ID in (SELECT ID_Child FROM COMPONENT_RELATION ' + ' WHERE (ID_Component = '''+IntToStr(AComponent.ID)+''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(cntUnion) +''') )) )' ); if DM.scsQ.RecordCount > 0 then begin Result := true; if AShowList then begin //F_CanDelete.Button_Close.Caption := 'Продолжить'; F_CanDelete.ListView_NotDel.OnChange := nil; ShowList(Self, trkCatalog, fmView, cMain_Msg14+':', true); //F_CanDelete.Button_Close.Caption := 'Закрыть'; F_CanDelete.ListView_NotDel.OnChange := F_CanDelete.ListView_NotDelChange; end; end; end; function TF_MAIN.CheckComponVolumeBeforeCopy(ASrcForm, ATrgForm: TForm; ASrcCompon: TSCSComponent; ATrgObject: TSCSCatalog; var ATrgCompon: TSCSComponent; ATargetObjNode: TTreeNode; AFromHuman: Boolean): Integer; //const CmpDelta = 0.01; var SrcComponent: TSCSComponent; Interfac: TSCSInterface; TrgDat: PObjectData; //TrgObject: TSCSCatalog; SCSCompon: TSCSComponent; i, j: Integer; HaveSrcFemale: Boolean; HaveTrgFemale: Boolean; FemaleValue: Double; MaleValue: Double; FillValue: Double; FemaleCompon: TSCSComponent; MaleCompon: TSCSComponent; FemaleComponInterface: TSCSInterface; MaleComponInterface: TSCSInterface; FemaleInterface: TSCSInterface; //MaleInterface: TSCSInterface; FemaleComponsCH: TSCSComponents; // CH - Can Have Males FemaleComponsNCH: TSCSComponents; // NCH - Not Can Have Males FemaleName: String; MessgText: String; ConnectType: TConnectType; CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; CableChannelFullness: Double; QuastResultPlaceToConduitMaxCompons: Word; begin Result := IDYES; try ATrgCompon := nil; SrcComponent := nil; //TrgObject := nil; FemaleComponsCH := nil; FemaleComponsNCH := nil; HaveSrcFemale := false; HaveTrgFemale := false; ConnectType := cntComplect; TrgDat := ATargetObjNode.Data; if TrgDat.ItemType <> itSCSLine then Exit; ///// EXIT ///// if ATrgObject = nil then Exit; //// EXIT ///// FemaleValue := 0; MaleValue := 0; FillValue := 0; FemaleCompon := nil; MaleCompon := nil; FemaleComponInterface := nil; MaleComponInterface := nil; FemaleInterface := nil; //MaleInterface := nil; SrcComponent := ASrcCompon; if ATrgObject.ComponentReferences.Count > 0 then if DefineFemaleMaleCompons(SrcComponent, ATrgObject.ComponentReferences[0], FemaleCompon, MaleCompon, FemaleComponInterface, MaleComponInterface) then begin //*** Процент запаса каб. каналов CableChannelFullness := 0; if ATrgObject.SCSComponents.Count > 0 then CableChannelFullness := GetCableCanalFullnessKoef(ATrgObject.SCSComponents[0]) else CableChannelFullness := GSCSBase.CurrProject.CurrList.Setting.CableCanalFullnessKoef; //*** Определить, является ли ASrcCompon здесь мамой HaveSrcFemale := SrcComponent = FemaleCompon; if Not HaveSrcFemale then if MaleComponInterface <> nil then MaleValue := MaleComponInterface.ValueI; FemaleComponsCH := TSCSComponents.Create(false); FemaleComponsNCH := TSCSComponents.Create(false); try for i := 0 to ATrgObject.SCSComponents.Count - 1 do begin SCSCompon := ATrgObject.SCSComponents[i]; if Assigned(SCSCompon) then if SCSCompon.IsLine = biTrue then case HaveSrcFemale of true: //*** Определяем общий объем пап в целевом объекте if CanConnCompon(SrcComponent, SCSCompon, ConnectType, smtNone) then MaleValue := MaleValue + SCSCompon.GetVolume(gtMale); false: //*** поиск мам в целевом объекте begin FemaleInterface := SCSCompon.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue); if FemaleInterface <> nil then begin HaveTrgFemale := true; if CanConnCompon(SrcComponent, SCSCompon, ConnectType, smtNone, false) then begin CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleInterface, MaleValue, CableChannelFullness); if CanFemaleHaveMaleRes.CanHave then FemaleComponsCH.Add(SCSCompon) else FemaleComponsNCH.Add(SCSCompon); end; end; end; end; end; //*** Анализ Результатов case HaveSrcFemale of true: begin CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleComponInterface, MaleValue, CableChannelFullness); if Not CanFemaleHaveMaleRes.CanHave then begin MessgText := cMain_Msg16_1+' "'+SrcComponent.Name+'" '+cMain_Msg16_2+' '+FloatToStr(RoundCP(FloatInUOM(SrcComponent.GetVolume(gtFemale), umSM, FUOMMin, 2)))+' '+GetNameUOM2(FUOMMin)+cMain_Msg16_31+' '+ ' "'+ATrgObject.Name+'" '+cMain_Msg16_4+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.CurrMaleValue, umSM, FUOMMin, 2)))+' '+GetNameUOM2(FUOMMin)+'.'+#10+#13+ cMain_Msg16_6+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.MinValueForMales, umSM, FUOMMin, 2)))+' '+GetNameUOM2(FUOMMin)+'.'+#10+#13+ cMain_Msg16_7+' '+FloatToStr(RoundCP(CableChannelFullness))+' %.'+#10+#13+#10+#13+ cMain_Msg16_8+' "'+SrcComponent.Name+'" '+cMain_Msg16_9+'?'; if AFromHuman then begin //Result := MessageModal(MessgText, ApplicationName, MB_ICONQUESTION or MB_YESNOCANCEL); // проверка предыдущего нажатия "Да для всех" и "Нет для всех" if (FQuastLastResPlaceToConduitMaxCompons = mrYesToAll) and (mbYesToAll in FQuastAdditButtonsPlaceToConduitMaxCompons) then Result := IDYES else if (FQuastLastResPlaceToConduitMaxCompons = mrNoToAll) and (mbNoToAll in FQuastAdditButtonsPlaceToConduitMaxCompons) then Result := IDNO else begin QuastResultPlaceToConduitMaxCompons := MessageDlgLn(MessgText, ApplicationName, mtConfirmation, mbYesNoCancel + FQuastAdditButtonsPlaceToConduitMaxCompons); FQuastLastResPlaceToConduitMaxCompons := QuastResultPlaceToConduitMaxCompons; if (QuastResultPlaceToConduitMaxCompons = mrYes) or (QuastResultPlaceToConduitMaxCompons = mrYesToAll) then Result := IDYES else if (QuastResultPlaceToConduitMaxCompons = mrNo) or (QuastResultPlaceToConduitMaxCompons = mrNoToAll) then Result := IDNO else if QuastResultPlaceToConduitMaxCompons = mrCancel then Result := IDCANCEL; end; end else Result := IDYES; end; end; false: if HaveTrgFemale then begin //*** Если больше равно одного вмещающих "коробов", то выбрать нужный if FemaleComponsCH.Count >= 1 then begin ATrgCompon := FemaleComponsCH[0]; end; //*** Если нет пустых вмещающих коробов if (FemaleComponsCH.Count = 0) and (FemaleComponsNCH.Count > 0) then begin FemaleInterface := TSCSComponent(FemaleComponsNCH[0]).GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue); FemaleName := TSCSComponent(FemaleComponsNCH[0]).Name; CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleInterface, MaleValue, CableChannelFullness); if Not CanFemaleHaveMaleRes.CanHave then begin MessgText := cMain_Msg17_1+' "'+FemaleName+'" '+cMain_Msg17_2+' '+FloatToStr(RoundCP(FloatInUOM(FemaleComponsNCH[0].GetVolume(gtFemale),umSM,FUOMMin,2)))+' '+GetNameUOM2(FUOMMin)+cMain_Msg16_31+ ' "'+ATrgObject.Name+'" '+cMain_Msg17_4+' "'+SrcComponent.Name+'" '+cMain_Msg17_5+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.CurrMaleValue,umSM,FUOMMin,2)))+' '+GetNameUOM2(FUOMMin)+cMain_Msg17_61+'.'+ #13 + cMain_Msg17_7+' "'+FemaleName+'" '+cMain_Msg17_8+' '+FloatToStr(RoundCP(FloatInUOM(CanFemaleHaveMaleRes.MinValueForMales,umSM,FUOMMin,2)))+' '+GetNameUOM2(FUOMMin)+cMain_Msg17_91+#10+#13+ cMain_Msg17_10+' '+FloatToStr(RoundCP(CableChannelFullness))+' %.'+#10+#13+#10+#13+ cMain_Msg17_11+' "'+SrcComponent.Name+'" '+cMain_Msg17_12+'?'; if AFromHuman then begin Result := MessageModal(MessgText, ApplicationName, MB_ICONQUESTION or MB_YESNO); //*** Если значение = IDNO, то компонент продолжет свое копироваться if Result = IDNO then Result := IDCANCEL; end else Result := IDIGNORE; end; end else // Если в объекте не присутствуют компоненты рода мымы if (FemaleComponsCH.Count = 0) and (FemaleComponsNCH.Count > 0) then Result := IDNO; end else Result := IDNO; end; finally if FemaleComponsCH <> nil then FreeAndNil(FemaleComponsCH); if FemaleComponsNCH <> nil then FreeAndNil(FemaleComponsNCH); end; end else begin if (FemaleComponInterface = nil) and (MaleComponInterface = nil) then begin if GUseVisibleInterfaces then ShowMessageByType(0, smtNone, cMain_Msg15_1+' "'+ASrcCompon.GetNameForVisible+'" '+cMain_Msg15_2, ApplicationName, 0) else begin if (ASrcCompon = MaleCompon) and (ASrcCompon.GetPropertyBySysName(pnOutSection) = nil) then ShowMessageByType(0, smtNone, cMain_Msg15_1+' "'+ASrcCompon.GetNameForVisible+'" '+cMain_Msg15_2_1, ApplicationName, 0) else if (ASrcCompon = FemaleCompon) and (ASrcCompon.GetPropertyBySysName(pnInSection) = nil) then ShowMessageByType(0, smtNone, cMain_Msg15_1+' "'+ASrcCompon.GetNameForVisible+'" '+cMain_Msg15_2_2, ApplicationName, 0); end; Result := IDIGNORE; Exit; ///// EXIT ///// end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.CheckComponVolumeBeforeCopy: '+E.Message); end; //ATrgCompon := nil; // Если не nil, то в некоторых случаях может получаться ХУЙНЯ в InsertComplectInObject (если ATrgCompon <> nil могут выпадать одни вопросы, иначе другие) end; function TF_MAIN.CheckComponComplectBeforeCopy(ASrcForm, ATrgForm: TForm; ASrcCompon: TSCSComponent; ATrgObject: TSCSCatalog; var ATrgCompon: TSCSComponent; ATargetObjNode: TTreeNode; AFromHuman: Boolean): Integer; var SrcComponent: TSCSComponent; Interfac: TSCSInterface; TrgDat: PObjectData; //TrgObject: TSCSCatalog; SCSCompon: TSCSComponent; i, j: Integer; HaveSrcFemale: Boolean; HaveTrgFemale: Boolean; FemaleValue: Double; MaleValue: Double; FillValue: Double; FemaleCompon: TSCSComponent; MaleCompon: TSCSComponent; FemaleComponInterface: TSCSInterface; MaleComponInterface: TSCSInterface; FemaleInterface: TSCSInterface; FemaleComponsCH: TSCSComponents; // CH - Can Have Males FemaleComponsNCH: TSCSComponents; // NCH - Not Can Have Males FemaleName: String; MessgText: String; ConnectType: TConnectType; CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; CableChannelFullness: Double; QuastResultPlaceToConduitMaxCompons: Word; sMale, sFemale : integer; compon : TSCSComponent; begin Result := IDNO; //FemaleComponsCH := TSCSComponents.Create(false); //FemaleComponsNCH := TSCSComponents.Create(false); try ATrgCompon := nil; SrcComponent := nil; //TrgObject := nil; //FemaleComponsCH := nil; //FemaleComponsNCH := nil; HaveSrcFemale := false; HaveTrgFemale := false; ConnectType := cntComplect; TrgDat := ATargetObjNode.Data; if TrgDat.ItemType <> itSCSConnector then Exit; ///// EXIT ///// if ATrgObject = nil then Exit; //// EXIT ///// FemaleValue := 0; MaleValue := 0; FillValue := 0; FemaleCompon := nil; MaleCompon := nil; FemaleComponInterface := nil; MaleComponInterface := nil; FemaleInterface := nil; //MaleInterface := nil; sMale := 0; sFemale := 0; Compon := nil; // Tolik 21/05/2018 -- //FemaleComponsCH := TSCSComponents.Create(false); //FemaleComponsNCH := TSCSComponents.Create(false); // SrcComponent := ASrcCompon; // Male Interfs of dropped obj for i := 0 to SrcComponent.Interfaces.Count - 1 do begin if (SrcComponent.Interfaces[i].TypeI = itConstructive) and (SrcComponent.Interfaces[i].Gender = gtMale) then inc(sMale); end; // Looking for Female interfaces in terget Obj if ATrgObject.ComponentReferences.Count > 0 then begin for i := 0 to ATrgObject.ComponentReferences.Count -1 do begin sFemale := 0; Compon := ATrgObject.ComponentReferences[i]; if Compon <> nil then begin for j := 0 to Compon.Interfaces.Count - 1 do begin if ((Compon.Interfaces[j].TypeI = itConstructive) and (Compon.Interfaces[j].Gender = gtFeMale) and (Compon.Interfaces[j].IsBusy = biFalse)) then inc(sFemale); end; // Can insert to this Obj if sFemale >= sMale then begin Result := IDYES; ATrgCompon := Compon; //ATrgObject := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(Compon.Id); break; end; end; end; end; { if ATrgObject.ComponentReferences.Count > 0 then ATrgCompon := ATrgObject.ComponentReferences[0] else Result := IDNO;} except; end; // Tolik 21/05/2018 - - //FemaleComponsCH.Free; //FemaleComponsNCH.Free; // end; { function TF_MAIN.CheckComponVolumeBeforeCopy(ASrcForm, ATrgForm: TForm; ASrcCompon: TSCSComponent; ATrgObject: TSCSCatalog; var ATrgCompon: TSCSComponent; ATargetObjNode: TTreeNode; AFromHuman: Boolean): Integer; const CmpDelta = 0.01; var SrcComponent: TSCSComponent; SrcComponGender: TGenderType; Interfac: TSCSInterface; TrgDat: PObjectData; //TrgObject: TSCSCatalog; SCSCompon: TSCSComponent; i, j: Integer; HaveSrcFemale: Boolean; HaveTrgFemale: Boolean; FemaleValue: Double; MaleValue: Double; FillValue: Double; FemaleInterface: TSCSInterface; MaleInterface: TSCSInterface; FemaleComponsCH: TSCSComponents; // CH - Can Have Males FemaleComponsNCH: TSCSComponents; // NCH - Not Can Have Males FemaleName: String; MessgText: String; ConnectType: TConnectType; CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; CableChannelFullness: Double; ListItem: TListItem; ptrID: ^Integer; begin Result := IDYES; try ATrgCompon := nil; SrcComponent := nil; //TrgObject := nil; FemaleComponsCH := nil; FemaleComponsNCH := nil; HaveSrcFemale := false; HaveTrgFemale := false; ConnectType := cntComplect; TrgDat := ATargetObjNode.Data; if TrgDat.ItemType <> itSCSLine then Exit; ///// EXIT ///// if ATrgObject = nil then Exit; //// EXIT ///// FemaleValue := 0; MaleValue := 0; FillValue := 0; FemaleInterface := nil; MaleInterface := nil; FemaleComponsCH := TSCSComponents.Create(false); FemaleComponsNCH := TSCSComponents.Create(false); SrcComponent := ASrcCompon; CableChannelFullness := 0; if ATrgObject.SCSComponents.Count > 0 then CableChannelFullness := GetCableCanalFullnessKoef(ATrgObject.SCSComponents[0]) else CableChannelFullness := GSCSBase.CurrProject.CurrList.Setting.CableCanalFullnessKoef; try //*** Найти конструктивный интерфейс "мама" for i := 0 to SrcComponent.Interfaces.Count - 1 do begin Interfac := SrcComponent.Interfaces[i]; if (Interfac.TypeI = itConstructive) and (Interfac.Multiple = biTrue) then if Interfac.Gender = gtFemale then begin FemaleInterface := Interfac; MaleValue := 0; FemaleName := SrcComponent.Name; HaveSrcFemale := true; SrcComponGender := Interfac.Gender; Break; ///// BREAK ///// end else if Not HaveSrcFemale then begin MaleValue := Interfac.ValueI; SrcComponGender := Interfac.Gender; MaleInterface := Interfac; end; end; if (FemaleInterface = nil) and (MaleInterface = nil) then begin ShowMessageByType(0, smtNone, cMain_Msg15_1+' "'+ASrcCompon.GetNameForVisible+'" '+cMain_Msg15_2, ApplicationName, 0); Result := IDIGNORE; Exit; ///// EXIT ///// end; //ATrgObject := TSCSCatalog.Create(ATrgForm); //ATrgObject.LoadCatalogByID(TrgDat.ObjectID, false); //ATrgObject.LoadComponents(TrgDat.ObjectID, false); for i := 0 to ATrgObject.SCSComponents.Count - 1 do begin SCSCompon := TSCSComponent(ATrgObject.SCSComponents[i]); if Assigned(SCSCompon) then if SCSCompon.IsLine = biTrue then case HaveSrcFemale of true: //*** Определяем общий объем пап в целевом объекте if CanConnCompon(SrcComponent, SCSCompon, ConnectType, smtNone) then MaleValue := MaleValue + SCSCompon.GetVolume(gtMale); false: //*** поиск мам в целевом объекте begin FemaleInterface := SCSCompon.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue); if FemaleInterface <> nil then begin HaveTrgFemale := true; if CanConnCompon(SrcComponent, SCSCompon, ConnectType, smtNone, false) then begin CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleInterface, MaleValue, CableChannelFullness); if CanFemaleHaveMaleRes.CanHave then FemaleComponsCH.Add(SCSCompon) else FemaleComponsNCH.Add(SCSCompon); end; end; end; end; end; //*** Анализ Результатов case HaveSrcFemale of true: begin CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleInterface, MaleValue, CableChannelFullness); if Not CanFemaleHaveMaleRes.CanHave then begin //MessgText := 'Компонент "'+SrcComponent.Name+'" (с свободным объемом '+FloatToStr(CanFemaleHaveMaleRes.CurrFemaleEmptyValue)+' см2) не может вместить в себя компоненты '+ // 'объекта "'+ATrgObject.Name+'" (с общим объемом '+FloatToStr(CanFemaleHaveMaleRes.CurrMaleValue)+' см2).'+ #13 + // 'Выберите "'+FemaleName+'" с объемом не меньше чем '+FloatToStr(CanFemaleHaveMaleRes.MinValueForMales)+' см2.'; MessgText := cMain_Msg16_1+' "'+SrcComponent.Name+'" '+cMain_Msg16_2+' '+FloatToStr(RoundCP(SrcComponent.GetVolume(gtFemale)))+' '+cMain_Msg16_3+' '+ ' "'+ATrgObject.Name+'" '+cMain_Msg16_4+' '+FloatToStr(RoundCP(CanFemaleHaveMaleRes.CurrMaleValue))+' '+cMain_Msg16_5+'.'+#10+#13+ cMain_Msg16_6+' '+FloatToStr(RoundCP(CanFemaleHaveMaleRes.MinValueForMales))+' '+cMain_Msg16_5+'.'+#10+#13+ cMain_Msg16_7+' '+FloatToStr(RoundCP(CableChannelFullness))+' %.'+#10+#13+#10+#13+ cMain_Msg16_8+' "'+SrcComponent.Name+'" '+cMain_Msg16_9+'?'; if AFromHuman then Result := MessageModal(MessgText, ApplicationName, MB_ICONQUESTION or MB_YESNOCANCEL) else Result := IDYES; end; end; false: if HaveTrgFemale then begin //*** Если больше одного вмещающих "коробов", то выбрать нужный if FemaleComponsCH.Count > 1 then begin ATrgCompon := FemaleComponsCH[0]; end; //*** Если один вмещающий "короб" if FemaleComponsCH.Count = 1 then begin ATrgCompon := FemaleComponsCH[0]; end; //*** Если нет пустых вмещающих коробов if (FemaleComponsCH.Count = 0) and (FemaleComponsNCH.Count > 0) then begin FemaleInterface := TSCSComponent(FemaleComponsNCH[0]).GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue); FemaleName := TSCSComponent(FemaleComponsNCH[0]).Name; CanFemaleHaveMaleRes := CanFemaleHaveMale(FemaleInterface, MaleValue, CableChannelFullness); if Not CanFemaleHaveMaleRes.CanHave then begin MessgText := cMain_Msg17_1+' "'+FemaleName+'" '+cMain_Msg17_2+' '+FloatToStr(RoundCP(FemaleComponsNCH[0].GetVolume(gtFemale)))+' '+cMain_Msg17_3+ ' "'+ATrgObject.Name+'" '+cMain_Msg17_4+' "'+SrcComponent.Name+'" '+cMain_Msg17_5+' '+FloatToStr(RoundCP(CanFemaleHaveMaleRes.CurrMaleValue))+' '+cMain_Msg17_6+'.'+ #13 + cMain_Msg17_7+' "'+FemaleName+'" '+cMain_Msg17_8+' '+FloatToStr(RoundCP(CanFemaleHaveMaleRes.MinValueForMales))+' '+cMain_Msg17_9+#10+#13+ cMain_Msg17_10+' '+FloatToStr(RoundCP(CableChannelFullness))+' %.'+#10+#13+#10+#13+ cMain_Msg17_11+' "'+SrcComponent.Name+'" '+cMain_Msg17_12+'?'; if AFromHuman then begin Result := MessageModal(MessgText, ApplicationName, MB_ICONQUESTION or MB_YESNO); //*** Если значение = IDNO, то компонент продолжет свое копироваться if Result = IDNO then Result := IDCANCEL; end else Result := IDIGNORE; end; end else // Если в объекте не присутствуют компоненты рода мымы if (FemaleComponsCH.Count = 0) and (FemaleComponsNCH.Count > 0) then Result := IDNO; end else Result := IDNO; end; finally if FemaleComponsCH <> nil then FreeAndNil(FemaleComponsCH); if FemaleComponsNCH <> nil then FreeAndNil(FemaleComponsNCH); end; except on E: Exception do AddExceptionToLog('TF_MAIN.CheckComponVolumeBeforeCopy: '+E.Message); end; end; } // ##### Вставляет в линейный компонент подходящую комплектующую в объекте ##### function TF_MAIN.InsertComplectInObject(AInsComponentNode: TTreeNode; ATrgObject: TSCSCatalog; AInsCompon, ATrgCompon: TSCSComponent; AFromHuman: Boolean): Boolean; var ComponIns: TSCSComponent; //ComponInsVolume: Double; //CatComponVolume: Double; //HaveFemale: Boolean; //Interfac: TSCSInterface; SCSCompon: TSCSComponent; ComponentNode: TTreeNode; ParentNode: TTreeNode; ChildNode: TTreeNode; i: Integer; CanConnectKind: TCanConnectKind; ConnectKind: TConnectKind; InsComponConstrType: Integer; SCSComponents: TSCSComponents; ShowMessageType: TShowMessageType; begin Result := false; try //ComponIns := nil; ConnectKind := cnkVarious; ParentNode := nil; ChildNode := nil; SCSComponents := nil; //if Not GAutoInsertingCompons then // Exit; //// EXIT ///// if (AInsComponentNode = nil) or (AInsComponentNode.Data = nil) then Exit; //// EXIT ///// if (ATrgObject = nil) then Exit; //// EXIT ///// //ComponIns := TSCSComponent.Create(TForm(Self)); try //ComponIns.LoadComponentByID(PObjectData(AInsComponentNode.Data).ObjectID, false); ComponIns := nil; if AInsCompon <> nil then ComponIns := AInsCompon else ComponIns := GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(AInsComponentNode.Data).ObjectID); if ComponIns = nil then Exit; //// EXIT ///// //if ComponIns.IsLine = biFalse then // Exit; ///// EXIT ///// ShowMessageType := smtNone; if AFromHuman then ShowMessageType := smtDisplay; //*** Если цель передана if ATrgCompon <> nil then begin ComponentNode := nil; ComponentNode := ATrgCompon.TreeViewNode; //FindComponOrDirInTree(ATrgCompon.ID, true); if ComponentNode = nil then ComponentNode := FindComponOrDirInTree(ATrgCompon.ID, true); if ComponentNode <> nil then begin MoveCompl(AInsComponentNode, ComponentNode, ShowMessageType); ParentNode := ComponentNode; ChildNode := AInsComponentNode; Result := true; end; end else begin //ObjCatalog := TSCSCatalog.Create(TForm(Self)); //ObjCatalog.LoadCatalogByID(PObjectData(AObjCatalogNode.Data).ObjectID, false); //ComponIns.LoadInterfaces(-1, false); SCSComponents := TSCSComponents.Create(false); SCSComponents.Assign(ATrgObject.SCSComponents); if ATrgObject.ItemType = itSCSLine then begin //ATrgObject.LoadComponents(ATrgObject.ID, false); if SCSComponents.Count > 0 then begin for i := 0 to SCSComponents.Count - 1 do if Assigned(SCSComponents[i]) then begin SCSCompon := SCSComponents.Items[i]; if SCSCompon.ID <> ComponIns.ID then if SCSCompon.IsLine = biTrue then begin //SCSCompon.LoadInterfaces(-1, false); if CanConnCompon(ComponIns, SCSCompon, ConnectKind, smtNone) then begin //CanConnectKind := CanConnComponByinterf(Self, ComponIns, // SCSCompon, ConnectKind, cntComplect); //if CanConnectKind = cckAuto then if ComponIns.CheckComplectWith(SCSCompon, false, true).CanConnect then begin ComponentNode := nil; ComponentNode := SCSCompon.TreeViewNode; //FindComponOrDirInTree(SCSCompon.ID, true); if ComponentNode = nil then ComponentNode := FindComponOrDirInTree(SCSCompon.ID, true); if ComponentNode <> nil then begin MoveCompl(ComponentNode, AInsComponentNode, ShowMessageType); ParentNode := AInsComponentNode; ChildNode := ComponentNode; Result := true; if ComponIns.ComponentType.SysName <> ctsnCableChannel then Break; ///// BREAK ///// end; end else begin //CanConnectKind := CanConnComponByinterf(Self, SCSCompon, // ComponIns, ConnectKind, cntComplect); //if CanConnectKind = cckAuto then if SCSCompon.CheckComplectWith(ComponIns, false, true).CanConnect then begin ComponentNode := nil; ComponentNode := SCSCompon.TreeViewNode; if ComponentNode = nil then ComponentNode := FindComponOrDirInTree(SCSCompon.ID, true); if ComponentNode <> nil then begin MoveCompl(AInsComponentNode, ComponentNode, ShowMessageType); ParentNode := ComponentNode; ChildNode := AInsComponentNode; Result := true; if ComponIns.ComponentType.SysName <> ctsnCableChannel then Break; ///// BREAK ///// end; end; end; end; end; end; end; end; FreeAndNil(SCSComponents); end; finally //if ComponIns <> nil then // ComponIns.Free; //if ObjCatalog <> nil then // ObjCatalog.Free; end; except on E: Exception do AddExceptionToLog('TF_MAIN.InsertComplectInObject: '+E.Message); end; end; procedure TF_MAIN.MoveComponComplectsToUp(ACompon: TSCSComponent; AComponNode: TTreeNode); var //ParantComponNode: TTreeNode; ObjectNode: TTreeNode; CurrChildComponNode: TTreeNode; NextNode: TTreeNode; ObjectOwner: TSCSCatalog; ChildComplect: TSCSComponent; i: Integer; //Compon: TSCSComponent; //ChildCompon: TSCSComponent; //SCSObject: TSCSCatalog; begin try LockTreeAndGrid(true); try if GDBMode <> bkProjectManager then Exit; //// EXIT //// if ACompon.IsLine = biFalse then Exit; //// EXIT //// if ACompon.ComponentType.SysName = ctsnCableChannel then begin ObjectOwner := ACompon.GetFirstParentCatalog; if ObjectOwner <> nil then begin if AComponNode = nil then begin FindComponOrDirInTree(ACompon.ID, true); DefineChildNodes(ACompon.TreeViewNode); end else DefineChildNodes(AComponNode); i := 0; while i <= (ACompon.ChildComplects.Count - 1) do begin ChildComplect := ACompon.ChildComplects[i]; if ChildComplect.ComponentType.SysName <> ctsnCableChannelAccessory then begin ChildComplect.DisConnectFromParent; ObjectOwner.AddComponentToCatRel(ChildComplect); end else Inc(i); end; end; end; {if GDBMode <> bkProjectManager then Exit; //// EXIT //// if PObjectData(AComponNode.Data).ItemType <> itComponLine then Exit; //// EXIT //// ObjectNode := nil; ObjectNode := GetTargetNodeForItemType(AComponNode, itComponLine, qmUndef); if ObjectNode = nil then Exit; //// EXIT //// DefineChildNodes(AComponNode); CurrChildComponNode := nil; CurrChildComponNode := AComponNode.GetFirstChild; while CurrChildComponNode <> nil do begin NextNode := CurrChildComponNode.GetNextSibling; MoveCompl(CurrChildComponNode, ObjectNode, smtDisplay); PObjectData(CurrChildComponNode.Data).ComponKind := ckCompon; SetSortID(CurrChildComponNode); CurrChildComponNode := NextNode; end;} finally LockTreeAndGrid(false); end; except on E: Exception do AddExceptionToLog('TF_MAIN.MoveComponComplectsToUp: '+E.Message); end; end; function TF_MAIN.isComplect(AIDComponent: Integer; AQuery: TSCSQuery): Boolean; begin Result := false; SetSQLToQuery(AQuery, ' SELECT COUNT(ID) As Cnt FROM COMPONENT_RELATION ' + ' WHERE (ID_CHILD = '''+IntToStr(AIDComponent)+''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(cntComplect) +''') '); if AQuery.GetFNAsInteger('Cnt') > 0 then Result := true; { SetSQLToQuery(DM.scsQ, ' SELECT * FROM COMPONENT '+ ' WHERE ID in (SELECT ID_COMPONENT FROM COMPONENT_RELATION ' + 'WHERE (ID_CHILD = '''+IntToStr(AIDComponent)+''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(cntComplect) +''') )' ); if DM.scsQ.RecordCount > 0 then Result := true; } end; // ##### Проверяет Является ли компонента комплектующей, если да, то в ##### // ##### каких компонентах ##### function TF_MAIN.isComplectWhere(AComponent: TSCSComponent; AMess1, AMess2: String): Boolean; begin Result := false; if isComplect(AComponent.ID, DM.scsQ) then begin F_CanDelete.Button_Close.Caption := cMain_Msg18; F_CanDelete.ListView_NotDel.OnChange := nil; SetSQLToQuery(DM.scsQ, ' SELECT ID, Name FROM COMPONENT '+ ' WHERE ID in (SELECT ID_Component FROM COMPONENT_RELATION ' + ' WHERE (ID_CHILD = '''+IntToStr(AComponent.ID)+''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(cntComplect) +''')) '); ShowList(Self, trkCatalog, fmView, AMess1 + ' "' + AComponent.Name +'"' + #13 + AMess2, true); F_CanDelete.Button_Close.Caption := cMain_Msg19; F_CanDelete.ListView_NotDel.OnChange := F_CanDelete.ListView_NotDelChange; Result := true; end else if HaveConnect(AComponent, true) then Result := true; end; // показать кабели вне каб. каналов // (если на трассе каб. канал есть, а кабель в него весь не поместился) procedure TF_MAIN.ShowConnDisconnCompons(ACatalog: TSCSCatalog; AModeConnDisconnCompons: TModeConnDisconnCompons); var SCSObject: TSCSCatalog; //FolderIDComponList: TList; ListWithLookedCompons: TIntList; Component: TSCSComponent; i, j: Integer; CanShowCompon: Boolean; HaveComplConnections: Boolean; //FillLineCompon: TFillConnectConObj; ListItem: TListItem; CablesNoInCanals: TSCSComponents; CurrCables: TSCSComponents; CurrCatalog: TSCSCatalog; CurrCompon: TSCSComponent; WasMeetCanal: Boolean; Node: TFlyNode; // added by Tolik // CurrCatalog: TSCSCatalog; SCSComponent: TSCSComponent; CableIds : TIntList; k: integer; SCScomponents : TSCSComponents; ListCad : TF_Cad; CurrList, NextList: TSCSList; Figure : TFigure; FirstCatalog, NextCatalog : TSCSCatalog; s : TStringList; Connector1, Connector2, Connector3, Connector4 : TConnectorObject; currTrace,NextTrace : TFigure; // трассы, по которым проходит кабель CurrAngle : double; LookedComponents : TIntList; AnglesList : TStringList; TakeThisCable : boolean; AnglesCount : Integer; currSCSComponent : TSCSComponent; SCSComponList : TIntList; OldCap: string; // 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 Result := 0; // первый вектор 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; Function GetListName(AComponent: TSCSComponent): String; Var //ListCatalog: TCatalog; SCSList: TSCSList; Begin Result := ''; SCSList := nil; SCSList := AComponent.GetListOwner; //TF_Main(GForm).GSCSBase.CurrProject.GetListBySCSID(AIDList); if Assigned(SCSList) then Result := SCSList.GetNameForVisible(false); //ListCatalog := TF_Main(GForm).DM.GetCatalogByComponAndItemType(AIDComponent, itList); //Result := ListCatalog.Name; End; Function GetActualOrderInWholeComponent(Component: TSCSComponent) : TIntList; Var i,j,counter: integer; firstSCSComponent, nextSCSComponent : TSCSComponent; Connector1, Connector2, Connector3, Connector4 : TConnectorObject; currTrace,NextTrace : TFigure; // трассы, по которым проходит кабель ListCad : TF_Cad; CurrList, NextList: TSCSList; Figure : TFigure; FirstCatalog, NextCatalog : TSCSCatalog; //ListWithLookedComponents : TIntList; TakeThisCable : boolean; Begin Result := TIntList.Create; Component.LoadWholeComponent(true); //Component.DefineFirstLast(true); firstSCSComponent := Component.FirstCompon;//F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(Component.WholeComponent[0]); Result.Add(Component.WholeComponent[0]); // лист, на котором кабель currList := firstSCSComponent.GetListOwner; // КАД ListCad := GetListByID(firstSCSComponent.GetFirstParentCatalog.GetListOwner.SCSID); //трасса FirstCatalog := firstSCSComponent.GetFirstParentCatalog; // трасса на КАДе currTrace := TOrthoLine(GetFigureByID(ListCad,FirstCatalog.SCSID)); // коннекторы трассы connector1 := TConnectorObject(Tortholine(CurrTrace).JoinConnector1); connector2 := TConnectorObject(Tortholine(CurrTrace).JoinConnector2); Counter := 1; repeat for i := 1 to Component.WholeComponent.Count - 1 do begin nextSCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.WholeComponent[i]); TakeThisCable := true; // если кабель еще не попал в список for j := 0 to Result.Count-1 do begin if Result[j] = nextSCSComponent.ID then TakethisCable := false; end; if TakeThisCable then begin // трасса nextCatalog := nextSCSComponent.GetFirstParentCatalog; // лист КАДа ListCad := GetListByID(nextSCSComponent.GetFirstParentCatalog.GetListOwner.SCSID); // трасса на КАДе nextTrace := TOrthoLine(GetFigureByID(ListCad,nextCatalog.SCSID)); // коннекторы трассы connector3 := TConnectorObject(Tortholine(nextTrace).JoinConnector1); connector4 := TConnectorObject(Tortholine(nextTrace).JoinConnector2); if (connector1<>nil) then begin if connector1 = connector3 then TakeThisCable := false; if connector1 = connector4 then TakeThisCable := false; end; if (connector2<>nil) then begin if connector2 = connector3 then TakeThisCable := false; if connector2 = connector4 then TakeThisCable := false; end; if not TakethisCable then begin Result.Add(nextSCSComponent.ID); // коннекторы трассы connector1 := connector3; connector2 := connector4; counter := counter + 1; break; end; end; end; until counter = Component.WholeComponent.Count; End; function HowFillComponent(AComponent: TSCSComponent): TFillConnectConObj; var i, j: Integer; SCSComplect: TSCSComponent; Interfac: TSCSInterface; BusyInterfCount: Integer; EmptyInterfCount: Integer; begin Result := foNone; BusyInterfCount := 0; EmptyInterfCount := 0; //if AComponent.Interfaces.Count = 0 then // AComponent.LoadInterfaces(-1, false); for i := 0 to AComponent.Interfaces.Count - 1 do begin Interfac := AComponent.Interfaces.Items[i]; if (Interfac.TypeI = itFunctional) and (Interfac.Kind = ikNoSplit) then IncBusyEmptyInterface(Interfac, EmptyInterfCount, BusyInterfCount); {if Interfac.IsBusy = biTrue then BusyInterfCount := BusyInterfCount + 1 else EmptyInterfCount := EmptyInterfCount + 1;} end; for i := 0 to AComponent.ChildReferences.Count - 1 do begin SCSComplect := AComponent.ChildReferences.Items[i]; if SCSComplect.Interfaces.Count = 0 then SCSComplect.LoadInterfaces(-1, false); for j := 0 to SCSComplect.Interfaces.Count - 1 do begin Interfac := SCSComplect.Interfaces.Items[j]; if (Interfac.TypeI = itFunctional) and (Interfac.Kind = ikNoSplit) then IncBusyEmptyInterface(Interfac, EmptyInterfCount, BusyInterfCount); {if Interfac.IsBusy = biTrue then BusyInterfCount := BusyInterfCount + 1 else EmptyInterfCount := EmptyInterfCount + 1;} end; end; { if (EmptyInterfCount = 0) and (BusyInterfCount > 0) then Result := foBusy; if (EmptyInterfCount > 0) and (BusyInterfCount = 0) then Result := foEmpty; if (EmptyInterfCount > 0) and (BusyInterfCount > 0) then Result := foPartEmpty;} Result := GetHowFillObjByEmptyBusy(EmptyInterfCount, BusyInterfCount); end; function HowFillLineComponent(AComponent: TSCSComponent): TFillConnectConObj; var FillSide1: TFillConnectConObj; FillSide2: TFillConnectConObj; ComponSide1: TSCSComponent; ComponSide2: TSCSComponent; i: Integer; Interfac: TSCSInterface; ChildSumValueI: Double; ValueI: Double; CurrValueI: Double; HaveConstructiveFemale: Boolean; HaveFunctionalInterf: Boolean; begin Result := foNone; FillSide1 := foEmpty; FillSide2 := foEmpty; ComponSide1 := nil; ComponSide2 := nil; ValueI := 0; CurrValueI := 0; if AComponent.IsLine = biFalse then Exit; //// EXIT //// HaveConstructiveFemale := false; HaveFunctionalInterf := false; if AComponent.Interfaces.Count = 0 then AComponent.LoadInterfaces(-1, false); for i := 0 to AComponent.Interfaces.Count - 1 do begin Interfac := AComponent.Interfaces.Items[i]; if Interfac.TypeI = itConstructive then if Interfac.Gender = gtFemale then begin ChildSumValueI := 0; ChildSumValueI := Interfac.GetInterfToValues; //DM.GetConnectedInterfacesValues(DM.scsQSelect, Interfac.ID); ValueI := Interfac.ValueI; CurrValueI := Interfac.ValueI - ChildSumValueI; HaveConstructiveFemale := true; end; if Interfac.TypeI = itFunctional then HaveFunctionalInterf := true; end; if HaveConstructiveFemale then begin if (CurrValueI = 0) and (ValueI > 0) then Result := foBusy; if (CurrValueI = ValueI) and (ValueI > 0) then Result := foEmpty; if (CurrValueI < ValueI) and (CurrValueI > 0) then Result := foPartEmpty; end else if HaveFunctionalInterf then begin if AComponent.FirstIDCompon <> 0 then begin ComponSide1 := GSCSBase.CurrProject.GetComponentFromReferences(AComponent.FirstIDCompon); if Assigned(ComponSide1) then FillSide1 := HowFillComponent(ComponSide1); end; if AComponent.LastIDCompon <> 0 then begin ComponSide2 := GSCSBase.CurrProject.GetComponentFromReferences(AComponent.LastIDCompon); if Assigned(ComponSide2) then FillSide2 := HowFillComponent(ComponSide2); end; if (FillSide1 = foBusy) and (FillSide2 = foBusy) then Result := foBusy; if (FillSide1 = foEmpty) and (FillSide2 = foEmpty) then Result := foEmpty; if (FillSide1 = foEmpty) and (FillSide2 = foNone) then Result := foEmpty; if (FillSide2 = foEmpty) and (FillSide1 = foNone) then Result := foEmpty; if ((FillSide1 = foBusy) or (FillSide1 = foPartEmpty)) and (FillSide2 <> foBusy) then Result := foPartEmpty; if ((FillSide2 = foBusy) or (FillSide2 = foPartEmpty)) and (FillSide1 <> foBusy) then Result := foPartEmpty; end; end; function AddComponToTree(AParentNode: TFlyNode; AComponent: TSCSComponent; AImageIndex: Integer; TrView : TFlyTreeViewPro; AnglesCount : integer): TFlyNode; var NodeText: String; i: integer; //ptrObjectData: PObjectData; begin Result := nil; i := AnglesCount; if F_InterFaceInfo.TreeView.Visible then begin if AParentNode = nil then Result := TrView.Items.Add(nil, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); if AParentNode <> nil then Result := TrView.Items.AddChild(AParentNode, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); end else begin if TrView = F_InterFaceInfo.TreeView2 then begin if AParentNode = nil then Result := TrView.Items.Add(nil, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); if AParentNode <> nil then Result := TrView.Items.AddChild(AParentNode, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); end else begin if AParentNode = nil then Result := TrView.Items.Add(nil, AComponent.GetNameForVisible(false) + ' ' + inttostr(i) {AComponent.Name + cptConnect}); if AParentNode <> nil then Result := TrView.Items.AddChild(AParentNode, AComponent.GetNameForVisible(false) +' '+ inttostr(i) {AComponent.Name + cptConnect}); end; end; if Result <> nil then begin {NewData(ptrObjectData, ttComponents); ptrObjectData.ObjectID := AComponent.ID; case AComponent.IsLine of biTrue : ptrObjectData.ItemType := itComponLine; biFalse: ptrObjectData.ItemType := itComponCon; end; ptrObjectData.NBMode := nbmNone; ptrObjectData.QueryMode := FQueryModeByGDBMode; ptrObjectData.Expanded := false; ptrObjectData.SortID := AComponent.SortID; Result.Data := ptrObjectData;} Result.Data := AComponent; Result.ImageIndex := AImageIndex; Result.SelectedIndex := Result.ImageIndex; end; end; procedure AddComponenetToTreeView(AParentNode: TFlyNode; AComponent: TSCSComponent;TreeView : TFlyTreeViewPro); var cptConnect: String; NodeText: String; NewNode: TFlyNode; //ptrObjectData: PObjectData; ChildCompon: TSCSComponent; PartComponent: TSCSComponent; PartIDCompon: Integer; i: Integer; // HaveConnection: Boolean; FillCompon: TFillConnectConObj; //FillSimpleCompon: TFillConnectConObj; begin FillCompon := foNone; NewNode := nil; //case AComponent.IsLine of // biTrue: // FillCompon := HowFillLineComponent(AComponent); // biFalse: // FillCompon := HowFillComponent(AComponent); //end; FillCompon := AComponent.GetFilling(biFalse, itFunctional, true, AComponent.IsLine=biFalse); if ((FillCompon = foBusy) and ((AModeConnDisconnCompons = cdConnConCompons) or (AModeConnDisconnCompons = cdConnlineCompons)) ) or ((FillCompon = foEmpty) and ((AModeConnDisconnCompons = cdDisConnConCompons) or (AModeConnDisconnCompons = cdDisConnlineCompons)) ) or (FillCompon = foPartEmpty) then begin cptConnect := ''; if AModeConnDisconnCompons = cdConnConCompons then if FillCompon = foBusy then cptConnect := cMain_Msg20_1; if AModeConnDisconnCompons = cdDisConnConCompons then if FillCompon = foEmpty then cptConnect := cMain_Msg20_2; if FillCompon = foPartEmpty then cptConnect := cMain_Msg20_3; //NewData(ptrObjectData, ttComponents); //ptrObjectData.ObjectID := AComponent.ID; //case AComponent.IsLine of // biTrue : ptrObjectData.ItemType := itComponLine; // biFalse: ptrObjectData.ItemType := itComponCon; //end; //ptrObjectData.NBMode := nbmNone; //ptrObjectData.QueryMode := FQueryModeByGDBMode; //ptrObjectData.Expanded := false; //ptrObjectData.SortID := AComponent.SortID; // ////NodeText := GetComponNameForVisible(AComponent.Name, AComponent.NameMark) + ' - ' + cptConnect; //if AParentNode = nil then // NewNode := F_InterfaceInfo.TreeView.Items.Add(nil, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); //if AParentNode <> nil then // NewNode := F_InterfaceInfo.TreeView.Items.AddChild(AParentNode, AComponent.GetNameForVisible(false) {AComponent.Name + cptConnect}); NewNode := AddComponToTree(AParentNode, AComponent, GetComponImageIndexByFilling(AComponent.IsLine, FillCompon), TreeView,0); if NewNode <> nil then begin {case AComponent.IsLine of biTrue : begin case FillCompon of foBusy : NewNode.ImageIndex := tciiComponLineFill; foEmpty : NewNode.ImageIndex := tciiComponLineNoFill; foPartEmpty: NewNode.ImageIndex := tciiComponLinePartFill; end; NewNode.Text := NewNode.Text + GetNameConnectFromAndTo(AComponent); end; biFalse: case FillCompon of foBusy : NewNode.ImageIndex := tciiComponLineFill; foEmpty : NewNode.ImageIndex := tciiComponLineNoFill; foPartEmpty: NewNode.ImageIndex := tciiComponLinePartFill; end; end; NewNode.ImageIndex := GetComponImageIndexByFilling(AComponent.IsLine, FillCompon); NewNode.SelectedIndex := NewNode.ImageIndex; NewNode.Data := ptrObjectData;} //*** Загрузить комплектующие if AComponent.IsLine = biFalse then begin //AComponent.LoadChildComplects(false, false); for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildCompon := AComponent.ChildComplects.Items[i]; AddComponenetToTreeView(NewNode, ChildCompon, TreeView); end; end; if (AComponent.IsLine = biTrue) and (AParentNode = nil) then if AComponent.WholeComponent.Count > 1 then //*** Если есть многокр-ные интерфейсы то подгрузить участки компоненты //if AComponent.HaveMultipleInterface then for i := 0 to AComponent.WholeComponent.Count - 1 do begin PartIDCompon := AComponent.WholeComponent.Items[i]; PartComponent := nil; PartComponent := GSCSBase.CurrProject.GetComponentFromReferences(PartIDCompon); if Assigned(PartComponent) then begin //PartComponent := TSCSComponent.Create(TForm(Self)); //PartComponent.LoadComponentByID(PartIDCompon, false); PartComponent.FirstIDCompon := PartComponent.ID; PartComponent.LastIDCompon := PartComponent.ID; AddComponenetToTreeView(NewNode, PartComponent, TreeView); end; end; end; end; end; procedure AddConnObjectToTreeView(AConnObject: TSCSCatalog; TreeView : TFlyTreeViewPro); var FillConnectConObj: TFillConnectConObj; NewNode: TFlyNode; //ptrObjectData: PObjectData; SCSCompon: TSCSComponent; i: Integer; begin FillConnectConObj := HowFillConnectConObj(AConnObject, false); //HowFillConnectConObj(AConnObject.SCSID); if ((FillConnectConObj = foBusy) and (AModeConnDisconnCompons = cdConnConCompons)) or ((FillConnectConObj = foEmpty) and (AModeConnDisconnCompons = cdDisConnConCompons)) or (FillConnectConObj = foPartEmpty) then begin //*** Добавить объект в дерево {NewData(ptrObjectData, ttComponents); ptrObjectData.ObjectID := AConnObject.ID; ptrObjectData.ItemType := itSCSConnector; ptrObjectData.QueryMode := FQueryModeByGDBMode; ptrObjectData.NBMode := nbmNone; ptrObjectData.Expanded := false; ptrObjectData.SortID := AConnObject.SortID;} NewNode := TreeView.Items.Add(nil, AConnObject.Name); //NewNode.Data := ptrObjectData; NewNode.Data := AConnObject; {NewNode.Text := GetNameAndIndex(AConnObject.Name, AConnObject.ItemType, AConnObject.IndexPointObj, AConnObject.IndexConnector, AConnObject.IndexLine);} NewNode.Text := AConnObject.GetNameForVisible; //GetObjNameForVisible(AConnObject, ppPM); case FillConnectConObj of foBusy : NewNode.ImageIndex := tciiSCSConFill; foEmpty: NewNode.ImageIndex := tciiSCSConNoFill; foPartEmpty: NewNode.ImageIndex := tciiSCSConPartFill; end; NewNode.SelectedIndex := NewNode.ImageIndex; //AConnObject.LoadComponents(AConnObject.ID, false); for i := 0 to AConnObject.SCSComponents.Count - 1 do begin SCSCompon := AConnObject.SCSComponents.Items[i]; AddComponenetToTreeView(NewNode, SCSCompon, TreeView); end; end; end; begin try Screen.Cursor := crHourGlass; ProcessMessagesEx; //Self.Repaint; if (GDBMode <> bkProjectManager) or Not Assigned(ACatalog) then Exit; //// EXIT ///// CreateFInterfaceInfo; with F_InputBox do begin ListView_Compons.OnChange := nil; ListView_Compons.Items.BeginUpdate; end; ListWithLookedCompons := TIntList.Create; //Component := TSCSComponent.Create(TForm(Self)); try case AModeConnDisconnCompons of //*** точечные компоненты cdConnConCompons, cdDisConnConCompons: begin F_InterFaceInfo.RzPageControl1.Hide; F_InterFaceInfo.TreeView.Show; for i := 0 to ACatalog.ChildCatalogReferences.Count - 1 do begin SCSObject := ACatalog.ChildCatalogReferences.Items[i]; if SCSObject.ItemType = itSCSConnector then AddConnObjectToTreeView(SCSObject, F_InterFaceInfo.TreeView); end; case AModeConnDisconnCompons of cdConnConCompons: begin F_InterFaceInfo.RzPageControl1.Hide; F_InterFaceInfo.TreeView.Show; F_InterfaceInfo.GFormMode := iimConnectedConObjects; end; cdDisConnConCompons: begin F_InterFaceInfo.RzPageControl1.Hide; F_InterFaceInfo.TreeView.Show; F_InterfaceInfo.GFormMode := iimDisconnectedConObjects; end; end; F_InterfaceInfo.Execute(F_InterfaceInfo.GFormMode, ACatalog); //F_InterfaceInfo.ShowModal; end; cdConnlineCompons, cdDisConnlineCompons: begin F_InterFaceInfo.RzPageControl1.Hide; F_InterFaceInfo.TreeView.Show; for i := 0 to ACatalog.ComponentReferences.Count - 1 do if Assigned(ACatalog.ComponentReferences[i]) then begin Component := ACatalog.ComponentReferences[i]; if Component.IsLine = bitrue then if ListWithLookedCompons.IndexOf(Component.ID) = -1 then //if CheckNoIDinList(Component.ID, ListWithLookedCompons) then begin Component.LoadWholeComponent(false); AddComponenetToTreeView(nil, Component, F_InterFaceInfo.TreeView); //*** Если есть многокр-е интерфейсы то подгрузить // участки компоненты { if Component.HaveFucntionalInterface then for j := 0 to Component.WholeComponent.Count - 1 do begin PartIDCompon := Integer(Component.WholeComponent.Items[j]^); if PartIDCompon <> Component.ID then begin PartComponent := TSCSComponent.Create(TForm(Self)); PartComponent.LoadComponentByID(PartIDCompon); AddComponenetToTreeView(nil, Component); PartComponent.Destroy; end; end; } for j := 0 to Component.WholeComponent.Count - 1 do ListWithLookedCompons.Add(Component.WholeComponent.Items[j]); end; end; case AModeConnDisconnCompons of cdConnlineCompons: F_InterfaceInfo.GFormMode := iimConnectedLineCompons; cdDisConnlineCompons: F_InterfaceInfo.GFormMode := iimDisconnectedLineCompons; end; F_InterfaceInfo.Execute(F_InterfaceInfo.GFormMode, ACatalog); //F_InterfaceInfo.ShowModal; end; // Кабели не в каб. каналах cdCablesNoInCanals: begin F_InterFaceInfo.TreeView.Hide; F_InterFaceInfo.RzPageControl1.Show; if F_InterFaceInfo.TreeView2.Items.Count > 0 then F_InterFaceInfo.TreeView2.Items.Clear; if F_InterFaceInfo.TreeView1.Items.Count > 0 then F_InterFaceInfo.TreeView1.Items.Clear; CurrCables := TSCSComponents.Create(false); try BeginProgress; try // Таки правильно этот кусок работает // отображаться должны кабели только те которые лежат на трассах с каб.каналок но не входят в него for i := 0 to ACatalog.ChildCatalogReferences.Count - 1 do begin CurrCatalog := ACatalog.ChildCatalogReferences[i]; WasMeetCanal := false; CurrCables.Clear; for j := 0 to CurrCatalog.SCSComponents.Count - 1 do begin CurrCompon := CurrCatalog.SCSComponents[j]; if CurrCompon.ComponentType.SysName = ctsnCableChannel then WasMeetCanal := true else if CheckSysNameIsCable(CurrCompon.ComponentType.SysName) then CurrCables.Add(CurrCompon); end; if WasMeetCanal then //begin {TODO возможно и нужен тут begin однако } //CablesNoInCanals.Assign(CurrCables, laOr); for j := 0 to CurrCables.Count - 1 do begin Node := AddComponToTree(nil, CurrCables[j], -1,F_InterFaceInfo.TreeView2,0); Node.ImageIndex := GetImageIndexByObjectData(Node.Data, CurrCables[j].GetItemType, ekNone, CurrCables[j].GetFirstParentCatalog); Node.SelectedIndex := Node.ImageIndex; end; end; // Cable swerves s := TStringList.Create; CableIds := TIntList.Create; LookedComponents := TIntList.Create; for i := 0 to ACatalog.ComponentReferences.count - 1 do begin SCSComponent := ACatalog.ComponentReferences[i]; // если нашли кабель if CheckSysNameIsCable(SCSComponent.ComponentType.SysName) then begin SCSComponent.LoadWholeComponent(true); TakeThisCable := true; if LookedComponents.Count > 1 then begin for j := 0 to LookedComponents.Count-1 do begin if LookedComponents[j] = SCSComponent.WholeComponent[0] then begin TakeThisCable := false; break; end; end; end; // если кабель еще не попадался, считаем углы if TakeThisCable then begin // если кусков кабеля больше одного, будем искать повороты if (SCSComponent.WholeComponent.Count > 1) then begin // добавляем айдишники кусков кабеля по всей длине в список отобранных, // чтобы при обнаруженнии следующего куска кабеля снова не обрабатывать // тот же цельный кабель for j := 0 to SCSComponent.WholeComponent.Count - 1 do LookedComponents.Add(SCSComponent.WholeComponent[j]); SCSComponents := TSCSComponents.Create(false); AnglesCount := 0; for j := 0 to SCSComponent.WholeComponent.count - 2 do begin // currSCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(SCSComponList[j]); currSCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.wholecomponent[j]); FirstCatalog := currSCSComponent.GetFirstParentCatalog; currSCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.wholecomponent[j + 1]); NextCatalog := currSCSComponent.GetFirstParentCatalog; currList := FirstCatalog.GetListOwner; nextList := NextCatalog.GetListOwner; // получаем линии, между которыми нужно вычислить угол поворота ListCad := GetListByID(FirstCatalog.GetListOwner.SCSID); CurrTrace := TOrthoLine(GetFigureByID(ListCad,FirstCatalog.SCSID)); ListCad := GetListByID(NextCatalog.GetListOwner.SCSID); NextTrace := TOrthoLine(GetFigureByID(ListCad,NextCatalog.SCSID)); // CurrTrace.Selected := true; // ищем стык (коннектор) connector1 := TConnectorObject(Tortholine(CurrTrace).JoinConnector1); connector2 := TConnectorObject(Tortholine(CurrTrace).JoinConnector2); connector3 := TConnectorObject(Tortholine(NextTrace).JoinConnector1); connector4 := TConnectorObject(Tortholine(NextTrace).JoinConnector2); CurrAngle := -1; if (connector1 <> nil) and ((connector1 = connector3) or (connector1 = connector4)) then begin CurrAngle := GetAngleXYZ(FirstCatalog,NextCatalog,Connector1); end else if (connector2 <> nil) and ((connector2 = connector3) or (connector2 = connector4)) then begin CurrAngle := GetAngleXYZ(FirstCatalog,NextCatalog,Connector2); end; if (CurrAngle > 0) and (CurrAngle <= F_ProjMan.GSCSBase.CurrProject.DefListSettings.CableSwervesAngle + 0.1) then //.CurrList.Setting.CableSwervesAngle + 0.1) then AnglesCount := AnglesCount + 1; end; if AnglesCount > F_ProjMan.GSCSBase.CurrProject.DefListSettings.CableSwervesMaxCount then //CurrList.Setting.CableSwervesMaxCount then // если на кабеле есть недопустимые углы(в недопустимом количестве), добавляем его в список begin if not F_InterFaceInfo.TreeView1.Visible then begin F_InterFaceInfo.TreeView1.Visible := true; F_InterFaceInfo.TreeView2.Visible := true; F_InterFaceInfo.TreeView.Visible := false; end; Node := AddComponToTree(nil, SCScomponent, -1,F_InterFaceInfo.TreeView1, AnglesCount); Node.ImageIndex := GetImageIndexByObjectData(Node.Data, SCSComponent.GetItemType, ekNone, SCSComponent.GetFirstParentCatalog); Node.SelectedIndex := Node.ImageIndex; end; end; end; // if Cable end; // перебор компонент end; finally freeandNil(LookedComponents); EndProgress; end; { try BeginProgress; try for i := 0 to ACatalog.ChildCatalogReferences.Count - 1 do begin CurrCatalog := ACatalog.ChildCatalogReferences[i]; WasMeetCanal := false; CurrCables.Clear; for j := 0 to CurrCatalog.SCSComponents.Count - 1 do begin CurrCompon := CurrCatalog.SCSComponents[j]; // if CurrCompon.ComponentType.SysName = ctsnCableChannel then // WasMeetCanal := true // else if CheckSysNameIsCable(CurrCompon.ComponentType.SysName) then begin if CurrCompon.GetTopComponent.ComponentType.SysName <> ctsnCableChannel then begin CurrCables.Add(CurrCompon); end end; end; // if not WasMeetCanal then //CablesNoInCanals.Assign(CurrCables, laOr); for j := 0 to CurrCables.Count - 1 do begin Node := AddComponToTree(nil, CurrCables[j], -1); Node.ImageIndex := GetImageIndexByObjectData(Node.Data, CurrCables[j].GetItemType, ekNone, CurrCables[j].GetFirstParentCatalog); Node.SelectedIndex := Node.ImageIndex; radtodeg end; end; finally EndProgress; end; } OldCap := F_InterfaceInfo.Caption; F_InterfaceInfo.Caption := Act_CablesNoHitToCanals.Caption; // F_InterFaceInfo.TreeView.Hide; // F_InterFaceInfo.RzPageControl1.Visible := true; F_InterfaceInfo.Execute(iimCablesNoInCanals, ACatalog); F_InterfaceInfo.Caption := OldCap; finally CurrCables.Free; end; end; end; finally Screen.Cursor := crDefault; FreeAndNil(ListWithLookedCompons); with F_InputBox do begin ListView_Compons.OnChange := ListView_ComponsChange; ListView_Compons.Items.EndUpdate; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.ShowConnDisconnCompons: '+E.Message); end; end; // ##### Проверяет существование компоненты по умолчанию с AID_Component ##### function TF_MAIN.CheckDefaultCompon(AID_Component: Integer; AComponType: TComponType): Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from component '+ ' where (id = '''+IntToStr(AID_Component)+''') and (isline = '''+IntToStr(AComponType)+''') '); if DM.scsQSelect.GetFNAsInteger('Cnt') > 0 then Result := AID_Component; end; function TF_MAIN.CheckList(AListID: Integer): Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from katalog '+ ' where (scs_id = '''+IntToStr(AListID)+''') and ( id_item_type = '''+IntToStr(itList)+''' ) '); if DM.scsQSelect.GetFNAsInteger('Cnt') > 0 then Result := AListID; end; procedure TF_MAIN.DelCompon(AComponent: TSCSComponent; ANode: TTreeNode; ADisconnect, ACanOnAfterDel, ARemoveInterfFromCAD, ADeletedAsComplect: Boolean); var Catalog: TSCSCatalog; //*** папка в которой находится компонент SCSComponent: TSCSComponent; ConnectedCompon: TSCSComponent; Connection: PComplect; ObjectOwner: TSCSCatalog; ObjectOwnerSCSID: Integer; CADArchObj: TObject; IDInterfaces: TList; //*** Интерфейсы нелиненого компонента InterfLists: TInterfLists; //*** Интерфейсы линеного компонента i, j: integer; ComponNode: TTreeNode; Node: TTreeNode; ParentComponNode: TTreeNode; JoinedComponents: TSCSComponents; DesignList: TSCSList; CanDelCableCanalElemant: Boolean; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // DeletedAsComplect: Boolean; IDComponent: Integer; ListID: Integer; GUIDComponType: String; CompTypeSysName: String; SavedDelCADObjectEvent: TDelCADObjectEvent; Figure: TFigure; // Tolik 09/01/2019 -- CadForm: TF_Cad; // Tolik 09/01/2019 -- SCSList: TSCSList; // Tolik 09/01/2019 -- procedure Step(AIDComp: Integer; AComp: TSCSComponent); var ComplList: TIntList; ComplID: Integer; i: Integer; DelCompon: TSCSComponent; ChildCompon: TSCSComponent; begin ComplList := nil; //*** Если к кабельному каналу, или точ. компоненту подключены заглушки, то // Найти их if GDBMode = bkProjectManager then begin if AComp.ComponentType.IsLine = biTrue then begin if AComp.ComponentType.SysName = ctsnCableChannel then begin if JoinedComponents = nil then JoinedComponents := TSCSComponents.Create(false); //JoinedComponents.Assign(AComp.JoinedComponents, laOr); for i := 0 to AComp.JoinedComponents.Count - 1 do begin ConnectedCompon := TSCSComponent(AComp.JoinedComponents.List.List^[i]); if Not ConnectedCompon.ServToDelete then if JoinedComponents.IndexOf(ConnectedCompon) = -1 then JoinedComponents.Add(ConnectedCompon); end; // связанные ЭКК в трассе вместе с Каб каналом for i := 0 to ObjectOwner.ComponentReferences.Count - 1 do begin ConnectedCompon := ObjectOwner.ComponentReferences[i]; if Not ConnectedCompon.ServToDelete then if ConnectedCompon.IsLine = biFalse then if ConnectedCompon.IDRelatedCompon = AComp.ID then if ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement then if JoinedComponents.IndexOf(ConnectedCompon) = -1 then begin JoinedComponents.Add(ConnectedCompon); end; end; end; end else begin for i := 0 to AComp.JoinedComponents.Count - 1 do begin ConnectedCompon := TSCSComponent(AComp.JoinedComponents.List.List^[i]); if Not ConnectedCompon.ServToDelete then if ConnectedCompon.IsLine = biFalse then if ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement then begin if JoinedComponents = nil then JoinedComponents := TSCSComponents.Create(false); JoinedComponents.Add(ConnectedCompon); end; end; end; end; if GDBMode = bkProjectManager then begin //ComplList := DM.GetComponentChildsID(AIDComp); //if ComplList <> nil then // for i := 0 to ComplList.Count - 1 do // begin // ComplID := ComplList.Items[i]; // Step(ComplId); // end; F_ChoiceConnectSide.OnBeforeDeleteComponent(AComp); for i := 0 to AComp.ChildComplects.Count - 1 do begin ChildCompon := TSCSComponent(AComp.ChildComplects.List.List^[i]); Step(ChildCompon.ID, ChildCompon); end; end; //*** Удалить связь с папкой //SetSQLToQuery(DM.scsQOperat, ' DELETE FROM CATALOG_RELATION ' + // ' WHERE ID_COMPONENT = '''+ IntToStr(AIDComp) +''' '); {//*** Удалить связанные ресурсы SetSQLToQuery(DM.scsQOperat, ' delete from resources '+ ' where id in (select id_resource from norm_resource_rel '+ ' where id_norm in (select id from norms where id_component = '''+IntToStr(AIDComp)+''') ) ');} ////*** Удалить связанные ресурсы //SetSQLToQuery(DM.scsQOperat, ' delete from resources '+ // ' where id in (select id_resource from norm_resource_rel, norms '+ // ' where (id_master = '''+IntToStr(AIDComp)+''') and (TableKind = ''0'') and (id_norm = norms.id) ) '); //DM.DelCatRelByIDCompon(AIDComp); //DM.DelNormsByMasterID(AIDComp, ctkComponent); //DM.DelResourcesByMasterID(AIDComp, ctkComponent); if GDBMode = bkProjectManager then begin DelCompon := AComp; if DelCompon = nil then DelCompon := GSCSBase.CurrProject.GetComponentFromReferences(AIDComp); if Assigned(DelCompon) then DelCompon.ServToDelete := true; if ADisconnect then DisconnectCompon(AIDComp, DelCompon) else if Assigned(DelCompon) then for i := 0 to DelCompon.JoinedComponents.Count - 1 do if Assigned(DelCompon.JoinedComponents[i]) then DelCompon.JoinedComponents[i].JoinedComponents.Remove(DelCompon); end; //*** Удалить компоненту if GDBMode = bkNormBase then DM.DelSimpleComponent(AIDComp); if ComplList <> nil then ComplList.Free; //FreeList(ComplList); end; begin DeletedAsComplect := ADeletedAsComplect; JoinedComponents := nil; // Tolik 04/06/2018 -- try try OldTick := GetTickCount; ObjectOwner := nil; ObjectOwner := AComponent.GetFirstParentCatalog; CADArchObj := nil; if GDBMode = bkProjectManager then begin if ObjectOwner = nil then ObjectOwner := GSCSBase.CurrProject.GetCatalogFromReferences(AComponent.ObjectID); if IsArchComponByIsLine(AComponent.IsLine) then CADArchObj := GetCADObjByArchObj(AComponent); end; Catalog := nil; //JoinedComponents := nil; // Tolik 04/06/2018 -- DesignList := nil; ComponNode := nil; ParentComponNode := nil; IDComponent := AComponent.ID; ListID := AComponent.ListID; GUIDComponType := AComponent.GUIDComponentType; CompTypeSysName := AComponent.ComponentType.SysName; if (GDBMode = bkProjectManager) and (ARemoveInterfFromCAD = true) then Catalog := AComponent.GetFirstParentCatalog; if (GDBMode = bkProjectManager) and (ARemoveInterfFromCAD = true) then begin //Эти проверки еще ранее делать нужно в - // procedure TDM.DelCatalog(ACallFrom: TCallFrom; AIDCatalog, AIDItemType: Integer; AQueryMode: TQueryMode; aCatalogObj: TSCSCatalog=nil; aIsManual: Boolean=false); (* if (CompTypeSysName = ctsnHouse) or (CompTypeSysName = ctsnApproach) then begin //ListID := GCadForm.FCADListID; //AComponent.ListID := ListID; //if Catalog <> nil then // Catalog.ListID := ListID; //if ObjectOwner <> nil then //begin // ObjectOwner.SCSID := ObjectOwner.SCSID; //end; // исправление не помогает - все одно с ПМ-ки не с того листа удаляет - нужно рихтовки после открытия проекта делать if ListID <> GCadForm.FCADListID then begin {$IF Defined(SCS_PE)} //ShowMessage('Unable to remove it'); {$ELSE} ShowMessage('Невозможно удалить данный объект'); {$IFEND} exit; end; end; if ListID <> GCadForm.FCADListID then begin {$IF Defined(BASEADM_SCS)} ShowMessage('Невозможно удалить данный компонент'); {$IFEND} exit; end; *) end; ComponNode := ANode; if Not Assigned(ComponNode) then begin if Assigned(AComponent.TreeViewNode) then ComponNode := AComponent.TreeViewNode else begin ComponNode := FindTreeNodeByDat(AComponent.ID, [AComponent.GetItemType]); if ComponNode = nil then ComponNode := FindComponOrDirInTree(AComponent.ID, true); end; end; if Assigned(ComponNode) then ParentComponNode := ComponNode.Parent; //*** Если к кабельному каналу подключены заглушки, то // Найти их {if GDBMode = bkProjectManager then begin if AComponent.ComponentType.IsLine = biTrue then begin if AComponent.ComponentType.SysName = ctsnCableChannel then begin JoinedComponents := TSCSComponents.Create(false); JoinedComponents.Assign(AComponent.JoinedComponents); // связанные ЭКК в трассе вместе с Каб каналом for i := 0 to ObjectOwner.ComponentReferences.Count - 1 do begin ConnectedCompon := ObjectOwner.ComponentReferences[i]; if ConnectedCompon.IsLine = biFalse then if ConnectedCompon.IDRelatedCompon = AComponent.ID then if ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement then if JoinedComponents.IndexOf(ConnectedCompon) = -1 then begin JoinedComponents.Add(ConnectedCompon); end; end; end; end else begin for i := 0 to AComponent.JoinedComponents.Count - 1 do begin ConnectedCompon := TSCSComponent(AComponent.JoinedComponents.List.List^[i]); if ConnectedCompon.IsLine = biFalse then if ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement then begin if JoinedComponents = nil then JoinedComponents := TSCSComponents.Create(false); JoinedComponents.Add(ConnectedCompon); end; end; end; end;} Step(AComponent.ID, AComponent); //*** Откомплектоваться, если есть парент if AComponent.Parent <> nil then begin if AComponent.Parent is TSCSComponent then begin AComponent.DisConnectFromParent; DeletedAsComplect := true; end; end; if ObjectOwner <> nil then if ObjectOwner.ClassName = 'TSCSCatalog' then begin if AComponent.ID = TSCSCatalog(ObjectOwner).IDLastAddedComponent then begin TSCSCatalog(ObjectOwner).IDLastAddedComponent := 0; TSCSCatalog(ObjectOwner).LastAddedComponent := nil; end; end; //*** Если к кабельному каналу подключены заглушки, то // удалять их, если к ним больше нет подкл. каналов //if AComponent.ComponentType.SysName = ctsnCableChannel then if Assigned(JoinedComponents) then begin for i := 0 to JoinedComponents.Count - 1 do begin ConnectedCompon := JoinedComponents[i]; if (ConnectedCompon.ComeFrom = cftAuto) and (ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement) then begin CanDelCableCanalElemant := true; //*** Если Эл. каб. канала ни счем не соед кроме удал-го компоненты, то его нах. for j := 0 to ConnectedCompon.JoinedComponents.Count - 1 do if ConnectedCompon.JoinedComponents[j] <> AComponent then if Not CheckJoinedComponToComponWithChilds(AComponent, ConnectedCompon.JoinedComponents[j]) then begin CanDelCableCanalElemant := false; Break; ///// BREAK ///// end; if CanDelCableCanalElemant then DelCompon(ConnectedCompon, nil, ADisconnect, true, ARemoveInterfFromCAD, false); end; end; {for i := 0 to JoinedComponents.Count - 1 do begin //ConnectedCompon := JoinedComponents[i]; ConnectedCompon := TSCSComponent(JoinedComponents.List.List^[i]); // Берем ЭКК как верхний компонент ConnectedCompon := ConnectedCompon.GetTopComponent; if (ConnectedCompon.ComeFrom = cftAuto) and (ConnectedCompon.ComponentType.SysName = ctsnCableChannelElement) then begin CanDelCableCanalElemant := true; //*** Если Эл. каб. канала ни счем не соед кроме удал-го компоненты, то его нах. if GetJoinedCountToComponWithChilds(ConnectedCompon) <= 1 then CanDelCableCanalElemant := false; if CanDelCableCanalElemant then DelCompon(ConnectedCompon, nil, ADisconnect, true, ARemoveInterfFromCAD, false); end; end;} end; //*** Если удаляется шкаф, то удалять лист с изображением этого шкафа if AComponent.ComponentType.SysName = ctsnCupBoard then if GDBMode = bkProjectManager then begin DesignList := GSCSBase.CurrProject.GetDesignListByIDFigure(ObjectOwner.SCSID); if Assigned(DesignList) then begin DeleteNode(DesignList.TreeViewNode); DM.DelCatalog(cfBase, DesignList.ID, DesignList.ItemType, qmMemory); end; end; //if ACanOnAfterDel then // F_ChoiceConnectSide.OnAfterDeleteCompon(AComponent); //*** Удалить ветвь с дерева if Assigned(ComponNode) then begin // Если не комплектующая //if ParentComponNode <> nil then // if Not(PObjectData(ParentComponNode.Data).ItemType in [itComponLine, itComponCon]) then // Если удаление вызвано не от удаления комплектующей if Not DeletedAsComplect then OnAddDeleteNode(ComponNode, AComponent, nil, false); DeleteNode(ComponNode); end; FreeAndNil(AComponent); //*** группировка объектов if GDBMode = bkProjectManager then begin if Assigned(ObjectOwner) then begin if (CompTypeSysName = ctsnHouse) then begin ObjectOwnerSCSID := ObjectOwner.SCSID; if Not ObjectOwner.ServDeleting then begin DeleteCatalog(ObjectOwner, ObjectOwner.TreeViewNode, true); if ObjectOwner = Catalog then Catalog := nil; ObjectOwner := nil; end; DeleteHouseOnCAD(ListID, ObjectOwnerSCSID); end else if (CompTypeSysName = ctsnApproach) then DeleteApproachOnCAD(ListID, ObjectOwner.SCSID, IDComponent); //if Not ObjectOwner.ServDeleting and // (GUIDComponType = guidCompTypeHouse) and // (ObjectOwner.SCSComponents.Count = 0) then //begin // //DM.DelCatalog(cfBase, ObjectOwner.ID, ObjectOwner.ItemType, qmMemory); // DeleteCatalog(ObjectOwner, ObjectOwner.TreeViewNode, true); // if ObjectOwner = Catalog then // Catalog := nil; // ObjectOwner := nil; //end //else if CompTypeSysName <> ctsnHouse then if ObjectOwner <> nil then if Not ObjectOwner.ServDeleting then //22.01.2013 then begin ObjectOwner.ServDeleteInCAD := CheckObjectDeleted(ObjectOwner.ListID, ObjectOwner.SCSID); if Not ObjectOwner.ServDeleteInCAD then if Assigned(ParentComponNode) and (ParentComponNode = ObjectOwner.TreeViewNode) then begin DefineConnectorObjectNodeName(ObjectOwner); if ObjectOwner.ItemType = itSCSLine then DefineObjectGroupForCatalog(ObjectOwner); //DefineObjectGroup(ParentComponNode, GSCSBase.SCSComponent.ID_ComponentType, GSCSBase.SCSComponent.IsLine); end; end; end; if CADArchObj <> nil then DelArchCADObj(CADArchObj); end; if ACanOnAfterDel then if ObjectOwner <> nil then F_ChoiceConnectSide.OnAfterCopyDelComponFromObject(ObjectOwner); //*** Удалить интерфейсы удаленной компоненты из CAD-а if (GDBMode = bkProjectManager) and (ARemoveInterfFromCAD = true) then if Catalog <> nil then if Not Catalog.ServDeleting then //01.04.2009 AppendRemoveComponInterfacesInCADByAllParams(Catalog, nil, nil, {IDInterfaces,} arRemove); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do AddExceptionToLog('TF_MAIN.DelCompon: '+E.Message); end; finally //Application.ProcessMessages; //if (GDBMode = bkProjectManager) and (ARemoveInterfFromCAD = true) then // SCSComponent.Free; end; // Tolik 04/06/2018 -- if JoinedComponents <> nil then JoinedComponents.Free; // end; function TF_MAIN.DelComponByNode(ANode: TTreeNode): Boolean; var //OwnerCompon: TCatalog; //ParentNode: TTreeNode; //ParentDat: PObjectData; NodeDat: PObjectData; PrevNode: TTreeNode; ComponName : String; strMessg: String; ID_Component : Integer; CanDelComponInAllTrace: Boolean; TraceCompons: TIntList; DelComponMode: TDelComponMode; i: Integer; MesgRes: Integer; DelNode: TTreeNode; WholeLineCompon: TWholeLineCompon; isCompl: Boolean; SCSCompon: TSCSComponent; SCSList: TSCSList; SCSComponents: TSCSComponents; IsSelected: Boolean; begin Result := false; TraceCompons := nil; SCSCompon := nil; strMessg := ''; try try MesgRes := ID_CANCEL; CanDelComponInAllTrace := false; DelComponMode := dmNone; TraceCompons := nil; isCompl := false; NodeDat := ANode.Data; //if (Not NodeDat.ItemType in [itComponLine, itComponCon]) or (NodeDat.ObjectID <> GSCSBase.SCSComponent.ID) then // Raise Exception.Create('No assigned component'); SCSCompon := GetComponentFromNode(ANode); if SCSCompon <> nil then begin if SCSCompon.ID > 0 then begin if GDBMode = bkNormBase then if Not DM.CheckNoComponInComplects(SCSCompon) then Exit; ///// EXIT ///// if (GDBMode = bkProjectManager) then if SCSCompon.IsLine = biTrue then begin WholeLineCompon := GetLineComponsInTraceFromBase(SCSCompon, true); if WholeLineCompon.WholeComponObj <> nil then WholeLineCompon.WholeComponObj.Free; TraceCompons := WholeLineCompon.WholeCompon; if TraceCompons <> nil then if TraceCompons.Count > 1 then //*** тек-й компонент тоже включен в этот список и поэтому >1 CanDelComponInAllTrace := true; //*** Определить комплектующая ли это if NodeDat.ComponKind = ckCompl then isCompl := true; end; //*** Вывод сообщений о удалении case CanDelComponInAllTrace of true: begin if FMultipleAction then DelComponMode := FMultipleDelComponMode; if DelComponMode = dmNone then begin PauseProgressByMode(true); try DelComponMode := F_InputBox.ChoiceDelComponMode(SCSCompon.Name); finally PauseProgressByMode(false); end; if FMultipleAction then FMultipleDelComponMode := DelComponMode; end; end; false: begin if FMultipleAction then MesgRes := ID_YES else begin strMessg := cMain_Msg54_1+' "' + SCSCompon.Name + '" ?'; if GDBMode = bkProjectManager then if (SCSCompon.ComponentType.SysName = ctsnCableChannel) and (SCSCompon.KolComplect > 0) then strMessg := strMessg + #10+#13+ cMain_Msg54_2; PauseProgressByMode(true); try MesgRes := MessageModal(strMessg, cMain_Msg54_3, MB_YESNO or MB_ICONQUESTION); finally if GIsProgress then PauseProgressByMode(false); end; end; end; end; if (MesgRes = ID_YES) or (DelComponMode <> dmNone) then begin IsSelected := ANode = Tree_Catalog.Selected; BeginProgress; try //DM.DelComponent(NodeDat.ObjectID, nil, DelComponMode); if (GDBMode = bkNormBase) then DM.DelComponent(NodeDat.ObjectID, nil, DelComponMode) else //*** Удалить с учетом undo begin //SCSCompon := GSCSBase.CurrProject.CurrList.GetComponentFromReferences(NodeDat.ObjectID); //if SCSCompon <> nil then begin SCSComponents := TSCSComponents.Create(false); SCSComponents.Add(SCSCompon); SCSList := SCSCompon.GetListOwner; if DelComponMode = dmTrace then DelComponentsFromList(SCSList, SCSComponents, true, biTrue) else DelComponentsFromList(SCSList, SCSComponents, false); FreeAndnil(SCSComponents); end; end; finally EndProgress; if IsSelected and Not FMultipleAction then Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); end; end; end; if GDBMode = bkNormBase then FreeAndNil(SCSCompon); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DelComponByNode', E.Message); end; finally if TraceCompons <> nil then TraceCompons.Free; end; end; // ##### Удаляет компоненты с листа по заданому типу ##### procedure TF_MAIN.DelComponsByTypeFromList(AIDList: Integer; AComponentTypeSysName: String); var IDComponentList: TIntList; ptrID: ^Integer; i, j, k: integer; ComponList: TSCSComponents; Component: TSCSComponent; ComponCount: Integer; WholeComponent: TSCSComponents; PartComponent: TSCSComponent; DelComponent: TSCSComponent; DeletedCount: Integer; Node: TTreeNode; ParentNode: TTreeNode; List: TSCSList; SCSListIDs: TIntList; // Tolik 28/08/2019 - - //DragPrevTickCount: Cardinal; //DragCurrTickCount: Cardinal; //OldTick, CurrTick: Cardinal; DragPrevTickCount, DragCurrTickCount, OldTick, CurrTick: DWord; // ComponentTypeName: String; ComponentType: TComponentType; ComponentTypeIndex: Integer; CanDelCable: Boolean; CanDelCablesFromOtherList: Integer; WasSetCablesToDelForOtherList: Boolean; begin if GDBMode <> bkProjectManager then Exit; //// EXIT ///// try OldTick := GetTickCount; List := nil; List := GSCSBase.CurrProject.GetListBySCSID(AIDList); DeletedCount := 0; CanDelCablesFromOtherList := biNone; if Assigned(List) then begin //ComponentType := FNormBase.DM.GetComponentType(AComponentType); ComponentType := List.Spravochnik.GetComponentTypeBySysName(AComponentTypeSysName); ComponList := TSCSComponents.Create(false); SCSListIDs := TIntList.Create; //*** Поставить компонентам признак как удаляемый for i := 0 to List.ComponentReferences.Count - 1 do begin Component := List.ComponentReferences[i]; if (Component.ComponentType.SysName = AComponentTypeSysName) or ((GCableCompTypes.IndexOf(AComponentTypeSysName) <> -1) and (GCableCompTypes.IndexOf(Component.ComponentType.SysName) <> -1)) then begin if (Component.ComponentType.IsLine = biTrue) or (Component.Parent is TSCSCatalog) then begin Component.ServToDelete := true; ComponList.Add(Component); end; end; end; WholeComponent := TSCSComponents.Create(false); IDComponentList := TIntList.Create; if ComponList.Count = 0 then begin MessageModal(cMain_Msg21_1+' "'+List.GetNameForVisible+'" '+cMain_Msg21_2+' "'+ComponentType.NamePlural+'".', ApplicationName, MB_ICONINFORMATION or MB_OK); end else if MessageModal(cMain_Msg22_1+' "'+ComponentType.NamePlural+'" '+cMain_Msg22_2+' "'+List.GetNameForVisible+'"?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ComponentTypeIndex := -1; ComponentTypeName := ''; if GCableCompTypes.IndexOf(ComponentType.SysName) <> -1 then begin ComponentTypeIndex := ctCable; ComponentTypeName := cMain_Msg23_1; end else if ComponentType.SysName = ctsnCableChannel then begin ComponentTypeIndex := ctCableCanal; ComponentTypeName := cMain_Msg23_2; end else if ComponentType.SysName = ctsnCableChannelElement then begin ComponentTypeIndex := ctCableChannelElement; ComponentTypeName := cMain_Msg23_4; end; BeginProgress; try if Not List.OpenedInCAD then OpenNoExistsListInCAD(List); case ComponentTypeIndex of ctCable: begin SCSListIDs.Add(List.CurrID); //*** В список удаляемых добавить кабели из других листов i := 0; ComponCount := ComponList.Count; while i <= ComponCount - 1 do begin DelComponent := ComponList[i]; DelComponent.ServToDelete := true; WholeComponent := GSCSBase.CurrProject.GetComponentsByWholeID(DelComponent.Whole_ID); WasSetCablesToDelForOtherList := false; for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; CanDelCable := false; if PartComponent.ListID <> List.CurrID then begin if SCSListIDs.IndexOf(PartComponent.ListID) = -1 then SCSListIDs.Add(PartComponent.ListID); //**** ХЗ - Удалять лапшу на других этажах if CanDelCablesFromOtherList = biNone then begin PauseProgress(true); try case MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) of IDYES: CanDelCablesFromOtherList := biTrue; else CanDelCablesFromOtherList := biFalse; end; finally PauseProgress(false); end; end; //*** Удалять кусок на другом листе if CanDelCablesFromOtherList = biTrue then begin //*** Удалить кусок на другом листе PartComponent.ServToDelete := true; if ComponList.IndexOf(PartComponent) = -1 then ComponList.Add(PartComponent); end; end; end; FreeAndNil(WholeComponent); Inc(i); end; SaveListsToUndoStack(SCSListIDs); end; ctCableCanal: begin // UNDO SaveListToUndoStack(List.CurrID); end; else SaveListToUndoStack(List.CurrID); end; finally EndProgress; end; //BeginProgress; BeginProgress(cMain_Msg23_3+' '+ComponentTypeName, ComponList.Count); try //OpenNoExistsListInCAD(List); DeletedCount := 0; i := 0; while ComponList.Count > 0 do begin if Assigned(ComponList[0]) then //if ComponList[0].ComponentType.SysName = AComponentTypeSysName then begin DelComponent := ComponList[0]; case ComponentTypeIndex of ctCable: begin ComponList.Remove(DelComponent); DelCompon(DelComponent, nil, true, true, true, false); DeletedCount := DeletedCount + 1; StepProgress; end; ctCableCanal: begin Node := nil; ParentNode := nil; if Assigned(DelComponent) then begin if Assigned(DelComponent.TreeViewNode) then Node := DelComponent.TreeViewNode else Node := FindComponOrDirInTree(DelComponent.ID, true); if Node <> nil then MoveComponComplectsToUp(DelComponent, Node); IDComponentList.Add(DelComponent.ID); ComponList.Remove(DelComponent); DelCompon(DelComponent, nil, false, true, true, false); //i := -1; DeletedCount := DeletedCount + 1; end; StepProgress; end; else begin if ComponentType.IsLine = biFalse then begin if DelComponent.Parent is TSCSCatalog then begin IDComponentList.Add(DelComponent.ID); ComponList.Remove(DelComponent); DelCompon(DelComponent, nil, true, true, true, false); DeletedCount := DeletedCount + 1; end else begin ComponList.Remove(DelComponent); DelComponent.ServToDelete := false; end; end; StepProgress; end; end; end; Inc(i); end; { //OpenNoExistsListInCAD(List); DeletedCount := 0; i := 0; while ComponList.Count > 0 do begin if Assigned(ComponList[0]) then //if ComponList[0].ComponentType.SysName = AComponentTypeSysName then begin DelComponent := ComponList[0]; case ComponentTypeIndex of ctCable: begin WholeComponent := GSCSBase.CurrProject.GetComponentsByWholeID(DelComponent.Whole_ID); WasSetCablesToDelForOtherList := false; for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; CanDelCable := false; if PartComponent.ListID = List.CurrID then begin CanDelCable := true; StepProgress; end else begin //**** ХЗ - Удалять лапшу на других этажах if CanDelCablesFromOtherList = biNone then begin PauseProgress(true); try case MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) of IDYES: CanDelCablesFromOtherList := biTrue; else CanDelCablesFromOtherList := biFalse; end; finally PauseProgress(false); end; end; //*** Удалять кусок на другом листе if CanDelCablesFromOtherList = biTrue then begin //*** Установить кабели на другом листе как удаляемые, // дабы их не разъединять между собой if Not WasSetCablesToDelForOtherList then begin for k := j to WholeComponent.Count - 1 do WholeComponent[k].ServToDelete := true; WasSetCablesToDelForOtherList := true; end; //*** Удалить кусок на другом листе CanDelCable := true; end; end; if CanDelCable then begin ComponList.Remove(PartComponent); DelCompon(PartComponent, nil, true, true, true, false); DeletedCount := DeletedCount + 1; end; end; //DelCompon(DelComponent, nil, true, true, true, false); //DeletedCount := DeletedCount + 1; end; ctCableCanal: begin Node := nil; ParentNode := nil; if Assigned(DelComponent) then begin if Assigned(DelComponent.TreeViewNode) then Node := DelComponent.TreeViewNode else Node := FindComponOrDirInTree(DelComponent.ID, true); if Node <> nil then MoveComponComplectsToUp(Node); IDComponentList.Add(DelComponent.ID); ComponList.Remove(DelComponent); DelCompon(DelComponent, nil, false, true, true, false); //i := -1; DeletedCount := DeletedCount + 1; end; StepProgress; end; end; end; Inc(i); end;} finally EndProgress; FreeAndNil(ComponList); WholeComponent.Free; IDComponentList.Free; end; end; FreeAndNil(SCSListIDs); //Node := FindComponOrDirInTree(List.ID, false); //DeleteComponNodes(Node); CurrTick := GetTickCount - oldTick; CurrTick := GetTickCount - oldTick; if DeletedCount > 0 then ShowMessageByType(0, smtProtocol, cMain_Msg25_1+' '+IntToStr(DeletedCount)+' '+cMain_Msg25_2, '', 0); end; except on E: Exception do AddExceptionToLog('TF_MAIN.DelComponsByTypeFromList: '+E.Message); end; { try try DragPrevTickCount := GetTickCount; Screen.Cursor := crHourGlass; Application.MainForm.Repaint; if GDBMode <> bkProjectManager then Exit; //// EXIT ///// IDComponentList := TList.Create; SetSQLToQuery(DM.scsQSelect, ' select id from component '+ ' where (List_ID = '''+IntToStr(AIDList)+''' ) and '+ ' (id_component_type = '''+IntToStr(AComponentType)+''') '); DM.IntFieldToList(IDComponentList, DM.scsQSelect, 'id'); DeletedCount := 0; for i := 0 to IDComponentList.Count - 1 do begin SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from component where id = '''+IntTOStr(Integer(IDComponentList[i]^))+''' '); if DM.scsQSelect.GetFNAsInteger('Cnt') > 0 then case AComponentType of ctCable: begin Component := TSCSComponent.Create(TForm(Self)); try Component.ID := Integer(IDComponentList[i]^); Component.LoadWholeComponent(false); if Component.FirstIDConnectedConnCompon > 0 then DisconnectCompon(Component.FirstIDCompon); if Component.LastIDConnectedConnCompon > 0 then DisconnectCompon(Component.LastIDCompon); ChangeSQLQuery(DM.scsQOperat, ' delete from component where id = :id '); for j := 0 to Component.WholeComponent.Count - 1 do begin DelComponenet := TSCSComponent.Create(TForm(Self)); DelComponenet.LoadComponentByID(Integer(Component.WholeComponent[j]^), false); DelCompon(DelComponenet, false, true, true); end; DeletedCount := DeletedCount + 1; finally Component.Free; end; end; ctCableCanal: begin Node := nil; ParentNode := nil; Node := FindComponOrDirInTree(Integer(IDComponentList[i]^), true); if Node <> nil then begin ParentNode := Node.Parent; MoveComponComplectsToUp(Node); end; DelComponenet := TSCSComponent.Create(TForm(Self)); DelComponenet.LoadComponentByID(Integer(IDComponentList[i]^), false); DelCompon(DelComponenet, true, true, true); if ParentNode <> nil then OnAddDeleteNode(Node, false); //SetKol(ParentNode, nil); DeletedCount := DeletedCount + 1; end; end; end; DragCurrTickCount := GetTickCount - DragPrevTickCount; DragCurrTickCount := GetTickCount - DragPrevTickCount; //*** Обновить дерево List := GSCSBase.CurrProject.GetListBySCSID(AIDList); if List <> nil then begin Node := FindComponOrDirInTree(List.ID, false); DeleteComponNodes(Node); end; ShowMessageByType(smtProtocol, 'Удалено '+IntToStr(DeletedCount)+' компонент', '', 0); except on E: Exception do AddExceptionToLog('TF_MAIN.DelComponsByTypeFromList: '+E.Message); end; finally FreeList(IDComponentList); Screen.Cursor := crDefault; end; } end; procedure TF_MAIN.DelComponentsFromList(AList: TSCSList; AComponents: TSCSComponents; AlookOtherLists: Boolean; ADelComponsFromOtherList: integer = biNone; ASaveToUnoStack: Boolean=true; ASCSListIDs: TIntList=nil); var i, j: integer; ComponCount: integer; ComponList: TSCSComponents; WholeComponent: TSCSComponents; //16.02.2012 CanDelCablesFromOtherList: integer; DelComponent: TSCSComponent; PartComponent: TSCSComponent; SCSListIDs: TIntList; CanAddToList: Boolean; //Tolik SprComponentType: TNBComponentType; // begin ComponList := TSCSComponents.Create(false); ComponList.Assign(AComponents); //16.02.2012 CanDelCablesFromOtherList := ADelComponsFromOtherList; SCSListIDs := TIntList.Create; SCSListIDs.Add(AList.CurrID); if ASCSListIDs <> nil then SCSListIDs.Assign(ASCSListIDs, laOr); if AList = GSCSBase.CurrProject.CurrList then if Not AList.OpenedInCAD then OpenNoExistsListInCAD(AList); BeginProgress; try if AlookOtherLists then begin GetSCSListsIDsByCompons(AList, ComponList, true, SCSListIDs, ADelComponsFromOtherList); {i := 0; ComponCount := ComponList.Count; while i <= ComponCount - 1 do begin DelComponent := ComponList[i]; DelComponent.ServToDelete := true; if (DelComponent.Whole_ID <> 0) and (DelComponent.IsLine = biTrue) then begin WholeComponent := GSCSBase.CurrProject.GetComponentsByWholeID(DelComponent.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; CanAddToList := false; if PartComponent.ListID = AList.CurrID then begin CanAddToList := true; end else begin if SCSListIDs.IndexOf(PartComponent.ListID) = -1 then SCSListIDs.Add(PartComponent.ListID); //**** ХЗ - Удалять лапшу на других этажах if CanDelCablesFromOtherList = biNone then begin PauseProgress(true); try case MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) of IDYES: CanDelCablesFromOtherList := biTrue; else CanDelCablesFromOtherList := biFalse; end; finally PauseProgress(false); end; end; //*** Удалять кусок на другом листе if CanDelCablesFromOtherList = biTrue then CanAddToList := true; end; if CanAddToList then begin //*** Удалить кусок на другом листе PartComponent.ServToDelete := true; if ComponList.IndexOf(PartComponent) = -1 then ComponList.Add(PartComponent); end; end; FreeAndNil(WholeComponent); end; Inc(i); end;} end; if Not FMultipleAction and ASaveToUnoStack then SaveListsToUndoStack(SCSListIDs); finally EndProgress; end; BeginProgress('', ComponList.Count); try //***Удалить компоненты из списка while ComponList.Count > 0 do begin DelComponent := ComponList[0]; DM.DelComponent(DelComponent.ID, DelComponent, dmNone, nil, ComponList, true); end; finally EndProgress; end; FreeAndNil(ComponList); SCSListIDs.free; // Tolik 21/05/2018 -- end; procedure TF_MAIN.DeleteObjectGroup(AGroupNode: TTreeNode); var Dat: PObjectData; ListNode: TTreeNode; SCSList: TSCSList; CanAddObjectToDel: Boolean; CanDelCablesFromOtherList: Integer; CanDelCablesFromOtherTraces: Integer; DelComponMode: TDelComponMode; SCSObjectsToDel: TSCSCatalogs; SCSObject: TSCSCatalog; SCSComponsToDel: TSCSComponents; SCSCompon: TSCSComponent; FirstCompon: TSCSComponent; i, j: Integer; SCSListIDs: TIntList; ObjectCountInCADGroup: Integer; CanDelCADGroup: Boolean; // Tolik --15/05/2017 -- CanDoDelete: Boolean; ProgressPausedHere: Boolean; // begin SCSListIDs := Nil; // Tolik 21/05/2018 - - if (AGroupNode <> nil) and IsGroupObjectNode(AGroupNode) then // Tolik 15/05/2017 -- сюда попадает при активном прогрессе, в результате чего // окна залочены и нет возможности нажать кнопочку на окне с вопросом // поэтому нужно сделать паузу прогресса (и сбросить ее после ответа пользователя) begin {if MessageModal(cMain_Msg127_1 +AGroupNode.Text+ cMain_Msg127_2, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then } ProgressPausedHere := False; if GIsProgress then begin PauseProgress(True); ProgressPausedHere := True; end; CanDoDelete := (MessageModal(cMain_Msg127_1 +AGroupNode.Text+ cMain_Msg127_2, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES); if ProgressPausedHere then PauseProgress(False); if CanDoDelete then // begin CanDelCablesFromOtherList := biNone; DelComponMode := dmNone; Dat := AGroupNode.Data; SCSList := nil; ListNode := GetParentNodeByItemType(AGroupNode, [itList]); if ListNode <> nil then SCSList := GSCSBase.CurrProject.GetListByID(PObjectData(ListNode.Data).ObjectID); if SCSList <> nil then begin //*** Отобрать объекты для удаления SCSObjectsToDel := TSCSCatalogs.Create(false); SCSComponsToDel := TSCSComponents.Create(false); CanDelCADGroup := true; ObjectCountInCADGroup := 0; BeginProgress; try for i := 0 to SCSList.ChildCatalogReferences.Count - 1 do begin SCSObject := SCSList.ChildCatalogReferences[i]; if SCSObject.ItemType in [itSCSLine, itSCSConnector] then begin //*** Проверить, попадает ли этот объект в данную группу CanAddObjectToDel := false; if CanDelSCSObject(SCSObject) then begin case Dat.ItemType of itSCSEmptyGroup: begin if SCSObject.ComponentReferences.Count = 0 then CanAddObjectToDel := true; end; else begin FirstCompon := SCSObject.GetFirstComponent; if FirstCompon <> nil then if FirstCompon.GUIDComponentType = Dat.GroupType then CanAddObjectToDel := true; end; end; end else begin Inc(ObjectCountInCADGroup); end; if CanAddObjectToDel then begin SCSObjectsToDel.Add(SCSObject); //*** Поставить признак на удаление SCSObject.ServDeleting := true; //SCSObject.ServCanConnect := true; for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSObject.ComponentReferences[j]; SCSCompon.ServToDelete := true; //*** Определить стоит ли удалять кабель if (SCSCompon.IsLine = biTrue) and (DelComponMode = dmNone) and CheckJoinedToSameByWholeID(SCSCompon) then begin DelComponMode := dmNone; if FMultipleAction then DelComponMode := FMultipleDelComponMode; if DelComponMode = dmNone then begin PauseProgress(true); try If MessageModal(cMain_Msg128, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then DelComponMode := dmTrace else DelComponMode := dmArea; if FMultipleAction then FMultipleDelComponMode := DelComponMode; finally PauseProgress(false); end; end; end; SCSComponsToDel.Add(SCSCompon); end; end; end; end; if DelComponMode = dmNone then DelComponMode := dmArea; if ObjectCountInCADGroup > 0 then begin PauseProgress(true); try if SCSObjectsToDel.Count > 0 then begin if FMultipleAction and (FMultipleCanDelCADGroup <> -1) then CanDelCADGroup := IntToBool(FMultipleCanDelCADGroup) else begin if MessageModal(cMain_Msg144_1, ApplicationName, MB_YESNO or MB_ICONQUESTION) <> IDYES then CanDelCADGroup := false; if FMultipleAction then FMultipleCanDelCADGroup := BoolToInt(CanDelCADGroup); end; end else begin if Not FMultipleAction then MessageModal(cMain_Msg144_2, ApplicationName, MB_OK or MB_ICONINFORMATION); CanDelCADGroup := false; end; finally PauseProgress(false); end; end; if CanDelCADGroup then begin //UNDO + Удалить все компоненты с учетом возможного удаления кабелей по всем трассам SCSListIDs := GetVariousListsIDsByObjects(SCSObjectsToDel, true); if DelComponMode = dmTrace then DelComponentsFromList(SCSList, SCSComponsToDel, true, biTrue, true, SCSListIDs) else DelComponentsFromList(SCSList, SCSComponsToDel, false, biFalse, true, SCSListIDs); ////*** Удалить все компоненты с учетом возможного удаления кабелей по всем трассам //while SCSComponsToDel.Count > 0 do //begin // SCSCompon := SCSComponsToDel[0]; // DM.DelComponent(SCSCompon.ID, SCSCompon, DelComponMode, @CanDelCablesFromOtherList, SCSComponsToDel, false); //end; //*** Удалить сами объекты while SCSObjectsToDel.Count > 0 do begin SCSObject := SCSObjectsToDel[0]; DeleteCatalog(SCSObject, nil); SCSObjectsToDel.Delete(0); end; end; finally EndProgress; FreeAndNil(SCSComponsToDel); FreeAndNil(SCSObjectsToDel); end; end; end; end; // Tolik 21/05/2018 -- if SCSListIDs <> nil then SCSListIDs.Free; end; function TF_MAIN.GetSCSListsIDsByCompons(AAtList: TSCSList; ACompons: TSCSComponents; AServToDel: Boolean=false; ARes: TIntList=nil; ADelComponsFromOtherList: integer = biNone): TIntList; var i, j, ComponCount: Integer; ComponList: TSCSComponents; DelComponent: TSCSComponent; WholeComponent: TSCSComponents; Compon, PartComponent: TSCSComponent; CanAddToList: Boolean; CanDelCablesFromOtherList: integer; begin Result := ARes; if Result = nil then Result := TintList.Create; CanDelCablesFromOtherList := ADelComponsFromOtherList; if AAtList = GSCSBase.CurrProject.CurrList then // Tolik if AAtList <> nil then // Будет NIL, если проект выбран, но закрыт(получаем GSCSBase.CurrProject.CurrList = NIL). // Попробуешь открыть - получишь АВ на NIL, хотя ... // AAtList = GSCSBase.CurrProject.CurrList будет справведливо, если оба = NIL. begin // if Not AAtList.OpenedInCAD then OpenNoExistsListInCAD(AAtList); //ComponList := TSCSComponents.Create(false); //ComponList.Assign(ACompons); ComponList := ACompons; i := 0; ComponCount := ComponList.Count; while i <= ComponCount - 1 do begin Compon := ComponList[i]; if Result.IndexOf(Compon.ListID) = -1 then Result.Add(Compon.ListID); if AServToDel then Compon.ServToDelete := true; if (Compon.Whole_ID <> 0) and (Compon.IsLine = biTrue) then begin WholeComponent := GSCSBase.CurrProject.GetComponentsByWholeID(Compon.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; CanAddToList := false; if AAtList <> nil then if PartComponent.ListID = AAtList.CurrID then begin CanAddToList := true; end; //else if Not CanAddToList then begin if Result.IndexOf(PartComponent.ListID) = -1 then Result.Add(PartComponent.ListID); //**** ХЗ - Удалять лапшу на других этажах if AServToDel then begin if CanDelCablesFromOtherList = biNone then if FMultipleAction then CanDelCablesFromOtherList := FMultipleCanDelCablesFromOtherList; if CanDelCablesFromOtherList = biNone then begin PauseProgressByMode(true); try case MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) of IDYES: CanDelCablesFromOtherList := biTrue; else CanDelCablesFromOtherList := biFalse; end; finally PauseProgressByMode(false); end; if FMultipleAction then FMultipleCanDelCablesFromOtherList := CanDelCablesFromOtherList; end; //*** Удалять кусок на другом листе if CanDelCablesFromOtherList = biTrue then CanAddToList := true; end else CanAddToList := true; end; if CanAddToList then begin //*** Удалить кусок на другом листе if AServToDel then PartComponent.ServToDelete := true; if ComponList.IndexOf(PartComponent) = -1 then ComponList.Add(PartComponent); end; end; FreeAndNil(WholeComponent); end; Inc(i); end; end; //FreeAndNil(ComponList); end; function TF_MAIN.SelectComponentFromList(AComponents: TSCSComponents; APropSysNameToShow, ACaption, AMessgLabel, AMessgCheckBox: String; AControlTypeApplyForAll: Integer; AButtons: TibButtons; AModalResult: PInteger; ACheckBoxRes: PInteger; aIDToSel: Integer=0): TSCSComponent; var ListItem, ItemToSel: TListItem; i: Integer; CurrCompon: TSCSComponent; SavedbtCancelCaption: String; CCEType: Integer; RadioItems: TStringList; SavedFProgressVisible: Boolean; //ptrID: ^Integer; begin Result := nil; if AComponents.Count > 0 then begin SavedFProgressVisible := F_Progress.Visible; try F_Progress.Visible := false; F_InputBox.ListView_Compons.Items.BeginUpdate; try ItemToSel := nil; for i := 0 to AComponents.Count - 1 do begin CurrCompon := AComponents[i]; ListItem := F_InputBox.ListView_Compons.Items.Add; //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := CurrCompon.ID; //ListItem.Data := ptrID; ListItem.Data := Pointer(CurrCompon.ID); ListItem.Caption := CurrCompon.GetNameForVisible; if APropSysNameToShow <> '' then begin if APropSysNameToShow = pnCableCanalElemetType then begin CCEType := CurrCompon.GetPropertyValueAsInteger(APropSysNameToShow); if CCEType <> contNone then ListItem.Caption := ListItem.Caption +' ('+GetCableChannelElementName(CCEType)+')'; end; end; ListItem.ImageIndex := GetSCSComponType(CurrCompon.IsLine); if aIDToSel = CurrCompon.ID then ItemToSel := ListItem; //ListItem.Selected := True; end; finally F_InputBox.ListView_Compons.Items.EndUpdate; end; F_InputBox.ListView_Compons.SortType := stText; F_InputBox.ListView_Compons.SortType := ComCtrls.stNone; try F_InputBox.GListKind := lkComponID; F_InputBox.GTreeKind := trkCatalog; F_InputBox.GInputFormMode := imListForTree; F_InputBox.GChangeInMainForm := true; F_InputBox.Caption := ACaption; if (AMessgLabel = cCadClasses_Mes35_2) or (AMessgLabel = cCadClasses_Mes35_3) then F_InputBox.Label_Messg.Font.Style := F_InputBox.Label_Messg.Font.Style + [fsBold] else F_InputBox.Label_Messg.Font.Style := F_InputBox.Label_Messg.Font.Style - [fsBold]; F_InputBox.Label_Messg.Caption := AMessgLabel; F_InputBox.FIsSelectionItem := true; F_InputBox.FButtons := AButtons; SavedbtCancelCaption := F_InputBox.Button_CancelChoice.Caption; F_InputBox.Button_CancelChoice.Caption := cInputBox_Msg21; F_InputBox.cbComponList.Visible := false; if ACheckBoxRes <> nil then begin if AControlTypeApplyForAll = ctalCheckBox then begin F_InputBox.cbComponList.Visible := true; F_InputBox.cbComponList.Caption := AMessgCheckBox; F_InputBox.cbComponList.Checked := false; end else if AControlTypeApplyForAll = ctalRadio then begin RadioItems := GetStringsFromStr(AMessgCheckBox, ';', false); F_InputBox.rgComponList.Visible := true; F_InputBox.rgComponList.Items.Clear; F_InputBox.rgComponList.Items.AddStrings(RadioItems); F_InputBox.rgComponList.ItemIndex := -1; FreeAndNil(RadioItems); end; end; if ItemToSel <> nil then ItemToSel.Selected := true; //24.06.2013 F_InputBox.ListView_Compons.Selected := ItemToSel; //ItemToSel.Selected := true; if (AMessgLabel = cCadClasses_Mes35_2) or (AMessgLabel = cCadClasses_Mes35_3) then begin F_InputBox.Panel_ComponList.Constraints.MaxWidth := 383; F_InputBox.pnComponButtons.Constraints.MaxWidth := 383; F_InputBox.ListView_Compons.Constraints.MaxWidth := 383; end else begin F_InputBox.Panel_ComponList.Constraints.MaxWidth := 0; F_InputBox.pnComponButtons.Constraints.MaxWidth := 600; F_InputBox.ListView_Compons.Constraints.MaxWidth := 0; end; if F_InputBox.ShowModal = mrOk then begin if F_InputBox.GLastSelID <> 0 then begin Result := AComponents.GetComponenByID(F_InputBox.GLastSelID); if ACheckBoxRes <> nil then begin if AControlTypeApplyForAll = ctalCheckBox then ACheckBoxRes^ := BoolToInt(F_InputBox.cbComponList.Checked) else if AControlTypeApplyForAll = ctalRadio then ACheckBoxRes^ := F_InputBox.rgComponList.ItemIndex; end; end; end; if AModalResult <> nil then AModalResult^ := F_InputBox.ModalResult; finally F_InputBox.cbComponList.Visible := false; F_InputBox.rgComponList.Visible := false; F_InputBox.FIsSelectionItem := false; F_InputBox.FButtons := []; F_InputBox.Button_CancelChoice.Caption := SavedbtCancelCaption; end; finally F_Progress.Visible := SavedFProgressVisible; end; end; end; procedure TF_MAIN.ShowComponentsInList(AComponents: TSCSComponents; ACaption, AMessg: String); var ListItem: TListItem; i: Integer; CurrCompon: TSCSComponent; //ptrID: ^Integer; begin for i := 0 to AComponents.Count - 1 do begin CurrCompon := AComponents[i]; ListItem := F_InputBox.ListView_Compons.Items.Add; //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := CurrCompon.ID; //ListItem.Data := ptrID; ListItem.Data := Pointer(CurrCompon.ID); ListItem.Caption := CurrCompon.GetNameForVisible; ListItem.ImageIndex := GetSCSComponType(CurrCompon.IsLine); end; F_InputBox.GListKind := lkComponID; F_InputBox.GTreeKind := trkCatalog; F_InputBox.GInputFormMode := imListForTree; F_InputBox.GChangeInMainForm := true; F_InputBox.Caption := ACaption; F_InputBox.Label_Messg.Caption := AMessg; F_InputBox.cbComponList.Visible := false; F_InputBox.ShowModal; end; procedure TF_MAIN.ShowComponentsInListByIDList(AIDComponents: TIntList; ACaption, AMessg: String); var i: Integer; CurrID: Integer; SCSComponents: TSCSComponents; SCSCompon: TSCSComponent; begin SCSComponents := TSCSComponents.Create(true); try for i := 0 to AIDComponents.Count - 1 do begin CurrID := AIDComponents[i]; SCSCompon := TSCSComponent.Create(Self); SCSCompon.LoadComponentByID(CurrID, false, i=0); SCSComponents.Add(SCSCompon); end; ShowComponentsInList(SCSComponents, ACaption, AMessg); finally SCSComponents.Free; end; {for i := 0 to AIDComponents.Count - 1 do begin CurrID := AIDComponents[i]; ListItem := F_InputBox.ListView_Compons.Items.Add; GetMem(ptrID, SizeOf(Integer)); ptrID^ := CurrID; ListItem.Data := ptrID; ListItem.Caption := DM.GetComponFldValueAsString(CurrID, fnName); ListItem.ImageIndex := GetSCSComponType(DM.GetComponFieldValueAsInteger(CurrID, fnIsLine)); end; F_InputBox.GListKind := lkCompon; F_InputBox.GTreeKind := trkCatalog; F_InputBox.GInputFormMode := imListForTree; F_InputBox.GChangeInMainForm := true; F_InputBox.Caption := ACaption; F_InputBox.Label_Messg.Caption := AMessg; F_InputBox.ShowModal;} end; procedure TF_MAIN.ShowCurrComponProperties; var SCSCompon: TSCSComponent; begin if GSCSBase.SCSComponent.ID = 0 then Exit; ///// EXIT ///// WaitForTVChange; if GDBMode = bkProjectManager then begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); if SCSCompon <> nil then SCSCompon.DefineInterfaceNorms(true); end; //19.05.2009 F_AddComponent.GFormMode := fmView; //19.05.2009 F_AddComponent.ShowModal; CreateFAddComponent.Execute(fmView, false); end; // ##### Устанавливает высоту интерфейсам ##### procedure TF_MAIN.SetInterfacesCoordZ(AInterfaces: TList; ACoordZ: Double); var i: Integer; IDInterf: Integer; begin try if AInterfaces = nil then Exit; ///// EXIT ///// with F_ProjMan.DM do begin scsQOperat.Close; scsQOperat.SQL.Clear; scsQOperat.SQL.Add(' update interface_relation set coordz = :coordz where id = :id '); for i := 0 to AInterfaces.Count - 1 do begin IDInterf := Integer(AInterfaces.Items[i]^); scsQOperat.SetParamAsInteger('id', IDInterf); scsQOperat.SetParamAsFloat('coordz', ACoordZ); scsQOperat.ExecQuery; scsQOperat.Close; end; end; except on E: Exception do AddExceptionToLog('SetInterfacesCoordZ: '+E.Message); end; end; // ##### Изменяет высоту интерфейсов стороны линейного объекта ##### procedure TF_MAIN.ChangeLineObjectSideCoordZ(AIDCatalog: Integer; AInterfaces: TList; ACoordZ: Double); var FigureNode: TTreeNode; begin { SetInterfacesCoordZ(AInterfaces, ACoordZ); FigureNode := FindComponOrDirInTree(IDCatalog, false); if (FigureNode <> nil) and (FigureNode.Data <> nil) then begin FigureDat := FigureNode.Data; FigureNode.ImageIndex := GetNodeImageIndex(FigureDat.ItemType, GEditKind, FigureDat.ObjectID); end; } end; // ##### Изменяет высоту интерфейсов точечного объекта ##### procedure TF_MAIN.ChangeConObjectCoordZ(ASCSCatalog: TSCSCatalog; ACoordZ: Double); //var //SCSConObject: TSCSCatalog; //SCSCompon: TSCSComponent; //Interfaces: TList; //Interfac: TSCSInterface; //i, j: Integer; //ConObjNode: TTreeNode; //ConObjDat: PObjectData; begin ASCSCatalog.SetPropertyValueAsFloat(pnCoordZ, ACoordZ, true); //try //DM.SetPropertyValue(tkCatalog, AIDCatalog, 'COORDZ', FloatToStr(ACoordZ), qmUndef, -1); { SCSConObject := GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if Not Assigned(SCSConObject) then Exit; ///// EXIT ///// for i := 0 to SCSConObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSConObject.ComponentReferences.Items[i]; SetPropertyValueAsFloat(tkComponent, SCSCompon.ID, pnHeight, ACoordZ, qmUndef, -1); SCSCompon.SetPropertyValueAsFloat(pnHeight, ACoordZ); //SCSCompon.LoadInterfaces(-1, false); for j := 0 to SCSCompon.Interfaces.Count - 1 do begin Interfac := SCSCompon.Interfaces[j]; DM.UpdateInterfFieldAsFloat(Interfac.ID, ACoordZ, fnCoordZ); Interfac.CoordZ := ACoordZ; end; end; ConObjNode := FindComponOrDirInTree(AIDCatalog, false); if (ConObjNode <> nil) and (ConObjNode.Data <> nil) then begin ConObjDat := ConObjNode.Data; SetNodeImageIndex(ConObjNode, ConObjDat.ItemType, GEditKind); //ConObjNode.ImageIndex := GetNodeImageIndex(ConObjDat.ItemType, GEditKind, ConObjDat.ObjectID); end; } //except // on E: Exception do AddExceptionToLog('ChangeConObjectHeight: '+E.Message); //end; end; // ###### Изменяет свойство длины линейного объекта ###### procedure TF_MAIN.ChangeLineObjectLength(ASCSObject: TSCSCatalog; ALength: Double); var SCSLineObject: TSCSCatalog; //ObjNorms: TSCSNormsResources; //objNorm: TSCSNorm; SCSCompon: TSCSComponent; //SCSPartCompon: TSCSComponent; //ptrSCSNorm: PSCSNorm; i: Integer; //IDProperty: Integer; OldLength: Double; //CurrLength: Double; //StrCurrLength: String; begin try GDragPrevTickCount := GetTickCount; SCSLineObject := nil; SCSLineObject := ASCSObject; //SCSLineObject := GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if Not Assigned(SCSLineObject) then Exit; //// EXIT ///// if SCSLineObject.ItemType <> itSCSLine then Exit; ///// EXIT ///// OldLength := SCSLineObject.GetPropertyValueAsFloat(pnLength); //DM.GetPropertyValueAsFloat(tkCatalog, AIDCatalog, pnLength, qmUndef, IDProperty); if Abs(ALength - OldLength) < cnstCmpLenDelta then Exit; ///// EXIT ///// SCSLineObject.SetPropertyValueAsFloat(pnLength, ALength, true); for i := 0 to SCSLineObject.ComponentReferences.Count - 1 do begin SCSCompon := SCSLineObject.ComponentReferences.Items[i]; SCSCompon.RefreshWholeLengthInFuture; //SCSCompon.ServChangedLength := biTrue; ////*** Загрузить длину цельного кабеля //SCSCompon.RefreshWholeLength; OnChangeComponProperty(SCSCompon, 'G_LENGTH'); end; //IDProperty := DM.GetIDPropertyBySysName(tkCatalog, AIDCatalog, pnLength, SCSLineObject.ItemType); //OldLength := DM.GetPropertyValueAsFloat(tkCatalog, AIDCatalog, pnLength, qmUndef, IDProperty); //if Abs(ALength - OldLength) < 0.01 then // Exit; ///// EXIT ///// // //DM.SetPropertyValue(tkCatalog, AIDCatalog, pnLength, FloatToStr(ALength), qmUndef, IDProperty); //for i := 0 to SCSLineObject.ComponentReferences.Count - 1 do //begin // SCSCompon := SCSLineObject.ComponentReferences.Items[i]; // // //*** Загрузить длину цельного кабеля // SCSCompon.RefreshWholeLength; // //SCSCompon.RefreshWholeLengthAfterChangeObjectLength(OldLength, ALength); //end; except on E: Exception do AddExceptionToLog('ChangeLineObjectLength: '+E.Message); end; end; procedure TF_MAIN.DefineLocalCurrency; var CurrLocalCurrencyM: TObjectCurrencyRel; CurrLocalCurrencyS: TObjectCurrencyRel; Currency: TCurrency; WasChanging: Boolean; IDCatalog: Integer; begin if GDBMode = bkNormBase then begin IDCatalog := -1; if GSCSBase.SCSComponent.ID > 0 then IDCatalog := DM.GetComponCatalogOwnerID(GSCSBase.SCSComponent.ID); if IDCatalog < 1 then IDCatalog := GSCSBase.SCSCatalog.ID; if IDCatalog > 0 then begin DM.GetCatalogCurrencies(IDCatalog, CurrLocalCurrencyM, CurrLocalCurrencyS); WasChanging := false; if (CurrLocalCurrencyM.ID > 0) and (CurrLocalCurrencyM.ID <> GLocalCurrencyM.ID) then begin WasChanging := true; GLocalCurrencyM := CurrLocalCurrencyM; Currency := GetCurrencyByID(GLocalCurrencyM.IDCurrency, DM.Query_Select); GLocalCurrencyM.Data.Name := Currency.Name; GLocalCurrencyM.Data.NameBrief := Currency.NameBrief; end else if (CurrLocalCurrencyM.ID = 0) and (CurrLocalCurrencyM.IDCurrency > 0) then begin WasChanging := true; GLocalCurrencyM := CurrLocalCurrencyM; end; if (CurrLocalCurrencyS.ID > 0) and (CurrLocalCurrencyS.ID <> GLocalCurrencyS.ID) then begin WasChanging := true; GLocalCurrencyS := CurrLocalCurrencyS; Currency := GetCurrencyByID(GLocalCurrencyS.IDCurrency, DM.Query_Select); GLocalCurrencyS.Data.Name := Currency.Name; GLocalCurrencyS.Data.NameBrief := Currency.NameBrief; end else if (CurrLocalCurrencyS.ID = 0) and (CurrLocalCurrencyS.IDCurrency > 0) then begin WasChanging := true; GLocalCurrencyS := CurrLocalCurrencyS; end; if WasChanging then begin SetCurrencyBriefToControls; end; ShowPrice; end; end; end; procedure TF_MAIN.LoadLocalCurrencyFromDefault; begin ZeroMemory(@GLocalCurrencyM, SizeOf(TObjectCurrencyRel)); ZeroMemory(@GLocalCurrencyS, SizeOf(TObjectCurrencyRel)); GLocalCurrencyM.Data := GCurrencyM; GLocalCurrencyS.Data := GCurrencyS; end; // ##### Отображает названия валют в заглавиях столбцах Грида с комплектующими ##### procedure TF_MAIN.SetCurrencyBriefToControls; var PriceStr: String; CostStr: String; DisplayFormatM: String; DisplayFormatS: String; begin PriceStr := cMain_Msg26+', '; CostStr := cMain_Msg27+', '; // Справочники DisplayFormatM := GetDisplayFormat(GCurrencyM.NameBrief); DisplayFormatS := GetDisplayFormat(GCurrencyS.NameBrief); if Assigned(F_CaseForm) then begin F_CaseForm.SetCurrencyBriefToControls(GCurrencyM); //TcxCurrencyEditProperties(F_CaseForm.GT_NB_ResourcesPRICE.Properties).DisplayFormat := DisplayFormatM; //TcxCurrencyEditProperties(F_CaseForm.GT_NB_ResourcesAdditionalPrice.Properties).DisplayFormat := DisplayFormatM; end; if Assigned(F_MakeCurrency) then F_MakeCurrency.neRatio.DisplayFormat := DisplayFormatM; if Assigned(F_MakeNorm) then begin F_MakeNorm.nePrice.DisplayFormat := DisplayFormatM; F_MakeNorm.nePricePerTime.DisplayFormat := DisplayFormatM; end; DM.ceRepositoryCommon.Properties.DisplayFormat := DisplayFormatM; // Компонент DisplayFormatM := GetDisplayFormat(GLocalCurrencyM.Data.NameBrief); DisplayFormatS := GetDisplayFormat(GLocalCurrencyS.Data.NameBrief); CurrencyEdit_Cost1.Properties.DisplayFormat := DisplayFormatM; CurrencyEdit_Cost2.Properties.DisplayFormat := DisplayFormatS; CurrencyEdit_Price1.Properties.DisplayFormat := DisplayFormatM; CurrencyEdit_Price2.Properties.DisplayFormat := DisplayFormatS; GT_Compon_RelationPrice1.Caption := PriceStr + GLocalCurrencyM.Data.NameBrief + '.'; GT_Compon_RelationCost1.Caption := CostStr + GLocalCurrencyM.Data.NameBrief + '.'; GT_Compon_RelationPrice2.Caption := PriceStr + GLocalCurrencyS.Data.NameBrief + '.'; GT_Compon_RelationCost2.Caption := CostStr + GLocalCurrencyS.Data.NameBrief + '.'; //31.10.2013 TcxCurrencyEditProperties(GT_NormsResourcesPricePerTime.Properties).DisplayFormat := DisplayFormatM; TcxCurrencyEditProperties(GT_NormsResourcesPricePerTime.Properties).DecimalPlaces := FloatPrecision; TcxCurrencyEditProperties(GT_NormsResourcesCost.Properties).DisplayFormat := DisplayFormatM; TcxCurrencyEditProperties(GT_NormsResourcesCost.Properties).DecimalPlaces := FloatPrecision; TcxCurrencyEditProperties(GT_NormsResourcesTotalCost.Properties).DisplayFormat := DisplayFormatM; GT_NormsResourcesPricePerTime.Caption := cRepMsg208_1 + GCurrencyM.NameBrief + cRepMsg208_2; if Assigned(F_AddComponent) then begin F_AddComponent.cePriceSupply.Properties.DisplayFormat := DisplayFormatM; F_AddComponent.GT_ComplectsPrice1.Caption := PriceStr + GLocalCurrencyM.Data.NameBrief; F_AddComponent.GT_ComplectsCost1.Caption := CostStr + GLocalCurrencyM.Data.NameBrief; F_AddComponent.GT_ComplectsPrice2.Caption := PriceStr + GLocalCurrencyS.Data.NameBrief; F_AddComponent.GT_ComplectsCost2.Caption := CostStr + GLocalCurrencyS.Data.NameBrief; F_AddComponent.CurrencyEdit_ResourcesCost.Properties.DisplayFormat := DisplayFormatM; //TcxCurrencyEditProperties(F_AddComponent.GT_NORMSCost.Properties).DisplayFormat := DisplayFormatM; TcxCurrencyEditProperties(F_AddComponent.GT_ResourcesAdditionalPrice.Properties).DisplayFormat := DisplayFormatM; F_AddComponent.EditRepository_NormCurrency_NormCost.Properties.DisplayFormat := DisplayFormatM; F_AddComponent.EditRepository_NormCurrency_NormTotalCost.Properties.DisplayFormat := DisplayFormatM; F_AddComponent.EditRepository_NormCurrency_ResourcePrice.Properties.DisplayFormat := DisplayFormatM; F_AddComponent.EditRepository_NormCurrency_ResourceCost.Properties.DisplayFormat := DisplayFormatM; TcxCurrencyEditProperties(F_AddComponent.GT_NORMSPricePerTime.Properties).DisplayFormat := DisplayFormatM; end; // Единици измерения SetUOMToControls; //*** Загрузить формат валют для норм и ресурсов //if Assigned(F_Norms) then // with F_Norms do // begin // CurrencyEdit_ResourcesCost.Properties.DisplayFormat := DisplayFormatM; // TcxCurrencyEditProperties(GT_ResourcesAdditionalPrice.Properties).DisplayFormat := DisplayFormatM; // EditRepository_NormCurrency_NormCost.Properties.DisplayFormat := DisplayFormatM; // EditRepository_NormCurrency_NormTotalCost.Properties.DisplayFormat := DisplayFormatM; // EditRepository_NormCurrency_ResourcePrice.Properties.DisplayFormat := DisplayFormatM; // EditRepository_NormCurrency_ResourceCost.Properties.DisplayFormat := DisplayFormatM; // end; end; procedure TF_MAIN.SetUOMToControls; begin FUOMMin := ConvertUOMToMin(FUOM); FUOMSupplKind := ConvertUOMToSuppliesKind(FUOM); // Сечение GT_InterfaceValueI.Caption := cNameFreeCutset +', '+ GetNameUOM(ConvertUOMToMin(FUOM), true, false)+'2'; // Расход на метр GT_NormsResourcesExpenseForLength.Caption := cNameExpenseFor +' '+ IntToStr(1)+GetNameUOM(FUOM, true); // Шаг точки GT_NormsResourcesStepOfPoint.Caption := cNameStepOfPoint +', '+ GetNameUOM(FUOM, true); DefineFTraceLength; end; // ############################ Функции формы ################################## // ############################################################################# // // ##### Создать форму ##### procedure TF_MAIN.FormCreate(Sender: TObject); var CommonIni: TCommonIni; Res: Integer; DBFile : String; ini: TIniFile; OpenBaseResult: TOpenBaseResult; //HaltMessgIconType: Integer; //OpenMessage: String; //BaseName: String; Node: TTreeNode; QMode: TQueryMode; Q1Mode: TQueryMode; QSelectMode: TQueryMode; QOperatMode: TQueryMode; QTSCSCSelect: TQueryMode; QTSCSOperat: TQueryMode; //i: Integer; TmpInt: Integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // //UpdateBaseParams: TUpdateBaseParams; procedure CopyMenuItems(ASrcItems, ATrgItems: TMenuItem); var i: Integer; SrcItem: TMenuItem; pmnuItem: TMenuItem; begin for i := 0 to ASrcItems.Count - 1 do begin SrcItem := ASrcItems[i]; pmnuItem := TMenuItem.Create(Self); pmnuItem.Caption := SrcItem.Caption; pmnuItem.Enabled := SrcItem.Enabled; pmnuItem.OnClick := SrcItem.OnClick; pmnuItem.Checked := SrcItem.Checked; pmnuItem.AutoCheck := SrcItem.AutoCheck; pmnuItem.Action := SrcItem.Action; pmnuItem.ImageIndex := SrcItem.ImageIndex; //pmnuItem.Name := SrcItem.Name; //pmnuItem.Items := MainMenu.Items[0].Items; //pmnuItem.Assign(SrcItem); ATrgItems.Add(pmnuItem); CopyMenuItems(SrcItem, pmnuItem); end; end; 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 FAllowTreeCatalogChange := true; FOnSetPropValue := OnSetPropValueForm; DisableAlign; try if FParentControl <> nil then Parent := FParentControl; FTreeNodeExpandTick := 0; SetFullRepaint(false); //26.12.2011 {GLiteVersion := true; GUseLiteFunctional := true; GUseComponTemplates := Not GLiteVersion; GUseVisibleInterfaces := Not GLiteVersion;} //SetControlsByUseLiteFunctional(GLiteVersion, GUseLiteFunctional, false); //ZeroMemory(@UpdateBaseParams, SizeOf(TUpdateBaseParams)); // UpdateBaseParams.RequiredDBTypes := [dbtCatalog, dbtComponent]; // UpdateBaseParams.DestObjectGUID := '{27CD1215-3D47-404B-B82A-AA88634052E9}'; // UpdateNormBase('C:\Projects\СКС\Точечные.scf', 'C:\Program Files\Эксперт-Телеком 1.4.9\NormBase\NB.dat', UpdateBaseParams, bbmImportData); ShowCount := 0; FLockTreeAndGreedCount := 0; if Not Assigned(GLog) then GLog := TStringList.Create; if Not Assigned(GTimerListToHandle) then GTimerListToHandle := TList.Create; //if GFormMode = fmNormal then // DeleteMenu(GetSystemMenu(Handle, False), SC_CLOSE, MF_BYCOMMAND); GDBMode := GGDBMode; FQueryModeByGDBMode := GetQueryModeByGDBMode(GDBMode); //FFilterBlock := nil; FFilterParams := TFilterParams.Create(GDBMode); FGroupFilterBlock := nil; FGroupFieldValues := nil; FTimerPostGrid := nil; FTimerPostDataSet := nil; DM := nil; if GFormMode = fmNormal then begin DM := TDM.Create(Self, TForm(Self)); DM.scsQ.QueryMode := qmPhisical; DM.scsQ1.QueryMode := qmPhisical; DM.scsQSelect.QueryMode := qmPhisical; DM.scsQOperat.QueryMode := qmPhisical; DM.scsQTSCSSelect.QueryMode := qmPhisical; DM.scsQTSCSOperat.QueryMode := qmPhisical; end else begin case GDBMode of bkNormBase: DM := F_NormBase.DM; bkProjectManager: DM := F_ProjMan.DM; end; end; Docking := False; FreeAndNil(Tree_Catalog); Tree_Catalog := TESTreeView.Create(Self); Tree_Catalog.Align := alClient; Tree_Catalog.AutoExpand := false; Tree_Catalog.Parent := Panel_Tree; //GroupBox_Folders; Tree_Catalog.DragMode := dmAutomatic; //Tree_Catalog.RightClickSelect := true; Tree_Catalog.HideSelection := false; Tree_Catalog.MultiSelect := true; //16.01.2012 Tree_Catalog.MultiSelectStyle := [msControlSelect, msShiftSelect]; Tree_Catalog.RowSelect := {true; //}false; Tree_Catalog.ShowHint := true; Tree_Catalog.Images := DM.ImageList_Dir; Tree_Catalog.StateImages := DM.iiDirStates; PopupMenu_Catalog.AutoPopup := false; Tree_Catalog.PopupMenu := PopupMenu_Catalog; Tree_Catalog.OnAddition := Tree_CatalogAddition; Tree_Catalog.OnDeletion := Tree_CatalogDeletion; Tree_Catalog.OnChange := Tree_CatalogChange; Tree_Catalog.OnChanging := Tree_CatalogChanging; Tree_Catalog.OnClick := Tree_CatalogClick; Tree_Catalog.OnCustomDrawItem := Tree_CatalogCustomDrawItem; Tree_Catalog.OnCollapsing := Tree_CatalogCollapsing; //Tree_Catalog.OnCustomDraw := Tree_CatalogCustomDraw; if GFormMode = fmNormal then Tree_Catalog.OnDblClick := Tree_CatalogDblClick; Tree_Catalog.OnDragDrop := Tree_Catalog_DragDrop; Tree_Catalog.OnDragOver := Tree_Catalog_DragOver; Tree_Catalog.OnEdited := Tree_CatalogEdited; Tree_Catalog.OnEditing := Tree_CatalogEditing; Tree_Catalog.OnEndDrag := Tree_Catalog_EndDrag; Tree_Catalog.OnEnter := Tree_CatalogEnter; Tree_Catalog.OnExit := Tree_CatalogExit; Tree_Catalog.OnExpanding := Tree_CatalogExpanding; //Tree_Catalog.OnExpanded := Tree_CatalogExpanded; Tree_Catalog.OnGetImageIndex := Tree_CatalogGetImageIndex; Tree_Catalog.OnGetSelectedIndex := Tree_CatalogGetSelectedIndex; Tree_Catalog.OnKeyDown := Tree_CatalogKeyDown; Tree_Catalog.OnKeyPress := Tree_CatalogKeyPress; Tree_Catalog.OnKeyUp := Tree_CatalogKeyUp; Tree_Catalog.OnMouseDown := Tree_CatalogMouseDown; Tree_Catalog.OnMouseMove := Tree_CatalogMouseMove; Tree_Catalog.OnMouseUp := Tree_CatalogMouseUp; Tree_Catalog.OnStartDrag := Tree_CatalogStartDrag; TESTreeView(Tree_catalog).OnEditCancelled := Tree_CatalogEditCancelled; //Tree_Catalog.Indent := 9; //SendMessage(Tree_catalog.Handle, TVM_SETINDENT, 10, 0); FLoadedComponElements := TIntList.Create; //#Panel_Tree.ManualDock(Panel_Main, nil, alTop); //#Panel_Addition.ManualDock(Panel_Main, nil, alBottom); Panel_Addition.Height := Round(Panel_Main.Height / 3); //Panel_Addition.CloseHotSpot; //Panel_Addition.RestoreHotSpot; {case GDBMode of bkNormBase: DBFile := extractfilepath(paramstr(0)) + DefNBPath; bkProjectManager: DBFile := extractfilepath(paramstr(0)) + DefPMPath; end; If FileExists(DBFile) then begin DataBase_SCS.AliasName := DBFile; DataBase_SCS.DBName := DBFile; Database_SCS.Connected := true; end; } GNDS := 20; DBFile := ''; ApplyComponentFilter(nil, FFilterParams, false); if GFormMode = fmNormal then case GDBMode of bkNormBase: begin GSCSIni.NB := ReadNBIni; GSCSIni.Colors := ReadColors; GLiteVersion := false; GUseLiteFunctional := false; {IGOR} //D0000006315 //GLiteVersion := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtLiteVersion, false); {$IF Defined(SCS_PE)} GAutoAddNetworkEquipment := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAutoAddNetworkEquipment, true); {$ELSE} GAutoAddNetworkEquipment := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAutoAddNetworkEquipment, false); {$IFEND} GUseLiteFunctional := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtUseLiteFunctional, false); {IGOR} //D0000006315 GAllowConvertInterfToUniversal := False; //GAllowConvertInterfToUniversal := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAllowConvertInterfToUniversal, GLiteVersion or GUseLiteFunctional); {$IF NOT Defined(TELECOM)} //31.03.2011 GLiteVersion := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtLiteVersion, false); //31.03.2011 GUseLiteFunctional := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtUseLiteFunctional, false); GUseVerticalTraces := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtUseVerticalTraces, false); GDropObjByOneClick := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtDropObjByOneClick, false); GShowAutoCreatedGuides := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtShowAutoCreatedGuides, false); GStoreLastPaths := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtStoreLastPaths, false); GAutoScaleRasterImages := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAutoScaleRasterImages, True); // Tolik 09/08/2019 -- GAllowDropCableToRoute := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAllowDropCableToRoute, false); // Tolik 28/05/2021 -- GAutoRouteCableAfterTraceCreation := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral, idtAutoRouteCableAfterTraceCreation, true); // Tolik 09/08/2021 -- // Tolik 03/02017 -- GConnectTraceOnClickPoint := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral,'ConnectTraceOnClickPoint', false); //if GConnectTraceOnClickPoint then GMoveRouteToPointObject := ReadSetting(fnSCSIniFile, dtBoolean, scGeneral,'MoveRouteToPointObject', false); //else // GMoveRouteToPointObject := False; // Tolik 03/03/2021 -- //GCallElectricAutoTraceMaster := ReadSetting(fnSCSIniFile, dtBoolean, scElectrical, idtTraceElectrical, false); GCallElectricAutoTraceMaster := ReadSetting(fnSCSIniFile, dtBoolean, scElectrical, idtTraceElectrical, true); // {$IFEND} //SetControlsByUseLiteFunctional(GLiteVersion, GUseLiteFunctional, false); end; bkProjectManager: GSCSIni.PM := ReadPMIni; end else begin EnableDisableEdit(false); Tree_Catalog.OnDragDrop := nil; Tree_Catalog.OnDragOver := nil; Tree_Catalog.OnKeyDown := nil; Tree_Catalog.OnKeyPress := nil; Tree_Catalog.OnKeyUp := nil; //Tree_Catalog.OnMouseDown := nil; Tree_Catalog.OnMouseMove := nil; Tree_Catalog.OnMouseUp := nil; Tree_Catalog.OnStartDrag := nil; Tree_Catalog.PopupMenu := nil; end; FFilterParams.FFilterType := fltCustom; ZeroMemory(@CommonIni, SizeOf(TCommonIni)); case GDBMode of bkNormBase: begin CommonIni := GSCSIni.NB.Common; GSCSIni.NB.IsAdministration := false; {$IF Not Defined (FINAL_SCS) or Defined(BASEADM_SCS)} GSCSIni.NB.IsAdministration := true; {$IFEND} Act_SettIsAdministration.Checked := GSCSIni.NB.IsAdministration; if GFormMode = fmNormal then begin EnableDisableEdit(Not GSCSIni.NB.DisableEdit and CheckWriteNBByUser); FFilterParams.FFilterType := GSCSIni.NB.FilterType; end; end; bkProjectManager: begin CommonIni := GSCSIni.PM.Common; GIDLastProject := GSCSIni.PM.IDLastProject; end; end; DBFile := CommonIni.DBPath; if CommonIni.PnAdditionRestored then Panel_Addition.RestoreHotSpot else Panel_Addition.CloseHotSpot; ZeroMemory(@FLastNodeDat, SizeOf(TObjectData)); ZeroMemory(@FPrevSelectedNodeDat, SizeOf(TObjectData)); FPrevSelectionCount := 0; (* If FileExists('SCS.ini') then begin ini := TIniFile.Create(extractfilepath(paramstr(0)) + 'Scs.ini'); if ReadPnAdditionRestored(GDBMode) = true then Panel_Addition.RestoreHotSpot else Panel_Addition.CloseHotSpot; case GDBMode of bkNormBase: begin if GFormMode = fmNormal then GIDLastNBDir := ReadLastNBDir; GDefaultNoLineCompon := 0; GDefaultLineCompon := 0; DBFile := ReadDBPath(GDBMode); GNDS := ReadNDS; GDisableTreeEdit := ReadNBDisabeEdit(GDBMode); Act_mnuDisableEditTree.Checked := GDisableTreeEdit; GDefaultNoLineCompon := ReadDefaultIDCompon(biFalse); GDefaultLineCompon := ReadDefaultIDCompon(biTrue); //GIsAdministration := ReadIsAdministration; GIsAdministration := false; {$IF Not Defined (FINAL_SCS)} GIsAdministration := true; {$IFEND} Act_SettIsAdministration.Checked := GIsAdministration; //GAutoInsertingCompons := ReadAutoInsertingCompons; //Act_SettAutoInsertingCompons.Checked := GAutoInsertingCompons; end; bkProjectManager: begin DBFile := ReadDBPath(GDBMode); Act_mnuDisableEditTree.Checked := ReadNBDisabeEdit(GDBMode); // ini.ReadBool('ProjectManager', 'Disable Edit', false); GComboIndex := ReadDefNewItemType; //ini.ReadInteger('ProjectManager', 'DefNewItemType', 0); GCheck_asDefault := ReadDefCheckState; //ini.ReadBool('ProjectManager', 'DefCheckState', true); GIDLastProject := ReadSavedIDProject; GIDLastList := -1; //GIDLastList := ReadSavedIDList; //ini.ReadInteger('ProjectManager', 'SavedList', 0); end; end; FreeAndNil(ini); EnableDisableEdit(Not Act_mnuDisableEditTree.Checked); {if (fileExists(DBFile)) and Not DataBase_SCS.Connected then begin DataBase_SCS.AliasName := DBFile; DataBase_SCS.DBName := DBFile; Database_SCS.Connected := true; end; } end else GNDS := 20; *) // Обновить нормативку if GDBMode = bkNormBase then if ReadUpdatePath <> '' then try if F_Animate = nil then F_Animate := TF_Animate.Create(Self); if DBFile <> '' then UpdateNB(DBFile, true, ReadUpdatePath) else {$if Defined(ES_GRAPH_SC)} UpdateNB(exedir + '\' + DefNBPath, true, ReadUpdatePath); {$else} UpdateNB(extractfilepath(paramstr(0)) + DefNBPath, true, ReadUpdatePath); {$ifend} WriteUpdatePath(''); except end; //*** Открытие базы данных GSCSBase := TSCSBase.Create(TForm(Self)); //OpenBaseResult := GSCSBase.Open(DBFile, GFormMode = fmNormal); //if GFormMode = fmNormal then // OpenBaseResultHandler(OpenBaseResult, Self); if GDropComponent = nil then GDropComponent := TSCSComponent.Create(TForm(Self)); {if GSCSBase.Active then if GDBMode = bkNormBase then begin GCurrencyM := DM.GetCurrencyByType(ctMain); GCurrencyS := DM.GetCurrencyByType(ctSecond); end;} CreateTemplateControls(GDBMode = bkNormBase); Left := Screen.Width + 10; //DM.ActiveAll; //if Not GCreatedDMAIN {GFormMode <> fmComplects} then case GDBMode of bkNormBase: begin if GFormMode <> fmNormal then begin pnGroupCompType.Visible := false; pnUpDownGroupProps.Visible := false; pnGroupConf.Height := pnGroupConf.Height - pnGroupCompType.Height; //tvComponGroups.PopupMenu := nil; if FlvTemplate <> nil then begin FlvTemplate.OnContextPopup := nil; FlvTemplate.OnItemContextMenu := nil; end; end; HelpContext := hiNormBase; ToolBar_Tree.HelpContext := hiNormBaseToolsPanel; Tree_Catalog.HelpContext := hiNormBaseTreeElements; Grid_CompData.HelpContext := hiNormBaseObjectElemens; Caption := cMain_Msg28_1; //Left := Screen.WorkAreaWidth - Width - 1; //18.06.2009 Left := Screen.Width - Width - 1; SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces); SetVisibleGridLevel(GL_Interface, tcGridData, GUseVisibleInterfaces); GT_Compon_RelationKolvo.Options.Editing := true; GT_Compon_Relation.OptionsSelection.CellSelect := true; GT_INTERFACENpp.Visible := false; GT_INTERFACECoordZ.Visible := false; GT_InterfaceKolvoBusy.Visible := false; GT_PORTNpp.Visible := false; GT_PORTNppPort.Visible := false; GT_PORTNameConnected.Visible := false; GT_PORTNameConnectCable.Visible := false; GT_PortKolvoBusy.Visible := false; {08.11.2007 if GSCSIni.NB.IDLastNBDir > 0 then begin Node := nil; if GSCSBase.Active then Node := FindComponOrDirInTree(GSCSIni.NB.IDLastNBDir, false); if Node <> nil then begin Node.Expanded := true; Tree_Catalog.Selected := Node; end; end; } TmpInt := ReadSetting(fnSCSIniFile, dtInteger, scNormBase, idtComponDrawMode, 0); if TmpInt = 0 then Act_DrawModeRect.Checked := true else if TmpInt = 1 then Act_DrawModePoly.Checked := true; Act_DrawBasement.Checked := ReadSetting(fnSCSIniFile, dtBoolean, scNormBase, idtComponDrawBasement, False); end; bkProjectManager: begin HideTemplateControls; HelpContext := hiProjMan; ToolBar_Tree.HelpContext := hiProjManToolsPanel; Tree_Catalog.HelpContext := hiProjManTreeElements; Grid_CompData.HelpContext := hiProjManObjectElemens; Caption := cMain_Msg28_2; Left := 1; Grid_CompData.OnActiveTabChanged := nil; GT_Compon_RelationKolvo.Visible := false; //GL_Compon_Relation.Visible := false; //GL_INTERFACE.Visible := false; GT_INTERFACECoordZ.Visible := false; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, false); SetVisibleGridLevel(GL_INTERFACE, tcGridData, false); Grid_CompData.OnActiveTabChanged := Grid_CompDataActiveTabChanged; //GT_INTERFACE.OptionsSelection.CellSelect := true; Act_MakeComponent.Visible := false; //pmnu_ChoiceFind.Visible := false; //Act_ChoiceFind.Visible := false; Act_CutDir.Visible := false; //*** Запретить действия с компонентами по умолчанию Act_DropDefLineCompon.Visible := false; Act_DropDefNoLineCompon.Visible := false; Act_TurnToDefLineCompon.Visible := false; Act_TurnToDefNoLineCompon.Visible := false; //GListSetting := TListSettings.Create(TForm(Self)); //GProjectSettings := TProjectSettings.Create(TForm(Self)); //*** Проверка Листа на существование //ChangeCurrList(GIDLastList, CheckList(GIDLastList)); {08.11.2007 //*** Раскрыть папку "Менеджер проектов" и перейти на последний проект if Tree_Catalog.Items.Count > 0 then Tree_Catalog.Items[0].Expanded := true; if GIDLastProject > 0 then begin Node := nil; if GSCSBase.Active then Node := FindTreeNodeByDat(GIDLastProject, [itProject]); if Node = nil then Node := FindComponOrDirInTree(GIDLastProject, false, qmPhisical); if Node <> nil then Tree_Catalog.Selected := Node; end; } end; end; Act_TurnToDefLineCompon.Visible := false; Act_TurnToDefNoLineCompon.Visible := false; gbFilterType.Visible := GDBMode = bkNormBase; //GL_Connections.Visible := false; SetVisibleGridLevel(GL_Connections, tcGridData, false); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, false); SetVisibleGridLevel(GL_CrossConnection, tcGridData, false); Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); GT_Compon_Relation.DataController.DataSource := DM.DataSource_MT_Complects; GT_PROPERTY.DataController.DataSource := DM.DataSource_MT_Property; GT_Interface.DataController.DataSource := DM.DataSource_MT_InterfaceRel; //DM.DataSource1; GT_PORT.DataController.DataSource := DM.DataSource_MT_Port; //GT_IOfI_Rel.DataController.DataSource := {DM.DataSource_MT_IOFI_REL; //}DM.DataSource_INTERFOFINTERF_RELATION; GT_Connections.DataController.DataSource := DM.DataSource_MT_Connections; GT_CableCanalConnectors.DataController.DataSource := DM.dsrcMTCableCanalConnectors; GT_CrossConnection.DataController.DataSource := DM.DSrc_MT_CrossConnection; GT_NormsResources.DataController.DataSource := DM.dsrcMTNorms; GT_ObjectCurrency.DataController.DataSource := DM.dsrcObjectCurrency; TcxCurrencyEditProperties(GT_Compon_RelationPrice1.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_Compon_RelationCost1.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_Compon_RelationPrice2.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_Compon_RelationCost2.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_INTERFACEValueI.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_INTERFACEValueI.Properties).DecimalPlaces := FloatPrecision; GT_NormsResourcesExpenseForLength.DataBinding.FieldName := fnExpenseForLength; TcxCurrencyEditProperties(GT_NormsResourcesExpenseForLength.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_NormsResourcesExpenseForLength.Properties).DecimalPlaces := FloatPrecision; //31.10.2013 //TcxCurrencyEditProperties(GT_NormsResourcesLaborTime.Properties).DisplayFormat := GetDisplayFormatForFloat; //TcxCurrencyEditProperties(GT_NormsResourcesLaborTime.Properties).DecimalPlaces := FloatPrecision; GT_NormsResourcesCountForPoint.Caption := cNameCountForPoint; GT_NormsResourcesCountForPoint.DataBinding.FieldName := fnCountForPoint; TcxCurrencyEditProperties(GT_NormsResourcesCountForPoint.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_NormsResourcesCountForPoint.Properties).DecimalPlaces := FloatPrecision; GT_NormsResourcesStepOfPoint.DataBinding.FieldName := fnStepOfPoint; TcxCurrencyEditProperties(GT_NormsResourcesStepOfPoint.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_NormsResourcesStepOfPoint.Properties).DecimalPlaces := FloatPrecision; GT_NormsResourcesTotalKolvo.Caption := cNameTotalkolvo; GT_NormsResourcesTotalKolvo.DataBinding.FieldName := fnTotalKolvo; TcxCurrencyEditProperties(GT_ObjectCurrencyRatio.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_ObjectCurrencyRatio.Properties).DecimalPlaces := FloatPrecision; GT_ConnectionsRelType.Visible := GUseArhOnlyMode; GT_ConnectionsFixed.Visible := GUseArhOnlyMode; tcGridData.Tabs[cdliNormsResources].Caption := cNameAccessoryResourceNorm; Act_MakeResource.Hint := Act_MakeResource.Caption; Act_MakeResourceCompon.Caption := cMain_Msg168; Act_MakeResourceCompon.Hint := Act_MakeResourceCompon.Caption; Tree_Catalog.Update; //*** Настройка ToolBar tbDevTools.Visible := false; {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} if GDBMode = bkNormBase then tbDevTools.Visible := true; {$ELSE IF} tbTest.Visible := false; tbTest2.Visible := false; Act_PairLineInterfaces.Visible := false; Act_ChangeComponArtProducerByTemplate.Visible := false; {$IFEND} {$if Defined(ES_GRAPH_SC)} Act_ChangeComponArtProducerByTemplate.Visible := false; {$ifend} //*** Настройка Конт.меню InsertActToPopupMenu(PopupMenu_Catalog, 0, nil); // Разделительная линия if GDBMode <> bkNormBase then InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeRoom); InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeDir); InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_AddComplectToComponent); if GDBMode = bkNormBase then begin Act_MakeProject.Visible := false; Act_OpenProject.Visible := false; Act_CloseProject.Visible := false; Act_SaveProjectToFile.Visible := false; Act_SaveProjectFromNodeToFile.Visible := false; Act_LoadProjectFromFile.Visible := false; Act_MakeList.Visible := false; Act_MakeRoom.Visible := false; Act_MakeSCSConnector.Visible := false; Act_MakeSCSLine.Visible := false; Act_MnuActions.Visible := false; ToolButton_TMnuActions.Visible := false; Act_ConnectedConCompons.Visible := false; Act_ConnectedLineCompons.Visible := false; Act_NoConnectedConCompons.Visible := false; Act_NoConnectedLineCompons.Visible := false; Act_CablesNoHitToCanals.Visible := false; Act_AllComponsNorms.Visible := false; Act_MasterDefectAct.Visible := false; Act_NoConnectedRoutes.Visible := false; InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeComponent); ToolButton_TMnuMenu.Visible := false; pmnu_DropAct_Report.Visible := false; Act_SetCurrencies.Visible := True; end else begin InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeProject); InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_CopyCurrList); InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_CopyCurrListWithoutCompons); InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeList); //InsertActToPopupMenu(PopupMenu_Catalog, 0, Act_MakeProject); pmnu_TurnToDefLineCompon.Visible := false; pmnu_TurnToDefNoLineCompon.Visible := false; pmnu_DropAct_Guides.Visible := false; pmnu_DropAct_Settings.Visible := false; //CopyMenuItems(PopupMenu_Catalog.Items[PopupMenu_Catalog.Items.IndexOf(pmnu_Actions)] , PopupMenu_TBActions.Items); end; //FpmnuActions := TPopupMenu.Create(Self); //FpmnuActions.Images := PopupMenu_Catalog.Images; //CopyMenuItems(pmnu_Actions, FpmnuActions.Items); //ToolButton_TMnuActions.MenuItem := nil; //ToolButton_TMnuActions.DropdownMenu := FpmnuActions; XPMenu.Active := false; XPMenu.Active := true; SaveDialog_Project.Title := cMain_Msg29+'...'; OpenDialog_Project.Title := cMain_Msg30+'...'; sdAlPlan.Title := Act_SaveToAlPlan.Caption; splFindInTree.Enabled := Act_ChoiceFind.Checked; splFindInTree.Visible := Act_ChoiceFind.Checked; GisBuildedTree := false; GisAddEditingComplect := false; GisFindingNode := false; GisDragTree := false; GisInitEdit := false; GisEditingTree := false; GCanClearListView := true; //GWhoChange := wcNone; GIDCompForPict := 0; GEditKind := ekNone; GBaseBeginUpdateCount := 0; FEditingPropertyValue := false; FLastOnHintNode := nil; FLastOnHintObject := nil; //GIDLastList := -1; FIsBufferedList := false; FEnabledRefreshNode := true; FIsDefineInterfaceNormsOnChangeNode := true; FCanCallCADOnCopingCompon := true; FQuastAdditButtonsPlaceToConduitMaxCompons := []; FQuastLastResPlaceToConduitMaxCompons := -1; EnablePaste; FCurrUserInfo := nil; FProjUserInfo := nil; FMultipleAction := false; //04.01.2011 F_ImageShow := TF_ImageShow.Create(Self, TForm(Self)); if GFormMode = fmNormal then begin OldTick := GetTickCount; //04.01.2011 if F_Connect = nil then //04.01.2011 F_Connect := TF_Connect.Create(Self, TForm(Self)); //04.01.2011 F_AddComponent := TF_AddComponent.Create(Self, TForm(Self)); F_AnswerToQuast := TF_AnswerToQuast.Create(Self); //05.01.2011 F_AddInterface := TF_AddInterface.Create(Self, TForm(Self) ); if F_Animate = nil then F_Animate := TF_Animate.Create(Self); F_CanDelete := TF_CanDelete.Create(Self, TForm(Self) ); //05.01.2011 F_FindParams := TF_FindParams.Create(Self, TForm(Self)); F_InputBox := TF_InputBox.Create(Self, TForm(Self) ); F_ChoiceConnectSide := TF_ChoiceConnectSide.Create(Self, TForm(Self) ); //04.01.2011 F_Norms := TF_Norms.Create(Self, TForm(Self)); //05.01.2011 F_MakeNorm := TF_MakeNorm.Create(Self, TForm(Self)); //05.01.2011 F_MarkMask := TF_MarkMask.Create(Self, TForm(Self)); //05.01.2011 F_ConnectComplWith := TF_ConnectComplWith.Create(Self, TForm(Self)); F_MakeCurrency := TF_MakeCurrency.Create(Self, TForm(Self) ); F_MakeEditComponentType := TF_MakeEditComponentType.Create(Self, TForm(Self)); //04.01.2011 F_MakeEditCrossConnection := TF_MakeEditCrossConnection.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditInterface := TF_MakeEditInterface.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditInterfaceAccordance := TF_MakeEditInterfaceAccordance.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditInterfNorm := TF_MakeEditInterfNorm.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditObjectIcons := TF_MakeEditObjectIcons.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditPortInterfRel := TF_MakeEditPortInterfRel.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditProducer := TF_MakeEditProducer.Create(Self, TForm(Self)); //05.01.2011 F_MakeEditPropRel := TF_MakeEditPropRel.Create(Self, TForm(Self)); //05.01.2011 F_MakeProperty := TF_MakeProperty.Create(Self, TForm(Self) ); //05.01.2011 F_MakeEditSupplyKind := TF_MakeEditSupplyKind.Create(Self, TForm(Self)); //F_MsgDlg := TF_MsgDlg.Create(Self, TForm(Self)); if GDBMode = bkNormBase then begin Application.OnIdle := IdleEventHandler; //05.01.2011 F_BaseOptions := TF_BaseOptions.Create(Self, TForm(Self)); //05.01.2011 F_BackUpBase := TF_BackUpBase.Create(Self, TForm(Self)); F_CaseForm := TF_CaseForm.Create(Self, TForm(Self), nil, itNone); F_NDS := TF_NDS.Create(Self, TForm(Self)); //F_ActiveCurrency := TF_ActiveCurrency.Create(Self, TForm(Self) ); //05.01.2011 F_MakeEditObjCurrency := TF_MakeEditObjCurrency.Create(Self, TForm(Self)); //05.01.2011 F_UpdateNormBaseDialog := TF_UpdateNormBaseDialog.Create(Self, TForm(Self)); //04.01.2011 F_MasterUpdatePrice := TF_MasterUpdatePrice.Create(Self, TForm(Self)); F_CurrencyPreparer := nil; F_ConfiguratorUpdateInfo := nil; {$IF NOT Defined (FINAL_SCS)} //04.01.2011 F_CurrencyPreparer := TF_CurrencyPreparer.Create(Self, TForm(Self)); //04.01.2011 F_ConfiguratorUpdateInfo := TF_ConfiguratorUpdateInfo.Create(Self, TForm(Self)); {$IFEND} {08.11.2007 //*** Подгрузить фильтр из нормативной базы if FileExists(GetPathToNBComponFilter) then begin FFilterBlock := TFilterBlock.Create(nil, btBlock); FFilterBlock.LoadFromFile(GetPathToNBComponFilter, ftComponent, nil, false); ApplyComponentFilter(nil, FFilterBlock, true); DM.DefineIsOnFilterBlocks(FFilterBlock, true); end;} if GCableCompTypes = nil then begin GCableCompTypes := TStringList.Create; GCableCompTypes.Add(ctsnCable); GCableCompTypes.Add(ctsnOFCable); end; end; if GDBMode = bkProjectManager then begin //04.01.2011 F_ObjectParams := TF_ObjectParams.Create(Self, TForm(Self)); //04.01.2011 F_ComponTypesMarkMask := TF_ComponTypesMarkMask.Create(Self, TForm(Self)); //04.01.2011 F_InterfaceInfo := TF_InterfaceInfo.Create(Self, TForm(Self)); //04.01.2011 F_MasterCableCanalTracing := TF_MasterCableCanalTracing.Create(Self, Self); F_ProgressExp := TF_ProgressExp.Create(Application, Self); //F_ReportForm := TF_ReportForm.Create(Self, TForm(Self)); //04.01.2011 F_ResourceReport := TF_ResourceReport.Create(Self, TForm(Self)); //04.01.2011 F_MakeMarkPage := TF_MakeMarkPage.Create(Self, TForm(Self)); //04.01.2011 F_ItemsSelector := TF_ItemsSelector.Create(Self, TForm(Self)); //04.01.2011 CreateSpravochnikiInMasterNewList; //F_Preview := TF_Preview.Create(Self, TForm(Self)); //F_ProgressExp := TF_ProgressExp.Create(Self, TForm(Self)); ClearSCSTemDirs; if IsUseProjLoginning then begin FCurrUserInfo := TUserInfo.Create; FProjUserInfo := TUserInfo.Create; end; end; //F_ProgressExp := nil; {$IF Defined(SCS_RF)} if GDBMode = bkProjectManager then GSCSIni.PM.RepDesignLanguageFile := fnRepDesignLangRus; //04.01.2011 if Assigned(F_ResourceReport) then //04.01.2011 F_ResourceReport.pnOtherProperties.Visible := false; //*** Убрать панель с украинским переключателем //05.01.2011 if Assigned(F_BaseOptions) then //05.01.2011 F_BaseOptions.HideTabSheet(F_BaseOptions.tsReportDesigner); {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_SPA)} if GDBMode = bkProjectManager then GSCSIni.PM.RepDesignLanguageFile := fnRepDesignLang; //04.01.2011 if Assigned(F_ResourceReport) then //04.01.2011 F_ResourceReport.pnOtherProperties.Visible := false; //*** Убрать панель с украинским переключателем //05.01.2011 if Assigned(F_BaseOptions) then //05.01.2011 F_BaseOptions.HideTabSheet(F_BaseOptions.tsReportDesigner); {$IFEND} CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; //SetCurrencyBriefToControls; //LoadCurrencyFormat; //if GFormMode = fmNormal then // SetCurrencyBriefToControls; //ShowModal; ActionCaptionsToHints(ActionList); SetPriceCostPanel; if GFormMode <> fmNormal then ConnectToBase; DM.scsQ.DefineQueryMode; DM.scsQ1.DefineQueryMode; DM.scsQSelect.DefineQueryMode; DM.scsQOperat.DefineQueryMode; DM.scsQTSCSSelect.DefineQueryMode; DM.scsQTSCSOperat.DefineQueryMode; // Tolik 03/*06/*2017 -- CashedCompon := nil; // //Tolik 24/01/2022 -- //{$IF Defined(SCS_PE)} if GDBMode = bkNormbase then pcObjects.ActivePage := tsTemplates; //{$IFEND} except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.FormCreate), E.Message); end; // Tolik -- 30/04/2021 -- OoldProc := ToolBar_CompData.WindowProc; ToolBar_CompData.WindowProc := NNewProc; ToolBar_Tree_OldProc := ToolBar_Tree.WindowProc; ToolBar_Tree.WindowProc := ToolBar_Tree_NewProc; ToolBar1_OldProc := ToolBar1.WindowProc; ToolBar1.WindowProc := ToolBar1_NewProc; // EnableAlign; end; procedure TF_MAIN.FormActivate(Sender: TObject); begin //ChangeActiveBase; GGForm := TForm(Self); // Tolik -- 24/12/2015 if GCadForm <> nil then begin TPowerCad(TF_CAD(GCadForm).PCad).OnGuiEvent := TF_CAD(GCadForm).PCadGUIEvent; end; end; procedure TF_MAIN.FormDeactivate(Sender: TObject); begin Act_HideHints.Execute; end; procedure TF_MAIN.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin if GFormMode = fmNormal then begin CanClose := false; if self = F_NormBase then FSCS_Main.aViewNormBase.Execute; if self = F_ProjMan then FSCS_Main.aViewProjectManager.Execute; end; end; // ##### Закрыть форму ##### procedure TF_MAIN.FormClose(Sender: TObject; var Action: TCloseAction); var ParentPanel: TComponent; begin Act_HideHints.Execute; { if TForm(Sender).Name <> 'F_MAIN' then Action := caNone; if (TForm(Sender).Name = 'F_NormBase') Or (TForm(Sender).Name = 'F_ProjMan') then Action := caNone; //// Oleg : Скрытие рисунка, если он есть //// Act_HideImage.Execute; } {IF GFormMode = fmNormal then Action := caNone; } { ///// MARK : Код для нормализирования панелей при отсоединении от них NormBase FSCS_Main.aViewNormBase.Checked := false; ParentPanel := TForm(Sender).GetParentComponent; if ActiveMDIChild = nil then Exit; if ParentPanel = FSCS_Main.pDock1 then FSCS_Main.CountDock1 := FSCS_Main.CountDock1 - 1; if ParentPanel = FSCS_Main.pDock2 then FSCS_Main.CountDock2 := FSCS_Main.CountDock2 - 1; if FSCS_Main.CountDock1 = 0 then begin FSCS_Main.pDock1.Width := 1; FSCS_Main.sDiv1.Visible := False; end; if FSCS_Main.CountDock2 = 0 then begin FSCS_Main.sDiv2.Visible := False; FSCS_Main.pDock2.Width := 1; end; } ////////////////////////////////////////////////////////////////////////////// end; // ##### Показать форму (при дубликате) ##### procedure TF_MAIN.FormShow(Sender: TObject); var Obj: PObjectData; Node : TTreeNode; i, j, k: Integer; IDFirstList: Integer; ListNode: TTreeNode; // #forprogrammer FiguresIDList: TList; ComponIDList: TList; SCSCompon: TSCSComponent; ptrProperty: PProperty; SCSCatalog: TSCSCatalog; Catalog: TCatalog; CatList: TList; CanDel: Boolean; ResourceRel: TSCSResourceRel; Norm: TSCSNorm; FieldNames: TStringList; Stream: TStream; begin if Not GConnected then begin {***Application.FreeOnRelease; Halt;***} end; try if (GFormMode = fmNewFolder) and (Edit_NewName <> nil) then Edit_NewName.SetFocus; //*** Открыть Менеджер проэктов на 1-м листе if (GDBMode = bkProjectManager) and (GFormMode = fmNormal) then begin {SetSQLToQuery(DM.scsQ, ' select id from katalog '+ ' where id_item_type = '''+ IntToStr(itList) +''' '+ ' order by id '); IDFirstList := DM.scsQ.FN('id').AsInteger; if IDFirstList <> 0 then begin ListNode := FindComponOrDirInTree(IDFirstList, false); if ListNode <> nil then Tree_Catalog.Selected := ListNode; end; } //OpenListInPM(GIDLastList, ''); // end; except end; //SetSQLToQuery(DM.scsQOperat, ' update component set price = ''1'', price_calc = ''1'' '); //if GFormmode = fmComplects then // EnableDisableEdit(false); { if GDBMode = bkNormBase then begin SetSQLToQuery(DM.scsQSelect, 'select id from component order by id'); ComponIDList := Tlist.Create; dm.IntFieldToList(ComponIDList, DM.scsQSelect, fnID); ChangeSQLQuery(DM.scsQOperat, 'update component set cypher = :cypher where id = :id'); for i := 0 to ComponIDList.Count - 1 do begin if Integer(ComponIDList[i]^) = 1864 then Beep; DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger(fnID, Integer(ComponIDList[i]^)); DM.scsQOperat.SetParamAsString(fnCypher, GenNewComponentCypher); DM.scsQOperat.ExecQuery; DM.scsQOperat.Close; end; DM.scsQOperat.Close; FreeList(ComponIDList); end; } {$IF Defined(ES_GRAPH_SC)} OpenDialog_Project.DefaultExt := '*.scg'; SaveDialog_Project.DefaultExt := '*.scg'; {$IFEND} end; // ##### Уничтожить форму ##### procedure TF_MAIN.FormDestroy(Sender: TObject); var i: Integer; CurrCompon: TComponent; begin if GFormMode = fmNormal then begin if Assigned(FProjectMan) and (FProjectMan <> Self) then begin FProjectMan.FNormBase := nil; FProjectMan := nil; end; if Assigned(FNormBase) and (FNormBase <> Self) then begin FNormBase.FProjectMan := nil; FNormBase := nil; end; end; if GFormMode = fmNormal then WriteOptionsToINI else if GDBMode = bkNormBase then WriteLastNBDir(GDBMode, GSCSIni.NB.IDLastNBDir); //if Act_ChoiceFind.Checked then // Act_ChoiceFind.Execute; ClearListView(ListView_Find); ClearTemplateGroups; //ClearListViewRz(lvTemplates); if FCurrUserInfo <> nil then FreeAndNil(FCurrUserInfo); if FProjUserInfo <> nil then FreeAndNil(FProjUserInfo); if GFormMode = fmNormal then begin if GDBMode = bkNormBase then if Assigned(Application.OnIdle) then Application.OnIdle := nil; //if GDBMode = bkNormBase then if Assigned(GDropComponent) then if TF_Main(GDropComponent.ActiveForm).GDBMode = GDBMode then FreeAndNil(GDropComponent); if GDBMode = bkProjectManager then SaveProtocolToFile(GetFileNameToSaveProtocol); if Assigned(GCableCompTypes) then FreeAndNil(GCableCompTypes); if Assigned(GLog) then FreeAndNil(GLog); if Assigned(GTimerListToHandle) then FreeAndNil(GTimerListToHandle); end; //if GListSetting <> nil then // GListSetting.Free; //if GProjectSettings <> nil then // GProjectSettings.Free; if GDBMode = bkProjectManager then if GSCSBase.CurrProject.Active then CloseProject(true, false); // Tolik 24/03/2021 -- if GDBMode = bkNormBase then GSCSBase.SCSComponent := nil; // GSCSBase.Close(GFormMode = fmNormal); FreeAndNil(GSCSBase); ClearTree(Tree_Catalog); //*** Освободить поля с ImageList for i := 0 to ComponentCount - 1 do begin CurrCompon := Components[i]; if CurrCompon is TActionList then TActionList(CurrCompon).Images := nil else if CurrCompon is TTreeView then TTreeView(CurrCompon).Images := nil else if CurrCompon is TListView then begin TListView(CurrCompon).LargeImages := nil; TListView(CurrCompon).SmallImages := nil; TListView(CurrCompon).StateImages := nil; end; end; //if FFilterBlock <> nil then // FreeAndNil(FFilterBlock); FreeAndNil(FFilterParams); if FGroupFilterBlock <> nil then FreeAndNil(FGroupFilterBlock); if FGroupFieldValues <> nil then FreeAndNil(FGroupFieldValues); FLoadedComponElements.Free; //*** Удалить все формы // if Assigned(F_Preview) then // FreeAndNil(F_Preview); //04.01.2011 if Assigned(F_ComponTypesMarkMask) then //04.01.2011 FreeAndNil(F_ComponTypesMarkMask); if Assigned(F_InterfaceInfo) then FreeAndNil(F_InterfaceInfo); if Assigned(F_ResourceReport) then FreeAndNil(F_ResourceReport); if Assigned(F_ReportForm) then FreeAndNil(F_ReportForm); if Assigned(F_MasterCableCanalTracing) then FreeAndNil(F_MasterCableCanalTracing); if Assigned(F_MasterUpdatePrice) then FreeAndNil(F_MasterUpdatePrice); if Assigned(F_ObjectParams) then FreeAndNil(F_ObjectParams); if Assigned(F_MakeMarkPage) then FreeAndNil(F_MakeMarkPage); if Assigned(F_ItemsSelector) then FreeAndNil(F_ItemsSelector); //if GDBMode = bkNormBase then begin //05.01.2011 if Assigned(F_UpdateNormBaseDialog) then //05.01.2011 FreeAndNil(F_UpdateNormBaseDialog); if Assigned(F_MakeEditSupplyKind) then FreeAndNil(F_MakeEditSupplyKind); if Assigned(F_MakeEditProducer) then FreeAndNil(F_MakeEditProducer); if Assigned(F_MakeEditObjCurrency) then FreeAndNil(F_MakeEditObjCurrency); if Assigned(F_MakeEditObjectIcons) then FreeAndNil(F_MakeEditObjectIcons); if Assigned(F_MakeEditInterfNorm) then FreeAndNil(F_MakeEditInterfNorm); if Assigned(F_MakeEditInterfaceAccordance) then FreeAndNil(F_MakeEditInterfaceAccordance); if Assigned(F_MakeEditInterface) then FreeAndNil(F_MakeEditInterface); if Assigned(F_MakeEditComponentType) then FreeAndNil(F_MakeEditComponentType); if Assigned(F_MakeProperty) then FreeAndNil(F_MakeProperty); if Assigned(F_MakeCurrency) then FreeAndNil(F_MakeCurrency); //if Assigned(F_ActiveCurrency) then // FreeAndNil(F_ActiveCurrency); if Assigned(F_NDS) then FreeAndNil(F_NDS); if Assigned(F_CaseForm) then FreeAndNil(F_CaseForm); if Assigned(F_BaseOptions) then FreeAndNil(F_BaseOptions); if Assigned(F_ConfiguratorUpdateInfo) then FreeAndNil(F_ConfiguratorUpdateInfo); end; if Assigned(F_MakeEditPropRel) then FreeAndNil(F_MakeEditPropRel); if Assigned(F_MakeEditPortInterfRel) then FreeAndNil(F_MakeEditPortInterfRel); if Assigned(F_MakeEditCrossConnection) then FreeAndNil(F_MakeEditCrossConnection); if Assigned(F_ConnectComplWith) then FreeAndNil(F_ConnectComplWith); if Assigned(F_MarkMask) then FreeAndNil(F_MarkMask); if Assigned(F_MakeNorm) then FreeAndNil(F_MakeNorm); //04.01.2011 if Assigned(F_Norms) then //04.01.2011 FreeAndNil(F_Norms); if Assigned(F_ChoiceConnectSide) then FreeAndNil(F_ChoiceConnectSide); if Assigned(F_InputBox) then FreeAndNil(F_InputBox); if Assigned(F_FindParams) then FreeAndNil(F_FindParams); if Assigned(F_CanDelete) then FreeAndNil(F_CanDelete); if Assigned(F_Animate) then FreeAndNil(F_Animate); if Assigned(F_AddInterface) then FreeAndNil(F_AddInterface); if Assigned(F_AnswerToQuast) then FreeAndNil(F_AnswerToQuast); if Assigned(F_AddComponent) then FreeAndNil(F_AddComponent); if Assigned(F_Connect) then FreeAndNil(F_Connect); if Assigned(F_ImageShow) then FreeAndNil(F_ImageShow); //if Assigned(GDropComponent) then // FreeAndNil(GDropComponent); if Assigned(GSCSBase) then FreeAndNil(GSCSBase); if Assigned(Tree_Catalog) then FreeAndNil(Tree_Catalog); //if Assigned(DM) then // FreeAndNil(DM); Act_ClearCopyBuf.Execute; try FreeAndNil(ActionList); except end; end; // #################### Редактирование / Перемещение ######################### // ########################################################################### // // ##### Редактирование наименование ветви ##### procedure TF_MAIN.Tree_CatalogEdited(Sender: TObject; Node: TTreeNode; var S: String); begin try if Node <> nil then S := RenameNode(cfBase, Node, nil, S); except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogEdited: '+E.Message); end; end; procedure TF_MAIN.Tree_CatalogEditCancelled(Sender: TObject); var Node: TTreeNode; TextNode: String; Dat: PobjectData; Catalog: Tcatalog; begin try Node := TTreeView(Sender).Selected; if (Node <> nil) and (Node.Data <> nil) then if Not(PObjectData(Node.Data).ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup]) then begin Dat := Node.Data; Node.Text := GetNameNode(Node, nil, true, true); //if (Dat.ItemType = itSCSLine) or (Dat.ItemType = itSCSConnector) then // SetNodeImageIndex(Node, Dat.ItemType, GEditKind) //else end; except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_catalogEditCancelled: '+E.Message); end; end; // ##### Если Добавлена / Удалена ветвь, то Очищать свписок найденных ##### procedure TF_MAIN.Tree_CatalogAddition(Sender: TObject; Node: TTreeNode); begin GCanClearListView := true; //PObjectData(Node.Data).Expanded := false; end; // ##### Удаление ветви дерева ##### procedure TF_MAIN.Tree_CatalogDeletion(Sender: TObject; Node: TTreeNode); var NodeDat: PobjectData; ParentNode: TTreeNode; ParentNodeDat: PobjectData; begin try NodeDat := Node.Data; ParentNode := nil; ParentNodeDat := nil; ParentNode := Node.Parent; if ParentNode <> nil then ParentNodeDat := ParentNode.Data; if ParentNodeDat <> nil then begin //if ParentNode.Count = 1 then // ParentNodeDat.HasChildren := false; //*** Удалать группу, если в ней нихера нету if ParentNodeDat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin if ParentNode.Count = 1 then DeleteNode(ParentNode) else Dec(PObjectData(ParentNode.Data).ChildNodesCount); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogDeletion: '+E.Message); end; end; procedure TF_MAIN.Timer_TreeCatalogChangeTimer(Sender: TObject); var Node: TTreeNode; Data: PObjectData; //DatComp: PObjectData; Item: TListItem; ID_COMPONENT: Integer; SCSCatal: TSCSCatalog; SCSCompon: TSCSComponent; ComplNode: TTreeNode; CatName: String; SCS_ID: Integer; QueryMode: TQueryMode; IsLine: Boolean; VisibleObjectCurrency: Boolean; LineNo: Integer; procedure CompareComponent; var CatalogNode: TTreeNode; CurrTick, OldTick: Cardinal; begin ID_COMPONENT :=Data.ObjectID; Data := Tree_Catalog.Selected.Parent.Data; SCSCompon := nil; SCSCompon := RefreshTreeNodeComponent(Node); //*** Загрузить папку для тек-й компоненты CatalogNode := GetTargetNodeForItemType(Node, GSCSBase.SCSComponent.GetItemType{можно и itComponLine}, qmUndef); if (CatalogNode <> nil) and (CatalogNode.Data <> nil) then begin if GSCSBase.SCSCatalog.ID <> PObjectData(CatalogNode.Data).ObjectID then case QueryMode of qmPhisical: GSCSBase.SCSCatalog.LoadCatalogByID(PObjectData(CatalogNode.Data).ObjectID, false, false); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(CatalogNode.Data).ObjectID); if Assigned(SCSCatal) then GSCSBase.SCSCatalog.Assign(SCSCatal); end; end; GSCSBase.SCSCatalog.TreeViewNode := CatalogNode; end; if SCSCompon <> nil then IsLine := SCSCompon.IsLine = biTrue; ShowComponObjects(Node, SCSCompon); OnSelectCompon(SCSCompon); {//17.06.2009 DefineLocalCurrency; if Assigned(GSCSBase.SCSComponent) then begin ShowPrice; if GFormMode = fmNormal then DM.SelectCompSub(Node, SCSCompon); if GDBMode = bkProjectManager then begin //if Not GL_Compon_Relation.Visible then // GL_Compon_Relation.Visible := true; //if Not GL_INTERFACE.Visible then // GL_INTERFACE.Visible := true; //if Not GL_PORT.Visible then // GL_PORT.Visible := true; //if Not GL_Connections.Visible then // GL_Connections.Visible := true; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, GTemplateContCompl or (GSCSBase.SCSComponent.IsTemplate = biFalse)); SetVisibleGridLevel(GL_Interface, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_INTERFACE, tcGridData, true); SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_Connections, tcGridData, true); SetVisibleGridLevel(GL_NormsRerources, tcGridData, true); tcGridData.TabIndex := GActiveLevelIndex; //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); end else begin SetVisibleGridLevel(GL_Compon_Relation, tcGridData, true); if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then SetVisibleGridLevel(GL_CrossConnection, tcGridData, true) else SetVisibleGridLevel(GL_CrossConnection, tcGridData, false); //*** подключения в НБ if IsCanNBComponNodeHaveConnection(Node) then SetVisibleGridLevel(GL_Connections, tcGridData, true) else SetVisibleGridLevel(GL_Connections, tcGridData, false); end; if GSCSBase.SCSComponent.IsLine = biTrue then begin GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; SetVisibleGridLevel(GL_PORT, tcGridData, false); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel); //if GL_PORT.Visible then //begin // GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; // SetVisibleGridLevel(GL_PORT, tcGridData, false); //end; //GT_INTERFACEMultiple.Visible := true; //GT_INTERFACEValueI.Visible := true; GT_InterfaceNumPairsStr.Visible := true; //GT_INTERFACEColor.Visible := true; GT_INTERFACESide.Visible := true; end else begin SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, false); //if Not GL_PORT.Visible then //begin // SetVisibleGridLevel(GL_PORT, tcGridData, true); // //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //end; //GT_INTERFACEMultiple.Visible := false; //GT_INTERFACEValueI.Visible := false; GT_InterfaceNumPairsStr.Visible := false; //GT_INTERFACEColor.Visible := false; GT_INTERFACESide.Visible := false; end; GT_NormsResourcesExpenseForLength.Visible := GSCSBase.SCSComponent.IsLine = biTrue; GT_NormsResourcesCountForPoint.Visible := GT_NormsResourcesExpenseForLength.Visible; GT_NormsResourcesStepOfPoint.Visible := GT_NormsResourcesExpenseForLength.Visible; GT_NormsResourcesTotalKolvo.Visible := GT_NormsResourcesExpenseForLength.Visible; end; if SCSCompon <> nil then IsLine := SCSCompon.IsLine = biTrue; GT_PROPERTYTakeIntoConnect.Visible := true; GT_PROPERTYTakeIntoJoin.Visible := true; } end; begin // Tolik 15/06/2021 -- if Timer_TreeCatalogChange.Tag = 999 then begin Timer_TreeCatalogChange.Tag := 999; exit; end; //IGOR if GDBMode = bkNormBase then begin if Tree_Catalog.Selected = nil then begin if Sender <> nil then begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then begin Timer_TreeCatalogChange.Tag := 0; Exit; ///// EXIT ///// end; EnableTimerWithOrder(TTimer(Sender), false); exit; end; end; end; // Timer_TreeCatalogChange.Tag := 999; // Tolik 14/11/2019 -- { if (GIsProgress or GIsProgressHandling) then begin if Sender <> nil then begin //Timer_TreeCatalogChange.Tag := 0; //EnableTimerWithOrder(TTimer(Sender), false); exit; end; end;} // if Sender <> nil then begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then begin //IGOR Timer_TreeCatalogChange.Tag := 0; Exit; ///// EXIT ///// end; EnableTimerWithOrder(TTimer(Sender), false); end; LineNo := 1; Node := Tree_Catalog.Selected; Inc(LineNo); try QueryMode := GetQueryModeByNode(GDBMode, Node, GetQueryModeByGDBMode(GDBMode)); Inc(LineNo); IsLine := False; Inc(LineNo); VisibleObjectCurrency := false; Inc(LineNo); try try LockTreeAndGrid(true); Inc(LineNo); //*** Очистить гриды if GFormMode = fmNormal then begin // Tolik 10/12/2019 -- Grid_CompData.BeginUpdate; GT_Compon_Relation.BeginUpdate; GT_PROPERTY.BeginUpdate; GT_INTERFACE.BeginUpdate; GT_Connections.BeginUpdate; if DM.MemTable_Complects.Active then DM.MemTable_Complects.Close; if DM.MemTable_Connections.Active then DM.MemTable_Connections.Close; if DM.MemTable_CrossConnection.Active then DM.MemTable_CrossConnection.Close; if DM.MemTable_InterfaceRel.Active then DM.MemTable_InterfaceRel.Close; if DM.MemTable_PortInterfRel.Active then DM.MemTable_PortInterfRel.Close; if DM.MemTable_Port.Active then DM.MemTable_Port.Close; if DM.mtInterfInternalConn.Active then DM.mtInterfInternalConn.Close; if DM.MemTable_Property.Active then DM.MemTable_Property.Close; if DM.mtCableCanalConnectors.Active then DM.mtCableCanalConnectors.Close; if DM.mtNorms.Active then DM.mtNorms.Close; if DM.mtObjectCurrency.Active then DM.mtObjectCurrency.Close; // Tolik 10/12/2019 -- Grid_CompData.EndUpdate; GT_Compon_Relation.EndUpdate; GT_PROPERTY.EndUpdate; GT_INTERFACE.EndUpdate; GT_Connections.EndUpdate; { if DM.MemTable_Complects.Active then DM.MemTable_Complects.Active := false; if DM.MemTable_Connections.Active then DM.MemTable_Connections.Active := false; if DM.MemTable_CrossConnection.Active then DM.MemTable_CrossConnection.Active := false; if DM.MemTable_InterfaceRel.Active then DM.MemTable_InterfaceRel.Active := false; if DM.MemTable_PortInterfRel.Active then DM.MemTable_PortInterfRel.Active := false; if DM.MemTable_Port.Active then DM.MemTable_Port.Active := false; if DM.mtInterfInternalConn.Active then DM.mtInterfInternalConn.Active := false; if DM.MemTable_Property.Active then DM.MemTable_Property.Active := false; if DM.mtCableCanalConnectors.Active then DM.mtCableCanalConnectors.Active := false; if DM.mtNorms.Active then DM.mtNorms.Active := false; if DM.mtObjectCurrency.Active then DM.mtObjectCurrency.Active := false;} end; if (Node = nil) or (Node.Data = nil) then begin Timer_TreeCatalogChange.Tag := 0; Exit; ///// EXIT ////// end; if (GisFindingNode) or (GisDragTree) {or (GWhoChange <> wcTree)} then begin Timer_TreeCatalogChange.Tag := 0; Exit; ///// EXIT ////// end; Data := Node.Data; Inc(LineNo); //case Data.ItemType of // itComponLine, itComponCon: if IsComponItemType(Data.ItemType) then begin EnableDisableCost(true); //PageScroller_Cost.Enabled := true; //EnableControl(PageScroller_Cost, true); if GFormMode <> fmNewFolder then CompareComponent; end //itDir, itProjMan, itProject, itList, itRoom, itSCSLine, itSCSConnector: else if IsCatalogItemType(Data.ItemType) then begin try CurrencyEdit_Cost1.Value := 0; CurrencyEdit_Cost2.Value := 0; CurrencyEdit_Price1.Value := 0; CurrencyEdit_Price2.Value := 0; EnableDisableCost(false); Inc(LineNo); except on E: Exception do EmptyProcedure; end; //PageScroller_Cost.Enabled := false; //EnableControl(PageScroller_Cost, false); //GSCSBase.SCSCatalog.LoadCatalogByID(Data.ObjectID, false, false); if Assigned(GSCSBase.SCSCatalog) then begin try GSCSBase.SCSCatalog.QueryMode := QueryMode; Inc(LineNo); SCSCatal := nil; Inc(LineNo); case QueryMode of qmPhisical: GSCSBase.SCSCatalog.LoadCatalogByID(Data.ObjectID, false, false); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(Data.ObjectID); Inc(LineNo); if Assigned(SCSCatal) then GSCSBase.SCSCatalog.Assign(SCSCatal); Inc(LineNo); end; end; if SCSCatal <> nil then IsLine := (SCSCatal.ItemType = itSCSLine) or (SCSCatal.ItemType = itSCSLineGroup); Inc(LineNo); GSCSBase.SCSCatalog.TreeViewNode := Node; Inc(LineNo); if Assigned(GSCSBase.SCSComponent) then begin //06.11.2013 if GDBMode = bkNormBase then //06.11.2013 GSCSBase.SCSComponent.Clear; Inc(LineNo); GSCSBase.SCSComponent.Clear; //06.11.2013 Inc(LineNo); end; except on E: Exception do EmptyProcedure; end; end; if GFormMode = fmNormal then begin DM.MemTable_Complects.Active := false; Inc(LineNo); DM.MemTable_InterfaceRel.Active := false; Inc(LineNo); DM.MemTable_Port.Active := false; Inc(LineNo); DM.MemTable_CrossConnection.Active := false; Inc(LineNo); end; //GT_INTERFACE.DataController.DataSource := nil; CurrencyEdit_Cost1.Text := ''; Inc(LineNo); CurrencyEdit_Cost2.Text := ''; Inc(LineNo); if GDBMode = bkProjectManager then begin GSCSBase.SCSCatalog.ProjectOwner := GSCSBase.CurrProject; if GFormMode = fmNormal then if Assigned(GSCSBase.SCSCatalog) then DM.SelectCatalogSub(Node, SCSCatal); // if GSCSBase.SCSCatalog.QueryMode = qmMemory then // DM.SelectCatalogSub(Node); //GT_PROPERTY.DataController.DataSource := DM.DataSource_MT_Property; //ToolButton_Add.Action := Act_AddProperty; //ToolButton_Change.Action := Act_EditProperty; //ToolButton_Remove.Action := Act_RemoveProperty; //ToolButton_Add.ImageIndex := 0; //ToolButton_Change.ImageIndex := 1; //ToolButton_Remove.ImageIndex := 2; //Grid_CompData.PopupMenu := PopupMenu_SUPPLEMENT_DATA; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, false); SetVisibleGridLevel(GL_INTERFACE, tcGridData, false); //04.11.2013 SetVisibleGridLevel(GL_NormsRerources, tcGridData, false); SetVisibleGridLevel(GL_NormsRerources, tcGridData, (Data.ItemType=itProject) OR (Data.ItemType=itList)); //if GL_Compon_Relation.Visible then // GL_Compon_Relation.Visible := false; //if GL_INTERFACE.Visible then // GL_INTERFACE.Visible := false; if Data.ItemType in [itSCSConnector, itSCSLine] then begin SetVisibleGridLevel(GL_Connections, tcGridData, true); //if Not GL_Connections.Visible then // GL_Connections.Visible := true; end else SetVisibleGridLevel(GL_Connections, tcGridData, false); //if GL_Connections.Visible then // GL_Connections.Visible := false; if PObjectData(Node.Data).ItemType = itSCSConnector then SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces) //14.05.2009 SetVisibleGridLevel(GL_PORT, tcGridData, true) //GL_PORT.Visible := true else SetVisibleGridLevel(GL_PORT, tcGridData, false); //if GL_PORT.Visible then // GL_PORT.Visible := false; Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); end else begin if GFormMode = fmNormal then begin try if hints_prog_id <> '' then begin DM.Query_Select.Close; DM.Query_Select.SQL.Clear; DM.Query_Select.SQL.Text := 'select count(*) from KATALOG'; DM.Query_Select.ExecQuery; if Not DM.Query_Select.Eof then if DM.Query_Select.Fields[0].AsInteger < 300 then begin if assigned(F_HintW) then begin FreeAndNil(F_HintW); end; CheckAndShowHint('http://admin.cableproject.net/hints/' + hints_prog_id + '_nb/index.html', hints_prog_id + '_nb', FSCS_Main, 3, True); end; end; except end; DM.SelectCatalogSub(Node, nil); DM.MemTable_Property.Active := false; end; //*** Валюты для папок второго уровня if Node.Level = dirCurrencyLevel then begin VisibleObjectCurrency := true; //DM.SelectCatalogCurrency; end; DefineLocalCurrency; end; GT_PROPERTYTakeIntoConnect.Visible := false; GT_PROPERTYTakeIntoJoin.Visible := false; {if GL_PORT.Visible then begin GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; GL_PORT.Visible := false; end; } //GT_PROPERTY.DataController.DataSource := nil; //DM.SelectCompSub; end; //end; if IsLine then GT_INTERFACEMultiple.Caption := GetNameInterfaceMultipleForLine //CMultipleLineInterface else GT_INTERFACEMultiple.Caption := CMultiplePoinInterface; SetVisibleGridLevel(GL_ObjectCurrency, tcGridData, VisibleObjectCurrency); if VisibleObjectCurrency then tcGridData.TabIndex := GL_ObjectCurrency.Index; //DM.SelectCompSub; //DM.FillMemTableCompl(DM.MemTable_Complects); Data := Node.Data; EnableEditDel(Data.ItemType); //if GWhoChange <> wcTree then {case GDBMode of bkNormBase: if Not GSCSIni.NB.DisableEdit then EnableEditDel(Data.ItemType); bkProjectManager: EnableEditDel(Data.ItemType); end; } //ToolBar_CompData.Enabled := true; //if Node.IsVisible = false then // Beep; DefineFTraceLength; finally LockTreeAndGrid(false); end; FHandledTVOnChange := true; except on E: Exception do AddExceptionToLog('TF_MAIN.Timer_TreeCatalogChangeTimer: '+E.Message); end; except on E: Exception do AddExceptionToLog('TF_MAIN.Timer_TreeCatalogChangeTimer: '+E.Message); end; Timer_TreeCatalogChange.Tag := 0; end; // ##### Перемещение по папкам ##### procedure TF_MAIN.Tree_CatalogChange(Sender: TObject; Node: TTreeNode); var SCSCompon: TSCSComponent; begin if pcObjects.ActivePage = tsComponents then begin FHandledTVOnChange := false; EnableTimerWithOrder(Timer_TreeCatalogChange, true); try if FSCS_Main.FInteractiveScene = 1 then begin if (GFormMode = fmNormal) and (GDBMode = bkNormBase) then begin if IsComponItemType(PObjectData(Node.Data).ItemType) then begin SCSCompon := nil; SCSCompon := RefreshTreeNodeComponent(Node); if (SCSCompon.ID = 280408) or (SCSCompon.ID = 280410) then begin case FSCS_Main.FInteractiveStep of 4: begin // Восстанавливаем старый обработчик if Assigned(FSCS_Main.FInteractiveMsgOrig) then Application.OnMessage := FSCS_Main.FInteractiveMsgOrig; FSCS_Main.FInteractiveMsgOrig := nil; FSCS_Main.StepInteractive; end; end; end; if (SCSCompon.ID = 280414) then begin case FSCS_Main.FInteractiveStep of 6: begin // Восстанавливаем старый обработчик if Assigned(FSCS_Main.FInteractiveMsgOrig) then Application.OnMessage := FSCS_Main.FInteractiveMsgOrig; FSCS_Main.FInteractiveMsgOrig := nil; FSCS_Main.StepInteractive; end; end; end; end; end; end; except end; end; end; (* // ##### Перемещение по папкам ##### procedure TF_MAIN.Tree_CatalogChange(Sender: TObject; Node: TTreeNode); var Data: PObjectData; //DatComp: PObjectData; Item: TListItem; ID_COMPONENT: Integer; SCSCatal: TSCSCatalog; SCSCompon: TSCSComponent; ComplNode: TTreeNode; CatName: String; SCS_ID: Integer; QueryMode: TQueryMode; IsLine: Boolean; VisibleObjectCurrency: Boolean; procedure CompareComponent; var CatalogNode: TTreeNode; CurrTick, OldTick: Cardinal; begin ID_COMPONENT :=Data.ObjectID; Data := Tree_Catalog.Selected.Parent.Data; SCSCompon := nil; {GSCSBase.SCSComponent.Clear; if GDBMode = bkNormBase then begin OldTick := GetTickCount; GSCSBase.SCSComponent.LoadComponentByID(ID_COMPONENT, false); GSCSBase.SCSComponent.LoadComponentType; GSCSBase.SCSComponent.LoadInterfaces; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel then GSCSBase.SCSComponent.LoadCableCanalConnectors; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then GSCSBase.SCSComponent.LoadCrossConnections; GSCSBase.SCSComponent.LoadChildComplectsQuick(true, true); GSCSBase.SCSComponent.ServAllLoaded := false; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; SCSCompon := GSCSBase.SCSComponent; //OldTick := GetTickCount; //GSCSBase.SCSComponent.LoadComponentByID(ID_COMPONENT, true); //GSCSBase.SCSComponent.LoadChildComplects(true, true); //GSCSBase.SCSComponent.ServAllLoaded := false; //CurrTick := GetTickCount - OldTick; //CurrTick := GetTickCount - OldTick; //SCSCompon := GSCSBase.SCSComponent; //GSCSBase.SCSComponent.LoadCrossConnections; GSCSBase.SCSCatalog.Clear; end else begin SCSCompon := nil; SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(ID_COMPONENT); if Assigned(SCSCompon) then begin //*** Проверить длину цельного кабеля SCSCompon.RefreshWholeLengthIfNecessary; GSCSBase.SCSComponent.AssignOnlyComponent(SCSCompon); GSCSBase.SCSComponent.ProjectOwner := GSCSBase.CurrProject; end; end; } SCSCompon := RefreshTreeNodeComponent(Node); //*** Загрузить папку для тек-й компоненты CatalogNode := GetTargetNodeForItemType(Node, GSCSBase.SCSComponent.GetItemType{можно и itComponLine}, qmUndef); if (CatalogNode <> nil) and (CatalogNode.Data <> nil) then begin if GSCSBase.SCSCatalog.ID <> PObjectData(CatalogNode.Data).ObjectID then case QueryMode of qmPhisical: GSCSBase.SCSCatalog.LoadCatalogByID(PObjectData(CatalogNode.Data).ObjectID, false, false); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(CatalogNode.Data).ObjectID); if Assigned(SCSCatal) then GSCSBase.SCSCatalog.Assign(SCSCatal); end; end; GSCSBase.SCSCatalog.TreeViewNode := CatalogNode; end; DefineLocalCurrency; if Assigned(GSCSBase.SCSComponent) then begin ShowPrice; {GT_Compon_Relation.DataController.DataSource := nil; GT_PROPERTY.DataController.DataSource := nil; GT_INTERFACE.DataController.DataSource := nil; GT_Connections.DataController.DataSource := nil;} DM.SelectCompSub(Node, SCSCompon); {GT_Compon_Relation.DataController.DataSource := DM.DataSource_MT_Complects; GT_PROPERTY.DataController.DataSource := DM.DataSource_MT_Property; GT_INTERFACE.DataController.DataSource := DM.DataSource_MT_InterfaceRel; GT_Connections.DataController.DataSource := DM.DataSource_MT_Connections;} if GDBMode = bkProjectManager then begin //if Not GL_Compon_Relation.Visible then // GL_Compon_Relation.Visible := true; //if Not GL_INTERFACE.Visible then // GL_INTERFACE.Visible := true; //if Not GL_PORT.Visible then // GL_PORT.Visible := true; //if Not GL_Connections.Visible then // GL_Connections.Visible := true; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, true); SetVisibleGridLevel(GL_INTERFACE, tcGridData, true); SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_Connections, tcGridData, true); tcGridData.TabIndex := GActiveLevelIndex; //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); end else begin if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then SetVisibleGridLevel(GL_CrossConnection, tcGridData, true) else SetVisibleGridLevel(GL_CrossConnection, tcGridData, false); //*** подключения в НБ if IsCanNBComponNodeHaveConnection(Node) then SetVisibleGridLevel(GL_Connections, tcGridData, true) else SetVisibleGridLevel(GL_Connections, tcGridData, false); end; if GSCSBase.SCSComponent.IsLine = biTrue then begin GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; SetVisibleGridLevel(GL_PORT, tcGridData, false); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel); //if GL_PORT.Visible then //begin // GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; // SetVisibleGridLevel(GL_PORT, tcGridData, false); //end; //GT_INTERFACEMultiple.Visible := true; //GT_INTERFACEValueI.Visible := true; GT_InterfaceNumPairsStr.Visible := true; //GT_INTERFACEColor.Visible := true; GT_INTERFACESide.Visible := true; end else begin SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, false); //if Not GL_PORT.Visible then //begin // SetVisibleGridLevel(GL_PORT, tcGridData, true); // //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //end; //GT_INTERFACEMultiple.Visible := false; //GT_INTERFACEValueI.Visible := false; GT_InterfaceNumPairsStr.Visible := false; //GT_INTERFACEColor.Visible := false; GT_INTERFACESide.Visible := false; end; GT_NormsResourcesExpenseForLength.Visible := GSCSBase.SCSComponent.IsLine = biTrue; end; if SCSCompon <> nil then IsLine := SCSCompon.IsLine = biTrue; GT_PROPERTYTakeIntoConnect.Visible := true; GT_PROPERTYTakeIntoJoin.Visible := true; end; begin //Exit; //#Del if Tree_Catalog.Focused then ; QueryMode := GetQueryModeByNode(GDBMode, Node, GetQueryModeByGDBMode(GDBMode)); IsLine := False; VisibleObjectCurrency := false; try try LockTreeAndGrid(true); //*** Очистить гриды DM.MemTable_Complects.Active := false; DM.MemTable_Connections.Active := false; DM.MemTable_CrossConnection.Active := false; DM.MemTable_InterfaceRel.Active := false; DM.MemTable_PortInterfRel.Active := false; DM.MemTable_Port.Active := false; DM.mtInterfInternalConn.Active := false; DM.MemTable_Property.Active := false; DM.mtCableCanalConnectors.Active := false; DM.mtNorms.Active := false; DM.mtObjectCurrency.Active := false; if (Node = nil) or (Node.Data = nil) then Exit; ///// EXIT ////// if (GisFindingNode) or (GisDragTree) {or (GWhoChange <> wcTree)} then Exit; ///// EXIT ////// Data := Node.Data; case Data.ItemType of itComponLine, itComponCon: begin EnableDisableCost(true); //PageScroller_Cost.Enabled := true; //EnableControl(PageScroller_Cost, true); if GFormMode <> fmNewFolder then CompareComponent; end; itDir, itProjMan, itProject, itList, itRoom, itSCSLine, itSCSConnector: begin CurrencyEdit_Cost1.Value := 0; CurrencyEdit_Cost2.Value := 0; CurrencyEdit_Price1.Value := 0; CurrencyEdit_Price2.Value := 0; EnableDisableCost(false); //PageScroller_Cost.Enabled := false; //EnableControl(PageScroller_Cost, false); //GSCSBase.SCSCatalog.LoadCatalogByID(Data.ObjectID, false, false); if Assigned(GSCSBase.SCSCatalog) then begin GSCSBase.SCSCatalog.QueryMode := QueryMode; SCSCatal := nil; case QueryMode of qmPhisical: GSCSBase.SCSCatalog.LoadCatalogByID(Data.ObjectID, false, false); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(Data.ObjectID); if Assigned(SCSCatal) then GSCSBase.SCSCatalog.Assign(SCSCatal); end; end; if SCSCatal <> nil then IsLine := (SCSCatal.ItemType = itSCSLine) or (SCSCatal.ItemType = itSCSLineGroup); GSCSBase.SCSCatalog.TreeViewNode := Node; if Assigned(GSCSBase.SCSComponent) then if GDBMode = bkNormBase then GSCSBase.SCSComponent.Clear; end; DM.MemTable_Complects.Active := false; DM.MemTable_InterfaceRel.Active := false; DM.MemTable_Port.Active := false; DM.MemTable_CrossConnection.Active := false; //GT_INTERFACE.DataController.DataSource := nil; CurrencyEdit_Cost1.Text := ''; CurrencyEdit_Cost2.Text := ''; if GDBMode = bkProjectManager then begin if Assigned(GSCSBase.SCSCatalog) then DM.SelectCatalogSub(Node, SCSCatal); // if GSCSBase.SCSCatalog.QueryMode = qmMemory then // DM.SelectCatalogSub(Node); //GT_PROPERTY.DataController.DataSource := DM.DataSource_MT_Property; ToolButton_Add.Action := Act_AddProperty; ToolButton_Change.Action := Act_EditProperty; ToolButton_Remove.Action := Act_RemoveProperty; ToolButton_Add.ImageIndex := 0; ToolButton_Change.ImageIndex := 1; ToolButton_Remove.ImageIndex := 2; //Grid_CompData.PopupMenu := PopupMenu_SUPPLEMENT_DATA; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, false); SetVisibleGridLevel(GL_INTERFACE, tcGridData, false); //if GL_Compon_Relation.Visible then // GL_Compon_Relation.Visible := false; //if GL_INTERFACE.Visible then // GL_INTERFACE.Visible := false; if Data.ItemType in [itSCSConnector, itSCSLine] then begin SetVisibleGridLevel(GL_Connections, tcGridData, true); //if Not GL_Connections.Visible then // GL_Connections.Visible := true; end else SetVisibleGridLevel(GL_Connections, tcGridData, false); //if GL_Connections.Visible then // GL_Connections.Visible := false; if PObjectData(Node.Data).ItemType = itSCSConnector then SetVisibleGridLevel(GL_PORT, tcGridData, true) //GL_PORT.Visible := true else SetVisibleGridLevel(GL_PORT, tcGridData, false); //if GL_PORT.Visible then // GL_PORT.Visible := false; Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); end else begin DM.SelectCatalogSub(Node, nil); DM.MemTable_Property.Active := false; //*** Валюты для папок второго уровня if Node.Level = dirCurrencyLevel then begin VisibleObjectCurrency := true; //DM.SelectCatalogCurrency; end; DefineLocalCurrency; end; GT_PROPERTYTakeIntoConnect.Visible := false; GT_PROPERTYTakeIntoJoin.Visible := false; {if GL_PORT.Visible then begin GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; GL_PORT.Visible := false; end; } //GT_PROPERTY.DataController.DataSource := nil; //DM.SelectCompSub; end; end; if IsLine then GT_INTERFACEMultiple.Caption := CMultipleLineInterface else GT_INTERFACEMultiple.Caption := CMultiplePoinInterface; SetVisibleGridLevel(GL_ObjectCurrency, tcGridData, VisibleObjectCurrency); if VisibleObjectCurrency then tcGridData.TabIndex := GL_ObjectCurrency.Index; //DM.SelectCompSub; //DM.FillMemTableCompl(DM.MemTable_Complects); Data := Node.Data; EnableEditDel(Data.ItemType); //if GWhoChange <> wcTree then {case GDBMode of bkNormBase: if Not GSCSIni.NB.DisableEdit then EnableEditDel(Data.ItemType); bkProjectManager: EnableEditDel(Data.ItemType); end; } //ToolBar_CompData.Enabled := true; //if Node.IsVisible = false then // Beep; finally LockTreeAndGrid(false); end; except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogChange: '+E.Message); end; end; *) procedure TF_MAIN.Tree_CatalogChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean); var //Dat: PObjectData; SCSCatalog: TSCSCatalog; SCSComonent: TSCSComponent; SCSList: TSCSList; TrunkComponent: TSCSComponent; JoinedTrunkComponent: TSCSComponent; TrunkComponobject: TSCSCatalog; // Tolik - -13/05/2017 -- CurrKeyboardState: TShiftState; KeyState: TKeyboardState; // begin if TTreeView(Sender).Tag = 999 then exit; if Node = nil then // Tolik 04/01/2020 exit; // Tolik -- 13/05/2017 -- GetKeyboardState(KeyState); CurrKeyBoardState := KeyboardStateToShiftState(KeyState); AllowChange := FAllowTreeCatalogChange; if AllowChange then begin if (TTreeView(Sender).Selected <> nil) and (TTreeView(Sender).Selected.Data <> nil) and (TTreeView(Sender).Selected <> Node) then begin if not ((ssShift in CurrKeyBoardState) or (ssCTRL in CurrKeyBoardState)) then begin TTreeView(Sender).Tag := 999; TTreeView(Sender).ClearSelection(False); TTreeView(Sender).Selected := Node; TTreeView(Sender).Tag := 0; end; FLastNodeDat := PObjectData(TTreeView(Sender).Selected.Data)^; OnNodeExit(TTreeView(Sender).Selected, Node, true); Timer_Changing.Enabled := true; end; end; { if GDBMode = bkProjectManager then begin if FLastNodeDat.ItemType = itRoom then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(FLastNodeDat.ObjectID); if SCSCatalog <> nil then begin SCSList := SCSCatalog.GetListOwner; if (SCSList <> nil) and SCSList.OpenedInCAD then DeactivateCabinetOnCAD(SCSCatalog.SCSID); end; end; //*** Проверить, нужно ли переопределить кросс объект на КАДе if (FLastNodeDat.ItemType in [itComponCon, itComponLine]) and Not(PObjectData(Node.Data).ItemType in [itComponCon, itComponLine]) then begin TrunkComponent := nil; SCSComonent := GSCSBase.CurrProject.GetComponentFromReferences(FLastNodeDat.ObjectID); if SCSComonent <> nil then begin if IsTrunkComponent(SCSComonent) then TrunkComponent := SCSComonent else begin JoinedTrunkComponent := GetJoinedTrunkComponent(SCSComonent); if JoinedTrunkComponent <> nil then TrunkComponent := JoinedTrunkComponent; end; if TrunkComponent <> nil then begin TrunkComponobject := TrunkComponent.GetFirstParentCatalog; if TrunkComponobject <> nil then if dopTrunkChanged in TrunkComponobject.ServToDefineObjParams then begin BeginProgress; try F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(TrunkComponent, true); finally EndProgress; end; end; end; end; end; end; } {Dat := Node.Data; case Dat.ItemType of itComponLine, itComponCon: PageScroller_Cost.Visible := true; itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: PageScroller_Cost.Visible := false; end;} end; // ##### Click по ветви (Показать рисунок) ##### procedure TF_MAIN.Tree_CatalogClick(Sender: TObject); Var Node: TTreeNode; Obj: PObjectData; PosXYBySrc: TPoint; PosXY: TPoint; X: Integer; Y: Integer; // Tolik - -13/05/2017 -- CurrKeyboardState: TShiftState; KeyState: TKeyboardState; // begin // Tolik -- 13/05/2017 -- GetKeyboardState(KeyState); CurrKeyBoardState := KeyboardStateToShiftState(KeyState); // GetCursorPos(PosXYBySrc); PosXY := Tree_catalog.ScreenToClient(PosXYBySrc); Node := Tree_Catalog.GetNodeAt(PosXY.X, PosXY.Y); //Tolik -- 13/05/2017 -- if GDBMode = bkProjectManager then begin CheckCloseReportForm; // Toilk 30/04/2021 -- //F_ProjMan.Tree_Catalog.MultiSelectStyle := []; if not ((ssShift in CurrKeyBoardState) or (ssCTRL in CurrKeyBoardState)) then begin // НЕ нужно тут єто делать так как єто вызывается после всех обработок дерева когда уже к примеру // свернулась ветка - и соотв. Tree_Catalog.GetNodeAt(PosXY.X, PosXY.Y); может вернуть не тот уже совсем НОД по // которому кликнули... // и потому ClearSelection(False) перенесен в Tree_CatalogChanging //if node <> nil then // F_ProjMan.Tree_Catalog.ClearSelection(False); { if ((ssShift in CurrKeyBoardState) and (ssCTRL in CurrKeyBoardState)) then F_ProjMan.Tree_Catalog.MultiSelectStyle := [msControlSelect, msShiftSelect] else if (ssCTRL in CurrKeyBoardState) then F_ProjMan.Tree_Catalog.MultiSelectStyle := [msControlSelect] else if (ssShift in CurrKeyBoardState) then F_ProjMan.Tree_Catalog.MultiSelectStyle := [msShiftSelect]; F_ProjMan.Tree_Catalog.MultiSelect := True;} end; end; // if node <> nil then begin // НЕ нужно тут єто делать так как єто вызывается после всех обработок дерева когда уже к примеру // свернулась ветка - и соотв. Tree_Catalog.GetNodeAt(PosXY.X, PosXY.Y); может вернуть не тот уже совсем НОД по // которому кликнули... //F_ProjMan.Tree_Catalog.Selected := Node; // да и это не очень здесь правильно из-за читай выше, но пока оставил как было FTreeClickNode := Node; end; //if (Node <> nil) and (Node.Selected) {and (Node <> GLastNode)} then //begin // GLastNode := Node; //end; //Tolik 15/05/2017 -- (*Node.Selected := True; if (Node <> nil) and (Node.Selected) {and (Node <> GLastNode)} then begin F_ProjMan.Tree_Catalog.select(Node, CurrKeyBoardState) end; *) // end; // ##### Двойной Click по ветви ##### procedure TF_MAIN.Tree_CatalogDblClick(Sender: TObject); var Dat: PObjectData; CurrNode: TTreeNode; CurrPoint: TPoint; HitTests: THitTests; begin try WaitForTVChange; GetCursorPos(CurrPoint); CurrPoint := Tree_Catalog.ScreenToClient(CurrPoint); //CurrNode := Tree_Catalog.GetNodeAt(CurrPoint.X, CurrPoint.Y); HitTests := Tree_Catalog.GetHitTestInfoAt(CurrPoint.X, CurrPoint.Y); //*** Убрать сворачивание/разворачивание при двойном клике, если чтото вызывается if (FTreeClickNode <> nil) and (Tree_Catalog.Selected = FTreeClickNode) and Not CanExpandOnDoubleClick(Tree_Catalog.Selected) then begin Tree_Catalog.Items.BeginUpdate; Tree_Catalog.Selected.Expanded := Not Tree_Catalog.Selected.Expanded; Tree_Catalog.Items.EndUpdate; end; Act_HideHints.Execute; CurrNode := nil; Dat := nil; if Not Assigned(FTreeClickNode) then FTreeClickNode := Tree_Catalog.Selected; CurrNode := FTreeClickNode; if CurrNode = nil then Exit; //// EXIT //// if Not (htOnButton in HitTests) then OpenNode(CurrNode); //if Not OpenNode(CurrNode) then // Tree_Catalog.Selected.Expanded := Not Tree_Catalog.Selected.Expanded; Dat := CurrNode.Data; except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogDblClick: '+E.Message); end; end; procedure TF_MAIN.Tree_CatalogGetImageIndex(Sender: TObject; Node: TTreeNode); begin //Node.SelectedIndex := Node.ImageIndex; if PObjectData(Node.Data).ItemType in [itDir, itProjMan] then begin if Node.Expanded then Node.ImageIndex := tciiDirOpened else Node.ImageIndex := tciiDir; Node.SelectedIndex := Node.ImageIndex; end; end; // ##### Получить текущий индекс ##### procedure TF_MAIN.Tree_CatalogGetSelectedIndex(Sender: TObject; Node: TTreeNode); begin //Node.SelectedIndex := Node.ImageIndex; end; // ##### Перемещение по комплектующим ##### procedure TF_MAIN.GT_Compon_RelationFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); var ID_CompRel: Integer; ComponNode: TTreeNode; ComplNode: TTreeNode; NodeDat: PObjectData; begin //ID_CompRel := DM.MemTable_Complects.FieldByName('ID').AsInteger; //SearchRecord(DM.DataSet_Component_Relation, 'ID', ID_CompRel); {if Not(GisAddEditingComplect) and (GWhoChange = wcGrid) then begin ID_CompRel := DM.MemTable_Complects.FieldByName('ID').AsInteger; SearchRecord(DM.DataSet_Component_Relation, 'ID', ID_CompRel); //*** Выйти на эту комплектющую в дереве в текущей папке ComplNode := Tree_Catalog.Selected; //*** Выйти на компоненту, если это комплектующая if GDBMode = bkNormBase then while PObjectData(ComplNode.Data).ComponKind <> ckCompon do ComplNode := ComplNode.Parent else ComplNode := ComplNode.Parent; ComponNode := ComplNode; ComplNode := ComplNode.GetFirstChild; while ComplNode <> nil do begin if PObjectData(ComplNode.Data).ID_CompRel = ID_CompRel then begin Tree_Catalog.Selected := Complnode; Break; end; ComplNode := ComplNode.getNextSibling; end; end; } end; procedure TF_MAIN.GT_InterfaceFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); //var ID_InterfRel: Integer; begin //ID_InterfRel := DM.MemTable_InterfaceRel.FieldByName('ID').AsInteger; {if ID_InterfRel > 0 then DM.FillMemTableIOfIRel(ID_InterfRel); } //SearchRecord(DM.pFIBDataSet1, 'ID', ID_InterfRel); end; // ##### Поле "Вид интерфейса отобразить словами" ##### procedure TF_MAIN.GT_InterfaceTYPEGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg31_1; if AText = '1' then AText := cMain_Msg31_2; end; procedure TF_MAIN.GT_InterfaceKindGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg32_1; if AText = '1' then AText := cMain_Msg32_2; end; procedure TF_MAIN.GT_InterfaceValueIGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33 else AText := GetDisplayTextInFLoatUOMMin2(AText, FUOM); end; procedure TF_MAIN.GT_InterfaceNumPairsStrGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33; end; procedure TF_MAIN.GT_InterfaceSideGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33; end; procedure TF_MAIN.Timer_SelectNodeAtCursorTimer(Sender: TObject); //var // TargetNode : TTreeNode; // PosScr: TPoint; // PosTree: TPoint; begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then Exit; ///// EXIT ///// EnableTimerWithOrder(TTimer(Sender), false); SelectNodeAtCursor; //GetCursorPos(PosScr); // PosTree := Tree_Catalog.ScreenToClient(PosScr); // // TargetNode := Tree_Catalog.GetNodeAt(PosTree.X, PosTree.Y); // if TargetNode <> nil Then // begin // //TargetNode.SelectedIndex := TargetNode.ImageIndex; // Screen.Cursor := crHourGlass; // try // Tree_Catalog.Selected := TargetNode; // finally // Screen.Cursor := crDefault; // end; // end; end; // Tolik 08/06/2021 -- сиарая закомменчена - см ниже // ##### Помечание ветви при Клике правой кнопкой ##### procedure TF_MAIN.Tree_CatalogMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TargetNode : TTreeNode; //HitTests: THitTests; begin //ShowMessage('M_Down'); if GDBMOde = bkProjectManager then CheckCloseReportForm; // Toilk 30/04/2021 -- FTreeMouseDownNode := Tree_Catalog.GetNodeAt(X, Y); if Button = mbLeft then begin //HitTests := Tree_Catalog.GetHitTestInfoAt(X, Y); //02.02.2011 Если клик по кнопке развернуть/свернуть //Tolik 15/06/2021 -- //if (GetTickCount - FTreeNodeExpandTick) < 50 then //if (htOnButton in HitTests) or (htOnIndent in HitTests) then begin Try // Tolik 15/08/2021 -- if Assigned(FTreeExpandNode) then begin if FTreeExpandNode.ClassName <> 'TTreeNode' then FTreeExpandNode := nil else begin if FTreeExpandNode.Expanded then //02.02.2011 Expanded = true, так как событие OnExpanding происходит раньше MouseDown begin begin if PObjectData(FTreeExpandNode.Data).ItemType = itList then //02.02.2011 - пока что только после раскрытия листа, так как на нем подгружаются группы - после чего нод не виден if FTreeExpandNode.Count <> FTreeExpandNodeCountBefore then //02.02.2011 - Если на растрытии было изменен состав чилдов - характерно для листа begin FTreeNodeToShow := FTreeExpandNode; Timer_NodeShow.Enabled := true; end; end; end; end; end; Except // Tolik 15/08/2021 -- on E: Exception do begin FTreeNodeToShow := nil; FTreeExpandNode := nil; end; End; end; end else if Button = mbRight then begin SelectNodeAtCursor; //EnableTimerWithOrder(Timer_SelectNodeAtCursor, true); end; //30.08.2007 {TargetNode := Tree_Catalog.GetNodeAt(X, Y); if TargetNode <> nil Then begin //TargetNode.SelectedIndex := TargetNode.ImageIndex; if Button = mbRight then begin Screen.Cursor := crHourGlass; try Tree_Catalog.Selected := TargetNode; finally Screen.Cursor := crDefault; end; end; end;} end; // (* // ##### Помечание ветви при Клике правой кнопкой ##### procedure TF_MAIN.Tree_CatalogMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var TargetNode : TTreeNode; //HitTests: THitTests; begin //ShowMessage('M_Down'); if GDBMOde = bkProjectManager then CheckCloseReportForm; // Toilk 30/04/2021 -- FTreeMouseDownNode := Tree_Catalog.GetNodeAt(X, Y); if Button = mbLeft then begin //HitTests := Tree_Catalog.GetHitTestInfoAt(X, Y); //02.02.2011 Если клик по кнопке развернуть/свернуть //Tolik 15/06/2021 -- //if (GetTickCount - FTreeNodeExpandTick) < 50 then //if (htOnButton in HitTests) or (htOnIndent in HitTests) then begin if Assigned(FTreeExpandNode) and FTreeExpandNode.Expanded then //02.02.2011 Expanded = true, так как событие OnExpanding происходит раньше MouseDown if PObjectData(FTreeExpandNode.Data).ItemType = itList then //02.02.2011 - пока что только после раскрытия листа, так как на нем подгружаются группы - после чего нод не виден if FTreeExpandNode.Count <> FTreeExpandNodeCountBefore then //02.02.2011 - Если на растрытии было изменен состав чилдов - характерно для листа begin FTreeNodeToShow := FTreeExpandNode; Timer_NodeShow.Enabled := true; end; end; end else if Button = mbRight then begin SelectNodeAtCursor; //EnableTimerWithOrder(Timer_SelectNodeAtCursor, true); end; //30.08.2007 {TargetNode := Tree_Catalog.GetNodeAt(X, Y); if TargetNode <> nil Then begin //TargetNode.SelectedIndex := TargetNode.ImageIndex; if Button = mbRight then begin Screen.Cursor := crHourGlass; try Tree_Catalog.Selected := TargetNode; finally Screen.Cursor := crDefault; end; end; end;} end; *) procedure TF_MAIN.Timer_TreePopupMenuTimer(Sender: TObject); var PosXYByScr: TPoint; TimerNodeHintEnabled: Boolean; TimerRefreshNodeEnabled: Boolean; TimerTreeCatalogChangeEnabled: Boolean; TimerSelectNodeAtCursorEnabled: Boolean; begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then Exit; ///// EXIT ///// EnableTimerWithOrder(TTimer(Sender), false); GetCursorPos(PosXYByScr); //*** Запрет таймеров устранит мерцание TimerNodeHintEnabled := Timer_NodeHint.Enabled; TimerRefreshNodeEnabled := Timer_RefreshNode.Enabled; TimerTreeCatalogChangeEnabled := Timer_TreeCatalogChange.Enabled; TimerSelectNodeAtCursorEnabled := Timer_SelectNodeAtCursor.Enabled; Timer_NodeHint.Enabled := false; Timer_RefreshNode.Enabled := false; Timer_TreeCatalogChange.Enabled := false; Timer_SelectNodeAtCursor.Enabled := false; PopupMenu_Catalog.Popup(PosXYByScr.X, PosXYByScr.Y); Timer_NodeHint.Enabled := TimerNodeHintEnabled; Timer_RefreshNode.Enabled := TimerRefreshNodeEnabled; Timer_TreeCatalogChange.Enabled := TimerTreeCatalogChangeEnabled; Timer_SelectNodeAtCursor.Enabled := TimerSelectNodeAtCursorEnabled; end; // Tolik 15/06/2021 -- старая закомменчена -- смотри ниже --- procedure TF_MAIN.Tree_CatalogMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var PosXYByScr: TPoint; PosXY: TPoint; Node: TTreeNode; Obj: PObjectData; st: smallint; SelList: TList; i: integer; // Tolik 18/06/2021 -- function CheckSelected(aNode: TtreeNode): Boolean; var i: integer; ChildNode: TTreeNode; begin Result := aNode.Selected; if Result then exit; ChildNode := aNode.getFirstChild; while ChildNode <> nil do begin Result := CheckSelected(ChildNode); if Result then break; ChildNode := ChildNode.getNextSibling; end; end; Procedure SelectCadFigure(aNode: TTreeNode); var Figure: TFigure; FigCatalog: TSCSCatalog; Component: TSCSComponent; List: TSCSList; FigureCad: TF_Cad; CatalogNode: TTreeNode; begin if GCadForm = nil then exit; Figure := nil; FigCatalog := nil; Component := nil; Obj := PObjectData(aNode.Data); {case Obj.ItemType of itDir, itSCSLine, itSCSConnector: begin FigCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(Obj.ObjectID); end; itComponent, itComponLine, itComponCon : begin Component := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(Obj.ObjectID); if Component <> nil then FigCatalog := Component.GetFirstParentCatalog; end; end;} if Obj.ItemType in [itDir, itSCSLine, itSCSConnector] then begin FigCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferences(Obj.ObjectID); end else if Obj.ItemType in [itComponent, itComponLine, itComponCon] then begin Component := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(Obj.ObjectID); if Component <> nil then FigCatalog := Component.GetFirstParentCatalog; end; if FigCatalog <> nil then begin CatalogNode := FigCatalog.TreeViewNode; if CatalogNode <> nil then begin //if CheckSelected(CatalogNode) = aNode.Selected then Figure := GetFigureByID(GCadForm, FigCatalog.SCSID); end; end; if Figure <> nil then begin //Figure.Selected := ANode.Selected; Figure.Selected := True; //GCadForm.PCad.RefreshSelection; //GCadForm.PCad.ReDrawSelectionPoints; //GCadForm.PCad.Refresh; (* if aSelect then SwitchInCAD(Node, ccOne, False) else begin Figure.Selected := aSelect; {GCadForm.PCad.RefreshSelection; GCadForm.PCad.ReDrawSelectionPoints;} GCadForm.PCad.Refresh; end; *) end; end; // begin SelList := nil; if TTreeView(Sender).Dragging then begin Node := nil; exit; end; st := GetAsyncKeyState(VK_LBUTTON); // Если был начат драг - выходим // Правда эта же проверка срабатывает при кликах на + - в дереве if st < 0 then begin Node := nil; exit; end; Act_HideHints.Execute; PosXY.X := X; PosXY.Y := Y; PosXYByScr := PosXY; GetCursorPos(PosXYByScr); Node := FTreeMouseDownNode; // Tolik 03/05/2017 -- если ткнули на пустом месте, чтобы не було ошибки -- нах отсюда! if Node = nil then exit; // RememberIDLastNBDir(Node); //if Button = mbRight then begin if Self.GDBMode = bkProjectManager then begin SelList := TList.Create; F_ProjMan.Tree_Catalog.GetSelections(SelList); end; end; // Если изменился текущий Ноуд {if (FPrevSelectedNodeDat.ObjectID <> PObjectData(Node.Data).ObjectID) or (FPrevSelectedNodeDat.ItemType <> PObjectData(Node.Data).ItemType) or (FPrevSelectionCount <> Tree_Catalog.SelectionCount) then begin Act_DeselectSelectComponInCAD.Execute; if Node <> nil then begin // Tolik 18/06/2021 -- //SwitchInCAD(Node, ccOne); SwitchInCAD(Node, ccOne, false); // if Not Tree_Catalog.Focused then Tree_Catalog.SetFocus; end; end; } if Self.GDBMode = bkProjectManager then begin //Tolik 27/09/2021 -- if (FPrevSelectedNodeDat.ObjectID <> PObjectData(Node.Data).ObjectID) or (FPrevSelectedNodeDat.ItemType <> PObjectData(Node.Data).ItemType) or (FPrevSelectionCount <> Tree_Catalog.SelectionCount) then begin Act_DeselectSelectComponInCAD.Execute; if Node <> nil then begin // Tolik 18/06/2021 -- //SwitchInCAD(Node, ccOne); SwitchInCAD(Node, ccOne, false); // if Not Tree_Catalog.Focused then Tree_Catalog.SetFocus; end; end; if SelList <> nil then begin F_ProjMan.Tree_catalog.Tag := 999; //Node.Selected := False; //F_ProjMan.SelectNodeDirect(Node); if Node.Selected then // 18/06/2021 -- Tolik -- тут переставить указатель дерева на текущий ноуд begin if SelList.indexOf(Node) <> -1 then begin SelList.Remove(Node); SelList.Add(Node); end; Obj := PObjectData(Node.Data); if Obj.ItemType = itList then begin if SelList.Count = 1 then begin if Button = mbLeft then begin SwitchInCAD(Node, ccOne, false); if Not Tree_Catalog.Focused then Tree_Catalog.SetFocus; SelList.Free; F_ProjMan.Tree_Catalog.Tag := 0; Timer_ChangingTimer(Timer_Changing); exit; end; end; end; end; //SelList.Remove(Node); //SelList.Add(Node); if Assigned(GCadForm) then GCadForm.PCad.DeselectAll(2); //SelectCadFigure(Node.Selected); //18/06/2021 -- Tolik -- Select/Unselect Figure on Cad F_ProjMan.Tree_Catalog.Items.BeginUpdate; F_ProjMan.Tree_Catalog.ClearSelection; for i := 0 to SelList.Count - 1 do begin SelectCadFigure(TTreeNode(SelList[i])); //18/06/2021 -- Tolik -- Select/Unselect Figure on Cad if not TTreeNode(SelList[i]).Selected then F_ProjMan.Tree_Catalog.Select(TTreeNode(selList[i]), [ssCtrl, ssLeft]); end; F_ProjMan.Tree_Catalog.Items.EndUpdate; if Assigned(GCadForm) then begin GCadForm.PCad.RefreshSelection; GCadForm.PCad.ReDrawSelectionPoints; end; // F_ProjMan.Tree_Catalog.Selected := Node; F_ProjMan.Tree_Catalog.Tag := 0; end; end; if SelList <> nil then SelList.Free; if Button = mbRight then begin {if Self.GDBMode = bkProjectManager then begin if SelList <> nil then begin F_ProjMan.Tree_catalog.Tag := 999; Node.Selected := False; //F_ProjMan.SelectNodeDirect(Node); SelList.Remove(Node); SelList.Add(Node); for i := 0 to SelList.Count - 1 do begin if not TTreeNode(SelList[i]).Selected then F_ProjMan.Tree_Catalog.Select(TTreeNode(selList[i]), [ssCtrl]); end; // F_ProjMan.Tree_Catalog.Selected := Node; F_ProjMan.Tree_Catalog.Tag := 0; end; end; if SelList <> nil then SelList.Free; } EnableEditDel(itAuto); if Assigned(PopupMenu_Catalog) then begin EnableTimerWithOrder(Timer_TreePopupMenu, true); end; end; Timer_ChangingTimer(Timer_Changing); end; (* procedure TF_MAIN.Tree_CatalogMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var PosXYByScr: TPoint; PosXY: TPoint; Node: TTreeNode; Obj: PObjectData; st: smallint; //TimerNodeHintEnabled: Boolean; //TimerRefreshNodeEnabled: Boolean; //TimerTreeCatalogChangeEnabled: Boolean; //TimerSelectNodeAtCursorEnabled: Boolean; begin if TTreeView(Sender).Dragging then begin Node := nil; exit; end; st := GetAsyncKeyState(VK_LBUTTON); // Если был начат драг - выходим // Правда эта же проверка срабатывает при кликах на + - в дереве if st < 0 then begin Node := nil; exit; end; //ShowMessage('M_UP'); //TMyTreeView(Sender).MouseButtonAfterUp := Button; Act_HideHints.Execute; //Application.ProcessMessages; PosXY.X := X; PosXY.Y := Y; //PosXYByScr := TTreeView(Sender).ClientToScreen(PosXY); PosXYByScr := PosXY; GetCursorPos(PosXYByScr); //Node := Tree_Catalog.Selected; Node := FTreeMouseDownNode; // Tolik 03/05/2017 -- если ткнули на пустом месте, чтобы не було ошибки -- нах отсюда! if Node = nil then exit; // RememberIDLastNBDir(Node); // Если изменился текущий Ноуд if (FPrevSelectedNodeDat.ObjectID <> PObjectData(Node.Data).ObjectID) or (FPrevSelectedNodeDat.ItemType <> PObjectData(Node.Data).ItemType) or (FPrevSelectionCount <> Tree_Catalog.SelectionCount) then begin Act_DeselectSelectComponInCAD.Execute; if Node <> nil then begin SwitchInCAD(Node, ccOne); if Not Tree_Catalog.Focused then Tree_Catalog.SetFocus; end; //FPrevSelectedNodeDat := PObjectData(Node.Data)^; end; if Button = mbRight then begin //*** Ветвь должна быть плдгружена //FHandledTVOnChange := false; //WaitForTVChange; //SwitchInCAD(Tree_catalog.Selected, ccOne); //Tree_catalog.Selected.c EnableEditDel(itAuto); if Assigned(PopupMenu_Catalog) then begin //Application.ProcessMessages; EnableTimerWithOrder(Timer_TreePopupMenu, true); {31.08.2007 //*** Запрет таймеров устранит мерцание TimerNodeHintEnabled := Timer_NodeHint.Enabled; TimerRefreshNodeEnabled := Timer_RefreshNode.Enabled; TimerTreeCatalogChangeEnabled := Timer_TreeCatalogChange.Enabled; TimerSelectNodeAtCursorEnabled := Timer_SelectNodeAtCursor.Enabled; Timer_NodeHint.Enabled := false; Timer_RefreshNode.Enabled := false; Timer_TreeCatalogChange.Enabled := false; Timer_SelectNodeAtCursor.Enabled := false; PopupMenu_Catalog.Popup(PosXYByScr.X, PosXYByScr.Y); Timer_NodeHint.Enabled := TimerNodeHintEnabled; Timer_RefreshNode.Enabled := TimerRefreshNodeEnabled; Timer_TreeCatalogChange.Enabled := TimerTreeCatalogChangeEnabled; Timer_SelectNodeAtCursor.Enabled := TimerSelectNodeAtCursorEnabled;} end; end; Timer_ChangingTimer(Timer_Changing); end; *) // ##### Подставление Edit-а в Grid ##### procedure TF_MAIN.GT_PROPERTYVALUEGetProperties( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AProperties: TcxCustomEditProperties); begin if ARecord.Values[6] <> null then with DM do begin case ARecord.Values[6] of dtBoolean: AProperties := EditRepositoryCheckBoxItem.Properties; //dtFloat: // AProperties := EditRepositorySpinItem.Properties; //dtDate: // AProperties := EditRepositoryDateItem.Properties; dtCompStateType: AProperties := EditRepositoryLookupCompSateType.Properties; dtColor: AProperties := EditRepositoryColorComboBox.Properties; dtCableCanalElementType: AProperties := EditRepositoryLookupCableCanalElementType.Properties; //dtSectionSide: // AProperties := EditRepositoryMaskItemSectionSide.Properties; //dtStringList: // AProperties := EditRepositoryMemo.Properties; end; end; end; procedure TF_MAIN.GT_PROPERTYVALUEGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); //var // CurrFloat: Double; var DoSetDisplay: boolean; // IGOR 04/07/2019 -- begin // IGOR 04/07/2019 -- DoSetDisplay := True; if ARecord.Values[6] <> null then begin if (ARecord.Values[6] = dtBoolean) or (ARecord.Values[6] = dtCompStateType) or (ARecord.Values[6] = dtColor) or (ARecord.Values[6] = dtCableCanalElementType) then DoSetDisplay := False; end; if DoSetDisplay then // SetDisplayTextToGridTablePropValue(AText, ARecord, 6, 7, FUOM); {if ARecord.Values[6] <> null then case ARecord.Values[6] of dtFloat: try CurrFloat := StrToFloatU(AText); if GPropSysNameInUOM.IndexOf(ARecord.Values[7]) <> -1 then CurrFloat := RoundCP(FloatInUOM(CurrFloat, umMetr, FUOM)); AText := FloatToStr(CurrFloat); except end; dtDate: try AText := DateToStr(StrToDateU(AText)); except end; end;} end; // ################################### Main Menu #################################### // ################################################################################## // // ##### Выход ##### procedure TF_MAIN.mnu_ExitClick(Sender: TObject); begin Close; end; procedure TF_MAIN.Tree_CatalogBeforeMoveNode(Sender: TObject; Source, Destination: TTreeNode; Mode: TNodeAttachMode); var SrcParent: TTreeNode; SrcParentDat: PObjectData; begin if Mode in [naAddChild, naAddChildFirst] then begin SrcParent := Source.Parent; SrcParentDat := nil; if (SrcParent <> nil) and (SrcParent.Count = 1) then begin SrcParentDat := SrcParent.Data; //if SrcParentDat <> nil then // SrcParentDat.HasChildren := false; end; end; end; // ##### Открыть Валюты ##### procedure TF_MAIN.mnu_CurrencyClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkCurrency; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Открыть Типы сетей ##### procedure TF_MAIN.mnu_NetTypeClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkNetType; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Открыть интерфейсы ##### procedure TF_MAIN.mnu_InterfaceClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkInterface; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; DM.SelectInterfaces(Tree_Catalog.Selected); } end; // ##### Таблица соответствий интерфейсов ##### procedure TF_MAIN.pmnu_DA_InterfaceAccordanceClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkInterfaceAccordance; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Открыть свойства ##### procedure TF_MAIN.mnu_PropertyClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkProperty; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; DM.SelectComponProperty; } end; // ##### Открыть Условные обозначения ##### procedure TF_MAIN.mnu_CompStateTypeClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkObjectIcons; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Производители ##### procedure TF_MAIN.Act_GuideProducersExecute(Sender: TObject); begin { F_CaseForm.GViewKind := vkProducers; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Типы компонентов ###### procedure TF_MAIN.Act_GuideComponentTypesExecute(Sender: TObject); begin { F_CaseForm.GViewKind := vkComponentType; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Открыть нормы ##### procedure TF_MAIN.mnu_NormsClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkNorm; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Открыть ресурсы ##### procedure TF_MAIN.mnu_ResourcesClick(Sender: TObject); begin { F_CaseForm.GViewKind := vkResource; F_CaseForm.GFormMode := fmView; F_CaseForm.ShowModal; } end; // ##### Выбор НДС ##### procedure TF_MAIN.mnu_NDSClick(Sender: TObject); { var OldNDS: Double; ID_Component : Integer; FldList: TStringList; function GetNewPrice(APrice: Double): Double; var ChPrice: Double; begin ChPrice := APrice - APrice * (OldNDS / (100 + OldNDS) ); // Цена без НДС ChPrice := ChPrice + ChPrice * (GNDS / 100); Result := ChPrice; end; procedure RefreshPriceFields(AFormBase: TForm; ATableName: String; APriceFields: TStringList); var IDList: TList; i, j: Integer; CurrID: Integer; PriceValue: Double; begin try try with TF_Main(AFormBase).DM do begin IDList := TList.Create; SetSQLToQuery(scsQSelect, ' select id from '+ATableName+' '); IntFieldToList(IDList, scsQSelect, 'id'); for i := 0 to APriceFields.Count - 1 do begin scsQSelect.Close; scsQSelect.SQL.Clear; scsQSelect.SQL.Add(' select '+APriceFields.Strings[i]+' from '+ATableName+ ' where id = :id '); scsQOperat.Close; scsQOperat.SQL.Clear; scsQOperat.SQL.Add(' update '+ATableName+' set '+ APriceFields.Strings[i]+' = :PriceValue '+ ' where id = :id '); for j := 0 to IDList.Count - 1 do begin CurrID := Integer(IDList.Items[j]^); scsQSelect.Close; scsQSelect.SetParamAsInteger('id', CurrID); scsQSelect.ExecQuery; PriceValue := 0; PriceValue := scsQSelect.GetFNAsFloat(APriceFields.Strings[i]); PriceValue := GetNewPrice(PriceValue); PriceValue := RoundX(PriceValue, 7); scsQOperat.Close; scsQOperat.SetParamAsFloat('PriceValue', PriceValue); scsQOperat.SetParamAsInteger('id', CurrID); scsQOperat.ExecQuery; end; end; end; except on E: Exception do AddExceptionToLog('TF_ActiveCurrency.RefreshPriceFields: '+E.Message); end; finally FreeList(IDList); end; end; } begin {OldNDS := GNDS; F_NDS.GValue := GNDS; if F_NDS.ShowModal = mrOK then if OldNDS <> F_NDS.GValue then begin GNDS := F_NDS.GValue; Screen.Cursor := crHourGlass; FldList := TStringList.Create; FldList.Add('price'); FldList.Add('price_calc'); RefreshPriceFields(TForm(F_NormBase), 'component', FldList); RefreshPriceFields(TForm(F_ProjMan), 'component', FldList); FProjectMan.Tree_Catalog.OnChange(FProjectMan.Tree_Catalog, FProjectMan.Tree_Catalog.Selected); FNormBase.Tree_Catalog.OnChange(FNormBase.Tree_Catalog, FNormBase.Tree_Catalog.Selected); Screen.Cursor := crDefault; FreeAndNil(FldList); end; } end; // ##### Раскрытие контекстного меню дерева ##### procedure TF_MAIN.PopupMenu_CatalogPopup(Sender: TObject); begin EnableDisablePopupMenuCatalogItems; end; procedure TF_MAIN.PopupMenu_ComponDataPopup(Sender: TObject); var DatNode: PObjectData; MemTable_InterfOrPort: TkbmMemTable; IsBusyFunctionalInterface: Boolean; Compon: TSCSComponent; Interf: TSCSInterface; pmiInterfPathVisible: Boolean; begin CheckCloseReportForm; // Tolik 05/05/2021 -- DatNode := Tree_Catalog.Selected.Data; pmiInterfPathVisible := false; Compon := GetActualSelectedComponent; Interf := nil; //*** Если открыта вкладка с соединениями if (Grid_CompData.ActiveLevel.Index = cdliConnections) {and (GDBMode = bkProjectManager)} then begin pmnu_ComponDataL1.Visible := true; Act_GoToConnectCompon.Visible := true; end else begin pmnu_ComponDataL1.Visible := false; Act_GoToConnectCompon.Visible := false; end; { //*** Если открыта вкладка со свойствами листа Act_ApplyPropHeightForObjects.Visible := false; if (DatNode.ItemType = itList) and (Grid_CompData.ActiveLevel.Index = 1) and (GDBMode = bkProjectManager) then begin if (DM.MemTable_Property.FieldByName('sysname').AsString = pnHeightRoom) or (DM.MemTable_Property.FieldByName('sysname').AsString = pnHeightCeiling) or (DM.MemTable_Property.FieldByName('sysname').AsString = pnHeightSocket) then Act_ApplyPropHeightForObjects.Visible := true; end; } // Tolik if (((Grid_CompData.ActiveLevel.Index = cdliProperty) and (GDBMode = bkProjectManager)) and (DM.MemTable_Property.RecordCount > 0)) then Act_SelAllWithSimilarProps.Enabled := true else Act_SelAllWithSimilarProps.Enabled := false; // Act_DublicatePortInterface.Visible := false; Act_TurnFromMemTableToSpravochnik.Visible := false; Act_TurnToConnectedComponByInterf.Visible := false; Act_TurnToConnectedComponByPort.Visible := false; Act_FreeMultipleInterface.Visible := false; Act_FindComponInNBFromComponData.Visible := false; //*** Если открыта вкладка с интерфейсами if (Grid_CompData.ActiveLevel.Index in [cdliInterface, cdliPort]) then begin MemTable_InterfOrPort := nil; case Grid_CompData.ActiveLevel.Index of cdliInterface: MemTable_InterfOrPort := DM.MemTable_InterfaceRel; cdliPort: MemTable_InterfOrPort := DM.MemTable_Port; end; Act_TurnFromMemTableToSpravochnik.Visible := true; Act_TurnFromMemTableToSpravochnik.Enabled := false; Act_DublicatePortInterface.Visible := true; Act_DublicatePortInterface.Enabled := false; if MemTable_InterfOrPort <> nil then if MemTable_InterfOrPort.Active then if MemTable_InterfOrPort.RecordCount > 0 then begin Act_TurnFromMemTableToSpravochnik.Enabled := true; Act_DublicatePortInterface.Enabled := true; end; if GDBMode = bkProjectManager then begin Act_FreeMultipleInterface.Visible := true; case Grid_CompData.ActiveLevel.Index of cdliInterface: Act_TurnToConnectedComponByInterf.Visible := true; cdliPort: begin Act_TurnToConnectedComponByPort.Visible := true; Act_TurnToConnectedComponByPort.Enabled := (DM.MemTable_Port.FieldByName(fnIDConnected).AsInteger > 0); end; end; if MemTable_InterfOrPort <> nil then if MemTable_InterfOrPort.Active = true then begin if Compon <> nil then Interf := Compon.GetInterfaceByID(MemTable_InterfOrPort.FieldByName(fnID).AsInteger); IsBusyFunctionalInterface := false; IsBusyFunctionalInterface := (MemTable_InterfOrPort.FieldByName(fnIsBusy).AsInteger <> biFalse) and (MemTable_InterfOrPort.FieldByName(fnTypeI).AsInteger = itFunctional); Act_TurnToConnectedComponByInterf.Enabled := IsBusyFunctionalInterface; Act_FreeMultipleInterface.Enabled := IsBusyFunctionalInterface; if CheckSysNameIsCable(GSCSBase.SCSComponent.ComponentType.SysName) and (Grid_CompData.ActiveLevel.Index = cdliInterface) and Assigned(Interf) then if IsBusyFunctionalInterface then begin if LoadInterfPositionsToMenuItem(pmiInterfPath, Interf, OnpmiInterfPathClick) then pmiInterfPathVisible := true; end; end; end; end else if (Grid_CompData.ActiveLevel.Index = cdliCableChannelElements) or (Grid_CompData.ActiveLevel.Index = cdliNormsResources) then begin if GDBMode = bkNormBase then Act_FindComponInNBFromComponData.Caption := cMain_Msg166 else Act_FindComponInNBFromComponData.Caption := cMain_Msg132; Act_FindComponInNBFromComponData.Visible := true; Act_FindComponInNBFromComponData.Enabled := false; if Grid_CompData.ActiveLevel.Index = cdliCableChannelElements then begin if DM.mtCableCanalConnectors.RecordCount > 0 then Act_FindComponInNBFromComponData.Enabled := true; end else if Grid_CompData.ActiveLevel.Index = cdliNormsResources then begin if DM.mtNorms.RecordCount > 0 then if DM.mtNorms.FieldByName(fnGuidNBComponent).AsString <> '' then Act_FindComponInNBFromComponData.Enabled := true; end; end; pmiInterfPath.Visible := pmiInterfPathVisible; end; procedure TF_MAIN.PopupMenu_DropInTreePopup(Sender: TObject); var Node: TTreeNode; CursorNode: TTreeNode; ScrPos: TPoint; Pos: TPoint; VisibleDropTreeCopy: Boolean; begin CursorNode := nil; try VisibleDropTreeCopy := false; Node := Tree_Catalog.Selected; if Not (PObjectData(Node.Data).ItemType in [itProject, itList, itRoom, itSCSLine, itSCSConnector]) then begin if GDBMode = bkNormBase then begin if CheckWriteNB(false) then VisibleDropTreeCopy := true; //*** Если компонент над компонентой GetCursorPos(ScrPos); Pos := Tree_Catalog.ScreenToClient(ScrPos); CursorNode := Tree_Catalog.GetNodeAt(Pos.X, Pos.Y); if (GSNode <> nil) and (CursorNode <> nil) and IsComponItemType(PObjectData(GSNode.Data).ItemType) and IsComponItemType(PObjectData(CursorNode.Data).ItemType) then begin Act_DropTreeCopy.Caption := cActToComplect; {$IF Defined(OEM_NIKOMAX)} Act_DropTreeCopy.Enabled := true; {$IFEND} end else begin Act_DropTreeCopy.Caption := cActToCopy; {$IF Defined(OEM_NIKOMAX)} Act_DropTreeCopy.Enabled := false; {$IFEND} end; end else if GDBMode = bkProjectManager then begin //*** Запретить копирование папок в ИП if Not PObjectData(Node.Data).ItemType in [itDir, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner] then VisibleDropTreeCopy := true; end; end; Act_DropTreeCopy.Visible := VisibleDropTreeCopy; except on E: Exception do AddExceptionToLog('TF_MAIN.PopupMenu_DropInTreePopup: '+E.Message); end; end; // ##### Если комплектующая, то переходит наоригинал ##### procedure TF_MAIN.pmnu_GoToOriginalComponClick(Sender: TObject); var ComponNode: TTreeNode; Dat: PObjectData; begin Dat := Tree_Catalog.Selected.Data; if (GDBMode = bkNormBase) and (Dat.ComponKind = ckCompl) then begin ComponNode := FindComponOrDirInTree(Dat.ObjectID, true); if ComponNode <> nil then Tree_Catalog.Selected := ComponNode; end; end; // ##### Выбор Базовой валюты ##### procedure TF_MAIN.mnu_ActiveCurrencyClick(Sender: TObject); //var // ID_Component: Integer; begin //04.01.2011 //ID_Component := GSCSBase.SCSComponent.ID; //if F_ActiveCurrency.ShowModal = mrOK then //begin // //SearchRecord(DM.DataSEt, 'ID', ID_Component); // //LoadCurrencyFormat; // //SetBriefToGridHeader; // //ShowPrice; //end; end; // ############################## Acton List ########################################## // #################################################################################### // // ##### Редактировать ветвь ##### procedure TF_MAIN.Act_EditTreeExecute(Sender: TObject); var Obj: PObjectData; begin Act_HideHints.Execute; Obj := Tree_Catalog.Selected.Data; case Obj.ItemType of itComponLine, itComponCon: Act_EditComponent.Execute; itSCSLine, itSCSConnector: ShowObjectProps(0); itRoom: ShowRoomProps(Obj.ObjectID); itList: ShowListProps; itProject: begin if (GSCSBase.CurrProject.Active) and (GSCSBase.CurrProject.ID = Obj.ObjectID) then ShowCurrProjectProperties else ShowMessageByType(0, smtDisplay, cMain_Msg34, Application.Title, MB_OK or MB_ICONINFORMATION); end; else begin if Not (IsArchComponByItemType(Obj.ItemType) and EditSelectedCADArchObj) then Act_RenameDir.Execute; end; end; end; procedure TF_MAIN.Act_EditTubeElementExecute(Sender: TObject); begin AddEditTubeElement(meEdit); EnableEditDel(itAuto); end; procedure TF_MAIN.Act_EditingNodeExecute(Sender: TObject); begin Tree_Catalog.Selected.EditText; end; // ##### Удалить ветвь ##### procedure TF_MAIN.Act_DelTreeExecute(Sender: TObject); var Obj: PObjectData; NotDelNode: TTreeNode; CopiedNode: TTreeNode; NodeName : String; NodeTypeStr: String; Mesg: String; CanDel: Boolean; Nodes: TList; begin GisOpenProjectDelFromPM := False; // Tolik 21/01/2021 -- Act_HideHints.Execute; if Tree_Catalog.SelectionCount > 1 then begin if MessageQuastYN(cMain_Msg192) = IDYES then begin Nodes := TList.Create; Tree_Catalog.GetSelections(Nodes); DeleteNodes(Nodes); Nodes.Free; end; end else begin Obj := Tree_Catalog.Selected.Data; NodeName := Tree_Catalog.Selected.Text; CutColFromStr(NodeName); NodeName := '"'+NodeName+'"'; CanDel := true; // Если SCSОбъект используется (является компонетой / папкой при выборе комплектующей ) if GSNotDel.ObjectID > 0 then begin case Obj.ItemType of itComponLine, itComponCon: begin NodeTypeStr := cMain_Msg35_2; mesg := cMain_Msg35_3; end; else begin case Obj.ItemType of itDir : NodeTypeStr := cMain_Msg35_4; itProject : NodeTypeStr := cMain_Msg35_5; itList : NodeTypeStr := cMain_Msg35_6; itRoom : NodeTypeStr := cMain_Msg35_7; itSCSLine : NodeTypeStr := cMain_Msg35_8; itSCSConnector : NodeTypeStr := cMain_Msg35_9; end; mesg := cMain_Msg35_10 + #13 + cMain_Msg35_11; end; end; NotDelNode := FindTreeNodeByDat(GSNotDel.ObjectID, [GSNotDel.ItemType]); if HaveNodeSub(Tree_Catalog.Selected, NotDelNode) then begin MessageModal(cMain_Msg35_1+' '+ NodeTypeStr+ ' ' + NodeName + ', '+ mesg, cMain_Msg35_12, MB_ICONINFORMATION or MB_OK); Exit; end; end; // Если SCSОбъект Скопирован/Вырезан или в нем есть такой if GEditKind <> ekNone then begin case Obj.ItemType of itComponLine, itComponCon: begin mesg := cMain_Msg36_1+' ' + NodeName +' '; case GEditKind of ekCopy: mesg := mesg + cMain_Msg36_2_1; ekCut : mesg := mesg + cMain_Msg36_2_2; end; end; else begin case Obj.ItemType of itDir : mesg := cMain_Msg36_3_1; itProject : mesg := cMain_Msg36_3_2; itList : mesg := cMain_Msg36_3_3; itRoom : Mesg := cMain_Msg36_3_4; itSCSLine : mesg := cMain_Msg36_3_5; itSCSConnector : mesg := cMain_Msg36_3_6 end; mesg := mesg + ' '+ NodeName; case GEditKind of ekCopy: mesg := mesg + ' '+cMain_Msg36_4_1; ekCut : mesg := mesg + ' '+cMain_Msg36_4_2; end; end; end; CopiedNode := FindTreeNodeByDat(GSDat.ObjectID, [GSDat.ItemType]); // Является ли Копированный объект потомком удаляемого if HaveNodeSub(Tree_Catalog.Selected, CopiedNode) then if MessageModal(mesg + #13 + cMain_Msg36_5, cMain_Msg36_6, MB_ICONQUESTION or MB_YESNO) = IDYes then Act_ClearCopyBuf.Execute else CanDel:= false; end; if CanDel then case Obj.ComponKind of ckCompon: Act_DelComponent.Execute; ckCompl: begin if (GSCSBase.SCSComponent.IsLine = biFalse) or (GDBMode = bkNormBase) then DelComplFromTreeOrGrid(wcTree) else //*** Комплектующую линейного типа мржна удалить по всей трассе if (GSCSBase.SCSComponent.IsLine = biTrue) or IsArchComponByIsLine(GSCSBase.SCSComponent.IsLine) then Act_DelComponent.Execute; end; else begin if Not IsGroupObjectNode(Tree_catalog.Selected) then Act_DelDir.Execute else DeleteObjectGroup(Tree_catalog.Selected); end; end; end; GisOpenProjectDelFromPM := false; // Tolik 21/01/2021 -- Tree_Catalog.SetFocus; end; procedure TF_MAIN.Act_DelTubeElementExecute(Sender: TObject); var DelName: String; DelID: Integer; SCSComponent: TSCSComponent; ptrCableCanalConnector: PCableCanalConnector; begin try with DM do begin DelName := mtCableCanalConnectors.FieldByName(fnName).AsString; if MessageModal(cMain_Tube_Msg107 + ' "'+DelName+'"?', Application.Title, MB_YESNO or MB_ICONQUESTION) = IDYES then begin DelID := mtCableCanalConnectors.FieldByName(fnID).AsInteger; mtCableCanalConnectors.Delete; SCSComponent := GetActualSelectedComponent;; if SCSComponent <> nil then begin ptrCableCanalConnector := SCSComponent.GetCableCanalConnectorByID(DelID); if ptrCableCanalConnector <> nil then begin SCSComponent.CableCanalConnectors.Remove(ptrCableCanalConnector); FreeMem(ptrCableCanalConnector); end; end; if GDBMode = bkNormBase then begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnCableCanalConnectors, fnID+' = :'+fnID, nil, ''), false); Query_Operat.ParamByName(fnID).AsInteger := DelID; Query_Operat.ExecQuery; end; GSCSBase.SCSComponent.NotifyChange; end; end; EnableEditDel(itAuto); except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelTubeElementExecute: '+E.Message); end; end; // ##### Создать Папку или Лист ... ##### procedure TF_MAIN.Act_MakeNewitemTypeExecute(Sender: TObject); var NewDir: String; Node: TTreeNode; ObjData: PObjectData; ParentNode: TTreeNode; ParentData: PObjectData; PrevData: PObjectData; ItemType : TItemType; NodeTypeStr: String; DefNameNode: String; TrgNode: TTreeNode; TmpNode: TTreeNode; //RoomMarkID: Integer; //ObjectParams: TObjectParams; //QueryMode: TQueryMode; NewNode: TTreeNode; begin ObjData := Tree_Catalog.Selected.Data; //QueryMode := GetQueryModeByGDBMode(GDBMode); NewDir := ''; //ObjectParams.MarkID := 0; //ObjectParams.Name := ''; if GDBMode = bkProjectManager then case GNewItemType of itDir: begin NodeTypeStr := cMain_Msg37_4_1; DefNameNode := cMain_Msg37_6_1; end; itProject: begin NodeTypeStr := cMain_Msg37_4_2; DefNameNode := cMain_Msg37_6_2; end; //itList: // begin // NodeTypeStr := 'листа'; // DefNameNode := 'новый лист'; // end; itRoom: begin NodeTypeStr := cMain_Msg37_4_3; //SetSQLToQuery(DM.scsQSelect, ' select Max(Mark_id) As Max_Mark_ID from katalog where id_item_Type = '''+IntToStr(itRoom)+''' '); //RoomMarkID := DM.scsQSelect.GetFNAsInteger('Max_Mark_ID'); //DefNameNode := 'Кабинет' + ' ' + IntToStr(RoomMarkID + 1); //ObjectParams.MarkID := DM.GetCatalogMaxMarkID(itRoom, GSCSBase.CurrProject.CurrID, QueryMode); //ObjectParams.Name := 'Кабинет'; //ObjectParams.MarkID := DM.ge end; //itSCSLine : NodeTypeStr := 'SCSLine'; //itSCSConnector : NodeTypeStr := 'SCSConnector'; end else NodeTypeStr := cMain_Msg37_4_1; TrgNode := nil; TrgNode := GetTargetNodeForItemType(Tree_Catalog.Selected, GNewItemType, qmUndef); //*** Определить, где создать папку - среди списка проектов, или в самом проекте if TrgNode <> nil then begin if GNewItemType = itDir then if PObjectData(TrgNode.Data).ItemType = itProject then if Not GSCSBase.CurrProject.Active or (GSCSBase.CurrProject.ID <> PObjectData(TrgNode.Data).ObjectID) then begin ParentNode := TrgNode.Parent; TmpNode := TrgNode; TrgNode := nil; if ParentNode <> nil then TrgNode := GetTargetNodeForItemType(ParentNode, GNewItemType, qmUndef); end; end; if TrgNode = nil then begin case GNewItemType of itDir: begin NodeTypeStr := cMain_Msg37_2_1; end; itProject: NodeTypeStr := cMain_Msg37_2_2; //itList: // NodeTypeStr := 'лист'; itRoom: NodeTypeStr := cMain_Msg37_2_3; end; if GNewItemType <> itList then begin MessageModal(cMain_Msg37_1+' '+ NodeTypeStr, cMain_Msg37_3+' '+ NodeTypeStr, MB_ICONINFORMATION or MB_OK); Exit; //// EXIT //// end; end; case GNewItemType of itProject: MakeNewProject; itList: MakeNewList; itDir{, itRoom}: begin if PObjectData(TrgNode.Data).ItemType = itDir then if Not CheckWritePM(true) then Exit; ///// EXIT ///// //if GNewItemType = itDir then NewDir := InputForm(Self, cMain_Msg37_5+' '+ NodeTypeStr, cMain_Msg37_7+' '+ NodeTypeStr, DefNameNode); //if GNewItemType = itRoom then // begin // F_ObjectParams.MakeEditRoom(meMake, ObjectParams); // NewDir := ObjectParams.Name; // end; if NewDir <> '' then try LockTreeAndGrid(True); ItemType := ObjData.ItemType; NewNode := MakeDir(cfBase, TrgNode, NewDir, GNewItemType, nil); Tree_Catalog.Selected := NewNode; finally LockTreeAndGrid(False); end; end; end; end; procedure TF_MAIN.Act_MakeProjectExecute(Sender: TObject); var TrgNode: TTreeNode; NewNode: TTreeNode; ProjectParams: TProjectParams; ListParams: TListParams; WasPausedProgress: Boolean; ListName: String; // Tolik 21/01/2022 begin //MakeNewProject; if GDBMode = bkProjectManager then begin if Not CheckWritePM(true) then Exit; ///// EXIT ///// if Not CheckIsCloseProject then Exit; ///// EXIT ///// TrgNode := nil; NewNode := nil; TrgNode := GetTargetNodeForItemType(Tree_Catalog.Selected, itProject, qmPhisical); //GetTopNode; if TrgNode = nil then TrgNode := GetTopNode; if Assigned(TrgNode) then begin ProjectParams := GetProjectParamsForNew(true); //Tolik 17/08/2021 -- {$if DEfined(SCS_PE)} if ProjectParams.defListSetting.CadFontName = 'GOST' then ProjectParams.defListSetting.CadFontName := 'Tahoma'; {$IFEND} if MakeEditProject(meMake, -1, ProjectParams) then begin ClearProjUserInfo; NewNode := MakeDir(cfBase, TrgNode, ProjectParams.Name, itProject, @ProjectParams); {if Assigned(NewNode) then begin //GSCSBase.CurrProject.MarkID := ProjectParams.MarkID; //GSCSBase.CurrProject.Setting := ProjectParams.Setting; GSCSBase.CurrProject.LoadParams(ProjectParams); GSCSBase.CurrProject.Save; NewNode.Text := GetNameNode(NewNode, GSCSBase.CurrProject, true, true); end; } if ProjectParams.ServCreateList then begin //ListParams.MarkID := 1; //ListParams.Name := ProjectParams.Setting.DefListName; //ListParams.Settings := ProjectParams.Setting.ListSettingRecord; ListName := F_MasterNewList.edListName.text; // Tolik 21/01/2022 ListParams := GetListParamsForNewList; //Tolik 21/01/2022 -- if ListName <> '' then begin ListParams.Name := ListName; if F_MasterNewList.cbListIsIndexWithName.Checked then ListParams.Caption := ListName + ' ' + F_MasterNewList.seCurrIndex.Text else ListParams.Caption := ListName; end; // MakeEditList(meMake, ListParams, false); // Tolik 17/05/2021 -- Application.ProcessMessages; WasPausedProgress := False; if GIsProgress then begin PauseProgress(True); WasPausedProgress := True; end; GisUserDimLine := True; FSCS_Main.LoadSubstrateEx(true); if GisUserDimLine then begin GetUserScaleVal; if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then begin FSCS_Main.tbSCSHDimLineExpert.click; ShowHintRzR(cCadClasses_Mes36_, 3000); end else begin GisUserDimLine := False; GuserScaleVal := 0; end; end else begin GisUserDimLine := False; GuserScaleVal := 0; end; if WasPausedProgress then PauseProgress(False); // end; end; end; end; end; procedure TF_MAIN.Act_OpenProjectExecute(Sender: TObject); var Messg: String; begin Messg := ''; if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then begin if (GSCSBase.CurrProject.Active) and (GSCSBase.CurrProject.CurrID = PObjectData(Tree_Catalog.Selected.Data).ObjectID) then Messg := cMain_Msg38_1 else SwitchInCAD(Tree_Catalog.Selected, ccDouble); end else Messg := cMain_Msg38_2; if Messg <> '' then ShowMessageByType(0, smtDisplay, Messg, Application.Title, MB_OK or MB_ICONINFORMATION); end; procedure TF_MAIN.Act_CloseProjectExecute(Sender: TObject); begin CloseProject(false); end; procedure TF_MAIN.Act_SaveProjectToFileExecute(Sender: TObject); var //Project: TSCSProject; ProjectNode: TTreeNode; begin //if GDBMode = bkProjectManager then // if GSCSBase.CurrProject.Active then // begin // SaveDialog_Project.InitialDir := ExtractSaveDir; //}ExtractFileDir(Application.ExeName); // SaveDialog_Project.FileName := FileNameCorrect(GSCSBase.CurrProject.Name); // if SaveDialog_Project.Execute then // begin // BeginProgress; // try // GSCSBase.CurrProject.SaveToStreamOrFile(nil, SaveDialog_Project.FileName); // finally // EndProgress; // end; // end; // end // else // ShowMessageByType(0, smtDisplay, cMain_Msg39, Application.Title, MB_OK or MB_ICONINFORMATION); //if GDBMode = bkProjectManager then // if GSCSBase.CurrProject.Active or // ((Tree_catalog.Selected <> nil) and (PObjectData(Tree_catalog.Selected.Data).ItemType = itProject)) then // begin // SaveDialog_Project.InitialDir := ExtractSaveDir; //}ExtractFileDir(Application.ExeName); // SaveDialog_Project.FileName := FileNameCorrect(GSCSBase.CurrProject.Name); // if SaveDialog_Project.Execute then // begin // BeginProgress; // try // if GSCSBase.CurrProject.Active then // GSCSBase.CurrProject.SaveToStreamOrFile(nil, SaveDialog_Project.FileName) // else // begin // Project := TSCSProject.Create(Self); // Project.ID := PObjectData(Tree_catalog.Selected.Data).ObjectID; // Project.SaveToStreamOrFile(nil, SaveDialog_Project.FileName); // // FreeAndNil(Project); // end; // finally // EndProgress; // end; // end; // end // else // ShowMessageByType(0, smtDisplay, cMain_Msg39_1, Application.Title, MB_OK or MB_ICONINFORMATION); if GDBMode = bkProjectManager then begin ProjectNode := nil; if GSCSBase.CurrProject.Active then ProjectNode := GSCSBase.CurrProject.TreeViewNode else if (Tree_catalog.Selected <> nil) and (PObjectData(Tree_catalog.Selected.Data).ItemType = itProject) then ProjectNode := Tree_catalog.Selected; if ProjectNode <> nil then SaveProjectFromNodeToFile(ProjectNode) else ShowMessageByType(0, smtDisplay, cMain_Msg39_1, Application.Title, MB_OK or MB_ICONINFORMATION); end; end; procedure TF_MAIN.Act_SaveProjectFromNodeToFileExecute(Sender: TObject); begin if GDBMode = bkProjectManager then if Tree_catalog.Selected <> nil then if Tree_catalog.Selected.Data <> nil then if PObjectData(Tree_catalog.Selected.Data).itemType = itProject then SaveProjectFromNodeToFile(Tree_catalog.Selected); end; procedure TF_MAIN.LoadProjectFromFile(aFileName: String); var MessageResult: Integer; CanLoadProjectFromFile: Boolean; NewProjectNode: TTreeNode; TrgNode: TTreeNode; ProjectParams: TProjectParams; // Tolik 28/08/2019 -- //Old: Cardinal; //Curr: Cardinal; Old, Curr: DWord; // OpenCatalogResult: TOpenCatalogFromFileResult; Res: boolean; begin Res := True; if Not GReadOnlyMode then Res := CheckWritePM(true); if Res then begin CanLoadProjectFromFile := true; if GSCSBase.CurrProject.Active then if CloseProject(false) = IDCANCEL then CanLoadProjectFromFile := false; if CanLoadProjectFromFile then begin TrgNode := GetTargetNodeForItemType(Tree_Catalog.Selected, itProject, qmPhisical); //GetTopNode; if TrgNode = nil then TrgNode := GetTopNode; if TrgNode <> nil then begin if Not FileExists(aFileName) then MessageModal(cFileOf+' '+AFileName+' '+cNoFound+'.', ApplicationName, MB_ICONINFORMATION or MB_OK) else begin BeginProgress; try ProjectParams := GetProjectParamsForNew(true); ProjectParams.Name := ExtractFileNameOnly(aFileName); NewProjectNode := MakeDir(cfBase, TrgNode, ProjectParams.Name, itProject, @ProjectParams); if Assigned(NewProjectNode) then begin Old := GetTickCount; OpenCatalogResult := GSCSBase.CurrProject.LoadFromStreamOrFile(nil, aFileName, true); if OpenCatalogResult = ocrSuccessful then NewProjectNode.Text := GetNameNode(NewProjectNode, nil, true, true) else begin DM.DelCatalog(cfBase, PObjectData(NewProjectNode.Data).ObjectID, itProject, qmPhisical); DeleteNode(NewProjectNode); EndProgress; if OpenCatalogResult = ocrFoulItemType then MessageModal(cMain_Msg40_1+' '+AFileName+' '+cMain_Msg40_2+'.', ApplicationName, MB_ICONINFORMATION or MB_OK) else if OpenCatalogResult = ocrBadFormat then MessageModal(cMain_Msg40_1+' '+AFileName+' '+cMain_Msg40_3+'.', ApplicationName, MB_ICONINFORMATION or MB_OK) else if OpenCatalogResult = orcIsOldRelease then MessageModal(cMain_Msg40_1+' '+AFileName+' '+cMain_Msg40_4+'.', ApplicationName, MB_ICONINFORMATION or MB_OK); end; Curr := GetTickCount - Old; end; finally EndProgress; end; end; end; end; end; end; procedure TF_MAIN.Act_LoadProjectFromFileExecute(Sender: TObject); var Res: boolean; begin if GDBMode = bkProjectManager then begin Res := True; if Not GReadOnlyMode then Res := CheckWritePM(true); if Res then begin OpenDialog_Project.InitialDir := ExtractSaveProjectsDir; //ExtractFileDir(Application.ExeName); {$IF Defined(ES_GRAPH_SC)} OpenDialog_Project.DefaultExt := '*.scg'; {$IFEND} //OpenDialog_Project.Options := OpenDialog_Project.Options - [ofNoChangeDir]; if OpenDialog_Project.Execute then LoadProjectFromFile(OpenDialog_Project.FileName); end; end; end; // ##### Создать папку ##### procedure TF_MAIN.Act_MakeDirExecute(Sender: TObject); begin GNewItemType := itDir; Act_MakeNewitemType.Execute; end; // ##### Создать Лист ##### procedure TF_MAIN.Act_MakeListExecute(Sender: TObject); begin MakeNewList; //GNewItemType := itList; //Act_MakeNewitemType.Execute; end; // ##### Создание комнаты ##### procedure TF_MAIN.Act_MakeRoomExecute(Sender: TObject); var TrgNode: TTreeNode; //NewNode: TTreeNode; SCSList: TSCSList; //SCSCatalog: TSCSCatalog; //NewListParams: TListParams; RoomParams: TObjectParams; //NewRoom: TSCSCatalog; begin //GNewItemType := itRoom; //Act_MakeNewitemType.Execute; if GDBMode = bkProjectManager then if Assigned(Tree_Catalog.Selected) then begin TrgNode := nil; SCSList := nil; RoomParams.MarkID := 0; RoomParams.Name := ''; SCSList := GSCSBase.CurrProject.CurrList; if Not Assigned(SCSList) then Exit; ///// EXIT ///// if SCSList.Setting.GroupListObjectsByType then begin //ShowMessageByType(0, smtDisplay, 'Для создания кабинета нужно отключить группировку объектов по типам в настройках листа на вкладке "менеджер проектов"', Application.Title, MB_OK or MB_ICONINFORMATION); //Exit; ///// EXIT ///// if MessageModal(cMain_Msg41, ApplicationName, MB_ICONQUESTION or MB_OKCANCEL) <> IDOK then Exit; ///// EXIT ///// end; TrgNode := GetTargetNodeForItemType(Tree_Catalog.Selected, itRoom, qmUndef); if Assigned(TrgNode) then begin //ZeroMemory(@RoomParams, SizeOf(TObjectParams)); //RoomParams.MarkID := DM.GetCatalogMaxMarkID(itRoom, GSCSBase.CurrProject.CurrID, qmMemory); //Inc(RoomParams.MarkID); //RoomParams.Name := GSCSBase.CurrProject.Setting.DefRoomName; //RoomParams.NameShort := ''; RoomParams := GetRoomParamsForNew(SCSList); if CreateFObjectParams.MakeEditRoom(meMake, RoomParams, SCSList) then begin // UNDO - на CreateSimpleRoomInPM SaveListToUndoStack(SCSList.CurrID); RoomParams := CreateSimpleRoomInPM(cfBase, SCSList, RoomParams, true); //*** применить все параметры на КАД ChangeCabinetParams(SCSList.CurrID, RoomParams); {if SCSList.Setting.GroupListObjectsByType then begin NewListParams := SCSList.GetParams; NewListParams.Settings.GroupListObjectsByType := false; SaveListParams(SCSList.CurrID, NewListParams); end; NewNode := MakeDir(cfBase, TrgNode, RoomParams.Name, itRoom, @RoomParams); if NewNode <> nil then begin Tree_Catalog.Selected := NewNode; NewRoom := GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(PObjectData(NewNode.Data).ObjectID); if NewRoom <> nil then CreateCabinetOnCAD(NewRoom.SCSID, NewRoom.MarkID); end;} end; end; end; end; // ##### Создать SCSLine ##### procedure TF_MAIN.Act_MakeSCSLineExecute(Sender: TObject); begin GNewItemType := itSCSLine; Act_MakeNewitemType.Execute; end; // ##### Создать SCSConnector ##### procedure TF_MAIN.Act_MakeSCSConnectorExecute(Sender: TObject); begin GNewItemType := itSCSConnector; Act_MakeNewitemType.Execute; end; // ##### Переименовать Папку ##### procedure TF_MAIN.Act_RenameDirExecute(Sender: TObject); var NewName: String; OldName: String; NameDir: String; NodeTypeStr : string; Dat: PObjectData; ParentProjNode: TTreeNode; ItemType: Integer; begin if Tree_Catalog.Selected.Level > 0 then begin ParentProjNode := GetParentNodeByItemType(Tree_Catalog.Selected, [itProject]); if (ParentProjNode = nil) or (ParentProjNode = Tree_Catalog.Selected) then if Not CheckWritePM(true) then Exit; ///// EXIT ///// NodeTypeStr := ''; ItemType := PObjectData(Tree_Catalog.Selected.Data).ItemType; if GDBMode = bkProjectManager then case ItemType of itDir : NodeTypeStr := cMain_Msg42_2_1; itProject : NodeTypeStr := cMain_Msg42_2_2; itList : NodeTypeStr := cMain_Msg42_2_3; itRoom : NodeTypeStr := cMain_Msg42_2_4; //itSCSLine : NodeTypeStr := 'SCSLine'; //itSCSConnector : NodeTypeStr := 'SCSConnector'; end else NodeTypeStr := cMain_Msg157; Dat := Tree_Catalog.Selected.Data; NameDir := ''; if IsCatalogItemType(ItemType) then NameDir := GSCSBase.SCSCatalog.Name else if IsComponItemType(ItemType) then NameDir := GSCSBase.SCSComponent.Name; NewName := InputForm(Self, cMain_Msg42_1+' '+ NodeTypeStr, cMain_Msg42_3+' '+ NodeTypeStr,NameDir); if NewName <> '' Then Tree_Catalog.Selected.Text := RenameNode(cfBase, Tree_Catalog.Selected, nil, NewName); end; end; // ##### Удалить папку ##### procedure TF_MAIN.Act_DelDirExecute(Sender: TObject); var CurrData: PObjectData; DirName : String; DelMessg: String; DelNode: TTreeNode; //DelNodeData: TObjectData; NextSelNode: TTreeNode; DirComponIDs: TIntList; // *** Переменные для анализа на наличие Child-ов что находятся в удаляемой папки, // *** предки которых находятся в других папках, которые не находятся в удаляемой //ListItem: TListItem; //ID_DelComp: ^Integer; ////ID_FindedComp: ^Integer; //CanDelItemData: PCanDelItemData; //DelComponents: TIntList; //*** Имее ID всех компонент, кот. могут быть удалены //CreatedNewData: Boolean; NotDel: Boolean; //KolDir: Integer; //KolCompon: Integer; ObjectTypeName: String; ObjectTypeNames: String; ObjectTypeNameGnd: String; UserName: String; UserDateTime: TDateTime; SCSCatalog: TSCSCatalog; ParentObject: TBasicSCSClass; DelObject: TSCSCatalog; CatalogList: TSCSCatalogs; SCSListIDs: TintList; ParentProjNode: TTreeNode; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin if Tree_Catalog.Selected <> nil then begin OldTick := GetTickCount; DeleteDirByNode(Tree_Catalog.Selected); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; {//16.02.2012 try DirName := Tree_Catalog.Selected.Text; CutColFromStr(DirName); NotDel := false; CurrData := Tree_Catalog.Selected.Data; ObjectTypeName := ''; ObjectTypeNames := ''; GetNameNodeType(Tree_Catalog.Selected, ObjectTypeName, ObjectTypeNames, ObjectTypeNameGnd); ParentObject := nil; ParentProjNode := GetParentNodeByItemType(Tree_Catalog.Selected, [itProject]); if (ParentProjNode = nil) or (ParentProjNode = Tree_Catalog.Selected) then if Not CheckWritePM(true) then Exit; ///// EXIT ///// if GDBMode = bkNormBase then begin DirComponIDs := DM.GetCatalogAllComponIDs(GSCSBase.SCSCatalog.ID, true); try if GUseComponTemplates and Not DM.CheckNoDirComponsTemplates(GSCSBase.SCSCatalog, DirComponIDs) then Exit; ///// EXIT ///// if Not DM.CheckNoDirComponsInComplects(GSCSBase.SCSCatalog, DirComponIDs) then Exit; ///// EXIT ///// finally DirComponIDs.Free; end; end else if GDBMode = bkProjectManager then begin if GSCSBase.SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then if Not CanDeleteObjectFromPM(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID) or IsLockedObject(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID) then begin MessageModal(cMain_Msg43+' '+GSCSBase.SCSCatalog.GetNameForVisible+'.', ApplicationName, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(GSCSBase.SCSCatalog.ID); if SCSCatalog <> nil then ParentObject := SCSCatalog.Parent; end; case CurrData.ItemType of itProject: if CheckProjectInUse(CurrData.ObjectID, UserName, UserDateTime) then if UserName <> GetComputerNetName then begin ShowMessageByType(0, smtDisplay, cMain_Msg44_1+' '+ObjectTypeName+' '+cMain_Msg44_2+' '+UserName+'. ', cMain_Msg44_3+' '+ObjectTypeNames+'', MB_ICONINFORMATION or MB_OK); NotDel := True; end; // Есть ли в папке проекты, открытые другими юзерами itDir: if GDBMode = bkProjectManager then if DM.CheckHaveDirProjects(CurrData.ObjectID) then begin MessageModal(cMain_Msg131, ApplicationName, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; end; if Tree_Catalog.Selected.Count > 0 then DelMessg := cMain_Msg45_1+' '+ObjectTypeNames+' "' + DirName + '" '+cMain_Msg45_2+'. '+ cMain_Msg45_3+' "' + DirName +'" ?' else DelMessg := cMain_Msg45_3+' '+ObjectTypeNameGnd+' "' + DirName +'" ?'; if Not NotDel then if MessageModal(Delmessg, cMain_Msg45_1+' '+ObjectTypeNames+'', MB_YESNO or MB_ICONQUESTION) = IDYES then begin BeginProgress; try CurrData := Tree_Catalog.Selected.Data; DelNode := Tree_Catalog.Selected; //FindComponOrDirInTree(CurrData.ObjectID, false); NextSelNode := GetNextSelNodeAfterDel(DelNode); //UNDO if GDBMode = bkProjectManager then if IsSCSObjectItemType(CurrData.ItemType) or (CurrData.ItemType = itRoom) then begin CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(GSCSBase.CurrProject.GetCatalogFromReferences(CurrData.ObjectID)); SCSListIDs := GetVariousListsIDsByObjects(CatalogList, true); try // Спросить - удалять кабели на тек участке, или по всей длине if IsSCSObjectItemType(CurrData.ItemType) and (CatalogList.Count > 0) then NotDel := Not BeforeDelObjectFromPM(cfBase, GSCSBase.CurrProject.CurrList.CurrID, CatalogList[0].SCSID, SCSListIDs) else SaveListsToUndoStack(SCSListIDs); finally FreeAndNil(SCSListIDs); FreeAndNil(CatalogList); end; end; if Not NotDel then begin GDragPrevTickCount := GetTickCount; DM.DelCatalog(cfBase, CurrData.ObjectID, CurrData.ItemType, CurrData.QueryMode); OnAddDeleteNode(DelNode, nil, ParentObject, false); if DelNode <> nil then DeleteNode(DelNode); // Новый текущий ноуд if NextSelNode <> nil then Tree_Catalog.Selected := NextSelNode; SwitchInCAD(Tree_Catalog.Selected, ccOne); GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //Tree_Catalog.Items.Delete(Tree_Catalog.Selected); end; finally EndProgress; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelDirExecute: '+E.Message); end;} end; // ##### Удалить все кабели из тек. Листа ##### procedure TF_MAIN.Act_DeleteAllCablesExecute(Sender: TObject); begin DelComponsByTypeFromList(GIDLastList, ctsnCable); end; // ##### Удалить все кабельные каналы из тек. Листа ##### procedure TF_MAIN.Act_DeleteAllCableCanalsExecute(Sender: TObject); begin DelComponsByTypeFromList(GIDLastList, ctsnCableChannel); end; // ##### Удалить все кабельные каналы из тек. Листа ##### procedure TF_MAIN.Act_ClearListExecute(Sender: TObject); var List: TSCSList; SCSComponents: TSCSComponents; SCSComponent: TSCSComponent; JoinedComponents: TSCSComponents; SCSCatalogs: TSCSCatalogs; SCSCatalog: TSCSCatalog; FindedObject: Boolean; i: Integer; SCSListIDs: TIntList; begin if GDBMode <> bkProjectManager then Exit; ////// EXIT ///// List := GSCSBase.CurrProject.CurrList; if Assigned(List) then if MessageModal(cMain_Msg46_1+' "'+List.GetNameForVisible+'" '+cMain_Msg46_2, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin BeginProgress; try if Not List.OpenedInCAD then OpenNoExistsListInCAD(List); // UNDO SCSListIDs := GetVariousListsIDsByObjects(List.ChildCatalogReferences, true); SaveListsToUndoStack(SCSListIDs); FreeAndNil(SCSListIDs); //OpenNoExistsListInCAD(List); while List.ComponentReferences.Count > 0 do begin SCSComponent := List.ComponentReferences[0]; if Assigned(SCSComponent) then begin JoinedComponents := TSCSComponents.Create(false); JoinedComponents.Assign(SCSComponent.JoinedComponents); for i := 0 to JoinedComponents.Count - 1 do if SCSComponent.ListID <> JoinedComponents[i].ListID then SCSComponent.DisJoinFrom(JoinedComponents[i]); FreeAndNil(JoinedComponents); //if Assigned(SCSComponent.TreeViewNode) then // DeleteNode(SCSComponent.TreeViewNode); DelCompon(SCSComponent, nil, false, false, false, false); end; end; i := 0; while i <= List.ChildCatalogReferences.Count - 1 do begin FindedObject := false; SCSCatalog := List.ChildCatalogReferences[i]; if Assigned(SCSCatalog) then if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then begin if Assigned(SCSCatalog.TreeViewNode) then begin //OnAddDeleteNode(SCSCatalog.TreeViewNode, nil, false); OnAddDeleteNode(SCSCatalog.TreeViewNode, SCSCatalog, SCSCatalog.Parent, false); DeleteNode(SCSCatalog.TreeViewNode) end; DM.DelCatalog(cfBase, SCSCatalog.ID, SCSCatalog.ItemType, SCSCatalog.QueryMode, SCSCatalog); //FreeAndNil(SCSCatalog); FindedObject := true; //Break; ///// BREAK //// end; if Not FindedObject then Inc(i); end; //*** Удалить сгруппированные объекты DeleteSCSFigureGrps(List.CurrID); {while True do begin FindedObject := false; i := 0; while i <= List.ChildCatalogReferences.Count - 1 do begin SCSCatalog := List.ChildCatalogReferences[i]; if Assigned(SCSCatalog) then if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then begin if Assigned(SCSCatalog.TreeViewNode) then begin OnAddDeleteNode(SCSCatalog.TreeViewNode, nil, false); DeleteNode(SCSCatalog.TreeViewNode) end; DM.DelCatalog(cfBase, SCSCatalog.ID, SCSCatalog.ItemType); //FreeAndNil(SCSCatalog); FindedObject := true; Break; ///// BREAK //// end; end; if Not FindedObject then Break; ///// BREAK //// end;} finally EndProgress; end; end; end; procedure TF_MAIN.Act_SetCableCanalConnectorsExecute(Sender: TObject); begin SetCableCanalConnectors(false); end; procedure TF_MAIN.Act_SetCableCanalConnectorsToSelectedExecute( Sender: TObject); begin SetCableCanalConnectors(true); end; // ##### Создать компоненту ##### procedure TF_MAIN.Act_MakeComponentExecute(Sender: TObject); var CatalogNode: TTreeNode; Node: TTreeNode; Dir : TTreeNode; Obj: PObjectData; NameComp: String; TextNode: String; KolvoComp: Integer; begin try CatalogNode := nil; //*** Если стою на компоненте, то должен быть указатель на текущую папку Node := Tree_Catalog.Selected; CatalogNode := GetTargetNodeForItemType(Node, itComponCon {можно и itComponLine}, qmUndef); if PObjectData(Node.Data).ItemType in [itComponLine, itComponCon] then begin if (CatalogNode <> nil) and (CatalogNode.Data <> nil) then GSCSBase.SCSCatalog.LoadCatalogByID(PObjectData(CatalogNode.Data).ObjectID, false); end; //19.05.2009 F_AddComponent.GFormMode := fmMake; //19.05.2009 if F_AddComponent.ShowModal = mrOK then if CreateFAddComponent.Execute(fmMake, false) then try LockTreeAndGrid(True); (* NameComp := GSCSBase.SCSComponent.Name; //DM.DataSet_Component.FN('Name').AsString; //Obj := Tree_Catalog.Selected.Data; {case Obj.ItemType of itDir,itList,itSCSLine,itSCSConnector: Dir := Tree_Catalog.Selected; itComponLine, itComponCon : Dir := Tree_Catalog.Selected.Parent; end;} // Количество компонентов в Папке //SetKol(CatalogNode, nil); Node := Tree_Catalog.Items.AddChild(CatalogNode, NameComp); NewData(Obj, ttComponents); Obj.ObjectID := GSCSBase.SCSComponent.ID; Obj.ItemType := GetSCSComponType(GSCSBase.SCSComponent.IsLine); //itComponent; obj.ComponKind := ckCompon; Obj.NBMode := PObjectData(CatalogNode.Data).NBMode; Obj.SortID := 0; Node.Data := Obj; //Node.ImageIndex := GetNodeImageIndex(Obj.ItemType, ekNone, -1); SetNodeImageIndex(Node, Obj.ItemType, ekNone); Tree_Catalog.Selected := Node; SetSortID(Node); // Количество компонентов в Папке OnAddDeleteNode(Node, nil, true); //SetKol(Node, nil); *) Node := MakeNodeForNewComponent(CatalogNode, GSCSBase.SCSComponent); if Node <> nil then Tree_Catalog.Selected := Node; ShowPrice; EnableEditDel(itComponLine); finally LockTreeAndGrid(false); end; {DM.SelectInterfaces; DM.SelectComponProperty;} except on E: Exception do AddExceptionToLog('TF_MAIN.Act_MakeComponentExecute: '+E.Message); end; end; Procedure TF_MAIN.DeleteCableFromList(ASCSCompon: TSCSCOmponent; Node: TTreeNode); var NodeDat: PObjectData; PrevNode: TTreeNode; ComponName : String; strMessg: String; ID_Component : Integer; CanDelComponInAllTrace: Boolean; TraceCompons: TIntList; DelComponMode: TDelComponMode; i: Integer; MesgRes: Integer; DelNode: TTreeNode; WholeLineCompon: TWholeLineCompon; isCompl: Boolean; SCSCompon: TSCSComponent; SCSComponents: TSCSComponents; begin TraceCompons := nil; SCSCompon := nil; strMessg := ''; try try MesgRes := ID_CANCEL; CanDelComponInAllTrace := false; DelComponMode := dmNone; TraceCompons := nil; isCompl := false; if Node <> nil then begin NodeDat := Node.Data; if (Not NodeDat.ItemType in [itComponLine, itComponCon]) or (NodeDat.ObjectID <> ASCSCompon.ID) then Raise Exception.Create('No assigned component'); //if Not(isComplectWhere(GSCSBase.SCSComponent, 'Нельзя удалить компонент', // 'так как она является комплектуюушей в таких компонентах:') ) then if GDBMode = bkNormBase then if Not DM.CheckNoComponInComplects(ASCSCompon) then Exit; ///// EXIT ///// if (GDBMode = bkProjectManager) then if ASCSCompon.IsLine = biTrue then begin WholeLineCompon := GetLineComponsInTraceFromBase(ASCSCompon, true); if WholeLineCompon.WholeComponObj <> nil then WholeLineCompon.WholeComponObj.Free; TraceCompons := WholeLineCompon.WholeCompon; if TraceCompons <> nil then if TraceCompons.Count > 1 then //*** тек-й компонент тоже включен в этот список и поэтому >1 CanDelComponInAllTrace := true; //*** Определить комплектующая ли это if PObjectData(Node.Data).ComponKind = ckCompl then isCompl := true; end; //*** Оставил =на всяк случай)))Но можно обойтись и без него... // Tolik // Добавлено для мастера автотрассировки электрики, чтобы удалял ненужный кабель // без лишних вопросов // TODO - протестить этот кусок, на сборке 2.3.0 if not F_PEAutoTraceDialog.FromAutoTraceDialog было закоменчено if not F_PEAutoTraceDialog.FromAutoTraceDialog then begin // case CanDelComponInAllTrace of true: DelComponMode := F_InputBox.ChoiceDelComponMode(ASCSCompon.Name); false: begin MesgRes := 6; end; end; end //Tolik else begin DelComponMode := dmNone; MesgRes := ID_YES; end; // if (MesgRes = ID_YES) or (DelComponMode <> dmNone) then begin BeginProgress; try if (GDBMode = bkNormBase) then DM.DelComponent(NodeDat.ObjectID, nil, DelComponMode) else //*** Удалить без учета undo так как потом получается Ж-О-П-А begin SCSCompon := GSCSBase.CurrProject.CurrList.GetComponentFromReferences(NodeDat.ObjectID); if SCSCompon <> nil then begin SCSComponents := TSCSComponents.Create(false); SCSComponents.Add(SCSCompon); if DelComponMode = dmTrace then DelComponentsFromList(GSCSBase.CurrProject.CurrList, SCSComponents, true, biTrue, false) else DelComponentsFromList(GSCSBase.CurrProject.CurrList, SCSComponents, false, -1, false); FreeAndnil(SCSComponents); end; end; finally EndProgress; Tree_CatalogChange(Tree_Catalog, Node); end; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelComponentExecute: '+E.Message); end; finally if TraceCompons <> nil then TraceCompons.Free; end; end; // ##### Удалить компоненту ###### procedure TF_MAIN.Act_DelComponentExecute(Sender: TObject); var //OwnerCompon: TCatalog; //ParentNode: TTreeNode; //ParentDat: PObjectData; NodeDat: PObjectData; PrevNode: TTreeNode; ComponName : String; strMessg: String; ID_Component : Integer; CanDelComponInAllTrace: Boolean; TraceCompons: TIntList; DelComponMode: TDelComponMode; i: Integer; MesgRes: Integer; DelNode: TTreeNode; WholeLineCompon: TWholeLineCompon; isCompl: Boolean; SCSCompon: TSCSComponent; SCSComponents: TSCSComponents; begin TraceCompons := nil; SCSCompon := nil; strMessg := ''; try try MesgRes := ID_CANCEL; CanDelComponInAllTrace := false; DelComponMode := dmNone; //TraceCompons := nil; isCompl := false; NodeDat := Tree_catalog.Selected.Data; if (Not NodeDat.ItemType in [itComponLine, itComponCon]) or (NodeDat.ObjectID <> GSCSBase.SCSComponent.ID) then Raise Exception.Create('No assigned component'); //if Not(isComplectWhere(GSCSBase.SCSComponent, 'Нельзя удалить компонент', // 'так как она является комплектуюушей в таких компонентах:') ) then if GDBMode = bkNormBase then if Not DM.CheckNoComponInComplects(GSCSBase.SCSComponent) then Exit; ///// EXIT ///// if (GDBMode = bkProjectManager) then if GSCSBase.SCSComponent.IsLine = biTrue then begin WholeLineCompon := GetLineComponsInTraceFromBase(GSCSBase.SCSComponent, true); if WholeLineCompon.WholeComponObj <> nil then WholeLineCompon.WholeComponObj.Free; TraceCompons := WholeLineCompon.WholeCompon; //TraceCompons := GetLineComponsInTraceFromBase(GSCSBase.SCSComponent.ID); if TraceCompons <> nil then if TraceCompons.Count > 1 then //*** тек-й компонент тоже включен в этот список и поэтому >1 CanDelComponInAllTrace := true; //*** Определить комплектующая ли это if PObjectData(Tree_Catalog.Selected.Data).ComponKind = ckCompl then isCompl := true; end; //*** Вывод сообщений о удалении case CanDelComponInAllTrace of true: DelComponMode := F_InputBox.ChoiceDelComponMode(GSCSBase.SCSComponent.Name); false: begin strMessg := cMain_Msg54_1+' "' + GSCSBase.SCSComponent.Name + '" ?'; if GDBMode = bkProjectManager then if (GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel) and (GSCSBase.SCSComponent.KolComplect > 0) then strMessg := strMessg + #10+#13+ cMain_Msg54_2; MesgRes := MessageModal(strMessg, cMain_Msg54_3, MB_YESNO or MB_ICONQUESTION); end; end; if (MesgRes = ID_YES) or (DelComponMode <> dmNone) then begin BeginProgress; try //DM.DelComponent(NodeDat.ObjectID, nil, DelComponMode); if (GDBMode = bkNormBase) then DM.DelComponent(NodeDat.ObjectID, nil, DelComponMode) else //*** Удалить с учетом undo begin SCSCompon := GSCSBase.CurrProject.CurrList.GetComponentFromReferences(NodeDat.ObjectID); if SCSCompon <> nil then begin SCSComponents := TSCSComponents.Create(false); SCSComponents.Add(SCSCompon); if DelComponMode = dmTrace then DelComponentsFromList(GSCSBase.CurrProject.CurrList, SCSComponents, true, biTrue) else DelComponentsFromList(GSCSBase.CurrProject.CurrList, SCSComponents, false); FreeAndnil(SCSComponents); end; end; ////Screen.Cursor := crHourGlass; // //LockTreeAndGrid(True); // ParentNode := Tree_Catalog.Selected.Parent; // ParentDat := ParentNode.Data; // //*** Если удаляется компонент линейного типа, то его // // внутренние комплектующие переместить на уровень выше, чтобы не удалить // if GSCSBase.SCSComponent.IsLine = biTrue then // MoveComponComplectsToUp(Tree_Catalog.Selected); // // // DelNode := Tree_Catalog.Selected; // case GDBMode of // bkNormBase: // begin // SCSCompon := TSCSComponent.Create(TForm(Self)); // SCSCompon.LoadComponentByID(GSCSBase.SCSComponent.ID); // SCSCompon.TreeViewNode := DelNode; // // DelCompon(SCSCompon, nil, true, true, false, false); //DM.DataSet.Delete; // //OnAddDeleteNode(DelNode, nil, false); //SetKol(ParentNode, nil); // //DeleteNode(DelNode); // end; // bkProjectManager: // begin // SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); // if DelComponMode <> dmTrace then // begin // if isCompl then // begin // //SCSCompon.DisJoinFromAll(true, true); // //SCSCompon.DisConnectFromParent; // //DelCompon(SCSCompon, nil, true, true, true, false); // FreeComponsFromComplect(ParentDat.ObjectID, GSCSBase.SCSComponent.ID, ParentNode); // end // else // begin // //SCSCompon := TSCSComponent.Create(TForm(Self)); // //SCSCompon.LoadComponentByID(GSCSBase.SCSComponent.ID); // SCSCompon := nil; // SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); // if Assigned(SCSCompon) then // begin // //OnAddDeleteNode(DelNode, SCSCompon, false); //SetKol(ParentNode, nil); // //DeleteNode(DelNode); // DelCompon(SCSCompon, nil, true, true, true, false); // end; // end; // //DefineObjectGroup(ParentNode, GSCSBase.SCSComponent.ID_ComponentType, GSCSBase.SCSComponent.IsLine); // // //*** Определить имя объекта, если удаляется его компонент // //DefineConnectorObjectNodeName(ParentNode); // // //if GSCSBase.SCSComponent.IsLine = biTrue then // // F_ChoiceConnectSide.DefineObjectFullness(OwnerCompon.ID, true); // end // else // for i := 0 to TraceCompons.Count - 1 do // begin // DelNode := nil; // ParentNode := nil; // ParentDat := nil; // // SCSCompon := nil; // SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(TraceCompons.Items[i]); // if Assigned(SCSCompon) then // begin // DelNode := SCSCompon.TreeViewNode; // if Assigned(DelNode) then // begin // ParentNode := DelNode.Parent; // ParentDat := ParentNode.Data; // end; // // DelCompon(SCSCompon, nil, true, true, true, false); // //if isCompl then // // FreeComponsFromComplect(ParentDat.ObjectID, Integer(TraceCompons.Items[i]^), ParentNode) // //else // //begin // // //OnAddDeleteNode(DelNode, SCSCompon, false); //SetKol(ParentNode, nil); // // //DeleteNode(DelNode); // // DelCompon(SCSCompon, nil, true, true, true, false); // //end; // // //if ParentNode <> nil then // // DefineObjectGroup(ParentNode, GSCSBase.SCSComponent.ID_ComponentType, GSCSBase.SCSComponent.IsLine); // end; // // //if GSCSBase.SCSComponent.IsLine = biTrue then // // F_ChoiceConnectSide.DefineObjectFullness(OwnerCompon.ID, true); // end; // end; // end; // //GSCSBase.SCSComponent.Clear; finally EndProgress; Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); //Screen.Cursor := crDefault; //LockTreeAndGrid(False); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelComponentExecute: '+E.Message); end; finally if TraceCompons <> nil then TraceCompons.Free; //FreeList(TraceCompons); end; end; // ##### Редактирование комплектующей как компоненты ##### procedure TF_MAIN.Act_EditComplectExecute(Sender: TObject); var ID_Component: Integer; ID_Complect: Integer; ID_Child: Integer; GridLevel: TcxGridLevel; ID_EdCompon: Integer; ModRes: TModalResult; CurrNode: TTreeNode; ComplNode: TTreeNode; ListMemTable: TList; ListPositions: TIntList; SCSCompon: TSCSComponent; begin {if GDBMode = bkProjectManager then Exit;} CheckCloseReportForm; // Tolik 05/05/2021 -- if Act_EditCompRelation.Enabled then with DM do begin //*** Сохранить позицию ID_Component := GSCSBase.SCSComponent.ID; //DataSet.FN('ID').AsInteger; ID_Complect := MemTable_Complects.FieldByName('ID').AsInteger; ID_Child := MemTable_Complects.FieldByName('ID_Child').AsInteger; GridLevel := Grid_CompData.ActiveLevel; CurrNode := TTreeView(Tree_Catalog).Selected; ComplNode := nil; ComplNode := FindComponOrDirInTree(ID_Child, true); if ComplNode = nil then Exit; ///// EXIT ///// ListMemTable := TList.Create; ListPositions := TIntList.Create; DM.SaveComponMemTablesPositions(ListMemTable, ListPositions); Grid_CompData.BeginUpdate; try try LockTreeAndGrid(True); GSCSBase.SCSComponent.LoadComponentByID(ID_Child); if GDBMode = bkProjectManager then begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); if SCSCompon <> nil then SCSCompon.DefineInterfaceNorms(true); end; SelectCompSub(ComplNode, nil); finally LockTreeAndGrid(False); end; //*** Открыть форму редактирования компоненты //19.05.2009 F_AddComponent.GFormMode := fmEdit; //19.05.2009 ModRes := F_AddComponent.ShowModal; CreateFAddComponent.Execute(fmEdit, false); ModRes := F_AddComponent.ModalResult; try LockTreeAndGrid(True); if ModRes = mrOk then if GDBMode = bkNormBase then RenameAllComplNodes(ID_Child, GetNameAndKol(GSCSBase.SCSComponent.Name, GSCSBase.SCSComponent.KolComplect)) else if ComplNode <> nil then case GSCSBase.SCSComponent.IsLine of biTrue: ComplNode.Text := RenameNode(cfBase, ComplNode, nil, GSCSBase.SCSComponent.Name); biFalse: ComplNode.Text := GetNameNode(ComplNode, GSCSBase.SCSComponent, true, true); end; //*** Выйти на запомненную компоненту {GSCSBase.SCSComponent.LoadComponentByID(ID_Component); SelectCompSub(CurrNode, nil); Grid_CompData.ActiveLevel := GridLevel; SearchRecordMT(MemTable_Complects, 'ID', ID_Complect);} Tree_Catalog.Selected := CurrNode; if GSCSBase.SCSComponent.ID <> ID_Component then Tree_CatalogChange(Tree_Catalog, CurrNode); finally LockTreeAndGrid(False); end; finally Grid_CompData.EndUpdate; DM.RestoreMemTablesPositions(ListMemTable, ListPositions); Grid_CompData.SetFocus; end; // Tolik 21/05/2018 -- ListMemTable.Free; ListPositions.Free; // end; end; // ##### Редактирование свойств компонента ##### procedure TF_MAIN.Act_EditComponentExecute(Sender: TObject); var ComponName: String; ID_Component: Integer; Dat: PobjectData; SCSCompon: TSCSComponent; i,j: Integer; ComponNode, Node: TTreeNode; aFigure:TFigure; begin if Act_EditComponent.Enabled = false then Exit; ///// EXIT ///// if GSCSBase.SCSComponent.ID = 0 then Exit; ///// EXIT ///// WaitForTVChange; FAllowTreeCatalogChange := false; try Dat := Tree_Catalog.Selected.Data; ComponName := GSCSBase.SCSComponent.Name; ID_Component := GSCSBase.SCSComponent.ID; if GDBMode = bkProjectManager then begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); if SCSCompon <> nil then SCSCompon.DefineInterfaceNorms(true); end; //F_AddComponent.GFormMode := fmEdit; //if F_AddComponent.ShowModal = mrOK then ComponNode := Tree_Catalog.Selected; if CreateFAddComponent.Execute(fmEdit, false) then begin Tree_Catalog.Items.BeginUpdate; try if ComponNode <> nil then begin ComponNode.Text := GetComponNameForVisible(GSCSBase.SCSComponent.Name, GSCSBase.SCSComponent.NameMark); ComponNode.Text := GetNameAndKol(ComponNode.Text, GSCSBase.SCSComponent.KolComplect); end; ShowPrice; Dat.ItemType := GetSCSComponType(GSCSBase.SCSComponent.IsLine); //Tree_Catalog.Selected.ImageIndex := GetNodeImageIndex(Dat.ItemType, ekNone, -1); //SetNodeState(Tree_Catalog.Selected, Dat.ItemType, ekNone, GSCSBase.SCSComponent); if GDBMode = bkNormBase then begin for i := 0 to Tree_catalog.Items.Count - 1 do begin Node := Tree_catalog.Items[i]; if (PObjectData(Node.Data).ObjectID = GSCSBase.SCSComponent.ID) then begin if PObjectData(Node.Data).ComponKind = ckCompon then SetNodeState(Node, PObjectData(Node.Data).ItemType, ekNone, GSCSBase.SCSComponent); if PObjectData(Node.Data).ComponKind = ckCompl then case GSCSBase.SCSComponent.IsLine of biTrue: SetNodeState(Node, itLinkCompLine, ekNone, GSCSBase.SCSComponent); biFalse: SetNodeState(Node, itLinkCompCon, ekNone, GSCSBase.SCSComponent); end; end; end; {if Dat.ComponKind = ckCompl then case GSCSBase.SCSComponent.IsLine of biTrue : SetNodeState(Tree_Catalog.Selected, itLinkCompLine, ekNone, GSCSBase.SCSComponent); //Tree_Catalog.Selected.ImageIndex := GetNodeImageIndex(itLinkCompLine, ekNone, -1); biFalse: SetNodeState(Tree_Catalog.Selected, itLinkCompCon, ekNone, GSCSBase.SCSComponent); //Tree_Catalog.Selected.ImageIndex := GetNodeImageIndex(itLinkCompCon, eknone, -1); end;} RenameAllComplNodes(Dat.ObjectID, ComponNode.Text); end else begin SetNodeState(ComponNode, Dat.ItemType, ekNone, GSCSBase.SCSComponent); if Dat.ItemType = itComponLine then RenameNode(cfBase, ComponNode, nil, GSCSBase.SCSComponent.Name); end; finally Tree_catalog.Items.EndUpdate; end; EnableEditDel(itAuto); //Проверка фигуры на вхождение в кабинет if (GCadForm <> nil)and(GCadForm.Pcad <> nil) then begin if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; GCadForm.PCad.Refresh; end; end; finally FAllowTreeCatalogChange := true; end; //SetKol(Tree_Catalog.Selected); end; // ##### Добавить Интерфейс ##### procedure TF_MAIN.Act_AddInterfaceExecute(Sender: TObject); var ID_InterfRel: Integer; meInterfaceRel: TmeInterfaceRel; MakeEdit: TMakeEdit; begin AddInterfacePort(biFalse); {MakeEdit := meMake; meInterfaceRel.IsLineCompon := GSCSBase.SCSComponent.IsLine; if F_AddInterface.GetInterfRel(meInterfaceRel, fmMake) then begin meInterfaceRel.ID_COMPONENT := GSCSBase.SCSComponent.ID; Grid_CompData.BeginUpdate; DM.MakeEditInterfRel(meInterfaceRel, MakeEdit); EnableEditDel(itAuto); Grid_CompData.EndUpdate; end;} end; // ##### Убрать интерфейс ##### procedure TF_MAIN.Act_DelInterfaceExecute(Sender: TObject); var ComponName: String; InterfName: String; IDInterfRel: Integer; IDAdverse: Integer; NumPair: Integer; CanDel: Boolean; begin DelInterfacePort(biFalse); {CanDel := false; IDInterfRel := DM.MemTable_InterfaceRel.FieldByName('Id').AsInteger; IDAdverse := DM.MemTable_InterfaceRel.FieldByName('Id_Adverse').AsInteger; NumPair := DM.MemTable_InterfaceRel.FieldByName('Num_Pair').AsInteger; if isUseInterfRel(TForm(Self), DM.MemTable_InterfaceRel, meDel) then Exit; InterfName := DM.MemTable_InterfaceRel.FieldByName('Name').AsString; if MessageModal(0,PAnsiChar('Удалить Интерфейс "' + InterfName +'" ?'), 'Удаление интерфейса', MB_YESNO or MB_ICONQUESTION) = IDYES then with DM do begin if GSCSBase.SCSComponent.ISComplect = biTrue then begin ComponName := GSCSBase.SCSComponent.Name; if MessageModal(0,PAnsiChar('Компонент ' + ComponName + ' может быть комплектующей'+ #13 + 'при этом удалении интерфейса нежелательно.' + #13+#13+ 'Удалить Интерфейс "' + InterfName +'" ?') , ' Удаление Интерфейса', MB_OKCANCEL or MB_ICONQUESTION) = IDOK then CanDel := true; end else CanDel := true; if CanDel then begin if NumPair = 0 then begin SetSQLToQuery(DM.scsQOperat, ' delete from interface_relation where id = '''+IntToStr(IDInterfRel)+''' '); MemTable_InterfaceRel.Delete; end else begin SetSQLToQuery(DM.scsQOperat, ' delete from interface_relation '+ ' where (id_component = '''+IntToStr(GSCSBase.SCSComponent.ID)+''') and '+ ' (num_pair = '''+IntToStr(NumPair)+''') '); DM.FillMemTableInterfRel(GSCSBase.SCSComponent, TRee_Catalog.Selected); end; end; EnableEditDel(itAuto); end;} end; // ##### Редактировать интерфейс ##### procedure TF_MAIN.Act_EditInterfaceExecute(Sender: TObject); var ID_InterfRel: Integer; meInterfaceRel: TmeInterfaceRel; MakeEdit: TMakeEdit; IDAdverse: Integer; NumPair: Integer; begin CheckCloseReportForm; // Tolik 05/05/2021 -- EditInterfacePort(biFalse); {try if GDBMode = bkProjectManager then Exit; ///// EXIT ///// ID_InterfRel := DM.MemTable_InterfaceRel.FieldByName('id').AsInteger; IDAdverse := DM.MemTable_InterfaceRel.FieldByName('id_adverse').AsInteger; NumPair := DM.MemTable_InterfaceRel.FieldByName('Num_Pair').AsInteger; if isUseInterfRel(TForm(Self), DM.MemTable_InterfaceRel, meEdit) then Exit; ///// EXIT ///// MakeEdit := meEdit; meInterfaceRel := DM.GetInterfaceRel(DM.DataSource_MT_InterfaceRel); meInterfaceRel.IsLineCompon := GSCSBase.SCSComponent.IsLine; if F_AddInterface.GetInterfRel(meInterfaceRel, fmEdit) then begin meInterfaceRel.ID_COMPONENT := GSCSBase.SCSComponent.ID; DM.MakeEditInterfRel(meInterfaceRel, MakeEdit); end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_EditInterfaceExecute: '+E.Message); end;} end; // ##### Добавить порт ##### procedure TF_MAIN.Act_AddPortExecute(Sender: TObject); begin AddInterfacePort(biTrue); end; // ##### Редактировать порт ##### procedure TF_MAIN.Act_EditPortExecute(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- EditInterfacePort(biTrue); end; // ##### Удалить порт ##### procedure TF_MAIN.Act_DelPortExecute(Sender: TObject); begin DelInterfacePort(biTrue); end; // ##### Добавить комплектующую ##### procedure TF_MAIN.Act_AddCompRelationExecute(Sender: TObject); begin //DM.SelectCompRel; AddEditComplect(FNormBase, cmAdd, false, cntComplect); {ShowPrice; SetKol(Tree_Catalog.Selected);} end; // ##### Редактировать комплектующую ##### procedure TF_MAIN.Act_EditCompRelationExecute(Sender: TObject); begin AddEditComplect(FNormBase, cmEdit, false, cntComplect); {ShowPrice; SetKol(Tree_Catalog.Selected);} end; // ##### Удалить комплектующую ##### procedure TF_MAIN.Act_DelCompRelationExecute(Sender: TObject); var ComplName : String; IDDelCompl: Integer; IDCompn: Integer; IDChild: Integer; ComponNode: TTreeNode; ComplNode: TTreeNode; //ParentNode: TTreeNode; TempNode: TTreeNode; CurrDat: PObjectData; ID_ComplRel: Integer; begin DelComplFromTreeOrGrid(wcGrid); end; // ##### Перемещение Данных при Drop, и после Вырез. + Вставить) ##### procedure TF_MAIN.Act_MoveDirExecute(Sender: TObject); var ParentSNode: TTreeNode; i: integer; minlevel: integer; begin try try LockTreeAndGrid(True); if Not Assigned(GSNodes) then GSNodes := TList.Create; if (GSNodes.Count = 0) and (GSNode <> nil) then GSNodes.Add(GSNode); minlevel := 10000; for i := 0 to GSNodes.Count - 1 do begin if TTreeNode(GSNodes[i]).Level < minlevel then minlevel := TTreeNode(GSNodes[i]).Level; end; for i := 0 to GSNodes.Count - 1 do begin GSNode := GSNodes[i]; if GSNode <> nil then begin ParentSNode := GetParentNodeByItemType(GSNode, [itProject]); if (ParentSNode = nil) or (ParentSNode = GSNode) then if Not CheckWritePM(true) then Exit; ///// EXIT ///// end; if GSNode.Level = minlevel then MoveDir(GSNode, GTNode); end; GSNodes.Clear; Tree_Catalog.Selected := GSNode; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_MoveDirExecute: '+E.Message); end; finally LockTreeAndGrid(False); end; end; // ##### Добавить свойство ##### procedure TF_MAIN.Act_AddPropertyExecute(Sender: TObject); begin AddEditProperty(meMake); end; procedure TF_MAIN.Act_AddTubeElementExecute(Sender: TObject); var i: integer; begin AddEditTubeElement(meMake); EnableEditDel(itAuto); end; // ##### Убрать Свойство ##### procedure TF_MAIN.Act_RemovePropertyExecute(Sender: TObject); Var PropName, PropSysName: String; Dat : PObjectData; ObjID, ObjItemType: Integer; ID_PropRel, j: Integer; QueryMode: TQueryMode; PropKind: TPropKind; SCSCompon: TSCSComponent; CanDel: Boolean; aFigure: TFigure; // Tolik -- 30/06/2017 -- SCSCatalog: TSCSCatalog; // begin QueryMode := GetQueryModeByNode(GDBMode, Tree_Catalog.Selected, GetQueryModeByGDBMode(GDBMode)); //Dat := Tree_Catalog.Selected.Data; Dat := GetSelectedObjectData(ObjID, ObjItemType); ID_PropRel := DM.MemTable_Property.FieldByName(fnID).AsInteger; PropName := DM.MemTable_Property.FieldByName(fnName).AsString; PropSysName := DM.MemTable_Property.FieldByName(fnSysName).AsString; SCSCompon := nil; PropKind := pkNoneProp; ////*** Не дать удалить стандартное свойство //if DM.MemTable_Property.FieldByName('isStandart').AsInteger = 1 then // begin // MessageModal(0, 'Нельзя удалить стандартное свойство.', 'Удаление свойства', MB_ICONINFORMATION or MB_OK); // Exit; // end; if DM.MemTable_Property.FieldByName(fnIsDefault).AsInteger = biTrue then begin {$IF Defined (FINAL_SCS)} MessageModal(cMain_Msg55_1+' "'+PropName+'", '+cMain_Msg55_2+'.', cMain_Msg55_3, MB_ICONINFORMATION or MB_OK); Exit; //// EXIT //// {$ELSE} if MessageQuastYN('Раб.версия: Это свойство стандартное, удалять?') <> IDYES then Exit; //// EXIT //// {$IFEND} end; if IsComponItemType(ObjItemType) then //if Dat.ItemType in [itComponLine, itComponCon] then begin //*** Если компонент линейный, то не удалять свойство "Длина" if GSCSBase.SCSComponent.IsLine = biTrue then if DM.MemTable_Property.FieldByName(fnSysName).AsString = pnLength then begin MessageModal(cMain_Msg56_1, cMain_Msg55_3, MB_OK or MB_ICONINFORMATION); Exit; end; if GDBMode = bkProjectManager then SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); PropKind := pkCompon; end else if GDBMode = bkProjectManager then PropKind := pkCatalog; if MessageModal(cMain_Msg57_1+' "' + PropName +'" ?', cMain_Msg55_3, MB_YESNO or MB_ICONQUESTION) = IDYES then begin CanDel := true; if SCSCompon <> nil then if GetComponNormResourcesCountByCompPropRelID(SCSCompon, ID_PropRel) > 0 then begin case MessageModal(cMain_Msg177, ApplicationName, MB_YESNOCANCEL or MB_ICONQUESTION) of IDYES: begin DeleteComponNormResByIDCompPropRel(SCSCompon, ID_PropRel); DM.SelectNorms(SCSCompon.NormsResources); end; IDCANCEL: CanDel := false; end; end; if CanDel then begin DM.DeleteFromPropRelation(PropKind, ObjID, ID_PropRel, QueryMode); DM.MemTable_Property.Delete; OnChangeComponProperty(SCSCompon, PropSysName); //24.08.2013 EnableEditDel(ObjItemType); //Tolik 30/06/2017 -- переопределить свойства после удаления if GDBMode = bkProjectManager then if CanDel then if SCSCompon.isLine = biFalse then begin SCSCatalog := SCSCompon.GetFirstParentCatalog; if SCSCatalog <> nil then TF_Main(SCSCatalog.ActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSCatalog); end; // end; end; //Добавил сюда Проверка фигуры на вхождение в кабинет if (GCadForm <> nil)and(GCadForm.Pcad <> nil) then begin if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; GCadForm.PCad.Refresh; end; end; // ##### Изменит Свойчтво ##### procedure TF_MAIN.Act_EditPropertyExecute(Sender: TObject); var Dat: PObjectData; TableName: String; MasterField: String; XXX_Prop_Relation: TpFIBDataSet; ID_XXXProp, j: Integer; aFigure: TFigure; begin AddEditProperty(meEdit); //Проверка фигуры на вхождение в кабинет if (GCadForm <> nil)and(GCadForm.Pcad <> nil) then begin if GCadForm.FNeedUpdateCheckedFigures then GCadForm.UpdateCheckedFigures; for j := 0 to GCadForm.FCheckedFigures.Count - 1 do begin aFigure := TFigure(GCadForm.FCheckedFigures[j]); GCadForm.Pcad.CheckFigureInsideCabinet(GCadForm.FCheckedFigures, aFigure); end; GCadForm.PCad.Refresh; end; {F_NormBase.F_CaseForm.GViewKind := vkProperty; F_NormBase.F_CaseForm.GFormMode := fmEdit; F_NormBase.F_CaseForm.GID_Property := DM.MemTable_Property.FieldByName('ID_Property').AsInteger; F_NormBase.F_CaseForm.GValue := DM.MemTable_Property.FieldByName('PValue').AsString; if F_NormBase.F_CaseForm.ShowModal = mrOK then with DM.MemTable_Property do begin Edit; FieldByName('ID_Property').AsInteger := F_NormBase.DM.DataSet_PROPERTIES.FN('ID').AsInteger; FieldByName('PVALUE').AsString := F_NormBase.F_CaseForm.GValue; Post; Dat := Tree_Catalog.Selected.Data; if Dat.ItemType in [itComponLine, itComponCon] then begin TableName := 'COMP_PROP_RELATION'; MasterField := 'ID_Component'; end else if GDBMode = bkProjectManager then begin TableName := 'CATALOG_PROP_RELATION'; MasterField := 'ID_Catalog'; end; //*** Внести изменения в базу DM.ExecuteQuery(' UPDATE '+ TableName +' SET '+ ' ID_Property = '''+ IntToStr(FieldByName('ID_Property').AsInteger) +''', '+ ' PValue = '''+ FieldByName('PVALUE').AsString +''' '+ ' WHERE '+MasterField+' = '+ IntToStr(FieldByName('ID_Master').AsInteger)); end; } {Dat := Tree_Catalog.Selected.Data; if Dat.ItemType in [itComponLine, itComponCon] then XXX_Prop_Relation := DM.DataSet_COMP_PROP_RELATION else if GDBMode = bkProjectManager then XXX_Prop_Relation := DM.DataSet_CATALOG_PROP_RELATION; if XXX_Prop_Relation.RecordCount > 0 then begin F_CaseForm.GViewKind := vkProperty; F_CaseForm.GFormMode := fmEdit; F_CaseForm.GID_Property := XXX_Prop_Relation.FN('ID_Property').AsInteger; F_CaseForm.GValue := XXX_Prop_Relation.FN('PValue').AsString; if F_CaseForm.ShowModal = mrOK then with XXX_Prop_Relation do begin Edit; FN('ID_Property').AsInteger := DM.DataSet_PROPERTIES.FN('ID').AsInteger; FN('PVALUE').AsString := F_CaseForm.GValue; Post; ID_XXXProp := FN('ID').AsInteger; if Dat.ItemType in [itComponLine, itComponCon] then DM.SelectComponProperty else DM.SelectCatalogProperty; SearchRecord(XXX_Prop_Relation, 'ID', ID_XXXProp); end; end; } end; function TF_MAIN.CheckIsCloseProject: Boolean; begin Result := true; if GSCSBase.CurrProject <> nil then if GSCSBase.CurrProject.Active then begin CloseProject(false); Result := Not GSCSBase.CurrProject.Active; end; end; procedure TF_MAIN.CheckBackUpBase; var BaseNow: TDateTime; DateLastUpdateVar: Variant; DateLastUpdate: TDate; BaseNameOf: String; begin if GSCSIni.NB.RemindToBackUpBase then begin BaseNow := DM.GetBaseNow; DateLastUpdate := 0; DateLastUpdateVar := DM.GetValueFromTableFirst(tnSettings, fnBackUpDate); if DateLastUpdateVar <> null then try DateLastUpdate := DateLastUpdateVar; //VarToDateTime() StrToDate(DateLastUpdateStr); except end; if DateLastUpdate <> 0 then begin if (Trunc(BaseNow) - Trunc(DateLastUpdate)) >= GSCSIni.NB.RemindToBackUpBaseTime then begin BaseNameOf := ''; if GDBMode = bkNormBase then BaseNameOf := cOfNormBase else if GDBMode = bkProjectManager then BaseNameOf := cOfProjMan; if MessageModal(cMain_Msg148 + ' ' + BaseNameOf +'?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then FNormBase.CreateFBackUpBase.Execute(fmBackUp, GDBMode); end; end else begin {$IF Defined(FINAL_SCS)} UpdateTableFieldAllRec(DM.Query_Operat, tnSettings, fnBackUpDate, DM.GetBaseNow); {$IFEND} end; end; end; function TF_MAIN.CloseProject(ACloseApplication: Boolean; AMessageIfClosed: Boolean = true): Integer; var i: Integer; Action: TAction; MessageResult: Integer; // Tolik 08/05/2019 -- C_Id: Integer; Procedure ClearBackUPInfo; var s: String; begin s := dm.Query_Operat.SQL.Text; dm.Query_Operat.SQL.BeginUpdate; dm.Query_Operat.SQL.Clear; //dm.Query_Operat.SQL.Add('Delete from KATALOG WHERE ID = '+'"' + IntToStr(C_Id) + '"'); dm.Query_Operat.SQL.Add('Select * from KATALOG WHERE ID = '+ IntToStr(C_Id)); dm.Query_Operat.SQL.EndUpdate; dm.Query_Operat.ExecQuery; dm.Query_Operat.SQL.BeginUpdate; dm.Query_Operat.SQL.Clear; dm.Query_Operat.SQL.text := s; dm.Query_Operat.Sql.EndUpdate; end; // begin if GDBMode = bkProjectManager then //27/11/2019 -- если текущего проекта нет -- будет бяка if GSCSBase.CurrProject <> nil then // Tolik 08/05/2019 - - C_Id := GSCSBase.CurrProject.CurrID; // Result := 0; if GDBMode = bkProjectManager then if Assigned(GSCSBase) and Assigned(GSCSBase.CurrProject) and GSCSBase.CurrProject.Active then begin MessageResult := IDNO; if GProjectChanged then if CheckWriteProj(GSCSBase.CurrProject.CurrID, false) then MessageResult := MessageModal(cMain_Msg58+' "'+GSCSBase.CurrProject.GetNameForVisible+'"?', ApplicationName, MB_ICONQUESTION or MB_YESNOCANCEL); //MessageResult := IDNo; if MessageResult <> IDCANCEL then begin if MessageResult = IDYES then begin if Not GSCSBase.CurrProject.SaveProject then MessageResult := IDCANCEL; end; if MessageResult <> IDCANCEL then begin CheckCloseReportForm; // Toilk 30/04/2021 -- GSCSBase.CurrProject.ReadOnly := true; //16.08.2011 (MessageResult = IDNO); // Tolik 15/05/2019 -- GProjectClose := True; try GSCSBase.CurrProject.Close; finally //14.05.2009 for i := 0 to FSCS_Main.ActionManager.ActionCount - 1 do //14.05.2009 begin //14.05.2009 Action := TAction(FSCS_Main.ActionManager.Actions[i]); //14.05.2009 Action.Enabled := True; //14.05.2009 end; GSCSBase.CurrProject.ReadOnly := false; GProjectClose := False; end; SetProjectChanged(false); if Act_ChoiceFind.Checked then Act_ChoiceFind.Execute; if Assigned(GSCSBase.CurrProject.TreeViewNode) then begin PObjectData(GSCSBase.CurrProject.TreeViewNode.Data).ChildNodesCount := 0; GSCSBase.CurrProject.TreeViewNode.HasChildren := false; end; Tree_CatalogChange(Tree_catalog, Tree_catalog.Selected); EnableEditDel(itAuto); ClearProjUserInfo; //ClearBackUPInfo; end; end; Result := MessageResult; end else if Not ACloseApplication and AMessageIfClosed then ShowMessageByType(0, smtDisplay, cMain_Msg59, Application.Title, MB_OK or MB_ICONINFORMATION); end; function TF_MAIN.SaveProjectFromNodeToFile(ANode: TTreeNode): Boolean; var IsCurrOpenedProject: Boolean; Project: TSCSProject; begin Result := false; if ANode <> nil then if ANode.Data <> nil then if PObjectData(ANode.Data).ItemType = itProject then if CheckWriteProj(PObjectData(ANode.Data).ObjectID, true) then begin IsCurrOpenedProject := false; if GSCSBase.CurrProject.Active and (GSCSBase.CurrProject.CurrID = PObjectData(ANode.Data).ObjectID) then IsCurrOpenedProject := true; if IsCurrOpenedProject then begin SaveDialog_Project.InitialDir := ExtractSaveDir; //}ExtractFileDir(Application.ExeName); SaveDialog_Project.FileName := FileNameCorrect(GSCSBase.CurrProject.Name); end else begin SaveDialog_Project.InitialDir := ExtractSaveDir(ANode.Text); SaveDialog_Project.FileName := ANode.Text; end; if SaveDialog_Project.Execute then begin Application.ProcessMessages; BeginProgress; try if IsCurrOpenedProject then begin AddExceptionToLog('Save Project as: ' + SaveDialog_Project.FileName, False); //08.09.2011 MessageInfo(cSCSComponent_Msg22_4); Result := GSCSBase.CurrProject.SaveToStreamOrFile(nil, SaveDialog_Project.FileName); end else begin Project := TSCSProject.Create(Self); Project.ID := PObjectData(Tree_catalog.Selected.Data).ObjectID; Result := Project.SaveToStreamOrFile(nil, SaveDialog_Project.FileName); FreeAndNil(Project); end; finally EndProgress; end; if Not Result then AddExceptionToLog(cSCSComponent_Msg22_4, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_4); end; end; end; procedure TF_MAIN.SaveProjectRevision; var Str: String; OldRev, NewRev: Integer; ProjStream: TMemoryStream; Fields: TStringList; MaterialCost, NormCost: Double; NormsRes: TSCSNormsResources; Norm: TSCSNormGroup; Resource: TSCSResourceGroup; i: Integer; BaseNow: TDateTime; isSaveProj: Boolean; function GetUpdateCount(aTreeView: TTreeView):Integer; //UpdateCount l?sst sich nur mit einem Hack auslesen Begin Result := THackTreeNodes(aTreeView.Items).FUpdateCount; end; begin // Tolik 05/05/2021 -- if GDBMode = bkNormBase then exit; // if GSCSBase.CurrProject.Active then if CheckWriteProj(GSCSBase.CurrProject.CurrID, true) then begin {Str := 'F_ProjMan.TreeView.UpdateCount = ' + inttostr(GetUpdateCount(F_ProjMan.Tree_Catalog)) + #13#10 + // Tolik 12/04/2021 -- 'LockTreeAndGreedCoumt = ' + InttoStr(F_ProjMan.FLockTreeAndGreedCount);} if InputMemo(cBaseCommon86_1, cBaseCommon86_2, Str) then begin try // IGOR 21/09/2017 -- здесь BeginProgress НЕЛЬЗЯ, так как не произойдет GSCSBase.CurrProject.SaveProject если прогресс активен! //BeginProgress; SetSQLToFIBQuery(DM.Query_Select, 'SELECT MAX(REVISION) FROM PROJECT_REV WHERE ID_CATALOG = '+IntToStr(GSCSBase.CurrProject.ID), true); NewRev := DM.Query_Select.Fields[0].AsInteger + 1; OldRev := GSCSBase.CurrProject.Setting.Revision; GSCSBase.CurrProject.Setting.Revision := NewRev; isSaveProj := GSCSBase.CurrProject.SaveProject; BeginProgress; if isSaveProj then begin MaterialCost := 0; NormCost := 0; NormsRes := GSCSBase.CurrProject.GetAllNormsResources([nrNorms, nrResources, nrAccessories, nrComponents], false, true, false, true, false, true, false, True); for i := 0 to NormsRes.Resources.Count - 1 do begin Resource := TSCSResourceGroup(NormsRes.Resources[i]); MaterialCost := MaterialCost + Resource.Cost; end; for i := 0 to NormsRes.Norms.Count - 1 do begin Norm := TSCSNormGroup(NormsRes.Norms[i]); NormCost := NormCost + Norm.TotalCost; end; ProjStream := TMemoryStream.Create; Fields := TStringList.Create; try GSCSBase.CurrProject.SaveToStreamOrFile(ProjStream, '', false, true); ProjStream.Position := 0; BaseNow := GetBaseNow(DM.Query_Select); Fields.Add(fnIDCatalog); Fields.Add(fnMaterialCost); Fields.Add(fnNormCost); Fields.Add(fnTotalCost); Fields.Add(fnRevision); Fields.Add(fnPMBlock); Fields.Add(fnComment); Fields.Add(fnBaseline); Fields.Add(fnDateIn); Fields.Add(fnTimeIn); SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtInsert, tnProjectRev, '', Fields, ''), false); DM.Query_Operat.ParamByName(fnIDCatalog).AsInteger := GSCSBase.CurrProject.ID; DM.Query_Operat.ParamByName(fnMaterialCost).AsFloat := MaterialCost; DM.Query_Operat.ParamByName(fnNormCost).AsFloat := NormCost; DM.Query_Operat.ParamByName(fnTotalCost).AsFloat := NormCost + MaterialCost; DM.Query_Operat.ParamByName(fnRevision).AsInteger := NewRev; DM.Query_Operat.ParamByName(fnPMBlock).LoadFromStream(ProjStream); DM.Query_Operat.ParamByName(fnComment).AsString := Str; DM.Query_Operat.ParamByName(fnBaseline).AsInteger := biFalse; DM.Query_Operat.ParamByName(fnDateIn).AsDate := BaseNow; DM.Query_Operat.ParamByName(fnTimeIn).AsTime := BaseNow; DM.Query_Operat.ExecQuery; finally Fields.Free; ProjStream.Free; NormsRes.Free; end; end else GSCSBase.CurrProject.Setting.Revision := OldRev; finally EndProgress; end; end; end; end; // ##### Показать/Скрыть панель с ProgressBar ##### procedure TF_MAIN.StartStopProgress(AStartStop: TStartStop; ACaption: String = ''); begin case AStartStop of ssStart: begin //Panel_Progress.Visible := true; //Label_Progress.AutoSize := true; //Label_Progress.Caption := ACaption; {ProgressBar.Left := Label_Progress.Left + Label_Progress.Width + 3; ProgressBar.Width := Panel_Progress.Width - ProgressBar.Left - 3; ProgressBar.Position := 0; ProgressBar.Update;} //Label_Progress.Update; Screen.Cursor := crHourGlass; end; ssStop : begin //Panel_Progress.Visible := false; Screen.Cursor := crDefault; end; end; end; function TF_MAIN.IsCurrProjectNode(ANode: TTreeNode): Boolean; var Dat: PObjectDAta; begin result := false; if GDBMode = bkProjectManager then if Assigned(ANode) and (ANode.Data <> nil) then begin Dat := ANode.Data; if (Dat.ItemType = itProject) and (Dat.ObjectID = GSCSBase.CurrProject.CurrID) and (GSCSBase.CurrProject.Active) then Result := true; end; end; function TF_MAIN.GetCatalogExtendedFromCurrNode: TSCSCatalogExtended; var Dat: PObjectData; Node: TTreeNode; begin {Result := nil; Dat := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if Dat <> nil then begin if Dat.ItemType = itProject then Result := GSCSBase.CurrProject else if Dat.ItemType = itList then Result := GSCSBase.CurrProject.GetListByID(Dat.ObjectID); end;} Result := nil; try // Ищем лист Node := GetParentNodeByItemType(Tree_Catalog.Selected, [itList]); if Node <> nil then Result := GSCSBase.CurrProject.GetListByID(PObjectData(Node.Data).ObjectID) else begin Node := GetParentNodeByItemType(Tree_Catalog.Selected, [itProject]); if (Node <> nil) and (PObjectData(Node.Data).ObjectID = GSCSBase.CurrProject.ID) then Result := GSCSBase.CurrProject; end; if Result = nil then Result := GSCSBase.CurrProject.CurrList; except on E: Exception do AddExceptionToLogEx('TF_MAIN.GetCatalogExtendedFromCurrNode', E.Message); end; end; // ##### Снимает/ добавляет выдиление трассы ##### procedure TF_MAIN.Act_DeselectSelectComponInCADExecute(Sender: TObject); var Node: TTreeNode; Obj: PObjectData; begin if GDBMode = bkProjectManager then begin //*** Снять выдиление на CAD-е if GExistsSelectTrace then begin DeselectTraceInCAD; GExistsSelectTrace := false; end; Node := Tree_Catalog.Selected; Obj := Node.Data; //*** Выделить линейный компонент по ысей трассе if Obj.ItemType = itComponLine then begin SelectTraceInCADByIDCompon(Obj.ObjectID); GExistsSelectTrace := true; end; //*** Выделить линейный компонент по ысей трассе //if (Obj.ItemType = itComponLine) and (GSCSBase.SCSComponent.IsLine = ctLine) then // begin // SelectTraceInCADByIDCompon(GSCSBase.SCSComponent.ID); // GExistsSelectTrace := true; // end; end; end; // ##### Делает компоненту по умолчанию ##### procedure TF_MAIN.Act_SetComponAsDefaultExecute(Sender: TObject); //var Dat: PObjectData; // CanBeAsDef: Boolean; begin {CanBeAsDef := true; Dat := Tree_Catalog.Selected.Data; if (Dat <> nil) and (GDBMode = bkNormBase) then begin case Dat.ItemType of itComponCon: if GSCSBase.SCSComponent.HaveMinimumInterfaces(false) then begin GDefaultNoLineCompon := Dat.ObjectID; IconToFile('ConnAsDefault'); end else CanBeAsDef := false; itComponLine: if GSCSBase.SCSComponent.HaveMinimumInterfaces(false) then GDefaultLineCompon := Dat.ObjectID else CanBeAsDef := false; end; EnableDisableActsWithDefCompons; end; if Not CanBeAsDef then MessageModal('Компонент "'+GSCSBase.SCSComponent.Name+'" не может быть назначен по умолчанию потому, что у него нет интерфейсов.'+#13+ 'Добавте в данный компонент интерфейсы', 'Назначение компоненты по умолчанию', MB_ICONINFORMATION or MB_OK); } end; // ##### Перейти на линейный компонент по умолчанию ##### procedure TF_MAIN.Act_TurnToDefLineComponExecute(Sender: TObject); //var Node: TTreeNode; begin { if GDefaultLineCompon <> 0 then begin Node := FindComponOrDirInTree(GDefaultLineCompon, true); if Node <> nil then Tree_Catalog.Selected := Node; end;} end; // ##### Перейти на точечный компонент по умолчанию ##### procedure TF_MAIN.Act_TurnToDefNoLineComponExecute(Sender: TObject); //var Node: TTreeNode; begin { if GDefaultNoLineCompon <> 0 then begin Node := FindComponOrDirInTree(GDefaultNoLineCompon, true); if Node <> nil then Tree_Catalog.Selected := Node; end;} end; // ##### Проложить каб. канал по выделенной трассе ##### procedure TF_MAIN.Act_TraceLineComponlBySelectedLinesExecute(Sender: TObject); begin if GDBMode = bkNormBase then begin if GCADForm <> nil then begin if IsSelectedLinesExist then begin //if FProjectMan.GSCSBase.CurrProject.CurrList <> nil then // SaveListToUndoStack(FProjectMan.GSCSBase.CurrProject.CurrList.CurrID); if GSCSBase.SCSComponent.IsLine = biTrue then begin // Tolik 15/03/2018 -- //TraceCableChannelBySelectedLines(GSCSBase.SCSComponent.ID); if isCablecomponent(GSCSBase.SCSComponent) then TraceCableChannelBySelectedLines(GSCSBase.SCSComponent.ID, true) else TraceCableChannelBySelectedLines(GSCSBase.SCSComponent.ID); // DM.AddComponGUIDToFreqUseObj(GSCSBase.SCSComponent.GuidNB); end else if GSCSBase.SCSComponent.IsLine = biFalse then begin if MasterComponToCAD(Self) then begin // Tolik -- 12/03/2016 -- // SetConnComponToTraces(GCadForm, GSCSBase.SCSComponent, F_MasterComponToCAD.fStep.Value, F_MasterComponToCAD.cbSetToConnectors.Checked); if F_MasterComponToCAD.cbSetToConnectorsOnly.Checked then SetConnComponToTraces(GCadForm, GSCSBase.SCSComponent, 0, F_MasterComponToCAD.cbSetToConnectorsOnly.Checked) else SetConnComponToTraces(GCadForm, GSCSBase.SCSComponent, F_MasterComponToCAD.fStep.Value, F_MasterComponToCAD.cbSetToConnectors.Checked); // DM.AddComponGUIDToFreqUseObj(GSCSBase.SCSComponent.GuidNB); end; end; end else ShowMessageByType(0, smtDisplay, cMain_Msg60, Application.Title, MB_OK or MB_ICONINFORMATION); end else MessageModal(CActiveListNotExistMessage, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; // ##### Автотрассировать кабель #### procedure TF_MAIN.Act_AutoTraceCableExecute(Sender: TObject); var // Tolik 28/08/2019 - - //TickPrev, TickCurr: Cardinal; TickPrev, TickCurr: DWord; i: integer; // Tolik 25/11/2021 - - //Tolik 23/02/2022 -- Prop: PProperty; SCSCompon, FindedCompon : TSCSComponent; GuidSTR: string; Compon_ID: integer; // begin //try //TickPrev := GetTickCount; GProcCnt := 0; if GDBMode = bkNormBase then begin if GCadForm.PCad.Selection.Count > 0 then //Tolik 15/09/2021 -- begin if GCadForm <> nil then begin if FSCS_Main.FInteractiveScene = 1 then begin if FSCS_Main.FInteractiveStep = 9 then begin if IsVisibleHintES then HideHintES; end; end; //Tolik 23/02/2022 -- SCSCompon := GSCSBase.SCSComponent; SCSCompon.LoadComponentByFi([fiIsLine, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); if isCableComponent(SCSCompon) then begin if SCSCompon.IsTemplate = biTrue then begin GuidSTR := ''; SCSCompon.LoadProperties; Prop := SCSCompon.GetPropertyBySysName(pnGUID_NB_EXCHANGE); if Prop <> nil then begin if Prop.Value <> '' then GuidSTR := Prop.Value; end; if GuidSTR <> '' then begin Compon_ID := F_NormBase.DM.GetIntFromTable(tnComponent, fnID, fnGUID, GuidStr, qmPhisical); if Compon_ID <> -1 then begin SCSCompon.ID := Compon_ID; SCSCompon.LoadComponentByFi([fiIsLine, fiIDProducer, fiIDNetType, fiIDNormBase, fiObjectID]); end; end; end; end; //AutoTraceCableFromNB(GSCSBase.SCSComponent.ID, GSCSBase.SCSComponent); AutoTraceCableFromNB(SCSCompon.ID, SCSCompon); // DM.AddComponGUIDToFreqUseObj(GSCSBase.SCSComponent.GuidNB); if FSCS_Main.FInteractiveScene = 1 then begin if FSCS_Main.FInteractiveStep = 9 then begin // Восстанавливаем старый обработчик if Assigned(FSCS_Main.FInteractiveMsgOrig) then Application.OnMessage := FSCS_Main.FInteractiveMsgOrig; FSCS_Main.FInteractiveMsgOrig := nil; FSCS_Main.StepInteractive; end; end; end else MessageModal(CActiveListNotExistMessage, ApplicationName, MB_ICONINFORMATION or MB_OK); end else ShowMessage(cMain_Msg160); //Tolik 15/09/2021 -- end; {if IsSelectServerAsDefault then AutoTraceCableFromNB(GSCSBase.SCSComponent.ID) else ShowMessageByType(0, smtDisplay, 'Выберите конечный объект по умолчанию, к которому будут производиться соединения', 'Автотрассировка', MB_ICONINFORMATION or MB_OK); } //TickCurr := GetTickCount - TickPrev; //TickCurr := GetTickCount - TickPrev; //ShowMessage(IntToStr(TickCurr)); //finally //end; //Tolik 24/11/2021 - - GCadForm.PCad.DeselectAll(2); RefreshCad(GCadForm.PCad); // Application.ProcessMessages; end; procedure TF_MAIN.Act_AutoTraceByRayModeExecute(Sender: TObject); begin if GDBMode = bkNormBase then begin if GCadForm <> nil then begin StartMasterPETrace; DM.AddComponGUIDToFreqUseObj(GSCSBase.SCSComponent.GuidNB); end else MessageModal(CActiveListNotExistMessage, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; // ##### Заменить компонент на... ##### procedure TF_MAIN.Act_ReplaceComponentExecute(Sender: TObject); var IDComponent: Integer; ReplaceCompon: TSCSComponent; SprComponentType: TNBComponentType; CanReplace: Boolean; OldProjSetting_ConnectComponPortsCount: Boolean; // Tolik 08/04/2020 -- begin // Tolik 08/04/2020 -- если в настройках проекта выставлено трассировать только идин порт вне зависимости ....бла-бла-бла // то при замене компонента с прилегающей трассы подключится только один кабель... // поэтому настройка принудительно сбрасывается ...хотя... на всех не угодишь.... OldProjSetting_ConnectComponPortsCount := GSCSBase.CurrProject.Setting.TraceOnePortToOne; GSCSBase.CurrProject.Setting.TraceOnePortToOne := False; // try if GDBMode = bkProjectManager then begin IDComponent := -1; ReplaceCompon := nil; // Tolik 08/04/2020 -- а то... может подъебнуть...? if PObjectData(Tree_Catalog.Selected.Data).ItemType in [itComponCon, itComponLine] then IDComponent := PObjectData(Tree_Catalog.Selected.Data).ObjectID; if IDComponent <> -1 then ReplaceCompon := GSCSBase.CurrProject.CurrList.GetComponentFromReferences(IDComponent); if Assigned(ReplaceCompon) then begin SprComponentType := GSCSBase.CurrProject.Spravochnik.GetComponentTypeByGUID(ReplaceCompon.GUIDComponentType); CanReplace := true; if SprComponentType <> nil then if (SprComponentType.ComponentType.SysName = ctsnHouse) or (SprComponentType.ComponentType.SysName = ctsnApproach) then begin CanReplace := false; MessageModal(cMain_Msg178+' "'+SprComponentType.ComponentType.Name+'"', ApplicationName, MB_OK or MB_ICONINFORMATION); end; if CanReplace then ReplaceComponent(GSCSBase.CurrProject.CurrList, ReplaceCompon); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_ReplaceComponentExecute: '+E.Message); // Tolik 08/04/2020 -- end; GSCSBase.CurrProject.Setting.TraceOnePortToOne := OldProjSetting_ConnectComponPortsCount; // Tolik 08/04/2020 -- end; // ##### Замена кабельных каналов ##### procedure TF_MAIN.Act_ReplaceCableCanalsExecute(Sender: TObject); var Dat: PObjectData; CurrNode: TTreeNode; SCSCatalog: TSCSCatalog; CableCanals: TSCSComponents; CableCanalsToReplace: TSCSComponents; NBCableCanal: TSCSComponent; i: Integer; SCSListIDs: TIntList; ReplaceCount: Integer; begin if GDBMode <> bkProjectManager then Exit; ////// EXIT ///// CurrNode := Tree_Catalog.Selected; Dat := CurrNode.Data; SCSCatalog := nil; if (Dat.ItemType = itSCSLine) or (Dat.ItemType = itList) or (Dat.ItemType = itRoom) or (Dat.ItemType = itDir) then SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if Dat.ItemType = itProject then SCSCatalog := TSCSCatalog(GSCSBase.CurrProject); if Assigned(SCSCatalog) then begin CableCanals := TSCSComponents.Create(false); CableCanalsToReplace := TSCSComponents.Create(false); for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do if Assigned(SCSCatalog.ComponentReferences[i]) then if SCSCatalog.ComponentReferences[i].ComponentType.SysName = ctsnCableChannel then CableCanals.Add(SCSCatalog.ComponentReferences[i]); if CableCanals.Count > 0 then begin NBCableCanal := CreateFConnectComplWith.DefineReplaceCableCanal(CableCanals, CableCanalsToReplace); if Assigned(NBCableCanal) then begin Screen.Cursor := crHourGlass; BeginProgress; try //*** UNDO SCSListIDs := GetVariousListsIDsByCompons(CableCanals); SaveListsToUndoStack(SCSListIDs); FreeAndnil(SCSListIDs); ReplaceCount := 0; for i := 0 to CableCanalsToReplace.Count - 1 do if Assigned(CableCanalsToReplace[i]) then begin //OpenNoExistsListInCAD(CableCanalsToReplace[i].GetListOwner); //if CableCanalsToReplace[i].ReplaceWithNBCompon(NBCableCanal, false) <> nil then if ReplacePMComponFromNB(CableCanalsToReplace[i], NBCableCanal, false) <> nil then Inc(ReplaceCount); end; FreeAndNil(NBCableCanal); finally EndProgress; Screen.Cursor := crDefault; //LockTreeAndGrid(false); ReselectNode; end; if ReplaceCount > 0 then ShowMessageByType(0, smtDisplay, cMain_Msg61_1+' '+IntToStr(ReplaceCount)+' '+cMain_Msg61_2, '', 0); end; end else ShowMessageByType(0, smtDisplay, cMain_Msg62_1, cMain_Msg62_2, MB_OK or MB_ICONINFORMATION); FreeAndNil(CableCanals); FreeAndNil(CableCanalsToReplace); end; end; // ##### Сбросить линейный компонент по умолчанию ##### procedure TF_MAIN.Act_DropDefLineComponExecute(Sender: TObject); begin //GDefaultLineCompon := 0; //EnableDisableActsWithDefCompons; end; // ##### Сбросить точечный компонент по умолчанию ##### procedure TF_MAIN.Act_DropDefNoLineComponExecute(Sender: TObject); begin //GDefaultNoLineCompon := 0; //EnableDisableActsWithDefCompons; end; // ##### Администрирование нормативной базы ##### procedure TF_MAIN.Act_SettIsAdministrationExecute(Sender: TObject); begin try GSCSIni.NB.IsAdministration := Act_SettIsAdministration.Checked; F_NormBase.EnableEditDel(itAuto); except on E: Exception do AddExceptionToLog('TF_MAIN.Act_SettIsAdministrationExecute: '+E.Message); end; end; // Tolik 16/11/2021 - - установка элементов трубных соединений procedure TF_MAIN.SetTubesElements; var i: integer; Dat: PObjectData; Folder: TSCSCatalog; List: TSCSList; InstallList: TList; isNormalList: Boolean; Function CheckIsTubeElementsOnFolder(aFolder: TSCSCatalog):Boolean; var i: integer; begin Result := False; for i := 0 to aFolder.ComponentReferences.Count - 1 do begin if aFolder.ComponentReferences[i].ComponentType.SysName = ctsnTube then begin Result := True; break; end; end; end; Procedure AddObjectsToList(aList: TSCSList); var i, j, k, connCount: integer; Cad: TF_CAD; Conn: TConnectorObject; Line: TOrthoLine; LineList: TList; LineFolder: TSCSCatalog; PtrTubeConnector : PCableCanalConnector; Procedure AddConnToList(aConn: TConnectorObject; aList: TList); var i, j, ConnCount: integer; TubeCompon, TubeElement, TubeConn: TSCSComponent; begin try TubeElement := nil; for i := 0 to aList.Count - 1 do begin TubeCompon := TSCSComponent(aList[i]); if Assigned(TubeCompon.CableCanalConnectors) then begin if TubeCompon.CableCanalConnectors.Count = 0 then TubeCompon.LoadCableCanalConnectors; for j := 0 to TubeCompon.CableCanalConnectors.Count - 1 do begin PtrTubeConnector := PCableCanalConnector(TubeCompon.CableCanalConnectors[j]); TubeConn := TSCSComponent(TubeCompon.CableCanalConnectors[j]); //TubeConn := //PtrTubeConnector.GuidNBConnector if TubeConn.Properties <> nil then begin connCount := 0; try connCount := TubeConn.GetPropertyValueAsInteger(pnConnectCount); except on e: Exception do connCount := 0; end; if connCount = aList.Count then begin exit; end; end; end; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.SetTubesElements: ' + e.Message); end; end; begin Cad := GetListByID(aList.SCSID); if Cad <> nil then begin LineList := TList.Create; for i := 0 to Cad.FSCSFigures.Count - 1 do begin if CheckFigureByClassName(TFigure(Cad.FSCSFigures[i]), cTConnectorObject) then begin Conn := TConnectorObject(Cad.FSCSFigures[i]); if not Conn.Deleted then begin if Conn.ConnectorType = ct_Clear then begin LineList.Clear; for j := 0 to Conn.JoinedOrtholinesList.Count - 1 do begin Line := TOrthoLine(Conn.JoinedOrtholinesList[j]); LineFolder := aList.GetCatalogFromReferencesBySCSID(Line.Id); if LineFolder <> nil then begin for k := 0 to LineFolder.ComponentReferences.Count - 1 do begin if LineFolder.ComponentReferences[k].ComponentType.SysName = ctsnTube then begin LineList.Add(LineFolder.ComponentReferences[k]); break; end; end; end; end; if LineList.Count > 0 then AddConnToList(Conn, LineList); end; end; end; end; LineList.Free; end; end; Procedure CollectTubeObjects(aFolder: TSCSCatalog); var i: integer; begin if aFolder.ItemType = itList then AddObjectsToList(TSCSList(aFolder)) else if aFolder.ItemType = itProject then begin for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin if F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].Setting.ListType = lt_Normal then AddObjectsToList(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]); end; end; end; Procedure InstallTubeObjects(aList: TList); var i: integer; begin for i := 0 to aList.Count - 1 do begin end; end; begin Dat := nil; Folder := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if Dat.ItemType = itProject then begin isNormalList := False; for i := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin if F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].Setting.ListType = lt_Normal then begin isNormalList := true; break; end; end; if isNormalList then Folder := F_ProjMan.GSCSBase.CurrProject; end; if Dat.ItemType = itList then begin Folder := GSCSBase.CurrProject.GetListByID(Dat.ObjectID); if TSCSList(Folder).Setting.ListType <> lt_Normal then Folder := nil; end; if Folder <> nil then begin if CheckIsTubeElementsOnFolder(Folder) then begin InstallList := TList.Create; CollectTubeObjects(Folder); if InstallList.Count > 0 then InstallTubeObjects(InstallList); InstallList.Free; end else begin if Dat.ItemType = itProject then ShowMessage(cMain_NoTubesOnProj) else if Dat.ItemType = itList then ShowMessage(cMain_NoTubesOnList); end; end; end; // procedure TF_MAIN.Act_SetTubesElementsExecute(Sender: TObject); begin //SetTubesElements; SetCableCanalConnectors(False, True); end; procedure TF_MAIN.Act_SettAutoInsertingComponsExecute(Sender: TObject); begin //GAutoInsertingCompons := Act_SettAutoInsertingCompons.Checked; end; // ##### Установка фокуса по Ctrl+Tab на соседнюю главную форму ##### procedure TF_MAIN.Act_SwitchExecute(Sender: TObject); begin case GDBMode of bkNormBase: F_ProjMan.SetFocus; bkProjectManager: F_NormBase.SetFocus; end; end; // ####################### Вырезать / Копировать / Вставить ################### // ############################################################################# // // ##### Отменить Вырезание ##### procedure TF_MAIN.RollBackCut; var Dat: PObjectData; SourceNode : TTreeNode; begin if GEditKind = ekCut then begin SourceNode := FindTreeNodeByDat(GSDat.ObjectID, [GSDat.ItemType]); Dat := SourceNode.Data; //SourceNode.ImageIndex := GetNodeImageIndex(dat.ItemType, ekNone, dat.ObjectID); SetNodeState(SourceNode, Dat.ItemType, ekNone); end; end; // ##### Копиовать Ветвь ##### procedure TF_MAIN.Act_CopyDirExecute(Sender: TObject); var SCSList: TSCSList; begin RollBackCut; //SNode := Tree_Catalog.Selected; GSDat.ObjectID := PObjectData(Tree_Catalog.Selected.Data).ObjectID; GSDat.ItemType := PObjectData(Tree_Catalog.Selected.Data).ItemType; GEditKind := ekCopy; if GSDat.ItemType = itList then if CheckWriteProj(GSCSBase.CurrProject.CurrID, true) then begin SCSList := GSCSBase.CurrProject.GetListByID(GSDat.ObjectID); if SCSList <> nil then begin GSCSBase.CurrProject.NoSaveListsToFiles.RemoveByString(GetAnsiTempPath + fnBufferedList); GSCSBase.CurrProject.NoSaveListsToFiles.Add(SCSList.ID, GetAnsiTempPath + fnBufferedList); FIsBufferedList := true; end; end; Act_ClearCopyBuf.Enabled := true; EnablePaste; end; // ##### Вырезать Ветвь ##### procedure TF_MAIN.Act_CutDirExecute(Sender: TObject); var Dat: PObjectData; begin RollBackCut; //SNode := Tree_Catalog.Selected; GSDat.ObjectID := PObjectData(Tree_Catalog.Selected.Data).ObjectID; GSDat.ItemType := PObjectData(Tree_Catalog.Selected.Data).ItemType; Dat := Tree_Catalog.Selected.Data; //Tree_Catalog.Selected.ImageIndex := GetNodeImageIndex(GSdat.ItemType, ekCut, dat.ObjectID); SetNodeState(Tree_Catalog.Selected, GSdat.ItemType, ekCut); Tree_Catalog.Refresh; GEditKind := ekCut; Act_ClearCopyBuf.Enabled := true; EnablePaste; end; procedure TF_MAIN.Act_PasteDirExecute(Sender: TObject); begin GTNode := Tree_Catalog.Selected; //if GTNode <> nil then //begin // GTNode := GetTargetNodeForItemType(GTNode, GSDat.ItemType, qmUndef); //end; GSNode := nil; if GSDat.ItemType <> itList then GSNode := FindComponOrDirInTree(GSDat.ObjectID, IsComponItemType(GSDat.ItemType)); PasteNode(GSNode, GTNode, @GSDat, GEditKind); //if GSNode <> nil then // PasteNode(GSNode, GTNode, GEditKind); end; (* // ##### Вставить Ветвь ##### procedure TF_MAIN.Act_PasteDirExecute(Sender: TObject); var DatS: PObjectData; // Source DatT: PObjectData; // Target DatPT: PObjectData; // Parent Target DatPS: PObjectData; // Parent Source TrgName: String; SrcName: String; S : String; Catalog: TCatalog; Finded: Boolean; IDNode: Integer; Node: TTreeNode; SrcNode: TTreeNode; NewTreeNode: TTreeNode; NewDat: PObjectData; NewID: Integer; ID_Cat: Integer; KolDir: Integer; KolCompon: Integer; SCSCatalog: TSCSCatalog; SCSList: TSCSList; SrcComponent: TSCSComponent; NewComponent: TSCSComponent; IDIndex: Integer; LastTick, CurrTick: Cardinal; STick: Cardinal; ETick: Cardinal; // Переменные для определения текущей позиции процесса копирования function CopyTreeCatalog(AID_SrcCatalog: Integer; AParentTrgNode: TTreeNode): TTreeNode; var ChildNodes: TIntList; Compons: TIntList; NewNode: TTreeNode; NewCompNode: TTreeNode; NewCatalogID: Integer; NewCompID: Integer; CompDat: PObjectData; SCS_ID: Integer; SCSCompon: TSCSComponent; i: Integer; CatalogCurrencies: TList; begin Result := nil; SetSQLToFIBQuery(DM.Query, ' select * from katalog where id = '''+ IntToStr(AID_SrcCatalog) +''' '); if GDBMode = bkProjectManager then SCS_ID := DM.Query.FN(fnSCSID).AsInteger else SCS_ID := 0; NewNode := MakeDir(cfBase, AParentTrgNode, DM.Query.FN('Name').AsString, DM.Query.FN(fnIDItemType).AsInteger, nil, -1, {DM.Query.FN(fnKolCompon).AsInteger,} 0, DM.Query.FN(fnSortID).AsInteger, false); NewCatalogID := PObjectData(NewNode.Data).ObjectID; // !!!!!!!!!!!!!!!!!!! ФАКТИЧЕСКИ НЕ ЮЗАЕТСЯ !!!!!!!!!!!!! // копировать свойства папок, если ProjectManager if GDBMode = bkProjectManager then begin SetSQLToFIBQuery(DM.Query, ' SELECT * FROM CATALOG_PROP_RELATION '+ ' WHERE ID_CATALOG = '''+ IntToStr(AID_SrcCatalog) +''' '); SetSQLToFIBQuery(DM.Query_Operat, ' insert into catalog_prop_relation (id_catalog, id_property, pvalue) '+ ' Values(:id_catalog, :id_property, :pvalue) ', false); while Not DM.Query.Eof do begin DM.Query_Operat.Close; DM.Query_Operat.ParamByName('id_catalog').AsInteger := NewCatalogID; DM.Query_Operat.ParamByName('ID_Property').AsInteger := DM.Query.FN('ID_Property').AsInteger; DM.Query_Operat.ParamByName('PValue').AsString := DM.Query.FN('PValue').AsString; DM.Query_Operat.ExecQuery; end; end else if GDBMode = bkNormBase then begin CatalogCurrencies := GetObjectCurrencies(AID_SrcCatalog, DM.Query_Select); if CatalogCurrencies <> nil then begin if CatalogCurrencies.Count > 0 then CreateDefCurrenciesForObject(NewCatalogID, DM.Query_Select, DM.Query_Operat, CatalogCurrencies); FreeList(CatalogCurrencies); end; end; //*** Копирование подпапок SetSQLToFIBQuery(DM.Query, ' select id from katalog where parent_id = '''+ IntToStr(AID_SrcCatalog) +''' order by sort_id '); ChildNodes := TIntList.Create; IntFIBFieldToIntList(ChildNodes, DM.Query, fnID); for i := 0 to ChildNodes.Count - 1 do CopyTreeCatalog(Integer(ChildNodes[i]), NewNode); FreeandNil(ChildNodes); //*** Копирование компонент //SetSQLToFIBQuery(DM.Query, ' SELECT ID FROM COMPONENT '+ // ' WHERE ID IN (SELECT ID_COMPONENT FROM CATALOG_RELATION '+ // ' WHERE ID_Catalog = '''+ IntToStr(AID_SrcCatalog) +''') '+ // ' ORDER BY SORT_ID '); SetSQLToFIBQuery(DM.Query, 'SELECT Component.ID FROM COMPONENT, CATALOG_RELATION '+ 'WHERE (ID_CATALOG = '''+IntToStr(AID_SrcCatalog)+''') and '+ '(Component.ID = ID_Component) '+ 'ORDER BY SORT_ID '); Compons := TIntList.Create; IntFIBFieldToIntList(Compons, DM.Query, fnID); for i := 0 to Compons.Count - 1 do CopyComponentFromNbToPm(Self, self, nil, NewNode, Compons[i], ckCompon, true); FreeandNil(Compons); Result := NewNode; CurrTick := GetTickCount; if (CurrTick - LastTick) >= 1000 then begin LastTick := CurrTick; Application.ProcessMessages; //ProcessMessagesEx; end; end; begin try try NewTreeNode := nil; SrcComponent := nil; NewComponent := nil; ProcessMessagesEx; Act_HideHints.Execute; DatS := nil; DatT := nil; SrcNode := nil; LastTick := GetTickCount; GTNode := Tree_Catalog.Selected; if GTNode <> nil then begin GTNode := GetTargetNodeForItemType(GTNode, GSDat.ItemType, qmUndef); DatT := GTNode.Data; end; if GSDat.ItemType = itList then begin if GSCSBase.CurrProject.Active then begin if FIsBufferedList then begin BeginProgress; try if (DatT = nil) or (DatT.ItemType = itProject) then SCSCatalog := GSCSBase.CurrProject else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(DatT.ObjectID); IDIndex := GSCSBase.CurrProject.NoSaveListsToFiles.IndexOfByString(GetAnsiTempPath + fnBufferedList); if IDIndex <> -1 then begin SCSList := GSCSBase.CurrProject.GetListByID(GSCSBase.CurrProject.NoSaveListsToFiles.GetIDByIndex(IDIndex)); if SCSList <> nil then SCSList.SaveToStreamOrFile(nil, GSCSBase.CurrProject.NoSaveListsToFiles.GetStringByIndex(IDIndex)); GSCSBase.CurrProject.NoSaveListsToFiles.Delete(IDIndex); end; GSCSBase.CurrProject.AddListFromFile(GetAnsiTempPath + fnBufferedList, SCSCatalog); finally EndProgress; end; end; end else MessageModal(CNoExistsActiveProject, ApplicationName, MB_ICONINFORMATION or MB_OK); end else begin if SrcNode = nil then begin if GSDat.ItemType in [itComponCon, itComponLine] then SrcNode := FindComponOrDirInTree(GSDat.ObjectID, true) else SrcNode := FindComponOrDirInTree(GSDat.ObjectID, false); end; if Not Assigned(SrcNode) then begin ShowMessageByType(0, smtDisplay, cMain_Msg63, Application.Title, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; //GTNode := Tree_Catalog.Selected; //GTNode := GetTargetNodeForItemType(GTNode, PObjectData(SrcNode.Data).ItemType); //******** Проверки на возможность вставки if GTNode = nil then Exit; ///// EXIT //// DefineChildNodes(GTNode); TrgName := GTNode.Text; CutColFromStr(TrgName); SrcName := SrcNode.Text; CutColFromStr(SrcName); if HaveNodeSub(SrcNode, GTNode) then begin MessageModal(cMain_Msg64_1+' "'+SrcName+'"' + cMain_Msg64_2+' "'+TrgName+'"', cMain_Msg65, MB_OK or MB_ICONERROR); Tree_Catalog.SetFocus; Exit; //// EXIT //// end; if Not CanParantNodeHaveChildItemInTreeView(GTNode, PObjectData(SrcNode.Data).ItemType, qmUndef) then begin MessageModal(cMain_Msg66_1+' "'+SrcName+'" '+cMain_Msg66_2+' "'+TrgName+'"', cMain_Msg65, MB_OK or MB_ICONERROR); Tree_Catalog.SetFocus; Exit; //// EXIT //// end; BeginProgress; DatS := SrcNode.Data; DatT := GTNode.Data; case GEditKind of ekCopy: begin DatT := GTNode.Data; //if DatT.ItemType in [itComponLine, itComponCon] then // GTNode := GTNode.Parent; //IDNode := DatS.ObjectID; KolDir := 0; KolCompon := 0; case DatS.ItemType of itDir, itProject, itRoom, itSCSLine,itSCSConnector: begin NewTreeNode := CopyTreeCatalog(DatS.ObjectID, GTNode); end; itComponLine, itComponCon: begin //*** Если цель не компонент, а папка if Not (DatT.ItemType in [itComponLine, itComponCon]) then begin case GDBMode of bkNormBase: begin DatPS := SrcNode.Parent.Data; NewID := CopyComponentFromNbToPm(Self, Self, SrcNode, GTNode, DatS.ObjectID, ckCompon, true); NewTreeNode := FindComponOrDirInTree(NewID, true); NewDat := NewTreeNode.Data; end; bkProjectManager: begin NewID := CopyComponentFromNbToPm(Self, self, nil, GTNode, DatS.ObjectID, ckCompon, true); Node := FindComponOrDirInTree(NewID, true); if Node <> nil then NewTreeNode := Node; NewComponent := GSCSBase.CurrProject.GetComponentFromReferences(NewID); if Assigned(NewComponent) then begin if NewComponent.IsLine = biTrue then AutoConnectOnAppendCable(NewComponent.GetFirstParentCatalog.SCSID); F_ChoiceConnectSide.DefineObjectParamsInFuture(NewComponent.GetFirstParentCatalog); end; end; end; FillCompl(PObjectData(NewTreeNode.Data).ObjectID, NewTreeNode); end else //Если цель компонент, то добавить комплектующую begin if GDBMode = bkNormBase then begin SrcComponent := TSCSComponent.Create(Self); SrcComponent.LoadComponentByID(DatS.ObjectID); end else if GDBMode = bkProjectManager then SrcComponent := GSCSBase.CurrProject.GetComponentFromReferences(DatS.ObjectID); if SrcComponent <> nil then begin PauseProgress(true); try AddComplect(Self, SrcNode, GTNode, SrcComponent, cntComplect, 1, false); finally PauseProgress(false); end; if GDBMode = bkNormBase then FreeAndNil(SrcComponent); end; //Act_DropTreeCopy.Execute; end; end; end; if NewTreeNode <> nil then begin NewTreeNode.Expanded := false; Tree_Catalog.Selected := NewTreeNode; SortByVetv(GTNode); //Tree_Catalog.Selected := NewTreeNode; SetSortID(NewTreeNode); //SetKol(NewTreeNode, nil); //SetKol(GTNode, nil); end; end; ekCut: begin //*** Если в НБ перемещается компонент в компонент, то переместить еего в папку if DatT.ItemType in [itComponLine, itComponCon] then if GDBMode = bkNormBase then begin GTNode := GetTargetNodeForItemType(GTNode, itDir, qmUndef); if GTNode <> nil then DatT := GTNode.Data; end; if GTNode <> nil then begin PauseProgress(true); try Act_MoveDir.Execute; // Перемещение и перещет количества finally PauseProgress(false); end; DatS := SrcNode.Data; //GSNode.ImageIndex := GetNodeImageIndex(DatS.ItemType, ekNone, DatS.ObjectID); SetNodeState(SrcNode, DatS.ItemType, ekNone); GEditKind := ekCopy; SortByVetv(GTNode); SetSortID(SrcNode); Tree_Catalog.Selected := SrcNode; end; end; end; Tree_CatalogChange(Self, Tree_Catalog.Selected); Tree_Catalog.SetFocus; end; except case GEditKind of ekCopy : MessageModal(cMain_Msg67, cMain_Msg65, MB_OK or MB_ICONERROR); ekCut : MessageModal(cMain_Msg68, cMain_Msg65, MB_OK or MB_ICONERROR); end; end; finally EndProgress; end; end; *) // ##### Скрыть Рисунок ##### procedure TF_MAIN.Act_HideHintsExecute(Sender: TObject); begin if F_ImageShow = nil then F_ImageShow := TF_ImageShow.Create(Self, TForm(Self)); if F_ImageShow <> nil then if F_ImageShow.Visible then F_ImageShow.Hide; GWhoChange := wcNone; if Assigned(F_AnswerToQuast) then F_AnswerToQuast.HideHint; Timer_NodeHint.Enabled := false; end; // ########################### Перемещение (Вверх / Вниз) ######################## // ############################################################################### // // ##### Развернуть все Папки ##### procedure TF_MAIN.Act_MaximizeDirExecute(Sender: TObject); var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin //ExpandTree(Self, ttComponents); OldTick := GetTickCount; LockTreeAndGrid(true); try ExpandNode(Tree_Catalog.Selected, true); finally LockTreeAndGrid(false); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {BeginProgress; try ExpandNode(Tree_Catalog.Selected, true); finally EndProgress; end;} end; // ##### Свернуть все папки ##### procedure TF_MAIN.Act_MinimizeDirExecute(Sender: TObject); begin //CollapseTree(Self, ttComponents); //EnableEditDel(itAuto); if Tree_Catalog.Selected <> nil then begin {BeginProgress; try Tree_Catalog.Selected.Collapse(true); finally EndProgress; end;} CollapseNode(Tree_Catalog.Selected, true); Tree_Catalog.OnChange(Tree_catalog, Tree_Catalog.Selected); end; end; // ##### Установить Sort_ID для ветви дерева ##### procedure TF_MAIN.SetSortID(ANode: TTreeNode; AObject: TObject); var ParentID: Integer; NewSortID: Integer; CurrDat: PObjectData; PrevDat: PObjectData; PrevNode: TTreeNode; CurrRecNo: Integer; PrevRecNo: Integer; SortID: Integer; //s: String; QueryMode: TQueryMode; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; ParentCatalog: TSCSCatalog; begin CurrDat := ANode.Data; if CurrDat = nil then exit; NewSortID := 0; QueryMode := GetQueryModeByNode(GDBMode, ANode, GetQueryModeByGDBMode(GDBMode)); case CurrDat.ItemType of itComponLine, itComponCon: begin CurrDat.SortID := 0; if ANode <> ANode.Parent.getFirstChild then begin PrevNode :=ANode.GetPrevSibling; PrevDat := PrevNode.Data; if (PrevDat <> nil) and Not(PrevDat.ItemType in [itDir, itSCSLine, itSCSConnector]) then CurrDat.SortID := PrevDat.SortID + 1; end; case QueryMode of qmPhisical: DM.UpdateComponFieldAsInteger(CurrDat.ObjectID, CurrDat.SortID, fnSortID); qmMemory: begin SCSComponent := nil; if (AObject <> nil) and (AObject is TSCSComponent) and (TSCSComponent(AObject).ID = CurrDat.ObjectID) then SCSComponent := TSCSComponent(AObject) else SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(CurrDat.ObjectID); if SCSComponent <> nil then SCSComponent.SortID := CurrDat.SortID; end; end; end; else begin //*** Вычислить Parent case QueryMode of qmPhisical: begin ParentID := DM.GetCatalogFieldValueAsInteger(CurrDat.ObjectID, fnID, fnParentID, QueryMode); //*** Найти последний SORT_ID NewSortID := 1 + DM.GetCatalogMaxFieldValueByFilter(fnSortID, 'parent_id = '''+IntToStr(ParentID)+'''', QueryMode); DM.UpdateCatalogFieldAsInteger(CurrDat.ObjectID, NewSortID, fnID, fnSortID, QueryMode); if CurrDat.ItemType = itProject then if CurrDat.ObjectID = GSCSBase.CurrProject.CurrID then GSCSBase.CurrProject.SortID := NewSortID; end; qmMemory: begin SCSCatalog := nil; if (AObject <> nil) and (AObject is TSCSCatalog) and (TSCSCatalog(AObject).ID = CurrDat.ObjectID) then SCSCatalog := TSCSCatalog(AObject) else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(CurrDat.ObjectID); if SCSCatalog <> nil then begin ParentCatalog := TSCSCatalog(SCSCatalog.Parent); if ParentCatalog <> nil then NewSortID := 1 + ParentCatalog.ChildCatalogs.GetMaxSortID; SCSCatalog.SortID := NewSortID; end; end; end; CurrDat.SortID := NewSortID; end; end; end; // ##### Переместить (Вверх / Вниз) ##### procedure TF_MAIN.MoveTreeNode(AMoveType: TMoveType); var i: Integer; Nodes:TList; CurrNode : TTreeNode; //PrevNode : TTreeNode; //NextNode : TTreeNode; //FirstNode: TTreeNode; //LastNode : TTreeNode; CurrDat: PObjectData; //PrevDat: PObjectData; //NextDat: PObjectData; //TableKind: TTableKind; CanMoveNodes: Boolean; CanMove: Boolean; ListsInterChangeMessRes: Integer; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; ParentCatalog: TSCSCatalog; function CompareNodesUp(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TTreeNode(Item1).AbsoluteIndex, TTreeNode(Item2).AbsoluteIndex); end; function CompareNodesDown(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TTreeNode(Item2).AbsoluteIndex, TTreeNode(Item1).AbsoluteIndex); end; function GetTableKind(ATreeNode: TTreeNode): TTableKind; begin Result := tkComponent; case PObjectData(ATreeNode.Data).ComponKind of ckCompon: Result := tkComponent; ckCompl : Result := tkComplect; end; end; function MoveNode(ANode: TTreeNode; AChek: Boolean): Boolean; var PrevNode : TTreeNode; NextNode : TTreeNode; FirstNode: TTreeNode; LastNode : TTreeNode; NodeDat: PObjectData; PrevDat: PObjectData; NextDat: PObjectData; SrchNode, SrchPrevNode: TTreeNode; SrchNodeDat: PObjectData; begin Result := false; PrevNode := nil; PrevDat := nil; NodeDat := ANode.Data; case AMoveType of mtUp: begin FirstNode := ANode.Parent.getFirstChild; PrevNode := ANode.getPrevSibling; if PrevNode <> nil then PrevDat := PrevNode.Data; case NodeDat.ItemType of itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: begin if ANode <> FirstNode then //if ((NodeDat.ItemType <> itRoom) and (PrevDat.ItemType <> itRoom)) or // ((NodeDat.ItemType = itRoom) and (PrevDat.ItemType = itRoom)) then if IsTreeViewItemTypesOfCommonKind(NodeDat.ItemType, PrevDat.ItemType) then begin Result := true; end; if NodeDat.ItemType = itList then case PrevDat.ItemType of itDir: Result := false; itList: if Not CanListsInterchange(NodeDat.ListID, PrevDat.ListID, @ListsInterChangeMessRes) then begin Result := false; // Если на перемещаемом листе нету м.э переходов, то можно его запиздячить в самый низ if (ListsInterChangeMessRes <> IDCANCEL) and Not CheckListWithFloorRaise(NodeDat.ListID) then begin SrchNode := PrevNode.getPrevSibling; SrchPrevNode := nil; while SrchNode <> nil do begin SrchNodeDat := SrchNode.Data; if SrchNodeDat.ItemType = itList then begin // Если текущий уже без м.э переходов, то меняем с предыдущим, на котором есть м.э. переход if CanListsInterchange(NodeDat.ListID, SrchNodeDat.ListID, @ListsInterChangeMessRes, false) then begin if SrchPrevNode <> nil then begin PrevNode := SrchPrevNode; Result := true; Break; //// BREAK //// end; end // Если след. нету, то зменяем с SrchNode else if SrchNode.getPrevSibling = nil then begin PrevNode := SrchNode; Result := true; Break; //// BREAK //// end; SrchPrevNode := SrchNode; end; SrchNode := SrchNode.getPrevSibling; end; end; PrevDat := PrevNode.Data; end; end; if Result and Not AChek then begin DM.ExchangeNodes(PrevNode, ANode, tkCatalog); //ExchNodes(ANode, PrevNode, naInsert); MoveNodeTo(ANode, PrevNode, naInsert); end; end; itComponLine, itComponCon: if (ANode <> FirstNode) and Not(PrevDat.ItemType in [itDir, itSCSLine, itSCSConnector]) then begin Result := true; if Not AChek then begin MoveNodeTo(ANode, PrevNode, naInsert); DM.ExchangeNodes(PrevNode, ANode, GetTableKind(ANode)); end; end; end; end; mtDown: begin LastNode := ANode.Parent.GetLastChild; NextNode := ANode.getNextSibling; if NextNode <> nil then case NodeDat.ItemType of itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: begin NextDat := NextNode.Data; Result := false; if (ANode <> LastNode) and (ANode.Level = LastNode.Level) and ( Not( NextDat.ItemType in [itComponLine, itComponCon])) then //if ((NodeDat.ItemType <> itRoom) and (NextDat.ItemType <> itRoom)) or // ((NodeDat.ItemType = itRoom) and (NextDat.ItemType = itRoom)) then if IsTreeViewItemTypesOfCommonKind(NodeDat.ItemType, NextDat.ItemType) then begin Result := true; end; case NodeDat.ItemType of itDir: if NextDat.ItemType = itList then Result := false; itList: if NextDat.ItemType = itList then begin if Not CanListsInterchange(NodeDat.ListID, NextDat.ListID, @ListsInterChangeMessRes) then begin Result := false; // Если на перемещаемом листе нету м.э переходов, то можно его запиздячить в самый низ if (ListsInterChangeMessRes <> IDCANCEL) and Not CheckListWithFloorRaise(NodeDat.ListID) then begin SrchNode := NextNode.getNextSibling; SrchPrevNode := nil; while SrchNode <> nil do begin SrchNodeDat := SrchNode.Data; if SrchNodeDat.ItemType = itList then begin // Если текущий уже без м.э переходов, то меняем с предыдущим, на котором есть м.э. переход if CanListsInterchange(NodeDat.ListID, SrchNodeDat.ListID, @ListsInterChangeMessRes, false) then begin if SrchPrevNode <> nil then begin NextNode := SrchPrevNode; Result := true; Break; //// BREAK //// end; end // Если след. нету, то зменяем с SrchNode else if SrchNode.getNextSibling = nil then begin NextNode := SrchNode; Result := true; Break; //// BREAK //// end; SrchPrevNode := SrchNode; end; SrchNode := SrchNode.getNextSibling; end; end; NextDat := NextNode.Data; end; end; end; if Result and Not AChek then begin //ExchangeNodes(NextNode, ANode, DM.DataSet_Catalog); DM.ExchangeNodes(NextNode, ANode, tkCatalog); if NextNode.Index < LastNode.Index then //ANode.MoveTo(NextNode.getNextSibling, naInsert) //ExchNodes(ANode, NextNode.getNextSibling, naInsert) MoveNodeTo(ANode, NextNode.getNextSibling, naInsert) else //ANode.MoveTo(NextNode, naAdd); //ExchNodes(ANode, NextNode, naAdd); MoveNodeTo(ANode, NextNode, naAdd); end; end; itComponLine, itComponCon: if ANode <> LastNode then begin Result := true; if Not AChek then begin NextDat := NextNode.Data; if NextNode.Index < LastNode.Index then MoveNodeTo(ANode, NextNode.getNextSibling, naInsert) else MoveNodeTo(ANode, NextNode, naAdd); DM.ExchangeNodes(NextNode, ANode, GetTableKind(ANode)); end; end; end; end; end; if ListsInterChangeMessRes = IDCANCEL then Result := false; end; begin if Not CheckWritePM(true) then Exit; ///// EXIT ///// //16.01.2012 PrevNode := nil; //16.01.2012 PrevDat := nil; CanMoveNodes := true; ListsInterChangeMessRes := -1; Nodes := TList.Create; Tree_Catalog.GetSelections(Nodes); //for i := 0 to Tree_Catalog.SelectionCount - 1 do // Nodes.Add(Tree_Catalog.Selections[i]); // Если вверх, то сортируем по порядку, иначе в обратном порядке if Nodes.Count > 1 then begin // Проверяем можно ли переместить все for i := 0 to Nodes.Count - 1 do begin if Not MoveNode(TTreeNode(Nodes[i]), true) then begin CanMoveNodes := false; Break; //// BREAK //// end; end; if CanMoveNodes then begin case AMoveType of mtUp: Nodes.Sort(@CompareNodesUp); mtDown: Nodes.Sort(@CompareNodesDown); end; end; end; //16.01.2012 CurrNode := Tree_Catalog.Selected; if CanMoveNodes then begin Tree_Catalog.Items.BeginUpdate; try // Снять выбеление - так как происходит почемуто expand на multiselect if Nodes.Count > 1 then for i := 0 to Nodes.Count - 1 do Tree_Catalog.Deselect(TTreeNode(Nodes[i])); for i := 0 to Nodes.Count - 1 do begin CurrNode := TTreeNode(Nodes[i]); CurrDat := CurrNode.Data; CanMove := MoveNode(CurrNode, false); //16.01.2012 // CanMove := false; // case AMoveType of // mtUp: // begin // FirstNode := CurrNode.Parent.getFirstChild; // PrevNode := CurrNode.getPrevSibling; // if PrevNode <> nil then // PrevDat := PrevNode.Data; // case CurrDat.ItemType of // itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: // begin // if CurrNode <> FirstNode then // //if ((CurrDat.ItemType <> itRoom) and (PrevDat.ItemType <> itRoom)) or // // ((CurrDat.ItemType = itRoom) and (PrevDat.ItemType = itRoom)) then // if IsTreeViewItemTypesOfCommonKind(CurrDat.ItemType, PrevDat.ItemType) then // begin // CanMove := true; // end; // if CurrDat.ItemType = itList then // case PrevDat.ItemType of // itDir: // CanMove := false; // itList: // if Not CanListsInterchange(CurrDat.ListID, PrevDat.ListID) then // CanMove := false; // end; // // if CanMove then // begin // DM.ExchangeNodes(PrevNode, CurrNode, tkCatalog); // //ExchNodes(CurrNode, PrevNode, naInsert); // MoveNodeTo(CurrNode, PrevNode, naInsert); // end; // end; // itComponLine, itComponCon: // if (CurrNode <> FirstNode) and // Not(PrevDat.ItemType in [itDir, itSCSLine, itSCSConnector]) then // begin // CanMove := true; // MoveNodeTo(CurrNode, PrevNode, naInsert); // TableKind := GetTableKind(CurrNode); // DM.ExchangeNodes(PrevNode, CurrNode, TableKind); // end; // end; // end; // mtDown: // begin // LastNode := CurrNode.Parent.GetLastChild; // NextNode := CurrNode.getNextSibling; // if NextNode <> nil then // case CurrDat.ItemType of // itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: // begin // NextDat := NextNode.Data; // CanMove := false; // if (CurrNode <> LastNode) and // (CurrNode.Level = LastNode.Level) and // ( Not( NextDat.ItemType in [itComponLine, itComponCon])) then // //if ((CurrDat.ItemType <> itRoom) and (NextDat.ItemType <> itRoom)) or // // ((CurrDat.ItemType = itRoom) and (NextDat.ItemType = itRoom)) then // if IsTreeViewItemTypesOfCommonKind(CurrDat.ItemType, NextDat.ItemType) then // begin // CanMove := true; // end; // // case CurrDat.ItemType of // itDir: // if NextDat.ItemType = itList then // CanMove := false; // itList: // if NextDat.ItemType = itList then // if Not CanListsInterchange(CurrDat.ListID, NextDat.ListID) then // CanMove := false; // end; // // if CanMove then // begin // //ExchangeNodes(NextNode, CurrNode, DM.DataSet_Catalog); // DM.ExchangeNodes(NextNode, CurrNode, tkCatalog); // if NextNode.Index < LastNode.Index then // //CurrNode.MoveTo(NextNode.getNextSibling, naInsert) // //ExchNodes(CurrNode, NextNode.getNextSibling, naInsert) // MoveNodeTo(CurrNode, NextNode.getNextSibling, naInsert) // else // //CurrNode.MoveTo(NextNode, naAdd); // //ExchNodes(CurrNode, NextNode, naAdd); // MoveNodeTo(CurrNode, NextNode, naAdd); // end; // end; // itComponLine, itComponCon: // if CurrNode <> LastNode then // begin // CanMove := true; // NextDat := NextNode.Data; // if NextNode.Index < LastNode.Index then // MoveNodeTo(CurrNode, NextNode.getNextSibling, naInsert) // else // MoveNodeTo(CurrNode, NextNode, naAdd); // TableKind := GetTableKind(CurrNode); // DM.ExchangeNodes(NextNode, CurrNode, TableKind); // end; // end; // end; // end; if CanMove then begin if CurrDat.ItemType in [itComponLine, itComponCon] then begin SCSComponent := nil; SCSCatalog := nil; if GDBMode = bkNormBase then begin SCSComponent := TSCSComponent.Create(TForm(Self)); SCSComponent.LoadComponentByID(CurrDat.ObjectID, false); end; if GDBMode = bkProjectManager then SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(CurrDat.ObjectID); if Assigned(SCSComponent) then try if Assigned(SCSComponent.Parent) then begin if SCSComponent.Parent is TSCSComponent then begin TSCSComponent(SCSComponent.Parent).SortComplects; TSCSComponent(SCSComponent.Parent).ReloadChildReferences; //*** Обновить магистраль if TSCSComponent(SCSComponent.Parent).Parent is TSCSCatalog then F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(TSCSComponent(SCSComponent.Parent), false); end; if SCSComponent.Parent is TSCSCatalog then TSCSCatalog(SCSComponent.Parent).SCSComponents.SortBySortID; SCSCatalog := SCSComponent.GetFirstParentCatalog; if (SCSCatalog <> nil) and (GDBMode = bkProjectManager) then begin SCSCatalog.ReloadComponentReferences; OpenNoExistsListInCAD(SCSCatalog.GetListOwner); end; end; F_ChoiceConnectSide.OnAfterMoveComponInCatalog(SCSComponent); DefineConnectorObjectNodeName(SCSCatalog); finally if GDBMode = bkNormBase then FreeAndNil(SCSComponent); end; end; if CurrDat.ItemType in [itSCSLine, itSCSConnector, itRoom, itList, itDir] then if GDBMode = bkProjectManager then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(CurrDat.ObjectID); ParentCatalog := TSCSCatalog(SCSCatalog.Parent); if Assigned(ParentCatalog) then begin ParentCatalog.ChildCatalogs.SortBySortID; if ParentCatalog is TSCSProject then TSCSProject(ParentCatalog).ProjectLists.SortBySortID; end; end; end; end; // Восстановить выделенные if Nodes.Count > 1 then Tree_Catalog.Select(Nodes); finally Tree_Catalog.Items.EndUpdate; // Tolik 23/11/2016 -- Tree_Catalog.Invalidate; // end; end; Nodes.Free; end; // ##### Переместить вверх ##### procedure TF_MAIN.Act_MoveUPExecute(Sender: TObject); begin MoveTreeNode(mtUp); end; // ##### Переместить вниз ##### procedure TF_MAIN.Act_MoveDOWNExecute(Sender: TObject); begin MoveTreeNode(mtDown); end; // ############################## Drag & Drop по Дереву ########################## // ############################################################################### // // ##### DragOver ##### procedure TF_MAIN.Tree_Catalog_DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var TargetNode, SourceNode: TTreeNode; SrcParentNode: TTreeNode; Node: TTreeNode; ListNode: TTreeNode; WasWait: Boolean; Dat : PObjectData; SrcDat: PObjectData; SrcTemplateDat: PTemplateData; SrcListItem: TListItem; SrcComponGrpData: TComponGrpData; TrgDat: PObjectData; List: TSCSList; SprComponentType: TNBComponentType; AcceptRes: Boolean; function CanPutComponToSCSObject(AComponItemType: Integer; ATrgDat: PObjectData): Boolean; begin Result := false; if AComponItemType in [itComponLine, itComponCon] then if ((ATrgDat.ItemType = itSCSLine) and ((GisLineCopingCompon = biTrue) or IsSpecialTrace(ATrgDat.ListID, ATrgDat.ObjectID, 0)) ) or ((ATrgDat.ItemType = itSCSConnector) and (GisLineCopingCompon = biFalse) ) then Result := true; end; begin WasWait := false; try try // Скролинг дерева //ScrollTreeOnDrag(Tree_Catalog, X, Y); ScrollTreeOnDragByRect(Self, Tree_Catalog); TargetNode := Tree_Catalog.GetNodeAt(X, Y); if TargetNode = nil then Exit; //// EXIT //// SrcParentNode := nil; SourceNode := Tree_Catalog.Selected; // Tolik 19/05/2021 -- {if SourceNode <> nil then SrcParentNode := SourceNode.Parent; SrcDat := SourceNode.Data;} if SourceNode <> nil then begin SrcParentNode := SourceNode.Parent; SrcDat := SourceNode.Data; end // // Tolik 27/05/2021 -- else begin { Accept := false; AcceptRes := false; Tree_Catalog.Repaint; exit; } end; TrgDat := TargetNode.Data; ExpandCursorNodeByTimer(Self, Tree_Catalog, TargetNode, 1500); //WasWait := WaitBeforeDragExpand(900, TargetNode); //if WasWait then //begin // //AddNodes(TargetNode); // TargetNode.Expanded := true; //end; Accept := false; AcceptRes := false; // Drag Over по Дереву if TargetNode <> nil then begin Dat := TargetNode.Data; if Source = Sender then //( (Source <> Sender) and (GDBMode = bkProjectManager){ and (PObjectData(SourceNode.Data).ItemType = itComponent) }) then begin AcceptRes := true; SourceNode := Tree_Catalog.Selected; if SourceNode.Parent = nil then AcceptRes := false; if (Dat.NBMode = nbmNorm) and (Not GSCSIni.NB.IsAdministration) then AcceptRes := false; if HaveNodeSubByPObjectData(SourceNode, TargetNode) then AcceptRes := false; if Not CanParantNodeHaveChildItemInTreeView(TargetNode, PObjectData(SourceNode.Data).ItemType, PObjectData(SourceNode.Data).QueryMode) then begin AcceptRes := false; Exit; //// EXIT //// end; {} {if (PObjectData(SourceNode.Data).ItemType in [itSCSLine, itSCSConnector]) and (PObjectDAta(TargetNode.Data).ItemType = itRoom) and (PObjectData(SourceNode.Data).ListID = PObjectDAta(TargetNode.Data).ListID) then AcceptRes := true;} if GDBMode = bkProjectManager then begin ListNode := GetParentNodeByItemType(TargetNode, [itList]); if ListNode <> nil then if CanParantNodeHaveChildItemInTreeView(ListNode, PObjectData(SourceNode.Data).ItemType, qmUndef) then if PObjectData(SourceNode.Data).ListID <> PObjectData(TargetNode.Data).ListID then AcceptRes := false; if PObjectData(TargetNode.Data).ItemType = itProject then if GSCSBase.CurrProject.Active then if GSCSBase.CurrProject.CurrID <> PObjectData(TargetNode.Data).ObjectID then AcceptRes := false; if SrcParentNode <> nil then if PObjectData(SrcParentNode.Data).ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then AcceptRes := false; if IsSCSObjectItemType(PObjectData(SourceNode.Data).ItemType) then AcceptRes := false; if PObjectData(TargetNode.Data).ItemType = itRoom then AcceptRes := false; //*** Проект ни куда не перемещать //if PObjectData(SourceNode.Data).ItemType = itProject then // AcceptRes := false; end; end else if (Source.ClassName = Sender.ClassName) then begin if GDBMode = bkProjectManager then begin SourceNode := FNormBase.Tree_Catalog.Selected; SrcDat := SourceNode.Data; if Dat.ItemType in [itComponLine, itComponCon] then begin Node := GetComponNode(TargetNode); Dat := Node.Parent.Data; end; {//27.05.2009 if PObjectData(FNormBase.Tree_Catalog.Selected.Data).ItemType in [itComponLine, itComponCon] then if ((Dat.ItemType = itSCSLine) and ((GisLineCopingCompon = biTrue) or IsSpecialTrace(Dat.ListID, Dat.ObjectID, 0)) ) or ((Dat.ItemType = itSCSConnector) and (GisLineCopingCompon = biFalse) ) then //if (Dat.ItemType = itSCSLine) and AcceptRes := true; } if CanPutComponToSCSObject(SrcDat.ItemType, Dat) then AcceptRes := true; //*** Если кабель кидается на трассу if (SrcDat.ItemType = itComponLine) and (TrgDat.ItemType in [itSCSLine, itComponLine]) then begin List := GSCSBase.CurrProject.GetListBySCSID(TrgDat.ListID); if List <> nil then if Not List.Setting.PutCableInTrace then begin SprComponentType := List.Spravochnik.GetComponentTypeWithAssign(GDropComponent.GUIDComponentType, FNormBase.GSCSBase.NBSpravochnik); if SprComponentType <> nil then if CheckSysNameIsCable(SprComponentType.ComponentType.SysName) then AcceptRes := false; end; end; end else if GDBMode = bkNormBase then begin {$IF Defined(OEM_NIKOMAX)} AcceptRes := false; Accept := False; {$ELSE} AcceptRes := false; SourceNode := FProjectMan.Tree_Catalog.Selected; if SourceNode <> nil then // Tolik 27/05/2021 -- begin SrcDat := SourceNode.Data; if (SourceNode.ImageIndex <> tciiTemplateLine) and (SourceNode.ImageIndex <> tciiTemplateCon) then begin if TargetNode.Level >= dirCurrencyLevel then if (Dat.ItemType = itDir) and CanEditNode(Dat) {((Dat.NBMode <> nbmNorm) or (GSCSIni.NB.IsAdministration))} then if (SrcDat.ItemType in [itComponLine, itComponCon]) then AcceptRes := true; end; end // Tolik 27/05/2021 -- else begin {Accept := false; AcceptRes := false; Tree_Catalog.Repaint; exit;} end; {$IFEND} end; end else begin if GDBMode = bkProjectManager then begin if Source = FNormBase.FlvTemplate then begin SrcListItem := FNormBase.FlvTemplate.Selected; SrcTemplateDat := SrcListItem.Data; if CanPutComponToSCSObject(GetItemTypeByIsLine(SrcTemplateDat.IsLine), Dat) then AcceptRes := true; end else if Source = FNormBase.tvComponGroups then begin if FNormBase.tvComponGroups.Selected <> nil then begin SrcComponGrpData := TComponGrpData(FNormBase.tvComponGroups.Selected.Data); if (SrcComponGrpData <> nil) and (SrcComponGrpData.FComponData <> nil) then begin if CanPutComponToSCSObject(SrcComponGrpData.FComponData.ItemType, Dat) then AcceptRes := true; end; end; end; end; end; end; Accept := AcceptRes; except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_Catalog_DragOver: '+E.Message); end; finally if WasWait then Tree_Catalog.Repaint; end; end; // ##### DragDrop ##### procedure TF_MAIN.Tree_Catalog_DragDrop(Sender, Source: TObject; X, Y: Integer); var SourceNode: TTreeNode; Point: Tpoint; ItemType1, ItemType2: Integer; NewCopyID: Integer; NewNode: TTreeNode; SCSCompon: TSCSComponent; CatalogOwner: TSCSCatalog; IDUpperCompon1: Integer; IDUpperCompon2: Integer; VisibleDropTreeMove: Boolean; EnabledDropTreeMove: Boolean; IsArchCompon: Boolean; begin Cursor := crDefault; //SourceNode := GSNode; GTNode := Tree_Catalog.GetNodeAt(X, Y); GSNode := nil; if not Assigned(GSNodes) then GSNodes := TList.Create; GSNodes.Clear; if (GTNode <> nil) then begin if GDBMode = bkNormBase then begin if Tree_Catalog.SelectionCount > 1 then begin Tree_Catalog.GetSelections(GSNodes); end else GSNodes.Add(Tree_Catalog.Selected); end else begin GSNodes.Add(Tree_Catalog.Selected); end; end; if Sender = Source then if (GTNode <> nil) and (Sender = Source) then begin GSNode := Tree_Catalog.Selected; GetCursorPos(Point); //Act_MoveDir.Execute; //*** Убрать п.м. "Переместить" если комплектующая кидается в папку EnabledDropTreeMove := false; VisibleDropTreeMove := true; if (GDBMode = bkNormBase) and ( ( (PObjectData(GSNode.Data).ComponKind = ckCompl) and (PObjectData(GTNode.Data).ComponKind = ckNone) ) or //*** Или компонента в компоненту (Не компл-я в компоненту) ( (PObjectData(GSNode.Data).ComponKind = ckCompon) and (PObjectData(GTNode.Data).ComponKind in [ckCompon, ckCompl]) ) ) then EnabledDropTreeMove := false else if CheckWriteNB(false) then EnabledDropTreeMove := true; ItemType1 := PObjectData(GSNode.Data).ItemType; ItemType2 := PObjectData(GTNode.Data).ItemType; IsArchCompon := IsArchComponByItemType(ItemType1) or IsArchComponByItemType(ItemType2); if ItemType1 in [itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner] then begin EnabledDropTreeMove := false; VisibleDropTreeMove := false; end; Act_DropTreeMove.Enabled := EnabledDropTreeMove; Act_DropTreeMove.Visible := VisibleDropTreeMove; Act_DropTreeConnect.Visible := false; Act_DropTreeConnectChoicingInterfaces.Visible := false; if ((ItemType1 in [itComponLine, itComponCon]) and (ItemType2 in [itComponLine, itComponCon])) or ((ItemType1 in [itArhRoofHip, itArhRoofHipCorner]) and (ItemType2 in [itArhRoofHip, itArhRoofHipCorner])) or ((ItemType1 in [itArhRoofHip, itArhRoofSeg]) and (ItemType2 in [itArhRoofHip, itArhRoofSeg])) then begin //if ((ItemType1 = itComponLine) or (ItemType1 = itComponLine)) and // (GDBMode = bkProjectManager) then if (GDBMode = bkNormBase) and (CheckWriteNB(false)) then begin //*** Внутри компонентное подключение if GetCommonParentComponNode(GSNode, GTNode) <> nil then //if GSNode.Parent = GTNode.Parent then //if PObjectData(GSNode.Parent.Data).ItemType = ItemType1 then Act_DropTreeConnect.Visible := true; end; if GDBMode = bkProjectManager then begin Act_DropTreeConnect.Visible := true; if GUseVisibleInterfaces and Not IsArchCompon then Act_DropTreeConnectChoicingInterfaces.Visible := true; end; //else // // Соединение внутри точ. компоненты // if (ItemType1 = itComponCon) or (ItemType1 = itComponCon) then // begin // IDUpperCompon1 := DM.GetIDUpperComponByIDChild(PObjectData(GSNode.Data).ObjectID); // IDUpperCompon2 := DM.GetIDUpperComponByIDChild(PObjectData(GTNode.Data).ObjectID); // if IDUpperCompon1 = IDUpperCompon2 then // Act_DropTreeConnect.Visible := true; // end; end; {if (GDBMode = bkProjectManager) and (ItemType1 in [itComponLine, itComponCon]) and (ItemType2 in [itComponLine, itComponCon]) and Not( (ItemType1 = itComponCon) and (ItemType2 = itComponCon) ) then Act_DropTreeConnect.Visible := true else if Act_DropTreeConnect.Visible := false;} PopupMenu_DropInTree.Popup(Point.X, Point.Y); end; //*** Добавление компоненты. комплектующей с Нормативной базы if (Sender <> Source) and (GTNode <> nil) then begin //20.09.2010 if Source is TTreeView then GSNode := TTreeView(Source).Selected; if GDBMode = bkProjectManager then case PObjectData(GTNode.Data).ComponKind of ckNone: begin // UNDO SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); //try //LockTreeAndGrid(true); NewCopyID := CopyComponentFromNbToPm(FNormBase, FProjectMan, nil, GTNode, GID_CopingCompon, ckCompon, true); SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(NewCopyID); if Assigned(SCSCompon) then begin F_NormBase.DM.AddComponGUIDToFreqUseObj(SCSCompon.GuidNB); if SCSCompon.IsLine = biTrue then begin CatalogOwner := SCSCompon.GetFirstParentCatalog; if Assigned(CatalogOwner) then AutoConnectOnAppendCable(CatalogOwner.ListID, CatalogOwner.SCSID); end; end; NewNode := nil; NewNode := FindComponOrDirInTree(NewCopyID, true); if NewNode <> nil then Tree_Catalog.Selected := NewNode; //finally //LockTreeAndGrid(false); //end; end; ckCompon, ckCompl: begin AddComplect(FNormBase, GSNode, GTNode, GDropComponent, cntComplect, 1, false); //GTNode.Expanded := true; end; end; if GDBMode = bkNormBase then begin GSNode := FProjectMan.Tree_Catalog.Selected; if GSNode <> nil then if (PObjectData(GTNode.Data).ItemType = itDir) and (PObjectData(GSNode.Data).ItemType in [itComponLine, itComponCon]) then begin SCSCompon := FProjectMan.GSCSBase.CurrProject.GetComponentFromReferences(GID_CopingCompon); if SCSCompon <> nil then CopyComponentFromPMToNB(FProjectMan, Self, SCSCompon, PObjectData(GTNode.Data).ObjectID); end; end; end; //GSNode := SourceNode; end; // ##### Изменена вкладка на Tab-е ##### procedure TF_MAIN.Grid_CompDataActiveTabChanged(Sender: TcxCustomGrid; ALevel: TcxGridLevel); var Dat: PObjectData; tbAddResourceVisible: Boolean; procedure SetActToToolButton(AAction: TAction; AToolButton: TToolButton); begin AAction.Hint := AAction.Caption; AToolButton.Action := AAction; end; procedure SetActToToolComponData(AAct_Add, AAct_Edit, AAct_Del: TAction); begin //ToolButton_Add.Action := AAct_Add; //ToolButton_Change.Action := AAct_Edit; //ToolButton_Remove.Action := AAct_Del; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} { SetActToToolButton(AAct_Add, U_CAD.TToolButton(ToolButton_Add)); SetActToToolButton(AAct_Edit, U_CAD.TToolButton(ToolButton_Change)); SetActToToolButton(AAct_Del, U_CAD.TToolButton(ToolButton_Remove)); } SetActToToolButton(AAct_Add, ToolButton_Add); SetActToToolButton(AAct_Edit,ToolButton_Change); SetActToToolButton(AAct_Del, ToolButton_Remove); {$ELSE} SetActToToolButton(AAct_Add, ToolButton_Add); SetActToToolButton(AAct_Edit, ToolButton_Change); SetActToToolButton(AAct_Del, ToolButton_Remove); {$IFEND} pmnu_AddComponData.Action := AAct_Add; pmnu_EditComponData.Action := AAct_Edit; pmnu_DelComponData.Action := AAct_Del; pmnu_AddComponData.ImageIndex := 0; pmnu_EditComponData.ImageIndex := 1; pmnu_DelComponData.ImageIndex := 2; end; begin Dat := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if Dat = nil then Exit; tbAddResourceVisible := false; if (GDBMode = bkNormBase) or (Dat.ItemType in [itComponLine, itComponCon]) then begin Case ALevel.Index of cdliComplects: SetActToToolComponData(Act_AddCompRelation, Act_EditComplect, Act_DelCompRelation); cdliProperty: SetActToToolComponData(Act_AddProperty, Act_EditProperty, Act_RemoveProperty); cdliInterface: SetActToToolComponData(Act_AddInterface, Act_EditInterface, Act_DelInterface); cdliPort: SetActToToolComponData(Act_AddPort, Act_EditPort, Act_DelPort); cdliConnections: SetActToToolComponData(Act_AddConnection, Act_EditComplect, Act_DelConnection); cdliCableChannelElements: //Tolik 13/11/2021 -- //SetActToToolComponData(Act_AddCableChannelElement, Act_EditCableChannelElement, Act_DelCableChannelElement); begin //if ALevel.Caption = Capt_CableChanElements then if tcGridData.Tabs[GL_CableCanalConnectors.Index].Caption = Capt_CableChanElements then SetActToToolComponData(Act_AddCableChannelElement, Act_EditCableChannelElement, Act_DelCableChannelElement) else SetActToToolComponData(Act_AddTubeElement, Act_EditTubeElement, Act_DelTubeElement); end; // cdliCrossConnections: SetActToToolComponData(Act_AddCrossConnection, Act_EditCrossConnection, Act_DelCrossConnection); cdliObjectCurrency: SetActToToolComponData(Act_MakeObjectCurrency, Act_EditObjectCurrency, Act_DelObjectCurrency); cdliNormsResources: begin SetActToToolComponData(Act_MakeNorm, Act_EditNormResource, Act_DelNormResource); tbAddResourceVisible := true; //SetActToToolButton(Act_MakeResource, ToolButton_AddResource); //SetActToToolButton(Act_MakeResourceCompon, tbAddResourceCompon); end; end; if GDBMode = bkProjectManager then GActiveLevelIndex := ALevel.Index; end else if GDBMode = bkProjectManager then Case ALevel.Index of cdliProperty: SetActToToolComponData(Act_AddProperty, Act_EditProperty, Act_RemoveProperty); cdliPort: SetActToToolComponData(Act_AddPort, Act_EditPort, Act_DelPort); cdliConnections: SetActToToolComponData(Act_AddConnection, Act_EditComplect, Act_DelConnection); cdliNormsResources: begin //Dat.ItemType in [itComponLine, itComponCon] SetActToToolComponData(Act_MakeNorm, Act_EditNormResource, Act_DelNormResource); tbAddResourceVisible := true; end; end; ToolButton_Add.ImageIndex := 0; ToolButton_Change.ImageIndex := 1; ToolButton_Remove.ImageIndex := 2; ToolButton_AddResource.ImageIndex := 4; tbAddResourceCompon.ImageIndex := 3; pmMakeResource.ImageIndex := ToolButton_AddResource.ImageIndex; pmMakeResourceCompon.ImageIndex := tbAddResourceCompon.ImageIndex; //ToolButton_AddResource.Visible := tbAddResourceVisible; //tbAddResourceCompon.Visible := tbAddResourceVisible; Act_MakeResource.Visible := tbAddResourceVisible; Act_MakeResourceCompon.Visible := tbAddResourceVisible; //EnableEditDel(Dat.ItemType); // *** GT_INTERFACE.DataController.GridView.ViewData.RefreshRecords ***; // *** GT_INTERFACE.DataController.GridView.ViewData.DataController. Много полезного;*** //*** Поправить вкладку в TabControl if ALevel.Index <> tcGridData.TabIndex then begin tcGridData.OnChange := nil; try tcGridData.TabIndex := ALevel.Index; finally tcGridData.OnChange := tcGridDataChange; end; end; end; // ##### Начало Редактирования ветви ##### procedure TF_MAIN.Tree_CatalogEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean); var NodeDat: PObjectData; ParentProjNode: TTreeNode; begin if Node = nil then Exit; //// EXIT //// if Node.Parent = nil then begin AllowEdit := false; Exit; //// EXIT //// end; NodeDat := Node.Data; if GDBMode = bkProjectManager then if NodeDat.ItemType = itProject then if (GSCSBase.CurrProject.Active = false) or ((GSCSBase.CurrProject.Active = true) and (GSCSBase.CurrProject.CurrID <> NodeDat.ObjectID)) then begin AllowEdit := false; Exit; //// EXIT //// end; ParentProjNode := GetParentNodeByItemType(Node, [itProject]); if (ParentProjNode = nil) or (ParentProjNode = Node) then if Not CheckWritePM(true) then begin AllowEdit := false; Exit; ///// EXIT ///// end; TTreeView(Sender).OnEditing := nil; AllowEdit := false; GTree_Contr := TTreeView(Sender); Timer_TreeContr.Enabled := true; end; procedure TF_MAIN.Timer_TreeContrTimer(Sender: TObject); var TextNode: String; begin try TTimer(Sender).Enabled := false; if GTree_Contr <> nil then if (TTreeView(GTree_Contr).Selected <> nil) and Not(PObjectData(TTreeView(GTree_Contr).Selected.Data).ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup]) then //Not(PObjectData(GTree_Contr.Selected.Data).ItemType in [itSCSLineGroup, itSCSConnGroup]) then begin TextNode := GetNameNode(TTreeView(GTree_Contr).Selected, nil, false, false); TTreeView(GTree_Contr).Selected.Text := TextNode; //12.04.2011 TTreeView(GTree_Contr).Selected.EditText; TESTreeView(GTree_Contr).EditNode(TTreeView(GTree_Contr).Selected); end; finally TTreeView(GTree_Contr).OnEditing := Tree_CatalogEditing; end; end; // ############################# Поиск в дереве ################################ // ############################################################################# // // ##### Включить / Выключить режим Поиска ##### procedure TF_MAIN.Act_ChoiceFindExecute(Sender: TObject); var CanUnCheck: Boolean; begin splFindInTree.Enabled := Act_ChoiceFind.Checked; splFindInTree.Visible := Act_ChoiceFind.Checked; case Act_ChoiceFind.Checked of true: begin if GDBMode = bkNormBase then sbSelectFromSearchInCAD.Visible := false; if GDBMode = bkProjectManager then if Not GSCSBase.CurrProject.Active then begin MessageModal(cMain_Msg69, ApplicationName, MB_ICONINFORMATION or MB_OK); Act_ChoiceFind.Checked := false; Exit; ///// EXIT ///// end; pcFind.Visible := true; if FFilterParams.IsUseFilter then //if (FFilterParams.FFilterBlock <> nil) and (FFilterParams.FFilterBlock.IsOn) then pcFind.ActivePage := tsFilter else ButtonEdit_Find.SetFocus; end; false: begin CanUnCheck := true; // Не скрывать панель поиска/фильтра в режиме фильтра if GFormMode = fmNormal then if pnFilterIsOn.Visible then begin CanUnCheck := false; Act_ChoiceFind.OnExecute := nil; try Act_ChoiceFind.Checked := true; finally Act_ChoiceFind.OnExecute := Act_ChoiceFindExecute; end; MessageModal(cMain_Msg149, ApplicationName, MB_OK or MB_ICONINFORMATION); if pcFind.ActivePage <> tsFilter then pcFind.ActivePage := tsFilter; end; if CanUnCheck then begin pcFind.Visible := false; ListView_Find.OnChange := nil; ClearListView(ListView_Find); end; end; end; end; // ##### Запустить Поиск ##### procedure TF_MAIN.ButtonEdit_FindPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); var ListItem : TListItem; SQLwhere: String; FieldNames: TStringList; //Strn: String; //SubStr: String; ItemDat: PObjectData; DirItemTypesToFind: TIntList; CurrDirItemType: Integer; FindedStrings: TStringList; Count: Integer; i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; CanComponentToFinded: Boolean; ComponArticulDistributor: String; ComponArticulProducer: String; ComponIzm: String; SearchTopNode: TTreeNode; SearchTopObject: TSCSCatalog; TempSCSObject: TSCSCatalog; TempIntList: TIntList; InDirs: TIntList; FilterCatalogID: TIntList; FilterComponID: TIntList; SQLInDirs: String; Spravochnik: TSpravochnik; function HaveStrSub(const ASub, AStr: String; AAsBeginOfStr: Boolean): Boolean; var PosIndex: Integer; begin Result := false; PosIndex := Pos(AnsiLowerCase(ASub), AnsiLowerCase(AStr)); if (AAsBeginOfStr and (PosIndex = 1)) or (Not AAsBeginOfStr and (PosIndex >= 1)) then Result := true; end; function AddCatalogToFinded(AFindedStrings: TStringList; AID, AItemType: Integer; const AName: String): Boolean; begin Result := false; if DirItemTypesToFind.IndexOf(AItemType) <> -1 then if (FilterCatalogID.Count = 0) or (GetValueIndexFromSortedIntList(AID, FilterCatalogID) <> -1) then if HaveStrSub(ButtonEdit_Find.Text, AName, F_FindParams.cbAsBeginName.Checked) then begin Result := true; NewData(ItemDat, ttComponents); ItemDat.ObjectID := AID; ItemDat.ItemType := AItemType; ItemDat.ComponKind := ckNone; ItemDat.QueryMode := qmUndef; AFindedStrings.AddObject(AName, TObject(ItemDat)); ProcessMessagesEx; end; end; function AddComponentToFinded(AFindedStrings: TStringList; ACompon: TSCSComponent; AID, AIsLine, AIDCompType: Integer; const AGUIDCompType, AName, AArtDistributor, AArtProducer, AIzm: String): Boolean; var FindedCompon: Boolean; SprCompType: TNBComponentType; Izm: String; ptrProp: PProperty; CompPropValue: String; begin Result := false; if (FilterComponID.Count = 0) or (GetValueIndexFromSortedIntList(AID, FilterComponID) <> -1) then begin FindedCompon := true; if F_FindParams.cbName.Checked and Not HaveStrSub(F_FindParams.edName.Text, {ButtonEdit_Find.Text,} AName, F_FindParams.cbAsBeginName.Checked) then FindedCompon := false; if F_FindParams.cbArtDistributor.Checked and Not HaveStrSub(F_FindParams.edArtDistributor.Text, AArtDistributor, F_FindParams.cbAsBeginArtDistributor.Checked) then FindedCompon := false; if F_FindParams.cbArtProducer.Checked and Not HaveStrSub(F_FindParams.edArtProducer.Text, AArtProducer, F_FindParams.cbAsBeginArtProducer.Checked) then FindedCompon := false; if F_FindParams.cbIzm.Checked then begin Izm := ''; SprCompType := nil; if Spravochnik <> nil then if AIDCompType <> 0 then SprCompType := Spravochnik.GetComponentTypeObjByID(AIDCompType) else SprCompType := Spravochnik.GetComponentTypeByGUID(AGUIDCompType); if (SprCompType <> nil) and CheckPriceTransformToUOMByCompType(@SprCompType.ComponentType) then Izm := GetNameUOM(FUOM, true) else Izm := AIzm; if Not HaveStrSub(F_FindParams.edIzm.Text, Izm, F_FindParams.cbAsBeginIzm.Checked) then FindedCompon := false; end; // По наличию свойства if FindedCompon and F_FindParams.cbProperty.Checked and Assigned(F_FindParams.FCurrProp) then begin CompPropValue := ''; if GDBMode = bkNormBase then begin SetSQLToFIBQuery(DM.Query, 'select pvalue from '+tnCompPropRelation+' where ('+fnIDComponent+'='''+IntToStr(AID)+''') and ('+fnIDProperty+'='''+IntToStr(F_FindParams.IDProperty)+''') '); if DM.Query.RecordCount = 0 then FindedCompon := false else CompPropValue := DM.Query.Fields[0].AsString; end else begin ptrProp := ACompon.GetPropertyByGUIDProperty(F_FindParams.GUIDProperty); if ptrProp = nil then FindedCompon := false else CompPropValue := ptrProp^.Value; end; if FindedCompon and F_FindParams.cbPropertyValue.Checked then if Not ComparePropValues(CompPropValue, F_FindParams.PropValue, F_FindParams.FCurrProp.PropertyData.IDDataType, F_FindParams.PropCompareType) then FindedCompon := false; end; // Если прошли проверку if FindedCompon then begin AddComponInfoToStrings(AID, AIsLine, AName, AFindedStrings); //NewData(ItemDat, ttComponents); //ItemDat.ObjectID := AID; //ItemDat.ItemType := GetSCSComponType(AIsLine); //ItemDat.ComponKind := ckCompon; //ItemDat.QueryMode := qmUndef; //AFindedStrings.AddObject(AName, TObject(ItemDat)); end; end; end; procedure LoadTextFromFindParams; var TextFromFindParams: string; begin //*** Установить значение в ButtonEdit_Find.Text из единственного открытого поля поиска // Если такого нет, то из именование TextFromFindParams := ''; if F_FindParams.GetTextFromEditIfOneChecked(TextFromFindParams) then ButtonEdit_Find.Text := TextFromFindParams else ButtonEdit_Find.Text := F_FindParams.edName.Text; end; procedure SetTextToFindParams; begin //*** Установить значение из ButtonEdit_Find.Text на единственное открытое поле поиска // Если такого нет, то на именование if Not F_FindParams.SetTextToEditFieldIfOneChecked(ButtonEdit_Find.Text) then if F_FindParams.edName.Text <> ButtonEdit_Find.Text then F_FindParams.edName.Text := ButtonEdit_Find.Text; end; { procedure LoadItemsToListViewFromStringList(AStringList: TStringList); var i: Integer; ItemDat: PObjectData; begin AStringList.Sort; for i := 0 to AStringList.Count - 1 do begin ItemDat := PObjectData(AStringList.Objects[i]); ListItem := ListView_Find.Items.Add; ListItem.Caption := AStringList[i]; ListItem.ImageIndex := 1; ListItem.Data := ItemDat; SetListItemImageIndex(ListItem); end; end;} // Tolik 18/05/2018 -- Procedure ClearLists; begin if DirItemTypesToFind <> nil then DirItemTypesToFind.free; if FindedStrings <> nil then FindedStrings.free; if FilterCatalogID <> nil then FilterCatalogID.free; if FilterComponID <> nil then FilterComponID.free; end; // begin CreateFFindParams; // Tolik 18/05/2018 -- DirItemTypesToFind := nil; FindedStrings := nil; FilterCatalogID := nil; FilterComponID := nil; // try Spravochnik := GetSpravochnik; case AButtonIndex of 0: begin SetTextToFindParams; if F_FindParams.Execute(Spravochnik) then begin LoadTextFromFindParams; if F_FindParams.cbDoFindAfterOk.Checked then begin ProcessMessagesEx; ButtonEdit_FindPropertiesButtonClick(ButtonEdit_Find, 1); end; end; end; 1: begin FilterCatalogID := TIntList.Create; FilterComponID := TIntList.Create; // Если искать в результатах предыдущего поиска if F_FindParams.cbInPrevResult.Checked then for i := 0 to ListView_Find.Items.Count - 1 do begin ListItem := ListView_Find.Items[i]; if IsCatalogItemType(PObjectData(ListItem.Data).ItemType) then InsertValueToSortetIntList(PObjectData(ListItem.Data).ObjectID, FilterCatalogID) else if IsComponItemType(PObjectData(ListItem.Data).ItemType) then InsertValueToSortetIntList(PObjectData(ListItem.Data).ObjectID, FilterComponID); end; ClearListView(ListView_Find); ButtonEdit_Find.Enabled := false; sbSelectFromSearchInCAD.Visible := false; ProcessMessagesEx; SetTextToFindParams; //Gauge.Visible := true; //Gauge.Progress := 0; //ListView_Find.SortType := stNone; //ListView_Find.OnChange := nil; SCSCatalog := nil; SCSComponent := nil; DirItemTypesToFind := TIntList.Create; FindedStrings := TStringList.Create; BeginProgress; try //***** Поиск Каталогов if F_FindParams.cbFindAsCatalogs.Checked then DirItemTypesToFind.Add(itDir); if F_FindParams.cbFindAsLists.Checked then DirItemTypesToFind.Add(itList); if F_FindParams.cbFindAsRooms.Checked then DirItemTypesToFind.Add(itRoom); if F_FindParams.cbFindAsSCSObject.Checked then begin DirItemTypesToFind.Add(itSCSLine); DirItemTypesToFind.Add(itSCSConnector); end; InDirs := nil; SQLInDirs := ''; SearchTopNode := nil; SearchTopObject := GSCSBase.CurrProject; // Если в пределах выделенной ветки дерева if F_FindParams.cbInCurrentDir.Checked then begin if GDBMode = bkNormBase then begin SearchTopNode := GetTargetNodeForItemType(Tree_Catalog.Selected, itComponent, qmPhisical); if SearchTopNode <> nil then begin TempIntList := GetCatalogAllChildsIDs(PObjectData(SearchTopNode.Data)^.ObjectID, DM.Query_Select); TempIntList.Add(PObjectData(SearchTopNode.Data)^.ObjectID); InDirs := IntListToSorted(TempIntList); FreeAndNil(TempIntList); end else begin MessageInfo(cMain_Msg185); ClearLists;// Tolik 18/05/2018 -- Exit; ///// EXIT ///// end; end else if GDBMode = bkProjectManager then begin SearchTopNode := Tree_Catalog.Selected; // Если находимся в пределах текущего проекта if GetParentNodeByItemType(SearchTopNode, [itProject]) <> nil then begin if Not CheckIsOpenProject(true) then begin ClearLists;// Tolik 18/05/2018 -- Exit; ///// EXIT ///// end // Если выделен не текущий проект else if (PObjectData(SearchTopNode.Data)^.ItemType = itProject) and (PObjectData(SearchTopNode.Data)^.ObjectID <> GSCSBase.CurrProject.ID) then begin MessageInfo(cMain_Msg186); ClearLists;// Tolik 18/05/2018 -- Exit; ///// EXIT ///// end // Если не на проекте а в его пределах else if PObjectData(SearchTopNode.Data)^.ObjectID <> SearchTopObject.ID then begin if IsComponentNode(SearchTopNode) then SearchTopNode := GetTargetNodeForItemType(SearchTopNode, PObjectData(SearchTopNode.Data)^.ItemType, qmPhisical); TempSCSObject := GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(SearchTopNode.Data)^.ObjectID); if TempSCSObject <> nil then SearchTopObject := TempSCSObject; end; end; end; end; if DirItemTypesToFind.Count > 0 then begin case GDBMode of bkNormBase: begin SQLwhere := ''; //if InDirs <> nil then // SQLwhere := ' where '+GetSQLOpeatorIN(fnID, '', InDirs)+' '; SetSQLToFIBQuery(DM.Query_Select, 'SELECT ID, NAME, ID_ITEM_TYPE '+ 'FROM '+tnCatalog+' '+ SQLwhere+ 'ORDER BY ID_ITEM_TYPE, NAME '); FindedStrings.Clear; while Not DM.Query_Select.Eof do begin if (InDirs = nil) or (GetValueIndexFromSortedIntList(DM.Query_Select.Fields[0].AsInteger, InDirs) <> -1) then begin AddCatalogToFinded(FindedStrings, DM.Query_Select.FN(fnID).AsInteger, DM.Query_Select.FN(fnIDItemType).AsInteger, DM.Query_Select.FN(fnName).AsString ); end; DM.Query_Select.Next; end; LoadItemsToListViewFromStringList(FindedStrings); end; bkProjectManager: begin for i := 0 to DirItemTypesToFind.Count - 1 do begin CurrDirItemType := DirItemTypesToFind[i]; FindedStrings.Clear; for j := 0 to SearchTopObject.ChildCatalogReferences.Count - 1 do begin SCSCatalog := SearchTopObject.ChildCatalogReferences[j]; if SCSCatalog.ItemType = CurrDirItemType then begin AddCatalogToFinded(FindedStrings, SCSCatalog.ID, SCSCatalog.ItemType, SCSCatalog.GetNameForVisible ); if Not sbSelectFromSearchInCAD.Visible and IsSCSObjectItemType(CurrDirItemType) then sbSelectFromSearchInCAD.Visible := true; end; end; LoadItemsToListViewFromStringList(FindedStrings); end; end; end; end; //*** Поиск Компонент if F_FindParams.cbFindAsComponents.Checked then begin FindedStrings.Clear; case GDBMode of bkNormBase: begin FieldNames := TStringList.Create; if F_FindParams.cbName.Checked then FieldNames.Add(fnName); if F_FindParams.cbArtDistributor.Checked then FieldNames.Add(fnArticulDistributor); if F_FindParams.cbArtProducer.Checked then FieldNames.Add(fnArticulProducer); if F_FindParams.cbIzm.Checked then FieldNames.Add(fnIzm); if F_FindParams.cbComponentType.Checked then FieldNames.Add(fnIDComponentType); if F_FindParams.cbNetType.Checked then FieldNames.Add(fnIDNetType); if F_FindParams.cbProducer.Checked then FieldNames.Add(fnIDProducer); if (FieldNames.Count > 0) or (F_FindParams.cbProperty.Checked) then begin //*** Поле Name if FieldNames.IndexOf(fnName) = -1 then FieldNames.Insert(0, fnName); FieldNames.Insert(0, fnIsLine); FieldNames.Insert(0, fnID); FieldNames.Add(fnIDComponentType); //12.04.2011 SQLwhere := ' ID IN (SELECT ID_COMPONENT FROM CATALOG_RELATION '+ //12.04.2011 ' WHERE ID_CATALOG IN (SELECT ID FROM KATALOG) ) '; DM.Query_Select.Close; //12.04.2011 DM.Query_Select.SQL.Text := GetSQLByParams(qtSelect, tnComponent, SQLwhere, FieldNames, '') + //12.04.2011 'ORDER BY '+fnName; DM.Query_Select.SQL.Text := 'SELECT '+GetSQLFieldsAsStr(FieldNames, tnComponent+'.')+', CATALOG_RELATION.ID_CATALOG FROM '+tnComponent+' '+ 'INNER JOIN CATALOG_RELATION ON (CATALOG_RELATION.ID_COMPONENT = COMPONENT.ID) '+ 'INNER JOIN KATALOG ON (CATALOG_RELATION.ID_CATALOG = KATALOG.ID)'; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin if (InDirs = nil) or (GetValueIndexFromSortedIntList(DM.Query_Select.FN(fnIDCatalog).AsInteger, InDirs) <> -1) then begin CanComponentToFinded := true; ComponArticulDistributor := ''; ComponArticulProducer := ''; ComponIzm := ''; if F_FindParams.cbArtDistributor.Checked then ComponArticulDistributor := DM.Query_Select.FN(fnArticulDistributor).AsString; if F_FindParams.cbArtProducer.Checked then ComponArticulProducer := DM.Query_Select.FN(fnArticulProducer).AsString; if F_FindParams.cbIzm.Checked then ComponIzm := DM.Query_Select.FN(fnIzm).AsString; if F_FindParams.cbComponentType.Checked then if DM.Query_Select.FN(fnIDComponentType).AsInteger <> F_FindParams.IDComponentType then CanComponentToFinded := false; if F_FindParams.cbNetType.Checked then if DM.Query_Select.FN(fnIDNetType).AsInteger <> F_FindParams.IDNetType then CanComponentToFinded := false; if F_FindParams.cbProducer.Checked then if DM.Query_Select.FN(fnIDProducer).AsInteger <> F_FindParams.IDProducer then CanComponentToFinded := false; if CanComponentToFinded then AddComponentToFinded(FindedStrings, nil, DM.Query_Select.FN(fnID).AsInteger, DM.Query_Select.FN(fnIsLine).AsInteger, DM.Query_Select.FN(fnIDComponentType).AsInteger, '', DM.Query_Select.FN(fnName).AsString, ComponArticulDistributor, ComponArticulProducer, ComponIzm); {AddComponentToFinded(FindedStrings, DM.Query_Select.FN(fnID).AsInteger, DM.Query_Select.FN(fnIsLine).AsInteger, DM.Query_Select.FN(fnName).AsString, DM.Query_Select.FN(fnArticulDistributor).AsString, DM.Query_Select.FN(fnArticulProducer).AsString, DM.Query_Select.FN(fnIzm).AsString );} end; DM.Query_Select.Next; end; end; FieldNames.Free; end; bkProjectManager: for i := 0 to SearchTopObject.ComponentReferences.Count - 1 do begin SCSComponent := SearchTopObject.ComponentReferences[i]; CanComponentToFinded := true; if F_FindParams.cbComponentType.Checked then if SCSComponent.GUIDComponentType <> F_FindParams.GUIDComponentType then CanComponentToFinded := false; if F_FindParams.cbNetType.Checked then if SCSComponent.GUIDNetType <> F_FindParams.GUIDNetType then CanComponentToFinded := false; if F_FindParams.cbProducer.Checked then if SCSComponent.GUIDProducer <> F_FindParams.GUIDProducer then CanComponentToFinded := false; if CanComponentToFinded then begin AddComponentToFinded(FindedStrings, SCSComponent, SCSComponent.ID, SCSComponent.IsLine, 0, SCSComponent.GUIDComponentType, SCSComponent.GetNameForVisible, SCSComponent.ArticulDistributor, SCSComponent.ArticulProducer, SCSComponent.Izm ); sbSelectFromSearchInCAD.Visible := true; end; end; end; LoadItemsToListViewFromStringList(FindedStrings); end; //Gauge.Visible := false; if Assigned(InDirs) then InDirs.Free; finally EndProgress; ButtonEdit_Find.Enabled := true; FindedStrings.Free; DirItemTypesToFind.Free; //ListView_Find.OnChange := ListView_FindChange; //ListView_Find.SortType := stText; end; FilterCatalogID.Free; FilterComponID.Free; // Сбрасываем флаг F_FindParams.cbInPrevResult.Checked := false; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ButtonEdit_FindPropertiesButtonClick', E.Message); end; end; // ##### Если в Edit-e поиска нажат Enter ##### procedure TF_MAIN.ButtonEdit_FindKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then ButtonEdit_FindPropertiesButtonClick(ButtonEdit_Find, 1); end; // ##### Раскрыть папку ##### procedure TF_MAIN.Tree_CatalogExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean); var Dat: PObjectData; begin Dat := Node.Data; // Tolik 06/03/2017 -- stateindex = -2 ставим, если не хотим позволить пользователю развернуть // лист в дереве. Это нужно при превышении квоты, когда не поднимутся фигуры Када, а // в дерево ПМ они уже загружены if (Node.StateIndex = -2) and (Dat.ItemType = itList) then AllowExpansion := false; // if Not FAllowTreeCatalogChange then Exit; ///// EXIT ///// try //GDragPrevTickCount := GetTickCount; FTreeNodeExpandTick := 0; FTreeExpandNode := nil; FTreeExpandNodeCountBefore := 0; Dat := Node.Data; if (Dat.ItemType = itProject) and (Dat.ObjectID <> GSCSBase.CurrProject.CurrID) then begin AllowExpansion := false; ShowMessageByType(0, smtProtocol, cMain_Msg70, '', 0); end else try LockTreeAndGrid(True); if Not GIsProgress then Screen.Cursor := crHourGlass; FTreeExpandNodeCountBefore := Node.Count; AddNodes(Node); //DefineNodesFromAndTo(Node); //Tree_Catalog.Repaint; if Not GCreatedDMAIN then if Node.Count > 0 then PObjectData(Node.Data).Expanded := True; if (Node.Count = 0) and (PObjectData(Node.Data).SkipCount = 0) then begin PObjectData(Node.Data).ChildNodesCount := 0; Node.HasChildren := false; end else if Node.Count = 0 then AllowExpansion := false; finally if Not GIsProgress then Screen.Cursor := crDefault; LockTreeAndGrid(False); end; //GDragCurrTickCount := GetTickCount; //GDragCurrTickCount := GDragCurrTickCount - GDragPrevTickCount; //GDragCurrTickCount := GetTickCount; if AllowExpansion then begin FTreeNodeExpandTick := GetTickCount; FTreeExpandNode := Node; // Tolik 17/12/2020 -- if GDBMode = bkProjectManager then begin if Dat.ItemType = itList then SwitchInCAD(Node, ccOne); end; // end except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogExpanding: '+E.Message); end; end; // ##### Свернуть папку ##### procedure TF_MAIN.Tree_CatalogCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); begin if TESTreeView(Sender).FEditingNode or Not FAllowTreeCatalogChange then AllowCollapse := false; if AllowCollapse and Not {F_Main.}GCreatedDMAIN then PObjectData(Node.Data).Expanded := False; end; // ##### Перемещение по найденным папкам ##### procedure TF_MAIN.ListView_FindChange(Sender: TObject; Item: TListItem; Change: TItemChange); Var Node: TTreeNode; ListItemDat: PObjectData; begin try Node := nil; ListItemDat := nil; if Item <> nil then if Item.Data <> nil then begin ListItemDat := Item.Data; Node := FindComponOrDirInTree(ListItemDat.ObjectID, ((ListItemDat.ItemType = itComponCon) or (ListItemDat.ItemType = itComponLine))); end; if Node = nil then begin //if Item.Data <> nil then // FreeMem(Item.Data); //Item.Delete; end else begin Tree_Catalog.Selected := Node; if GDBMode = bkProjectManager then SwitchInCAD(Node, ccOne); end; except end; end; function TF_MAIN.FindChildNodeByIDCompRel(ANode: TTreeNode; AIDCompRel: Integer): TTreeNode; var ChildNode: TTreeNode; AfterLastNode: TTreeNode; begin Result := nil; if Assigned(ANode) then begin DefineChildNodes(ANode); ChildNode := ANode.getFirstChild; AfterLastNode := ANode.getNextSibling; while (ChildNode <> nil) and (ChildNode <> AfterLastNode) do begin if PObjectData(ChildNode.Data).ID_CompRel = AIDCompRel then begin Result := ChildNode; Break; //// BREAK //// end; //*** Загрузить подветви DefineChildNodes(ChildNode); ChildNode := ChildNode.GetNext; //ChildNode.getNextSibling; end; end; end; // ##### Найти в дереве ветвь с заданой компонентой учитывая листИД ##### function TF_MAIN.FindComponOrDirInTreeByList(AListID, AFindID: Integer; AComponent: Boolean; AQueryMode: TQueryMode = qmUndef): TTreeNode; type TListDat = record ID: Integer; Parent_ID: Integer; end; PListDat = ^TlistDat; Var FindID: Integer; DirRoad: TList; ComplRoad: TIntList; ListDat: PListDat; Dat: PObjectData; ChildDat: PObjectData; SCSList: TSCSList; CanAddToRoad: Boolean; QueryMode: TQueryMode; TopID: Integer; TopNode: TTreeNode; Node: TTreeNode; ParentGroupNode: TTreeNode; SubNode: TTreeNode; ChildNode: TTreeNode; ChildCatalog: TSCSCatalog; SCSCatal: TSCSCatalog; SCSComponent: TSCSComponent; ParentObject: TBasicSCSClass; ID_Component: Integer; ID_Compon: ^Integer; ID_Catalog: Integer; Parent_ID: Integer; MayFindCompl: Boolean; i, j: Integer; RCount: Integer; // Record Count NCount: Integer; // Node Count FindedNode: TTreeNode; isFindedNode: Boolean; Item: TListItem; FindItemTypes: TIntSet; begin Result := nil; FindID := AFindID; if FindID = 0 then Exit; ////// EXIT //// MayFindCompl := false; ComplRoad := nil; ID_Catalog := 0; TopID := 0; TopNode := GetTopNode; if GDBMode = bkProjectManager then begin Node := TopNode; //TopNode.GetFirstChild; while Node <> nil do begin if Node.Data <> nil then if PObjectData(Node.Data).ItemType = itProject then begin if PObjectData(Node.Data).ObjectID = GSCSBase.CurrProject.CurrID then if (PObjectData(Node.Data).ObjectID = FindID) and (AComponent = false) then begin //Result := Node; //Exit; ///// EXIT ///// end else if GSCSBase.CurrProject.Active then begin TopID := GSCSBase.CurrProject.CurrID; TopNode := Node; end; end; Node := Node.GetNext; //Node.getNextSibling; end; //if Not DM.FMemBaseActive then // Exit; ///// EXIT ///// end; QueryMode := GetQueryModeByGDBMode(GDBMode); if AQueryMode <> qmUndef then QueryMode := AQueryMode; FindItemTypes := []; if AComponent then FindItemTypes := [itComponLine, itComponCon] else FindItemTypes := [itList, itRoom, itSCSLine, itSCSConnector]; Result := FindTreeNodeByDat(AFindID, FindItemTypes, TopNode); if Result <> nil then Exit; ///// EXIT ///// if AComponent then begin ID_Component := FindID; //*** Выйти на компоненту, которая есть в папках данной комплектующей case QueryMode of qmPhisical: begin while ID_Catalog = 0 do begin //ID_Catalog := DM.GetCatRelFieldValueAsIntByFilter('id_catalog', 'ID_COMPONENT = '''+ IntToStr(ID_Component) +''''); ID_Catalog := DM.GetCatRelCatalogIDByComponIDFromLists(ID_Component); //*** Если компоненты нет в папке if ID_Catalog = 0 then begin if MayFindCompl = false then begin MayFindCompl := true; ComplRoad := TIntList.Create; end; if ComplRoad <> nil then begin ComplRoad.Add(ID_Component); ID_Component := DM.GetCompRelFieldValueAsIntByFilter('id_component', '(ID_Child = '''+ IntToStr(ID_COMPONENT) +''') and (connect_type = '''+IntTostr(cntComplect)+''')'); //*** Если компонента также не является комплектующей (ни к чему не привязана) if ID_Component = 0 then Exit; end; end; end; end; qmMemory: begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferencesList(AListID, ID_Component); if Assigned(SCSComponent) then begin while Not (SCSComponent.Parent is TSCSCatalog) do begin ParentObject := SCSComponent.Parent; if ParentObject <> nil then begin if ParentObject is TSCSComponent then begin if Not MayFindCompl then begin MayFindCompl := true; ComplRoad := TIntList.Create; end; if ComplRoad <> nil then begin ComplRoad.Add(SCSComponent.ID); SCSComponent := TSCSComponent(ParentObject); ID_Component := SCSComponent.ID; end; end end else Exit; ///// EXIT ///// end; if SCSComponent.Parent is TSCSCatalog then ID_Catalog := TSCSCatalog(SCSComponent.Parent).ID; end; end; end; FindID := ID_Component; end else ID_Catalog := FindID; DirRoad := TList.Create; //Построить спписок Пути Parent_ID := 10000; if ID_Catalog <> 0 then while (Parent_ID <> TopID) and (Parent_ID <> 0) do begin CanAddToRoad := true; case QueryMode of qmPhisical: //Parent_ID := DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, fnParentID, QueryMode); Parent_ID := DM.GetCatalogParentIDFromLists(ID_Catalog); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(ID_Catalog); if Assigned(SCSCatal) then begin Parent_ID := SCSCatal.ParentID; //*** Если включена группировка, то не впускать комнату в путь if SCSCatal.ItemType = itRoom then begin SCSList := SCSCatal.GetListOwner; if SCSList <> nil then if SCSList.Setting.GroupListObjectsByType then CanAddToRoad := false; end; end else Parent_ID := 0; end; end; //if DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, 'id_item_type', QueryMode) = itRoom then //begin // SCSList := GSCSBase.CurrProject.GetListBySCSID(DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, 'List_id', QueryMode)); // if SCSList <> nil then // if SCSList.Setting.GroupListObjectsByType then // CanAddToRoad := false; //end; if CanAddToRoad then begin New(ListDat); ListDat.ID := ID_Catalog; ListDat.Parent_ID := Parent_ID; DirRoad.Add(ListDat); end; ID_Catalog := Parent_ID; end; if GDBMode = bkProjectManager then if GSCSBase.CurrProject.Active then begin New(ListDat); ListDat.ID := GSCSBase.CurrProject.CurrID; ListDat.Parent_ID := 0; DirRoad.Add(ListDat); end; //*** Выйти на самый верх дерева ParentGroupNode := nil; SubNode := TopNode; //GetTopNode; //Построить путь FindedNode := nil; RCount := DirRoad.Count; //SubNode := Tree_Catalog.TopItem; for i := RCount - 1 downto 0 do begin ID_Catalog := PListDat(DirRoad.Items[i]).ID; //Проверить, созданна ли такая папка isFindedNode := false; while SubNode <> nil do begin Dat := SubNode.Data; //*** Учитывать группировку объектов if Dat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then if SubNode.Count > 0 then begin ParentGroupNode := SubNode; SubNode := SubNode.GetFirstChild; Dat := SubNode.Data; end; if (SubNode <> nil) and (Dat <> nil) then if (Dat.ObjectID = ID_Catalog) and Not(Dat.ItemType in [itComponLine, itComponCon] ) then begin ParentGroupNode := nil; if SubNode.Count = 0 then AddNodes(SubNode); FindedNode := SubNode; if SubNode.Count > 0 then //if SubNode.HasChildren then SubNode := SubNode.getFirstChild; break; end else begin SubNode := SubNode.getNextSibling; //*** Если SubNode была в групп. ветви, то прейти на следующую ветвь после группы if SubNode = nil then if ParentGroupNode <> nil then begin SubNode := ParentGroupNode.getNextSibling; ParentGroupNode := nil; end; end; end; end; Node := FindedNode; // Очистка Списка //FreeList(DirRoad); FreeAndDisposeList(DirRoad); // Tolik 21/12/2019 -- if Assigned(Node) then begin // Найти компоненту if AComponent then begin if FindedNode.Count = 0 then AddNodes(FindedNode); NCount := FindedNode.Count; Node := FindedNode.getFirstChild; for j := 0 to NCount -1 do begin Dat := Node.Data; if (Dat.ObjectID = FindID) and (Dat.ComponKind = ckCompon) then begin //*** Если нужно найти еще комплектующую if MayFindCompl then begin SubNode := Node; if SubNode.Count = 0 then FillCompl(Dat.ObjectID, SubNode, nil); SubNode := SubNode.getFirstChild; for i := ComplRoad.Count - 1 downto 0 do begin ID_Component := ComplRoad.Items[i]; while SubNode <> nil do begin Dat := SubNode.Data; if Dat.ObjectID = ID_Component then begin Node := SubNode; if SubNode.Count = 0 then FillCompl(Dat.ObjectID, SubNode, nil); if SubNode.Count > 0 then SubNode := SubNode.getFirstChild; Break; end else SubNode := SubNode.getNextSibling; end; end; end; break; end; Node := Node.getNextSibling; end; end; if Assigned(Node) and (PObjectData(Node.Data).ObjectID = AFindID) then Result := Node else Result := nil; end; if ComplRoad <> nil then FreeAndNil(ComplRoad); end; // ##### Найти в дереве ветвь с заданой компонентой ##### function TF_MAIN.FindComponOrDirInTree(AFindID: Integer; AComponent: Boolean; AQueryMode: TQueryMode = qmUndef; ffTopNode: TTreeNode = nil): TTreeNode; type TListDat = record ID: Integer; Parent_ID: Integer; end; PListDat = ^TlistDat; Var FindID: Integer; DirRoad: TList; ComplRoad: TIntList; ListDat: PListDat; Dat: PObjectData; ChildDat: PObjectData; SCSList: TSCSList; CanAddToRoad: Boolean; QueryMode: TQueryMode; TopID: Integer; TopNode: TTreeNode; Node: TTreeNode; ParentGroupNode: TTreeNode; SubNode: TTreeNode; ChildNode: TTreeNode; ChildCatalog: TSCSCatalog; SCSCatal: TSCSCatalog; SCSComponent: TSCSComponent; ParentObject: TBasicSCSClass; ID_Component: Integer; ID_Compon: ^Integer; ID_Catalog: Integer; Parent_ID: Integer; MayFindCompl: Boolean; i, j: Integer; RCount: Integer; // Record Count NCount: Integer; // Node Count FindedNode: TTreeNode; isFindedNode: Boolean; Item: TListItem; FindItemTypes: TIntSet; aProjectTopNode: TTreeNode; begin Result := nil; aProjectTopNode := nil; FindID := AFindID; if FindID = 0 then Exit; ////// EXIT //// MayFindCompl := false; ComplRoad := nil; ID_Catalog := 0; TopID := 0; TopNode := GetTopNode; if GDBMode = bkProjectManager then begin if ffTopNode = nil then begin if GSCSBase.CurrProject.TreeViewNode <> nil then begin if PObjectData(GSCSBase.CurrProject.TreeViewNode.Data).ObjectID = GSCSBase.CurrProject.CurrID then if GSCSBase.CurrProject.Active then begin aProjectTopNode := GSCSBase.CurrProject.TreeViewNode; TopID := GSCSBase.CurrProject.CurrID; TopNode := aProjectTopNode; end; end; if aProjectTopNode = nil then begin Node := TopNode; //TopNode.GetFirstChild; while Node <> nil do begin if Node.Data <> nil then if PObjectData(Node.Data).ItemType = itProject then begin if PObjectData(Node.Data).ObjectID = GSCSBase.CurrProject.CurrID then if (PObjectData(Node.Data).ObjectID = FindID) and (AComponent = false) then begin //Result := Node; //Exit; ///// EXIT ///// end else if GSCSBase.CurrProject.Active then begin TopID := GSCSBase.CurrProject.CurrID; TopNode := Node; end; end; Node := Node.GetNext; //Node.getNextSibling; end; //if Not DM.FMemBaseActive then // Exit; ///// EXIT ///// end; end else begin TopNode := ffTopNode; TopID := PObjectData(TopNode.Data).ObjectID; end; end; QueryMode := GetQueryModeByGDBMode(GDBMode); if AQueryMode <> qmUndef then QueryMode := AQueryMode; FindItemTypes := []; if AComponent then FindItemTypes := [itComponLine, itComponCon] else FindItemTypes := [itList, itRoom, itSCSLine, itSCSConnector]; Result := FindTreeNodeByDat(AFindID, FindItemTypes, TopNode); if Result <> nil then Exit; ///// EXIT ///// if AComponent then begin ID_Component := FindID; //*** Выйти на компоненту, которая есть в папках данной комплектующей case QueryMode of qmPhisical: begin while ID_Catalog = 0 do begin //ID_Catalog := DM.GetCatRelFieldValueAsIntByFilter('id_catalog', 'ID_COMPONENT = '''+ IntToStr(ID_Component) +''''); ID_Catalog := DM.GetCatRelCatalogIDByComponIDFromLists(ID_Component); //*** Если компоненты нет в папке if ID_Catalog = 0 then begin if MayFindCompl = false then begin MayFindCompl := true; ComplRoad := TIntList.Create; end; if ComplRoad <> nil then begin ComplRoad.Add(ID_Component); ID_Component := DM.GetCompRelFieldValueAsIntByFilter('id_component', '(ID_Child = '''+ IntToStr(ID_COMPONENT) +''') and (connect_type = '''+IntTostr(cntComplect)+''')'); //*** Если компонента также не является комплектующей (ни к чему не привязана) if ID_Component = 0 then Exit; end; end; end; end; qmMemory: begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ID_Component); if Assigned(SCSComponent) then begin while Not (SCSComponent.Parent is TSCSCatalog) do begin ParentObject := SCSComponent.Parent; if ParentObject <> nil then begin if ParentObject is TSCSComponent then begin if Not MayFindCompl then begin MayFindCompl := true; ComplRoad := TIntList.Create; end; if ComplRoad <> nil then begin ComplRoad.Add(SCSComponent.ID); SCSComponent := TSCSComponent(ParentObject); ID_Component := SCSComponent.ID; end; end end else Exit; ///// EXIT ///// end; if SCSComponent.Parent is TSCSCatalog then ID_Catalog := TSCSCatalog(SCSComponent.Parent).ID; end; end; end; FindID := ID_Component; end else ID_Catalog := FindID; DirRoad := TList.Create; //Построить спписок Пути Parent_ID := 10000; if ID_Catalog <> 0 then while (Parent_ID <> TopID) and (Parent_ID <> 0) do begin CanAddToRoad := true; case QueryMode of qmPhisical: //Parent_ID := DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, fnParentID, QueryMode); Parent_ID := DM.GetCatalogParentIDFromLists(ID_Catalog); qmMemory: begin SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(ID_Catalog); if Assigned(SCSCatal) then begin Parent_ID := SCSCatal.ParentID; //*** Если включена группировка, то не впускать комнату в путь if SCSCatal.ItemType = itRoom then begin SCSList := SCSCatal.GetListOwner; if SCSList <> nil then if SCSList.Setting.GroupListObjectsByType then CanAddToRoad := false; end; end else Parent_ID := 0; end; end; //if DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, 'id_item_type', QueryMode) = itRoom then //begin // SCSList := GSCSBase.CurrProject.GetListBySCSID(DM.GetCatalogFieldValueAsInteger(ID_Catalog, fnID, 'List_id', QueryMode)); // if SCSList <> nil then // if SCSList.Setting.GroupListObjectsByType then // CanAddToRoad := false; //end; if CanAddToRoad then begin New(ListDat); ListDat.ID := ID_Catalog; ListDat.Parent_ID := Parent_ID; DirRoad.Add(ListDat); end; ID_Catalog := Parent_ID; end; if GDBMode = bkProjectManager then if GSCSBase.CurrProject.Active then begin New(ListDat); ListDat.ID := GSCSBase.CurrProject.CurrID; ListDat.Parent_ID := 0; DirRoad.Add(ListDat); end; //*** Выйти на самый верх дерева ParentGroupNode := nil; SubNode := TopNode; //GetTopNode; //Построить путь FindedNode := nil; RCount := DirRoad.Count; //SubNode := Tree_Catalog.TopItem; for i := RCount - 1 downto 0 do begin ID_Catalog := PListDat(DirRoad.Items[i]).ID; //Проверить, созданна ли такая папка isFindedNode := false; while SubNode <> nil do begin Dat := SubNode.Data; //*** Учитывать группировку объектов if Dat.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then if SubNode.Count > 0 then begin ParentGroupNode := SubNode; SubNode := SubNode.GetFirstChild; Dat := SubNode.Data; end; if (SubNode <> nil) and (Dat <> nil) then if (Dat.ObjectID = ID_Catalog) and Not(Dat.ItemType in [itComponLine, itComponCon] ) then begin ParentGroupNode := nil; if SubNode.Count = 0 then AddNodes(SubNode); FindedNode := SubNode; if SubNode.Count > 0 then //if SubNode.HasChildren then SubNode := SubNode.getFirstChild; break; end else begin SubNode := SubNode.getNextSibling; //*** Если SubNode была в групп. ветви, то прейти на следующую ветвь после группы if SubNode = nil then if ParentGroupNode <> nil then begin SubNode := ParentGroupNode.getNextSibling; ParentGroupNode := nil; end; end; end; end; Node := FindedNode; // Очистка Списка //FreeList(DirRoad); FreeAndDisposeList(DirRoad); // Tolik 21/12/2019 -- if Assigned(Node) then begin // Найти компоненту if AComponent then begin if FindedNode.Count = 0 then AddNodes(FindedNode); NCount := FindedNode.Count; Node := FindedNode.getFirstChild; for j := 0 to NCount -1 do begin Dat := Node.Data; if (Dat.ObjectID = FindID) and (Dat.ComponKind = ckCompon) then begin //*** Если нужно найти еще комплектующую if MayFindCompl then begin SubNode := Node; if SubNode.Count = 0 then FillCompl(Dat.ObjectID, SubNode, nil); SubNode := SubNode.getFirstChild; for i := ComplRoad.Count - 1 downto 0 do begin ID_Component := ComplRoad.Items[i]; while SubNode <> nil do begin Dat := SubNode.Data; if Dat.ObjectID = ID_Component then begin Node := SubNode; if SubNode.Count = 0 then FillCompl(Dat.ObjectID, SubNode, nil); if SubNode.Count > 0 then SubNode := SubNode.getFirstChild; Break; end else SubNode := SubNode.getNextSibling; end; end; end; break; end; Node := Node.getNextSibling; end; end; if Assigned(Node) and (PObjectData(Node.Data).ObjectID = AFindID) then Result := Node else Result := nil; end; if ComplRoad <> nil then FreeAndNil(ComplRoad); end; function TF_MAIN.GetNameNode(ANode: TTreeNode; AObject: TObject; AFullName, AKolChild: Boolean): String; var ResText: String; TableName: String; NodeDat: PObjectData; Catalog: TSCSCatalog; SCSCompon: TSCSComponent; strIndex: String; strKolChild: String; IDTopCompon: Integer; IDCompRel: Integer; KolCompl: Integer; CreatedHere: Boolean; QueryMode: TQueryMode; begin try Result := ''; strIndex := ''; strKolChild := ''; CreatedHere := false; Catalog := nil; SCSCompon := nil; if ANode = nil then ANode := GetNodeByObj(AObject); if ANode = nil then Exit; //// EXIT ///// if ANode.Data = nil then Exit; //// EXIT ///// ResText := ANode.Text; NodeDat := ANode.Data; if GDBMode = bkNormBase then QueryMode := qmPhisical else QueryMode := qmMemory; QueryMode := GetQueryModeByNode(GDBMode, ANode, QueryMode); //case NodeDat.ItemType of // itDir, itProjMan, itProject, itList, itRoom, itSCSConnector, itSCSLine: if IsCatalogItemType(NodeDat.ItemType) then begin if (AObject = nil) and (QueryMode = qmPhisical) then begin Catalog := nil; end else if (AObject is TSCSCatalog) and (TSCSCatalog(AObject).ID = NodeDat.ObjectID) then Catalog := TSCSCatalog(AObject) else if QueryMode = qmMemory then if Assigned(GSCSBase.CurrProject) then Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(NodeDat.ObjectID); if Catalog = nil then begin CreatedHere := true; Catalog := TSCSCatalog.Create(TForm(Self)); Catalog.QueryMode := QueryMode; Catalog.LoadCatalogByID(NodeDat.ObjectID, false); end; {if AIndex then strIndex := GetNameAndIndex('', Catalog.ItemType, Catalog.IndexPointObj, Catalog.IndexConnector, Catalog.IndexLine); if AKolChild then strKolChild := GetNameAndKol('', Catalog.Kol_Compon); Result := Catalog.Name + strIndex + strKolChild; } //if AKolChild then // strKolChild := GetNameAndKol('', Catalog.KolCompon); case AFullName of True: Result := Catalog.GetNameForVisible(AKolChild); False: Result := Catalog.Name; end; //Result := Result + strKolChild; if CreatedHere then FreeAndNil(Catalog); end //itComponCon, itComponLine, itLinkCompLine, itLinkCompCon: else if IsComponItemType(NodeDat.ItemType) then begin IDTopCompon := 0; IDCompRel := 0; KolCompl := 0; if (AObject = nil) and (QueryMode = qmPhisical) then begin SCSCompon := nil; end else if (AObject is TSCSComponent) and (TSCSComponent(AObject).ID = NodeDat.ObjectID) then SCSCompon := TSCSComponent(AObject) else if QueryMode = qmMemory then if Assigned(GSCSBase.CurrProject) then SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(NodeDat.ObjectID); if SCSCompon = nil then begin CreatedHere := true; SCSCompon := TSCSComponent.Create(TForm(Self)); SCSCompon.LoadComponentByID(NodeDat.ObjectID, false); end; if AFullName then Result := GetComponNameForVisible(SCSCompon.Name, SCSCompon.NameMark) else Result := SCSCompon.Name; if AKolChild then begin KolCompl := SCSCompon.KolComplect; if QueryMode = qmPhisical then begin IDTopCompon := GetTopComponIDByNode(ANode); IDCompRel := GetIDCompRelFromNode(ANode); //*** Если это ветка комплектующая, а не верхняя компонента if (IDTopCompon <> 0) and (IDCompRel <> 0) and (IDTopCompon <> SCSCompon.ID) then KolCompl := DM.GetIntFromTable(tnComponentRelation, fnKolSubComplect, fnID, IDCompRel, qmPhisical); end; Result := GetNameAndKol(Result, KolCompl); end; if AKolChild then if NodeDat.ItemType = itComponLine then Result := Result + GetNameConnectFromAndTo(SCSCompon); if CreatedHere then FreeAndNil(SCSCompon); {SetSQLToQuery(DM.scsQSelect, ' select name, kol_complect from component where id = '''+IntTostr(NodeDat.ObjectID)+''' '); if AKolChild then strKolChild := GetNameAndKol('', DM.scsQSelect.FN('kol_complect').AsInteger); Result := DM.scsQSelect.FN('name').AsString + strKolChild; if AKolChild then if NodeDat.ItemType = itComponLine then Result := Result + GetNameConnectFromAndTo(NodeDat.ObjectID);} end; //end; except on E: Exception do AddExceptionToLog('TF_MAIN.GetNameNode: '+E.Message); end; end; procedure TF_MAIN.GetNameNodeType(ANode: TTreeNode; var ANameType, ANameTypes, ANameTypeGnd: String); var Dat: PObjectData; begin if Assigned(ANode) then begin Dat := ANode.Data; case Dat.ItemType of itProject: begin ANameType := cMain_Msg71_1; ANameTypes := cMain_Msg71_2; ANameTypeGnd := ANameType; end; itDir: begin ANameType := cMain_Msg71_3; ANameTypes := cMain_Msg71_4; ANameTypeGnd := cMain_Msg71_5; end; itRoom: begin ANameType := cMain_Msg71_6; ANameTypes := cMain_Msg71_7; ANameTypeGnd := ANameType; end; itList: begin ANameType := cMain_Msg71_8; ANameTypes := cMain_Msg71_9; ANameTypeGnd := ANameType; end; itSCSLine, itSCSConnector: begin ANameType := cMain_Msg71_10; ANameTypes := cMain_Msg71_11; ANameTypeGnd := ANameType; end; end; end; end; function TF_MAIN.GetNextSelNodeAfterDel(ANode: TTreeNode): TTreeNode; var Node: TTreeNode; begin Result := nil; if ANode <> nil then begin Node := ANode.getNextSibling; if Node = nil then Node := ANode.Parent; if Node <> nil then Result := Node; end; end; function TF_MAIN.GetNodeByObj(AObject: TObject; aTopNode: TTreeNode = nil): TTreeNode; begin Result := nil; if AObject <> nil then begin if AObject is TSCSComponent then Result := FindComponOrDirInTree(TSCSComponent(AObject).ID, true, qmUndef, aTopNode) else if AObject is TSCSCatalog then Result := FindComponOrDirInTree(TSCSCatalog(AObject).ID, false); end; end; function TF_MAIN.GetObjNameForVisible(ASCSObject: TSCSCatalog; AProjPart: TProjPart): String; var SCSList: TSCSList; //IDList: Integer; Cat: TCatalog; Setting: TListSettingRecord; ShowObjectType: TShowType; begin Result := ASCSObject.Name; ShowObjectType := st_Short; if GDBMode <> bkProjectManager then Exit; //// EXIT ///// if Not(ASCSObject.ItemType in [itSCSLine, itSCSConnector]) then Exit; //// EXIT ///// if ASCSObject.IsUserName = biFalse then begin SCSList := GSCSBase.CurrProject.GetListBySCSID(ASCSObject.ListID); if SCSList = nil then begin //Cat := DM.GetCatalogByItemType(ASCSObject.ID, itList); SCSList := TSCSList.Create(TForm(Self)); //SCSList.Open(Cat.Scs_ID); SCSList.Open(ASCSObject.SCSID); Setting := SCSList.Setting; FreeAndNil(SCSList); end else Setting := SCSList.Setting; {# После удаления свойства "Отображать маркировки" if Setting.ShowObjectMarking = true then Result := ASCSObject.Name + ' ' + ASCSObject.NameMark else} case AProjPart of ppPM: ShowObjectType := Setting.ShowObjectTypePM; PPCAD: ShowObjectType := Setting.ShowObjectTypeCAD; end; case ShowObjectType of st_Full: Result := ASCSObject.NameMark + ASCSObject.Name; st_Short: Result := GetNameAndIndex(ASCSObject.Name, ASCSObject.ItemType, ASCSObject.IndexPointObj, ASCSObject.IndexConnector, ASCSObject.IndexLine); end; end else Result := ASCSObject.Name; end; function TF_MAIN.DefineConnectorObjectNodeName(ASCSObject: TSCSCatalog): String; var FirstComponent: TSCSComponent; DatObjNode: PObjectData; ChildNode: TTReeNode; DatChildNode: PObjectData; SelectedNode: TTreeNode; SCSCompon: TSCSComponent; SCSObject: TSCSCatalog; CanRefreshNodeText: Boolean; begin Result := ''; try ChildNode := nil; DatChildNode := nil; if ASCSObject = nil then Exit; //// EXIT //// if ASCSObject.ItemType = itSCSConnector then begin if (ASCSObject.SCSComponents.Count > 0) then begin FirstComponent := ASCSObject.GetFirstComponent; if FirstComponent <> nil then begin CanRefreshNodeText := false; //*** Индекс брать от верхней компоненты if ASCSObject.MarkID <> FirstComponent.MarkID then begin CanRefreshNodeText := true; ASCSObject.MarkID := FirstComponent.MarkID; if ASCSObject.IndexConnector <> 0 then ASCSObject.IndexConnector := ASCSObject.MarkID; if ASCSObject.IndexPointObj <> 0 then ASCSObject.IndexPointObj := ASCSObject.MarkID; if ASCSObject.IndexLine <> 0 then ASCSObject.IndexLine := ASCSObject.MarkID; ASCSObject.NameMark := MakeNameMarkCatalog(ASCSObject.ID, true, qmMemory); SetIndexToFigure(ASCSObject.ListID, ASCSObject.SCSID, ASCSObject.MarkID); end; if ASCSObject.NameShort <> FirstComponent.NameShort then begin CanRefreshNodeText := false; if ASCSObject.TreeViewNode = nil then begin SetNewObjectNameInCad(ASCSObject.ListID, ASCSObject.SCSID, ASCSObject.NameShort, FirstComponent.NameShort); //10.08.2012 ASCSObject.NameShort := FirstComponent.NameShort; ASCSObject.Name := FirstComponent.NameShort; end else if ASCSObject.TreeViewNode <> nil then begin ASCSObject.TreeViewNode.Text := RenameNode(cfBase, ASCSObject.TreeViewNode, ASCSObject, FirstComponent.NameShort); ////ASCSObject.TreeViewNode.Text := GetNameNode(ASCSObject, FirstComponent, true, true); //*** Определить группу //SelectedNode := Tree_Catalog.Selected; //DefineObjectGroup(ASCSObject.TreeViewNode, FirstComponent.GUIDComponentType, FirstComponent.IsLine); //if Assigned(SelectedNode) then // Tree_Catalog.Selected := SelectedNode; Result := ASCSObject.TreeViewNode.Text; end; end; // Определить группу if ASCSObject.TreeViewNode <> nil then begin //*** Определить группу SelectedNode := Tree_Catalog.Selected; DefineObjectNodeGroup(ASCSObject.TreeViewNode, FirstComponent.GUIDComponentType, FirstComponent.IsLine); if Assigned(SelectedNode) then Tree_Catalog.Selected := SelectedNode; end; if CanRefreshNodeText and (ASCSObject.TreeViewNode <> nil) then begin Result := ASCSObject.GetNameForVisible(true); ASCSObject.TreeViewNode.Text := Result; end; end; end else if ASCSObject.SCSComponents.Count = 0 then DefineObjectGroupForCatalog(ASCSObject); { ChildNode := nil; DatChildNode := nil; if AObjNode = nil then Exit; //// EXIT //// DatObjNode := AObjNode.Data; if DatObjNode.ItemType = itSCSConnector then begin ChildNode := AObjNode.GetFirstChild; if ChildNode <> nil then begin SCSObject := nil; SCSCompon := nil; DatChildNode := ChildNode.Data; //SCSObject.LoadCatalogByID(DatObjNode.ObjectID, false, false); //SCSCompon.LoadComponentByID(DatChildNode.ObjectID, false); SCSObject := GSCSBase.CurrProject.GetCatalogFromReferences(DatObjNode.ObjectID); SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(DatChildNode.ObjectID); if (SCSObject = nil) or (SCSCompon = nil) then Exit; ////// EXIT ///// if SCSObject.Name <> SCSCompon.NameShort then begin RenameNode(cfBase, AObjNode, SCSCompon.NameShort); AObjNode.Text := GetNameNode(AObjNode, SCSCompon, true, true); //*** Определить группу SelectedNode := Tree_Catalog.Selected; DefineObjectGroup(AObjNode, SCSCompon.ID_ComponentType, SCSCompon.IsLine); if Assigned(SelectedNode) then Tree_Catalog.Selected := SelectedNode; Result := AObjNode.Text; end; end;} end; except on E: Exception do AddExceptionToLog('TF_MAIN.DefineConnectorObjectNodeName: '+E.Message); end; end; function TF_MAIN.MakeNameMarkCatalog(AIDCatalog: Integer; AUpdateInBase: Boolean; AQueryMode: TQueryMode): String; var Catalog: TCatalog; mrkProject: String; mrkList: String; mrkRoom: String; mrkIndex: String; ObjNameShort: String; NameMark: String; GoUp: Boolean; QueryMode: TQueryMode; CurrCatalog: TSCSCatalog; UpCatalog: TSCSCatalog; begin try Result := ''; mrkProject := IntToStr(GSCSBase.CurrProject.MarkID); mrkList := '0'; mrkRoom := '0'; mrkIndex := '0'; //Catalog := DM.GetCatalogByID(AIDCatalog, AQueryMode); CurrCatalog := nil; CurrCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if CurrCatalog = nil then Exit; ///// EXIT ///// ObjNameShort := CurrCatalog.NameShort; if CurrCatalog.IsUserName = biTrue then begin Result := CurrCatalog.NameShort; Exit; //// EXIT //// end; UpCatalog := CurrCatalog; GoUp := true; while GoUp do begin if UpCatalog <> nil then case UpCatalog.ItemType of itSCSConnector, itSCSLine: begin if UpCatalog.IndexPointObj > 0 then mrkIndex := IntToStr(UpCatalog.IndexPointObj); if UpCatalog.IndexConnector > 0 then mrkIndex := IntToStr(UpCatalog.IndexConnector); if UpCatalog.IndexLine > 0 then mrkIndex := IntToStr(UpCatalog.IndexLine); QueryMode := qmMemory; end; itRoom: begin mrkRoom := IntToStr(UpCatalog.MarkID); QueryMode := qmMemory; end; itList: begin mrkList := IntToStr(UpCatalog.MarkID); QueryMode := qmMemory; GoUp := false; end; {itProject: begin mrkProject := IntToStr(Catalog.MarkID); QueryMode := qmPhisical; GoUp := false; end;} end; //*** Перейти на уровень вверх if (GoUp) and (UpCatalog <> nil) then UpCatalog := TSCSCatalog(UpCatalog.Parent); //Catalog := DM.GetCatalogByID(UpCatalog.Parent_ID, QueryMode); end; NameMark := mrkProject + '.' + mrkList + '.' + mrkRoom + '.' + mrkIndex; CurrCatalog.NameMark := NameMark; Result := NameMark; //if AUpdateInBase then // DM.UpdateCatalogFieldAsString(AIDCatalog, NameMark, fnID, 'name_mark', QueryMode); (* ObjNameShort := Catalog.NameShort; if Catalog.IsUserName = biTrue then begin Result := Catalog.NameShort; Exit; //// EXIT //// end; GoUp := true; while GoUp do begin case Catalog.ItemType of itSCSConnector, itSCSLine: begin if Catalog.IndexPointObj > 0 then mrkIndex := IntToStr(Catalog.IndexPointObj); if Catalog.IndexConnector > 0 then mrkIndex := IntToStr(Catalog.IndexConnector); if Catalog.IndexLine > 0 then mrkIndex := IntToStr(Catalog.IndexLine); QueryMode := qmMemory; end; itRoom: begin mrkRoom := IntToStr(Catalog.MarkID); QueryMode := qmMemory; end; itList: begin mrkList := IntToStr(Catalog.MarkID); QueryMode := qmMemory; GoUp := false; end; {itProject: begin mrkProject := IntToStr(Catalog.MarkID); QueryMode := qmPhisical; GoUp := false; end;} end; //*** Перейти на уровень вверх if GoUp then Catalog := DM.GetCatalogByID(Catalog.Parent_ID, QueryMode); end; NameMark := mrkProject + '.' + mrkList + '.' + mrkRoom + '.' + mrkIndex; Result := NameMark; if AUpdateInBase then DM.UpdateCatalogFieldAsString(AIDCatalog, NameMark, fnID, 'name_mark', QueryMode); *) //SetSQLToQuery(DM.scsQOperat, ' update katalog set '+ // ' name_mark = '''+NameMark+''' '+ // ' where id = '''+IntToStr(AIDCatalog)+''' '); except on E: Exception do AddExceptionToLog('TF_MAIN.MakeNameMarkCatalog: '+E.Message); end; end; function TF_MAIN.MakeNameMarkComponent(AComponent: TSCSComponent; AObject: TSCSCatalog; AUpdateInBase: Boolean; AMarkTemplate: String = ''): String; var MarkTemplate: String; NewMark: String; RoomMarkID: Integer; List: TSCSList; NBCompType: TNBComponentType; MarkTemplateObjects: TObjectList; //ptrCatalogMarkMask: PCatalogMarkMask; i: Integer; Len: Integer; CurrChar: Char; PrevChar: Char; Room: TSCSCatalog; ptrPort: TSCSInterface; TopComponent: TSCSComponent; MProj, MList, MRoom, MObj, MTopCompon, MCompon, MPort: Integer; ComunicationCompon: TSCSComponent; JoinedCable: TSCSComponent; ComponPort: TSCSInterface; IsNoCanMarkByCurrMode: Boolean; { function GetRoomNameShort(ARoom: TSCSCatalog): String; begin Result := ''; if ARoom <> nil then Result := ARoom.NameShort else if GSCSBase.CurrProject.Setting.RoomNameShortSrcType = rnssRoomName then Result := ARoom.Name + IntToStr(ARoom.MarkID) else if GSCSBase.CurrProject.Setting.RoomNameShortSrcType = rnssRoomDefStr then Result := GSCSBase.CurrProject.Setting.RoomNameShortDefault; end;} {//23.02.2009 function GetNameMarkThroughCable(ACable, AJoinedPoint: TSCSComponent): String; var WholeLineCompon: TWholeLineCompon; ComunicationComponent1: TSCSComponent; ComunicationComponent2: TSCSComponent; ComunicationComponent: TSCSComponent; ConnectedConnCompon: TSCSComponent; IDLineJoinedToComunication: Integer; LineJoinedToComunication: TSCSComponent; SCSCatalog: TSCSCatalog; RoomOwner: TSCSCatalog; RoomOwner2: TSCSCatalog; ListOwner: TSCSCatalog; ListOwner2: TSCSCatalog; RoomMark: String; RoomMark2: String; ListMark: String; ListMark2: String; ComunicationPort: TSCSInterface; ComunicationPortNpp: Integer; ComunicationPortMark: String; LastConnectedConnCompon: TSCSComponent; FirstConnectedConnCompon: TSCSComponent; begin Result := ''; if ACable.IsLine = biTrue then begin WholeLineCompon := GetLineComponsInTraceFromBase(ACable, false); LastConnectedConnCompon := nil; FirstConnectedConnCompon := nil; if WholeLineCompon.LastIDConnectedConnCompon <> 0 then LastConnectedConnCompon := GSCSBase.CurrProject.GetComponentFromReferences(WholeLineCompon.LastIDConnectedConnCompon); if WholeLineCompon.FirstIDConnectedConnCompon <> 0 then FirstConnectedConnCompon := GSCSBase.CurrProject.GetComponentFromReferences(WholeLineCompon.FirstIDConnectedConnCompon); // Определить поделюченные комуникационные компоненты ComunicationComponent1 := nil; ComunicationComponent2 := nil; ComunicationComponent := nil; IDLineJoinedToComunication := -1; ConnectedConnCompon := nil; if (LastConnectedConnCompon <> nil) and (LastConnectedConnCompon <> AJoinedPoint) then ComunicationComponent1 := GetParentComunicationCompon(LastConnectedConnCompon); if (FirstConnectedConnCompon <> nil) and (FirstConnectedConnCompon <> AJoinedPoint) then ComunicationComponent2 := GetParentComunicationCompon(FirstConnectedConnCompon); RoomOwner := nil; ListOwner := nil; RoomMark := ''; ListMark := ''; RoomOwner2 := nil; ListOwner2 := nil; RoomMark2 := ''; ListMark2 := ''; if (ComunicationComponent1 <> nil) and (ComunicationComponent2 <> nil) then begin // Получаем объекты компоненты и их обозначения GetComponObjectsMark(ComunicationComponent1, RoomOwner, ListOwner, RoomMark, ListMark, GSCSBase.CurrProject.Setting.RoomNameShortSrcType, GSCSBase.CurrProject.Setting.RoomNameShortDefault, GSCSBase.CurrProject.Setting.RoomNameShortIfNoRoom); GetComponObjectsMark(ComunicationComponent2, RoomOwner2, ListOwner2, RoomMark2, ListMark2, GSCSBase.CurrProject.Setting.RoomNameShortSrcType, GSCSBase.CurrProject.Setting.RoomNameShortDefault, GSCSBase.CurrProject.Setting.RoomNameShortIfNoRoom); if (ListMark+RoomMark) < (ListMark2+RoomMark2) then Result := ListMark + RoomMark +'/'+ ListMark2 + RoomMark2 else Result := ListMark2 + RoomMark2 +'/'+ ListMark + RoomMark; Result := Result +'-'+IntToStr(ACable.MarkID); end else begin if ComunicationComponent1 <> nil then begin ComunicationComponent := ComunicationComponent1; IDLineJoinedToComunication := WholeLineCompon.LastIDCompon; ConnectedConnCompon := LastConnectedConnCompon; end else if ComunicationComponent2 <> nil then begin ComunicationComponent := ComunicationComponent2; IDLineJoinedToComunication := WholeLineCompon.FirstIDCompon; ConnectedConnCompon := FirstConnectedConnCompon; end; if ComunicationComponent <> nil then begin LineJoinedToComunication := GSCSBase.CurrProject.GetComponentFromReferences(IDLineJoinedToComunication); // Получаем объекты компоненты и их обозначения GetComponObjectsMark(ComunicationComponent, RoomOwner, ListOwner, RoomMark, ListMark, GSCSBase.CurrProject.Setting.RoomNameShortSrcType, GSCSBase.CurrProject.Setting.RoomNameShortDefault, GSCSBase.CurrProject.Setting.RoomNameShortIfNoRoom); // Получаем порт панели, к которой подключен кабель ComunicationPort := nil; ComunicationPortMark := ' '; if LineJoinedToComunication <> nil then ComunicationPort := ConnectedConnCompon.GetPortJoinedToLine(LineJoinedToComunication); if ComunicationPort <> nil then begin //ComunicationPortNpp := ComunicationPort.NppPort; ComunicationPortNpp := GetNppPortByJoinedCompon(ComunicationPort, LineJoinedToComunication); ComunicationPortMark := IntToStrF(ComunicationPortNpp, 2); end else ComunicationPortMark := IntToStrF(ConnectedConnCompon.MarkID, 2); Result := ListMark + RoomMark +'-'+ ComunicationComponent.NameMark + ComunicationPortMark; end; end; end; end;} begin Result := ''; if GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if AComponent = nil then Exit; //// EXIT //// try NewMark := ''; List := nil; Room := nil; ptrPort := nil; //ptrCatalogMarkMask := nil; MProj := 0; MList := 0; MRoom := 0; MObj := 0; MTopCompon := 0; MCompon := 0; MPort := 0; if AComponent.IsUserMark = biTrue then begin Result := AComponent.NameMark; Exit; //// EXIT //// end; IsNoCanMarkByCurrMode := false; if GSCSBase.CurrProject.Setting.MarkMode = mmTIAEIA606A then begin if AComponent.IsLine = biFalse then begin if AComponent.ComponentType.PortKind = pkPort then begin // Проверяем, находится ли компонент в комуникационной панели ComunicationCompon := GetParentComunicationCompon(AComponent); if ComunicationCompon = nil then begin // Через подключенный кабель выяснить комуникационный компонент for i := 0 to AComponent.JoinedComponents.Count - 1 do begin JoinedCable := AComponent.JoinedComponents[i]; Result := MakeNameMarkThroughCableTIAEIA606A(JoinedCable, AComponent); if Result <> '' then Break; //// BREAK //// end; end else begin ComponPort := AComponent.GetPort; if ComponPort <> nil then Result := ComunicationCompon.NameMark + IntToStrF(ComponPort.NppPort, 2); end; end else begin if AComponent.NameMark = '' then Result := DecToABC(AComponent.MarkID) else Result := AComponent.NameMark; end; end else if AComponent.IsLine = biTrue then begin Result := MakeNameMarkThroughCableTIAEIA606A(AComponent, nil); end; if Result = '' then IsNoCanMarkByCurrMode := true; end; if (GSCSBase.CurrProject.Setting.MarkMode = mmTemplate) or (IsNoCanMarkByCurrMode and GSCSBase.CurrProject.Setting.IsMarkByTemplateIfNoAtOtherMode) then begin //*** Получить маску маркировки List := AObject.GetListOwner; //GSCSBase.CurrProject.GetListBySCSID(AObject.ListID); if List <> nil then begin MarkTemplate := AMarkTemplate; NBCompType := nil; MarkTemplateObjects := nil; if MarkTemplate = '' then begin NBCompType := List.Spravochnik.GetComponentTypeByGUID(AComponent.GUIDComponentType); //ptrCatalogMarkMask := List.GetMarkMaskByComponType(AComponent.ID_ComponentType); if NBCompType <> nil then begin MarkTemplate := NBCompType.ComponentType.MarkMask; MarkTemplateObjects := NBCompType.DefineMarkTemplateObjects; end; end; if MarkTemplate <> '' then begin { //18.02.2009 MProj := GSCSBase.CurrProject.MarkID; MList := List.MarkID; //SetSQLToQuery(DM.scsQSelect, ' select mark_id from katalog where (id = '''+IntToStr(AObject.ParentID)+''') and (id_item_type = '''+IntToStr(itRoom)+''') '); //MRoom := DM.scsQSelect.GetFNAsInteger('mark_id'); MRoom := 0; Room := AObject.GetParentCatalogByItemType(itRoom); if Assigned(Room) then MRoom := Room.MarkID; //MRoom := DM.GetCatalogFieldValueAsIntegerByFilter('mark_id', '(id = '''+IntToStr(AObject.ParentID)+''') and (id_item_type = '''+IntToStr(itRoom)+''')', qmMemory); MObj := -1; if AObject.IndexPointObj > 0 then MObj := AObject.IndexPointObj; if AObject.IndexConnector > 0 then MObj := AObject.IndexConnector; if AObject.IndexLine > 0 then MObj := AObject.IndexLine; //*** Индкс верхней компоненты if Pos(mteTopCompon, MarkTemplate) <> 0 then begin TopComponent := AComponent.GetTopComponent; if TopComponent <> nil then MTopCompon := TopComponent.MarkID; end; MCompon := AComponent.MarkID; //*** Номер порта if Pos(mteComponPort, MarkTemplate) <> 0 then begin ptrPort := AComponent.GetPort; if ptrPort <> nil then MPort := ptrPort.NppPort; end; NewMark := MakeMarkMaskForComponent(MProj, MList, MRoom, MObj, MTopCompon, MCompon, MPort, AComponent.NameShort, MarkTemplate); //if AUpdateInBase then // DM.UpdateComponFieldAsString(AComponent.ID, NewMark, fnNameMark); // //SetSQLToQuery(DM.scsQOperat, ' update component set name_mark = '''+NewMark+''' where id = '''+IntToStr(AComponent.ID)+''' '); Result := NewMark; } //*** Номер порта if Pos(mteComponPort, MarkTemplate) <> 0 then begin ptrPort := AComponent.GetPort; if ptrPort <> nil then MPort := ptrPort.NppPort; end; Result := MakeNameMarkForComponByPortNum(AObject, List, AComponent, MPort, MarkTemplate, MarkTemplateObjects); end; end; end; except on E: Exception do AddExceptionToLog('MakeNameMarkComponent: '+E.Message); end; end; function TF_MAIN.GenComponentMarkID(AComponent: TSCSComponent): Integer; begin Result := 0; try if GDBMode <> bkProjectManager then Exit; ///// EXIT ///// //Result := GSCSBase.CurrProject.GenComponentMarkIDByType(AComponent.ComponentType.GUID); Result := GSCSBase.CurrProject.GenComponentMarkIDByMode(AComponent, GSCSBase.CurrProject.Setting.PointComonIndexingMode, GSCSBase.CurrProject.Setting.PointComplIndexingMode); except on E: Exception do AddExceptionToLog('TF_MAIN.GenComponentMarkID: '+E.Message); end; end; function TF_MAIN.GetNameConnectFromAndTo(APartComponent: TSCSComponent): String; var IDFromObject: Integer; IDToObject: Integer; strFrom: String; strTo: String; ConnectedComponsInfoFrom: TConnectedComponsInfo; ConnectedComponsInfoTo: TConnectedComponsInfo; (* function GetObjName(AIDObject: Integer): String; var Catalog: TSCSCatalog; begin Result := ''; //Catalog := TSCSCatalog.Create(TForm(Self)); //Catalog.LoadCatalogByID(AIDObject, false); {Result := GetNameAndIndex(Catalog.Name, Catalog.ItemType, Catalog.IndexPointObj, Catalog.IndexConnector, Catalog.IndexLine);} Catalog := nil; Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(AIDObject); if Catalog <> nil then Result := GetObjNameForVisible(Catalog, ppPM); //Catalog.Free; end; *) function GetObjNameByIDComponent(AIDObj, AIDComponent: Integer): String; var SCSComponent: TSCSComponent; SCSCatal: TSCSCatalog; begin Result := ''; SCSCatal := GSCSBase.CurrProject.GetCatalogFromReferences(AIDObj); if SCSCatal = nil then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if SCSComponent <> nil then SCSCatal := SCSComponent.GetFirstParentCatalog; end; if SCSCatal <> nil then Result := GetObjNameForVisible(SCSCatal, ppPM); end; begin try Result := ''; if GDBMode = bkNormBase then Exit; ///// EXIT ///// if Not Assigned(APartComponent) then Exit; ///// EXIT ///// IDFromObject := -1; IDToObject := -1; strFrom := ''; strTo := ''; { SetFilterToSQLMemTable(DM.tSQL_ConnectedComponents, 'compon_whole_id = '''+IntToStr(APartComponent.Whole_ID)+''''); if DM.tSQL_ConnectedComponents.RecordCount > 0 then begin DM.tSQL_ConnectedComponents.First; while Not DM.tSQL_ConnectedComponents.Eof do begin if DM.tSQL_ConnectedComponents.FieldByName(fnTypeConnect).AsInteger = tcoFrom then IDFromObject := DM.tSQL_ConnectedComponents.FieldByName(fnIDConnectObject).AsInteger; if DM.tSQL_ConnectedComponents.FieldByName(fnTypeConnect).AsInteger = tcoTo then IDToObject := DM.tSQL_ConnectedComponents.FieldByName(fnIDConnectObject).AsInteger; DM.tSQL_ConnectedComponents.Next; end; end; } { SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(APartComponent.ID); if Assigned(SCSComponent) then begin //if SCSComponent.WholeComponent.Count = 0 then begin SCSComponent.LoadWholeComponent(true); SCSComponent.DefineFirstLast; end; IDFromObject := SCSComponent.FirstConnectedConnCompon.GetFirstParentCatalog.ID; IDToObject := SCSComponent.LastConnectedConnCompon.GetFirstParentCatalog.ID; end; } { if IDFromObject <> -1 then strFrom := GetObjName(IDFromObject); if IDToObject <> -1 then strTo := GetObjName(IDToObject); } GSCSBase.CurrProject.ConnectedComponsList.GetConnectedComponsInfosByWholeID(APartComponent.Whole_ID, ConnectedComponsInfoFrom, ConnectedComponsInfoTo); //29.01.2013 ConnectedComponsInfoFrom := GSCSBase.CurrProject.ConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(APartComponent.Whole_ID, tcoFrom); if ConnectedComponsInfoFrom.ComponWholeID > 0 then strFrom := GetObjNameByIDComponent(ConnectedComponsInfoFrom.IDConnectObject, ConnectedComponsInfoFrom.IDConnectCompon); //29.01.2013 ConnectedComponsInfo := GSCSBase.CurrProject.ConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(APartComponent.Whole_ID, tcoTo); if ConnectedComponsInfoTo.ComponWholeID > 0 then strTo := GetObjNameByIDComponent(ConnectedComponsInfoTo.IDConnectObject, ConnectedComponsInfoTo.IDConnectCompon); if (strFrom = '') and (strTo <> '') then Result := ' [ '+cMain_Msg196_2+' "' + strTo + '" ]'; if (strFrom <> '') and (strTo = '') then Result := ' [ '+cMain_Msg196_2+' "' + strFrom + '" ]'; if (strFrom <> '') and (strTo <> '') then Result := ' [ '+cMain_Msg196_1+' "'+ strFrom +'" '+cMain_Msg196_2+' "' + strTo + '" ]'; except on E: Exception do AddExceptionToLog('TF_MAIN.GetNameConnectFromAndTo: '+E.Message); end; end; // ##### Вычислить и установить количество компонентов / комплектующих ##### procedure TF_MAIN.SetKol(ANode: TTreeNode; AObject: TObject); var Dat: PObjectData; NameNode: String; IDCat: Integer; IDComp: Integer; SetKolvo: Boolean; Kolvo: integer; ItemsCount: Integer; TableName: String; KolvoField: String; Catalog: TSCSCAtalog; SCSCompon: TSCSComponent; begin if ANode = nil then Exit; ANode.Text := GetNameNode(ANode, AObject, true, true); Exit; /// EXIT /// Kolvo := 0; SetKolvo := false; NameNode := ANode.Text; CutColFromStr(NameNode); Dat := ANode.Data; with DM do Case Dat.ItemType of itDir, itSCSLine, itSCSConnector : if ((GDBMode = bkNormBase) and (Dat.ItemType = itDir)) or ( (GDBMode = bkProjectManager) and (Dat.ItemType in [itSCSLine, itSCSConnector]) ) then begin Catalog := TSCSCatalog.Create(TForm(Self)); Catalog.LoadCatalogByID(Dat.ObjectID, false); Kolvo := Catalog.KolCompon; ItemsCount := Catalog.ItemsCount; {ANode.Text := GetNameAndIndex(NameNode, Catalog.ItemType, Catalog.IndexPointObj, Catalog.IndexConnector, Catalog.IndexLine);} NameNode := GetObjNameForVisible(Catalog, ppPM); {SetSQLToQuery(scsQSelect, ' select kol_compon, items_count from katalog '+ ' where id = '''+IntToStr(IDCat)+''' '); Kolvo := scsQSelect.FN('kol_compon').AsInteger; ItemsCount := scsQSelect.FN('items_count').AsInteger;} TableName := 'catalog'; KolvoField := 'kol_compon'; SetKolvo := true; FreeAndNil(Catalog); end; itComponLine, itComponCon: begin IDComp := Dat.ObjectID; {SetSQLToQuery(scsQ, ' SELECT COUNT(*) As Cnt FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+IntToStr(IDComp)+''' ) and'+ ' (CONNECT_TYPE = '''+ IntToStr(cntComplect) +''') and '+ ' (ID_CHILD IN (SELECT ID FROM COMPONENT) ) ' ); Kolvo := scsQ.FN('COUNT').AsInteger;} SetSQLToQuery(scsQSelect, ' select name, kol_complect from component '+ ' where id = '''+IntToStr(IDComp)+''' '); NameNode := scsQSelect.GetFNAsString('Name'); Kolvo := scsQSelect.GetFNAsInteger('kol_complect'); ItemsCount := Kolvo; TableName := 'component'; KolvoField := 'kol_complect'; SetKolvo := true; end; end; if SetKolvo then begin //SetSQLToQuery(DM.scsQOperat, ' update '+TableName+' set '+KolvoField+' = '''+IntToStr(Kolvo)+''' '+ // ' where id = '''+IntToStr(Dat.ObjectID)+''' '); ANode.Text := GetNameAndKol(NameNode, Kolvo); // if Dat.ItemType = itComponLine then // ANode.Text := ANode.Text + GetNameConnectFromAndTo(Dat.ObjectID); // Dat.ChildNodesCount := ItemsCount; end; end; procedure TF_MAIN.OnAddDeleteNode(ANode: TTreeNode; AObject, AParentObject: TBasicSCSClass; AAdding: Boolean); var ParentNode: TTreeNode; Dat: PObjectData; ParentDat: PObjectData; ParentObject: TBasicSCSClass; IDCompRel: Integer; IDTopComponent: Integer; IsNBCompl: Boolean; KolComplect: Integer; KolCompon: Integer; ItemsCount: Integer; QueryMode: TQueryMode; BasicSCSObject: TBasicSCSClass; ParentSCSObject: TBasicSCSClass; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; CreatedParentDat: Boolean; begin try ParentObject := nil; CreatedParentDat := false; if Assigned(ANode) then begin Dat := ANode.Data; ParentNode := ANode.Parent; ParentDat := nil; if PObjectData(ParentNode.Data).ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin ParentNode := ParentNode.Parent; ParentSCSObject := nil; if AParentObject is TSCSCatalog then ParentSCSObject := AParentObject; if ParentSCSObject = nil then begin BasicSCSObject := AObject; if BasicSCSObject = nil then if GDBMode = bkProjectManager then if IsSCSObjectItemType(Dat.ItemType) then BasicSCSObject := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if BasicSCSObject <> nil then if BasicSCSObject.Parent <> nil then if BasicSCSObject.Parent is TSCSCatalog then ParentSCSObject := BasicSCSObject.Parent; end; if ParentSCSObject <> nil then begin GetZeroMem(ParentDat, SizeOf(TObjectData)); ParentDat.ObjectID := TSCSCatalog(ParentSCSObject).ID; ParentDat.ItemType := TSCSCatalog(ParentSCSObject).ItemType; ParentDat.ChildNodesCount := TSCSCatalog(ParentSCSObject).ItemsCount; CreatedParentDat := true; end; end else ParentDat := ParentNode.Data; end else Exit; ///// EXIT ///// QueryMode := GetQueryModeByNode(GDBMode, ParentNode, GetQueryModeByGDBMode(GDBMode)); if QueryMode = qmMemory then if AObject <> nil then ParentObject := AObject.Parent; //if Not(Assigned(AObject) and // OnAddDeleteObject(AObject, AAdding)) then begin if ANode = nil then Exit; ///// EXIT ///// if (ANode.Data = nil) or (ANode.Parent = nil) then Exit; ///// EXIT ///// SCSCatalog := nil; SCSComponent := nil; //case Dat.ItemType of // itComponCon, itComponLine, itLinkCompLine, itLinkCompCon: if IsComponItemType(Dat.ItemType) then begin //case ParentDat.ItemType of // itComponCon, itComponLine, itLinkCompLine, itLinkCompCon: if IsComponItemType(ParentDat.ItemType) then begin case QueryMode of {qmPhisical: begin KolComplect := DM.GetComponFieldValueAsInteger(ParentDat.ObjectID, fnKolComplect); if AAdding then begin Inc(KolComplect); Inc(ParentDat.ChildNodesCount); end else begin Dec(KolComplect); Dec(ParentDat.ChildNodesCount); end; DM.UpdateComponFieldAsInteger(ParentDat.ObjectID, KolComplect, fnKolComplect); end;} qmPhisical: begin //*** Определить комплектующая ли на ветке в НБ IsNBCompl := false; IDCompRel := GetIDCompRelFromNode(ParentNode); IDTopComponent := GetTopComponIDByNode(ParentNode); if (IDTopComponent <> 0) and (IDCompRel <> 0) and (IDTopComponent <> ParentDat.ObjectID) then IsNBCompl := true; KolComplect := 0; if IsNBCompl then KolComplect := DM.GetIntFromTable(tnComponentRelation, fnKolSubComplect, fnID, IDCompRel, qmPhisical) else KolComplect := DM.GetComponFieldValueAsInteger(ParentDat.ObjectID, fnKolComplect); if AAdding then begin KolComplect := KolComplect + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin KolComplect := KolComplect - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; if IsNBCompl then DM.UpdateIntTableFieldByID(tnComponentRelation, fnKolSubComplect, IDCompRel, KolComplect, qmPhisical) else DM.UpdateComponFieldAsInteger(ParentDat.ObjectID, KolComplect, fnKolComplect); end; qmMemory: begin SCSComponent := nil; if (ParentObject <> nil) and (ParentObject is TSCSComponent) and (TSCSComponent(ParentObject).ID = ParentDat.ObjectID) then SCSComponent := TSCSComponent(ParentObject) else SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ParentDat.ObjectID); if Assigned(SCSComponent) then begin if AAdding then begin SCSComponent.KolComplect := SCSComponent.KolComplect + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin SCSComponent.KolComplect := SCSComponent.KolComplect - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; end; end; end; end //itDir, itSCSLine, itSCSConnector: else if ParentDat.ItemType in [itDir, itSCSLine, itSCSConnector] then begin case QueryMode of qmPhisical: begin KolCompon := DM.GetCatalogFieldValueAsInteger(ParentDat.ObjectID, fnID, fnKolCompon, QueryMode); if AAdding then begin KolCompon := KolCompon + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin KolCompon := KolCompon - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; DM.UpdateCatalogFieldAsInteger(ParentDat.ObjectID, KolCompon, fnID, fnKolCompon, QueryMode); end; qmMemory: begin SCSCatalog := nil; if (ParentObject <> nil) and (ParentObject is TSCSCatalog) and (TSCSCatalog(ParentObject).ID = ParentDat.ObjectID) then SCSCatalog := TSCSCatalog(ParentObject) else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ParentDat.ObjectID); if Assigned(SCSCatalog) then begin if AAdding then begin SCSCatalog.KolCompon := SCSCatalog.KolCompon + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin SCSCatalog.KolCompon := SCSCatalog.KolCompon - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; end; end; end; end; //end; end else begin case QueryMode of qmPhisical: begin ItemsCount := DM.GetCatalogFieldValueAsInteger(ParentDat.ObjectID, fnID, fnItemsCount, QueryMode); if AAdding then begin ItemsCount := ItemsCount + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin ItemsCount := ItemsCount - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; DM.UpdateCatalogFieldAsInteger(ParentDat.ObjectID, ItemsCount, fnID, fnItemsCount, QueryMode); if ParentDat.ItemType = itProject then GSCSBase.CurrProject.ItemsCount := ItemsCount; end; qmMemory: begin SCSCatalog := nil; if (ParentObject <> nil) and (ParentObject is TSCSCatalog) and (TSCSCatalog(ParentObject).ID = ParentDat.ObjectID) then SCSCatalog := TSCSCatalog(ParentObject) else SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ParentDat.ObjectID); if Assigned(SCSCatalog) then begin if AAdding then begin SCSCatalog.ItemsCount := SCSCatalog.ItemsCount + 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount + 1; end else begin SCSCatalog.ItemsCount := SCSCatalog.ItemsCount - 1; ParentDat.ChildNodesCount := ParentDat.ChildNodesCount - 1; end; end; end; end; end; //end; end; ParentNode.Text := GetNameNode(ParentNode, ParentObject, true, true); if CreatedParentDat then FreeMem(ParentDat); except on E: Exception do AddExceptionToLogEx('TF_MAIN.OnAddDeleteNode', E.Message); end; end; function TF_MAIN.OnAddDeleteObject(AObject: TBasicSCSClass; AAdding: Boolean): Boolean; var ParentObject: TBasicSCSClass; QueryMode: TQueryMode; begin Result := false; ParentObject := nil; QueryMode := GetQueryModeByGDBMode(GDBMode); if Assigned(AObject) then begin if AObject is TSCSComponent then ParentObject := TSCSComponent(AObject).Parent; if AObject is TSCSCatalog then ParentObject := TSCSCatalog(AObject).Parent; if Assigned(ParentObject) then begin if ParentObject is TSCSComponent then begin if AAdding then Inc(TSCSComponent(ParentObject).KolComplect) else Dec(TSCSComponent(ParentObject).KolComplect); //DM.UpdateComponFieldAsInteger(TSCSComponent(ParentObject).ID, // TSCSComponent(ParentObject).KolComplect, fnKolComplect); if Assigned(TSCSComponent(ParentObject).TreeViewNode) then TSCSComponent(ParentObject).TreeViewNode.Text := GetNameNode(TSCSComponent(ParentObject).TreeViewNode, TSCSComponent(ParentObject), true, true); Result := true; end; if ParentObject is TSCSCatalog then begin if AObject is TSCSComponent then begin if AAdding then Inc(TSCSCatalog(ParentObject).KolCompon) else Dec(TSCSCatalog(ParentObject).KolCompon); //DM.UpdateCatalogFieldAsInteger(TSCSCatalog(ParentObject).ID, // TSCSCatalog(ParentObject).KolCompon, fnID, fnKolCompon, QueryMode); Result := true; end; if AObject is TSCSCatalog then begin if AAdding then Inc(TSCSCatalog(ParentObject).ItemsCount) else Dec(TSCSCatalog(ParentObject).ItemsCount); //DM.UpdateCatalogFieldAsInteger(TSCSCatalog(ParentObject).ID, // TSCSCatalog(ParentObject).ItemsCount, fnID, fnItemsCount, QueryMode); Result := true; end; if Assigned(TSCSCatalog(ParentObject).TreeViewNode) then TSCSCatalog(ParentObject).TreeViewNode.Text := GetNameNode(TSCSCatalog(ParentObject).TreeViewNode, TSCSCatalog(ParentObject), true, true); end; end; end; end; // ##### Отображает количество компонентов для папок ##### procedure TF_MAIN.ShowKolForDir(ANode: TTreeNode; AKol: Integer); var Dat: PObjectData; pos1: Integer; pos2: Integer; S:String; begin Dat := ANode.Data; if ((GDBMode = bkNormBase) and (Dat.ItemType = itDir)) or ((GDBMode = bkProjectManager) and (Dat.ItemType in [itSCSLine, itSCSConnector]) ) then begin // Проверить содержит ли текст количество s := ANode.Text; pos1 := Pos(S, ' [ '); pos2 := Pos(S, ' ]'); if (Pos1 <> 0) and (Pos2 <> 0) and (pos1 < pos2) then CutColFromStr(S); S := GetNameAndKol(S, AKol); ANode.Text := s; end; end; // ##### Очистить буфер после вырезания / копирования ##### procedure TF_MAIN.Act_ClearCopyBufExecute(Sender: TObject); begin RollBackCut; GEditKind := ekNone; Act_ClearCopyBuf.Enabled := false; Act_PasteDir.Enabled := false; if FIsBufferedList then begin if FileExists(GetAnsiTempPath + fnBufferedList) then DeleteFile(GetAnsiTempPath + fnBufferedList); FIsBufferedList := false; end; end; // ##### Запретить вытаскивание Панелей ##### procedure TF_MAIN.Panel_TreeStartDock(Sender: TObject; var DragObject: TDragDockObject); var Rect: PRect; Point: Tpoint; begin New(Rect); Rect.TopLeft := Panel_Main.BoundsRect.TopLeft; Rect.BottomRight := Panel_Main.BoundsRect.BottomRight; Rect.TopLeft := Panel_Main.ClientToScreen(Rect.TopLeft); Rect.BottomRight := Panel_Main.ClientToScreen(Rect.BottomRight); ClipCursor(Rect); //Freemem(Rect); Dispose(Rect); // Tolik 21/12/2019 -- end; // ##### Разрешить курсок мыши по всему екрану ##### procedure TF_MAIN.Panel_TreeEndDock(Sender, Target: TObject; X, Y: Integer); begin ClipCursor(nil); end; // ##### Проверить - не закрылась ли панель "Папок", или "Данных компоненты" ##### procedure TF_MAIN.Panel_Main1Click(Sender: TObject); begin //Act_mnuDir.Checked := Panel_Tree.Visible; if Not Panel_Tree.Visible then Panel_Tree.Visible := true; Act_mnuComponData.Checked := Panel_Addition.Visible; EnableDragPanels; end; // ##### Отображать / Скрыть Панель "Данных компоненты" ##### procedure TF_MAIN.Act_mnuComponDataExecute(Sender: TObject); begin Panel_Addition.Visible := Act_mnuComponData.Checked; EnableDragPanels; end; { // ##### Обработка перемещения Главной Формы ##### procedure TF_MAIN.WMMove(var M: TWMMove); begin if F_ImageShow <> nil then if F_ImageShow.Visible then begin F_ImageShow.Left := Left + GImageDifference.Left; F_ImageShow.Top := Top + GImageDifference.Top; end; end;} procedure TF_MAIN.WMMouseWheel(var Msg: TMessage); var CurrTabIndex: Integer; begin //if Tree_Catalog.Focused then // Act_HideHints.Execute; { CurrTabIndex := tcGridData.TabIndex; //*** Прокрутка к себе if WheelDelta < 0 then begin if CurrTabIndex < (tcGridData.Tabs.Count - 1) then tcGridData.TabIndex := CurrTabIndex + 1; end else //*** Прокрутка от себя if WheelDelta > 0 then begin if CurrTabIndex > 0 then tcGridData.TabIndex := CurrTabIndex - 1; end;} // end; procedure TF_MAIN.WMEnterSizeMove(var Message:TMessage); begin Self.DisableAlign; end; procedure TF_MAIN.WMExitSizeMove(var Message:TMessage); begin Self.EnableAlign; end; procedure TF_MAIN.WMMove(var Message: TMessage); begin end; procedure TF_MAIN.FormStartDock(Sender: TObject; var DragObject: TDragDockObject); begin Docking := true; end; procedure TF_MAIN.FormEndDock(Sender, Target: TObject; X, Y: Integer); var ParentPanel: TComponent; begin (*Docking := False; FSCS_Main.PDock1.DockSite := true; FSCS_Main.pDock2.DockSite := true; FSCS_Main.cbMainPanel.DockSite := true; if TForm(Sender).Left > Screen.Width - 100 then TForm(Sender).Left := TForm(Sender).Left - 50; if TForm(Sender).Top > Screen.Height - 100 then TForm(Sender).Top := TForm(Sender).Top - 50; // Для привязываемых панелей формы // DragKind := true; //(если нормбаза отвязана) // FradKind := false; //(если нормбаза привязана) ParentPanel := {TForm(F_main).}GetParentComponent; if ParentPanel = nil then begin Panel_Addition.DragKind := dkDock; Panel_Tree.DragKind := dkDock; end else begin Panel_Addition.DragKind := dkDrag; Panel_Tree.DragKind := dkDrag; end; *) end; procedure TF_MAIN.FormPaint(Sender: TObject); begin //if TForm(Sender).Left > Screen.Width -100 then // TForm(Sender).Left := TForm(Sender).Left - 50; //if TForm(Sender).Top > Screen.Height -100 then // TForm(Sender).Top := TForm(Sender).Top - 50; end; procedure TF_MAIN.Tree_Catalog_EndDrag(Sender, Target: TObject; X, Y: Integer); begin {if ComponentObj <> nil then ComponentObj.Destroy; } if Assigned(GCadForm) then // Tolik 29/03/2021 begin GCadForm.FIsDragOver := False; if GFigureSnap <> nil then begin if GFigureSnap is TConnectorObject then TConnectorObject(GFigureSnap).IsSnap := False; GFigureSnap := nil; end; if GPrevFigureSnap <> nil then begin if GPrevFigureSnap is TConnectorObject then TConnectorObject(GPrevFigureSnap).IsSnap := False; GPrevFigureSnap := nil; end; GFigureTraceTo := nil; end; GisDragTree := false; EndDragCompon; end; procedure TF_MAIN.Tree_CatalogStartDrag(Sender: TObject; var DragObject: TDragObject); var Node: TTreeNode; CurrDat: PObjectData; Point: TPoint; SCSCompon: TSCSComponent; S: String; // Tolik 28/08/2019 -- //CurrTick: cardinal; CurrTick: DWord; // begin {if Timer_TreeCatalogChange.Enabled then begin // или ждать завершения таймера Tag <> 999 GDropComponent := nil; DragObject.Cancelling := true; exit; end; if Timer_TreeCatalogChange.Tag = 999 then begin // или ждать завершения таймера Tag <> 999 GDropComponent := nil; DragObject.Cancelling := true; exit; end;} CurrTick := GetTickCount; while Timer_TreeCatalogChange.Enabled or (Timer_TreeCatalogChange.Tag = 999) do begin Application.ProcessMessages; if (GetTickCount - CurrTick) >= 4000 then begin break; end; end; if Timer_TreeCatalogChange.Enabled or (Timer_TreeCatalogChange.Tag = 999) then begin GDropComponent := nil; DragObject.Cancelling := true; exit; end; Act_HideHints.Execute; try GisDragTree := true; Timer_NodeHint.Enabled := false; Act_HideHints.Execute; Node := Tree_Catalog.Selected; CurrDat := Node.Data; if CurrDat <> nil then if (CurrDat.ItemType in [itComponLine, itComponCon, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner]){ and (GDBMode = bkNormBase)} then begin GID_CopingCompon := CurrDat.ObjectID; if GDropComponent = nil then begin GDropComponent := TSCSComponent.Create(Self); end; GDropComponent.Clear; case GDBMode of bkNormBase: begin if Assigned(GDropComponent) then begin //GDropComponent.QueryMode := qmPhisical; GDropComponent.ActiveForm := F_NormBase; GDropComponent.Clear; GDropComponent.IDTopComponent := GetTopComponIDByNode(Node); GDropComponent.IDCompRel := GetIDCompRelFromNode(Node); GDropComponent.LoadComponentByID(CurrDat.ObjectID, true, true, false); GDropComponent.IDCompRel := CurrDat.ID_CompRel; GDropComponent.TreeViewNode := Node; end; CreateShadowObject; // На CAD end; bkProjectManager: begin //GDropComponent := GSCSBase.CurrProject.GetComponentFromReferences(CurrDat.ObjectID); SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(CurrDat.ObjectID); if Assigned(SCSCompon) then GDropComponent.Assign(SCSCompon, true, true); //GDropComponent.QueryMode := qmMemory; end; end; if GSCSBase.SCSComponent.ID <> GDropComponent.ID then begin GSCSBase.SCSComponent.Assign(GDropComponent, false, true); RefreshNode(true); end; //GDropComponent.ActiveForm := Self; //TBasicSCSClass(GDropComponent).ActiveForm := Self; //GDropComponent.LoadComponentByID(CurrDat.ObjectID); if Assigned(GDropComponent) then begin GDropComponent.Count := 1; if (GDBMode = bkNormBase) {and (GDropComponent.HaveMinimumInterfaces(false))} then begin GCanCopyComponToCAD := true; if FProjectMan <> nil then if FProjectMan.GSCSBase.CurrProject.Active then if FProjectMan.GSCSBase.CurrProject.CurrList <> nil then if FProjectMan.GSCSBase.CurrProject.CurrList.Setting.SCSType = st_Internal then if IsTrunkComponent(GDropComponent) then begin GCanCopyComponToCAD := false; end; end else GCanCopyComponToCAD := false; GisLineCopingCompon := GDropComponent.IsLine; end; {S := Tree_Catalog.Selected.Text; CutColFromStr(S); GComplect.Name := S; GComplect.ID := CurrDat.ObjectID; GComplect.Kolvo := 1; case CurrDat.ItemType of itComponCon : GComplect.isLine := 0; itComponLine: GComplect.isLine := 1; end; //*** Определить количество компл-х в новой комплектующей SetSQLToQuery(DM.scsQ, ' Select COUNT(*) As Cnt FROM COMPONENT_RELATION WHERE ID_Component = '''+ IntToStr(CurrDat.ObjectID) +''' '); GComplect.KolCompl := DM.scsQ.FN('Count').AsInteger; GComplect.IDNetType := DM.DataSet.FN('ID_Net_Type').AsInteger; } end else if GDropComponent <> nil then begin //if TF_Main(GDropComponent.ActiveForm).GDBMode = bkNormBase then // FreeAndNil(GDropComponent); GDropComponent.Clear; GCanCopyComponToCAD := false; end; if GCanCopyComponToCAD then ;//CreateShadowObject; // На CAD except on E: Exception do AddExceptionToLog('TF_MAIN.Tree_CatalogStartDrag: '+E.Message); end; end; constructor TF_MAIN.Create(AOwner: TComponent; AGDBMode: TDBKind; AFormMode: TFMainMode; AParent: TWinControl = nil); begin GDBMode := AGDBMode; GFormMode := AFormMode; FParentControl := AParent; inherited Create(AOwner); //Tolik 15/08/2021 -- FTreeExpandNode := nil; FTreeClickNode := nil; FTreeMouseDownNode := nil; FTreeNodeToShow := nil; FCreepNode := nil; GTree_Contr := nil; FLoadedComponElements := nil; FLastOnHintNode := nil; FLastOnHintObject := nil; // end; { destructor TF_MAIN.Destroy; begin inherited; end; } procedure TF_MAIN.Panel_MainUnDock(Sender: TObject; Client: TControl; NewTarget: TWinControl; var Allow: Boolean); begin if NewTarget <> Panel_Main then Allow := false; end; procedure TF_MAIN.ToolButton_MakeInTreeClick(Sender: TObject); var Point: TPoint; begin Point.X := ToolButton_MakeInTree.Left; Point.Y := ToolButton_MakeInTree.Top + ToolButton_MakeInTree.Height; Point := ToolButton_MakeInTree.ClientToScreen(Point); ToolButton_MakeInTree.DropdownMenu.Popup(Point.X, Point.Y); //CreateNewForm(''); //ToolButton_MakeInTree.PopupMenu.Popup(); end; procedure TF_MAIN.SaveComplects(AComponent: TSCSComponent; AComponID: Integer; AOnlyIOfIRel: Boolean = false); var OldIDCompRelIDs: TIntList; NewIDCompRelIDs: TIntList; //*** Сохранит подкомплектующие procedure SaveCompRels(AChildComponent: TSCSComponent); var i: Integer; CompRel: PComplect; begin for i := 0 to AChildComponent.Complects.Count - 1 do begin CompRel := AChildComponent.Complects[i]; CompRel.IDTopComponent := AComponID; if AChildComponent.LinkToComlectRec <> nil then CompRel.IDParentCompRel := AChildComponent.LinkToComlectRec.ID; OldIDCompRelIDs.Add(CompRel.ID); end; AChildComponent.SaveComplects(AChildComponent.ID); //*** Запомнить новые ID for i := 0 to AChildComponent.Complects.Count - 1 do NewIDCompRelIDs.Add(PComplect(AChildComponent.Complects[i]).ID); for i := 0 to AChildComponent.ChildComplects.Count - 1 do SaveCompRels(AChildComponent.ChildComplects[i]); //*** Переопререлить данные if AChildComponent.LinkToComlectRec <> nil then begin // В Объекте AChildComponent.IDCompRel := AChildComponent.LinkToComlectRec.ID; AChildComponent.IDTopComponent := AChildComponent.LinkToComlectRec.IDTopComponent; // В ветви //if AChildComponent.TreeViewNode <> nil then // PObjectData(AChildComponent.TreeViewNode.Data).ID_CompRel := AChildComponent.LinkToComlectRec.ID; end; end; //*** Сохранит связи интерфейсов для сохраненных подкомплектующих procedure SaveIOfIRels(AChildComponent: TSCSComponent); var i, j: Integer; Interf: TSCSinterface; IOfIRel: TSCSIOfIRel; CompRel: PComplect; begin for i := 0 to AChildComponent.Interfaces.Count - 1 do begin Interf := AChildComponent.Interfaces[i]; for j := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[j]); if (IOfIRel.CompRel <> nil) and (IOfIRel.CompRel.ConnectType = cntComplect) then begin IOfIRel.IDCompRel := IOfIRel.CompRel.ID; Interf.SaveIOfIRel(meMake, IOfIRel); end; end; end; for i := 0 to AChildComponent.ChildComplects.Count - 1 do SaveIOfIRels(AChildComponent.ChildComplects[i]); end; procedure DefineIDsInNodes(ANode: TTreeNode); var ChildNode: TTreeNode; IDIndex: Integer; begin ChildNode := ANode.getFirstChild; while ChildNode <> nil do begin DefineIDsInNodes(ChildNode); ChildNode := ChildNode.getNextSibling; end; if ANode.Data <> nil then if PObjectData(ANode.Data).ID_CompRel <> 0 then begin IDIndex := OldIDCompRelIDs.IndexOf(PObjectData(ANode.Data).ID_CompRel); if IDIndex <> -1 then PObjectData(ANode.Data).ID_CompRel := NewIDCompRelIDs[IDIndex]; end; end; begin SetLinksToComplectInIOfIRel(AComponent, true); OldIDCompRelIDs := TIntList.Create; NewIDCompRelIDs := TIntList.Create; if Not AOnlyIOfIRel then SaveCompRels(AComponent); SaveIOfIRels(AComponent); if Not AOnlyIOfIRel then if AComponent.TreeViewNode <> nil then DefineIDsInNodes(AComponent.TreeViewNode); FreeAndNil(OldIDCompRelIDs); FreeAndNil(NewIDCompRelIDs); //for i := 0 to AComponent.ChildComplects.Count - 1 do // SaveCompRels(AComponent.ChildComplects[i]); // for i := 0 to AComponent.ChildComplects.Count - 1 do // SaveIOfIRels(AComponent.ChildComplects[i]); end; function TF_MAIN.SaveComponent(ASrcCompon, ATrgCompon: TSCSComponent; ATrgNode: TTreeNode; ASrcForm, ATrgForm: TForm; ASrcObject, ATrgObject: TSCSCatalog; ADefineMark, ALoadTopComponToNode: Boolean; AComponKind: TComponKind): TSCSComponent; var CoordZ: Double; Length: Double; SortID: Integer; Node: TTreeNode; TargetNodeDat: PObjectData; NodeTxt: string; NewNode: TTreeNode; NewDat: PObjectData; TrgList: TSCSList; function SaveComponAndComplects(AComponentToSave: TSCSComponent; AParentNode: TTreeNode; ALoadToNode: Boolean; AOnlyComlects: Boolean): TSCSComponent; var ChildComponent: TSCSComponent; i, j, k, l: Integer; NewIDChild: Integer; //CurrNewCompon: TSCSComponent; //NewChildCompon: TSCSComponent; CCount: Integer; ID_CompProjMan: Integer; ID_SavedCompon: Integer; ID_Child: Integer; Complect: PComplect; Interf: TSCSInterface; ParentInterface: TSCSInterface; ParentIOfIRel: TSCSIOfIRel; Interfaces: TSCSInterface; IOfIRel: TSCSIOfIRel; WasBreak: Boolean; LookedCompRels: TList; //SrcComponent: TSCSComponent; //SCSCompon: TSCSComponent; begin Result := nil; //if (TF_Main(ASourceForm).GDBMode = bkNormBase) and (GDBMode = bkProjectManager) then //begin // GSCSBase.CurrProject.Spravochnik.GetComponentTypeWithAssign(AComponentToSave.GUIDComponentType, TF_Main(ASourceForm).GSCSBase.NBSpravochnik); // GSCSBase.CurrProject.CurrList.Spravochnik.GetComponentTypeWithAssign(AComponentToSave.GUIDComponentType, TF_Main(ASourceForm).GSCSBase.NBSpravochnik); //end; if ATrgObject <> nil then if not AComponentToSave.ServPriceisLoaded then DefineComponPriceOnCopyToOtherBase(AComponentToSave, ASrcObject, ATrgObject, ASrcForm, ATrgForm); //TBasicSCSClass(SCSCompon).ActiveForm := ATargetForm; {FProjectMan}; AComponentToSave.ActiveForm := ATrgForm; AComponentToSave.IsUserMark := biFalse; if (ALoadToNode) then //if (ALoadToNode) and AComponKind = ckCompon) then begin //17.05.2011 AComponentToSave.ID := ID_SavedCompon; // ID_SavedCompon is no init AComponentToSave.SortID := SortID; if TargetNodeDat <> nil then //case TargetNodeDat.ItemType of // itSCSConnector, itSCSLine: // if Assigned(ATrgObject) then // ATrgObject.AddComponentToList(AComponentToSave); // itComponCon, itComponLine: // if Assigned(ATrgCompon) then // ATrgCompon.AddChildComponent(AComponentToSave); //end; if IsCatalogItemTypeForCompon(TargetNodeDat.ItemType) then begin if Assigned(ATrgObject) then begin ATrgObject.AddComponentToList(AComponentToSave); //10.07.2013 - Нужно біло когда на размещении по клику на КАД, спрашивали маркировку один раз //TrgList := ATrgObject.GetListOwner; //if TrgList <> nil then // if TrgList.FNewComponNameMark <> '' then // begin // AComponentToSave.NameMark := TrgList.FNewComponNameMark; // AComponentToSave.IsUserMark := biTrue; // end; end; end else if IsComponItemType(TargetNodeDat.ItemType) then begin if Assigned(ATrgCompon) then ATrgCompon.AddChildComponent(AComponentToSave); end; end; if ATrgObject <> nil then begin AComponentToSave.ObjectID := ATrgObject.ID; AComponentToSave.ListID := ATrgObject.ListID; end; if ADefineMark then if AComponentToSave.IsUserMark = biFalse then begin AComponentToSave.MarkID := GenComponentMarkID(AComponentToSave); if GDBMode = bkProjectManager then if ATrgObject <> nil then AComponentToSave.NameMark := MakeNameMarkComponent(AComponentToSave, ATrgObject, false); end; { AComponentToSave.Price := GetPriceAfterChangeNDS(AComponentToSave.Price, TF_Main(ASourceForm).GNDS, GNDS); AComponentToSave.Price := GetPriceAfterChangeRatio(AComponentToSave.Price, TF_Main(ASourceForm).GCurrencyM.Ratio, GCurrencyM.Ratio); AComponentToSave.Price_Calc := GetPriceAfterChangeNDS(AComponentToSave.Price_Calc, TF_Main(ASourceForm).GNDS, GNDS); AComponentToSave.Price_Calc := GetPriceAfterChangeRatio(AComponentToSave.Price_Calc, TF_Main(ASourceForm).GCurrencyM.Ratio, GCurrencyM.Ratio); } //AComponentToSave.SortID := SortID; //SCSCompon.RepairKolComplect; //*** Обновить количество компл-х в ветви компоненты (KOL_Complect) //SCSCompon.DivideComplects; //20.08.2007 AComponentToSave.CoordZ := CoordZ; ID_SavedCompon := 0; if Not AOnlyComlects then ID_SavedCompon := AComponentToSave.SaveComponentAsNew(false, true) else ID_SavedCompon := AComponentToSave.ID; //Result := ID_SavedCompon; if (AComponKind = ckCompon) and (ALoadToNode) then if GDBMode = bkNormBase then if ATrgNode <> nil then AppendToCatalRel(PObjectData(ATrgNode.Data).ObjectID, ID_SavedCompon); if (ALoadToNode) {and (AComponKind = ckCompon) }then begin //AComponentToSave.ID := ID_SavedCompon; //AComponentToSave.SortID := SortID; //case TargetNodeDat.ItemType of // itSCSConnector, itSCSLine: // if Assigned(ATrgObject) then // ATrgObject.AddComponentToList(AComponentToSave); // itComponCon, itComponLine: // if Assigned(ATrgCompon) then // ATrgCompon.AddChildComponent(AComponentToSave); //end; NodeTxt := GetComponNameForVisible(AComponentToSave.Name, AComponentToSave.NameMark); NewNode := Tree_Catalog.Items.AddChild(AParentNode, NodeTxt); NewNode.Text := GetNameAndKol(NewNode.Text, AComponentToSave.KolComplect); //NewNode.ImageIndex := GetNodeImageIndex(GetSCSComponType(SCSCompon.IsLine), ekNone, -1); //itComponent; NewData(NewDat, ttComponents); NewDat.ItemType := AComponentToSave.GetItemType; NewDat.ObjectID := ID_SavedCompon; NewDat.SortID := SortID; NewDat.QueryMode := AComponentToSave.QueryMode; NewDat.ComponKind := AComponKind; NewDat.NBMode := PObjectData(AParentNode.Data).NBMode; NewDat.ChildNodesCount := AComponentToSave.KolComplect; if GDBMode = bkProjectManager then if ATrgObject <> nil then NewDat.ListID := ATrgObject.ListID; NewNode.Data := NewDat; AComponentToSave.TreeViewNode := NewNode; SetNodeState(NewNode, GetSCSComponType(AComponentToSave.IsLine), ekNone, AComponentToSave); SortID := SortID + 1; //IDComponType := AComponentToSave.ID_ComponentType; end; //MaxPos := MaxPos + 1; //*** В превую очередь сохранить комплектующие AComponentToSave.SaveComplects(ID_SavedCompon); if TF_Main(ATrgForm).GDBMode = bkProjectManager then begin for i := 0 to AComponentToSave.ChildComplects.Count - 1 do begin SaveComponAndComplects(AComponentToSave.ChildComplects[i], NewNode, false, GDBMode = bkNormBase); {Complect := SCSCompon.Complects.Items[i]; ID_Child := Complect.ID_Child; //NewIDChild := CopyComplects(ID_Child, ID_SavedCompon, SCSCompon, NewNode, false, CurrNppPort); //Complect.ID_Child := NewIDChild; NewChildCompon := CopyComplects(ID_Child, ID_SavedCompon, SCSCompon, NewNode, false, CurrNppPort); if Assigned(NewChildCompon) then begin Complect.ID_Child := NewChildCompon.ID; NewIDChild := NewChildCompon.ID; CurrNewCompon.AddChildComponent(NewChildCompon); end; } end; end else begin LookedCompRels := TList.Create; //*** Сохранить подкомплектующие for i := 0 to AComponentToSave.ChildComplects.Count - 1 do begin ChildComponent := AComponentToSave.ChildComplects[i]; if ChildComponent.LinkToComlectRec <> nil then if LookedCompRels.IndexOf(ChildComponent.LinkToComlectRec) = -1 then begin SaveComplects(ChildComponent, ID_SavedCompon); LookedCompRels.Add(ChildComponent.LinkToComlectRec); end; end; FreeAndNil(LookedCompRels); end; //AComponentToSave.SaveComplects(ID_SavedCompon); if TF_Main(ATrgForm).GDBMode = bkProjectManager then AComponentToSave.SaveConnections(ID_SavedCompon); //AComponentToSave.saveco if Not AOnlyComlects then begin if (TF_Main(ATrgForm).GDBMode = bkNormBase) then AComponentToSave.SaveCrossConnectionsAsNew; AComponentToSave.SaveInterfaces(ID_SavedCompon, false); end; AComponentToSave.ID := ID_SavedCompon; //*** Для лин. типа учитывать длину исходя с настроек/запасов/коэффициентов if AComponentToSave.IsLine = biTrue then begin AComponentToSave.Length := Length; //AComponentToSave.RefreshWholeLength; AComponentToSave.RefreshWholeLengthInFuture; end; Result := AComponentToSave; end; begin Result := nil; CoordZ := 0; Length := 0; TargetNodeDat := nil; if TF_Main(ATrgForm).GDBMode = bkProjectManager then begin if ATrgObject <> nil then begin CoordZ := ATrgObject.GetPropertyValueAsFloat(pnCoordZ); Length := ATrgObject.GetPropertyValueAsFloat(pnLength); end; if (TF_Main(ASrcForm).GDBMode = bkNormBase) and Not ASrcCompon.ServNoDefinePriceCalcInChild then DefinePriceCalcInChildComponInNB(ASrcCompon, ASrcForm); end; if ATrgNode <> nil then if ATrgNode.Data <> nil then TargetNodeDat := ATrgNode.Data; //*** определить SortID SortID := 0; if ATrgNode <> nil then if ATrgNode.Count > 0 then begin Node := nil; Node := ATrgNode.GetLastChild; if (Node <> nil) and (Node.Data <> nil) then if POBjectData(Node.Data).ItemType in [itComponLine, itComponCon] then SortID := POBjectData(Node.Data).SortID + 1; end; ASrcCompon.ActiveForm := ATrgForm; ASrcCompon.DefineIDsBeforeSaveAsNew{(nil, nil, NppPort, StepIndex)}; ASrcCompon.RefreshPriceAfterChangeNDS(TF_Main(ASrcForm).GNDS, TF_Main(ATrgForm).GNDS, false); Result := SaveComponAndComplects(ASrcCompon, ATrgNode, ALoadTopComponToNode, false); end; procedure TF_MAIN.AfterSaveComponent(AIDSrcCompon: Integer; ACompon: TSCSComponent; ATrgObject: TSCSCatalog; ASrcForm, ATrgForm: TForm; AComponKind: TComponKind; ACheckVolumeResult: TModalResult; ATrgFemaleCompon: TSCSComponent; AFromHuman: Boolean); var NewNode: TTreeNode; NewIDCompon: Integer; SavedCanCallCADOnCopingCompon: Boolean; begin NewIDCompon := 0; NewNode := nil; if ACompon <> nil then begin NewNode := ACompon.TreeViewNode; //NewCopiedNode := ACompon.TreeViewNode; NewIDCompon := ACompon.ID; end; // Количество компонентов в Папке if AComponKind <> ckCompl then OnAddDeleteNode(NewNode, ACompon, nil, true); //SetKol(ATargetNode, nil); if GDBMode = bkprojectManager then begin ATrgObject.IDLastAddedComponent := NewIDCompon; ATrgObject.LastAddedComponent := ACompon; //if ATrgObject.ItemType = itSCSConnector then // DefineConnectorObjectNodeName(ATrgObject); SavedCanCallCADOnCopingCompon := FCanCallCADOnCopingCompon; FCanCallCADOnCopingCompon := false; try F_ChoiceConnectSide.OnAfterCopyCompon(ACompon, ASrcForm, ATrgForm); finally FCanCallCADOnCopingCompon := SavedCanCallCADOnCopingCompon; end; //if TF_Main(ASourceForm).GDBMode = bkNormBase then //if PobjectData(ATargetNode).ItemType = itSCSLine then // if PObjectData(NewNode.Data).ItemType = itComponLine then // if ATrgObject.ItemType = itSCSLine then //Tolik закоментил //if TargetNodeDat.ItemType = itSCSLine then if ACheckVolumeResult = IDYES then if InsertComplectInObject(NewNode, ATrgObject, ACompon, ATrgFemaleCompon, AFromHuman) then begin //GSCSBase.SCSComponent.LoadComponentByID(NewIDCompon, false); RefreshNode; end; if FCanCallCADOnCopingCompon then begin if ATrgObject.ItemType in [itSCSConnector, itArhContainer] then DefineConnectorObjectNodeName(ATrgObject); AppendRemoveComponInterfacesInCADByAllParams(ATrgObject, ACompon, nil, arAppend); //AppendRemoveComponInterfacesInCAD(NewIDCompon, arAppend); end; DefineObjectGroupForCatalog(ATrgObject); end else if GDBMode = bkNormBase then begin //if TF_Main(ASourceForm).GDBMode = bkNormBase then // if IDTargetObject > 0 then // DM.DefineComponPricesAfterMoveToNewCatalog(NewIDCompon, DM.GetComponCatalogOwnerID(AID_NBCompon), IDTargetObject); if TF_Main(ASrcForm).GDBMode = bkNormBase then if ATrgObject <> nil then if (ATrgObject.ID > 0) and (AIDSrcCompon <> 0) then DM.DefineComponPricesAfterMoveToNewCatalog(NewIDCompon, DM.GetComponCatalogOwnerID(AIDSrcCompon), ATrgObject.ID); end; if AComponKind = ckCompon then begin FillCompl(NewIDCompon, NewNode, ACompon); if NewNode <> nil then begin //Tree_Catalog.Selected := NewCopiedNode; SetSortID(NewNode, ACompon); end; end; end; // Tolik 03/07/2017 -- // оригинал закомменчен -- смотри ниже.... //Процедура выполняет создание нового СКС компонента. В отдельной процедуре потому, //что юзается несколько раз. Procedure TF_MAIN.CreateAndConnectNewSCSCompon(ASourceForm, ATargetForm: TForm; //From Dimon ;) ASrcNode: TTreeNode; AID_NBCompon: Integer; var ComponentToSave: TSCSComponent; TargetObject: TSCSCatalog; CanDevideComplects: Boolean; var NewComponList: TList); var SrcObject: TSCSCatalog; IDCompRel: Integer; IDTopComponent: Integer; TmpComponent: TSCSComponent; i,j: Integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // AInterFace: TSCSInterFace; begin case TF_Main(ASourceForm).GDBMode of bkNormBase: begin ComponentToSave := TSCSComponent.Create(ASourceForm); if TF_Main(ATargetForm).GDBMode <> bkProjectManager then begin if TF_Main(ASourceForm).GSCSBase.SCSComponent.ID = AID_NBCompon then begin if Not TF_Main(ASourceForm).GSCSBase.SCSComponent.ServAllLoaded then begin OldTick := GetTickCount; IDTopComponent := GetTopComponIDByNode(ASrcNode); IDCompRel := GetIDCompRelFromNode(ASrcNode); TF_Main(ASourceForm).GSCSBase.SCSComponent.LoadComponentByID(AID_NBCompon, true); TF_Main(ASourceForm).GSCSBase.SCSComponent.LoadChildComplects(true, CanDevideComplects, true, IDTopComponent, IDCompRel); TF_Main(ASourceForm).GSCSBase.SCSComponent.ServAllLoaded := true; if TF_Main(ATargetForm).GDBMode = bkProjectManager then begin TF_Main(ASourceForm).GSCSBase.SCSComponent.Price_Calc := TF_Main(ASourceForm).GetComponPrice(AID_NBCompon, IDCompRel, IDTopComponent); DefinePriceCalcInChildComponInNB(TF_Main(ASourceForm).GSCSBase.SCSComponent, ASourceForm); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //SaveComponAllIOfIRelsToFile(TF_Main(ASourceForm).GSCSBase.SCSComponent); end; ComponentToSave.Assign(TF_Main(ASourceForm).GSCSBase.SCSComponent, true, true); ComponentToSave.AssignChildComponents(TF_Main(ASourceForm).GSCSBase.SCSComponent.ChildComplects, true, true); ComponentToSave.ServNoDefinePriceCalcInChild := true; end else begin if F_ProjMan.CashedCompon = nil then F_ProjMan.CashedCompon := TSCSComponent.Create(ASourceForm); if F_ProjMan.CashedCompon.ID <> AID_NBCompon then begin //Tolik -- 04/07/2017 -- F_ProjMan.CashedCompon.Clear; IDTopComponent := GetTopComponIDByNode(ASrcNode); IDCompRel := GetIDCompRelFromNode(ASrcNode); F_ProjMan.CashedCompon.LoadComponentByID(AID_NBCompon, true); F_ProjMan.CashedCompon.LoadChildComplects(true, CanDevideComplects, true, IDTopComponent, IDCompRel); F_ProjMan.CashedCompon.ServAllLoaded := true; if TF_Main(ATargetForm).GDBMode = bkProjectManager then begin F_ProjMan.CashedCompon.Price_Calc := TF_Main(ASourceForm).GetComponPrice(AID_NBCompon, IDCompRel, IDTopComponent); DefinePriceCalcInChildComponInNB(F_ProjMan.CashedCompon, ASourceForm); end; // end; ComponentToSave.Assign(F_ProjMan.CashedCompon, true, true); ComponentToSave.AssignChildComponents(F_ProjMan.CashedCompon.ChildComplects, true, true); ComponentToSave.ServNoDefinePriceCalcInChild := true; end; end else begin if F_ProjMan.CashedCompon = nil then F_ProjMan.CashedCompon := TSCSComponent.Create(ASourceForm); if F_ProjMan.CashedCompon.ID <> AID_NBCompon then begin //Tolik -- 04/07/2017 -- F_ProjMan.CashedCompon.Clear; IDTopComponent := GetTopComponIDByNode(ASrcNode); IDCompRel := GetIDCompRelFromNode(ASrcNode); F_ProjMan.CashedCompon.LoadComponentByID(AID_NBCompon, true); F_ProjMan.CashedCompon.LoadChildComplects(true, CanDevideComplects, true, IDTopComponent, IDCompRel); F_ProjMan.CashedCompon.ServAllLoaded := true; if TF_Main(ATargetForm).GDBMode = bkProjectManager then begin F_ProjMan.CashedCompon.Price_Calc := TF_Main(ASourceForm).GetComponPrice(AID_NBCompon, IDCompRel, IDTopComponent); DefinePriceCalcInChildComponInNB(F_ProjMan.CashedCompon, ASourceForm); DefineComponPriceOnCopyToOtherBase(F_ProjMan.CashedCompon, nil, TargetObject, ASourceForm, ATargetForm); end; // end; ComponentToSave.Assign(F_ProjMan.CashedCompon, true, true); ComponentToSave.AssignChildComponents(F_ProjMan.CashedCompon.ChildComplects, true, true); ComponentToSave.ServNoDefinePriceCalcInChild := true; ComponentToSave.ServPriceisLoaded := True; // ComponentToSave.LoadComponentByID(AID_NBCompon, true); // ComponentToSave.LoadChildComplects(true, CanDevideComplects, true, GetTopComponIDByNode(ASrcNode), GetIDCompRelFromNode(ASrcNode)); end; if TF_Main(ATargetForm).GDBMode = bkProjectManager then SetComponAsLite(ComponentToSave); NewComponList.Add(ComponentToSave); end; bkProjectManager: begin TmpComponent := TF_Main(ASourceForm).GSCSBase.CurrProject.GetComponentFromReferences(AID_NBCompon); //*** если нет такой компоненты. то посмотреть в другиг местах if TmpComponent = nil then TmpComponent := TF_Main(ASourceForm).GSCSBase.CurrProject.SpravComponents.GetComponenByID(AID_NBCompon); if Assigned(TmpComponent) then begin //*** определить отсутствующее УГО if TmpComponent.ProjectOwner <> nil then if FCanCallCADOnCopingCompon then TmpComponent.ProjectOwner.DefineSpravObjectIconFromCAD(TmpComponent.GUIDObjectIcon, TmpComponent.GetFirstParentCatalog); ComponentToSave := TSCSComponent.Create(ASourceForm); ComponentToSave.Assign(TmpComponent, false, true); ComponentToSave.AssignChildComponents(TmpComponent.ChildComplects, true); //Tolik { for i := TmpComponent.Interfaces.Count - 1 downto 0 do begin if TSCSInterFace(TmpComponent.Interfaces[i]).Side = 2 then begin AInterFace := TSCSInterFace.Create(); AInterFace.ComponentOwner := TmpComponent; TmpComponent.Interfaces.Delete(i); TmpComponent.Interfaces.Insert(i, AInterFace); end; end;} // Сбросить Индексы в 0; ComponentToSave.MarkID := 0; for i := 0 to ComponentToSave.ChildReferences.Count - 1 do ComponentToSave.ChildReferences[i].MarkID := 0; if TF_Main(ATargetForm).GDBMode = bkNormBase then begin // Убираем пользовательскую длину if ComponentToSave.IsLine = biTrue then ComponentToSave.UserLength := 0; //*** Выкинуть нормы пришедшие из интерфейсов DeleteComponObjectsForNB(ComponentToSave, true); CorrectComponLinksBeforeSaveToNB(ComponentToSave, ASourceForm, ATargetForm, TargetObject); end; SrcObject := TmpComponent.GetFirstParentCatalog; NewComponList.Add(ComponentToSave); end; end; end; end; // (* //Процедура выполняет создание нового СКС компонента. В отдельной процедуре потому, //что юзается несколько раз. Procedure TF_MAIN.CreateAndConnectNewSCSCompon(ASourceForm, ATargetForm: TForm; //From Dimon ;) ASrcNode: TTreeNode; AID_NBCompon: Integer; var ComponentToSave: TSCSComponent; TargetObject: TSCSCatalog; CanDevideComplects: Boolean; var NewComponList: TList); var SrcObject: TSCSCatalog; IDCompRel: Integer; IDTopComponent: Integer; TmpComponent: TSCSComponent; i,j: Integer; OldTick, CurrTick: Cardinal; AInterFace: TSCSInterFace; begin case TF_Main(ASourceForm).GDBMode of bkNormBase: begin ComponentToSave := TSCSComponent.Create(ASourceForm); if TF_Main(ASourceForm).GSCSBase.SCSComponent.ID = AID_NBCompon then begin if Not TF_Main(ASourceForm).GSCSBase.SCSComponent.ServAllLoaded then begin OldTick := GetTickCount; IDTopComponent := GetTopComponIDByNode(ASrcNode); IDCompRel := GetIDCompRelFromNode(ASrcNode); TF_Main(ASourceForm).GSCSBase.SCSComponent.LoadComponentByID(AID_NBCompon, true); TF_Main(ASourceForm).GSCSBase.SCSComponent.LoadChildComplects(true, CanDevideComplects, true, IDTopComponent, IDCompRel); TF_Main(ASourceForm).GSCSBase.SCSComponent.ServAllLoaded := true; if TF_Main(ATargetForm).GDBMode = bkProjectManager then begin TF_Main(ASourceForm).GSCSBase.SCSComponent.Price_Calc := TF_Main(ASourceForm).GetComponPrice(AID_NBCompon, IDCompRel, IDTopComponent); DefinePriceCalcInChildComponInNB(TF_Main(ASourceForm).GSCSBase.SCSComponent, ASourceForm); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //SaveComponAllIOfIRelsToFile(TF_Main(ASourceForm).GSCSBase.SCSComponent); end; ComponentToSave.Assign(TF_Main(ASourceForm).GSCSBase.SCSComponent, true, true); ComponentToSave.AssignChildComponents(TF_Main(ASourceForm).GSCSBase.SCSComponent.ChildComplects, true, true); ComponentToSave.ServNoDefinePriceCalcInChild := true; end else begin ComponentToSave.LoadComponentByID(AID_NBCompon, true); ComponentToSave.LoadChildComplects(true, CanDevideComplects, true, GetTopComponIDByNode(ASrcNode), GetIDCompRelFromNode(ASrcNode)); end; if TF_Main(ATargetForm).GDBMode = bkProjectManager then SetComponAsLite(ComponentToSave); NewComponList.Add(ComponentToSave); end; bkProjectManager: begin TmpComponent := TF_Main(ASourceForm).GSCSBase.CurrProject.GetComponentFromReferences(AID_NBCompon); //*** если нет такой компоненты. то посмотреть в другиг местах if TmpComponent = nil then TmpComponent := TF_Main(ASourceForm).GSCSBase.CurrProject.SpravComponents.GetComponenByID(AID_NBCompon); if Assigned(TmpComponent) then begin //*** определить отсутствующее УГО if TmpComponent.ProjectOwner <> nil then if FCanCallCADOnCopingCompon then TmpComponent.ProjectOwner.DefineSpravObjectIconFromCAD(TmpComponent.GUIDObjectIcon, TmpComponent.GetFirstParentCatalog); ComponentToSave := TSCSComponent.Create(ASourceForm); ComponentToSave.Assign(TmpComponent, false, true); ComponentToSave.AssignChildComponents(TmpComponent.ChildComplects, true); //Tolik { for i := TmpComponent.Interfaces.Count - 1 downto 0 do begin if TSCSInterFace(TmpComponent.Interfaces[i]).Side = 2 then begin AInterFace := TSCSInterFace.Create(); AInterFace.ComponentOwner := TmpComponent; TmpComponent.Interfaces.Delete(i); TmpComponent.Interfaces.Insert(i, AInterFace); end; end;} // Сбросить Индексы в 0; ComponentToSave.MarkID := 0; for i := 0 to ComponentToSave.ChildReferences.Count - 1 do ComponentToSave.ChildReferences[i].MarkID := 0; if TF_Main(ATargetForm).GDBMode = bkNormBase then begin // Убираем пользовательскую длину if ComponentToSave.IsLine = biTrue then ComponentToSave.UserLength := 0; //*** Выкинуть нормы пришедшие из интерфейсов DeleteComponObjectsForNB(ComponentToSave, true); CorrectComponLinksBeforeSaveToNB(ComponentToSave, ASourceForm, ATargetForm, TargetObject); end; SrcObject := TmpComponent.GetFirstParentCatalog; NewComponList.Add(ComponentToSave); end; end; end; end; *) Function PushTerminalBox(CableCnt: Integer): Boolean; begin Result := false; if CableCnt >= F_PEAutoTraceDialog.AKolTrace_Edit.Value then if F_PEAutoTraceDialog.PutBox_Check.Checked then Result := true; end; // ##### копирования компоненты и ее комплектующих из NormBase в ProjectManager ##### Вернет ID Скопир-й компоненты function TF_MAIN.CopyComponentFromNbToPm(ASourceForm, ATargetForm: TForm; ASrcNode, ATargetNode: TTreeNode; AID_NBCompon: Integer; AComponKind: TComponKind; AFromHuman: Boolean = false; ALeaveComplects: Boolean = false): Integer; var //FChkSCSComponent: TSCSComponent; //*** For checking component NewSCSComponent: TSCSComponent; CanCopy: Boolean; Node: TTreeNode; NewCopiedNode: TTreeNode; NewIDCompon: Integer; NewNode: TTreeNode; NewDat: PObjectData; NodeTxt: String; TargetNodeDat: PObjectData; TargetObject: TSCSCatalog; TargetComponent: TSCSComponent; TargetCatalog: TCatalog; TargetList: TSCSList; SrcObject: TSCSCatalog; //MaxPos : Integer; //CurrPos: Integer; IDComponType: Integer; IDTargetObject: Integer; IDTargetComponent: Integer; IDCompRel: Integer; IDTopComponent: Integer; SprComponType: TNBComponentType; //NewOldID: PNewOldID; //Sort_ID: Integer; //Coeficient: Double; //*** Значение валюты в NormBase CoordZ: Double; Length: Double; strLength: String; NppPort: Integer; StepIndex: Integer; TrgFemaleCompon: TSCSComponent; CheckVolumeResult: Integer; CanDevideComplects: Boolean; ComponentToSave: TSCSComponent; ChildCompon: TSCSComponent; TmpComponent: TSCSComponent; i,j: Integer; SavedCanCallCADOnCopingCompon: Boolean; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // vList: TF_CAD; Fig: TFigure; OL: TOrtholine; // Tolik 23/09/2016-- GDragOnCadStatus : Boolean; // // NewComponList: TList; (* //*** Рекурсивная функция для копировния компоненты function CopyComplects(AComponentToSave: TSCSComponent; AParentNode: TTreeNode; ALoadToNode: boolean): TSCSComponent; var i, j, k, l: Integer; NewIDChild: Integer; //CurrNewCompon: TSCSComponent; //NewChildCompon: TSCSComponent; CCount: Integer; ID_CompProjMan: Integer; ID_SavedCompon: Integer; ID_Child: Integer; Complect: PComplect; Interf: TSCSInterface; ParentInterface: TSCSInterface; ParentIOfIRel: TSCSIOfIRel; Interfaces: TSCSInterface; IOfIRel: TSCSIOfIRel; WasBreak: Boolean; //SrcComponent: TSCSComponent; //SCSCompon: TSCSComponent; begin Result := nil; //if (TF_Main(ASourceForm).GDBMode = bkNormBase) and (GDBMode = bkProjectManager) then //begin // GSCSBase.CurrProject.Spravochnik.GetComponentTypeWithAssign(AComponentToSave.GUIDComponentType, TF_Main(ASourceForm).GSCSBase.NBSpravochnik); // GSCSBase.CurrProject.CurrList.Spravochnik.GetComponentTypeWithAssign(AComponentToSave.GUIDComponentType, TF_Main(ASourceForm).GSCSBase.NBSpravochnik); //end; DefineComponPriceOnCopyToOtherBase(AComponentToSave, SrcObject, TargetObject, ASourceForm, ATargetForm); //TBasicSCSClass(SCSCompon).ActiveForm := ATargetForm; {FProjectMan}; AComponentToSave.ActiveForm := ATargetForm; AComponentToSave.IsUserMark := biFalse; AComponentToSave.ObjectID := TargetObject.ID; AComponentToSave.ListID := TargetObject.ListID; AComponentToSave.MarkID := GenComponentMarkID(AComponentToSave); if GDBMode = bkProjectManager then AComponentToSave.NameMark := MakeNameMarkComponent(AComponentToSave, TargetObject, false); { AComponentToSave.Price := GetPriceAfterChangeNDS(AComponentToSave.Price, TF_Main(ASourceForm).GNDS, GNDS); AComponentToSave.Price := GetPriceAfterChangeRatio(AComponentToSave.Price, TF_Main(ASourceForm).GCurrencyM.Ratio, GCurrencyM.Ratio); AComponentToSave.Price_Calc := GetPriceAfterChangeNDS(AComponentToSave.Price_Calc, TF_Main(ASourceForm).GNDS, GNDS); AComponentToSave.Price_Calc := GetPriceAfterChangeRatio(AComponentToSave.Price_Calc, TF_Main(ASourceForm).GCurrencyM.Ratio, GCurrencyM.Ratio); } AComponentToSave.SortID := Sort_ID; //SCSCompon.RepairKolComplect; //*** Обновить количество компл-х в ветви компоненты (KOL_Complect) //SCSCompon.DivideComplects; AComponentToSave.CoordZ := CoordZ; ID_SavedCompon := AComponentToSave.SaveComponentAsNew(false, true); //Result := ID_SavedCompon; if (AComponKind = ckCompon) and (ALoadToNode) then if GDBMode = bkNormBase then AppendToCatalRel(PObjectData(ATargetNode.Data).ObjectID, ID_SavedCompon); if (ALoadToNode) {and (AComponKind = ckCompon) }then begin AComponentToSave.ID := ID_SavedCompon; case TargetNodeDat.ItemType of itSCSConnector, itSCSLine: if Assigned(TargetObject) then TargetObject.AddComponentToList(AComponentToSave); itComponCon, itComponLine: if Assigned(TargetComponent) then TargetComponent.AddChildComponent(AComponentToSave); end; NodeTxt := GetComponNameForVisible(AComponentToSave.Name, AComponentToSave.NameMark); NewNode := Tree_Catalog.Items.AddChild(AParentNode, NodeTxt); NewNode.Text := GetNameAndKol(NewNode.Text, AComponentToSave.KolComplect); //NewNode.ImageIndex := GetNodeImageIndex(GetSCSComponType(SCSCompon.IsLine), ekNone, -1); //itComponent; NewData(NewDat, ttComponents); NewDat.ItemType := AComponentToSave.GetItemType; NewDat.ObjectID := ID_SavedCompon; NewDat.SortID := Sort_ID; NewDat.QueryMode := AComponentToSave.QueryMode; NewDat.ComponKind := AComponKind; NewDat.NBMode := PObjectData(AParentNode.Data).NBMode; NewDat.ChildNodesCount := AComponentToSave.KolComplect; if GDBMode = bkProjectManager then NewDat.ListID := TargetObject.ListID; NewNode.Data := NewDat; AComponentToSave.TreeViewNode := NewNode; SetNodeState(NewNode, GetSCSComponType(AComponentToSave.IsLine), ekNone, AComponentToSave); Sort_ID := Sort_ID + 1; IDComponType := AComponentToSave.ID_ComponentType; end; MaxPos := MaxPos + 1; //LCount := SCSCompon.Complects.Count; if TF_Main(ATargetForm).GDBMode = bkProjectManager then for i := 0 to AComponentToSave.ChildComplects.Count - 1 do begin CopyComplects(AComponentToSave.ChildComplects[i], NewNode, false); {Complect := SCSCompon.Complects.Items[i]; ID_Child := Complect.ID_Child; //NewIDChild := CopyComplects(ID_Child, ID_SavedCompon, SCSCompon, NewNode, false, CurrNppPort); //Complect.ID_Child := NewIDChild; NewChildCompon := CopyComplects(ID_Child, ID_SavedCompon, SCSCompon, NewNode, false, CurrNppPort); if Assigned(NewChildCompon) then begin Complect.ID_Child := NewChildCompon.ID; NewIDChild := NewChildCompon.ID; CurrNewCompon.AddChildComponent(NewChildCompon); end; } end; AComponentToSave.SaveComplects(ID_SavedCompon); if TF_Main(ATargetForm).GDBMode = bkProjectManager then AComponentToSave.SaveConnections(ID_SavedCompon); //AComponentToSave.saveco if TF_Main(ATargetForm).GDBMode = bkNormBase then AComponentToSave.SaveCrossConnectionsAsNew; AComponentToSave.SaveInterfaces(ID_SavedCompon, false); AComponentToSave.ID := ID_SavedCompon; //*** Для лин. типа учитывать длину исходя с настроек/запасов/коэффициентов if AComponentToSave.IsLine = biTrue then begin AComponentToSave.Length := Length; //AComponentToSave.RefreshWholeLength; AComponentToSave.RefreshWholeLengthInFuture; end; NewCopiedNode := NewNode; NewIDCompon := ID_SavedCompon; Result := AComponentToSave; end; *) begin Result := 0; OldTick := GetTickCount; // Tolik -- 12/11/2019 -- CanCopy := true; ComponentToSave := nil; TargetObject := nil; TargetList := nil; SrcObject := nil; // Tolik 23/09/2016 -- GDragOnCadStatus := GDragOnCAD; // // NewComponList := Tlist.Create; try try NewIDCompon := -1; NewCopiedNode := nil; CoordZ := 0; //FChkSCSComponent := nil; NewSCSComponent := nil; TrgFemaleCompon := nil; CheckVolumeResult := IDYES; TargetNodeDat := nil; TargetComponent := nil; DefineChildNodes(ATargetNode); if ATargetNode <> nil then if ATargetNode.Data <> nil then TargetNodeDat := ATargetNode.Data; if TargetNodeDat = nil then Exit; //// EXIT //// IDTargetObject := 0; IDTargetComponent := 0; NppPort := 0; StepIndex := 0; TargetObject := nil; //case TargetNodeDat.ItemType of // itSCSConnector, itSCSLine, itDir, itArhContainer: if IsCatalogItemTypeForCompon(TargetNodeDat.ItemType) then IDTargetObject := TargetNodeDat.ObjectID // itComponCon, itComponLine: else if IsComponItemType(TargetNodeDat.ItemType) then begin IDTargetComponent := TargetNodeDat.ObjectID; case TF_Main(ATargetForm).GDBMode of bkNormBase: IDTargetObject := DM.GetIDCatalogByIDNoUppCompon(TargetNodeDat.ObjectID); bkProjectmanager: begin TargetComponent := GSCSBase.CurrProject.GetComponentFromReferences(TargetNodeDat.ObjectID); if Assigned(TargetComponent) then TargetObject := TargetComponent.GetFirstParentCatalog; if Assigned(TargetObject) then IDTargetObject := TargetObject.ID; end; end; end; //end; CanDevideComplects := false; case GDBMode of bkNormbase: begin if IDTargetObject > 0 then begin TargetObject := TSCSCatalog.Create(ATargetForm); TargetObject.LoadCatalogByID(IDTargetObject, false); TargetObject.LoadComponents(IDTargetObject, false); end; end; bkProjectManager: begin CanDevideComplects := true; if Not Assigned(TargetComponent) then if IDTargetComponent > 0 then TargetComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDTargetComponent); if Not Assigned(TargetObject) then if IDTargetObject > 0 then TargetObject := GSCSBase.CurrProject.GetCatalogFromReferences(IDTargetObject); end; end; if TargetObject = nil then Exit; ///// EXIT ///// TargetObject.NewComponList.Clear; ComponentToSave := nil; vList := GetListByID(TargetObject.ListID); Fig := GetFigureByID(vList, TargetObject.SCSID); if F_PEAutoTraceDialog.FromAutoTraceDialog then begin if (Fig <> nil)and(Fig.ClassName = 'TOrthoLine')and(TOrtholine(Fig).FIsRaiseUpDown)and (not GetMultipleFromNB)and (not PushTerminalBox(TConnectorObject(TOrtholine(Fig).JoinConnector2).JoinedOrtholinesList.count - 1)) then begin for j := 0 to TConnectorObject(TOrtholine(Fig).JoinConnector2).JoinedOrtholinesList.count - 1 do begin OL := TOrtholine(TConnectorObject(TOrtholine(Fig).JoinConnector2).JoinedOrtholinesList[j]); if not OL.FIsRaiseUpDown then begin CreateAndConnectNewSCSCompon(ASourceForm,ATargetForm,ASRCNode, AID_NBCompon,ComponentToSave,TargetObject, CanDevideComplects, TargetObject.NewComponList); end; end; end else CreateAndConnectNewSCSCompon(ASourceForm,ATargetForm,ASRCNode, AID_NBCompon,ComponentToSave,TargetObject, CanDevideComplects, TargetObject.NewComponList); end else begin CreateAndConnectNewSCSCompon(ASourceForm,ATargetForm,ASRCNode, AID_NBCompon,ComponentToSave,TargetObject, CanDevideComplects, TargetObject.NewComponList); end; if Not Assigned(ComponentToSave) then Exit; ///// EXIT ///// //Tolik 27/01/2022 -- здесь, если идет копирование в ПМ , то если компонента будет виртуальная и // не задан тип сети, то по умолчанию забиваемм ее принадлежность к компьютерной сети ... { if TF_Main(ATargetForm).GDBMode = bkProjectManager then TargetList := TargetObject.GetListOwner; } if TF_Main(ATargetForm).GDBMode = bkProjectManager then begin TargetList := TargetObject.GetListOwner; if ComponentToSave.IdNetType = 0 then ComponentToSave.IdNetType := 1; end; // //*** Если компонент копируется с Норм. базы в Менеджер проектов // то проверить наличие нужного количества интерфейсов (точ-й компонент > 1; // линейный компонент > 2) if (TF_Main(ASourceForm).GDBMode = bkNormBase) and (TF_Main(ATargetForm).GDBMode = bkProjectManager) then begin //*** Определить типы компонент if TargetList <> nil then begin SprComponType := TargetList.Spravochnik.GetComponentTypeByGUID(ComponentToSave.GUIDComponentType); if SprComponType <> nil then ComponentToSave.ComponentType := SprComponType.ComponentType; for i := 0 to ComponentToSave.ChildReferences.Count - 1 do begin ChildCompon := ComponentToSave.ChildReferences[i]; SprComponType := TargetList.Spravochnik.GetComponentTypeByGUID(ChildCompon.GUIDComponentType); if SprComponType <> nil then ChildCompon.ComponentType := SprComponType.ComponentType; end; end; //FChkSCSComponent := TSCSComponent.Create(TForm(FNormBase)); //try //FChkSCSComponent.ID := AID_NBCompon; //FChkSCSComponent.LoadComponentByFi([fiID, fiName]); //if Not FChkSCSComponent.HaveMinimumInterfaces then {//#Not Del# if Not ComponentToSave.HaveMinimumInterfaces(true) then begin MessageModal(cMain_Msg72_1+' "'+ComponentToSave.Name+'" '+ cMain_Msg72_2, cMain_Msg72_3, MB_ICONINFORMATION or MB_OK); Result := 0; CanCopy := false; Exit; ///// EXIT ///// end;} //*** Если кабель ложится на трассу, роверять может ли он к чему нибудб подключится if CheckSysNameIsCable(ComponentToSave.ComponentType.SysName) and (TargetObject.ItemType = itSCSLine) and (AFromHuman) then begin if Not ComponentToSave.CheckJoinToSame then begin ShowMessageByType(0, smtDisplay, cMain_Msg73_1+' "'+ComponentToSave.GetNameForVisible+'" '+cMain_Msg73_2+'.', Application.Title, MB_ICONINFORMATION or MB_OK); Result := 0; CanCopy := false; Exit; ///// EXIT ///// end; end; //finally //FreeAndNil(FChkSCSComponent); //FChkSCSComponent := nil; //end; end; //*** Проверка на вместимость CheckVolumeResult := IDNO; if TargetNodeDat.ItemType = itSCSLine then begin CheckVolumeResult := CheckComponVolumeBeforeCopy(ASourceForm, ATargetForm, ComponentToSave, TargetObject, TrgFemaleCompon, ATargetNode, AFromHuman); // Tolik -- 11/05/2017 -- // if CheckVolumeResult = IDCANCEL then if (CheckVolumeResult = IDCANCEL) or ((CheckVolumeResult = 7) and (mbNoToAll in FquastAdditButtonsPlaceToConduitMaxCompons) and AFromHuman) then // begin CanCopy := false; Exit; //// EXIT //// end; end; if GFigureSnap <> nil then begin if TargetNodeDat.ItemType = itSCSConnector then begin CheckVolumeResult := CheckComponComplectBeforeCopy(ASourceForm, ATargetForm, ComponentToSave, TargetObject, TrgFemaleCompon, ATargetNode, AFromHuman); end; end; {#В SaveComponent if GDBMode = bkProjectManager then begin CoordZ := TargetObject.GetPropertyValueAsFloat(pnCoordZ); Length := TargetObject.GetPropertyValueAsFloat(pnLength); //DM.GetPropertyValueAsFloat(tkCatalog, TargetObject.ID, pnLength, qmUndef, -1); //strLength := FloatToStr(Length); end; } if AComponKind = ckNone then //case PObjectData(ATargetNode.Data).ItemType of // itComponCon, itComponLine: // AComponKind := ckCompl; // itSCSLine, itSCSConnector, itArhContainer: // AComponKind := ckCompon; //end; AComponKind := GetComponKindByItemType(PObjectData(ATargetNode.Data).ItemType); if AComponkind = ckCompon then //*** Выйти на папку //if PObjectData(ATargetNode.Data).ItemType in [itComponLine, itComponCon] then if IsComponItemType(PObjectData(ATargetNode.Data).ItemType) then ATargetNode := ATargetNode.Parent; {#В SaveComponent Sort_ID := 0; if ATargetNode.Count > 0 then begin Node := nil; Node := ATargetNode.GetLastChild; if (Node <> nil) and (Node.Data <> nil) then if POBjectData(Node.Data).ItemType in [itComponLine, itComponCon] then Sort_ID := POBjectData(Node.Data).SortID + 1; end;} //MaxPos := 0; #В SaveComponent //CurrPos := 0; #В SaveComponent //F_Animate.StartAnimate('Копирование компоненты и ее комплектующих', aviCopyFiles, aiProgressBar); //StartStopProgress(ssStart, 'Копирование'); //Screen.Cursor := crHourGlass; //GDragPrevTickCount := GetTickCount; //ComponentToSave.RepairKolComplect; if ALeaveComplects then begin ComponentToSave.ClearChilds; ClearList(ComponentToSave.Complects); ComponentToSave.CrossConnections.Clear; // Tolik-- 06/11/2015 // если идет разделение линии, то сторона 2 должна сохранить свои подключения, а сторона // 1 - будет сброшена, так как на ней идет переподключение (там будет коннектор-разделитель) { if GCadForm.GisDivideLine then begin for i := 0 to ComponentToSave.Interfaces.Count - 1 do if ComponentToSave.Interfaces[i].Side = 1 then begin ComponentToSave.Interfaces[i].ConnectedInterfaces.Clear; ComponentToSave.Interfaces[i].IOfIRelOut.Clear; ComponentToSave.Interfaces[i].IsBusy := biFalse; end; // компонент копируется без присоединенных компонент, поэтому нужно заполнить список // по оставшимся подключенным интерфейсам, если есть (на стороне 2) for i := 0 to ComponentToSave.Interfaces.Count - 1 do begin if TSCSInterface(ComponentToSave.Interfaces[i]).Side = 2 then begin TSCSInterface(ComponentToSave.Interfaces[i]).LoadIOfIRels; for j := 0 to TSCSInterface(ComponentToSave.Interfaces[i]).ConnectedInterfaces.Count - 1 do begin if ComponentToSave.JoinedComponents.IndexOf(TSCSInterface(TSCSInterface(ComponentToSave.Interfaces[i]).ConnectedInterfaces[j]).ComponentOwner) = -1 then ComponentToSave.JoinedComponents.Add(TSCSInterface(TSCSInterface(ComponentToSave.Interfaces[i]).ConnectedInterfaces[j]).ComponentOwner); end; end; end; end else} // begin for i := 0 to ComponentToSave.Interfaces.Count - 1 do //if ComponentToSave.Interfaces[i].IsBusy = biTrue then begin ComponentToSave.Interfaces[i].ConnectedInterfaces.Clear; ComponentToSave.Interfaces[i].IOfIRelOut.Clear; ComponentToSave.Interfaces[i].IsBusy := biFalse; end; end; end; (* #В SaveComponent ComponentToSave.ActiveForm := ATargetForm; ComponentToSave.DefineIDsBeforeSaveAsNew{(nil, nil, NppPort, StepIndex)}; //ComponentToSave.RefreshPricesAfterChangeCurrency(TF_Main(ASourceForm).GCurrencyM, GCurrencyM, false); ComponentToSave.RefreshPriceAfterChangeNDS(TF_Main(ASourceForm).GNDS, GNDS, false); NewSCSComponent := CopyComplects(ComponentToSave, ATargetNode, true); *) if TargetObject.NewComponList.Count > 0 then begin for j:= 0 to TargetObject.NewComponList.Count - 1 do begin ComponentToSave := TSCSComponent(TargetObject.NewComponList[j]); NewSCSComponent := SaveComponent(ComponentToSave, TargetComponent, ATargetNode, ASourceForm, ATargetForm, SrcObject, TargetObject, true, true, AComponKind); if (F_PEAutoTraceDialog.FromAutoTraceDialog)and(NewSCSComponent.ComponentType.SysName = 'TERMINAL_BOX') then begin //Delete Height if NewSCSComponent.GetPropertyValueBySysName(pnHeightOfPlacing) <> '' then NewSCSComponent.RemovePropertyBySysName(pnHeightOfPlacing); end; // Tolik -- 23/09/2016 -- GDragOnCAD := True; AfterSaveComponent(AID_NBCompon, NewSCSComponent, TargetObject, ASourceForm, ATargetForm, AComponKind, CheckVolumeResult, TrgFemaleCompon, AFromHuman); GDragOnCAD := GDragOnCadStatus; NewIDCompon := NewSCSComponent.ID; {IGOR} //D0000006294 try // Tolik //if ((AFromHuman and (TF_Main(ATargetForm).GDBMode = bkProjectmanager)) or (F_PEAutoTraceDialog.FromAutoTraceDialog)) then if AFromHuman and (TF_Main(ATargetForm).GDBMode = bkProjectmanager) then begin if NewSCSComponent.IsLine = 0 then //Tolik { begin if not F_PEAutoTraceDialog.NewRaspredBox then } // TF_Main(NewSCSComponent.ActiveForm).F_ChoiceConnectSide.JoinConnectorWithLines(TargetObject, NewSCSComponent, nil); // end; end; except end; end; end else begin NewSCSComponent := SaveComponent(ComponentToSave, TargetComponent, ATargetNode, ASourceForm, ATargetForm, SrcObject, TargetObject, true, true, AComponKind); if (F_PEAutoTraceDialog.FromAutoTraceDialog)and(NewSCSComponent.ComponentType.SysName = 'TERMINAL_BOX') then begin //Delete Height if NewSCSComponent.GetPropertyValueBySysName(pnHeightOfPlacing) <> '' then NewSCSComponent.RemovePropertyBySysName(pnHeightOfPlacing); end; // Tolik 23/09/2016 -- GDragOnCAD := True; AfterSaveComponent(AID_NBCompon, NewSCSComponent, TargetObject, ASourceForm, ATargetForm, AComponKind, CheckVolumeResult, TrgFemaleCompon, AFromHuman); // Tolik -- 23/09/2016 - GDragOnCAD := GDragOnCadStatus; // NewIDCompon := NewSCSComponent.ID; {IGOR} //D0000006294 try //Tolik //if ((AFromHuman and (TF_Main(ATargetForm).GDBMode = bkProjectmanager)) or (F_PEAutoTraceDialog.FromAutoTraceDialog)) then if AFromHuman and (TF_Main(ATargetForm).GDBMode = bkProjectmanager) then begin if NewSCSComponent.IsLine = 0 then TF_Main(NewSCSComponent.ActiveForm).F_ChoiceConnectSide.JoinConnectorWithLines(TargetObject, NewSCSComponent, nil); end; except end; end; (* if NewSCSComponent <> nil then begin NewNode := NewSCSComponent.TreeViewNode; NewCopiedNode := NewSCSComponent.TreeViewNode; NewIDCompon := NewSCSComponent.ID; end; //NewSCSComponent := CopyComplects(AID_NBCompon, -1, nil, ATargetNode, true, NppPort {AComponKind}); //GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //*** Коррекция ID-в таблици INTERFOFINTERF_RELATION //DM.scsQ.Options := DM.scsQ.Options + [ qoStartTransaction, qoAutoCommit]; //DM.QTransaction.Active := true; //CorrectIOfIRel; //FreeNotBusyInterfaces(NewIDCompon); // Количество компонентов в Папке if AComponKind <> ckCompl then OnAddDeleteNode(NewNode, NewSCSComponent, nil, true); //SetKol(ATargetNode, nil); if GDBMode = bkprojectManager then begin TargetObject.IDLastAddedComponent := NewIDCompon; TargetObject.LastAddedComponent := NewSCSComponent; //if TargetObject.ItemType = itSCSConnector then // DefineConnectorObjectNodeName(TargetObject); SavedCanCallCADOnCopingCompon := FCanCallCADOnCopingCompon; FCanCallCADOnCopingCompon := false; try F_ChoiceConnectSide.OnAfterCopyCompon(NewSCSComponent, ASourceForm, ATargetForm); finally FCanCallCADOnCopingCompon := SavedCanCallCADOnCopingCompon; end; //if TF_Main(ASourceForm).GDBMode = bkNormBase then //if PobjectData(ATargetNode).ItemType = itSCSLine then // if PObjectData(NewNode.Data).ItemType = itComponLine then if TargetObject.ItemType = itSCSLine then if TargetNodeDat.ItemType = itSCSLine then if CheckVolumeResult = IDYES then if InsertComplectInObject(NewNode, TargetObject, TrgFemaleCompon, AFromHuman) then begin //GSCSBase.SCSComponent.LoadComponentByID(NewIDCompon, false); RefreshNode; end; if FCanCallCADOnCopingCompon then begin if TargetObject.ItemType = itSCSConnector then DefineConnectorObjectNodeName(TargetObject); AppendRemoveComponInterfacesInCADByAllParams(TargetObject, NewSCSComponent, nil, arAppend); //AppendRemoveComponInterfacesInCAD(NewIDCompon, arAppend); end; DefineObjectGroupForCatalog(TargetObject); end else if GDBMode = bkNormBase then begin if TF_Main(ASourceForm).GDBMode = bkNormBase then if IDTargetObject > 0 then DM.DefineComponPricesAfterMoveToNewCatalog(NewIDCompon, DM.GetComponCatalogOwnerID(AID_NBCompon), IDTargetObject); end;*) except on E: Exception do AddExceptionToLog('CopyComponentFromNbToPm: '+E.Message); end; finally // //19.08.2010 // if (TargetObject <> nil) and (GDBMode = bkNormBase) then // FreeAndNil(TargetObject); // //if (NewSCSComponent <> nil) and (GDBMode = bkNormBase) then // // FreeAndNil(NewSCSComponent); // //if TrgFemaleCompon <> nil then // // FreeAndNil(TrgFemaleCompon); // if TF_Main(ATargetForm).GDBMode = bkNormBase then // if Assigned(ComponentToSave) then // ComponentToSave.Free; if GDBMode = bkNormBase then begin if TargetObject.NewComponList <> nil then begin For j := 0 to TargetObject.NewComponList.Count -1 do begin //FreeAndNil(TargetObject.NewComponList); TmpComponent := TSCSCOmponent(TargetObject.NewComponList[j]); if ComponentToSave = TmpComponent then begin FreeAndNil(TmpComponent); ComponentToSave := nil; end else FreeAndNil(TmpComponent); end; end; if Assigned(ComponentToSave) then ComponentToSave.Free; if (TargetObject <> nil) then FreeAndNil(TargetObject); end; if CanCopy then begin //F_Animate.Close; //StartStopProgress(ssStop); //Screen.Cursor := crDefault; //DM.scsQ.Close; //DM.scsQ.Options := DM.scsQ.Options - [ qoStartTransaction, qoAutoCommit]; //DM.QTransaction.Active := true; Result := NewIDCompon; {case AComponKind of ckCompon: begin FillCompl(NewIDCompon, NewCopiedNode); if NewCopiedNode <> nil then begin //Tree_Catalog.Selected := NewCopiedNode; SetSortID(NewCopiedNode); end; end; ckCompl: begin //ATargetNode.DeleteChildren; //FillCompl(PObjectData(ATargetNode.Data).ObjectID, ATargetNode, DM.scsQ1); //NewCopiedNode := ATargetNode.GetLastChild; //if NewCopiedNode <> nil then // Tree_Catalog.Selected := NewCopiedNode; end; end;} end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TF_MAIN.CopyCurrList(aCopyCompons: Boolean=true); var NewListOwner: TSCSCatalog; //Tolik -- 27/02/2017 -- UserQuotaReached_Message: String; // SavedFlag: Boolean; // Tolik 29/09/2021 - - begin //Tolik -- 27/00/2017 -- UserQuotaReached_Message := ''; BeginProgress; try OpenNoExistsListInCAD(GSCSBase.CurrProject.CurrList); //Tolik 29/09/2021 - - SavedFlag := GCanRefreshCad; GCanRefreshCad := False; // NewListOwner := nil; if GSCSBase.CurrProject.CurrList.Parent <> nil then if (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itDir) or (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itProject) then NewListOwner := TSCSCatalog(GSCSBase.CurrProject.CurrList); GSCSBase.CurrProject.CurrList.SaveCAD; // Tolik -- 27/02/2017 -- if GCadForm <> nil then begin if aCopyCompons then begin UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(GCadForm.FSCSFigures.Count), cSCSComponent_Msg_23); end; end; // GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, GSCSBase.CurrProject.CurrList.Name, NewListOwner, aCopyCompons) if UserQuotaReached_Message = '' then GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, GSCSBase.CurrProject.CurrList.Name, NewListOwner, aCopyCompons) else begin GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, GSCSBase.CurrProject.CurrList.Name, NewListOwner, False); Pauseprogress(True); ShowMEssage(UserQuotaReached_Message); PauseProgress(False); end; // //GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, cMain_Msg103+' '+GSCSBase.CurrProject.CurrList.Name, NewListOwner, aCopyCompons); {if GSCSBase.CurrProject.CurrList.TreeViewNode <> nil then begin SelectNodeDirect(GSCSBase.CurrProject.CurrList.TreeViewNode); //SwitchInCAD(GSCSBase.CurrProject.CurrList.TreeViewNode, ccOne); end;} SwitchListInCAD(GSCSBase.CurrProject.CurrList.CurrID, ''); finally EndProgress; GCanRefreshCad := SavedFlag; // Tolik 29/09/2021 - - end; //27.06.2013 // //18.06.2013 - подгрузка подложки с заменой существующей, сохраняя размеры/позиции // Application.ProcessMessages; // FSCS_Main.LoadSubstrateEx(true); // // // Тулза создания м-э перехода // if MessageQuastYN(cMain_Mes139) = IDYES then // begin // Application.ProcessMessages; // if GCadForm.CurrentLayer <> lnSCSCommon then // GCadForm.CurrentLayer := lnSCSCommon; // GCadForm.PCad.SetTool(toFigure, TBetweenFloorDownVertex.ClassName); // end; //Tolik 16/06/2021 -- // FSCS_Main.CustomizeNewList; //27.06.2013 try GisListCopy := True; FSCS_Main.CustomizeNewList; //27.06.2013 finally GisListCopy := False; end; end; function TF_MAIN.AppendRemoveComponInterfacesInCAD( AID_Component: Integer; AppendRemove: TAppendRemove): Boolean; var SCSComponent: TSCSComponent; IDInterfList: TList; InterfLists: TInterfLists; Catalog: TSCSCatalog; begin Result := false; try if GDBMode <> bkProjectManager then Exit; ////// EXIT ////// Catalog := nil; SCSComponent := nil; SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(AID_Component); if SCSComponent <> nil then begin //SCSComponent := TSCSComponent.Create(Self); try //SCSComponent.LoadComponentByID(AID_Component, false); Catalog := SCSComponent.GetFirstParentCatalog; if Catalog <> nil then case SCSComponent.IsLine of ctConn: begin //IDInterfList := SCSComponent.GetAllInterfIDCompon; // if IDInterfList <> nil then begin //Catalog := DM.GetCatalogByCompon(AID_Component); AppendRemoveComponInterfacesInCADByAllParams(Catalog, SCSComponent, nil, {InterfLists, }AppendRemove); end; end; ctLine: begin //InterfLists := SCSComponent.GetInterfIDLineCompon; //if (InterfLists.InterfList1 <> nil) or (InterfLists.InterfList2 <> nil) then begin //Catalog := DM.GetCatalogByCompon(AID_Component); AppendRemoveComponInterfacesInCADByAllParams(Catalog, SCSComponent, nil, {InterfLists, }AppendRemove); end; end; end; finally //SCSComponent.Free; end; end; except on E: Exception do AddExceptionToLog('AppendRemoveComponInterfacesInCAD: '+E.Message); end; end; procedure TF_MAIN.AppendRemoveComponInterfacesInCADByAllParams(ACatalog: TSCSCatalog; ACompon: TSCSComponent; AIDInterfList: TList; AppendRemove: TAppendRemove); var DivLineValue: Double; SprSuppliesKind: TNBSuppliesKind; begin try if ACatalog <> nil then if Not ACatalog.ServDeleteInCAD then case ACatalog.ItemType of itSCSConnector: //if AIDInterfList <> nil then if (ACatalog.SCSID <> 0) {and (ACatalog.Name <> '')} then case AppendRemove of arAppend: AppendNoLineInterfacesToCAD(ACatalog.ListID, ACatalog.SCSID, ACatalog.Name); arRemove: RemoveNoLineInterfacesFromCAD(ACatalog.ListID, ACatalog.SCSID, ACatalog.Name); end; itSCSLine: //if (AInterfLists.InterfList1 <> nil) or (AInterfLists.InterfList2 <> nil) then if (ACatalog.ScsID <> 0) {and (ACatalog.Name <> '')} then case AppendRemove of arAppend: begin DivLineValue := -1; if ACompon <> nil then begin DivLineValue := ACompon.GetPropertyValueAsFloat(pnSectionSize); if DivLineValue = 0 then DivLineValue := -1; end; AppendLineInterfacesToCAD(ACatalog.ListID, ACatalog.SCSID, ACatalog.Name, DivLineValue); end; //arRemove: RemoveLineInterfacesFromCAD(ACatalog.Scs_ID, ACatalog.Name, AInterfLists); end; end; except on E: Exception do AddExceptionToLog('AppendRemoveComponInterfacesInCADByAllParams: '+E.Message); end; end; function TF_MAIN.CanExpandOnDoubleClick(ANode: TTreeNode): Boolean; var Dat: PObjectData; begin Result := true; if Assigned(ANode) then if ANode.Data <> nil then begin Dat := ANode.Data; if GFormMode = fmNormal then case Dat.ItemType of itComponCon, itComponLine: Result := false; itList, itRoom, itSCSConnector, itSCSLine: if GSCSBase.CurrProject.Active then Result := false; itProject: Result := false; end; end; end; //*** Вернет true, если был вызов свойств оюъекта function TF_MAIN.OpenNode(ANode: TTreeNode): Boolean; var Dat: PObjectData; SCSCatalog: TSCSCatalog; begin Result := false; if Assigned(ANode) then if ANode.Data <> nil then begin Dat := ANode.Data; case GFormMode of fmNormal: case Dat.ItemType of itProject: begin if Not SwitchInCAD(ANode, ccDouble) then if GSCSBase.CurrProject.Active then if Dat.ObjectID = GSCSBase.CurrProject.CurrID then ShowCurrProjectProperties; end; itList: if GSCSBase.CurrProject.Active then if Assigned(GSCSBase.CurrProject.CurrList) then if Not CheckListExist(GSCSBase.CurrProject.CurrList.CurrID) then ReopenListInCAD(GSCSBase.CurrProject.CurrList.CurrID, GSCSBase.CurrProject.CurrList.Name) else ShowListProps; itRoom: ShowRoomProps(Dat.ObjectID); itSCSLine, itSCSConnector: begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if SCSCatalog <> nil then EditFirstFigureComponent(SCSCatalog.SCSID); end; itComponCon, itComponLine: Act_EditComponent.Execute; else begin if IsArchComponByItemType(Dat.ItemType) then begin EditSelectedCADArchObj; end; end; end; fmComplects, fmConnections: if Dat.ItemType in [itComponLine, itComponCon] then BitBtn_OK.Click; fmNewFolder: BitBtn_OK.Click; end; end; end; // ##### Соответственно типу ветви дерева ANode, делает переключения на CAD-e ##### // Tolik 18/06/2021 -- //function TF_MAIN.SwitchInCAD(ANode: TTreeNode; AClickCount: TClickCount): Boolean; function TF_MAIN.SwitchInCAD(ANode: TTreeNode; AClickCount: TClickCount; aReSelectNode: Boolean = True): Boolean; // var Data: PObjectData; //LastCatalog: TSCSCatalog; ParentData: PObjectData; CurrCatalog: TSCSCatalog; CurrComponent: TSCSComponent; ParentCatalog: TSCSCatalog; ObjNode: TTreeNode; IDCurrCatalog: Integer; CatName: String; SCS_ID: Integer; QueryMode: TQueryMode; SCSList: TSCSList; ParentComponByType: TSCSComponent; ComponObjectOwner: TSCSCatalog; i: Integer; ChildCatalog: TSCSCatalog; SelectedObjectsInCAD: TIntList; // Tolik 12/05/2017 -- RefreshFlag: Boolean; // function LoadProject(AIDNewProj: Integer): Boolean; var //ProjLists: TList; ListID: Integer; //ListNode: TTreeNode; SavedProjUserInfo: TUserInfo; begin Result := false; if (GSCSBase.CurrProject.Active = false) or (GSCSBase.CurrProject.CurrID <> AIDNewProj) then if LoginUserToProject(AIDNewProj) then begin SavedProjUserInfo := TUserInfo.Create; SavedProjUserInfo.Assign(FProjUserInfo); if CheckIsCloseProject then begin ListID := -1; //UnloadCurrentProject; ChangeCurrProject(GIDLastProject, AIDNewProj); if Assigned(GSCSBase.CurrProject.CurrList) then ListID := GSCSBase.CurrProject.CurrList.CurrID; //ProjLists := GetProjectLists(AIDNewProj); //if ProjLists <> nil then begin //if AIDCurrList < 1 then // if GSCSBase.CurrProject.ProjectLists.Count > 0 then // AIDCurrList := TSCSList(GSCSBase.CurrProject.ProjectLists[0]).CurrID; // LoadNewProject(ProjLists, ListID); //SwitchListInPM(Integer(ProjLists[0]^), ''); //ListID := Integer(ProjLists.Items[0]^); //SwitchListInCAD(ListID, ''); end; //GIDLastPoject := AIDNewProj; FProjUserInfo.Assign(SavedProjUserInfo); Result := true; end; FreeAndNil(SavedProjUserInfo); end; end; // Tolik 15/06/2021 -- старая закомменчена - см ниже procedure SelectObjectsInCAD(aList, aCatalog: TSCSCatalog); var SelObjects: TIntList; SelNode: TTreeNode; ObjNode: TTreeNode; SCSObj: TSCSCatalog; i: Integer; WasSelected: Boolean; // Tolik 14/06/2021 -- SelList: TList; CurrKeyBoardState: TShiftState; KeyState: TKeyboardState; Node: TTreeNode; // begin WasSelected := false; //Tolik 14/06/2021 -- CurrKeyBoardState:= KeyboardStateToShiftState(KeyState); SelList := TList.Create; Tree_Catalog.GetSelections(SelList); // if aList.TreeViewNode <> nil then if Tree_Catalog.SelectionCount > 1 then begin SelObjects := TIntList.Create; for i := 0 to Tree_Catalog.SelectionCount - 1 do begin SelNode := Tree_Catalog.Selections[i]; ObjNode := GetParentNodeByItemType(SelNode, [itSCSLine, itSCSConnector]); if ObjNode <> nil then if CheckNodeHaveParent(ObjNode, aList.TreeViewNode) then begin SCSObj := aList.GetCatalogFromReferences(PObjectData(ObjNode.Data).ObjectID); if SCSObj <> nil then SelObjects.Add(SCSObj.SCSID); end; end; if SelObjects.Count > 1 then begin WasSelected := true; DeselectAllSCSObjectsInCAD(aList.SCSID); SelectObjectsInCADByIDs(aList.SCSID, SelObjects); end; SelObjects.Free; if SelList.Count > 1 then begin if ObjNode <> nil then begin SelList.Remove(ObjNode); SelList.Add(ObjNode); end; for i := 0 to SelList.Count - 1 do begin Node := TTreeNode(SelList[i]); Node.Selected := True; end; end; end; if Not WasSelected then SelectObjectInCAD(aCatalog.ListID, aCatalog.SCSID, aCatalog.Name); SelList.Free; // Tolik 14/06/2021 -- end; // { procedure SelectObjectsInCAD(aList, aCatalog: TSCSCatalog); var SelObjects: TIntList; SelNode: TTreeNode; ObjNode: TTreeNode; SCSObj: TSCSCatalog; i: Integer; WasSelected: Boolean; // Tolik 14/06/2021 -- SelList: TList; CurrKeyBoardState: TShiftState; KeyState: TKeyboardState; // begin WasSelected := false; //Tolik 14/06/2021 -- CurrKeyBoardState:= KeyboardStateToShiftState(KeyState); SelList := TList.Create; Tree_Catalog.GetSelections(SelList); // if aList.TreeViewNode <> nil then if Tree_Catalog.SelectionCount > 1 then begin SelObjects := TIntList.Create; for i := 0 to Tree_Catalog.SelectionCount - 1 do begin SelNode := Tree_Catalog.Selections[i]; ObjNode := GetParentNodeByItemType(SelNode, [itSCSLine, itSCSConnector]); if ObjNode <> nil then if CheckNodeHaveParent(ObjNode, aList.TreeViewNode) then begin SCSObj := aList.GetCatalogFromReferences(PObjectData(ObjNode.Data).ObjectID); if SCSObj <> nil then SelObjects.Add(SCSObj.SCSID); end; end; if SelObjects.Count > 1 then begin WasSelected := true; DeselectAllSCSObjectsInCAD(aList.SCSID); SelectObjectsInCADByIDs(aList.SCSID, SelObjects); end; SelObjects.Free; end; if Not WasSelected then SelectObjectInCAD(aCatalog.ListID, aCatalog.SCSID, aCatalog.Name); SelList.Free; // Tolik 14/06/2021 -- end; } begin Result := false; Tree_Catalog.Items.BeginUpdate; try try CurrCatalog := nil; CurrComponent := nil; ParentCatalog := nil; IDCurrCatalog := 0; if GDBMode = bkNormBase then Exit; ///// EXIT ///// {//*** Предведущая выделенная ветвь if FLastNodeDat.ObjectID > 0 then //*** Деактивировать комнату на КАДе if FLastNodeDat.ItemType = itRoom then begin LastCatalog := GSCSBase.CurrProject.CurrList.GetCatalogFromReferences(FLastNodeDat.ObjectID); if LastCatalog <> nil then DeactivateCabinetOnCAD(LastCatalog.SCSID); end;} if ANode = nil then Exit; ///// EXIT ///// if ANode.Data = nil then Exit; ///// EXIT ///// SCSList := nil; Data := ANode.Data; QueryMode := GetQueryModeByNode(GDBMode, ANode, GetQueryModeByGDBMode(GDBMode)); if QueryMode = qmPhisical then begin CurrCatalog := TSCSCatalog.Create(TForm(Self)); CurrCatalog.QueryMode := GetQueryModeByNode(GDBMode, ANode, CurrCatalog.QueryMode); CurrCatalog.LoadCatalogByID(Data.ObjectID, false); end; try if Not IsComponItemType(Data.ItemType) then //if Not(Data.ItemType in [itComponLine, itComponCon]) then begin if QueryMode = qmMemory then CurrCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Data.ObjectID); //*** Если группа, сделать активный лист этой группы if Data.ItemType in [itSCSLineGroup, itSCSConnGroup, itSCSEmptyGroup] then begin SwitchInCAD(ANode.Parent, ccOne); Tree_Catalog.Selected := ANode; end else if Assigned(CurrCatalog) then begin //*** Стал на проект if CurrCatalog.ItemType = itProject {[itDir, itList, itSCSline, itSCSConnector]} then //if GSCSBase.CurrProject.CurrID <> CurrCatalog.ProjectID then if AClickCount = ccDouble then Result := LoadProject(CurrCatalog.ID); //*** Стал на Лист if CurrCatalog.ItemType = itList then begin ChangeCurrList(GIDLastList, CurrCatalog.SCSID); if TSCSList(CurrCatalog).OpenedInCAD then SwitchListInCAD(CurrCatalog.SCSID, CurrCatalog.Name); Result := true; end; //*** Стал на Комнату if CurrCatalog.ItemType = itRoom then begin SCSList := CurrCatalog.GetListOwner; if (SCSList <> nil) and SCSList.OpenedInCAD then begin // Tolik 14/11/2016 -- DeactivateCabinetOnCAD вызывает обновление КАДа (каждый!!!) // поэтому: RefreshFlag := GCanRefreshCad; try GCanRefreshCad := False; // //*** Деактивировать другие кабинеты этого листа for i := 0 to SCSList.ChildCatalogReferences.Count - 1 do begin ChildCatalog := SCSList.ChildCatalogReferences[i]; if ChildCatalog.ItemType = itRoom then if ChildCatalog.ID <> CurrCatalog.ID then DeactivateCabinetOnCAD(ChildCatalog.ListID, ChildCatalog.SCSID); end; ActivateCabinetOnCAD(CurrCatalog.ListID, CurrCatalog.SCSID); // Tolik -- 14/11/2016 -- except on E: Exception do; end; //GCanRefreshCad := True; GCanRefreshCad := RefreshFlag; RefreshCAD(GCadForm.PCad); // end; end; //*** Стал на SCS объект if (CurrCatalog.ItemType in [itSCSLine, itSCSConnector]) then begin SCSList := CurrCatalog.GetListOwner; //*** Получить ID Листа в котором находиться данный объект if GIDLastList <> CurrCatalog.ListID then begin BaseBeginUpdate; try ChangeCurrList(GIDLastList, CurrCatalog.ListID); if (SCSList <> nil) and SCSList.OpenedInCAD then SwitchListInCAD(CurrCatalog.ListID, ''); ObjNode := FindComponOrDirInTree(Data.ObjectID, false); if ObjNode <> nil then Tree_Catalog.Selected := ObjNode; Result := true; finally BaseEndUpdate; end; end; if (SCSList <> nil) and SCSList.OpenedInCAD then //13.08.2012 SelectObjectInCAD(CurrCatalog.ListID, CurrCatalog.SCSID, CurrCatalog.Name); SelectObjectsInCAD(SCSList, CurrCatalog); end; end; end else begin CurrComponent := GSCSBase.CurrProject.GetComponentFromReferences(Data.ObjectID); if Assigned(CurrComponent) then begin if CurrComponent.ComponentType.SysName = ctsnHouse then begin ComponObjectOwner := CurrComponent.GetFirstParentCatalog; if ComponObjectOwner <> nil then SelectHouseInCAD(CurrComponent.ListID, ComponObjectOwner.SCSID); end else if CurrComponent.ComponentType.SysName = ctsnApproach then begin // Находим компонент Дом ParentComponByType := GetParentComponByCompTypeSysName(CurrComponent, ctsnHouse); if ParentComponByType <> nil then begin ComponObjectOwner := ParentComponByType.GetFirstParentCatalog; if ComponObjectOwner <> nil then SelectApproachInCAD(ComponObjectOwner.ListID, ComponObjectOwner.SCSID, CurrComponent.ID); end; end else if IsArchComponByItemType(Data.ItemType) then SelectCADObjByArchObj(CurrComponent) else CurrCatalog := CurrComponent.GetFirstParentCatalog; ShowCADObjectView(true, CurrComponent); end; if Assigned(CurrCatalog) then begin SCSList := CurrCatalog.GetListOwner; if CurrCatalog.ListID <> GIDLastList then if GIDLastList <> CurrCatalog.ListID then begin BaseBeginUpdate; try ChangeCurrList(GIDLastList, CurrCatalog.ListID); if (SCSList <> nil) and SCSList.OpenedInCAD then SwitchListInCAD(CurrCatalog.ListID, ''); finally BaseEndUpdate; end; end; if (SCSList <> nil) and SCSList.OpenedInCAD then begin if aReSelectNode then // Tolik 18/06/2021 - - begin SelectedObjectsInCAD := GetObjectsListWithSelectedInCAD(CurrCatalog.ListID); if SelectedObjectsInCAD.IndexOf(CurrCatalog.SCSID) = -1 then //13.08.2012 SelectObjectInCAD(CurrCatalog.ListID, CurrCatalog.SCSID, ''); SelectObjectsInCAD(SCSList, CurrCatalog); FreeAndNil(SelectedObjectsInCAD); end; end; if Assigned(CurrComponent.TreeViewNode) then Tree_Catalog.Selected := CurrComponent.TreeViewNode; Result := true; end; end; finally if QueryMode = qmPhisical then FreeAndNil(CurrCatalog); end; except on E: Exception do AddExceptionToLog('TF_MAIN.SwitchInCAD: '+E.Message); end; finally Tree_Catalog.Items.EndUpdate; // Tolik 23//11//2016-- Tree_Catalog.Refresh; // end; end; // ##### Выдиляет трассу на которой лежит линейный компонент ##### procedure TF_MAIN.SelectTraceInCADByIDCompon(AIDComponent: Integer); var TraceCompon: TIntList; TraceComponList: TList; // Tolik -- 13/09/2016 -- Compon: TSCSComponent; begin GDragPrevTickCount := GetTickCount; TraceCompon := nil; // Tolik -- 13/09/2016 -- // TraceCompon := GetComponLineTrace(AIDComponent); Compon := nil; Compon := F_ProjMan.GSCSBase.CurrProject.CurrList.GetComponentFromReferences(AIDComponent); if Compon <> nil then TraceCompon := GetCableWayTraceList(Compon); // if TraceCompon <> nil then begin TraceComponList := IntListToList(TraceCompon); SelectTraceInCAD(TraceComponList); FreeList(TraceComponList); end; TraceCompon.Free; //FreeList(TraceCompon) GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; end; // ##### Проверка на цикличискую связь компонентов ##### function TF_MAIN.CanCycleCompon(AID_Component, AID_CanChild: Integer): Boolean; var FindedCompon: Boolean; procedure FindCycleCompon(AID_ParentCompon: Integer); var ID_Child: ^Integer; ComplectList: TSCSComponents; ChildComponent: TSCSComponent; i: Integer; LCount: Integer; begin ComplectList := DM.GetComponChilds(AID_ParentCompon, AID_ParentCompon, 0, nil, ''); if Assigned(ComplectList) then begin for i := 0 to ComplectList.Count - 1 do if Assigned(ComplectList[i]) then if ComplectList[i].ID = AID_CanChild then begin FindedCompon := true; Break; end; if Not FindedCompon then for i := 0 to ComplectList.Count - 1 do if Assigned(ComplectList[i]) then FindCycleCompon(ComplectList[i].ID); FreeAndNil(ComplectList); end; { SetSQLToQuery(DM.scsQ, ' SELECT ID_COMPONENT, ID_CHILD FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+ IntToStr(AID_ParentCompon) +''') AND (CONNECT_TYPE = '''+IntToStr(cntComplect)+''') '); ComplectList := TList.Create; while Not DM.scsQ.Eof do begin if DM.scsQ.GetFNAsInteger('ID_Child') = AID_CanChild then begin FindedCompon := true; Break; end; New(ID_Child); ID_Child^ := DM.scsQ.GetFNAsInteger('ID_Child'); ComplectList.Add(ID_Child); DM.scsQ.Next; end; if Not FindedCompon then begin LCount := ComplectList.Count; for i := 0 to LCount - 1 do begin ID_Child := ComplectList.Items[i]; FindCycleCompon(ID_Child^); end; end; FreeList(ComplectList); } end; begin Result := false; FindedCompon := false; FindCycleCompon(AID_Component); Result := FindedCompon; end; // ##### Нажатие на OK ##### procedure TF_MAIN.BitBtn_OKClick(Sender: TObject); begin case GFormMode of fmComplects: if Not(PObjectData(Tree_Catalog.Selected.Data).ItemType in [itComponLine, itComponCon]) then begin MessageModal(cMain_Msg74_1, cMain_Msg74_2, MB_OK or MB_ICONINFORMATION); ModalResult := mrNone; end else ModalResult := mrOk; end; end; procedure TF_MAIN.GT_InterfaceGenderGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := GetInterfaceGenderName(AText); {if AText = '0' then AText := 'мама'; if AText = '1' then AText := 'папа';} end; // ##### Соедеинение интерфейсов 2-х компонентов (AID_Compon = ID компоненты; // AID_Compon2 = комплектующей) ##### // ############################################################################# // // ##### Заполнить список интерфейсов компоненты ##### procedure TF_MAIN.FillInterfList(var AInterfList: TList; AID_Compon: Integer; AConnectType: TConnectType; ATakeBusy: Boolean = false); var InterfaceRelData: TSCSInterface; begin //*** Выделить все интерфейсы компонены ID которого = AID_Compon SetSQLToQuery(DM.scsQ, ' SELECT * FROM INTERFACE_RELATION '+ ' WHERE (INTERFACE_RELATION.ID_COMPONENT = '''+IntToStr(AID_Compon)+''' ) AND '+ ' (INTERFACE_RELATION.ID_COMPONENT in (SELECT ID FROM COMPONENT) )' + ' ORDER BY ID_iNTERFACE '); while not DM.scsQ.Eof do begin if (DM.scsQ.GetFNAsInteger('isBusy') = 0) or ((DM.scsQ.GetFNAsInteger('Multiple') = 1) and (AConnectType = cntUnion) ) or (ATakeBusy = true) then begin InterfaceRelData := TSCSInterface.Create(Self); InterfaceRelData.ID := DM.scsQ.GetFNAsInteger('ID'); InterfaceRelData.ID_Component := AID_Compon; InterfaceRelData.ID_INTERFACE := DM.scsQ.GetFNAsInteger('ID_INTERFACE'); InterfaceRelData.TypeI := DM.scsQ.GetFNAsInteger('TypeI'); InterfaceRelData.GENDER := DM.scsQ.GetFNAsInteger('Gender'); InterfaceRelData.Multiple := DM.scsQ.GetFNAsInteger('Multiple'); InterfaceRelData.IsBusy := DM.scsQ.GetFNAsInteger('IsBusy'); //*** Занести запись в список AInterfList.Add(InterfaceRelData); end; DM.scsQ.Next; end; end; function TF_MAIN.GetInterfPortMemTable: TkbmMemTable; begin Result := nil; case Grid_CompData.ActiveLevel.Index of cdliInterface: Result := DM.MemTable_InterfaceRel; cdliPort: Result := DM.MemTable_Port; end; end; // ##### отсоединяет компонент от остальных компонентов ##### procedure TF_MAIN.DisconnectCompon(AIDCompon: Integer; ACompon: TSCSComponent); var qrSQL: String; IDConnectedCompons: TList; i: Integer; SCSComponent: TSCSComponent; JoinedCompons: TSCSComponents; JoinComponent: TSCSComponent; begin try try IDConnectedCompons := nil; { IDConnectedCompons := DM.GetCompRelFieldValueListByFilter(fnID, '((id_component = '''+IntToStr(AIDCompon)+''') or '+ '(id_child = '''+IntToStr(AIDCompon)+''')) and '+ '(connect_type = '''+IntToStr(cntUnion)+''')'); //*** Процесс отсоединения for i := 0 to IDConnectedCompons.Count - 1 do DelComplect(Integer(IDConnectedCompons.Items[i]^), AIDCompon, nil, cntUnion); } if GDBMode = bkProjectManager then begin SCSComponent := ACompon; if SCSComponent = nil then SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDCompon); if Assigned(SCSComponent) then if SCSComponent.JoinedComponents.Count > 0 then begin JoinedCompons := TSCSComponents.Create(false); JoinedCompons.Assign(SCSComponent.JoinedComponents); try for i := 0 to JoinedCompons.Count - 1 do begin JoinComponent := JoinedCompons[i]; // если один из компонент не удаляется if Not SCSComponent.ServToDelete or Not JoinComponent.ServToDelete then SCSComponent.DisJoinFrom(JoinComponent); //DelComplect(JoinComponent.ID, AIDCompon, nil, cntUnion); end; finally JoinedCompons.Free; end; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.DisconnectCompon: '+E.Message); end; finally //FreeList(IDConnectedCompons); end; end; function TF_MAIN.ReplaceComponent(AFolder: TSCSCatalog; AReplaceCompon: TSCSComponent): Boolean; var ReplaceCompon: TSCSComponent; ReplaceComponents: TSCSComponents; ReplaceComponIndex: Integer; NBComponent: TSCSComponent; i, j: Integer; ComponentsForReplace: TSCSComponents; GuidComponToReplace: String; CurrCompon: TSCSComponent; RepleceName: String; ReplacedComponents: TStringList; SCSListIDs: TIntList; RFolder: TSCSCatalog; CanReplaceCompon: Boolean; LookedWholeComponentIDs: TIntList; CanShowMesssage: Boolean; // Tolik 08/04/2020 -- TryPeplacePotrNumbers: Boolean; // Tolik 13/12/2018 -- Procedure DropUserCaptions; var ReplFolder: TSCSCatalog; ReplaceFigure: TFigure; begin if AReplaceCompon <> nil then begin ReplFolder := AReplaceCompon.GetFirstParentCatalog; if ReplFolder<> nil then begin ReplaceFigure := GetFigureByID(GCadForm, ReplFolder.SCSId); if ReplaceFigure <> nil then begin if CheckFigureByClassName(ReplaceFigure, cTConnectorObject) then TConnectorObject(ReplaceFigure).FIsCaptionsChanged := False; end; end; end; end; // procedure AddComponentToReplaceList(AComponent: TSCSComponent); begin ComponentsForReplace.Add(AComponent); if AComponent.IsLine = biTrue then LookedWholeComponentIDs.Add(AComponent.Whole_ID); end; // Tolik -- 09/04/2020 -- определить, есть ли у компонента хоть один порт function CheckHasPort(aCompon: TSCSComponent): boolean; var i: integer; begin Result := False; if Assigned(aCompon) then if Assigned(aCompon.Interfaces) then begin for i := 0 to aCompon.Interfaces.Count - 1 do begin if aCompon.Interfaces[i].TypeI = itFunctional then if aCompon.Interfaces[i].isPort = biTrue then begin Result := True; break; end; end; end; end; begin // Tolik 08/04/2020 -- GComponsParentListForPortsReindex := TList.Create; // список парентов для переиндексации портов, если в них(портах) будет расходжение // Result := false; if Assigned(AReplaceCompon) then begin ReplaceComponents := TSCSComponents.Create(false); ReplaceComponents.Add(AReplaceCompon); NBComponent := CreateFConnectComplWith.DefineReplaceComponent(ReplaceComponents, ReplaceComponIndex, false); if Assigned(NBComponent) then if ReplaceComponIndex <> -1 then begin CanShowMesssage := false; DropUserCaptions; // Tolik 13/12/2018 -- BeginProgress; FAllowTreeCatalogChange := false; try {//17.08.2012 //*** Определить листы, на которых будут заменены компоненты SCSListIDs := GetVariousListsIDsByComponsWithWhole(GSCSBase.CurrProject, ReplaceComponents); SaveListsToUndoStack(SCSListIDs); FreeAndNil(SCSListIDs);} ReplacedComponents := TStringList.Create; ComponentsForReplace := TSCSComponents.Create(false); LookedWholeComponentIDs := TIntList.Create; try //if AFolder is TSCSList then //OpenNoExistsListInCAD(AFolder); GuidComponToReplace := ReplaceComponents[ReplaceComponIndex].GuidNB; RepleceName := ReplaceComponents[ReplaceComponIndex].GetNameForVisible(false); //*** Составить список заменяемых номпонент AddComponentToReplaceList(ReplaceComponents[ReplaceComponIndex]); RFolder := nil; if F_ConnectComplWith.cbApplyForCurrProj.Checked then RFolder := AFolder.GetParentCatalogByItemType(itProject) else if F_ConnectComplWith.cbApplyForCurrList.Checked then if AFolder.ItemType = itList then RFolder := AFolder else RFolder := AFolder.GetParentCatalogByItemType(itList); if RFolder <> nil then for i := 0 to RFolder.ComponentReferences.Count - 1 do begin CurrCompon := RFolder.ComponentReferences[i]; CanReplaceCompon := true; if F_ConnectComplWith.cbApplyForOnlySelected.Checked then CanReplaceCompon := IsSelectedComponFigure(CurrCompon); if CanReplaceCompon then if (CurrCompon.GuidNB = GuidComponToReplace) and (CurrCompon <> ReplaceComponents[ReplaceComponIndex]) and (F_ConnectComplWith.cbApplyForComplects.Checked or (CurrCompon.Parent is TSCSCatalog) or (CurrCompon.IsLine = biTrue)) and //Заменять комплектующие ((CurrCompon.IsLine = biFalse) or (LookedWholeComponentIDs.IndexOf(CurrCompon.Whole_ID) = -1)) then begin AddComponentToReplaceList(CurrCompon); end; end; if ComponentsForReplace.Count > 0 then //17.08.2012 begin //*** Определить листы, на которых будут заменены компоненты SCSListIDs := GetVariousListsIDsByComponsWithWhole(GSCSBase.CurrProject, ComponentsForReplace); SaveListsToUndoStack(SCSListIDs); FreeAndNil(SCSListIDs); // Tolik 09/04/2020 -- TryPeplacePotrNumbers := false; if NbComponent.isLine = biFalse then TryPeplacePotrNumbers := checkHasPort(NBComponent); //*** Заменить компоненты for i := 0 to ComponentsForReplace.Count - 1 do begin CurrCompon := ComponentsForReplace[i]; //Tolik 09/04/2020 -- if CurrCompon.isLine = biFalse then begin if not TryPeplacePotrNumbers then TryPeplacePotrNumbers := checkHasPort(CurrCompon); end else TryPeplacePotrNumbers := false; // на всякий.... // RepleceName := CurrCompon.GetNameForVisible(false); if CurrCompon.CanReplaceWithNBCompon(NBComponent, F_ConnectComplWith.cbLeaveComplectsInTarget.Checked) = [crcrSuccessful] then // Tolik 09/04/2020 -- //if CurrCompon.ReplaceWithNBCompon(NBComponent, F_ConnectComplWith.cbLeaveComplectsInTarget.Checked) <> nil then //if ReplacePMComponFromNB(CurrCompon, NBComponent, F_ConnectComplWith.cbLeaveComplectsInTarget.Checked, ReindexSilent) <> nil then if ReplacePMComponFromNB(CurrCompon, NBComponent, F_ConnectComplWith.cbLeaveComplectsInTarget.Checked, TryPeplacePotrNumbers) <> nil then // ReplacedComponents.Add(cMain_Msg75_1+' "'+RepleceName+'" '+cMain_Msg75_2+'.'); end; //if ReplacedComponents.Count > 0 then // ShowMessageByType(0, smtProtocol, ReplacedComponents.Text, '', 0); if ReplacedComponents.Count > 0 then Result := true; end; FreeAndNil(NBComponent); finally FreeAndNil(LookedWholeComponentIDs); FreeAndNil(ComponentsForReplace); if ReplacedComponents.Count > 0 then CanShowMesssage := true; ReplacedComponents.Free; ReselectNode; end; finally FAllowTreeCatalogChange := true; EndProgress; end; if CanShowMesssage then ShowMessageByType(0, smtDisplay, cMain_Msg76, ApplicationName, MB_ICONINFORMATION or MB_OK); if GComponsParentListForPortsReindex.Count > 0 then DM.DefineComponNppPorts(GComponsParentListForPortsReindex); end; FreeAndNil(GComponsParentListForPortsReindex); // Tolik 09/04/2020 -- FreeAndNil(ReplaceComponents); end; end; function TF_MAIN.ReplaceComponents(AComponentsToReplace: TSCSComponents; ANBComponent: TSCSComponent): Boolean; begin Result := false; end; //Tolik 22/11/2021 - - //procedure TF_MAIN.SetCableCanalConnectors(AForSelectedTraces: Boolean); procedure TF_MAIN.SetCableCanalConnectors(AForSelectedTraces: Boolean; aInstallTubesElements: Boolean = false); // var Dat: PObjectData; Folder: TSCSCatalog; List: TSCSList; CableCanals: TSCSComponents; CableCanalsInSpecialTraces: TSCSComponents; CableCanalSectionSide: Double; SCSComponent: TSCSComponent; ComponOwner: TSCSCatalog; i: Integer; CanAddComponToList: Boolean; IsSetConnectorsAtFalseFloorHeight: Integer; Connectors: TList; FindedConnectors: TSCSCatalogs; //SetConnectorCount: Integer; ptrConnectorWithLines: PConnectorWithLines; WasEndProgress: Boolean; Log: TStringList; SCSListIDs: TIntList; FindedNBConnectorIDs: TIDStringList; NBConnectors: TSCSComponents; CCESelectedForAll: TSCSComponents; CCESelectedForAllWithFemales: TSCSComponents; IsAskCCEOtherType: Boolean; CCEOtherTypeSelectedForAll: TSCSComponents; MessageResToJoinCCEWithAdapterThroughFemales: TModalResult; TubeConnectionkindForAll: TIntList; IsAborted: Boolean; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // // Tolik -- 28/02/2017 -- UserQuotaReached_Message: String; // сообщение о превышении квоты объектов USER // //Tolik -- 13/11/2015 CorkOnEndTracePointObject: Boolean; // ставить заглушки на концы трасс, если там есть точечные объекты DelConnFromList: Boolean; aSaveCT: TConnectorType; // функция перекинута из U_Common(GetObjectsListForCork), чтобы, во-первых, не поломать остальной функционал // и, во-вторых, сделать здесь проверку, включать ли в список коннекторов концы трасс, чтобы не передавать параметром // выбор пользователя ConnectComponType: String; // Tolik 22/11/2021 -- Function GetObjectsListForCork_New(AListID, AID_LineFigure, ALineSide: Integer; var AID_Connector: Integer): TIntList; var i, j: integer; ASelfLine: TOrthoLine; AConnector: TConnectorObject; GetPointObject: TConnectorObject; JoinedLine: TOrthoLine; JoinedConn: TConnectorObject; ID: Integer; IDLine: ^Integer; vList: TF_CAD; // Tolik -- 13/11/2015 function CanAddConnectorToList(CanConnector: TConnectorObject): Boolean; var i, j, JoinLineCount: Integer; JoinConn, JConn: TConnectorObject; SCSCatalog : TSCSCatalog; begin Result := True; JoinLineCount := 0; // количество присоединенных трасс if AConnector.JoinedConnectorsList.Count = 0 then begin if (AConnector.FConnRaiseType <> crt_BetweenFloorUp) and (AConnector.FConnRaiseType <> crt_BetweenFloorDown) then begin for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin Inc(JoinLineCount); end; end; end else // через точ.объект begin JoinConn := TConnectorObject(AConnector.JoinedConnectorsList[0]); if (JoinConn.FConnRaiseType <> crt_BetweenFloorUp) and (JoinConn.FConnRaiseType <> crt_BetweenFloorDown) then begin for i := 0 to JoinConn.JoinedConnectorsList.Count - 1 do begin JConn := TConnectorObject(JoinConn.JoinedConnectorsList[i]); for j := 0 to JConn.JoinedOrtholinesList.Count - 1 do begin Inc(JoinLineCount); end; end; end; end; // если конец трассы(который совсем конец), смотрим, ставить ли заглушку на точечном if JoinLineCount = 1 then begin if (AConnector.JoinedConnectorsList.Count <> 0) and (TConnectorObject(AConnector.JoinedConnectorsList[0]).ConnectorType = ct_NB) then begin if not CorkOnEndTracePointObject then Result := False; end; end; // если есть точечный объект на стыке трасс, элементы кабельного на такой стык тоже не устанавливаем if Result then if (JoinLineCount > 1) and (AConnector.JoinedConnectorsList.Count <> 0) and (TConnectorObject(AConnector.JoinedConnectorsList[0]).ConnectorType = ct_NB) then Result := False; end; // begin Result := TIntList.Create; try AConnector := nil; //#From Oleg# //14.09.2010 AID_Connector := -1; vList := GetListByID(AListID); if vList <> nil then begin ASelfLine := TOrthoLine(GetFigureByID(vList, AID_LineFigure)); if ASelfLine <> nil then begin if ALineSide = 1 then AConnector := TConnectorObject(ASelfLine.JoinConnector1); if ALineSide = 2 then AConnector := TConnectorObject(ASelfLine.JoinConnector2); //Tolik -- 16/11/2015 if CanAddConnectorToList(AConnector) then begin Result := TIntList.Create; // // лист из присоединенных трасс // напрямую if AConnector.JoinedConnectorsList.Count = 0 then begin if (AConnector.FConnRaiseType <> crt_BetweenFloorUp) and (AConnector.FConnRaiseType <> crt_BetweenFloorDown) then begin // Вернуть ИД коннектора AID_Connector := AConnector.ID; for i := 0 to AConnector.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(AConnector.JoinedOrtholinesList[i]); //New(IDLine); //ID := JoinedLine.ID; //IDLine^ := ID; //Result.Add(IDLine); Result.Add(JoinedLine.ID); end; end; end else // через точ.объект begin GetPointObject := TConnectorObject(AConnector.JoinedConnectorsList[0]); if (GetPointObject.FConnRaiseType <> crt_BetweenFloorUp) and (GetPointObject.FConnRaiseType <> crt_BetweenFloorDown) then begin AID_Connector := GetPointObject.ID; for i := 0 to GetPointObject.JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(GetPointObject.JoinedConnectorsList[i]); for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); //New(IDLine); //ID := JoinedLine.ID; //IDLine^ := ID; //Result.Add(IDLine); Result.Add(JoinedLine.ID); end; end; end; end; end; //end end; end; except on E: Exception do addExceptionToLogEx('U_Common.GetObjectsListForCork_New', E.Message); end; end; // procedure DefineConnectors(ACableCanalCompon: TSCSComponent; ASide: Integer); var ListOwner: TSCSList; RoomOwner: TSCSCatalog; CanalObject: TSCSCatalog; IDCADConnector: Integer; ConnectorLinesID: TIntList; ptrConnectorWithLines: PConnectorWithLines; ConnectorObject: TSCSCatalog; ConnectorObjectCoordZ: Double; HeightCeiling: Double; ConnectedLines: TSCSCatalogs; CableCanal: TSCSComponent; CableCanalObject: TSCSCatalog; CanAddConnectorInfo: Boolean; i: Integer; begin if Assigned(ACableCanalCompon) and //Tolik 07/03/2025 -- //(ACableCanalCompon.ComponentType.SysName = ctsnCableChannel) and (ASide > 0) then ((ACableCanalCompon.ComponentType.SysName = ctsnCableChannel) or (ACableCanalCompon.ComponentType.SysName = ctsnTube)) and (ASide > 0) then begin CanalObject := ACableCanalCompon.GetFirstParentCatalog; if Assigned(CanalObject) then begin IDCADConnector := -1; //Tolik -- 16/11/2015 //ConnectorLinesID := GetObjectsListForCork(CanalObject.ListID, CanalObject.SCSID, ASide, IDCADConnector); ConnectorLinesID := GetObjectsListForCork_New(CanalObject.ListID, CanalObject.SCSID, ASide, IDCADConnector); // if Assigned(ConnectorLinesID) and ((ConnectorLinesID.Count = 1) or // Для заглушки (ConnectorLinesID.Count = 2) or // Для уголка (ConnectorLinesID.Count = 3) or // Для тройника (ConnectorLinesID.Count = 4)) then // Для кроссовины begin if IDCADConnector > 0 then begin ConnectorObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(IDCADConnector); if Assigned(ConnectorObject) and (FindedConnectors.IndexOf(ConnectorObject) = -1) then begin //*** Если высота между потолком и подвесным потолком ConnectorObjectCoordZ := ConnectorObject.GetPropertyValueAsFloat(pnCoordZ); ListOwner := ConnectorObject.GetListOwner; if ListOwner <> nil then begin HeightCeiling := ListOwner.Setting.HeightCeiling; RoomOwner := ConnectorObject.GetParentCatalogByItemType(itRoom); if RoomOwner <> nil then if RoomOwner.RoomSetting.HeightCeiling > 0 then HeightCeiling := RoomOwner.RoomSetting.HeightCeiling; //if Not( (ConnectorObjectCoordZ >= ListOwner.Setting.HeightRoom - HeightCeiling) and // (ConnectorObjectCoordZ <= ListOwner.Setting.HeightRoom)) then CanAddConnectorInfo := true; // Если коннектор на высоте фальш потолка if (ConnectorObjectCoordZ >= (ListOwner.Setting.HeightRoom - HeightCeiling)) and (ConnectorObjectCoordZ <= ListOwner.Setting.HeightRoom) then begin if IsSetConnectorsAtFalseFloorHeight = biNone then begin PauseProgress(true); try if MessageModal(cMain_Msg170, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then IsSetConnectorsAtFalseFloorHeight := biTrue else IsSetConnectorsAtFalseFloorHeight := biFalse; finally PauseProgress(false); end; end; CanAddConnectorInfo := (IsSetConnectorsAtFalseFloorHeight = biTrue); end else // если коннектор выше высоты комнаты if ConnectorObjectCoordZ > ListOwner.Setting.HeightRoom then begin CanAddConnectorInfo := false; Log.Add(ConnectorObject.GetNameForVisible +' '+cMain_Msg169+' '+ FloatToStr(RoundCP(FloatInUOM(ListOwner.Setting.HeightRoom, umMetr, FUOM)))+', '+GetNameUOM(FUOM, true)); end; if CanAddConnectorInfo then begin ConnectedLines := TSCSCatalogs.Create(false); for i := 0 to ConnectorLinesID.Count - 1 do begin CableCanalObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(ConnectorLinesID[i]); if Assigned(CableCanalObject) then if assigned(CableCanalObject.ComponentReferences) then //Tolik 07/03/2025 // if CableCanalObject.ComponentReferences.GetComponentByType(ctsnCableChannel) <> nil then if CableCanalObject.ComponentReferences.GetComponentByType(ACableCanalCompon.Componenttype.SysName) <> nil then // ConnectedLines.Add(CableCanalObject); end; GetMem(ptrConnectorWithLines, SizeOf(TConnectorWithLines)); ptrConnectorWithLines.ConnectorObject := ConnectorObject; ptrConnectorWithLines.ConnectedLines := ConnectedLines; ptrConnectorWithLines.TraceSCSIDList := TIntList.Create; ptrConnectorWithLines.TraceSCSIDList.Assign(ConnectorLinesID); Connectors.Add(ptrConnectorWithLines); FindedConnectors.Add(ConnectorObject); end; end; end; end; FreeAndNil(ConnectorLinesID); end; end; end; end; procedure ShowConnectorObjectInCAD(AObject: TSCSCatalog); begin Application.ProcessMessages; ShowObjectInPM(AObject.SCSID, ''); //SelectObjectInCAD(ObjectToSelect.ListID, ObjectToSelect.SCSID, ''); SelectObjectInCAD(AObject.ListID, AObject.SCSID, ''); //Application.ProcessMessages; end; function GetCableCanalsIDNBConnectorsByType(ACableCanals: TSCSComponents; ASCSObject: TSCSCatalog; AConnectorType: Integer; AConnectorOwners: TSCSComponents): TIntList; var i, j: Integer; SCSComponent: TSCSComponent; IDNBConnectors: TIntList; IntValue: Integer; CanUseConnector: Boolean; CableChannel: TSCSComponent; NBConnector: TSCSComponent; ConnectorsTubeConnectionKinds: TIntList; TubeJoinKindStr: String; TubeJoinKindFromConnector: Integer; TubeJoinKindFromTube: Integer; TubeJoinKindToUse: Integer; IndexOfTubeJoinKind: Integer; SelectedTubeJoinKind: TStringItem; TubeJoinKinds: TStringList; IsApplyTubeJoinKindForAll: Boolean; TubeJoinKindName: String; begin Result := TIntList.Create; for i := 0 to ACableCanals.Count - 1 do begin IDNBConnectors := ACableCanals[i].GetCableCanalIDNBConnectorByType(AConnectorType, true, FindedNBConnectorIDs); //Result.Assign(IDNBConnectors, laOr); for j := 0 to IDNBConnectors.Count - 1 do begin IntValue := IDNBConnectors[j]; if Result.IndexOf(IntValue) = -1 then begin CanUseConnector := true; if CanUseConnector then begin Result.Add(IntValue); if AConnectorOwners <> nil then AConnectorOwners.Add(ACableCanals[i]); end; end; end; FreeAndNil(IDNBConnectors); end; {$IF Defined(TUBE)} if Result.Count > 0 then begin TubeJoinKindToUse := -1; TubeJoinKindFromConnector := -1; TubeJoinKindFromTube := -1; ConnectorsTubeConnectionKinds := TIntList.Create; // Смотрим сколько разных зачений свойства "Вид соединения труб" находится на каб. каналах // Если несколько разных, то пропускаем эту точку for i := 0 to ACableCanals.Count - 1 do begin CableChannel := ACableCanals[i]; TubeJoinKindFromTube := -1; TubeJoinKindStr := CableChannel.GetPropertyValueBySysName(pnTubeJoinKind); if TubeJoinKindStr <> '' then begin try TubeJoinKindFromTube := StrToInt(TubeJoinKindStr); except end; if TubeJoinKindFromTube <> -1 then if ConnectorsTubeConnectionKinds.IndexOf(TubeJoinKindFromTube) = -1 then ConnectorsTubeConnectionKinds.Add(TubeJoinKindFromTube); end; end; if ConnectorsTubeConnectionKinds.Count > 1 then begin Result.Clear; if AConnectorOwners <> nil then AConnectorOwners.Clear; end else begin if ConnectorsTubeConnectionKinds.Count > 0 then if ConnectorsTubeConnectionKinds[0] <> -1 then TubeJoinKindFromTube := ConnectorsTubeConnectionKinds[0]; // Смотрим сколько разных значений свойства "Вид соединения труб" находится в найденных ЭКК ConnectorsTubeConnectionKinds.Clear; for i := 0 to Result.Count - 1 do begin IntValue := Result[i]; NBConnector := NBConnectors.GetComponenByID(IntValue); if NBConnector = nil then begin NBConnector := TSCSComponent.Create(FNormBase); NBConnector.LoadComponentByID(IntValue); SetComponAsLite(NBConnector); NBConnectors.Add(NBConnector); end; TubeJoinKindFromConnector := -1; TubeJoinKindStr := NBConnector.GetPropertyValueBySysName(pnTubeJoinKind); if TubeJoinKindStr <> '' then begin try TubeJoinKindFromConnector := StrToInt(TubeJoinKindStr); except end; if TubeJoinKindFromConnector <> -1 then if ConnectorsTubeConnectionKinds.IndexOf(TubeJoinKindFromConnector) = -1 then ConnectorsTubeConnectionKinds.Add(TubeJoinKindFromConnector); end; end; if ConnectorsTubeConnectionKinds.Count > 1 then begin // если вид соединения всех коннекторов не совпадает с видом соединения трубы if TubeJoinKindFromTube <> -1 then begin IndexOfTubeJoinKind := ConnectorsTubeConnectionKinds.IndexOf(TubeJoinKindFromTube); if IndexOfTubeJoinKind <> -1 then TubeJoinKindToUse := ConnectorsTubeConnectionKinds[IndexOfTubeJoinKind]; end; // Смотрим вид соединения в запоменных для применения для всех if TubeJoinKindToUse = -1 then for i := 0 to ConnectorsTubeConnectionKinds.Count - 1 do if TubeConnectionkindForAll.IndexOf(ConnectorsTubeConnectionKinds[i]) <> -1 then begin TubeJoinKindToUse := ConnectorsTubeConnectionKinds[i]; Break; //// BREAK //// end; // Спрашиваем у юзверя if TubeJoinKindToUse = -1 then begin TubeJoinKinds := TStringList.Create; //TubeJoinKinds.AddObject(tcknHubOfPipe, TObject(tckHubOfPipe)); //TubeJoinKinds.AddObject(tcknCapillarySoldering, TObject(tckCapillarySoldering)); //TubeJoinKinds.AddObject(tcknMechanicalCompressive, TObject(tckMechanicalCompressive)); //TubeJoinKinds.AddObject(tcknMechanicalPress, TObject(tckMechanicalPress)); //TubeJoinKinds.AddObject(tcknMechanicalTread, TObject(tckMechanicalTread)); //TubeJoinKinds.AddObject(tcknPress, TObject(tckPress)); //TubeJoinKinds.AddObject(tcknWeldingConnection, TObject(tckWeldingConnection)); //TubeJoinKinds.AddObject(tcknWeldingButt, TObject(tckWeldingButt)); //TubeJoinKinds.AddObject(tcknWeldHubOfPipe, TObject(tckWeldHubOfPipe)); //TubeJoinKinds.AddObject(tcknWeldElectric, TObject(tckWeldElectric)); for i := tckFirst to tckLast do if ConnectorsTubeConnectionKinds.IndexOf(i) <> -1 then begin TubeJoinKindName := GetTubeConnectKindName(i); if TubeJoinKindName <> '' then TubeJoinKinds.AddObject(TubeJoinKindName, TObject(i)); end; SelectedTubeJoinKind.FObject := nil; PauseProgress(true); try ShowConnectorObjectInCAD(ASCSObject); IsApplyTubeJoinKindForAll := false; SelectedTubeJoinKind := InputFormCombo(Self, cMain_Msg176_1, cMain_Msg176_2 +' '+ ASCSObject.GetNameForVisible, '', cMain_Msg176_3, TubeJoinKinds, @IsApplyTubeJoinKindForAll); finally PauseProgress(false); end; if SelectedTubeJoinKind.FObject <> nil then begin TubeJoinKindToUse := Integer(SelectedTubeJoinKind.FObject); if IsApplyTubeJoinKindForAll then TubeConnectionkindForAll.Add(TubeJoinKindToUse); end; FreeAndNil(TubeJoinKinds); end; // Если ничего не выбрано, то чистим Result if TubeJoinKindToUse = -1 then begin Result.Clear; if AConnectorOwners <> nil then AConnectorOwners.Clear; end else // Иначе оставляем только те ЭКК, в которых значение свойства "Вид подключения" = TubeJoinKindToUse begin i := Result.Count - 1; while i >= 0 do begin TubeJoinKindFromConnector := -1; NBConnector := NBConnectors.GetComponenByID(Result[i]); if NBConnector <> nil then begin TubeJoinKindStr := NBConnector.GetPropertyValueBySysName(pnTubeJoinKind); if TubeJoinKindStr <> '' then try TubeJoinKindFromConnector := StrToInt(TubeJoinKindStr); except end; if (TubeJoinKindFromConnector = -1) or (TubeJoinKindFromConnector <> TubeJoinKindToUse) then begin Result.Delete(i); if AConnectorOwners <> nil then AConnectorOwners.Delete(i); end; end; i := i - 1; end; end; end; end; FreeAndNil(ConnectorsTubeConnectionKinds); end; {$IFEND} end; function GetNBCCEThatCanConnectToCanals(ACableCanalConnectorsID: TIntList; ACableCanals: TSCSComponents; AAngleSize: Integer; ANotCheckToJoin: Boolean): TSCSComponents; var CurrNBIDConnector: Integer; NBConnector: TSCSComponent; IsFoulConnector: Boolean; LookedConnectors: TIntList; i, j: Integer; ComponAngleSizeStr: String; ComponAngleSize: Integer; FindedAngleBySize: Boolean; ComponsWithNoProperAngles: TSCSComponents; {StandartAngles: TIntList; ComponNearStandartAngle: TSCSComponent; AngleDeltaNearStandart: Integer; CurrAngleDelta: Integer; StandartAngle: Integer; CurrStandartAngle: Integer;} begin Result := TSCSComponents.Create(false); ComponsWithNoProperAngles := nil; FindedAngleBySize := false; LookedConnectors := TIntList.Create; for i := 0 to ACableCanalConnectorsID.Count - 1 do begin CurrNBIDConnector := ACableCanalConnectorsID[i]; // Подгружаем соединитель //NBConnector.LoadComponentByID(CurrNBIDConnector); NBConnector := NBConnectors.GetComponenByID(CurrNBIDConnector); if NBConnector = nil then begin NBConnector := TSCSComponent.Create(FNormBase); NBConnector.LoadComponentByID(CurrNBIDConnector); SetComponAsLite(NBConnector); NBConnectors.Add(NBConnector); end; IsFoulConnector := false; if LookedConnectors.IndexOf(CurrNBIDConnector) = -1 then begin //*** проверить может ли эл. кабельного канала соед-ся со всеми каб каналами if Not ANotCheckToJoin then if Not NBConnector.CheckJoinToListCompons(ACableCanals).CanConnect then begin IsFoulConnector := true; //Break; ///// BREAK ///// end; //*** нашелся подходящий кабельный канал if Not IsFoulConnector then begin Result.Add(NBConnector); //Result := CurrNBIDConnector; //ResNBConnectors.Add(NBConnector); //ResListOfConnectorAdapters.Add(nil); //Break; ///// BREAK ///// end; LookedConnectors.Add(CurrNBIDConnector); end; end; FreeAndNil(LookedConnectors); // фильтруем по размеру угла if AAngleSize <> -1 then begin FindedAngleBySize := false; ComponsWithNoProperAngles := nil; for i := 0 to Result.Count - 1 do begin NBConnector := Result[i]; ComponAngleSizeStr := NBConnector.GetPropertyValueBySysName(pnAngle); ComponAngleSize := -1; if ComponAngleSizeStr <> '' then try ComponAngleSize := StrToInt(ComponAngleSizeStr); except end; if ComponAngleSize <> -1 then begin if (ComponAngleSize = AAngleSize) or (Abs(ComponAngleSize - AAngleSize) <= 1) then FindedAngleBySize := true else // Запоминаем все соединители, которые не подошли по углам begin //if ComponsWithNoProperAngles = nil then // ComponsWithNoProperAngles := TSCSComponents.Create(false); //ComponsWithNoProperAngles.Add(NBConnector); Result[i] := nil; end; end; end; Result.Pack; { if ComponsWithNoProperAngles <> nil then begin // Если не найден уголок по углу трасс, то выбрать тот который максимально наближен к стандартному if Not FindedAngleBySize then begin StandartAngles := TIntList.Create; StandartAngles.Add(15); StandartAngles.Add(30); StandartAngles.Add(45); StandartAngles.Add(60); StandartAngles.Add(90); StandartAngles.Add(120); StandartAngles.Add(180); ComponNearStandartAngle := nil; AngleDeltaNearStandart := -1; StandartAngle := -1; //Выбираем, какой из стандартных углов ближе к углу из параметра AAngleSize for i := 0 to StandartAngles.Count - 1 do begin CurrStandartAngle := StandartAngles[i]; CurrAngleDelta := Abs(CurrStandartAngle - AAngleSize); if (AngleDeltaNearStandart = -1) or (CurrAngleDelta < AngleDeltaNearStandart) then begin AngleDeltaNearStandart := CurrAngleDelta; StandartAngle := CurrStandartAngle; end; end; //Ищем компонент с углом минимально отклоненным от стандартного AngleDeltaNearStandart := -1; for i := 0 to ComponsWithNoProperAngles.Count - 1 do begin NBConnector := ComponsWithNoProperAngles[i]; ComponAngleSize := NBConnector.GetPropertyValueAsInteger(pnAngle); CurrAngleDelta := Abs(ComponAngleSize - StandartAngle); if (AngleDeltaNearStandart = -1) or (CurrAngleDelta < AngleDeltaNearStandart) then begin AngleDeltaNearStandart := CurrAngleDelta; ComponNearStandartAngle := NBConnector; end; end; if ComponNearStandartAngle <> nil then begin Result.Add(ComponNearStandartAngle); // Смотрим, может есть еще компонент с таким минимальным отклонением от стандартного угла for i := 0 to ComponsWithNoProperAngles.Count - 1 do begin NBConnector := ComponsWithNoProperAngles[i]; if NBConnector <> ComponNearStandartAngle then begin ComponAngleSize := NBConnector.GetPropertyValueAsInteger(pnAngle); if Abs(ComponAngleSize - StandartAngle) = AngleDeltaNearStandart then Result.Add(NBConnector); end; end; end; FreeAndNil(StandartAngles); end; FreeAndNil(ComponsWithNoProperAngles); end;} end; end; function GetAdaptersForJoinCanalsWithPoint(ACableCanals: TSCSComponents; AConnectorObject: TSCSCatalog; AAdapterIDs: TIntList; ACanalsToConnectWithAdapters: TSCSComponents): TSCSComponent; var PointComponents: TSCSComponents; PointCompon: TSCSComponent; i, j, k: Integer; CableCanalAdaptersID: TIntList; NBAdaptorListToConnect: TSCSComponents; NBAdaptorListContainer: TSCSComponents; ComponsForConnectToNBConnector: TSCSComponents; ComponsForConnectToNBAdaptor: TSCSComponents; CanalsToConnectWithNBConnector: TSCSComponents; CanalsToConnectWithNBAdapters: TSCSComponents; //ResConnectorAdapters: TSCSComponents; //ResCanalsToConnectWithAdapters: TSCSComponents; //ResListOfConnectorAdapters: TObjectList; //ResListOfCanalsToConnectWithAdapters: TObjectList; Canal: TSCSComponent; CurrNBIDAdapter: Integer; SprAdapter: TSCSComponent; NBAdapter: TSCSComponent; LastAdaptorCountToConnect: Integer; begin Result := nil; AAdapterIDs.Clear; ACanalsToConnectWithAdapters.Clear; NBAdaptorListContainer := TSCSComponents.Create(true); PointComponents := TSCSComponents.Create(false); // отбираем точ-е компоненты (не ЭКК) в список if assigned(AConnectorObject.ComponentReferences) then begin for i := 0 to AConnectorObject.ComponentReferences.Count - 1 do begin PointCompon := AConnectorObject.ComponentReferences[i]; //if PointCompon.ComponentType.SysName <> ctsnCableChannelElement then PointComponents.Add(PointCompon); end; end else begin i := 0; end; // проверяем подключение без адаптеров for i := 0 to PointComponents.Count - 1 do begin PointCompon := PointComponents[i]; if PointCompon.CheckJoinToListCompons(ACableCanals).CanConnect then begin Result := PointCompon; Break; //// BREAK //// end; end; // Проверяем подключения через адаптер CableCanalAdaptersID := GetCableCanalsIDNBConnectorsByType(ACableCanals, AConnectorObject, contAdapter, nil); if CableCanalAdaptersID.Count > 0 then begin //ResListOfConnectorAdapters := TObjectList.Create(true); //ResListOfCanalsToConnectWithAdapters := TObjectList.Create(true); NBAdaptorListToConnect := TSCSComponents.Create(false); ComponsForConnectToNBConnector := TSCSComponents.Create(false); ComponsForConnectToNBAdaptor := TSCSComponents.Create(false); CanalsToConnectWithNBConnector := TSCSComponents.Create(false); CanalsToConnectWithNBAdapters := TSCSComponents.Create(false); LastAdaptorCountToConnect := 0; for i := 0 to PointComponents.Count - 1 do begin PointCompon := PointComponents[i]; NBAdaptorListToConnect.Clear; CanalsToConnectWithNBConnector.Clear; CanalsToConnectWithNBAdapters.Clear; // определить все каб каналы, которые могут подключится без адаптера, и те которые будут подкл. через адаптер // проверям могут ли одновременно подключится 1, потом, 2 и т.д. каб канала к коннектору // Если не удается подключить тек-й список каб каналов, то последний из этого списка переносим в другой список - // - каб. каналы, которые будут подключены через адаптер for j := 0 to ACableCanals.Count - 1 do begin // формируем список каб каналов для проверки их одновременного подключения к коннетору // без тех, что уже в списке для подключения через адаптеры ComponsForConnectToNBConnector.Assign(CanalsToConnectWithNBConnector); ComponsForConnectToNBConnector.Add(ACableCanals[j]); //ComponsForConnectToNBConnector.Clear; //for k := 0 to j do // if CanalsToConnectWithNBAdapters.IndexOf(ACableCanals[k]) = -1 then // ComponsForConnectToNBConnector.Add(ACableCanals[k]); if ComponsForConnectToNBConnector.Count > 0 then begin if PointCompon.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then CanalsToConnectWithNBConnector.Assign(ComponsForConnectToNBConnector) else //CanalsToConnectWithNBAdapters.Add(ComponsForConnectToNBConnector[ComponsForConnectToNBConnector.Count-1]); CanalsToConnectWithNBAdapters.Add(ACableCanals[j]); end; end; // Ищем адаптеры для подключения к каждому каналу for j := 0 to CanalsToConnectWithNBAdapters.Count - 1 do begin Canal := CanalsToConnectWithNBAdapters[j]; for k := 0 to CableCanalAdaptersID.Count - 1 do begin CurrNBIDAdapter := CableCanalAdaptersID[k]; // Подгружаем адаптер SprAdapter := NBConnectors.GetComponenByID(CurrNBIDAdapter); if SprAdapter = nil then begin SprAdapter := TSCSComponent.Create(FNormBase); SprAdapter.LoadComponentByID(CurrNBIDAdapter); SetComponAsLite(SprAdapter); NBConnectors.Add(SprAdapter); end; NBAdapter := TSCSComponent.Create(FNormBase); NBAdapter.Assign(SprAdapter, false, false, false); NBAdaptorListContainer.Add(NBAdapter); // проверить, может ли адаптер одновременно подключится к каналу и ЭКК ComponsForConnectToNBConnector.Clear; ComponsForConnectToNBConnector.Add(Canal); ComponsForConnectToNBConnector.Add(PointCompon); if NBAdapter.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then begin // Проверить - может ли ЭКК одновременно подключится к каналам (подключение к которым уже проверено) // и адаптеру ComponsForConnectToNBConnector.Assign(CanalsToConnectWithNBConnector); ComponsForConnectToNBConnector.AddItems(NBAdaptorListToConnect); ComponsForConnectToNBConnector.Add(NBAdapter); if PointCompon.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then begin NBAdaptorListToConnect.Add(NBAdapter); Break; //// BREAK //// end; end; end; // Если адаптер небыл найден (количество адаптеров меньше чем кол-во расмотренных каб. каналов) // то выходим из цылка поиска адаптера для даного ЭКК if (NBAdaptorListToConnect.Count -1) < j then Break; //// BREAK //// end; // Если найдены адаптеры для всех ЭКК, то закинуть данную позицию в результат if NBAdaptorListToConnect.Count = CanalsToConnectWithNBAdapters.Count then if NBAdaptorListToConnect.Count > 0 then begin if (LastAdaptorCountToConnect = 0) or (NBAdaptorListToConnect.Count <= LastAdaptorCountToConnect) then begin Result := PointCompon; AAdapterIDs.Clear; ACanalsToConnectWithAdapters.Clear; for j := 0 to NBAdaptorListToConnect.Count - 1 do begin AAdapterIDs.Add(NBAdaptorListToConnect[j].ID); ACanalsToConnectWithAdapters.Add(CanalsToConnectWithNBAdapters[j]); end; LastAdaptorCountToConnect := NBAdaptorListToConnect.Count; Break; //// BREAK //// // добавляем в список адаптеры, подключаемые к ЭКК {ResConnectorAdapters := TSCSComponents.Create(false); ResConnectorAdapters.Assign(NBAdaptorListToConnect); ResListOfConnectorAdapters.Add(ResConnectorAdapters); // добавляем в список какналы, подключаемые к адаптерам ResCanalsToConnectWithAdapters := TSCSComponents.Create(false); ResCanalsToConnectWithAdapters.Assign(CanalsToConnectWithNBAdapters); ResListOfCanalsToConnectWithAdapters.Add(ResCanalsToConnectWithAdapters);} end; end; end; FreeAndNil(NBAdaptorListToConnect); FreeAndNil(ComponsForConnectToNBConnector); FreeAndNil(ComponsForConnectToNBAdaptor); FreeAndNil(CanalsToConnectWithNBConnector); FreeAndNil(CanalsToConnectWithNBAdapters); //FreeAndNil(ResListOfConnectorAdapters); //FreeAndNil(ResListOfCanalsToConnectWithAdapters); end; FreeAndNil(CableCanalAdaptersID); FreeAndNil(PointComponents); FreeAndNil(NBAdaptorListContainer); end; function GetCommonIDNBConnector(ACableCanals: TSCSComponents; AConnectorObject: TSCSCatalog; AConnectorType, AAngleSize: Integer; AAdapterIDs: TIntList; ACanalsToConnectWithAdapters: TSCSComponents; ACCeToAdapterThroughFemales: PBoolean; ANotCheckToJoin: Boolean): Integer; var //CableCanalsConnectorsID: TObjectList; //*** Список объектов CableCanalConnectorsID SrcCableCanals: TSCSComponents; CableCanalConnectorsID: TIntList; AllCCEIDs: TIntList; // Все ЭКК NBCCEThatCanConnectToCanals: TSCSComponents; ConnectorOwners: TSCSComponents; CableCanalAdaptersID: TIntList; i, j, k, l: Integer; CurrNBIDConnector: Integer; CurrNBConnectorOwner: TSCSComponent; CurrNBConnectorOwnerOutDiametr: Double; CurrNBIDAdapter: Integer; //StepNBIDConnector: Integer; Finded: Boolean; MessageStr: String; ComponNames: String; CCETypeName: String; NBConnector: TSCSComponent; TmpNBConnector: TSCSComponent; TmpNBConnectorType: Integer; SprAdapter: TSCSComponent; NBAdapter: TSCSComponent; NBAdaptorListToConnect: TSCSComponents; NBAdaptorListContiner: TSCSComponents; ComponsForConnectToNBConnector: TSCSComponents; ComponsForConnectToNBAdaptor: TSCSComponents; CanalsToConnectWithNBConnector: TSCSComponents; CanalsToConnectWithNBAdapters: TSCSComponents; LastAdaptorCountToConnect: Integer; LastConnectorOwnerOutDiametr: Double; Canal: TSCSComponent; WhileIndex: Integer; ResNBConnectors: TSCSComponents; ResNBConnectorIndex: Integer; ResConnectorAdapters: TSCSComponents; ResListOfConnectorAdapters: TObjectList; ResCanalsToConnectWithAdapters: TSCSComponents; ResListOfCanalsToConnectWithAdapters: TObjectList; ResSelectedForAll: Integer; ResModalResult: Integer; MessageModalRes: integer; CanAddConnectorToRes: Boolean; //IsFoulConnector: Boolean; //LookedConnectors: TIntList; IsFindConnectorFromBiggerCanal: Boolean; IsCCEToAdapterThrowFemaleFemale: Boolean; msgCCEToAdapterThroughFemales: String; ActiveListCCESelectedForAll: TSCSComponents; ObjectToSelect: TSCSCatalog; DestObjectCaption: String; begin Result := 0; IsFindConnectorFromBiggerCanal := true; IsCCEToAdapterThrowFemaleFemale := false; msgCCEToAdapterThroughFemales := ''; if Assigned(ACableCanals) then begin ObjectToSelect := nil; DestObjectCaption := ''; if AConnectorObject <> nil then begin ObjectToSelect := AConnectorObject; DestObjectCaption := AConnectorObject.GetNameForVisible; end else if ACableCanals.Count > 0 then begin ObjectToSelect := ACableCanals[0].GetFirstParentCatalog; DestObjectCaption := ACableCanals[0].GetNameForVisible; end; SrcCableCanals := TSCSComponents.Create(false); SrcCableCanals.Assign(ACableCanals); // Если поиск тройника идет по каналу с большим диаметром, то сортируем каналы по убыванию по этому диаметру if IsFindConnectorFromBiggerCanal then SortComponentsByOutDiametr(SrcCableCanals, true); //CableCanalsConnectorsID := TObjectList.Create(true); try //*** Отобрать ID-ки элементов кк, которые подходят под AConnectorType //for i := 0 to ACableCanals.Count - 1 do //begin // CableCanalConnectorsID := ACableCanals[i].GetCableCanalIDNBConnectorByType(AConnectorType, true, FindedNBConnectorIDs); // //if CableCanalConnectorsID.Count = 0 then // // FreeAndNil(CableCanalConnectorsID); // if Assigned(CableCanalConnectorsID) then // CableCanalsConnectorsID.Add(CableCanalConnectorsID); //end; ConnectorOwners := TSCSComponents.Create(false); CableCanalConnectorsID := GetCableCanalsIDNBConnectorsByType(SrcCableCanals, ObjectToSelect, AConnectorType, ConnectorOwners); //*** Найти эл. каб-го канала, кот. могут соединится со всеми каб. каналами //NBConnector := TSCSComponent.Create(FNormBase); //LookedConnectors := TIntList.Create; ResNBConnectors := TSCSComponents.Create(false); ResListOfConnectorAdapters := TObjectList.Create(true); ResListOfCanalsToConnectWithAdapters := TObjectList.Create(true); NBAdaptorListContiner := TSCSComponents.Create(true); try {for i := 0 to CableCanalConnectorsID.Count - 1 do begin CurrNBIDConnector := CableCanalConnectorsID[i]; // Подгружаем соединитель //NBConnector.LoadComponentByID(CurrNBIDConnector); NBConnector := NBConnectors.GetComponenByID(CurrNBIDConnector); if NBConnector = nil then begin NBConnector := TSCSComponent.Create(FNormBase); NBConnector.LoadComponentByID(CurrNBIDConnector); NBConnectors.Add(NBConnector); end; IsFoulConnector := false; if LookedConnectors.IndexOf(CurrNBIDConnector) = -1 then begin //*** проверить может ли эл. кабельного канала соед-ся со всеми каб каналами if Not ANotCheckToJoin then if Not NBConnector.CheckJoinToListCompons(ACableCanals).CanConnect then begin IsFoulConnector := true; //Break; ///// BREAK ///// end; //*** нашелся подходящий кабельный канал if Not IsFoulConnector then begin Result := CurrNBIDConnector; ResNBConnectors.Add(NBConnector); ResListOfConnectorAdapters.Add(nil); //Break; ///// BREAK ///// end; LookedConnectors.Add(CurrNBIDConnector); end; end;} // получаем ЭКК, которые могут подключить каналы NBCCEThatCanConnectToCanals := GetNBCCEThatCanConnectToCanals(CableCanalConnectorsID, ACableCanals, AAngleSize, ANotCheckToJoin); for i := 0 to NBCCEThatCanConnectToCanals.Count - 1 do begin NBConnector := NBCCEThatCanConnectToCanals[i]; Result := NBConnector.ID; ResNBConnectors.Add(NBConnector); ResListOfConnectorAdapters.Add(nil); end; FreeAndNil(NBCCEThatCanConnectToCanals); // Если идет поиск тройника, и такой не найден, найти такой чтоб можно было бы подключится через адаптер if Result = 0 then if (AConnectorType = contTjoin) or (AConnectorType = contCross) then begin // найти все адаптеры с каб каналов CableCanalAdaptersID := GetCableCanalsIDNBConnectorsByType(ACableCanals, ObjectToSelect, contAdapter, nil); NBAdaptorListToConnect := TSCSComponents.Create(false); ComponsForConnectToNBConnector := TSCSComponents.Create(false); ComponsForConnectToNBAdaptor := TSCSComponents.Create(false); CanalsToConnectWithNBConnector := TSCSComponents.Create(false); CanalsToConnectWithNBAdapters := TSCSComponents.Create(false); LastAdaptorCountToConnect := 0; LastConnectorOwnerOutDiametr := 0; for WhileIndex := 1 to 2 do begin // на второй итерации цикла проверяем подключение тройника к адаптеру без учета родов интерфейсов // Перебераем эл-ты каб канала нужного типа for i := 0 to CableCanalConnectorsID.Count - 1 do begin CurrNBIDConnector := CableCanalConnectorsID[i]; CurrNBConnectorOwner := ConnectorOwners[i]; CurrNBConnectorOwnerOutDiametr := GetComponOutDiametrInMetr(CurrNBConnectorOwner); // Подгружаем соединитель //NBConnector.LoadComponentByID(CurrNBIDConnector); NBConnector := NBConnectors.GetComponenByID(CurrNBIDConnector); if NBConnector = nil then begin NBConnector := TSCSComponent.Create(FNormBase); NBConnector.LoadComponentByID(CurrNBIDConnector); SetComponAsLite(NBConnector); NBConnectors.Add(NBConnector); end; NBAdaptorListToConnect.Clear; CanalsToConnectWithNBConnector.Clear; CanalsToConnectWithNBAdapters.Clear; // определить все каб каналы, которые могут подключится без адаптера, и те которые будут подкл. через адаптер // проверям могут ли одновременно подключится 1, потом, 2 и т.д. каб канала к коннектору // Если не удается подключить тек-й список каб каналов, то последний из этого списка переносим в другой список - // - каб. каналы, которые будут подключены через адаптер for j := 0 to ACableCanals.Count - 1 do begin // формируем список каб каналов для проверки их одновременного подключения к коннетору // без тех, что уже в списке для подключения через адаптеры ComponsForConnectToNBConnector.Assign(CanalsToConnectWithNBConnector); ComponsForConnectToNBConnector.Add(ACableCanals[j]); //ComponsForConnectToNBConnector.Clear; //for k := 0 to j do // if CanalsToConnectWithNBAdapters.IndexOf(ACableCanals[k]) = -1 then // ComponsForConnectToNBConnector.Add(ACableCanals[k]); if ComponsForConnectToNBConnector.Count > 0 then begin if NBConnector.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then CanalsToConnectWithNBConnector.Assign(ComponsForConnectToNBConnector) else //CanalsToConnectWithNBAdapters.Add(ComponsForConnectToNBConnector[ComponsForConnectToNBConnector.Count-1]); CanalsToConnectWithNBAdapters.Add(ACableCanals[j]); end; end; // Ищем адаптеры для подключения к каждому каналу for j := 0 to CanalsToConnectWithNBAdapters.Count - 1 do begin Canal := CanalsToConnectWithNBAdapters[j]; for k := 0 to CableCanalAdaptersID.Count - 1 do begin CurrNBIDAdapter := CableCanalAdaptersID[k]; // Подгружаем адаптер SprAdapter := NBConnectors.GetComponenByID(CurrNBIDAdapter); if SprAdapter = nil then begin SprAdapter := TSCSComponent.Create(FNormBase); SprAdapter.LoadComponentByID(CurrNBIDAdapter); SetComponAsLite(SprAdapter); NBConnectors.Add(SprAdapter); end; NBAdapter := TSCSComponent.Create(FNormBase); NBAdapter.Assign(SprAdapter, false, false, false); NBAdaptorListContiner.Add(NBAdapter); // проверить, может ли адаптер одновременно подключится к каналу и ЭКК ComponsForConnectToNBConnector.Clear; ComponsForConnectToNBConnector.Add(Canal); ComponsForConnectToNBConnector.Add(NBConnector); if WhileIndex = 2 then GCanJoinInterfFemaleToFemale := true; try if NBAdapter.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then begin // Проверить - может ли ЭКК одновременно подключится к каналам (подключение к которым уже проверено) // и адаптеру ComponsForConnectToNBConnector.Assign(CanalsToConnectWithNBConnector); ComponsForConnectToNBConnector.AddItems(NBAdaptorListToConnect); ComponsForConnectToNBConnector.Add(NBAdapter); if NBConnector.CheckJoinToListCompons(ComponsForConnectToNBConnector).CanConnect then begin NBAdaptorListToConnect.Add(NBAdapter); Break; //// BREAK //// end; end; finally GCanJoinInterfFemaleToFemale := false; end; end; // Если адаптер небыл найден (количество адаптеров меньше чем кол-во расмотренных каб. каналов) // то выходим из цылка поиска адаптера для даного ЭКК if (NBAdaptorListToConnect.Count -1) < j then Break; //// BREAK //// end; // Если найдены адаптеры для всех ЭКК, то закинуть данную позицию в результат if NBAdaptorListToConnect.Count = CanalsToConnectWithNBAdapters.Count then if NBAdaptorListToConnect.Count > 0 then begin CanAddConnectorToRes := false; if LastAdaptorCountToConnect = 0 then CanAddConnectorToRes := true else begin // если тройники ищем из самого большого канала if IsFindConnectorFromBiggerCanal then begin if (CurrNBConnectorOwnerOutDiametr = LastConnectorOwnerOutDiametr) or ((CurrNBConnectorOwnerOutDiametr - LastConnectorOwnerOutDiametr) > 0.001) then CanAddConnectorToRes := true end else // иначе ищем по минимальному количеству адаптеров if NBAdaptorListToConnect.Count <= LastAdaptorCountToConnect then CanAddConnectorToRes := true; end; if CanAddConnectorToRes then begin Result := CurrNBIDConnector; AAdapterIDs.Clear; ACanalsToConnectWithAdapters.Clear; for j := 0 to NBAdaptorListToConnect.Count - 1 do begin AAdapterIDs.Add(NBAdaptorListToConnect[j].ID); ACanalsToConnectWithAdapters.Add(CanalsToConnectWithNBAdapters[j]); end; LastAdaptorCountToConnect := NBAdaptorListToConnect.Count; LastConnectorOwnerOutDiametr := CurrNBConnectorOwnerOutDiametr; //ResNBConnectors.Clear; //ResListOfConnectorAdapters.Clear; //ResListOfCanalsToConnectWithAdapters.Clear; // добавляем в список ЭКК ResNBConnectors.Add(NBConnector); // добавляем в список адаптеры, подключаемые к ЭКК ResConnectorAdapters := TSCSComponents.Create(false); ResConnectorAdapters.Assign(NBAdaptorListToConnect); ResListOfConnectorAdapters.Add(ResConnectorAdapters); // добавляем в список какналы, подключаемые к адаптерам ResCanalsToConnectWithAdapters := TSCSComponents.Create(false); ResCanalsToConnectWithAdapters.Assign(CanalsToConnectWithNBAdapters); ResListOfCanalsToConnectWithAdapters.Add(ResCanalsToConnectWithAdapters); end; end; end; if ResNBConnectors.Count > 0 then //if ResNBConnectors.Count > 1 then begin if WhileIndex = 2 then begin // проверяем есть ли в списке компонент, который был выбран для всех при подключ мама-мама // Если нету, то предлагаем выбрать ResNBConnectorIndex := -1; for i := 0 to ResNBConnectors.Count - 1 do if CCESelectedForAllWithFemales.IndexOf(ResNBConnectors[i]) <> -1 then begin ResNBConnectorIndex := i; Break; //// BREAK //// end; if ResNBConnectorIndex = -1 then begin // спращиваем, можно ли подкл через мама-мама if GUseVisibleInterfaces then begin PauseProgress(true); try ShowConnectorObjectInCAD(ObjectToSelect); MessageModalRes := MessageDlgLn(cMain_Msg173, ApplicationName, mtConfirmation, [mbNoToAll, mbYes, mbNo]); finally PauseProgress(false); end; case MessageModalRes of mrYes: IsCCEToAdapterThrowFemaleFemale := true; mrNoToAll: begin MessageResToJoinCCEWithAdapterThroughFemales := mrNoToAll; IsCCEToAdapterThrowFemaleFemale := false; end; end; end else IsCCEToAdapterThrowFemaleFemale := true; end else IsCCEToAdapterThrowFemaleFemale := true; if IsCCEToAdapterThrowFemaleFemale then msgCCEToAdapterThroughFemales := #10+#13+cMain_Msg175 else begin Result := 0; ResNBConnectors.Clear; ResListOfConnectorAdapters.Clear; ResListOfCanalsToConnectWithAdapters.Clear; end; end; Break; //// BREAK //// end; // если в первом цмкле найдены адаптеры if WhileIndex = 1 then if ResNBConnectors.Count > 0 then Break; //// BREAK //// if (MessageResToJoinCCEWithAdapterThroughFemales = mrNoToAll) or (ACCeToAdapterThroughFemales = nil) then Break; //// BREAK //// end; FreeAndNil(NBAdaptorListToConnect); FreeAndNil(ComponsForConnectToNBConnector); FreeAndNil(ComponsForConnectToNBAdaptor); FreeAndNil(CanalsToConnectWithNBConnector); FreeAndNil(CanalsToConnectWithNBAdapters); FreeAndNil(CableCanalAdaptersID); end; // Если есть несколько вариантов выбора, то предлагаем юзеру выбрать if (ResNBConnectors.Count > 1) or IsCCEToAdapterThrowFemaleFemale then begin ResNBConnectorIndex := -1; // Проверяем нет ли среди предлагаемых вариантов, того что юзер выбрал для всех ActiveListCCESelectedForAll := nil; if Not IsCCEToAdapterThrowFemaleFemale then ActiveListCCESelectedForAll := CCESelectedForAll else ActiveListCCESelectedForAll := CCESelectedForAllWithFemales; for i := 0 to ResNBConnectors.Count - 1 do begin NBConnector := ResNBConnectors[i]; if ActiveListCCESelectedForAll.IndexOf(NBConnector) <> -1 then begin ResNBConnectorIndex := i; Break; //// BREAK //// end; end; // для лайт версии не спрашивать, на счет подключения мама-мама if Not GUseVisibleInterfaces then if IsCCEToAdapterThrowFemaleFemale then if ResNBConnectors.Count > 0 then ResNBConnectorIndex := 0; // Попросить юзера выбрать из списка if ResNBConnectorIndex = -1 then begin PauseProgress(true); try // подсветить коннектор ResModalResult := mrNone; {if AConnectorObject <> nil then begin ShowObjectInPM(AConnectorObject.SCSID, ''); SelectConnectedConnector(AConnectorObject.ListID, AConnectorObject.SCSID); NBConnector := FNormBase.SelectComponentFromList(ResNBConnectors, cMain_Msg162, cMain_Msg163_1+' '+AConnectorObject.GetNameForVisible, cMain_Msg164, [mbCancel, mbIgnore], @ResModalResult, @ResSelectedForAll); end else begin ShowObjectInPM(ACableCanals[0].GetFirstParentCatalog.SCSID, ''); SelectObjectInCAD(ACableCanals[0].ListID, ACableCanals[0].GetFirstParentCatalog.SCSID, ''); NBConnector := FNormBase.SelectComponentFromList(ResNBConnectors, cMain_Msg162, cMain_Msg163_1+' '+ACableCanals[0].GetNameForVisible, cMain_Msg164, [mbCancel, mbIgnore], @ResModalResult, @ResSelectedForAll); end;} //ShowObjectInPM(ObjectToSelect.SCSID, ''); //SelectObjectInCAD(ObjectToSelect.ListID, ObjectToSelect.SCSID, ''); ShowConnectorObjectInCAD(ObjectToSelect); NBConnector := FNormBase.SelectComponentFromList(ResNBConnectors, pnCableCanalElemetType, cMain_Msg162, cMain_Msg163_1+' '+DestObjectCaption + msgCCEToAdapterThroughFemales, cMain_Msg164, ctalCheckBox, [ibCancel, ibSkip], @ResModalResult, @ResSelectedForAll); finally PauseProgress(false); end; if NBConnector <> nil then begin ResNBConnectorIndex := ResNBConnectors.IndexOf(NBConnector); if ResSelectedForAll = biTrue then ActiveListCCESelectedForAll.Add(NBConnector); end else if ResModalResult = mrCancel then IsAborted := true; end; if ResNBConnectorIndex <> -1 then begin Result := ResNBConnectors[ResNBConnectorIndex].ID; ResConnectorAdapters := TSCSComponents(ResListOfConnectorAdapters[ResNBConnectorIndex]); ResCanalsToConnectWithAdapters := nil; if ResListOfCanalsToConnectWithAdapters.Count = ResListOfConnectorAdapters.Count then ResCanalsToConnectWithAdapters := TSCSComponents(ResListOfCanalsToConnectWithAdapters[ResNBConnectorIndex]); if ResConnectorAdapters <> nil then begin AAdapterIDs.Clear; if ResCanalsToConnectWithAdapters <> nil then ACanalsToConnectWithAdapters.Clear; for i := 0 to ResConnectorAdapters.Count - 1 do begin AAdapterIDs.Add(ResConnectorAdapters[i].ID); if ResCanalsToConnectWithAdapters <> nil then ACanalsToConnectWithAdapters.Add(ResCanalsToConnectWithAdapters[i]); end; end; end else begin Result := 0; if AAdapterIDs <> nil then AAdapterIDs.Clear; end; if ACCeToAdapterThroughFemales <> nil then ACCeToAdapterThroughFemales^ := IsCCEToAdapterThrowFemaleFemale; end else // Если нихрена не найдено, то ищем ЭКК всех типов, которые могут подключиться if ResNBConnectors.Count = 0 then if IsAskCCEOtherType or (CCEOtherTypeSelectedForAll.Count > 0) then begin AllCCEIDs := GetCableCanalsIDNBConnectorsByType(SrcCableCanals, ObjectToSelect, contAll, nil); // Исключаем из списка те, которые были рассмотрены выше, и которые не подошли if (CableCanalConnectorsID.Count > 0) and (AllCCEIDs.Count > 0) then for i := 0 to CableCanalConnectorsID.Count - 1 do AllCCEIDs.Remove(CableCanalConnectorsID[i]); // получаем ЭКК, которые могут подключить каналы NBCCEThatCanConnectToCanals := GetNBCCEThatCanConnectToCanals(AllCCEIDs, ACableCanals, AAngleSize, ANotCheckToJoin); if NBCCEThatCanConnectToCanals.Count > 0 then begin // ищем среди тех, которые отмечены как Применять выбранный в подобных случаях NBConnector := nil; if CCEOtherTypeSelectedForAll.Count > 0 then for i := 0 to NBCCEThatCanConnectToCanals.Count - 1 do begin ResNBConnectorIndex := CCEOtherTypeSelectedForAll.IndexOf(NBCCEThatCanConnectToCanals[i]); if ResNBConnectorIndex <> -1 then begin NBConnector := CCEOtherTypeSelectedForAll[ResNBConnectorIndex]; Break; //// BREAK //// end; end; if NBConnector = nil then if IsAskCCEOtherType then if NBCCEThatCanConnectToCanals.Count > 0 then begin PauseProgress(true); try ResModalResult := mrNone; {// К Имени компоненты добавим тип ЭКК for i := 0 to NBCCEThatCanConnectToCanals.Count - 1 do begin TmpNBConnector := NBCCEThatCanConnectToCanals[i]; TmpNBConnectorType := TmpNBConnector.GetPropertyValueAsInteger(pnCableCanalElemetType); if TmpNBConnectorType <> contNone then TmpNBConnector.Name := TmpNBConnector.Name +' ('+GetCableChannelElementName(TmpNBConnectorType)+')'; end;} // подсветить объект в МП и на КАДе //ShowObjectInPM(ObjectToSelect.SCSID, ''); //SelectObjectInCAD(ObjectToSelect.ListID, ObjectToSelect.SCSID, ''); ShowConnectorObjectInCAD(ObjectToSelect); NBConnector := FNormBase.SelectComponentFromList(NBCCEThatCanConnectToCanals, pnCableCanalElemetType, cMain_Msg162, cMain_Msg172_3+' "'+GetCableChannelElementName(AConnectorType)+'"'+#10#13+cMain_Msg172_4+' '+DestObjectCaption, cMain_Msg172_1, ctalCheckBox, [ibCancel, ibSkip, ibSkipAll], @ResModalResult, @ResSelectedForAll); if NBConnector <> nil then begin // Прверяем флаг "Применять выбранный в подобных случаях и не спрашивать в дальнейшем" if ResSelectedForAll = biTrue then CCEOtherTypeSelectedForAll.Add(NBConnector); end else // Кнопка пропустить все if ResModalResult = mrSkipAll then IsAskCCEOtherType := false else // Кнопка прервать if ResModalResult = mrCancel then IsAborted := true; finally PauseProgress(false); end; end; if NBConnector <> nil then begin Result := NBConnector.ID; ResNBConnectors.Add(NBConnector); ResListOfConnectorAdapters.Add(nil); end; end; FreeAndNil(NBCCEThatCanConnectToCanals); FreeAndNil(AllCCEIDs); end; finally //NBConnector.Free; //LookedConnectors.Free; FreeAndNil(NBAdaptorListContiner); FreeAndNil(ResNBConnectors); FreeAndNil(ResListOfCanalsToConnectWithAdapters); ResListOfConnectorAdapters.OwnsObjects := true; FreeAndNil(ResListOfConnectorAdapters); end; //if Result = 0 then // for i := 0 to CableCanalsConnectorsID.Count - 1 do // for j := 0 to TIntList(CableCanalsConnectorsID[i]).Count - 1 do // begin // CurrNBIDConnector := TIntList(CableCanalsConnectorsID[i])[j]; // Finded := true; // for k := i to CableCanalsConnectorsID.Count - 1 do // if TIntList(CableCanalsConnectorsID[k]).Count > 0 then // for l := 0 to TIntList(CableCanalsConnectorsID[k]).Count - 1 do // begin // StepNBIDConnector := TIntList(CableCanalsConnectorsID[k])[l]; // if CurrNBIDConnector <> StepNBIDConnector then // Finded := false; // end // else // Finded := false; // // if Finded then // begin // Result := CurrNBIDConnector; // Exit; //// EXIT //// // end; // end; finally //for i := 0 to CableCanalsConnectorsID.Count - 1 do // for j := 0 to TList(CableCanalsConnectorsID[i]).Count - 1 do // ClearList(TList(CableCanalsConnectorsID[i])); FreeAndNil(SrcCableCanals); FreeAndNil(CableCanalConnectorsID); FreeAndNil(ConnectorOwners); if Result < 1 then begin MessageStr := ''; ComponNames := ''; for i := 0 to ACableCanals.Count - 1 do begin ComponNames := ComponNames + ' "'+GetComponNameForVisible(ACableCanals[i].Name, ACableCanals[i].NameMark)+'"'; if i < ACableCanals.Count - 1 then ComponNames := ComponNames + ','; end; if ComponNames <> '' then begin if ACableCanals.Count = 1 then MessageStr := cMain_Msg47_1_1; if ACableCanals.Count > 1 then MessageStr := cMain_Msg47_1_2; MessageStr := MessageStr + ' '+ComponNames+' '; CCETypeName := ''; case ACableCanals.Count of 1: CCETypeName := cMain_Msg47_2; 2: case AConnectorType of contAnglePlane: CCETypeName := cMain_Msg47_3_1; contAngleIn: CCETypeName := cMain_Msg47_3_2; contAngleOut: CCETypeName := cMain_Msg47_3_3; contAdapter: CCETypeName := cMain_Msg47_3_4; contConnector: CCETypeName := cMain_Msg47_3_5; end; 3: CCETypeName := cMain_Msg47_4; 4: CCETypeName := cMain_Msg47_4_2; end; if CCETypeName <> '' then begin MessageStr := MessageStr + CCETypeName; Log.Add(' - '+MessageStr); end; //ShowMessageByType(0, smtProtocol, MessageStr, '', 0); end; end; end; end; end; //*** Опрелделяет какой элемент каб. канала больше подходит - адаптер, или соединитель function DefineAdapterOrConnector(ACanalsToJoin: TSCSComponents): Integer; var Canal1: TSCSComponent; Canal2: TSCSComponent; Volume1: Double; Volume2: Double; begin Result := contNone; if ACanalsToJoin.Count = 2 then begin Canal1 := ACanalsToJoin[0]; Canal2 := ACanalsToJoin[1]; Volume1 := Canal1.GetVolume(gtMale); Volume2 := Canal2.GetVolume(gtMale); if (Volume1 <= 0) and (Volume2 <= 0) then begin Volume1 := Canal1.GetVolume(gtFemale); Volume2 := Canal2.GetVolume(gtFemale); end; //*** Если сечения одинаковы, то кидать надо соединитель, иначе адаптор if Abs(Volume1 - Volume2) < cnstCmpDelta then Result := contConnector else Result := contAdapter; end; end; function JoinCCEWithCanals(APointObject: TSCSCatalog; ACCECompon: TSCSComponent; ACanals, ACanalsToConnectWithAdapters: TSCSComponents; AAdapterIDs: TintList; ACanDelPointCompon, AIsCCEToAdapterThroughFemales: Boolean): Boolean; var i: Integer; CanalComponent: TSCSComponent; CanalComponentObject: TSCSCatalog; CurrLineSide, ConnectorSide: Integer; Adapters: TSCSComponents; IsSuccessConnectedThroughAdapter: Boolean; IDNewAdapter: Integer; NewAdapter: TSCSComponent; ResJoinCCEToAdapter: TConnectInterfRes; CaptCheckParams: string; begin Result := false; if Assigned(ACCECompon) then begin CaptCheckParams := cMain_Msg49_3; if Not GUseVisibleInterfaces then CaptCheckParams := cMain_Msg49_3_1; // Подключаем каналы к ЭКК for i := 0 to ACanals.Count - 1 do begin CanalComponent := ACanals[i]; if ACanalsToConnectWithAdapters.IndexOf(CanalComponent) = -1 then begin CanalComponentObject := CanalComponent.GetFirstParentCatalog; CurrLineSide := -1; ConnectorSide := -1; if Assigned(CanalComponentObject) then begin GetSidesByConnectedFigures(CanalComponentObject.ListID, APointObject.ListID, CanalComponentObject.SCSID, APointObject.SCSID, CurrLineSide, ConnectorSide); end; if (ACCECompon.JoinedComponents.IndexOf(CanalComponent) <> -1) or (ACCECompon.JoinTo(CanalComponent, ConnectorSide, CurrLineSide).CanConnect) then begin Result := true; Log.Insert(0, ' - '+cMain_Msg48_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg48_2+' "'+ACCECompon.GetNameForVisible+'";'); end else begin Result := false; Log.Add(' - '+cMain_Msg49_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg49_2+' "'+ACCECompon.Name+'". '+ CaptCheckParams); if ACanDelPointCompon then begin DelCompon(ACCECompon, ACCECompon.TreeViewNode, true, true, true, false); ACCECompon := nil; Break; //// BREAK //// end; end; //CanAddCork := true; end; end; // Подключаем Каналы к ЭКК через адаптеры //27.08.2008 if ACCECompon <> nil then if AAdapterIDs.Count = ACanalsToConnectWithAdapters.Count then begin Adapters := TSCSComponents.Create(false); IsSuccessConnectedThroughAdapter := false; for i := 0 to ACanalsToConnectWithAdapters.Count - 1 do begin IsSuccessConnectedThroughAdapter := false; CanalComponent := ACanalsToConnectWithAdapters[i]; // Копируем Адаптер в точ-й объект IDNewAdapter := CopyComponentFromNbToPm(F_NormBase, Self, nil, APointObject.TreeViewNode, AAdapterIDs[i], ckCompon, false); NewAdapter := GSCSBase.CurrProject.GetComponentFromReferences(IDNewAdapter); if NewAdapter <> nil then begin SetComponAndChildsFieldComeFrom(NewAdapter, cftAuto); Adapters.Add(NewAdapter); // Подключаем адаптер к ЭКК GCanJoinInterfFemaleToFemale := AIsCCEToAdapterThroughFemales; try ResJoinCCEToAdapter := NewAdapter.JoinTo(ACCECompon, 0, 0); finally GCanJoinInterfFemaleToFemale := false; end; if ResJoinCCEToAdapter.CanConnect then // Подключаем адаптер к каналу if F_ChoiceConnectSide.JoinWithDefineSides(NewAdapter, CanalComponent, false).CanConnect then IsSuccessConnectedThroughAdapter := true; end; if Not IsSuccessConnectedThroughAdapter then Break; //// BREAK //// end; // Формируем Лог подключенных адаптеров if Adapters.Count = ACanalsToConnectWithAdapters.Count then begin Result := true; for i := 0 to Adapters.Count - 1 do begin NewAdapter := Adapters[i]; CanalComponent := ACanalsToConnectWithAdapters[i]; Log.Add(' - "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg48_2+' "'+ACCECompon.GetNameForVisible+'" '+ cMain_Msg48_3+' "'+NewAdapter.GetNameForVisible+'";') end; end else // Если подключены не все каналы к ЭКК через адаптер, то удаляем проставленные адаптеры вместе с ЭКК if Adapters.Count < ACanalsToConnectWithAdapters.Count then begin Result := false; // Формируем Лог не подключенных адаптеров for i := Adapters.Count to ACanalsToConnectWithAdapters.Count - 1 do begin CanalComponent := ACanalsToConnectWithAdapters[i]; Log.Add(' - '+cMain_Msg49_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg49_2+' "'+ACCECompon.Name+'" '+ cMain_Msg48_3+' '+ctnADapter+' .'+CaptCheckParams); end; // Удаляем for i := 0 to Adapters.Count - 1 do begin NewAdapter := Adapters[i]; DelCompon(NewAdapter, NewAdapter.TreeViewNode, true, true, true, false); end; if ACanDelPointCompon then DelCompon(ACCECompon, ACCECompon.TreeViewNode, true, true, true, false); end; FreeAndNil(Adapters); end; end; end; procedure SetConnectors(AConnectorWithLines: PConnectorWithLines); var i, j, k, l: Integer; FreeCanalsInTraces: TSCSObjectList; CanalCompons: TSCSComponents; CanalsToRemoveFromList: TSCSComponents; CurrCanalCompons: TSCSComponents; CanalComponsI: TSCSComponents; CanalComponsJ: TSCSComponents; CanalsToJoin: TSCSComponents; CableCanalI: TSCSComponent; CableCanalJ: TSCSComponent; ConnectorComponent: TSCSComponent; JoinedCountToConnector: Integer; JoinedComponent: TSCSComponent; LineObject: TSCSCatalog; CanalComponent: TSCSComponent; CanalComponentObject: TSCSCatalog; CanAddCork: Boolean; CurrLineSide: Integer; ConnectorSide: Integer; //IDDefCorkCompon: Integer; IDNewComponent: Integer; NewComponent: TSCSComponent; IDNewAdapter: Integer; NewAdapter: TSCSComponent; PointComponent: TSCSComponent; //CollectCompons: TSCSComponents; ConnectorTypeToSet: Integer; ConnectorAngleSize: Integer; IDNBConnector: Integer; AdapterIDs: TIntList; Adapters: TSCSComponents; CanalsToConnectWithAdapters: TSCSComponents; //ListOfListCanalsToJoinWithPoint: TObjectList; IsSuccessConnectedThroughAdapter: Boolean; IsCCEToAdapterThroughFemales: Boolean; ResJoinCCEToAdapter: TConnectInterfRes; IsConnectedCanals: Boolean; CornerType: TCornerType; ConnectorListOwner: TSCSList; CCEToDel: TSCSComponents; CCESideCount: Integer; //Tolik NBComponent: TSCSComponent; DropFigure: TFigure; StateType: TCompStateType; currConnector: TConnectorObject; SavedNBComponentID: Integer; //SavedNBComponent: TSCSComponent; // SavedGConnecntOnlyOneLineCompon: boolean; ComponSName, ElementSName: string; begin if aInstallTubesElements then begin ComponSName := ctsnTube; ElementSName := ctsnTubeElement; end else begin ComponSName := ctsnCableChannel; ElementSName := ctsnCableChannelElement; end; try SavedGConnecntOnlyOneLineCompon := GConnecntOnlyOneLineCompon; GConnecntOnlyOneLineCompon := True; if AConnectorWithLines <> nil then begin ConnectorListOwner := AConnectorWithLines.ConnectorObject.GetListOwner; //*** Удалить Левые заглушки тройники CCEToDel := TSCSComponents.Create(false); {for i := 0 to AConnectorWithLines.ConnectorObject.ComponentReferences.Count - 1 do begin ConnectorComponent := AConnectorWithLines.ConnectorObject.ComponentReferences[i]; if Assigned(ConnectorComponent) then if ConnectorComponent.ComponentType.SysName = ctsnCableChannelElement then begin CCESideCount := GetCCESideCount(ConnectorComponent); if (ConnectorComponent.JoinedComponents.Count <> AConnectorWithLines.ConnectedLines.Count) or (ConnectorComponent.JoinedComponents.Count <> CCESideCount) or (AConnectorWithLines.ConnectedLines.Count <> CCESideCount) then begin // Если это не дополнительный экк JoinedComponent := GetJoinedComponWithType(ConnectorComponent, ctsnCableChannelElement); if (JoinedComponent = nil) or (CCESideCount > GetCCESideCount(JoinedComponent)) then CCEToDel.Add(ConnectorComponent); //DelCompon(ConnectorComponent, nil, true, true, true, false); end; end; end;} for i := 0 to AConnectorWithLines.ConnectorObject.SCSComponents.Count - 1 do begin ConnectorComponent := AConnectorWithLines.ConnectorObject.SCSComponents[i]; if ConnectorComponent.ComeFrom = cftAuto then //Tolik 07/03/2025 -- //if ConnectorComponent.ComponentType.SysName = ctsnCableChannelElement then if ConnectorComponent.ComponentType.SysName = ElementSName then // begin CCESideCount := GetCCESideCount(ConnectorComponent); JoinedCountToConnector := GetJoinedCountToComponWithChilds(ConnectorComponent); if (JoinedCountToConnector <> AConnectorWithLines.ConnectedLines.Count) or (JoinedCountToConnector <> CCESideCount) or (AConnectorWithLines.ConnectedLines.Count <> CCESideCount) then begin // Если это не дополнительный экк //Tolik 07/03/2025 -- //JoinedComponent := GetJoinedComponWithType(ConnectorComponent, ctsnCableChannelElement); JoinedComponent := GetJoinedComponWithType(ConnectorComponent, ElementSName); // if (JoinedComponent = nil) or (CCESideCount > GetCCESideCount(JoinedComponent)) then CCEToDel.Add(ConnectorComponent); //DelCompon(ConnectorComponent, nil, true, true, true, false); end; end; end; // Удаляем ЭКК while CCEToDel.Count > 0 do begin ConnectorComponent := CCEToDel[0]; CCEToDel.Delete(0); // Удаляем подключенные ЭКК к ЭКК i := 0; while i <= ConnectorComponent.JoinedComponents.Count - 1 do begin JoinedComponent := ConnectorComponent.JoinedComponents[i]; //Tolik 07/03/2025 -- //if JoinedComponent.ComponentType.SysName = ctsnCableChannelElement then if JoinedComponent.ComponentType.SysName = ElementSName then // begin CCEToDel.Remove(JoinedComponent); DelCompon(JoinedComponent, nil, true, true, true, false) end else i := i + 1; end; DelCompon(ConnectorComponent, nil, true, true, true, false); end; FreeAndNil(CCEToDel); //*** С каждой трассы, подсоединенной к точ. объекту выбрать не подсоед. каб.кан. FreeCanalsInTraces := TSCSObjectList.Create(true); CanalsToJoin := TSCSComponents.Create(false); CanalsToRemoveFromList := TSCSComponents.Create(false); AdapterIDs := TintList.Create; CanalsToConnectWithAdapters := TSCSComponents.Create(false); try for i := 0 to AConnectorWithLines.ConnectedLines.Count - 1 do begin LineObject := AConnectorWithLines.ConnectedLines[i]; if Assigned(LineObject) then begin CurrLineSide := -1; ConnectorSide := -1; GetSidesByConnectedFigures(LineObject.ListID, AConnectorWithLines.ConnectorObject.ListID, LineObject.SCSID, AConnectorWithLines.ConnectorObject.SCSID, CurrLineSide, ConnectorSide); CurrCanalCompons := nil; CanalComponent := nil; if assigned(LineObject.ComponentReferences) then for j := 0 to LineObject.ComponentReferences.Count - 1 do if Assigned(LineObject.ComponentReferences[j]) then //Tolik 07/03/2025 -- ComponSName //if LineObject.ComponentReferences[j].ComponentType.SysName = ctsnCableChannel then if LineObject.ComponentReferences[j].ComponentType.SysName = ComponSName then // if LineObject.ComponentReferences[j].GetInterfcesCountByTypeIsBusySide(itFunctional, biTrue, CurrLineSide) = 0 then begin CanalComponent := LineObject.ComponentReferences[j]; if CurrCanalCompons = nil then begin CurrCanalCompons := TSCSComponents.Create(false); CurrCanalCompons.Add(CanalComponent); // Tolik 13/11/2015 //end; end else CurrCanalCompons.Add(CanalComponent); // end; if Assigned(CurrCanalCompons) then FreeCanalsInTraces.Add(CurrCanalCompons); end; end; CanAddCork := true; while CanAddCork do begin CanAddCork := false; //*** Выбрать по первому попавшему каб. каналу CanalsToJoin.Clear; for i := 0 to FreeCanalsInTraces.Count - 1 do begin CanalComponsI := TSCSComponents(FreeCanalsInTraces[i]); //*** Убрать из списка Удаленных j := 0; while j <= CanalComponsI.Count - 1 do begin if CanalsToRemoveFromList.IndexOf(CanalComponsI[j]) <> -1 then CanalComponsI.Delete(j) else Inc(j); end; if CanalComponsI.Count > 0 then begin CanalsToJoin.Add(CanalComponsI[0]); CanAddCork := true; end; end; //Tolik SavedNBComponentID := FNormBase.GSCSBase.SCSComponent.ID; // //*** Ложить можно только тройники уголки и затычки if (CanalsToJoin.Count = 1) or (CanalsToJoin.Count = 2) or (CanalsToJoin.Count = 3) or (CanalsToJoin.Count = 4) then begin ConnectorTypeToSet := 0; ConnectorAngleSize := -1; case CanalsToJoin.Count of 1: // Заглушка - по опции может не лежать между трассами if (AConnectorWithLines.TraceSCSIDList.Count = 1) or ((ConnectorListOwner <> nil) and (ConnectorListOwner.Setting.CanSetCorkBetweenTraces)) then ConnectorTypeToSet := contCork; 2: // Уголок begin CornerType := GetCornerTypeByConnectorID(AConnectorWithLines.ConnectorObject.ListID, AConnectorWithLines.ConnectorObject.SCSID); case CornerType of crn_Out, crn_In: begin case CornerType of crn_Out: ConnectorTypeToSet := contAngleOut; crn_In: ConnectorTypeToSet := contAngleIn; end; ConnectorAngleSize := Trunc(GetAngleBetweenLines(AConnectorWithLines.ConnectorObject.ListID, CanalsToJoin[0].GetFirstParentCatalog.SCSID, CanalsToJoin[1].GetFirstParentCatalog.SCSID, AConnectorWithLines.ConnectorObject.SCSID, at_Horizontal)); //Tolik 17/11/2021 -- // Для трасс, угол между которыми не сильно отличается, т.е. фактически они находятся на одной прямой - // установим небольшой люфт и сбросим установку уголка на адаптер (типа для прямого соединения), // чтобы не установило уголок, если нет видимого поворота или хотя бы искривления трасс, а то зачастую на "ровном" // участке трасс ставится уголок (поворотный), что не есть гут, // потому как тут угол вроде бы должен учитываться, при выборе уголка из НБ, но как-то... не срослось. if ConnectorAngleSize < 186 then begin if ConnectorAngleSize > 174 then begin ConnectorTypeToSet := contConnector; CornerType := crn_None; end; end; // end; crn_Vertical: begin ConnectorTypeToSet := contAnglePlane; ConnectorAngleSize := Trunc(GetAngleBetweenLines(AConnectorWithLines.ConnectorObject.ListID, CanalsToJoin[0].GetFirstParentCatalog.SCSID, CanalsToJoin[1].GetFirstParentCatalog.SCSID, AConnectorWithLines.ConnectorObject.SCSID, at_Vertical)); end; crn_Adapter, crn_None: ConnectorTypeToSet := DefineAdapterOrConnector(CanalsToJoin); end; end; 3: // тройник ConnectorTypeToSet := contTjoin; 4: //Крестовина ConnectorTypeToSet := contCross; end; if ConnectorTypeToSet > 0 then begin CanAddCork := true; //04.11.2008 IsConnectedCanals := false; // Подключить Каналы к точ. компоненту (возможно через адаптеры) PointComponent := GetAdaptersForJoinCanalsWithPoint(CanalsToJoin, AConnectorWithLines.ConnectorObject, AdapterIDs, CanalsToConnectWithAdapters); if PointComponent <> nil then begin IsConnectedCanals := JoinCCEWithCanals(AConnectorWithLines.ConnectorObject, PointComponent, CanalsToJoin, CanalsToConnectWithAdapters, AdapterIDs, false, false); end; if Not IsConnectedCanals then begin // 03/07/2007 -- Tolik IDNewComponent := 0; // NewComponent := nil; AdapterIDs.Clear; CanalsToConnectWithAdapters.Clear; IsCCEToAdapterThroughFemales := false; IDNBConnector := GetCommonIDNBConnector(CanalsToJoin, AConnectorWithLines.ConnectorObject, ConnectorTypeToSet, ConnectorAngleSize, AdapterIDs, CanalsToConnectWithAdapters, @IsCCEToAdapterThroughFemales, false); if IDNBConnector > 0 then begin if AConnectorWithLines.ConnectorObject.TreeViewNode = nil then FindComponOrDirInTree(AConnectorWithLines.ConnectorObject.ID, false); currConnector := TConnectorObject(GetFigureByID(GCadForm, AConnectorWithLines.ConnectorObject.SCSID)); // пока не понятно зачем, но было переписано в 2.4.0 что всегда вместо использования // CopyComponentFromNbToPm началось юзаться DropFigure := GetComponentFromNormBase // и получался бажик: // баг - не ставит заглушки на трассы если на конце есть ТО // потому что в GetComponentFromNormBase есть проверка - // if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_Clear) then // Result := nil; // потому сбросим на время тип коннектора... НО только через FConnectorType // НО даже если сбрасывали - затем получали ГЛЮК - комонент вместо того чтобы ложится в уже имеющийся // ТО, ложился на Джоинид-коннектор трассы - а ТАК нельзя - потому что потом баги полезут если К ТО приджоинить ТО!!! // потому сделаем так - если ТО - то по старому сделаем, если же пустой коннектор - то заюзаем новый код if currConnector <> nil then begin if (TConnectorObject(currConnector).ConnectorType <> ct_Clear) then begin IDNewComponent := CopyComponentFromNbToPm(F_NormBase, Self, nil, AConnectorWithLines.ConnectorObject.TreeViewNode, IDNBConnector, ckCompon, false); //Inc(SetConnectorCount); //IDNewComponent := CopyComponentToSCSObject(AConnectorWithLines.ConnectorObject.SCSID, IDDefCorkCompon); if IDNewComponent > 0 then if CanalsToConnectWithAdapters.Count = AdapterIDs.Count then //27.08.2008 begin NewComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDNewComponent); if NewComponent <> nil then SetComponAndChildsFieldComeFrom(NewComponent, cftAuto); end; end else begin (* // -- Tolik TF_Main(FNormBase).SelectComponInPCObjects(IDNBConnector); NBComponent := FNormBase.GSCSBase.SCSComponent; *) NBComponent := TSCSComponent.Create(Self); NBComponent.ActiveForm := TF_Main(FNormBase); NBComponent.LoadComponentByID(IDNBConnector, true, true, false); NBComponent.LoadChildComplects(true, true, true); NBComponent.ActiveForm := TF_Main(FNormBase); StateType := stProjectible; GListNode := Nil; if NBComponent <> nil then begin // баг - не ставит заглушки на трассы если на конце есть ТО // потому что в GetComponentFromNormBase есть проверка - // if CheckFigureByClassName(ASnapFigure, cTConnectorObject) and (TConnectorObject(ASnapFigure).ConnectorType <> ct_Clear) then // Result := nil; // потому сбросим на время тип коннектора... НО только через FConnectorType ////aSaveCT := TConnectorObject(currConnector).ConnectorType; ////TConnectorObject(currConnector).FConnectorType := ct_Clear; //// так как если мы получим таки DropFigure - далее CopyComponentToPrjManager и //// CheckingSnapPointObjectToConnector делают что-то несуразное и получается что к ТО джойнится ТО //// а так НЕЛЬЗЯ try DropFigure := GetComponentFromNormBase(currConnector.ap1.x, currConnector.ap1.y, NBComponent, currConnector, StateType); except DropFigure := nil; end; ////TConnectorObject(currConnector).FConnectorType := aSaveCT; IDNewComponent := 0; if DropFigure <> nil then begin // копирование IDNewComponent := CopyComponentToPrjManager(GListNode, DropFigure.ID, GCadForm.FCADListID, NBComponent, True, True); // накладка коннекторов один на другой CheckingSnapPointObjectToConnector(TConnectorObject(DropFigure), currConnector); SetConnObjectSelectHightPriority(TConnectorObject(DropFigure)); // BUG_2017-07-04 БАГ АВ на Проект АВ-ЄКК.scs при установке ЭКК на трассы с более чем одник КК // АВ было из-за того что пустой коннектор делался точечным и после // поєтому переназначим ConnectorObject if GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(DropFigure.id) <> nil then AConnectorWithLines.ConnectorObject := GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(DropFigure.id); end; // //IDNewComponent := CopyComponentFromNbToPm(F_NormBase, Self, nil, AConnectorWithLines.ConnectorObject.TreeViewNode, IDNBConnector, ckCompon, false); //Inc(SetConnectorCount); //IDNewComponent := CopyComponentToSCSObject(AConnectorWithLines.ConnectorObject.SCSID, IDDefCorkCompon); if IDNewComponent > 0 then if CanalsToConnectWithAdapters.Count = AdapterIDs.Count then //27.08.2008 begin NewComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDNewComponent); // Tolik //NewComponent.DisJoinFromAll(true); // if NewComponent <> nil then SetComponAndChildsFieldComeFrom(NewComponent, cftAuto); end; FreeAndNil(NBComponent); end; end; end; end; if NewComponent = nil then begin NewComponent := ConnectorListOwner.CreateCCEForCCTemplates(CanalsToJoin, AConnectorWithLines.ConnectorObject, ConnectorTypeToSet); if NewComponent <> nil then SetComponAndChildsFieldComeFrom(NewComponent, cftAuto); end; if NewComponent <> nil then begin // подключаем к ЭЭК каналы JoinCCEWithCanals(AConnectorWithLines.ConnectorObject, NewComponent, CanalsToJoin, CanalsToConnectWithAdapters, AdapterIDs, true, IsCCEToAdapterThroughFemales); {if Assigned(NewComponent) then begin // Подключаем каналы к ЭКК for i := 0 to CanalsToJoin.Count - 1 do begin CanalComponent := CanalsToJoin[i]; if CanalsToConnectWithAdapters.IndexOf(CanalComponent) = -1 then begin CanalComponentObject := CanalComponent.GetFirstParentCatalog; CurrLineSide := -1; ConnectorSide := -1; if Assigned(CanalComponentObject) then begin GetSidesByConnectedFigures(CanalComponentObject.ListID, AConnectorWithLines.ConnectorObject.ListID, CanalComponentObject.SCSID, AConnectorWithLines.ConnectorObject.SCSID, CurrLineSide, ConnectorSide); end; if Assigned(NewComponent) then if (NewComponent.JoinedComponents.IndexOf(CanalComponent) <> -1) or (NewComponent.JoinTo(CanalComponent, ConnectorSide, CurrLineSide).CanConnect) then Log.Insert(0, ' - '+cMain_Msg48_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg48_2+' "'+NewComponent.GetNameForVisible+'";') else begin Log.Add(' - '+cMain_Msg49_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg49_2+' "'+NewComponent.Name+'". '+ cMain_Msg49_3); DelCompon(NewComponent, NewComponent.TreeViewNode, true, true, true, false); NewComponent := nil; end; CanAddCork := true; end; end; // Подключаем Каналы к ЭКК через адаптеры //27.08.2008 if NewComponent <> nil then begin Adapters := TSCSComponents.Create(false); IsSuccessConnectedThroughAdapter := false; for i := 0 to CanalsToConnectWithAdapters.Count - 1 do begin IsSuccessConnectedThroughAdapter := false; CanalComponent := CanalsToConnectWithAdapters[i]; // Копируем Адаптер в точ-й объект IDNewAdapter := CopyComponentFromNbToPm(F_NormBase, Self, nil, AConnectorWithLines.ConnectorObject.TreeViewNode, AdapterIDs[i], ckCompon, false); NewAdapter := GSCSBase.CurrProject.GetComponentFromReferences(IDNewAdapter); if NewAdapter <> nil then begin Adapters.Add(NewAdapter); // Подключаем адаптер к ЭКК GCanJoinInterfFemaleToFemale := IsCCEToAdapterThroughFemales; try ResJoinCCEToAdapter := NewAdapter.JoinTo(NewComponent, 0, 0); finally GCanJoinInterfFemaleToFemale := false; end; if ResJoinCCEToAdapter.CanConnect then // Подключаем адаптер к каналу if F_ChoiceConnectSide.JoinWithDefineSides(NewAdapter, CanalComponent, false).CanConnect then IsSuccessConnectedThroughAdapter := true; end; if Not IsSuccessConnectedThroughAdapter then Break; //// BREAK //// end; // Формируем Лог подключенных адаптеров if Adapters.Count = CanalsToConnectWithAdapters.Count then begin for i := 0 to Adapters.Count - 1 do begin NewAdapter := Adapters[i]; CanalComponent := CanalsToConnectWithAdapters[i]; Log.Add(' - "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg48_2+' "'+NewComponent.GetNameForVisible+'" '+ cMain_Msg48_3+' "'+NewAdapter.GetNameForVisible+'";') end; end else // Если подключены не все каналы к ЭКК через адаптер, то удаляем проставленные адаптеры вместе с ЭКК if Adapters.Count < CanalsToConnectWithAdapters.Count then begin // Формируем Лог не подключенных адаптеров for i := Adapters.Count to CanalsToConnectWithAdapters.Count - 1 do begin CanalComponent := CanalsToConnectWithAdapters[i]; Log.Add(' - '+cMain_Msg49_1+' "'+CanalComponent.GetNameForVisible+'" '+cMain_Msg49_2+' "'+NewComponent.Name+'" '+ cMain_Msg48_3+' '+ctnADapter+' .'+cMain_Msg49_3); end; // Удаляем for i := 0 to Adapters.Count - 1 do begin NewAdapter := Adapters[i]; DelCompon(NewAdapter, NewAdapter.TreeViewNode, true, true, true, false); end; DelCompon(NewComponent, NewComponent.TreeViewNode, true, true, true, false); end; FreeAndNil(Adapters); end; end;} end else if IsAborted then Break; //// BREAK //// end; end; end; TF_Main(FNormBase).SelectComponInPCObjects(SavedNBComponentID); CanalsToRemoveFromList.AddItems(CanalsToJoin); end; finally AdapterIDs.Free; CanalsToConnectWithAdapters.Free; FreeCanalsInTraces.Free; CanalsToJoin.Free; CanalsToRemoveFromList.Free; end; end; except on E: Exception do AddExceptionToLogEx('SetConnectors', E.Message); end; GConnecntOnlyOneLineCompon := SavedGConnecntOnlyOneLineCompon; end; procedure SetConnectorsToSpecialTraces; var i, j: integer; CableChannel: TSCSComponent; CableChannelOwner: TSCSCatalog; CableChannelLength: Double; CableChannelSideSection: Double; DivisionRes: Double; ConnectorsExists: TSCSComponents; Connector: TSCSComponent; TmpCanals: TSCSComponents; TmpAdapterIDs: TIntList; ConnectorCountToAdd: Integer; IDNBConnector: Integer; IDNewComponent: Integer; NewComponent: TSCSComponent; ListOwner: TSCSlist; SavedGConnecntOnlyOneLineCompon: boolean; begin try SavedGConnecntOnlyOneLineCompon := GConnecntOnlyOneLineCompon; GConnecntOnlyOneLineCompon := True; TmpCanals := TSCSComponents.Create(false); TmpAdapterIDs := TIntList.Create; ConnectorsExists := TSCSComponents.Create(false); for i := 0 to CableCanalsInSpecialTraces.Count - 1 do begin CableChannel := CableCanalsInSpecialTraces[i]; ListOwner := CableChannel.GetListOwner; CableChannelOwner := CableChannel.GetFirstParentCatalog; if CableChannelOwner <> nil then begin CableChannelLength := CableChannelOwner.GetPropertyValueAsFloat(pnLength); CableChannelSideSection := CableChannel.GetPropertyValueAsFloat(pnSectionSize); ConnectorCountToAdd := 0; if (CableChannelLength - CableChannelSideSection) > 0.001 then begin DivisionRes := CableChannelLength / CableChannelSideSection; // Если результат деления не содержит дробной части if (DivisionRes - Trunc(DivisionRes)) = 0 then ConnectorCountToAdd := Trunc(DivisionRes) - 1 else ConnectorCountToAdd := Trunc(DivisionRes); end; // Определяем ранее проложенные соединители ConnectorsExists.Clear; if assigned(CableChannelOwner.ComponentReferences) then for j := 0 to CableChannelOwner.ComponentReferences.Count - 1 do begin Connector := CableChannelOwner.ComponentReferences[j]; if Connector.IsLine = biFalse then if Connector.IDRelatedCompon = CableChannel.ID then ConnectorsExists.Add(Connector); end; // Удаляем лишние ранее проложенные соединители if ConnectorsExists.Count > ConnectorCountToAdd then begin while ConnectorsExists.Count > ConnectorCountToAdd do begin j := ConnectorsExists.Count - 1; Connector := ConnectorsExists[j]; DelCompon(Connector, Connector.TreeViewNode, true, true, true, false); ConnectorsExists.Delete(j); end; ConnectorCountToAdd := 0; end else // определяем сколько еще соединителй не хватает ConnectorCountToAdd := ConnectorCountToAdd - ConnectorsExists.Count; if ConnectorCountToAdd > 0 then begin TmpCanals.Clear; TmpCanals.Add(CableChannel); for j := 0 to ConnectorCountToAdd - 1 do begin TmpAdapterIDs.Clear; NewComponent := nil; IDNBConnector := GetCommonIDNBConnector(TmpCanals, nil, contConnector, -1, TmpAdapterIDs, nil, nil, true); if IDNBConnector <> 0 then begin if CableChannelOwner.TreeViewNode = nil then FindComponOrDirInTree(CableChannelOwner.ID, false); IDNewComponent := CopyComponentFromNbToPm(F_NormBase, Self, nil, CableChannelOwner.TreeViewNode, IDNBConnector, ckCompon, false); NewComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDNewComponent); end; if NewComponent = nil then NewComponent := ListOwner.CreateCCEForCCTemplates(TmpCanals, CableChannelOwner, contConnector); if NewComponent <> nil then begin SetComponAndChildsFieldComeFrom(NewComponent, cftAuto); NewComponent.IDRelatedCompon := CableChannel.ID; Log.Insert(0, ' - '+cMain_Msg171+' "'+NewComponent.GetNameForVisible+'" '+cNameFor+' "'+CableChannel.GetNameForVisible+'";'); end else if IsAborted then Break; //// BREAK //// end; if IsAborted then Break; //// BREAK //// end; end; end; FreeAndNil(ConnectorsExists); FreeAndNil(TmpAdapterIDs); FreeAndNil(TmpCanals); except on E: Exception do AddExceptionToLogEx('SetConnectorsToSpecialTraces', E.Message); end; GConnecntOnlyOneLineCompon := SavedGConnecntOnlyOneLineCompon; end; begin // Tolik 28/02/2017 -- проверка на превышение квоты объектов USER //if GDBMode <> bkProjectManager then if ((GDBMode <> bkProjectManager) or (GUserOBjectsQuotaLimit_Message_Counter >=3)) then Exit; ///// EXIT ///// UserQuotaReached_Message := ''; UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(1), cMess_Quota); if UserQuotaReached_Message = '' then // begin // Tolik 28/02/2017 -- UserQuotaReached_Message := ''; // //Tolik CorkOnEndTracePointObject := False; CorkOnEndTracePointObject := (MessageModal(cMain_Msg51_1, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES); // Dat := nil; Folder := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if Dat.ItemType = itProject then Folder := GSCSBase.CurrProject; if Dat.ItemType = itList then Folder := GSCSBase.CurrProject.GetListByID(Dat.ObjectID); IsAborted := false; try //List := GSCSBase.CurrProject.CurrList; if Assigned(Folder) then begin CableCanals := TSCSComponents.Create(false); CableCanalsInSpecialTraces := TSCSComponents.Create(false); SCSListIDs := TIntList.Create; // Tolik 22/11/2021 - - if aInstallTubesElements then ConnectComponType := ctsnTube else ConnectComponType := ctsnCableChannel; // if assigned(Folder.ComponentReferences) then for i := 0 to Folder.ComponentReferences.Count - 1 do begin SCSComponent := Folder.ComponentReferences[i]; if Assigned(SCSComponent) then //Tolik 22/11/2021 - - //if SCSComponent.ComponentType.SysName = ctsnCableChannel then if SCSComponent.ComponentType.SysName = ConnectComponType then // begin CanAddComponToList := false; ComponOwner := SCSComponent.GetFirstParentCatalog; if Not AForSelectedTraces then CanAddComponToList := true else begin if ComponOwner <> nil then if CheckCADObjectSelect(ComponOwner.ListID, ComponOwner.SCSID) then CanAddComponToList := true; end; if CanAddComponToList then begin CableCanals.Add(SCSComponent); // добавить каб канал из спец-й не разрываемой трассы в список if ComponOwner.ItemType = itSCSLine then begin List := ComponOwner.GetListOwner; if List <> nil then // Если стоит опция - "учитывать размер отрезка" if List.Setting.CADAllowSuppliesKind then // Если это специальная трасса if IsSpecialTrace(ComponOwner.ListID, 0, ComponOwner.SCSID) then begin CableCanalSectionSide := SCSComponent.GetPropertyValueAsFloat(pnSectionSize); if CableCanalSectionSide > 0 then // Если длина трассы превышает размер отрезка if CableCanalSectionSide < ComponOwner.GetPropertyValueAsFloat(pnLength) then CableCanalsInSpecialTraces.Add(SCSComponent); end; end; end; end; end; if CableCanals.Count > 0 then begin WasEndProgress := false; IsSetConnectorsAtFalseFloorHeight := biNone; IsAskCCEOtherType := true; MessageResToJoinCCEWithAdapterThroughFemales := mrNone; Connectors := TList.Create; FindedConnectors := TSCSCatalogs.Create(false); FindedNBConnectorIDs := TIDStringList.Create; NBConnectors := TSCSComponents.Create(true); CCESelectedForAll := TSCSComponents.Create(false); CCESelectedForAllWithFemales := TSCSComponents.Create(false); CCEOtherTypeSelectedForAll := TSCSComponents.Create(false); TubeConnectionkindForAll := TIntList.Create; BeginProgress; try for i := 0 to CableCanals.Count - 1 do begin List := CableCanals[i].GetListOwner; if Not List.OpenedInCAD then OpenNoExistsListInCAD(List); if SCSListIDs.IndexOf(List.CurrID) = -1 then SCSListIDs.Add(List.CurrID); DefineConnectors(CableCanals[i], 1); DefineConnectors(CableCanals[i], 2); end; // Если нет соединителей if (Connectors.Count = 0) and (CableCanalsInSpecialTraces.Count = 0) then begin WasEndProgress := true; EndProgress; MessageModal(cMain_Msg50, ApplicationName, MB_ICONINFORMATION or MB_OK); end else begin // UNDO SaveListsToUndoStack(SCSListIDs); OldTick := GetTickCount; // Tolik -- 28/02/2017 -- проверка превышения квофы объектов USER UserQuotaReached_Message := GetQuotaMessage(CheckUserObjQuotaReached(Connectors.Count),cMess_Quota); if UserQuotaReached_Message = '' then begin // Log := TStringList.Create; //*** загрузка затычек for i := 0 to Connectors.Count - 1 do begin ptrConnectorWithLines := Connectors[i]; // КАКИМ то чудом в список бывает попадают очень битые записи // поэтому проверимс // как оказалось - не попадает вроде, а стает затем по // дороге плохим из-за // кода который далее выполняется: // CheckingSnapPointObjectToConnector(TConnectorObject(DropFigure), currConnector); // но проверку все же оставим if (assigned(ptrConnectorWithLines.ConnectorObject)) and (assigned(ptrConnectorWithLines.ConnectorObject.ComponentReferences)) and (ptrConnectorWithLines.ConnectorObject.ItemType > 0) and (ptrConnectorWithLines.ConnectorObject.SCSID > 0) then begin //if ptrConnectorWithLines.ConnectorObject <> nil then // OpenNoExistsListInCAD(ptrConnectorWithLines.ConnectorObject.GetListOwner); SetConnectors(ptrConnectorWithLines); end else begin IsAborted := IsAborted; end; if IsAborted then Break; //// BREAK //// end; if Not IsAborted then SetConnectorsToSpecialTraces; WasEndProgress := true; EndProgress; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; if Log.Count > 0 then begin if MessageModal(cMain_Msg51, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then F_AnswerToQuast.ShowContextHelp(cMain_Msg52, Log.Text); GLog.AddStrings(Log); Log.Free; end; end else // просто сообщение о превышении квоты begin PauseProgress(True); Showmessage(UserQuotaReached_Message); PauseProgress(False); end; end; finally EndProgress; //*** Освободить память FreeAndNil(TubeConnectionkindForAll); FreeAndNil(FindedConnectors); for i := 0 to Connectors.Count - 1 do begin ptrConnectorWithLines := Connectors[i]; FreeAndNil(ptrConnectorWithLines.ConnectedLines); FreeAndNil(ptrConnectorWithLines.TraceSCSIDList); end; FreeList(Connectors); FreeAndNil(FindedNBConnectorIDs); FreeAndNil(CCEOtherTypeSelectedForAll); FreeAndNil(CCESelectedForAllWithFemales); FreeAndNil(CCESelectedForAll); FreeAndNil(NBConnectors); end; end else begin if Not AForSelectedTraces then ShowMessageByType(0, smtDisplay, cMain_Msg53_1, Application.Title, MB_OK or MB_ICONINFORMATION) else ShowMessageByType(0, smtDisplay, cMain_Msg53_2, Application.Title, MB_OK or MB_ICONINFORMATION); end; FreeAndNil(CableCanals); FreeAndNil(CableCanalsInSpecialTraces); FreeAndNil(SCSListIDs); end; except on E: Exception do AddExceptionToLog('TF_MAIN.SetCableCanalConnectors: '+E.Message); end; end else Showmessage(UserQuotaReached_Message); end; procedure TF_MAIN.ApplyComponPropsForRelatedResources(ADestCatalog: TSCSCatalog; ASrcCompon: TSCSComponent); var i, j: Integer; Compon: TSCSComponent; ResourceRel: TSCSResourceRel; ptrStrComponCurrency: PObjectCurrencyRel; NBCurrencyProperSrcCompon: TNBCurrency; ResChanged: Boolean; ListIDs: TIntList; Resources: TSCSResources; begin ResChanged := false; if GDBMode = bkProjectManager then if ASrcCompon.GuidNB <> '' then begin ListIDs := TIntList.Create; Resources := TSCSResources.Create(false); if assigned(ADestCatalog.ComponentReferences) then for i := 0 to ADestCatalog.ComponentReferences.Count - 1 do begin Compon := ADestCatalog.ComponentReferences[i]; for j := 0 to Compon.NormsResources.Resources.Count - 1 do begin ResourceRel := Compon.NormsResources.Resources[j]; if ResourceRel.GUIDNBComponent = ASrcCompon.GuidNB then begin Resources.Add(ResourceRel); if ListIDs.IndexOf(Compon.ListID) = -1 then ListIDs.Add(Compon.ListID); end; end; end; SaveListsToUndoStack(ListIDs); NBCurrencyProperSrcCompon := nil; ptrStrComponCurrency := TF_Main(ASrcCompon.ActiveForm).DM.GetComponCurrencyByMainFld(ASrcCompon.ID, ctMain); if ptrStrComponCurrency <> nil then NBCurrencyProperSrcCompon := GSCSBase.CurrProject.Spravochnik.GetCurrencyByGUID(ptrStrComponCurrency.Data.GUID); for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; ResourceRel.Cypher := ASrcCompon.Cypher; ResourceRel.Name := ASrcCompon.Name; ResourceRel.Izm := ASrcCompon.Izm; ResourceRel.Price := ASrcCompon.Price; if NBCurrencyProperSrcCompon <> nil then ResourceRel.RefreshPricesAfterChangeCurrency(NBCurrencyProperSrcCompon.Data, GLocalCurrencyM.Data, true); ResChanged := true; end; FreeMem(ptrStrComponCurrency); //FreeAndNil(NBCurrencyProperSrcCompon); FreeAndNil(Resources); FreeAndNil(ListIDs); end; if ResChanged then begin ADestCatalog.NotifyChange; RefreshNode; end; end; // ##### Вернуть тип соединения ##### function TF_MAIN.GetConnectKind(AGender1, AGender2: TGenderType): TConnectKind; var ConnectKind: TConnectKind; begin Result := cnkNone; ConnectKind := cnkNone; if (AGender1 = gtFemale) and (AGender2 = gtMale) then ConnectKind := ConnectKind or cnkFemaleMale; if (AGender1 = gtMale) and (AGender2 = gtFemale) then ConnectKind := ConnectKind or cnkMaleFemale; if (AGender1 = gtFemale) and (AGender2 = gtFemale) then ConnectKind := ConnectKind or cnkFemaleFemale; if (AGender1 = gtMale) and (AGender2 = gtMale) then ConnectKind := ConnectKind or cnkMaleMale; if AGender1 = AGender2 then ConnectKind := ConnectKind or cnkSame; if AGender1 <> AGender2 then ConnectKind := ConnectKind or cnkVarious; Result := ConnectKind; end; function TF_Main.CanFemaleHaveMale(AFemaleInterface: TSCSInterface; AAdditionMaleValue, ACableCanalFullnessKoef: Double): TCanFemaleHaveMaleRes; var MaxFemaleFullValue: Double; FemaleComplValue: Double; MaleTotalValue: Double; MinValueForMales: Double; begin Result.CanHave := false; Result.MinValueForMales := AFemaleInterface.ValueI; try MaxFemaleFullValue := 0; FemaleComplValue := DM.GetConnectedInterfacesValues(DM.scsQSelect, AFemaleInterface.ID); MaleTotalValue := FemaleComplValue + AAdditionMaleValue; if AFemaleInterface.ValueI <> 0 then begin MaxFemaleFullValue := AFemaleInterface.ValueI; if ACableCanalFullnessKoef > 0 then MaxFemaleFullValue := (AFemaleInterface.ValueI / 100) * ACableCanalFullnessKoef; end; if MaxFemaleFullValue >= MaleTotalValue then Result.CanHave := true; if MaxFemaleFullValue < MaleTotalValue then Result.CanHave := false; Result.CurrFemaleEmptyValue := MaxFemaleFullValue - FemaleComplValue; Result.CurrMaleValue := MaleTotalValue; Result.MaxFemaleFullValue := MaxFemaleFullValue; MinValueForMales := MaleTotalValue; if ACableCanalFullnessKoef <> 0 then begin MinValueForMales := MaleTotalValue; if ACableCanalFullnessKoef > 0 then MinValueForMales := Round3(MaleTotalValue * (100 / ACableCanalFullnessKoef)); end; Result.MinValueForMales := RoundCP(MinValueForMales); if Not Result.CanHave then begin if ExtendTemplateInterface(AFemaleInterface, 0, @MinValueForMales) then Result.CanHave := true; end; except on E: Exception do AddExceptionToLog('TF_Main.CanFemaleHaveMale: '+E.Message); end; end; // ##### Проверить соответсвие "полов " ##### function TF_Main.CheckGender(AInterf1, AInterf2: TSCSInterface; AConnectType: Integer): Boolean; var ConnectKinds: Integer; function CheckGenderRes(AConnKind: TConnectKind; AGnd1, AGnd2: Integer): Boolean; begin Result := false; if ConnectKinds and AConnKind = AConnKind then if (AInterf1.Gender = AGnd1) and (AInterf2.Gender = AGnd2) then Result := true; end; begin Result := false; ConnectKinds := cnkVarious; case AConnectType of cntComplect: ConnectKinds := cnkVarious; cntUnion: begin if (AInterf1.ConnToAnyGender = biTrue) and (AInterf2.ConnToAnyGender = biTrue) then Result := true else if (AInterf1.ComponentOwner <> nil) and (AInterf2.ComponentOwner <> nil) then begin // Если линейный компонент к линейному if (AInterf1.ComponentOwner.isLine = biTrue) and (AInterf2.ComponentOwner.isLine = biTrue) then ConnectKinds := cnkVarious or cnkMaleMale; end; if Not Result then if GCanJoinInterfFemaleToFemale then if (AInterf1.Gender = gtFemale) and (AInterf2.Gender = gtFemale) then Result := true; end; end; if Not Result then begin if CheckGenderRes(cnkFemaleMale, gtFemale, gtMale) then Result := true else if CheckGenderRes(cnkMaleFemale, gtMale, gtFemale) then Result := true else if CheckGenderRes(cnkFemaleFemale, gtFemale, gtFemale) then Result := true else if CheckGenderRes(cnkMaleMale, gtMale, gtMale) then Result := true else if (ConnectKinds and cnkSame = cnkSame) and (AInterf1.Gender = AInterf2.Gender) then Result := true else if (ConnectKinds and cnkVarious = cnkVarious) and (AInterf1.Gender <> AInterf2.Gender) then Result := true; end; end; function TF_MAIN.CheckInterf(AInterface1, AInterface2: TSCSInterface; AConnectType: TConnectType; AKolvoInterf1, AKolvoInterf2: PInteger): Boolean; var //GUIDInterface: string; //GUIDAccordance: string; InterfComponIsLine: Integer; AccordComponIsLine: Integer; CanConnectByConnectType: Boolean; NBInterface1: TNBInterface; NBInterface2: TNBInterface; InterfAccordance: TRapList; NBInterfaceACcordance: TNBInterfaceACcordance; IsAccordanceInterface: Boolean; i: Integer; KolvoInterf1: Integer; KolvoInterf2: Integer; Spravochnik: TSpravochnik; SpravochnikPM: TSpravochnik; SpravochnikNB: TSpravochnik; Interf1UniverseIdx: Integer; Interf2UniverseIdx: Integer; begin Result := false; CanConnectByConnectType := false; try //if (AInterface1 = nil) or (AInterface2 = nil) then // Exit; ///// EXIT ///// KolvoInterf1 := 0; KolvoInterf2 := 0; case AConnectType of cntComplect: if (AInterface1.TypeI = itConstructive) and (AInterface2.TypeI = itConstructive) then CanConnectByConnectType := true; cntUnion: if (AInterface1.TypeI = itFunctional) and (AInterface2.TypeI = itFunctional) then CanConnectByConnectType := true; cntNone: CanConnectByConnectType := true; end; if CanConnectByConnectType then begin if (AInterface1.GUIDInterface = AInterface2.GUIDInterface) then begin Result := true; KolvoInterf1 := 1; KolvoInterf2 := 1; end else begin Spravochnik := nil; SpravochnikPM := nil; SpravochnikNB := FNormBase.GSCSBase.NBSpravochnik; if (TF_Main(AInterface1.ActiveForm).GDBMode = bkProjectManager) then begin if AInterface1.ComponentOwner.ProjectOwner <> nil then SpravochnikPM := AInterface1.ComponentOwner.ProjectOwner.Spravochnik else SpravochnikPM := FProjectMan.GSCSBase.CurrProject.Spravochnik; end; if (TF_Main(AInterface2.ActiveForm).GDBMode = bkProjectManager) then begin if AInterface2.ComponentOwner.ProjectOwner <> nil then SpravochnikPM := AInterface2.ComponentOwner.ProjectOwner.Spravochnik else SpravochnikPM := FProjectMan.GSCSBase.CurrProject.Spravochnik; end; Spravochnik := SpravochnikNB; if SpravochnikPM <> nil then Spravochnik := SpravochnikPM; // Посмотреть в таблице соответствий NBInterface1 := nil; NBInterface2 := nil; if AInterface1.GUIDInterface <> '' then NBInterface1 := Spravochnik.GetInterfaceByGUID(AInterface1.GUIDInterface) else NBInterface1 := Spravochnik.GetInterfaceByID(AInterface1.ID_Interface); if NBInterface1 = nil then begin if AInterface1.GUIDInterface <> '' then NBInterface1 := SpravochnikNB.GetInterfaceByGUID(AInterface1.GUIDInterface) else NBInterface1 := SpravochnikNB.GetInterfaceByID(AInterface1.ID_Interface); end; if AInterface2.GUIDInterface <> '' then NBInterface2 := Spravochnik.GetInterfaceByGUID(AInterface2.GUIDInterface) else NBInterface2 := Spravochnik.GetInterfaceByID(AInterface2.ID_Interface); if NBInterface2 = nil then begin if AInterface2.GUIDInterface <> '' then NBInterface2 := SpravochnikNB.GetInterfaceByGUID(AInterface2.GUIDInterface) else NBInterface2 := SpravochnikNB.GetInterfaceByID(AInterface2.ID_Interface); end; if (NBInterface1 <> nil) or (NBInterface2 <> nil) then begin InterfAccordance := TRapList.Create; try if NBInterface1 <> nil then for i := 0 to NBInterface1.InterfaceAccordance.Count - 1 do InterfAccordance.Add(NBInterface1.InterfaceAccordance.List.List^[i]); if NBInterface2 <> nil then for i := 0 to NBInterface2.InterfaceAccordance.Count - 1 do InterfAccordance.Add(NBInterface2.InterfaceAccordance.List.List^[i]); for i := 0 to InterfAccordance.Count - 1 do begin NBInterfaceACcordance := TNBInterfaceACcordance(InterfAccordance[i]); //GUIDInterface := NBInterfaceACcordance.GuidInterface; //GUIDAccordance := NBInterfaceACcordance.GUIDAccordance; InterfComponIsLine := NBInterfaceACcordance.InterfComponIsLine; AccordComponIsLine := NBInterfaceACcordance.AccordComponIsLine; IsAccordanceInterface := false; if (AInterface1.GUIDInterface = NBInterfaceACcordance.GuidInterface) and (AInterface2.GUIDInterface = NBInterfaceACcordance.GUIDAccordance) and ((InterfComponIsLine = ltAnyType) or (AInterface1.IsLineCompon = InterfComponIsLine)) and ((AccordComponIsLine = ltAnyType) or (AInterface2.IsLineCompon = AccordComponIsLine)) then begin IsAccordanceInterface := true; KolvoInterf1 := 1; KolvoInterf2 := NBInterfaceACcordance.Kolvo; end else if (AInterface1.GUIDInterface = NBInterfaceACcordance.GUIDAccordance) and (AInterface2.GUIDInterface = NBInterfaceACcordance.GuidInterface) and ((AccordComponIsLine = ltAnyType) or (AInterface1.IsLineCompon = AccordComponIsLine)) and ((InterfComponIsLine = ltAnyType) or(AInterface2.IsLineCompon = InterfComponIsLine)) then begin IsAccordanceInterface := true; KolvoInterf1 := NBInterfaceACcordance.Kolvo; KolvoInterf2 := 1; end; if IsAccordanceInterface then begin Result := true; Break; ///// BREAK ///// end; end; finally InterfAccordance.Free; end; end; if Not Result then begin Interf1UniverseIdx := GUniversalInterfaces.IndexOf(AInterface1.GUIDInterface); Interf2UniverseIdx := GUniversalInterfaces.IndexOf(AInterface2.GUIDInterface); if (Interf1UniverseIdx <> -1) or (Interf2UniverseIdx <> -1) then begin Result := true; if Interf1UniverseIdx <> Interf2UniverseIdx then begin // Проверяем может ли универсальный интерфейс подключится к определенному типу компонента if (Interf1UniverseIdx <> -1) and Not CheckUInterfConnectToCompType(Interf1UniverseIdx, AInterface2.ComponentOwner.ComponentType.SysName) then Result := false else if (Interf2UniverseIdx <> -1) and Not CheckUInterfConnectToCompType(Interf2UniverseIdx, AInterface1.ComponentOwner.ComponentType.SysName) then Result := false; end; if Result then begin KolvoInterf1 := 1; KolvoInterf2 := 1; end; end; end; end; end; //if KolvoInterf1 <> KolvoInterf2 then // if (TF_Main(AInterface1.ActiveForm).GDBMode = bkNormBase) or // (TF_Main(AInterface2.ActiveForm).GDBMode = bkNormBase) then // begin // KolvoInterf1 := 1; // KolvoInterf2 := 1; // end; if AKolvoInterf1 <> nil then Integer(AKolvoInterf1^) := KolvoInterf1; if AKolvoInterf2 <> nil then Integer(AKolvoInterf2^) := KolvoInterf2; except on E: Exception do AddExceptionToLog('TF_MAIN.CheckInterf: '+E.Message); end; end; { function TF_MAIN.CheckInterf(AInterface1, AInterface2: TSCSInterface; AConnectType: TConnectType; AKolvoInterf1, AKolvoInterf2: PInteger): Boolean; var ID_Interface: integer; ID_Accordance: Integer; InterfComponIsLine: Integer; AccordComponIsLine: Integer; CanConnectByConnectType: Boolean; NBInterface1: TNBInterface; NBInterface2: TNBInterface; InterfAccordance: TSCSObjectList; NBInterfaceACcordance: TNBInterfaceACcordance; IsAccordanceInterface: Boolean; i: Integer; KolvoInterf1: Integer; KolvoInterf2: Integer; Spravochnik: TSpravochnik; SpravochnikPM: TSpravochnik; SpravochnikNB: TSpravochnik; begin Result := false; CanConnectByConnectType := false; try //if (AInterface1 = nil) or (AInterface2 = nil) then // Exit; ///// EXIT ///// KolvoInterf1 := 0; KolvoInterf2 := 0; case AConnectType of cntComplect: if (AInterface1.TypeI = itConstructive) and (AInterface2.TypeI = itConstructive) then CanConnectByConnectType := true; cntUnion: if (AInterface1.TypeI = itFunctional) and (AInterface2.TypeI = itFunctional) then CanConnectByConnectType := true; cntNone: CanConnectByConnectType := true; end; if CanConnectByConnectType then if (AInterface1.ID_Interface = AInterface2.ID_Interface) or (AInterface1.GUIDInterface = AInterface2.GUIDInterface) then begin Result := true; KolvoInterf1 := 1; KolvoInterf2 := 1; end else begin Spravochnik := nil; SpravochnikPM := nil; SpravochnikNB := FNormBase.GSCSBase.NBSpravochnik; if (TF_Main(AInterface1.ActiveForm).GDBMode = bkProjectManager) then begin if AInterface1.ComponentOwner.ProjectOwner <> nil then SpravochnikPM := AInterface1.ComponentOwner.ProjectOwner.Spravochnik else SpravochnikPM := FProjectMan.GSCSBase.CurrProject.Spravochnik; end; if (TF_Main(AInterface2.ActiveForm).GDBMode = bkProjectManager) then begin if AInterface2.ComponentOwner.ProjectOwner <> nil then SpravochnikPM := AInterface2.ComponentOwner.ProjectOwner.Spravochnik else SpravochnikPM := FProjectMan.GSCSBase.CurrProject.Spravochnik; end; Spravochnik := SpravochnikNB; if SpravochnikPM <> nil then Spravochnik := SpravochnikPM; // Посмотреть в таблице соответствий NBInterface1 := nil; NBInterface2 := nil; if AInterface1.GUIDInterface <> '' then NBInterface1 := Spravochnik.GetInterfaceByGUID(AInterface1.GUIDInterface) else NBInterface1 := Spravochnik.GetInterfaceByID(AInterface1.ID_Interface); if NBInterface1 = nil then begin if AInterface1.GUIDInterface <> '' then NBInterface1 := SpravochnikNB.GetInterfaceByGUID(AInterface1.GUIDInterface) else NBInterface1 := SpravochnikNB.GetInterfaceByID(AInterface1.ID_Interface); end; if AInterface2.GUIDInterface <> '' then NBInterface2 := Spravochnik.GetInterfaceByGUID(AInterface2.GUIDInterface) else NBInterface2 := Spravochnik.GetInterfaceByID(AInterface2.ID_Interface); if NBInterface2 = nil then begin if AInterface2.GUIDInterface <> '' then NBInterface2 := SpravochnikNB.GetInterfaceByGUID(AInterface2.GUIDInterface) else NBInterface2 := SpravochnikNB.GetInterfaceByID(AInterface2.ID_Interface); end; if (NBInterface1 <> nil) or (NBInterface2 <> nil) then begin InterfAccordance := TSCSObjectList.Create(false); try if NBInterface1 <> nil then InterfAccordance.Assign(NBInterface1.InterfaceAccordance, laOr); if NBInterface2 <> nil then InterfAccordance.Assign(NBInterface2.InterfaceAccordance, laOr); for i := 0 to InterfAccordance.Count - 1 do begin NBInterfaceACcordance := TNBInterfaceACcordance(InterfAccordance[i]); ID_Interface := NBInterfaceACcordance.IDInterface; ID_Accordance := NBInterfaceACcordance.IDAccordance; InterfComponIsLine := NBInterfaceACcordance.InterfComponIsLine; AccordComponIsLine := NBInterfaceACcordance.AccordComponIsLine; IsAccordanceInterface := false; if (AInterface1.ID_Interface = ID_Interface) and (AInterface2.ID_Interface = ID_Accordance) and ((InterfComponIsLine = ltAnyType) or (AInterface1.IsLineCompon = InterfComponIsLine)) and ((AccordComponIsLine = ltAnyType) or (AInterface2.IsLineCompon = AccordComponIsLine)) then begin IsAccordanceInterface := true; KolvoInterf1 := 1; KolvoInterf2 := NBInterfaceACcordance.Kolvo; end else if (AInterface1.ID_Interface = ID_Accordance) and (AInterface2.ID_Interface = ID_Interface) and ((AccordComponIsLine = ltAnyType) or (AInterface1.IsLineCompon = AccordComponIsLine)) and ((InterfComponIsLine = ltAnyType) or(AInterface2.IsLineCompon = InterfComponIsLine)) then begin IsAccordanceInterface := true; KolvoInterf1 := NBInterfaceACcordance.Kolvo; KolvoInterf2 := 1; end; if IsAccordanceInterface then begin Result := true; Break; ///// BREAK ///// end; end; finally InterfAccordance.Free; end; end; end; //if KolvoInterf1 <> KolvoInterf2 then // if (TF_Main(AInterface1.ActiveForm).GDBMode = bkNormBase) or // (TF_Main(AInterface2.ActiveForm).GDBMode = bkNormBase) then // begin // KolvoInterf1 := 1; // KolvoInterf2 := 1; // end; if AKolvoInterf1 <> nil then Integer(AKolvoInterf1^) := KolvoInterf1; if AKolvoInterf2 <> nil then Integer(AKolvoInterf2^) := KolvoInterf2; except on E: Exception do AddExceptionToLog('TF_MAIN.CheckInterf: '+E.Message); end; end; } function TF_MAIN.CanConnectControlByProperty(AProperty: PProperty; AConnectType: TConnectType; ACheckControlComplect, ACheckControlJoin: Boolean): Boolean; begin Result := false; if (ACheckControlComplect and (AConnectType = cntComplect) and (AProperty.TakeIntoConnect = biTrue)) or (ACheckControlJoin and (AConnectType = cntUnion) and (AProperty.TakeIntoJoin = biTrue)) then Result := true; end; function TF_MAIN.CheckCanConnectProperties(AProperty1, AProperty2: PProperty; AConnectType: TConnectType; ACheckControlComplect, ACheckControlJoin, AForEndPointCompons: Boolean; AMessgNotAgreeProps: PString): Boolean; var PropsIsAccordance: Boolean; IsCrossControl: Boolean; begin Result := true; PropsIsAccordance := false; IsCrossControl := false; //*** проверить может ли осуществлятся контроль по свойствам if CanConnectControlByProperty(AProperty1, AConnectType, ACheckControlComplect, ACheckControlJoin) and CanConnectControlByProperty(AProperty2, AConnectType, ACheckControlComplect, ACheckControlJoin) then begin { if (AProperty1.ID_Property = AProperty2.ID_Property) and (AProperty1.IsCrossControl = biFalse) and (AProperty2.IsCrossControl = biFalse) then begin PropsIsAccordance := true; IsCrossControl := false; end else if ((AProperty1.IDCrossProperty = AProperty2.ID_Property) and (AProperty1.IsCrossControl = biTrue)) or ((AProperty2.IDCrossProperty = AProperty1.ID_Property) and (AProperty2.IsCrossControl = biTrue)) then begin PropsIsAccordance := true; IsCrossControl := true; end; } if (AProperty1.GUIDProperty = AProperty2.GUIDProperty) and (AProperty1.IsCrossControl = biFalse) and (AProperty2.IsCrossControl = biFalse) then begin PropsIsAccordance := true; IsCrossControl := false; end else if ((AProperty1.GUIDCrossProperty = AProperty2.GUIDProperty) and (AProperty1.IsCrossControl = biTrue)) or ((AProperty2.GUIDCrossProperty = AProperty1.GUIDProperty) and (AProperty2.IsCrossControl = biTrue)) then begin PropsIsAccordance := true; IsCrossControl := true; end; //*** Если название свойств одинаковое if PropsIsAccordance then begin if Not CmpPropValues(AProperty1, AProperty2) then //22.09.2010 if AProperty1.Value <> AProperty2.Value then begin Result := false; if AMessgNotAgreeProps <> nil then begin if AMessgNotAgreeProps^ <> '' then AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + ', '; case IsCrossControl of true: AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + AProperty1.Name_+ ' '+cMain_Msg78_1+' '+AProperty2.Name_; false: AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + AProperty1.Name_; end; if AForEndPointCompons then AMessgNotAgreeProps^ := AMessgNotAgreeProps^ +' '+ cMain_Msg78_2; end; end; end; end; end; function TF_MAIN.CheckCanJoinEndComponsByProps(APointCompon1, APointCompon2: TSCSComponent; AMessgNotAgreeProps: PString): Boolean; var i, j: Integer; Property1: PProperty; Property2: PProperty; ConnectType: TConnectType; CheckControlComplect, CheckControlJoin: Boolean; begin Result := true; ConnectType := cntUnion; CheckControlComplect := false; CheckControlJoin := true; for i := 0 to APointCompon1.Properties.Count - 1 do begin Property1 := APointCompon1.Properties[i]; //*** Если свойство определено как для контроля на конечных точечных компонентах if (Property1.IsTakeJoinforPoint = biTrue) and CanConnectControlByProperty(Property1, ConnectType, CheckControlComplect, CheckControlJoin) then for j := 0 to APointCompon2.Properties.Count - 1 do begin Property2 := APointCompon2.Properties[j]; //*** Если свойство определено как для контроля на конечных точечных компонентах if (Property2.IsTakeJoinforPoint = biTrue) and CanConnectControlByProperty(Property2, ConnectType, CheckControlComplect, CheckControlJoin) then begin if Not CheckCanConnectProperties(Property1, Property2, ConnectType, CheckControlComplect, CheckControlJoin, true, AMessgNotAgreeProps) then begin if Result = true then Result := false; end; end; end; end; // 07.08.2007 //for i := 0 to APointCompon1.Properties.Count - 1 do // begin // Property1 := APointCompon1.Properties[i]; // if CanConnectControlByProperty(Property1, ConnectType, CheckControlComplect, CheckControlJoin) then // for j := 0 to APointCompon2.Properties.Count - 1 do // begin // Property2 := APointCompon2.Properties[j]; // if CanConnectControlByProperty(Property2, ConnectType, CheckControlComplect, CheckControlJoin) then // begin // //*** Если свойства определены как для контроля на конечных точечных компонентах // if (Property1.IsTakeJoinforPoint = biTrue) or // (Property2.IsTakeJoinforPoint = biTrue) then // if Not CheckCanConnectProperties(Property1, Property2, ConnectType, // CheckControlComplect, CheckControlJoin, AMessgNotAgreeProps) then // begin // if Result = true then // Result := false; // end; // end; // end; // end; end; // ##### Проверяет, можно ли соединять компоненты не учитывая интерфейсов ##### function TF_MAIN.CanConnCompon(ACompon1, ACompon2: TSCSComponent; AConnectType: TConnectType; AShowMessageType: TShowMessageType; ACheckVariousObject: Boolean = true; AIDCompRelToSkip: Integer=-1): Boolean; var CanConnect: Boolean; SCSList: TSCSList; TextMsg: String; CaptMsg: String; //IDUpperCompon1: Integer; //IDUpperCompon2: Integer; TopCompon1: TSCSComponent; TopCompon2: TSCSComponent; ControlJoinByNetType: Boolean; ControlComplectByProducer: Boolean; CheckControlComplect: Boolean; CheckControlJoin: Boolean; MessgNotAgreeProps: String; CanCheckObjOwner: Boolean; procedure AddMsgItem(AMsgItem: String); begin TextMsg := TextMsg + #13+#10+ ' - '+AMsgItem; CanConnect := false; end; function GetStrComponType(AComponent: TSCSComponent): String; var ResStr: String; begin Result := ''; ResStr := '"'+AComponent.Name+'" '+cMain_Msg77_3+' '; case AComponent.IsLine of ctLine: ResStr := ResStr + cMain_Msg77_1; ctConn: ResStr := ResStr + cMain_Msg77_2; end; Result := ResStr; end; {function CanConnectControlByProperty(AProperty: PProperty): Boolean; begin Result := false; if (CheckControlComplect and (AConnectType = cntComplect) and (AProperty.TakeIntoConnect = biTrue)) or (CheckControlJoin and (AConnectType = cntUnion) and (AProperty.TakeIntoJoin = biTrue)) then Result := true; end;} { function CheckCanConnectProperties(AProperty1, AProperty2: PProperty; AMessgNotAgreeProps: PString): Boolean; var PropsIsAccordance: Boolean; IsCrossControl: Boolean; begin Result := true; PropsIsAccordance := false; IsCrossControl := false; //*** проверить может ли осуществлятся контроль по свойствам if CanConnectControlByProperty(AProperty1, AConnectType, CheckControlComplect, CheckControlJoin) and CanConnectControlByProperty(AProperty2, AConnectType, CheckControlComplect, CheckControlJoin) then begin if (AProperty1.ID_Property = AProperty2.ID_Property) and (AProperty1.IsCrossControl = biFalse) and (AProperty2.IsCrossControl = biFalse) then begin PropsIsAccordance := true; IsCrossControl := false; end else if ((AProperty1.IDCrossProperty = AProperty2.ID_Property) and (AProperty1.IsCrossControl = biTrue)) or ((AProperty2.IDCrossProperty = AProperty1.ID_Property) and (AProperty2.IsCrossControl = biTrue)) then begin PropsIsAccordance := true; IsCrossControl := true; end; //*** Если название свойств одинаковое if PropsIsAccordance then begin if AProperty1.Value <> AProperty2.Value then begin Result := false; if AMessgNotAgreeProps <> nil then begin if AMessgNotAgreeProps^ <> '' then AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + ', '; case IsCrossControl of true: AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + AProperty1.Name+ ' '+cMain_Msg78+' '+AProperty2.Name; false: AMessgNotAgreeProps^ := AMessgNotAgreeProps^ + AProperty1.Name; end; end; //if MessgNotAgreeProps <> '' then // MessgNotAgreeProps := MessgNotAgreeProps + ', '; //case IsCrossControl of // true: // MessgNotAgreeProps := MessgNotAgreeProps + AProperty1.Name+ ' '+cMain_Msg78+' '+AProperty2.Name; // false: // MessgNotAgreeProps := MessgNotAgreeProps + AProperty1.Name; //end; end; end; end; end;} function CheckComponControlProperties(AComponent1, AComponent2: TSCSComponent): Boolean; var i, j: Integer; ptrProperty1: PProperty; ptrProperty2: PProperty; CanContinue: Boolean; PropsIsAccordans: Boolean; IsCrossControl: Boolean; begin Result := true; for i := 0 to AComponent1.Properties.Count - 1 do begin ptrProperty1 := AComponent1.Properties[i]; CanContinue := false; if ((AConnectType = cntComplect) and (ptrProperty1.TakeIntoConnect = biTrue)) or ((AConnectType = cntUnion) and (ptrProperty1.TakeIntoJoin = biTrue)) then for j := 0 to AComponent2.Properties.Count - 1 do begin ptrProperty2 := AComponent2.Properties[j]; if Not CheckCanConnectProperties(ptrProperty1, ptrProperty2, AConnectType, CheckControlComplect, CheckControlJoin, false, @MessgNotAgreeProps) then if Result = true then begin Result := false; end; end; end; end; function CheckControlPropertiesForPointCompons(AComponent1, AComponent2: TSCSComponent): Boolean; var Compon1: TSCSComponent; Compon2: TSCSComponent; PointCompon1: TSCSComponent; PointCompon2: TSCSComponent; i, j: Integer; ptrProperty1: PProperty; ptrProperty2: PProperty; begin Result := true; //10.03.2009 Compon1 := nil; //10.03.2009 Compon2 := nil; //10.03.2009 Compon1 := GSCSBase.CurrProject.GetComponentFromReferences(AComponent1.ID); //10.03.2009 Compon2 := GSCSBase.CurrProject.GetComponentFromReferences(AComponent2.ID); Compon1 := AComponent1; Compon2 := AComponent2; if (Compon1 = nil) or (Compon2 = nil) then Exit; ///// EXIT ///// PointCompon1 := nil; PointCompon2 := nil; if (Compon1.IsLine = biFalse) and (Compon2.IsLine = biFalse) then begin PointCompon1 := Compon1; PointCompon2 := Compon2; end; if (Compon1.IsLine = biFalse) and (Compon2.IsLine = biTrue) then begin PointCompon1 := Compon1; PointCompon2 := Compon2.GetJoinedPointComponent; end; if (Compon1.IsLine = biTrue) and (Compon2.IsLine = biFalse) then begin PointCompon1 := Compon1.GetJoinedPointComponent; PointCompon2 := Compon2; end; if (Compon1.IsLine = biTrue) and (Compon2.IsLine = biTrue) then begin PointCompon1 := Compon1.GetJoinedPointComponent; PointCompon2 := Compon2.GetJoinedPointComponent; end; if (PointCompon1 <> nil) and (PointCompon2 <> nil) then begin //*** Найти свойства для контроля подключения точечных конечных компонент Result := CheckCanJoinEndComponsByProps(PointCompon1, PointCompon2, @MessgNotAgreeProps); //for i := 0 to PointCompon1.Properties.Count - 1 do //begin // ptrProperty1 := PointCompon1.Properties[i]; // if CanConnectControlByProperty(ptrProperty1, AConnectType, CheckControlComplect, CheckControlJoin) then // for j := 0 to PointCompon2.Properties.Count - 1 do // begin // ptrProperty2 := PointCompon2.Properties[j]; // if CanConnectControlByProperty(ptrProperty2, AConnectType, CheckControlComplect, CheckControlJoin) then // begin // //*** Если свойства определены как для контроля на конечных точечных компонентах // if (ptrProperty1.IsTakeJoinforPoint = biTrue) or // (ptrProperty2.IsTakeJoinforPoint = biTrue) then // if Not CheckCanConnectProperties(ptrProperty1, ptrProperty2, AConnectType, // CheckControlComplect, CheckControlJoin, @MessgNotAgreeProps) then // begin // if Result = true then // Result := false; // end; // end; // end; //end; end; end; function CheckProperties: Boolean; var i, j: Integer; ptrProperty1: PProperty; ptrProperty2: PProperty; CanContinue: Boolean; PropsIsAccordans: Boolean; IsCrossControl: Boolean; begin Result := true; CheckControlComplect := true; CheckControlJoin := true; if GDBMode = bkNormBase then begin CheckControlComplect := GSCSIni.NB.ControlComplectByProperties; CheckControlJoin := GSCSIni.NB.ControlJoinByProperties; end else if GDBMode = bkProjectManager then begin CheckControlComplect := GSCSBase.CurrProject.CurrList.Setting.ControlComplectByProperties; CheckControlJoin := GSCSBase.CurrProject.CurrList.Setting.ControlJoinByProperties; end; if ACompon1.Properties.Count = 0 then ACompon1.LoadProperties; if ACompon2.Properties.Count = 0 then ACompon2.LoadProperties; if CheckControlComplect or CheckControlJoin then begin //*** учесть контроль свойств на соединяемых компонентах if Not CheckComponControlProperties(ACompon1, ACompon2) then if Result = true then begin Result := false; end; //*** учесть контроль свойств на конечных подключенных компонентах if CheckControlJoin and (GDBMode = bkProjectManager) then if Not CheckControlPropertiesForPointCompons(ACompon1, ACompon2) then begin Result := false; end; end; {for i := 0 to ACompon1.Properties.Count - 1 do begin ptrProperty1 := ACompon1.Properties[i]; CanContinue := false; if ((AConnectType = cntComplect) and (ptrProperty1.TakeIntoConnect = biTrue)) or ((AConnectType = cntUnion) and (ptrProperty1.TakeIntoJoin = biTrue)) then for j := 0 to ACompon2.Properties.Count - 1 do begin ptrProperty2 := ACompon2.Properties[j]; PropsIsAccordans := false; IsCrossControl := false; if (ptrProperty1.ID_Property = ptrProperty2.ID_Property) and (ptrProperty1.IsCrossControl = biFalse) and (ptrProperty2.IsCrossControl = biFalse) then PropsIsAccordans := true else if ((ptrProperty1.IDCrossProperty = ptrProperty2.ID_Property) and (ptrProperty1.IsCrossControl = biTrue)) or ((ptrProperty2.IDCrossProperty = ptrProperty1.ID_Property) and (ptrProperty2.IsCrossControl = biTrue)) then begin PropsIsAccordans := true; IsCrossControl := true; end; //*** Если название свойств одинаковое if PropsIsAccordans then begin if (CheckControlComplect and (AConnectType = cntComplect) and (ptrProperty2.TakeIntoConnect = biTrue)) or (CheckControlJoin and (AConnectType = cntUnion) and (ptrProperty2.TakeIntoJoin = biTrue)) then if ptrProperty1.Value <> ptrProperty2.Value then begin if MessgNotAgreeProps <> '' then MessgNotAgreeProps := MessgNotAgreeProps + ', '; case IsCrossControl of true: MessgNotAgreeProps := MessgNotAgreeProps + ptrProperty1.Name+ ' с перекрестным свойством '+ptrProperty2.Name; false: MessgNotAgreeProps := MessgNotAgreeProps + ptrProperty1.Name; end; end; //CanContinue := true; Break; end; end; //if CanContinue then // Continue; end; } if MessgNotAgreeProps <> '' then MessgNotAgreeProps := MessgNotAgreeProps + '.'; if MessgNotAgreeProps <> '' then Result := false; end; //*** Контроль высоты в юнитах function ControlByHeightInUnits: Boolean; var ComponHeightU: Integer; ChildTotalHeightU: Integer; NewChildHeightU: integer; DeltaHeightU: integer; begin Result := true; //*** Контроль высоты в Юнитах для шкафа if (ACompon1.ComponentType.SysName = ctsnCupBoard) then begin if ACompon1.Properties.Count = 0 then ACompon1.LoadProperties; ComponHeightU := ACompon1.GetPropertyValueAsInteger(pnHeightInUnits); NewChildHeightU := ACompon2.GetPropertyValueAsInteger(pnHeightInUnits); if ACompon2.Count > 0 then NewChildHeightU := NewChildHeightU * ACompon2.Count; if (ComponHeightU > 0) and (NewChildHeightU > 0) then begin ChildTotalHeightU := GetComponChildsTotalHeihhtU(ACompon1, AIDCompRelToSkip); DeltaHeightU := ComponHeightU - (ChildTotalHeightU + NewChildHeightU); if DeltaHeightU < 0 then begin AddMsgItem(cMain_Msg152_1 + IntToStr(Abs(DeltaHeightU))+ ' '+cUnit); Result := false; end; end; end; end; begin Result := false; CanConnect := true; TextMsg := ''; MessgNotAgreeProps := ''; SCSList := nil; ControlJoinByNetType := false; ControlComplectByProducer := false; if GDBMode = bkProjectManager then SCSList := GSCSBase.CurrProject.CurrList; CanCheckObjOwner := false; if ACheckVariousObject then if (GDBMode = bkProjectManager) and (TF_Main(ACompon1.ActiveForm).GDBMode = bkProjectManager) and (TF_Main(ACompon2.ActiveForm).GDBMode = bkProjectManager) then CanCheckObjOwner := true; if AConnectType = cntComplect then begin TextMsg := cMain_Msg79_1+' "'+ACompon1.Name+'" '+cMain_Msg79_2+' "'+ACompon2.Name+'" '+cMain_Msg79_3+': '; CaptMsg := cMain_Msg79_4; if CanCheckObjOwner then if ACompon1.ObjectID <> ACompon2.ObjectID then AddMsgItem(cMain_Msg79_5_1); if ACompon1.ID = ACompon2.ID then AddMsgItem(cMain_Msg79_5_2); //*** Не намечается ли циклическая связь if CanCycleCompon(ACompon2.ID, ACompon1.ID) then AddMsgItem(cMain_Msg79_5_3); //*** Компонент и комплектующее не должны иметь разный тип if ACompon1.IsLine <> ACompon2.IsLine then begin if ( (ACompon1.ComponentType.SysName = ctsnCableChannelAccessory) or (ACompon2.ComponentType.SysName = ctsnCableChannelAccessory) or (ACompon1.ComponentType.SysName = ctsnAccessory) or (ACompon2.ComponentType.SysName = ctsnAccessory) ) and ( GCheckAccessory or (GDBMode = bkNormBase) ) then begin end else begin AddMsgItem(cMain_Msg79_5_4+': '+GetStrComponType(ACompon1)+'; '+GetStrComponType(ACompon2)); end; end; //*** Контроль по производителю case GDBMode of bkNormBase: ControlComplectByProducer := GSCSIni.NB.ComplectControlByProducer; bkProjectManager: if Assigned(SCSList) then ControlComplectByProducer := SCSList.Setting.ControlComplectByProducer; end; if ControlComplectByProducer then if ((ACompon1.ID_Producer > 0) and (ACompon2.ID_Producer > 0)) and (ACompon1.ID_Producer <> ACompon2.ID_Producer) then AddMsgItem(cMain_Msg79_5_5); //*** Запретить патч корд комплектовать в не Шкаф //if ACompon2.ComponentType.SysName = ctsnPatchCord then // if ACompon1.ComponentType.SysName <> ctsnCupboard then // AddMsgItem('Компонент "'+ACompon2.GetNameForVisible+'" может быть комплектующей в компоненте, системное имя типа которой "'+ctsnCupboard+'"(шкаф, стойка).'); //*** Контроль высоты в Юнитах для шкафа ControlByHeightInUnits; end; if AConnectType = cntUnion then begin TextMsg := cMain_Msg80_1+' "'+ACompon1.Name+'" '+cMain_Msg80_2+' "'+ACompon2.Name+'" '+cMain_Msg80_3+': '; CaptMsg := cMain_Msg80_4; if ACompon1.ActiveForm = ACompon2.ActiveForm then if (ACompon1.JoinedComponents.IndexOf(ACompon2) <> -1) and (ACompon1.GetTopComponent <> ACompon2.GetTopComponent) then //Если не внутрикомпонентное соединение AddMsgItem(cMain_Msg80_5_1); //01.07.2009 //*** Не соединять каб. канал с линейным компонентом //if ((ACompon1.ComponentType.SysName = ctsnCableChannel) and (ACompon2.IsLine = biTrue) and Not CheckHaveLineComponOnlyNoPairInterfaces(ACompon1)) or // ((ACompon2.ComponentType.SysName = ctsnCableChannel) and (ACompon1.IsLine = biTrue) and Not CheckHaveLineComponOnlyNoPairInterfaces(ACompon2)) then // Exit; //// EXIT //// //AddMsgItem('Кабельный канал не может соединяться'); //*** Не соединять каб. канал с линейным компонентом и с не ЭКК if ACompon1.ComponentType.SysName = ctsnCableChannel then if ((ACompon2.IsLine = biTrue) and Not CheckHaveLineComponOnlyNoPairInterfaces(ACompon1)) or ((ACompon2.IsLine = biFalse) and (ACompon2.ComponentType.SysName <> ctsnCableChannelElement)) then Exit; //// EXIT //// if ACompon2.ComponentType.SysName = ctsnCableChannel then if ((ACompon1.IsLine = biTrue) and Not CheckHaveLineComponOnlyNoPairInterfaces(ACompon2)) or ((ACompon1.IsLine = biFalse) and (ACompon1.ComponentType.SysName <> ctsnCableChannelElement)) then Exit; //// EXIT //// // Не соединять кабель с ЭКК if (IsCableComponent(ACompon1) and (ACompon2.ComponentType.SysName = ctsnCableChannelElement)) or (IsCableComponent(ACompon2) and (ACompon1.ComponentType.SysName = ctsnCableChannelElement)) then begin EmptyProcedure; Exit; //// EXIT //// end; if CanCheckObjOwner then if (ACompon1.ObjectID = ACompon2.ObjectID) and (ACompon1.IsLine = biTrue) and (ACompon2.IsLine = biTrue) then AddMsgItem(cMain_Msg80_5_2); //if (ACompon1.IsLine = ctLine) and (ACompon2.IsLine = ctLine) then // if ACompon1.GuidNB <> ACompon2.GuidNB then // AddMsgItem('Выбранные соединяемые компоненты имеют разный тип происхождения'); if ACompon1.ActiveForm = ACompon2.ActiveForm then if ACompon1.ID = ACompon2.ID then AddMsgItem(cMain_Msg80_5_3); //*** Соединяемые компоненты относятся к разным типам сети case GDBMode of bkNormBase: ControlJoinByNetType := GSCSIni.NB.ControlJoinByNetType; bkProjectManager: if Assigned(SCSList) then ControlJoinByNetType := SCSList.Setting.ControlJoinByNetType; end; if ControlJoinByNetType then if (ACompon1.GUIDNetType <> '') and (ACompon2.GUIDNetType <> '') and (ACompon1.GUIDNetType <> ACompon2.GUIDNetType) then AddMsgItem(cMain_Msg80_5_4); //*** Не м.б. соединения "мама-мама" вне внутрикомпонентного соединения if (ACompon1.isLine = ctConn) and (ACompon2.isLine = ctConn) then if Assigned(ACompon1.Parent) and Assigned(ACompon2.Parent) then begin //TopCompon1 := ACompon1.GetTopComponent; //TopCompon2 := ACompon2.GetTopComponent; //if (TopCompon1 <> TopCompon2) and (ACompon1.ActiveForm = ACompon2.ActiveForm) then // AddMsgItem('Подключяемые компоненты имеют точечный тип и находятся вне одной компоненты '); if (ACompon1.ObjectID <> ACompon1.ObjectID) and (ACompon1.ActiveForm = ACompon2.ActiveForm) then AddMsgItem(cMain_Msg80_5_5); //IDUpperCompon1 := DM.GetIDUpperComponByIDChild(ACompon1.ID); //IDUpperCompon2 := DM.GetIDUpperComponByIDChild(ACompon2.ID); //if (IDUpperCompon1 <> IDUpperCompon2) and (ACompon1.ActiveForm = ACompon2.ActiveForm) then // AddMsgItem('Подключемые компоненты имеют точечный тип и находятся вне одной компоненты '); end; //*** Не подключать демонтированный компонент if (ACompon1.IsDismount = biTrue) or (ACompon2.IsDismount = biTrue) then AddMsgItem(cMain_Msg80_5_6); end; if Not CheckProperties then AddMsgItem(cMain_Msg80_6+' (' + MessgNotAgreeProps+')'); if Not CanConnect then begin ShowMessageByType(0, AShowMessageType, TextMsg, CaptMsg, MB_ICONINFORMATION or MB_OK); end; Result := CanConnect; end; (* // ##### Проверяет на возможность соединения интерфейсов компоненты из "Менеджера проектов" // с комплектующей "Нормативной базы" ##### // *** Вернет количество свободных интерфейсов function TF_MAIN.CanConnComponByinterf(AFormBase: TForm; ACompon, ACompl: TSCSComponent; AConnectKind: TConnectkind; AConnectType: TConnectType; ATakeBusy: Boolean = false): TCanConnectKind; var InterfListCompon: TList; InterfListCompl: TList; InterfLists: TInterfLists; SCSCompon: TSCSComponent; SCSCompl: TSCSComponent; begin Result := cckNone; try //InterfListCompon := TList.Create; //InterfListCompl := TList.Create; InterfLists.InterfList1 := TList.Create; InterfLists.InterfList2 := TList.Create; //FillInterfList(InterfListCompon, AIDCompon, AConnectType); //TF_Main(AFormBase).FillInterfList(InterfListCompl, AIDCompl, AConnectType, ATakeBusy); //SCSCompon := TSCSComponent.Create(Self); //SCSCompl := TSCSComponent.Create(AFormBase); //SCSCompon.LoadComponentByID(AIDCompon, false); //SCSCompon.LoadInterfaces; //SCSCompl.LoadComponentByID(AIDCompl, false); //SCSCompl.LoadInterfaces; if (ACompon = nil) or (ACompl = nil) then Exit; //// EXIT //// SCSCompon := ACompon; SCSCompl := ACompl; if SCSCompon.Interfaces.Count = 0 then SCSCompon.LoadInterfaces(-1, false); if SCSCompl.Interfaces.Count = 0 then SCSCompl.LoadInterfaces(-1, false); Result := SynthesisInterf(SCSCompon, SCSCompl, InterfLists, AConnectKind, AConnectType); //if InterfLists.InterfList1.Count > 0 then // Result := true; //SCSCompon.Free; //SCSCompl.Free; //Freelist(InterfListCompon); //Freelist(InterfListCompl); //FreeList(InterfLists.InterfList1); //FreeList(InterfLists.InterfList2); FreeAndNil(InterfLists.InterfList1); FreeAndNil(InterfLists.InterfList2); except on E: Exception do AddExceptionToLog('TF_MAIN.CanConnComponByinterf: '+E.Message); end; end; *) { // ##### Проверяет возможно ли соединить интерфейсы ##### function TF_MAIN.CheckInterfForUnion(AInterf1, Ainterf2: TInterface; AConnectKinds: TConnectKind): TCheckInterfForUnionResult; var ContinueToCheck: Boolean; IDInterfStr1: String; IDInterfStr2: String; isMultiple1: Boolean; isMultiple2: Boolean; ColConn1: Integer; ColConn2: Integer; function GetisMultiple(AInterf: TInterface): Boolean; begin Result := false; //SetSQLToQuery(DM.scsQSelect, ' select multiple from interface_relation where id = '''+IntToStr(AInterfRel)+''' '); case AInterf.Multiple of 0: Result := false; 1: Result := true; end; end; function GetColConn(AInterfRel: Integer): Integer; var InterfRelStr: String; begin Result := 0; InterfRelStr := IntToStr(AInterfRel); SetSQLToQuery(DM.scsQSelect, ' select count(*) As Cnt from interfofinterf_relation '+ ' where (id_interf_rel = '''+InterfRelStr+''') or '+ ' (id_interf_to = '''+InterfRelStr+''') '); Result := DM.scsQSelect.FN('Count').AsInteger; end; function GetColConnWithNoMultiple(AInterfRel: integer): Integer; var InterfRelStr: String; PartSQL: String; begin Result := 0; PartSQL := ' in (select id from interface_relation where multiple = ''0'') '; InterfRelStr := IntToStr(AInterfRel); SetSQLToQuery(DM.scsQSelect, ' select count(*) As Cnt from interfofinterf_relation '+ ' where ((id_interf_rel = '''+InterfRelStr+''') and '+ ' (id_interf_to'+PartSQL+' ) ) or '+ ' ((id_interf_to = '''+InterfRelStr+''') and '+ ' (id_interf_rel'+PartSQL+' ) )'); Result := DM.scsQSelect.FN('Count').AsInteger; end; begin Result := chrFail; ContinueToCheck := true; IDInterfStr1 := IntToStr(AInterf1.ID); IDInterfStr2 := IntToStr(AInterf2.ID); //*** Проверить нет ли такого соединения SetSQLToQuery(DM.scsQSelect, ' select count(*) As Cnt from interfofinterf_relation '+ ' where ((id_interf_rel = '''+IDInterfStr1+''') and '+ ' (id_interf_to = '''+IDInterfStr2+''')) or '+ ' ((id_interf_to = '''+IDInterfStr1+''') and '+ ' (id_interf_rel = '''+IDInterfStr2+''')) '); if DM.scsQSelect.FN('Count').AsInteger > 0 then begin ContinueToCheck := false; Result := chrInterfConnected; end; if Ainterf1.ID_Interface <> Ainterf2.ID_Interface then begin ContinueToCheck := false; Result := chrFailInterfaces; end; if Not CheckGender(AInterf1.Gender, Ainterf2.Gender, AConnectKinds) then begin ContinueToCheck := false; Result := chrFailGenders; end; if Not ContinueToCheck then Exit; /////// EXIT //////// isMultiple1 := GetisMultiple(AInterf1); isMultiple2 := GetisMultiple(AInterf2); if isMultiple1 = isMultiple2 then begin ColConn1 := GetColConnWithNoMultiple(AInterf1.ID); ColConn2 := GetColConnWithNoMultiple(AInterf2.ID); if (ColConn1 = 0) and (ColConn2 = 0) then Result := chrSuccess else Result := chrSameMult; end; if isMultiple1 <> isMultiple2 then begin ColConn1 := GetColConn(AInterf1.ID); ColConn2 := GetColConn(AInterf2.ID); if (ColConn1 = 0) and (ColConn2 = 0) then Result := chrSuccess else Result := chrVariousMult; end; end; } procedure TF_MAIN.ShowCheckInterfForUnionResult( ACheckInterfForUnionResult: TCheckInterfForUnionResult); var MsgCaption: String; MsgText: String; begin if ACheckInterfForUnionResult <> chrSuccess then begin MsgCaption := cMain_Msg81_1; MsgText := cMain_Msg81_2+' '; case ACheckInterfForUnionResult of chrInterfConnected: MsgText := MsgText + #13 + ' - '+cMain_Msg81_3+' '; chrFailInterfaces: MsgText := MsgText + #13 + ' - '+cMain_Msg81_4+' '; chrFailGenders: MsgText := MsgText + #13 + ' - '+cMain_Msg81_5+' '; chrSameMult: MsgText := cMain_Msg81_6; chrVariousMult: MsgText := cMain_Msg81_7; end; MessageModal(MsgText, MsgCaption, MB_ICONINFORMATION or MB_OK); end; end; // ##### Соединяет 2-а интерфейса ##### function TF_MAIN.UnionInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AConnectKind: TConnectKind): Boolean; var CheckInterfForUnionResult: TCheckInterfForUnionResult; ConnInterfList1: TSCSInterfaces; ConnInterfList2: TSCSInterfaces; IDInterfRel: ^Integer; i, j: Integer; Interf1: TSCSInterface; Interf2: TSCSInterface; InterfCount1: Integer; InterfCount2: Integer; //IDCompon1: Integer; //IDCompon2: Integer; //IDCompRel: Integer; ptrCompRel: PComplect; Compon1: TSCSComponent; Compon2: TSCSComponent; EmptyPositions1: TSCSInterfPositions; EmptyPositions2: TSCSInterfPositions; begin Result := false; if GDBMode <> bkProjectManager then Exit; //// EXIT ///// if (AInterfRel1 = nil) or (AInterfRel2 = nil) then Exit; //// EXIT //// try if AInterfRel1.ID = AInterfRel2.ID then Exit; //// EXIT //// CheckInterfForUnionResult := CheckInterfForUnion(AInterfRel1, AInterfRel2, Self, Self, {AConnectKind,} cntUnion, nil, nil); if CheckInterfForUnionResult <> chrSuccess then begin Result := false; Exit; end; Compon1 := nil; Compon2 := nil; //*** Добавить соединенные //ConnInterfList1 := DM.GetConnectedIDInterfRels(AInterfRel1.ID); //ConnInterfList2 := DM.GetConnectedIDInterfRels(AInterfRel2.ID); ConnInterfList1 := TSCSInterfaces.Create(false); ConnInterfList2 := TSCSInterfaces.Create(false); ConnInterfList1.Add(AInterfRel1); ConnInterfList2.Add(AInterfRel2); ConnInterfList1.Assign(AInterfRel1.ConnectedInterfaces, laOr); ConnInterfList2.Assign(AInterfRel2.ConnectedInterfaces, laOr); for i := 0 to ConnInterfList1.Count - 1 do begin Interf1 := ConnInterfList1[i]; for j := 0 to ConnInterfList2.Count - 1 do begin Interf2 := ConnInterfList2[j]; if Interf2 <> nil then if Interf1.ID_Component <> Interf2.ID_Component then if CheckInterfForUnion(Interf1, Interf2, Self, Self, {cnkVarious or cnkMaleMale,} cntUnion, @InterfCount1, @InterfCount2) = chrSuccess then if Not Interf1.CheckJoinToComponent(Interf2.ComponentOwner) and Not Interf2.CheckJoinToComponent(Interf1.ComponentOwner) then begin EmptyPositions1 := Interf1.GetEmptyPositions; EmptyPositions2 := Interf2.GetEmptyPositions; if (EmptyPositions1.Kolvo > 0) and (EmptyPositions2.Kolvo > 0) then begin //IDCompRel := DM.GetIDCompRelByConnectCompons(Interf1.ID_Component, Interf2.ID_Component, cntUnion); Compon1 := Interf1.ComponentOwner; Compon2 := Interf2.ComponentOwner; ptrCompRel := Compon1.GetCompRelByConnectedCompon(Compon2, cntUnion); if ptrCompRel = nil then begin ptrCompRel := Compon1.JoinWithOnlyObject(Compon2); ptrCompRel.ID := GenCurrProjTableID(giComponentRelationID); F_ChoiceConnectSide.OnAfterJoinCompons(Compon1, Compon2, 0, 0); //IDCompRel := AppendToComponRel(Interf1.ID_Component, Interf2.ID_Component, 1, cntUnion); //Compon1 := GSCSBase.CurrProject.GetComponentFromReferences(Interf1.ID_Component); //Compon2 := GSCSBase.CurrProject.GetComponentFromReferences(Interf2.ID_Component); //if Assigned(Compon1) and Assigned(Compon2) then // Compon1.AddToJoined(Compon2); end; if ptrCompRel <> nil then begin RegroupInterfPositionsToConnect(EmptyPositions1, EmptyPositions2); ConnectInterfaces(Interf1, Interf2, ptrCompRel.ID, cntUnion, EmptyPositions1, EmptyPositions2, true); Result := true; end; end; FreeAndNil(EmptyPositions1); FreeAndNil(EmptyPositions2); end; end; end; FreeAndNil(ConnInterfList1); FreeAndNil(ConnInterfList2); //FreeList(ConnInterfList1); //FreeList(ConnInterfList2); except on E: Exception do AddExceptionToLog('TF_MAIN.UnionInterfaces: '+E.Message); end; end; (* function TF_MAIN.UnionInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AConnectKind: TConnectKind): Boolean; var CheckInterfForUnionResult: TCheckInterfForUnionResult; Compon1: TSCSComponent; Compon2: TSCSComponent; ConnInterfList1: TList; ConnInterfList2: TList; IDInterfRel: ^Integer; i, j: Integer; IDInterf1: Integer; IDInterf2: Integer; IDCompon1: Integer; IDCompon2: Integer; IDCompRel: Integer; Interface1: TInterface; Interface2: TInterface; ID_Comp1: Integer; ID_Comp2: Integer; function GetIDCompon(AID_Interf: Integer): Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select id_component from interface_relation '); Result := DM.scsQSelect.GetFNAsInteger('id_component'); end; procedure SelConnInterf(AField_from, AField_to: String; AIDInterf: Integer; AConnInterfList: TList); var IDInterfStr: String; begin IDInterfStr := IntToStr(AIDInterf); {SetSQLToQuery(DM.scsQSelect, ' select '+AField_to+' from interfofinterf_relation '+ ' where ('+AField_from+' = '''+ IDInterfStr +''') and '+ ' ('+AField_to+' in (select id from interface_relation '+ ' where (isBusy = ''0'') or (Multiple = ''1'') ) ) '); } SetSQLToQuery(DM.scsQSelect, ' select '+AField_to+' from interfofinterf_relation '+ ' where ('+AField_from+' = '''+ IDInterfStr +''') '); while Not DM.scsQSelect.Eof do begin New(IDInterfRel); IDInterfRel^ := DM.scsQSelect.GetFNAsInteger(AField_to); AConnInterfList.Add(IDInterfRel); DM.scsQSelect.Next; end; end; procedure FillConnInterfList(AIDInterf: Integer; AConnInterfList: TList); begin SelConnInterf('id_interf_rel', 'id_interf_to', AIDInterf, AConnInterfList); SelConnInterf('id_interf_to', 'id_interf_rel', AIDInterf, AConnInterfList); end; function GetIDComponByInterf(AIDInterf: Integer): Integer; begin Result := -1; SetSQLToQuery(DM.scsQSelect, ' select id_component from interface_relation '+ ' where id = '''+ IntToStr(AIDInterf) +''' '); Result := DM.scsQSelect.GetFNAsInteger('ID_Component'); end; function GetConnectCompRelID(AIDCompon1, AIDCompon2: Integer): Integer; var strIDComp1: String; strIDComp2: String; begin Result := 0; strIDComp1 := IntToStr(AIDCompon1); strIDComp2 := IntToStr(AIDCompon2); SetSQLToQuery(DM.scsQSelect, ' select id from component_relation '+ ' where ((id_component = '''+strIDComp1+''') and (id_child = '''+strIDComp2+''')) or '+ ' ((id_component = '''+strIDComp2+''') and (id_child = '''+strIDComp1+''')) '); if DM.scsQSelect.GetFNAsInteger('id') > 0 then Result := DM.scsQSelect.GetFNAsInteger('id'); end; begin Result := false; Compon1 := TSCSComponent.Create(Self); Compon2 := TSCSComponent.Create(Self); try try Compon1.LoadInterfaces(AInterfRel1); Compon2.LoadInterfaces(AInterfRel2); if AInterfRel1 = AInterfRel2 then Exit; //// EXIT //// CheckInterfForUnionResult := CheckInterfForUnion(TInterface(Compon1.Interfaces.Items[0]^), TInterface(Compon2.Interfaces.Items[0]^), AConnectKind); if CheckInterfForUnionResult <> chrSuccess then begin Result := false; Exit; end; //*** Добавить соединенные ConnInterfList1 := TList.Create; ConnInterfList2 := TList.Create; New(IDInterfRel); IDInterfRel^ := AInterfRel1; ConnInterfList1.Add(IDInterfRel); New(IDInterfRel); IDInterfRel^ := AInterfRel2; ConnInterfList2.Add(IDInterfRel); FillConnInterfList(AInterfRel1, ConnInterfList1); FillConnInterfList(AInterfRel2, ConnInterfList2); for i := 0 to ConnInterfList1.Count - 1 do begin IDInterf1 := Integer(ConnInterfList1.Items[i]^); IDCompon1 := GetIDComponByInterf(IDInterf1); for j := 0 to ConnInterfList2.Count - 1 do begin IDInterf2 := Integer(ConnInterfList2.Items[j]^); IDCompon2 := GetIDComponByInterf(IDInterf2); {ID_Comp1 := GetIDCompon(IDInterf1); ID_Comp2 := GetIDCompon(IDInterf2); if ID_Comp1 <> ID_Comp2 then} if IDCompon1 <> IDCompon2 then begin Interface1 := DM.GetInterfaceByID(IDInterf1); Interface2 := DM.GetInterfaceByID(IDInterf2); if CheckInterfForUnion(Interface1, Interface2, cnkVarious or cnkMaleMale) = chrSuccess then begin IDCompRel := GetConnectCompRelID(IDCompon1, IDCompon2); if IDCompRel = 0 then IDCompRel := AppendToComponRel(IDCompon1, IDCompon2, 1, cntUnion); ConnectInterfaces(@Interface1, @Interface2, IDCompRel, cntUnion); //ConnectInterfaces(IDInterf1, IDInterf2, IDCompRel, cntUnion); end; end; end; end; FreeList(ConnInterfList1); FreeList(ConnInterfList2); Result := true; except on E: Exception do AddExceptionToLog('TF_MAIN.UnionInterfaces: '+E.Message); end; finally Compon1.Free; Compon2.Free; end; end; *) function TF_Main.ConnectInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AIDCompRel: Integer; AConnectType: TConnectType; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; AIsFinalConnection: Boolean): TSCSIOfIRel; var ID_NeWCompl: Integer; SQLtxt: String; NewID: Integer; IOfIRel: TSCSIOfIRel; InterfPosConnection: TSCSInterfPosConnection; InterfPosition1: TSCSInterfPosition; InterfPosition2: TSCSInterfPosition; PositionsKolvo1: Integer; PositionsKolvo2: Integer; i: Integer; BusyinterfInNB: Boolean; begin //Result := true; Exit; Result := nil; IOfIRel := nil; BusyinterfInNB := false; try if AIDCompRel = -1 then ID_NeWCompl := GetLastCompRelID(GDBMode) + 1 else ID_NeWCompl := AIDCompRel; //*** Пометить интерфейсы как занятые if (GDBMode = bkNormBase) and AIsFinalConnection then if BusyinterfInNB then DM.UpdateInterfFieldAsInteger(AInterfRel1.ID, biTrue, fnIsBusy); if BusyinterfInNB then AInterfRel1.IsBusy := biTrue; if (GDBMode = bkProjectManager) or (AConnectType = cntUnion) then begin //DM.UpdateInterfFieldAsInteger(AInterfRel2.ID, biTrue, fnIsBusy); AInterfRel1.IsBusy := biTrue; AInterfRel2.IsBusy := biTrue; end; //*** Создать связь интерфейсов if GDBMode = bkNormBase then begin if AIsFinalConnection then begin NewID := DM.InsertToIOfIRel(AInterfRel1.ID, AInterfRel2.ID, ID_NeWCompl); end; IOfIRel := TSCSIOfIRel.Create(AInterfRel1); IOfIRel.ID := NewID; IOfIRel.IDInterfRel := AInterfRel1.ID; IOfIRel.IDInterfTo := AInterfRel2.ID; IOfIRel.IDCompRel := ID_NeWCompl; IOfIRel.InterfaceOwner := AInterfRel1; IOfIRel.InterfaceTo := AInterfRel2; AInterfRel1.IOfIRelOut.Add(IOfIRel); AInterfRel1.AddToConnectedInterfaces(AInterfRel2); AInterfRel2.AddToConnectedInterfaces(AInterfRel1); end; if GDBMode = bkProjectManager then begin IOfIRel := TSCSIOfIRel.Create(AInterfRel1); //ptrIOfIRel.ID := NewID; IOfIRel.IDInterfRel := AInterfRel1.ID; IOfIRel.IDInterfTo := AInterfRel2.ID; IOfIRel.IDCompRel := ID_NeWCompl; IOfIRel.InterfaceOwner := AInterfRel1; IOfIRel.InterfaceTo := AInterfRel2; AInterfRel1.IOfIRelOut.Add(IOfIRel); AInterfRel1.SaveIOfIRel(meMake, IOfIRel); AInterfRel1.AddToConnectedInterfaces(AInterfRel2); AInterfRel2.AddToConnectedInterfaces(AInterfRel1); { if (AInterfPositions1 <> nil) and (AInterfPositions2 <> nil) and (AInterfPositions1.Positions.Count = AInterfPositions2.Positions.Count) then begin PositionsKolvo1 := 0; PositionsKolvo2 := 0; for i := 0 to AInterfPositions1.Positions.Count - 1 do begin InterfPosition1 := TSCSInterfPosition(AInterfPositions1.Positions[i]); InterfPosition2 := TSCSInterfPosition(AInterfPositions2.Positions[i]); //*** Если позиции нулевые, то количество добавленных интерфейсов тоже нодь if (InterfPosition1.ToPos > 0) and (InterfPosition1.FromPos > 0) then PositionsKolvo1 := PositionsKolvo1 + (InterfPosition1.ToPos - (InterfPosition1.FromPos - 1)); if (InterfPosition2.ToPos > 0) and (InterfPosition2.FromPos > 0) then PositionsKolvo2 := PositionsKolvo2 + (InterfPosition2.ToPos - (InterfPosition2.FromPos - 1)); AInterfPositions1.Positions[i] := nil; AInterfPositions2.Positions[i] := nil; //AInterfPositions1.Kolvo := AInterfPositions1.Kolvo - (InterfPosition1.ToPos - (InterfPosition1.FromPos - 1)); //AInterfPositions2.Kolvo := AInterfPositions2.Kolvo - (InterfPosition2.ToPos - (InterfPosition2.FromPos - 1)); AInterfPositions1.Kolvo := AInterfPositions1.Kolvo - PositionsKolvo1; AInterfPositions2.Kolvo := AInterfPositions2.Kolvo - PositionsKolvo2; InterfPosConnection := TSCSInterfPosConnection.Create(IOfIRel, false); InterfPosConnection.ID := -1; InterfPosConnection.IDIOIRel := IOfIRel.ID; if AInterfRel1.ComponentOwner <> nil then if AInterfRel1.ComponentOwner.ProjectOwner <> nil then InterfPosConnection.ID := AInterfRel1.ComponentOwner.ProjectOwner.GenIDByGeneratorIndex(giInterfPosConnectionID); InterfPosConnection.SelfInterfPosition := InterfPosition1; InterfPosition1.InterfPosConnectionOwner := InterfPosConnection; InterfPosConnection.ConnInterfPosition := InterfPosition2; InterfPosition2.InterfPosConnectionOwner := InterfPosConnection; IOfIRel.PosConnections.Add(InterfPosConnection); //SetLinkToInterfPosConnection(InterfPosConnection, AInterfRel1, AInterfRel2); AInterfRel1.BusyPositions.Add(InterfPosition1); //InterfPosition1.InterfOwner := AInterfRel1; AInterfRel2.BusyPositions.Add(InterfPosition2); //InterfPosition2.InterfOwner := AInterfRel2; end; AInterfPositions1.Positions.Pack; AInterfPositions2.Positions.Pack; AInterfRel1.KolvoBusy := AInterfRel1.KolvoBusy + PositionsKolvo1; AInterfRel2.KolvoBusy := AInterfRel2.KolvoBusy + PositionsKolvo2; AInterfRel1.DefineIsBusy; AInterfRel2.DefineIsBusy; end else begin raise Exception.Create('Not coincidence Interface positions'); //InterfPosConnection: TSCSInterfPosConnection; //InterfPosition: PInterfPosition; end;} //if Assigned(AInterfRel1.ConnectedInterfaces) then // AInterfRel1.ConnectedInterfaces.Add(AInterfRel2); //if Assigned(AInterfRel2.ConnectedInterfaces) then // AInterfRel2.ConnectedInterfaces.Add(AInterfRel1); //AInterfRel2.IOfIRelIn.Add(AInterfRel1); { New(ptrIOfIRel); ptrIOfIRel.ID := NewID; ptrIOfIRel.IDInterfRel := AInterfRel2.ID; ptrIOfIRel.IDInterfTo := AInterfRel1.ID; ptrIOfIRel.IDCompRel := ID_NeWCompl; AInterfRel2.IOfIRel.Add(ptrIOfIRel); } end; if (AInterfPositions1 <> nil) and (AInterfPositions2 <> nil) and (AInterfPositions1.Positions.Count = AInterfPositions2.Positions.Count) then begin PositionsKolvo1 := 0; PositionsKolvo2 := 0; for i := 0 to AInterfPositions1.Positions.Count - 1 do begin InterfPosition1 := TSCSInterfPosition(AInterfPositions1.Positions[i]); InterfPosition2 := TSCSInterfPosition(AInterfPositions2.Positions[i]); //*** Если позиции нулевые, то количество добавленных интерфейсов тоже нодь if (InterfPosition1.ToPos > 0) and (InterfPosition1.FromPos > 0) then PositionsKolvo1 := PositionsKolvo1 + (InterfPosition1.ToPos - (InterfPosition1.FromPos - 1)); if (InterfPosition2.ToPos > 0) and (InterfPosition2.FromPos > 0) then PositionsKolvo2 := PositionsKolvo2 + (InterfPosition2.ToPos - (InterfPosition2.FromPos - 1)); AInterfPositions1.Positions[i] := nil; AInterfPositions2.Positions[i] := nil; //AInterfPositions1.Kolvo := AInterfPositions1.Kolvo - (InterfPosition1.ToPos - (InterfPosition1.FromPos - 1)); //AInterfPositions2.Kolvo := AInterfPositions2.Kolvo - (InterfPosition2.ToPos - (InterfPosition2.FromPos - 1)); AInterfPositions1.Kolvo := AInterfPositions1.Kolvo - PositionsKolvo1; AInterfPositions2.Kolvo := AInterfPositions2.Kolvo - PositionsKolvo2; InterfPosConnection := TSCSInterfPosConnection.Create(IOfIRel, false); InterfPosConnection.ID := -1; InterfPosConnection.IDIOIRel := IOfIRel.ID; if AInterfRel1.ComponentOwner <> nil then if AInterfRel1.ComponentOwner.ProjectOwner <> nil then InterfPosConnection.ID := AInterfRel1.ComponentOwner.ProjectOwner.GenIDByGeneratorIndex(giInterfPosConnectionID); InterfPosConnection.SelfInterfPosition := InterfPosition1; InterfPosition1.InterfPosConnectionOwner := InterfPosConnection; InterfPosConnection.ConnInterfPosition := InterfPosition2; InterfPosition2.InterfPosConnectionOwner := InterfPosConnection; IOfIRel.PosConnections.Add(InterfPosConnection); //SetLinkToInterfPosConnection(InterfPosConnection, AInterfRel1, AInterfRel2); AInterfRel1.BusyPositions.Add(InterfPosition1); //InterfPosition1.InterfOwner := AInterfRel1; AInterfRel2.BusyPositions.Add(InterfPosition2); //InterfPosition2.InterfOwner := AInterfRel2; end; AInterfPositions1.Positions.Pack; AInterfPositions2.Positions.Pack; AInterfRel1.KolvoBusy := AInterfRel1.KolvoBusy + PositionsKolvo1; AInterfRel2.KolvoBusy := AInterfRel2.KolvoBusy + PositionsKolvo2; AInterfRel1.DefineIsBusy; AInterfRel2.DefineIsBusy; end else begin if GDBMode = bkProjectManager then //Tolik 10/11/2021 -- добавить трубы в исключения //if (AInterfRel1.ComponentOwner = nil) or (AInterfRel1.ComponentOwner.ComponentType.SysName <> ctsnCableChannel) then if (AInterfRel1.ComponentOwner = nil) or ((AInterfRel1.ComponentOwner.ComponentType.SysName <> ctsnCableChannel) and (AInterfRel1.ComponentOwner.ComponentType.SysName <> ctsnTube)) then // //Tolik 08/02/2022 -- Roma translated/// // raise Exception.Create('Not coincidence Interface positions'); raise Exception.Create('Interface positions do not match'); //InterfPosConnection: TSCSInterfPosConnection; //InterfPosition: PInterfPosition; end; Result := IOfIRel; { if AIDCompRel = -1 then begin //SetSQLToQuery(DM.scsQSelect, ' SELECT * FROM GET_LAST_COMPLECT_ID '); //ID_NeWCompl := DM.scsQSelect.GetFNAsInteger('LASTID') + 1; //DM.scsQSelect.Close; ID_NeWCompl := GetLastCompRelID(GDBMode) + 1; end else ID_NeWCompl := AIDCompRel; //*** Пометить интерфейсы как занятые SQLtxt := 'update interface_relation set isbusy = ''1'' where id = :id '; ChangeSQLQuery(DM.scsQOperat, SQLTxt); DM.scsQOperat.SetParamAsInteger('id', AIDInterfRel1); DM.scsQOperat.ExecQuery; if (GDBMode = bkProjectManager) or (AConnectType = cntUnion) then begin DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', AIDInterfRel2); DM.scsQOperat.ExecQuery; end; //*** Создать связь интерфейсов SQLtxt := ' Insert into interfofinterf_relation(id_interf_rel, id_interf_to, id_comp_rel) '+ ' values(:id_interf_rel, :id_interf_to, :id_comp_rel) '; ChangeSQLQuery(DM.scsQOperat, SQLTxt); DM.scsQOperat.SetParamAsInteger('id_interf_rel', AIDInterfRel1); DM.scsQOperat.SetParamAsInteger('id_interf_to', AIDInterfRel2); DM.scsQOperat.SetParamAsInteger('id_Comp_rel', ID_NeWCompl); DM.scsQOperat.ExecQuery; DM.scsQOperat.Close; } except on E: Exception do AddExceptionToLog('TF_Main.ConnectInterfaces: '+E.Message); end; end; function TF_MAIN.ConnectInterfacesWithAccordance(AInterfRel1, AInterfRel2: TSCSInterface; AInterfCount1, AInterfCount2, AIDCompRel, AConnectType: Integer; AInterfPositions1, AInterfPositions2: TSCSInterfPositions; AIsFinalConnection: Boolean; AInterfList1, AInterfList2: TSCSInterfaces): Boolean; var SimpleInterface: TSCSInterface; // Простой интерфейс PartInterface: TSCSInterface; // Часть соответствующего интерфейса OtherPartinterface: TSCSinterface; SimpleInterfPositions: TSCSInterfPositions; SimpleInterfaceBusyPositions: TSCSInterfPositions; WorkSimpleInterfaceBusyPositions: TSCSInterfPositions; PartInterfPositions: TSCSInterfPositions; OtherPartInterfPositions: TSCSInterfPositions; InterfListWithOtherPart: TSCSInterfaces; SimpleInterfOldBusyListCount: Integer; SparePosCount: Integer; NewPosCount: Integer; //InterfPositions1Kolvo: Integer; //InterfPositions2Kolvo: Integer; SimpleInterfPositionKolvo: Integer; SimpleInterfaceBusyPosition: Integer; PartInterfPositionKolvo: Integer; OtherPartInterfPositionKolvo: Integer; OtherPartInterfPositionKolvoFirst: Integer; PrevPartInterfPositionKolvo: Integer; PrevOtherPartInterfPositionKolvo: Integer; AccordanceCount: Integer; OtherPartsCount: Integer; //*** Общее кол-во недостающих частей сложенного интерфейса MainIOfIRel: TSCSIOfIRel; PartIOfIRel: TSCSIOfIRel; CanWhile: Boolean; i: integer; begin //InterfPositions1Kolvo := AInterfPositions1.Kolvo; //InterfPositions2Kolvo := AInterfPositions2.Kolvo; if AInterfCount1 = AInterfCount2 then begin RegroupInterfPositionsToConnect(AInterfPositions1, AInterfPositions2); ConnectInterfaces(AInterfRel1, AInterfRel2, AIDCompRel, AConnectType, AInterfPositions1, AInterfPositions2, AIsFinalConnection); end else if (AInterfCount1 <> AInterfCount2) and (AInterfPositions1 <> nil) and (AInterfPositions2 <> nil) and (AInterfPositions1.Kolvo > 0) and (AInterfPositions2.Kolvo > 0) then begin SimpleInterface := nil; PartInterface := nil; SimpleInterfPositions := nil; PartInterfPositions := nil; InterfListWithOtherPart := nil; SimpleInterfPositionKolvo := 0; PartInterfPositionKolvo := 0; AccordanceCount := 0; OtherPartsCount := 0; if (AInterfCount1 = 1) and (AInterfCount2 > 1) then begin SimpleInterface := AInterfRel1; PartInterface := AInterfRel2; SimpleInterfPositions := AInterfPositions1; PartInterfPositions := AInterfPositions2; //SimpleInterfPositionKolvo := InterfPositions1Kolvo; //PartInterfPositionKolvo := InterfPositions2Kolvo; InterfListWithOtherPart := AInterfList2; AccordanceCount := AInterfCount2; end else if (AInterfCount1 > 1) and (AInterfCount2 = 1) then begin SimpleInterface := AInterfRel2; PartInterface := AInterfRel1; SimpleInterfPositions := AInterfPositions2; PartInterfPositions := AInterfPositions1; //SimpleInterfPositionKolvo := InterfPositions2Kolvo; //PartInterfPositionKolvo := InterfPositions1Kolvo; InterfListWithOtherPart := AInterfList1; AccordanceCount := AInterfCount1; end; if (SimpleInterface <> nil) and (PartInterface <> nil) then begin SimpleInterfaceBusyPositions := TSCSInterfPositions.Create; WorkSimpleInterfaceBusyPositions := TSCSInterfPositions.Create; //OtherPartsCount := (SimpleInterfPositionKolvo - SimpleInterfPositions.Kolvo) * AccordanceCount; //OtherPartsCount := SimpleInterfPositions.Kolvo * AccordanceCount; OtherPartsCount := AccordanceCount; // Убрать некратные позицци if PartInterfPositions.Kolvo > AccordanceCount then begin SparePosCount := (PartInterfPositions.Kolvo mod AccordanceCount); if SparePosCount > 0 then DecInterfPositionsKolvo(PartInterfPositions.Kolvo - SparePosCount, PartInterfPositions); end; if (SimpleInterfPositions.Kolvo > 1) and (PartInterfPositions.Kolvo > 1) then //if SimpleInterfPositions.Kolvo >= PartInterfPositions.Kolvo then if SimpleInterfPositions.Kolvo >= (PartInterfPositions.Kolvo div AccordanceCount) then begin NewPosCount := PartInterfPositions.Kolvo div AccordanceCount; if NewPosCount > 0 then begin DecInterfPositionsKolvo(NewPosCount, SimpleInterfPositions); OtherPartsCount := PartInterfPositions.Kolvo; end; end else OtherPartsCount := SimpleInterfPositions.Kolvo * AccordanceCount; RegroupInterfPositionsToConnect(SimpleInterfPositions, PartInterfPositions); //*** запомнить количества свобожных позиций SimpleInterfPositionKolvo := SimpleInterfPositions.Kolvo; PartInterfPositionKolvo := PartInterfPositions.Kolvo; PrevPartInterfPositionKolvo := PartInterfPositionKolvo; SimpleInterfOldBusyListCount := SimpleInterface.BusyPositions.Count; //*** Соединить сами интерфейсы MainIOfIRel := ConnectInterfaces(SimpleInterface, PartInterface, AIDCompRel, AConnectType, SimpleInterfPositions, PartInterfPositions, AIsFinalConnection); OtherPartsCount := OtherPartsCount - (PrevPartInterfPositionKolvo - PartInterfPositions.Kolvo); PrevPartInterfPositionKolvo := PartInterfPositions.Kolvo; //*** Отобрать толькочто занятые позиции простого интерфейса i := SimpleInterfOldBusyListCount; for i := i to SimpleInterface.BusyPositions.Count - 1 do SimpleInterfaceBusyPositions.Positions.Add(SimpleInterface.BusyPositions[i]); SimpleInterfaceBusyPositions.DefineKolvo; if OtherPartsCount > 0 then for i := 0 to InterfListWithOtherPart.Count - 1 do begin OtherPartinterface := InterfListWithOtherPart[i]; //if OtherPartinterface <> PartInterface then if OtherPartinterface.GUIDInterface = PartInterface.GUIDInterface then if (OtherPartinterface.Side = PartInterface.Side) and (OtherPartinterface.Multiple = PartInterface.Multiple) and (OtherPartinterface.TypeI = PartInterface.TypeI) and (OtherPartinterface.Gender = PartInterface.Gender) {and (OtherPartinterface.KolvoBusy = 0)} then //if CheckInterfForUnion(SimpleInterface, OtherPartinterface, SimpleInterface.ActiveForm, OtherPartinterface.ActiveForm, // ConnectKind, AConnectType, @InterfCount1, @InterfCount2) = chrSuccess then begin CanWhile := true; while CanWhile do begin CanWhile := false; OtherPartInterfPositions := OtherPartinterface.GetEmptyPositions; if OtherPartInterfPositions.Kolvo > 0 then begin OtherPartInterfPositionKolvoFirst := OtherPartInterfPositions.Kolvo; WorkSimpleInterfaceBusyPositions.Assign(SimpleInterfaceBusyPositions, true); RegroupInterfPositionsToConnect(WorkSimpleInterfaceBusyPositions, OtherPartInterfPositions); //*** позиции были добавлены в занятые выше WorkSimpleInterfaceBusyPositions.ZeroPositions; OtherPartInterfPositionKolvo := OtherPartInterfPositions.Kolvo; PrevOtherPartInterfPositionKolvo := OtherPartInterfPositionKolvo; ////*** Здесь первым должен быть OtherPartinterface //ConnectInterfaces(OtherPartinterface, SimpleInterface, AIDCompRel, // AConnectType, OtherPartInterfPositions, WorkSimpleInterfaceBusyPositions, AIsFinalConnection); PartIOfIRel := ConnectInterfaces(SimpleInterface, OtherPartinterface, AIDCompRel, AConnectType, WorkSimpleInterfaceBusyPositions, OtherPartInterfPositions, AIsFinalConnection); if (MainIOfIRel <> nil) and (PartIOfIRel <> nil) then PartIOfIRel.IDIOFIRelMain := MainIOfIRel.ID; OtherPartsCount := OtherPartsCount - (PrevOtherPartInterfPositionKolvo - OtherPartInterfPositions.Kolvo); if OtherPartsCount <= 0 then Break //// BREAK //// else //*** Если заняты не все соотв-е интф-сы и еще остались свободные позиции на сложенном интерфейсе if (OtherPartInterfPositionKolvoFirst - OtherPartInterfPositionKolvo) > 0 then CanWhile := true; end; FreeAndNil(OtherPartInterfPositions); end; if OtherPartsCount <= 0 then Break; //// BREAK //// end; end; FreeAndNil(WorkSimpleInterfaceBusyPositions); //*** Не удалять занятые позиции SimpleInterfaceBusyPositions.Positions.OwnsObjects := false; SimpleInterfaceBusyPositions.Positions.Clear; FreeAndNil(SimpleInterfaceBusyPositions); end; end; end; procedure TF_MAIN.FreeCompRel(AIDCompRel: Integer; ACompon, AChild: TSCSComponent); var strIDCompRel: String; //strProjManFields: String; //strProjManWhere: String; HaveMultipleInterfaces: Boolean; i: integer; InterfListForNoBusy: TSCSInterfaces; ptrInterfToEmpty: TSCSInterface; ptrConnectedInterf: TSCSInterface; SCSComponent: TSCSComponent; IOfIRelList: TList; procedure FillIOfIRel(ASCSComponent: TSCSComponent); var SCSInterface: TSCSInterface; IofIRel: TSCSIOfIRel; i, j: Integer; begin for i := 0 to ASCSComponent.Interfaces.Count - 1 do begin SCSInterface := TSCSInterface(ASCSComponent.Interfaces[i]); //22.01.2013 SCSComponent.Interfaces[j]; for j := 0 to SCSInterface.IOfIRelOut.Count - 1 do begin IofIRel := TSCSIOfIRel(SCSInterface.IOfIRelOut[j]); if IofIRel.IDCompRel = AIDCompRel then IOfIRelList.Add(IofIRel); end; end; end; begin InterfListForNoBusy := nil; try try strIDCompRel := IntToStr(AIDCompRel); //strProjManFields := ''; //strProjManWhere := ''; IOfIRelList := nil; if GDBMode = bkProjectManager then begin //22.01.2013 IOfIRelList := GSCSBase.CurrProject.GetIOfIRelsByIDCompRel(AIDCompRel); IOfIRelList := TList.Create;//22.01.2013 FillIOfIRel(ACompon); FillIOfIRel(AChild); if IOfIRelList.Count = 0 then EmptyProcedure; end; HaveMultipleInterfaces := DM.HaveCompRelConnectingWithMultipleInterfaces(AIDCompRel, IOfIRelList); if Not HaveMultipleInterfaces then InterfListForNoBusy := DM.GetInterfacesThatInConnection(AIDCompRel, IOfIRelList); DM.DeleteIOfIRelByIDCompRel(AIDCompRel, IOfIRelList); if IOfIRelList <> nil then FreeAndNil(IOfIRelList);//22.01.2013 // Tolik --21/05/2018 -- if InterfListForNoBusy <> nil then FreeAndNil(InterfListForNoBusy); // if HaveMultipleInterfaces then InterfListForNoBusy := DM.GetInterfacesThatMayBeNoBusy; if GDBMode = bkNormBase then DM.DeleteCompRelByID(AIDCompRel); //*** Освождение интерфейсов if InterfListForNoBusy <> nil then for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterfToEmpty := InterfListForNoBusy[i]; if GDBMode = bkNormBase then DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.ID, biFalse, fnIsBusy); if GDBMode = bkProjectManager then begin ptrInterfToEmpty.DefineIsBusy; //ptrInterfToEmpty.IsBusy := biFalse; //ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(ptrInterfToEmpty.ID, ptrInterfToEmpty.ID_Component); //if ptrInterfToEmpty <> nil then // ptrInterfToEmpty.IsBusy := biFalse; end; end; //*** Освободить указатели на присоединенные порты if GDBMode = bkProjectManager then if InterfListForNoBusy <> nil then for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterfToEmpty := InterfListForNoBusy[i]; //ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(ptrInterfToEmpty.ID, ptrInterfToEmpty.ID_Component); if ptrInterfToEmpty <> nil then if ptrInterfToEmpty.IDConnected > 0 then begin //DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.ID, 0, fnIDConnected); //DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.IDConnected, 0, fnIDConnected); ptrConnectedInterf := GSCSBase.CurrProject.GetInterfaceByID(ptrInterfToEmpty.IDConnected); ptrInterfToEmpty.IDConnected := 0; if ptrConnectedInterf <> nil then ptrConnectedInterf.IDConnected := 0; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.FreeCompRel: '+E.Message); end; finally if InterfListForNoBusy <> nil then InterfListForNoBusy.Free; //FreeList(InterfListForNoBusy); end; end; (* procedure TF_MAIN.FreeCompRel(ACompRel, AIDCompon, AIDChild: Integer); var strIDCompRel: String; //strProjManFields: String; //strProjManWhere: String; HaveMultipleInterfaces: Boolean; i: integer; InterfListForNoBusy: TSCSInterfaces; ptrInterfToEmpty: TSCSInterface; ptrConnectedInterf: TSCSInterface; begin try try InterfListForNoBusy := nil; strIDCompRel := IntToStr(ACompRel); //strProjManFields := ''; //strProjManWhere := ''; HaveMultipleInterfaces := DM.HaveCompRelConnectingWithMultipleInterfaces(ACompRel); if Not HaveMultipleInterfaces then InterfListForNoBusy := DM.GetInterfacesThatInConnection(ACompRel); DM.DeleteIOfIRelByFilter('ID_Comp_Rel = '''+ strIDCompRel +''''); if HaveMultipleInterfaces then InterfListForNoBusy := DM.GetInterfacesThatMayBeNoBusy; DM.DeleteCompRelByFilter('id = '''+strIDCompRel+''''); //*** Освождение интерфейсов if InterfListForNoBusy <> nil then for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterfToEmpty := InterfListForNoBusy[i]; DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.ID, biFalse, fnIsBusy); if GDBMode = bkProjectManager then begin ptrInterfToEmpty.IsBusy := biFalse; //ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(ptrInterfToEmpty.ID, ptrInterfToEmpty.ID_Component); //if ptrInterfToEmpty <> nil then // ptrInterfToEmpty.IsBusy := biFalse; end; end; //*** Освободить указатели на присоединенные порты if GDBMode = bkProjectManager then if InterfListForNoBusy <> nil then for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterfToEmpty := InterfListForNoBusy[i]; //ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(ptrInterfToEmpty.ID, ptrInterfToEmpty.ID_Component); if ptrInterfToEmpty <> nil then if ptrInterfToEmpty.IDConnected > 0 then begin DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.ID, 0, fnIDConnected); DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.IDConnected, 0, fnIDConnected); ptrConnectedInterf := GSCSBase.CurrProject.GetInterfaceByID(ptrInterfToEmpty.IDConnected); ptrInterfToEmpty.IDConnected := 0; if ptrConnectedInterf <> nil then ptrConnectedInterf.IDConnected := 0; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.FreeCompRel: '+E.Message); end; finally InterfListForNoBusy.Free; //FreeList(InterfListForNoBusy); end; end; *) (* // ##### Удаляет свзя интерф-в для соединения, ##### procedure TF_MAIN.FreeCompRel(ACompRel: Integer); var strIDCompRel: String; strProjManFields: String; strProjManWhere: String; HaveMultipleInterfaces: Boolean; i: integer; InterfListForNoBusy: TList; ptrInterf: TSCSInterface; procedure FillListWithInterfforNoBusy(AQuery: TSCSQuery); begin while Not AQuery.Eof do begin New(ptrInterf); ptrInterf.ID := AQuery.GetFNAsInteger('id'); if GDBMode = bkProjectManager then ptrInterf.IDConnected := AQuery.GetFNAsInteger('id_connected'); InterfListForNoBusy.Add(ptrInterf); AQuery.Next; end; end; begin try try InterfListForNoBusy := TList.Create; strIDCompRel := IntToStr(ACompRel); strProjManFields := ''; strProjManWhere := ''; if GDBMode = bkProjectManager then begin strProjManFields := ', id_connected '; //', id_connected = ''0'' '; //strProjManWhere end; //*** Узнать Есть ли многократные интерфейсы SetSQLToQuery(DM.scsQ, ' select count(interface_relation.id) As Cnt from interface_relation, interfofinterf_relation '+ ' where (multiple = '''+IntToStr(biTrue)+''') and '+ ' (typei = '''+IntToStr(itFunctional)+''') and '+ ' (isbusy = '''+IntToStr(biTrue)+''') and '+ ' (id_comp_rel = '''+strIDCompRel+''') and '+ ' ((interface_relation.id = id_interf_rel) or '+ ' (interface_relation.id = id_interf_to)) '); { ' ((id in (select id_interf_rel from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) or '+ ' (id in (select id_interf_to from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) )' ); } HaveMultipleInterfaces := false; if DM.scsQ.GetFNAsInteger('Cnt') > 0 then HaveMultipleInterfaces := true; { if Not HaveMultipleInterfaces then SetSQLToQuery(DM.scsQOperat, ' update interface_relation set isbusy = ''0'' ' + ' where (isbusy = '''+IntToStr(biTrue)+''') and '+ ' ((id in (select id_interf_rel from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) or '+ ' (id in (select id_interf_to from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) ) '); SetSQlToQuery(DM.scsQOperat, ' DELETE FROM INTERFOFINTERF_RELATION ' + ' WHERE ID_Comp_Rel = '''+ strIDCompRel +''' '); if HaveMultipleInterfaces then SetSQlToQuery(DM.scsQOperat, ' update interface_relation set isbusy = ''0'' '+ ' where (isbusy = ''1'') and (TypeI = '''+IntToStr(itFunctional)+''') and '+ ' Not( id in (select id_interf_rel from interfofinterf_relation)) and '+ ' Not( id in (select id_interf_to from interfofinterf_relation)) '); SetSQlToQuery(DM.scsQOperat, ' delete from component_relation where id = '''+strIDCompRel+''' '); } if Not HaveMultipleInterfaces then begin SetSQLToQuery(DM.scsQSelect, ' select id '+strProjManFields+' from interface_relation ' + ' where (isbusy = '''+IntToStr(biTrue)+''') and '+ ' ((id in (select id_interf_rel from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) or '+ ' (id in (select id_interf_to from interfofinterf_relation '+ ' where id_comp_rel = '''+strIDCompRel+''') ) ) '); FillListWithInterfforNoBusy(DM.scsQSelect); end; SetSQlToQuery(DM.scsQOperat, ' DELETE FROM INTERFOFINTERF_RELATION ' + ' WHERE ID_Comp_Rel = '''+ strIDCompRel +''' '); if HaveMultipleInterfaces then begin SetSQlToQuery(DM.scsQSelect, ' select id '+strProjManFields+' from interface_relation '+ ' where (isbusy = ''1'') and (TypeI = '''+IntToStr(itFunctional)+''') and '+ ' Not( id in (select id_interf_rel from interfofinterf_relation)) and '+ ' Not( id in (select id_interf_to from interfofinterf_relation)) '); FillListWithInterfforNoBusy(DM.scsQSelect); end; SetSQlToQuery(DM.scsQOperat, ' delete from component_relation where id = '''+strIDCompRel+''' '); {//*** Загрузка интерфейсов для освобождения в список while Not DM.scsQSelect.Eof do begin New(ptrInterf); ptrInterf.ID := DM.scsQSelect.FN('id').AsInteger; if GDBMode = bkProjectManager then ptrInterf.IDConnected := DM.scsQSelect.FN('id_connected').AsInteger; InterfListForNoBusy.Add(ptrInterf); DM.scsQSelect.Next; end; } //*** Освождение интерфейсов ChangeSQLQuery(DM.scsQOperat, ' update interface_relation set isbusy = ''0'' where id = :id '); for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterf := InterfListForNoBusy[i]; DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', ptrInterf.ID); DM.scsQOperat.ExecQuery; end; //*** Освободить указатели на присоединенные порты if GDBMode = bkProjectManager then begin ChangeSQLQuery(DM.scsQOperat, ' update interface_relation set id_connected = ''0'' where id = :id '); for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterf := InterfListForNoBusy[i]; if ptrInterf.IDConnected > 0 then begin DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', ptrInterf.ID); DM.scsQOperat.ExecQuery; DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', ptrInterf.IDConnected); DM.scsQOperat.ExecQuery; end; end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.FreeCompRel: '+E.Message); end; finally FreeList(InterfListForNoBusy); end; end; *) procedure TF_MAIN.LoadCompRelPathIDsToListFromNode(APathList: TIntList; AIDTopCompon: Integer; ANode: TTreeNode); var CurrNode: TTreeNode; Dat: PObjectData; PathID: TIntList; begin try if PObjectData(ANode.Data).ComponKind = ckCompl then begin CurrNode := ANode.Parent; PathID := TIntList.Create; while CurrNode <> nil do begin Dat := CurrNode.Data; if IsComponentNode(CurrNode) then begin if Dat.ObjectID = AIDTopCompon then begin APathList.Assign(PathID, laCopy); Break; //// BREAK //// end else if Dat.ComponKind = ckCompl then PathID.Add(Dat.ID_CompRel); end else Break; //// BREAK //// CurrNode := CurrNode.Parent; end; FreeAndNil(PathID); end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.LoadCompRelPathIDsToListFromNode', E.Message); end; end; // ##### Розсоединяет интерфейсы ##### function TF_MAIN.DisconnectInterfaces(AIDInterfRel1, AIDInterfRel2, AIDCompRel: Integer): Boolean; var IDCompRel: Integer; strIDInterfRel1: String; strIDInterfRel2: String; strIDCompRel: String; sqlWhere: String; begin Result := false; strIDInterfRel1 := IntToStr(AIDInterfRel1); strIDInterfRel2 := IntToStr(AIDInterfRel2); sqlWhere := ' where ((id_interf_rel = '''+strIDInterfRel1+''') and (id_interf_to = '''+strIDInterfRel2+''')) or '+ ' ((id_interf_rel = '''+strIDInterfRel2+''') and (id_interf_to = '''+strIDInterfRel1+''')) '; if AIDCompRel <> -1 then IDCompRel := AIDCompRel else begin SetSQLToQuery(DM.scsQSelect, ' select id_comp_rel from interfofinterf_relation '+ sqlWhere); IDCompRel := DM.scsQSelect.GetFNAsInteger('id_comp_rel'); end; if IDCompRel > 0 then begin strIDCompRel := IntToStr(IDCompRel); SetSQLToQuery(DM.scsQOperat, ' delete from interfofinterf_relation ' + sqlWhere); SetSQLToQuery(DM.scsQOperat, ' update interface_relation set isbusy = ''0'' '+ ' where Not( id in (select id_interf_rel from interfofinterf_relation)) and '+ ' Not( id in (select id_interf_to from interfofinterf_relation)) '); //*** Определить остались ли свзи интерейсов для IDCompRel, если нет, //*** то удалять соединение компонентов по IDCompRel SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from interfofinterf_relation where id_comp_rel = ''' +strIDCompRel+ ''' '); if DM.scsQSelect.GetFNAsInteger('Cnt') = 0 then SetSQLToQuery(DM.scsQOperat, ' delete from component_relation where id = '''+strIDCompRel+''' '); Result := true; end; end; (* // ##### Соединение интерфейсов ##### function TF_MAIN.ConnectCompons(ACompon1, ACompon2: TSCSComponent; AConnectKind: TConnectKind; AConnectType: TConnectType; AID_CompRel: Integer = -1): Boolean; var InterfList1: TList; InterfList2: TList; InterfLists: TInterfLists; InterfaceRelData: TSCSInterface; InterfTo: TSCSInterface; InterfFrom: TSCSInterface; IDInterfFrom: Integer; IDInterfTo: Integer; //SCSCompon1: TSCSComponent; //SCSCompon2: TSCSComponent; i: Integer; ID_NeWCompl: Integer; CanConnectKind: TCanConnectKind; begin Result := false; if (Not Assigned(ACompon1)) or (Not Assigned(ACompon2)) then Exit; //InterfList1 := TList.Create; //InterfList2 := TList.Create; InterfLists.InterfList1 := TList.Create; InterfLists.InterfList2 := TList.Create; if AID_CompRel = -1 then begin //SetSQLToQuery(DM.scsQ, ' SELECT * FROM GET_LAST_COMPLECT_ID '); //ID_NeWCompl := DM.scsQ.GetFNAsInteger('LASTID') + 1; ID_NeWCompl := GetLastCompRelID(GDBMode) + 1; end else ID_NeWCompl := AID_CompRel; //FillInterfList(InterfList1, AIDCompon1, AConnectType); //FillInterfList(InterfList2, AIDCompon2, AConnectType); { SCSCompon1 := TSCSComponent.Create(Self); SCSCompon2 := TSCSComponent.Create(Self); SCSCompon1.LoadComponentByID(AIDCompon1, false); SCSCompon1.LoadInterfaces; SCSCompon2.LoadComponentByID(AIDCompon2, false); SCSCompon2.LoadInterfaces; CanConnectKind := SynthesisInterf(SCSCompon1, SCSCompon2, InterfLists, AConnectKind, AConnectType); SCSCompon1.Free; SCSCompon2.Free; //Freelist(InterfList1); //Freelist(InterfList2); } if ACompon1.Interfaces.Count = 0 then ACompon1.LoadInterfaces; if ACompon2.Interfaces.Count = 0 then ACompon2.LoadInterfaces; CanConnectKind := SynthesisInterf(ACompon1, ACompon2, InterfLists, AConnectKind, AConnectType); if (CanConnectKind = cckAuto) and (InterfLists.InterfList1.Count > 0) and (InterfLists.InterfList1.Count > 0) then begin for i := 0 to InterfLists.InterfList1.Count - 1 do begin {InterfaceRelData := InterfLists.InterfList1.Items[i]; IDInterfFrom := InterfaceRelData.ID; InterfaceRelData := InterfLists.InterfList2.Items[i]; IDInterfTo := InterfaceRelData.ID; } InterfFrom := InterfLists.InterfList1.Items[i]; InterfTo := InterfLists.InterfList2.Items[i]; ConnectInterfaces(InterfFrom, InterfTo, ID_NeWCompl, AConnectType, nil, nil); end; Result := true; end; //FreeList(InterfLists.InterfList1); //FreeList(InterfLists.InterfList2); FreeAndNil(InterfLists.InterfList1); FreeAndNil(InterfLists.InterfList2); end; function TF_Main.SynthesisInterf(ACompon1, ACompon2: TSCSComponent; AInterfLists: TInterfLists; AConnectKind: TConnectKind; AConnectType: TConnectType): TCanConnectKind; var Res: TCanConnectKind; i, j: Integer; InterfRel1: TSCSInterface; InterfRel2: TSCSInterface; InterfRel: TSCSInterface; //IOfIRel: PIOfIRel; AddedInterf1: TList; AddedInterf2: TList; isLine1: Integer; isLine2: Integer; //ConnectedInterfacesValues: Double; //*** Сумма значений подсоединенных интерфейсов CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; CableCanalFullnessKoef: Double; function CanInterfToConnect(AInterface: TSCSInterface; AIsLineCompon: Integer): Boolean; begin Result := false; {case AIsLineCompon of biTrue: case AConnectType of cntComplect: if AInterface.TypeI = itConstructive then Result := True; cntUnion: if (AInterface.IsBusy = biFalse) or (AInterface.Multiple = biTrue) then Result := true; end; biFalse: if AInterface.IsBusy = biFalse then Result := true; end;} case AConnectType of cntComplect: //if AInterface.TypeI = itConstructive then if AInterface.IsBusy = biFalse then Result := True; cntUnion: if AInterface.TypeI = itFunctional then if (AInterface.IsBusy = biFalse) or (AInterface.Multiple = biTrue) then Result := true; end; {if AInterface.TypeI = itFunctional then if (AInterface.IsBusy = biFalse) or ((AInterface.Multiple = biTrue ) and (AConnectType = cntUnion) ) then Result := true; } end; function CheckForAdded(AIDInterfRel: Integer; AAddedList: TList): Boolean; var i: Integer; begin Result := true; for i := 0 to AAddedList.Count - 1 do if Integer(AAddedList.Items[i]^) = AIDInterfRel then begin Result := false; Break; end; end; procedure SignAsAdded(AIDInterfRel: Integer; AAddedList: TList); var IDInterf: ^Integer; begin New(IDInterf); IDInterf^ := AIDInterfRel; AAddedList.Add(IDInterf); end; //***************** ф-ции для разделения на стороны ******************** //*** Вернент кол-во интерфейсов компоненты function GetCountInterfFromCompon(AID_Component, AID_Interface: Integer): Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from interface_relation '+ ' where (id_component = '''+IntToStr(AID_Component)+''') and '+ ' (id_interface = '''+IntToStr(AID_Interface)+''') '); Result := DM.scsQSelect.GetFNAsInteger('Cnt'); end; function GetCountInterfFromConnectList(AConnList: Tlist; AID_Interface: Integer): Integer; var i: Integer; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to AConnList.Count - 1 do if TSCSInterface(AConnList.Items[i]).ID_Interface = AID_Interface then ResCount := ResCount + 1; Result := ResCount; end; procedure RemoveInterfacesFromList(AConnList, AParallelList: TList; AID_Interface, ARemoveCount: Integer); var i: Integer; RemoveCount: Integer; ListDelPos: TList; DelPos: ^Integer; begin RemoveCount := ARemoveCount; ListDelPos := TList.Create; //*** Выбрать удаляемыепозиции из списка for i := 0 to AConnList.Count - 1 do if TSCSInterface(AConnList.Items[i]).ID_INTERFACE = AID_Interface then begin New(DelPos); Delpos^ := i; ListDelPos.Add(DelPos); RemoveCount := RemoveCount - 1; if RemoveCount = 0 then Break; end; //*** Удалить интерфейсы из списка for i := 0 to ListDelPos.Count - 1 do begin Delpos := ListDelPos.Items[i]; AConnList.Delete(Delpos^); AParallelList.Delete(Delpos^); end; FreeList(ListDelPos); end; begin Result := cckNone; Res := cckNone; CableCanalFullnessKoef := 80; if Assigned(GSCSBase.CurrProject) then if GSCSBase.CurrProject.Active then if Assigned(GSCSBase.CurrProject.CurrList) then CableCanalFullnessKoef := GSCSBase.CurrProject.CurrList.Setting.CableCanalFullnessKoef; //*** Если соединение, или добавление компл-й в не линейный компонент if (AConnectType = cntUnion) or ((AConnectType = cntComplect) and (ACompon1.IsLine <> ctLine) and (ACompon2.IsLine <> ctLine)) then begin AddedInterf1 := TList.Create; AddedInterf2 := TList.Create; for i := 0 to ACompon1.Interfaces.Count - 1 do begin InterfRel1 := ACompon1.Interfaces.Items[i]; if CanInterfToConnect(InterfRel1, ACompon1.IsLine) then for j := 0 to ACompon2.Interfaces.Count - 1 do begin InterfRel2 := ACompon2.Interfaces.Items[j]; if CanInterfToConnect(InterfRel2, ACompon2.IsLine) then if CheckForAdded(InterfRel1.ID, AddedInterf1) and CheckForAdded(InterfRel2.ID, AddedInterf2) then if CheckInterf(InterfRel1, InterfRel2, AConnectType) and (CheckGender(InterfRel1.GENDER, InterfRel2.GENDER, AConnectKind)) then begin { New(InterfRel); InterfRel^ := InterfRel1^; AInterfLists.InterfList1.Add(InterfRel); New(InterfRel); InterfRel^ := InterfRel2^; AInterfLists.InterfList2.Add(InterfRel); } AInterfLists.InterfList1.Add(InterfRel1); AInterfLists.InterfList2.Add(InterfRel2); //*** Добавить в списки добавленных SignAsAdded(InterfRel1.ID, AddedInterf1); SignAsAdded(InterfRel2.ID, AddedInterf2); Break; end; end; end; //*** Формирование окончательных результатов if AInterfLists.InterfList1.Count = 0 then Res := cckNone else begin if (ACompon1.IsLine <> ctLine) and (ACompon2.IsLine <> ctLine) then Res := cckAuto else begin if ACompon1.IsLine = ctLine then Res := cckManual; if (ACompon2.IsLine = ctLine) {and (Res <> cckManual)} then Res := cckManual; end; end; Result := Res; FreeList(AddedInterf1); FreeList(AddedInterf2); end; //******************** //*** Если в линейный компонент добавляеться комплектующее if AConnectType = cntComplect then if (ACompon1.IsLine = ctLine) and (ACompon1.IsLine = ctLine) then begin for i := 0 to ACompon1.Interfaces.Count - 1 do begin InterfRel1 := ACompon1.Interfaces.Items[i]; if (InterfRel1.TypeI = itConstructive) and (InterfRel1.Gender = gtFemale) then for j := 0 to ACompon2.Interfaces.Count - 1 do begin InterfRel2 := ACompon2.Interfaces.Items[j]; if (InterfRel2.TypeI = itConstructive) and (InterfRel2.Gender = gtMale) then begin //ConnectedInterfacesValues := DM.GetConnectedInterfacesValues(DM.scsQSelect, InterfRel1.ID); //if InterfRel1.ValueI - ConnectedInterfacesValues - InterfRel2.ValueI >= 0 then CanFemaleHaveMaleRes := CanFemaleHaveMale(InterfRel1, InterfRel2.ValueI, CableCanalFullnessKoef); if CanFemaleHaveMaleRes.CanHave then begin {New(InterfRel); InterfRel^ := InterfRel1^; AInterfLists.InterfList1.Add(InterfRel); New(InterfRel); InterfRel^ := InterfRel2^; AInterfLists.InterfList2.Add(InterfRel); } AInterfLists.InterfList1.Add(InterfRel1); AInterfLists.InterfList2.Add(InterfRel2); Result := cckAuto; Exit; ///// EXIT ///// end; end; end; end; end; end; *) {function TF_Main.SynthesisInterf(ACompon1, ACompon2: TSCSComponent; AInterfList1, AInterfList2: TList; AInterfLists: TInterfLists; AConnectKind: TConnectKind): TCanConnectKind; var Res: TCanConnectKind; i, j: Integer; InterfRel1: TSCSInterface; InterfRel2: TSCSInterface; InterfRel: TSCSInterface; //IOfIRel: PIOfIRel; AddedInterf1: TList; AddedInterf2: TList; isLine1: Integer; isLine2: Integer; function CheckForAdded(AIDInterfRel: Integer; AAddedList: TList): Boolean; var i: Integer; begin Result := true; for i := 0 to AAddedList.Count - 1 do if Integer(AAddedList.Items[i]^) = AIDInterfRel then begin Result := false; Break; end; end; procedure SignAsAdded(AIDInterfRel: Integer; AAddedList: TList); var IDInterf: ^Integer; begin New(IDInterf); IDInterf^ := AIDInterfRel; AAddedList.Add(IDInterf); end; //***************** ф-ции для разделения на стороны ******************** //*** Вернент кол-во интерфейсов компоненты function GetCountInterfFromCompon(AID_Component, AID_Interface: Integer): Integer; begin Result := 0; SetSQLToQuery(DM.scsQSelect, ' select count(*) As Cnt from interface_relation '+ ' where (id_component = '''+IntToStr(AID_Component)+''') and '+ ' (id_interface = '''+IntToStr(AID_Interface)+''') '); Result := DM.scsQSelect.FN('Count').AsInteger; end; function GetCountInterfFromConnectList(AConnList: Tlist; AID_Interface: Integer): Integer; var i: Integer; ResCount: Integer; begin Result := 0; ResCount := 0; for i := 0 to AConnList.Count - 1 do if TSCSInterface(AConnList.Items[i]).ID_Interface = AID_Interface then ResCount := ResCount + 1; Result := ResCount; end; procedure RemoveInterfacesFromList(AConnList, AParallelList: TList; AID_Interface, ARemoveCount: Integer); var i: Integer; RemoveCount: Integer; ListDelPos: TList; DelPos: ^Integer; begin RemoveCount := ARemoveCount; ListDelPos := TList.Create; //*** Выбрать удаляемыепозиции из списка for i := 0 to AConnList.Count - 1 do if TSCSInterface(AConnList.Items[i]).ID_INTERFACE = AID_Interface then begin New(DelPos); Delpos^ := i; ListDelPos.Add(DelPos); RemoveCount := RemoveCount - 1; if RemoveCount = 0 then Break; end; //*** Удалить интерфейсы из списка for i := 0 to ListDelPos.Count - 1 do begin Delpos := ListDelPos.Items[i]; AConnList.Delete(Delpos^); AParallelList.Delete(Delpos^); end; FreeList(ListDelPos); end; function DetermineLineComponInterfaces(ACompon: TSCSComponent; AInterfList, AParallelInterf: Tlist): TCanConnectKind; var i, j: Integer; InterfRel: TSCSInterface; ListRecCount: Integer; CheckedAll: Boolean; CountToConnect: Integer; CountInSide: Integer; CountToDelFromList: Integer; begin if ACompon.IsLine <> ctLine then Exit; Result := cckNone; //*** Проверить есть ли многократные интерфейсы for i := 0 to AInterfList.Count - 1 do if TSCSInterface(AInterfList.Items[i]).Multiple = 1 then begin Result := cckManual; Exit; end; //*** Оставить одну свободную сторону интерфейсов ListRecCount := AInterfList.Count; CheckedAll := false; while Not CheckedAll do begin CheckedAll := true; for j := 0 to AInterfList.Count - 1 do begin InterfRel := AInterfList.Items[j]; //*** Если интерфейс функциональный if InterfRel.TypeI = itFunctional then begin CountToConnect := GetCountInterfFromConnectList(AInterfList, InterfRel.ID_INTERFACE); CountInSide := Trunc(GetCountInterfFromCompon(ACompon.ID, InterfRel.ID_INTERFACE) / 2); if CountToConnect > CountInSide then begin CountToDelFromList := CountToConnect - CountInSide; RemoveInterfacesFromList(AInterfList, AParallelInterf, InterfRel.ID_INTERFACE, CountToDelFromList); CheckedAll := false; Break; end; end; end; end; if AInterfList.Count > 0 then Result := cckAuto; if AInterfList.Count = 0 then Result := cckNone; end; begin Result := cckNone; if (ACompon1.IsLine <> ctLine) and (ACompon1.IsLine <> ctLine) then begin AddedInterf1 := TList.Create; AddedInterf2 := TList.Create; for i := 0 to AInterfList1.Count - 1 do begin InterfRel1 := AInterfList1.Items[i]; for j := 0 to AInterfList2.Count - 1 do begin InterfRel2 := AInterfList2.Items[j]; if CheckForAdded(InterfRel1.ID, AddedInterf1) and CheckForAdded(InterfRel2.ID, AddedInterf2) then if (InterfRel1.ID_INTERFACE = InterfRel2.ID_INTERFACE) and (CheckGender(InterfRel1.GENDER, InterfRel2.GENDER, AConnectKind)) then begin New(InterfRel); InterfRel^ := InterfRel1^; AInterfLists.InterfList1.Add(InterfRel); New(InterfRel); InterfRel^ := InterfRel2^; AInterfLists.InterfList2.Add(InterfRel); //*** Добавить в списки добавленных SignAsAdded(InterfRel1.ID, AddedInterf1); SignAsAdded(InterfRel2.ID, AddedInterf2); Break; end; end; end; //*** Формирование окончательных результатов if AInterfLists.InterfList1.Count = 0 then Res := cckNone else begin if (ACompon1.IsLine <> ctLine) and (ACompon2.IsLine <> ctLine) then Res := cckAuto else begin if ACompon1.IsLine = ctLine then Res := DetermineLineComponInterfaces(ACompon1, AInterfLists.InterfList1, AInterfLists.InterfList2); if (ACompon2.IsLine = ctLine) and (Res <> cckManual) then Res := DetermineLineComponInterfaces(ACompon2, AInterfLists.InterfList2, AInterfLists.InterfList1); end; end; Result := Res; FreeList(AddedInterf1); FreeList(AddedInterf2); end; if (ACompon1.IsLine = ctLine) and (ACompon1.IsLine = ctLine) then begin end; end;} {function TF_Main.SynthesisInterf(AInterfList1, AInterfList2, AIOfIRelList: TList; AConnectKind: TConnectKind): TCanConnectKind; var i, j: Integer; InterfRel1: TSCSInterface; InterfRel2: TSCSInterface; IOfIRel: PIOfIRel; AddedInterf1: TList; AddedInterf2: TList; isLine1: Integer; isLine2: Integer; function CheckForAdded(AIDInterfRel: Integer; AAddedList: TList): Boolean; var i: Integer; begin Result := true; for i := 0 to AAddedList.Count - 1 do if Integer(AAddedList.Items[i]^) = AIDInterfRel then begin Result := false; Break; end; end; procedure SignAsAdded(AIDInterfRel: Integer; AAddedList: TList); var IDInterf: ^Integer; begin New(IDInterf); IDInterf^ := AIDInterfRel; AAddedList.Add(IDInterf); end; begin Result := cckNone; AddedInterf1 := TList.Create; AddedInterf2 := TList.Create; for i := 0 to AInterfList1.Count - 1 do begin InterfRel1 := AInterfList1.Items[i]; for j := 0 to AInterfList2.Count - 1 do begin InterfRel2 := AInterfList2.Items[j]; if CheckForAdded(InterfRel1.ID, AddedInterf1) and CheckForAdded(InterfRel2.ID, AddedInterf2) then if (InterfRel1.ID_INTERFACE = InterfRel2.ID_INTERFACE) and (CheckGender(InterfRel1.GENDER, InterfRel2.GENDER, AConnectKind)) then begin New(IOfIRel); IOfIRel.ID_INTERF_REL := InterfRel1.ID; IOfIRel.ID_INTERF_To := InterfRel2.ID; AIOfIRelList.Add(IOfIRel); //*** Добавить в списки добавленных SignAsAdded(InterfRel1.ID, AddedInterf1); SignAsAdded(InterfRel2.ID, AddedInterf2); Break; end; end; end; FreeList(AddedInterf1); FreeList(AddedInterf2); end; } procedure TF_MAIN.Tree_CatalogKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var CursorPos: TPoint; begin GGlobalShiftState := Shift; case Key of Ord('C'), Ord('c'), Ord('С'), Ord('с'): begin if Shift = [ssCtrl, ssAlt] then Act_MakeComponent.Execute; if Shift = [ssCtrl] then Act_CopyDir.Execute; end; Ord('D'), Ord('d'), Ord('В'), Ord('в'): begin if Shift = [ssCtrl, ssAlt] then Act_MakeDir.Execute; end; Ord('X'), Ord('x'), Ord('Ч'), Ord('ч'): begin if Shift = [ssCtrl] then Act_CutDir.Execute; end; Ord('V'), Ord('v'), Ord('М'), Ord('м'): begin if Shift = [ssCtrl] then Act_PasteDir.Execute; end; Ord('F'), Ord('f'), Ord('А'), Ord('а'): begin if Shift = [ssCtrl] then Act_ChoiceFind.Execute; end; //Ord('A'), Ord('a'): // begin // if Shift = [ssCtrl] then // Act_ChoiceFind.Execute; // end; 189, 109: // '-': if Not(ssShift in Shift) then begin if Tree_Catalog.Selected <> nil then if Tree_Catalog.Selected.Parent <> nil then Tree_Catalog.Selected.Parent.Expanded := false; end; VK_F2: if Shift <> [ssCtrl] then Act_EditingNode.Execute else Act_EditTree.Execute; VK_DELETE: if Shift = [ssCtrl] then Act_DelTree.Execute; VK_APPS: begin GetCursorPos(CursorPos); PopupMenu_Catalog.Popup(CursorPos.X, CursorPos.Y); end; end; end; procedure TF_MAIN.Tree_CatalogKeyPress(Sender: TObject; var Key: Char); begin if Key = #13 then OpenNode(Tree_Catalog.Selected); end; procedure TF_MAIN.Tree_CatalogKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); var Node: TTreeNode; begin GGlobalShiftState := Shift; Act_HideHints.Execute; Node := Tree_Catalog.Selected; RememberIDLastNBDir(Node); if Node <> nil then if (FPrevSelectedNodeDat.ObjectID <> PObjectData(Node.Data).ObjectID) or (FPrevSelectedNodeDat.ItemType <> PObjectData(Node.Data).ItemType) or (FPrevSelectionCount <> Tree_Catalog.SelectionCount) then begin if GDBMode = bkProjectManager then Act_DeselectSelectComponInCAD.Execute; if Node <> nil then if GDBMode = bkProjectManager then begin SwitchInCAD(Node, ccOne); if Not Tree_Catalog.Focused then Tree_Catalog.SetFocus; end; //FPrevSelectedNodeDat := PObjectData(Node.Data)^; end; Timer_ChangingTimer(Timer_Changing); end; procedure TF_MAIN.Tree_CatalogEnter(Sender: TObject); begin GWhoChange := wcTree; end; procedure TF_MAIN.Tree_CatalogExit(Sender: TObject); begin //GWhoChange := wcNone; Act_HideHints.Execute; if Assigned(GSCSBase) and Assigned(GSCSBase.SCSComponent) then GSCSBase.SCSComponent.ServAllLoaded := false; if TTreeView(Sender).Selected <> nil then OnNodeExit(TTreeView(Sender).Selected, nil, false); end; procedure TF_MAIN.Grid_CompDataEnter(Sender: TObject); begin GWhoChange := wcGrid; if Assigned(GSCSBase) and Assigned(GSCSBase.SCSComponent) then GSCSBase.SCSComponent.ServAllLoaded := false; end; procedure TF_MAIN.Grid_CompDataExit(Sender: TObject); begin //GWhoChange := wcNone; end; // ##### Прокрутка панели со стоимостю и ценой ##### procedure TF_MAIN.PageScroller_CostScroll(Sender: TObject; Shift: TShiftState; X, Y: Integer; Orientation: TPageScrollerOrientation; var Delta: Integer); begin Delta := Round(Panel_Cost.Width / 2); end; // ##### Изменение количества омплектующих ##### procedure TF_MAIN.GT_Compon_RelationKolvoPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var IDCompRel: Integer; //ID_Component: Integer; //ID_Child: Integer; OldKol: Integer; NewKol: integer; WasChanged: Boolean; KolCanAdd: Integer; KolCanDel: Integer; KolRel: Integer; //*** по какому количеству интефейсов соединена комплетующая //Compon: TComponData; //Compl: TComponData; Compon: TSCSComponent; ChildCompon: TSCSComponent; Compl: TSCSComponent; ComplNode: TTreeNode; InterRelIDs: TIntList; IDInterfRel: Integer; i: Integer; begin try Error := false; NewKol := DisplayValue; Compon := TSCSComponent.Create(Self); Compl := TSCSComponent.Create(Self); WasChanged := false; IDCompRel := DM.MemTable_Complects.FieldByName(fnID).AsInteger; OldKol := DM.MemTable_Complects.FieldByName(fnkolvo).AsInteger; Compon.ID := DM.MemTable_Complects.FieldByName(fnIDComponent).AsInteger; //Compon.Name := GSCSBase.SCSComponent.Name; Compon.Assign(GSCSBase.SCSComponent, true, true); //Compon.LoadComponentByID(Compon.ID); Compon.IDTopComponent := GSCSBase.SCSComponent.IDTopComponent; Compon.IDCompRel := GSCSBase.SCSComponent.IDCompRel; Compon.TreeViewNode := Tree_Catalog.Selected; ComplNode := FindChildNodeByIDCompRel(Compon.TreeViewNode, IDCompRel); ChildCompon := GetComponChildByIDCompRel(Compon, IDCompRel); Compl.ID := DM.MemTable_Complects.FieldByName(fnIDChild).AsInteger; //Compl.LoadComponentByID(Compl.ID); if ChildCompon = nil then begin Compl.IDTopComponent := Compon.IDTopComponent; Compl.IDCompRel := IDCompRel; Compl.LoadComponentByID(Compl.ID, false, true, false); Compl.LoadChildComplectsQuick(true, false, true, Compl.IDTopComponent, Compl.IDCompRel); Compl.LoadInterfaces; end else begin Compl.Assign(ChildCompon, true, true); Compl.IDTopComponent := Compon.IDTopComponent; Compl.IDCompRel := IDCompRel; end; Compl.LoadComponentType; if Compl.Properties.Count = 0 then Compl.LoadProperties; Compl.TreeViewNode := ComplNode; Compl.Count := NewKol; Compon.AddToChild(Compl); Compon.SetInterfacesParallel; Compon.SetInterfacesComplect; Compon.SetPortInterfRelInterfaces; DefineComponConstructiveInterfacesIsBusy(Compon); if (NewKol < 1) or (GDBMode = bkProjectManager) then begin DisplayValue := OldKol; Exit; ///// Exit ///// end; //*** Нужно добавить комплектующие if NewKol > OldKol then begin TcxSpinEdit(Sender).Properties.OnValidate := nil; try WasChanged := true; KolCanAdd := NewKol - OldKol; for i := 0 to KolCanAdd - 1 do begin //Compl.Interfaces.Clear; //Compl.LoadInterfaces; //Compl.fr //*** Освободить интерфейсы у Чайлда для комплектации SetChildComponInterfacesToNoBusy(Compon, Compl, IDCompRel); //if Not ConnectCompons(Compon, Compl, cnkVarious, cntComplect, ID_CompRel) then //if Compon.ComplectWith(Compl, IDCompRel) = nil then if Not CanConnCompon(Compon, Compl, cntComplect, smtDisplay, true, IDCompRel) then begin WasChanged := false; NewKol := OldKol; Break; //// BREAK //// end else if Compon.ComplectWith(Compl, IDCompRel, false, true) = nil then begin if (i = 0) or (Not GUseLiteFunctional) then begin if (Not GUseVisibleInterfaces) or (MessageModal(cMain_Msg82_1+' "'+ Compon.Name +'" '+cMain_Msg82_2 + #13 + #13 + ' '+cMain_Msg82_3, cMain_Msg82_4, MB_ICONQUESTION or MB_YESNO) = IDYES) then //*** Изменить количество комплектующих SetSQLToFIBQuery(DM.Query_Operat, 'update component_relation set kolvo = '''+IntToStr(NewKol)+''' '+ ' where id = '''+IntToStr(IDCompRel)+''' ') else begin WasChanged := false; NewKol := OldKol; end; end else if i <= KolCanAdd - 1 then begin if Not GUseLiteFunctional then MessageModal(cMain_Msg83_1+' '+ IntToStr(i) +' '+ cMain_Msg83_2, cMain_Msg83_3, MB_ICONINFORMATION or MB_OK); //ErrorText := 'Добавить можно только '+ IntToStr(i) +' шт. комплектующх '; NewKol := OldKol + i; end; Break; end; end; finally TcxSpinEdit(Sender).Properties.OnValidate := GT_Compon_RelationKolvoPropertiesValidate; end; if WasChanged then //*** обновить интерфейсы Compon.LoadInterfaces; end; //*** Нужно удалить комплектующие if NewKol < OldKol then begin InterRelIDs := TIntList.Create; KolCanDel := OldKol - NewKol; //SetSQLToFIBQuery(DM.Query_Operat, ' UPDATE INTERFACE_RELATION SET ' + // ' ISBUSY = 0 ' + // ' WHERE ID IN (SELECT ID_INTERF_REL FROM INTERFOFINTERF_RELATION '+ // ' WHERE ID_COMP_REL = '''+IntToStr(ID_CompRel)+''') '); //*** Отобрать интерфейсы данного соединения SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnInterfOfInterfRelation, fnIDCompRel+' = '''+IntToStr(IDCompRel)+'''', nil, fnIDInterfRel)); IntFIBFieldToIntList(InterRelIDs, DM.Query_Select, fnIDInterfRel); //*** Сбросить флаг "IsBusy" для интерфейсов данного соединения SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnInterfaceRelation, fnID+' = :'+fnID, nil, fnIsBusy), false); for i := 0 to InterRelIDs.Count - 1 do begin DM.Query_Operat.Close; DM.Query_Operat.Params[0].AsInteger := biFalse; DM.Query_Operat.Params[1].AsInteger := InterRelIDs[i]; DM.Query_Operat.ExecQuery; end; SetSQLToFIBQuery(DM.Query_Operat, 'DELETE FROM INTERFOFINTERF_RELATION ' + ' WHERE (ID_COMP_REL = '''+ IntToStr(IDCompRel) +''') '); //*** обновить интерфейсы Compon.LoadInterfaces; for i := 0 to NewKol - 1 do begin //*** Освободить интерфейсы у Чайлда для комплектации if i > 0 then SetChildComponInterfacesToNoBusy(Compon, Compl, IDCompRel); //ConnectCompons(Compon, Compl, cnkVarious, cntComplect, ID_CompRel); Compon.ComplectWith(Compl, IDCompRel); end; SaveComplects(Compl, Compon.IDTopComponent, true); FreeAndNil(InterRelIDs); WasChanged := true; end; //LockTreeAndGrid(true); try if WasChanged then begin DisplayValue := NewKol; SetSQLToFIBQuery(DM.Query_Operat, ' update component_relation set kolvo = '''+ IntToStr(NewKol) +''' where id = '''+ IntToStr(IDCompRel) +''' '); if Compon.IDTopComponent <> 0 then CalcPrice(Compon.IDTopComponent) else CalcPriceForParents(Compon.ID); GSCSBase.SCSComponent.LoadComponentByID(GSCSBase.SCSComponent.ID, false, true, false); GSCSBase.SCSComponent.AssignInterfaces(Compon.Interfaces, true, false); //GSCSBase.SCSComponent.LoadInterfaces; GSCSBase.SCSComponent.LoadChildComplectsQuick(true, true, true, GSCSBase.SCSComponent.IDTopComponent, GSCSBase.SCSComponent.IDCompRel); DM.MTRefreshCurrentCompl(DM.MemTable_Complects); DM.SelectInterfaces(Tree_Catalog.Selected); ShowPrice; GSCSBase.SCSComponent.NotifyChange; //RefreshNode; end else begin DisplayValue := OldKol; DM.MTRefreshCurrentCompl(DM.MemTable_Complects); end; finally //LockTreeAndGrid(false); //FreeAndNil(Compl); FreeAndNil(Compon); end; except on E: Exception do AddExceptionToLog('TF_MAIN.GT_Compon_RelationKolvoPropertiesValidate: '+E.Message); end; end; procedure TF_MAIN.Act_DropTreeCopyExecute(Sender: TObject); var TargetDat: PObjectData; SourceDat: PObjectData; begin TargetDat := GTNode.Data; SourceDat := GSNode.Data; case TargetDat.ItemType of itComponCon, itComponLine: if SourceDat.ItemType in [itComponCon, itComponLine] then begin AddComplect(Self, GSNode, GTNode, GDropComponent, cntComplect, 1, false); end; itDir, itProject, itList, itRoom, itSCSConnector, itSCSLine: begin {GSDat.ObjectID := PObjectData(GSNode).ObjectID; GSDat.ItemType := PObjectData(GSNode).ItemType; } Tree_Catalog.Selected := GTNode; GSDat.ObjectID := PObjectData(GSNode.Data).ObjectID; GSDat.ItemType := PObjectData(GSNode.Data).ItemType; GEditKind := ekCopy; Act_ClearCopyBuf.Enabled := true; Act_PasteDir.Enabled := true; //EnablePaste; Act_PasteDir.Execute; end; end; end; procedure TF_MAIN.Act_DropTreeMoveExecute(Sender: TObject); begin Act_MoveDir.Execute; if Tree_Catalog.Selected <> nil then if Tree_Catalog.Selected.DisplayRect(false).Top <= 0 then ShowSelectedNode(Tree_Catalog); RefreshNode; end; procedure TF_MAIN.Act_DropTreeConnectExecute(Sender: TObject); //var // TargetDat: PObjectData; // SourceDat: PObjectData; begin JoinComponentsByTreeNodes(GSNode, GTNode, GDropComponent, false); //TargetDat := GTNode.Data; //SourceDat := GSNode.Data; //case TargetDat.ItemType of // itComponCon, itComponLine: // if SourceDat.ItemType in [itComponCon, itComponLine] then // AddComplect(Self, GTNode, GDropComponent, cntUnion, 1, false); //end; end; procedure TF_MAIN.Act_DropTreeConnectChoicingInterfacesExecute( Sender: TObject); begin JoinComponentsByTreeNodes(GSNode, GTNode, GDropComponent, true); end; // ##### Показать трудозатраты ##### procedure TF_MAIN.Act_NormsShowExecute(Sender: TObject); //var Dat: PObjectData; // SCSComponent: TSCSComponent; // SCSCatalog: TSCSCatalog; // NormsResources: TSCSNormsResources; begin //04.01.2011 //SCSComponent := nil; // SCSCatalog := nil; // // Dat := Tree_Catalog.Selected.Data; // //F_Norms.GItemType := Dat.ItemType; // //F_Norms.GIDMaster := Dat.ObjectID; // //if F_Norms.ShowModal = mrOk then // NormsResources := nil; // if GDBMode = bkProjectManager then // case Dat.ItemType of // itComponCon, itComponLine: // begin // SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); // if Assigned(SCSComponent) then // NormsResources := SCSComponent.NormsResources; // end; // itSCSConnector, itSCSLine: // begin // SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); // if Assigned(SCSCatalog) then // NormsResources := SCSCatalog.NormsResources; // end; // end; // // F_Norms.Execute(Dat.ItemType, Dat.ObjectID, NormsResources); // // { if GDBMode = bkProjectManager then // case Dat.ItemType of // itComponCon, itComponLine: // begin // SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); // if Assigned(SCSComponent) then // SCSComponent.NormsResources.Refesh; // end; // itSCSConnector, itSCSLine: // begin // SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); // if Assigned(SCSCatalog) then // SCSCatalog.NormsResources.Refesh; // end; // end;} end; procedure TF_MAIN.Act_SaveToAlPlanExecute(Sender: TObject); var Dat: PObjectData; SCSObject: TSCSCatalog; begin SCSObject := nil; Dat := nil; if GDBMode <> bkProjectManager then Exit; ///// EXIT ///// Dat := Tree_Catalog.Selected.Data; if Dat = nil then Exit; ///// EXIT ///// case Dat.ItemType of itProject: SCSObject := GSCSBase.CurrProject; itList: SCSObject := GSCSBase.CurrProject.CurrList; end; if Assigned(SCSObject) then begin sdAlPlan.InitialDir := ExtractSaveDir; //ExtractFileDir(Application.ExeName); if sdAlPlan.Execute then SCSObject.SaveNormsToAlPlan(sdAlPlan.FileName); end; end; // ##### Подключенные линейные компоненты ##### procedure TF_MAIN.Act_ConnectedLineComponsExecute(Sender: TObject); begin if Assigned(GSCSBase.CurrProject) then //if Assigned(GSCSBase.CurrProject.CurrList) then ShowConnDisconnCompons(GetCatalogExtendedFromCurrNode, cdConnlineCompons); end; // ##### Не подключенные линейные компоненты ##### procedure TF_MAIN.Act_NoConnectedLineComponsExecute(Sender: TObject); begin if Assigned(GSCSBase.CurrProject) then //if Assigned(GSCSBase.CurrProject.CurrList) then ShowConnDisconnCompons(GetCatalogExtendedFromCurrNode, cdDisConnlineCompons); end; // ##### Подключенные точечные компоненты ##### procedure TF_MAIN.Act_ConnectedConComponsExecute(Sender: TObject); begin //GSCSBase.CurrProject.CurrList.GetParentCatalogByItemType() if Assigned(GSCSBase.CurrProject) then //if Assigned(GSCSBase.CurrProject.CurrList) then ShowConnDisconnCompons(GetCatalogExtendedFromCurrNode, cdConnConCompons); end; // ##### Не подключенные линейные компоненты ##### procedure TF_MAIN.Act_NoConnectedConComponsExecute(Sender: TObject); begin if Assigned(GSCSBase.CurrProject) then //if Assigned(GSCSBase.CurrProject.CurrList) then ShowConnDisconnCompons(GetCatalogExtendedFromCurrNode, cdDisConnConCompons); end; procedure TF_MAIN.Pict1Click(Sender: TObject); begin IconToFile('Icon'); end; // ##### Перейти на соединение ##### procedure TF_MAIN.Act_GoToConnectComponExecute(Sender: TObject); var ID_Connect: Integer; ID_Component: Integer; IDCompRelFrom: Integer; IDCompRelTo: Integer; TopComponNode: TTreeNode; Node: TTreeNode; begin Node := nil; if GDBMode = bkNormBase then begin //*** Найти ветку верхней компоненты TopComponNode := FindComponOrDirInTree(DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger, true); if TopComponNode <> nil then begin ID_Component := DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger; IDCompRelFrom := DM.MemTable_Connections.FieldByName(fnIDCompRelFrom).AsInteger; IDCompRelTo := DM.MemTable_Connections.FieldByName(fnIDCompRelTo).AsInteger; if IDCompRelFrom <> IDCompRelTo then begin if GSCSBase.SCSComponent.IDCompRel = IDCompRelFrom then begin Node := FindChildNodeByIDCompRel(TopComponNode, IDCompRelTo); end else if GSCSBase.SCSComponent.IDCompRel = IDCompRelTo then begin if IDCompRelFrom <> 0 then Node := FindChildNodeByIDCompRel(TopComponNode, IDCompRelFrom) else // Если подключение к верхнему компоненту Node := FindComponOrDirInTree(ID_Component, true); end; end; end; end else if GDBMode = bkProjectManager then begin ID_Component := GSCSBase.SCSComponent.ID; //DM.MemTable_Connections.FieldByName('ID_Component').AsInteger; {if DM.MemTable_Connections.FieldByName('ID_Component').AsInteger = ID_Component then ID_Connect:= DM.MemTable_Connections.FieldByName('ID_Child').AsInteger else ID_Connect:= DM.MemTable_Connections.FieldByName('ID_Component').AsInteger;} ID_Connect := DM.MemTable_Connections.FieldByName(fnIDJoined).AsInteger; Node := FindComponOrDirInTree(ID_Connect, true); end; if Node <> nil then Tree_Catalog.Selected := Node; end; // ##### Показывает с чем соединен интерфейс ##### procedure TF_MAIN.Act_TurnToConnectedComponByInterfExecute( Sender: TObject); var MemTable_InterfOrPort: TkbmMemTable; IDInterf: Integer; IDConnected: Integer; InterfName: String; SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; i: Integer; JoinedInterface: TSCSInterface; JoinedComponents: TSCSComponents; ComponNode: TTreeNode; //strIDInterf: String; begin try MemTable_InterfOrPort := nil; IDConnected := 0; case Grid_CompData.ActiveLevel.Index of cdliInterface: MemTable_InterfOrPort := DM.MemTable_InterfaceRel; cdliPort: begin MemTable_InterfOrPort := DM.MemTable_Port; IDConnected := MemTable_InterfOrPort.FieldByName('ID_CONNECTED').AsInteger; end; end; if MemTable_InterfOrPort = nil then Exit; //// EXIT //// if MemTable_InterfOrPort.FieldByName('isBusy').AsInteger = biFalse then Exit; ///// EXIT //// IDInterf := MemTable_InterfOrPort.FieldByName('ID').AsInteger; InterfName := MemTable_InterfOrPort.FieldByName('Name').AsString; SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(MemTable_InterfOrPort.FieldByName(fnIDComponent).AsInteger); if Assigned(SCSComponent) then begin SCSInterface := SCSComponent.GetInterfaceByID(IDInterf); if Assigned(SCSInterface) then begin JoinedComponents := TSCSComponents.Create(false); try for i := 0 to SCSInterface.ConnectedInterfaces.Count - 1 do begin JoinedInterface := SCSInterface.ConnectedInterfaces[i]; if Assigned(JoinedInterface) then begin if Assigned(JoinedInterface.ComponentOwner) then if JoinedComponents.IndexOf(JoinedInterface.ComponentOwner) = -1 then JoinedComponents.Add(JoinedInterface.ComponentOwner); end; if JoinedComponents.Count = 1 then begin ComponNode := nil; ComponNode := JoinedComponents[0].TreeViewNode; if ComponNode = nil then ComponNode := FindComponOrDirInTree(JoinedComponents[0].ID, true); if ComponNode <> nil then Tree_Catalog.Selected := ComponNode; end else if JoinedComponents.Count > 1 then F_InputBox.SelectComponentFromList(cMain_Msg84_1+' "'+InterfName+'" '+cMain_Msg84_2+': ', JoinedComponents); end; finally JoinedComponents.Free; end; end; end; { if IDConnected = 0 then begin strIDInterf := IntToStr(IDInterf); SetSQLToQuery(DM.scsQ, ' select component.id, name from component, component_relation '+ ' where ((component.id = component_relation.id_component) or '+ ' (component.id = component_relation.id_child)) and '+ ' (connect_type = '''+IntToStr(cntUnion)+''') and '+ ' (component.id <> '''+IntToStr(GSCSBase.SCSComponent.ID)+''') and '+ ' (component_relation.id in (select id_comp_rel from interfofinterf_relation ' + ' where (id_interf_rel = '''+strIDInterf+''') or '+ ' (id_interf_to = '''+strIDInterf+''') )) '); end; if IDConnected > 0 then SetSQLToQuery(DM.scsQ, ' select component.id, name from component, interface_relation '+ ' where (interface_relation.id = '''+IntToStr(IDConnected)+''') and (component.id = id_component) '); ShowList(TForm(Self), trkCatalog, fmView, 'Через интерфейс "'+InterfName+'" соединены компоненты: ', true);} except on E: Exception do AddExceptionToLog('TF_MAIN.Act_TurnToConnectedComponByInterfExecute: '+E.Message); end; end; // ##### Освобождает заянятый многократный интерфейс ##### procedure TF_MAIN.Act_FreeMultipleInterfaceExecute(Sender: TObject); var MemTable_InterfOrPort: TkbmMemTable; InterfName: String; InterfID: Integer; IDConnected: Integer; ConnectionList: TIntList; sqlWhere: String; i: Integer; InterfToFree: TSCSInterface; CompRel: TComplect; //IDCompon1: Integer; //IDCompon2: Integer; //ConnectType: TConnectType; Compon: TSCSComponent; ComponChild: TSCSComponent; WasDisconnect: Boolean; InterfListForNoBusy: TSCSInterfaces; ptrInterfToEmpty: TSCSInterface; begin try ConnectionList := nil; WasDisconnect := false; IDConnected := 0; MemTable_InterfOrPort := nil; case Grid_CompData.ActiveLevel.Index of cdliInterface: MemTable_InterfOrPort := DM.MemTable_InterfaceRel; cdliPort: begin MemTable_InterfOrPort := DM.MemTable_Port; IDConnected := MemTable_InterfOrPort.FieldByName('ID_connected').AsInteger; end; end; if MemTable_InterfOrPort = nil then Exit; //// EXIT //// InterfID := MemTable_InterfOrPort.FieldByName(fnID).AsInteger; InterfName := MemTable_InterfOrPort.FieldByName(fnName).AsString; if MessageModal(cMain_Msg85_1+' "'+InterfName+'" '+cMain_Msg85_2, Application.Title, MB_ICONQUESTION or MB_YESNO) = ID_YES then begin Screen.Cursor := crHourGlass; ConnectionList := nil; try //*** Отобрать все соединения с участвием текущего интерфеса ConnectionList := DM.GetIOfIRelIDCompRelListByInterfIDs(InterfID, InterfID); //*** Освободить текущий интерфейс DM.DeleteIOfIRelByInterfID(InterfID); //*** удалить соединения в которых нет интерфейсных связей //ChangeSQLQuery(DM.scsQOperat, ' delete from component_relation '+ // ' where (id = :id) and '+ // ' Not(id in (select id_comp_rel from interfofinterf_relation) ) '); for i := 0 to ConnectionList.Count - 1 do begin //*** Выбрать компонеты текущей связи CompRel := DM.GetCompRelByID(ConnectionList[i]); if CompRel.ID <> 0 then //(DM.GetIOfIRelCountByFulter(fnIDCompRel+' = '''+ IntToStr(CompRel.ID)+'''', true) = 0) then begin Compon := nil; ComponChild := nil; case GDBMode of bkNormBase: begin Compon := TSCSComponent.Create(TForm(Self)); ComponChild := TSCSComponent.Create(TForm(Self)); Compon.LoadComponentByID(CompRel.ID_Component, false); ComponChild.LoadComponentByID(CompRel.ID_Child, false); Compon.LoadOwnerCatalog(true); ComponChild.LoadOwnerCatalog(true); end; bkProjectManager: begin Compon := GSCSBase.CurrProject.GetComponentFromReferences(CompRel.ID_Component); ComponChild := GSCSBase.CurrProject.GetComponentFromReferences(CompRel.ID_Child); end; end; //*** Запрос на удаление соединений //if DM.GetIOfIRelCountByFulter(fnIDCompRel+' = '''+ IntToStr(CompRel.ID)+'''', true) = 0 then // DM.DeleteCompRelByID(CompRel.ID); //*** Проверить, была ли удалина связь компонентов //if DM.GetCompRelByID(CompRel.ID).ID = 0 then if Not GSCSBase.CurrProject.CheckUseCompRelAtInterfaces(CompRel.ID) then begin WasDisconnect := true; case CompRel.ConnectType of cntUnion: begin Compon.DisJoinFrom(ComponChild); //Compon.RemoveJoinedComponent(ComponChild); //ComponChild.RemoveJoinedComponent(Compon); //F_ChoiceConnectSide.OnAfterDisJoinCompons(Compon, ComponChild); end; cntComplect: begin Compon.DisComplectChildComponent(ComponChild); //Compon.RemoveChildComponent(ComponChild); //F_ChoiceConnectSide.OnAfterDisConnectCompons(Compon, ComponChild, CompRel.ID); end; end; end else case GDBMode of bkNormBase: begin F_ChoiceConnectSide.DefineObjectStatus(TSCSCatalog(Compon.OwnerCatalog)); F_ChoiceConnectSide.DefineObjectStatus(TSCSCatalog(ComponChild.OwnerCatalog)); end; bkProjectManager: begin F_ChoiceConnectSide.DefineObjectStatus(Compon.GetFirstParentCatalog); F_ChoiceConnectSide.DefineObjectStatus(ComponChild.GetFirstParentCatalog); end; end; if GDBMode = bkNormBase then begin FreeAndNil(Compon); FreeAndNil(ComponChild); end; end; end; //*** поставить признак "не занят" освобожденным интерфейсам InterfListForNoBusy := DM.GetInterfacesThatMayBeNoBusy; for i := 0 to InterfListForNoBusy.Count - 1 do begin ptrInterfToEmpty := InterfListForNoBusy[i]; //DM.UpdateInterfFieldAsInteger(ptrInterfToEmpty.ID, biFalse, fnIsBusy); if GDBMode = bkProjectManager then begin //ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(ptrInterfToEmpty.ID, ptrInterfToEmpty.ID_Component); //if ptrInterfToEmpty <> nil then ptrInterfToEmpty.IsBusy := biFalse; end; end; InterfListForNoBusy.Free; //FreeList(InterfListForNoBusy); //*** Удалить связи с освобождаемым интерфейсом if GDBMode = bkProjectManager then begin ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByID(InterfID); if ptrInterfToEmpty <> nil then ptrInterfToEmpty.RemoveFromAllReferences; //RemoveInterfFromAllReferences(ptrInterfToEmpty); end; //*** Освободить указатели на присоединенные порты if IDConnected > 0 then begin //DM.UpdateInterfFieldAsInteger(InterfID, 0, fnIDConnected); //DM.UpdateInterfFieldAsInteger(IDConnected, 0, fnIDConnected); if GDBMode = bkProjectManager then begin ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByID(InterfID); if ptrInterfToEmpty <> nil then ptrInterfToEmpty.IDConnected := 0; ptrInterfToEmpty := GSCSBase.CurrProject.GetInterfaceByID(IDConnected); if ptrInterfToEmpty <> nil then ptrInterfToEmpty.IDConnected := 0; end; end; //if WasDisconnect then // F_ChoiceConnectSide.RefreshCurrListComponents; RefreshNode; finally Screen.Cursor := crDefault; FreeAndNil(ConnectionList); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_FreeMultipleInterfaceExecute: '+E.Message); end; { try ConnectionList := nil; WasDisconnect := false; try IDConnected := 0; MemTable_InterfOrPort := nil; case Grid_CompData.ActiveLevel.Index of cdliInterface: MemTable_InterfOrPort := DM.MemTable_InterfaceRel; cdliPort: begin MemTable_InterfOrPort := DM.MemTable_Port; IDConnected := MemTable_InterfOrPort.FieldByName('ID_connected').AsInteger; end; end; if MemTable_InterfOrPort = nil then Exit; //// EXIT //// InterfID := MemTable_InterfOrPort.FieldByName('ID').AsInteger; InterfName := MemTable_InterfOrPort.FieldByName('Name').AsString; if MessageModal(0, PChar('Отсоединить интерфейс "'+InterfName+'" от присоединенных к нему иентерфейсов?'), '', MB_ICONQUESTION or MB_YESNO) = ID_YES then begin ConnectionList := Tlist.Create; try sqlWhere := 'where (id_interf_rel = '''+IntToStr(InterfID)+''') or '+ ' (id_interf_to = '''+IntToStr(InterfID)+''')'; //*** Отобрать все соединения с участвием текущего интерфеса SetSQLToQuery(DM.scsQSelect, ' select id_comp_rel from interfofinterf_relation '+ sqlWhere); DM.IntFieldToList(ConnectionList, DM.scsQSelect, 'id_comp_rel'); //*** Освободить текущий интерфейс SetSQLToQuery(DM.scsQOperat, ' delete from interfofinterf_relation '+sqlWhere); //*** удалить соединения в которых нет интерфейсных связей ChangeSQLQuery(DM.scsQOperat, ' delete from component_relation '+ ' where (id = :id) and '+ ' Not(id in (select id_comp_rel from interfofinterf_relation) ) '); for i := 0 to ConnectionList.Count - 1 do begin //*** Выбрать компонеты текущей связи SetSQLToQuery(DM.scsQSelect, ' select id_component, id_child, connect_type from component_relation '+ ' where id = '''+IntToStr(Integer(ConnectionList.Items[i]^))+''' '); IDCompon1 := DM.scsQSelect.GetFNAsInteger('id_component'); IDCompon2 := DM.scsQSelect.GetFNAsInteger('id_child'); ConnectType := DM.scsQSelect.GetFNAsInteger('Connect_type'); Compon1 := nil; Compon2 := nil; case GDBMode of bkNormBase: begin Compon1 := TSCSComponent.Create(TForm(Self)); Compon2 := TSCSComponent.Create(TForm(Self)); Compon1.LoadComponentByID(Compon1.ID, false); Compon2.LoadComponentByID(Compon2.ID, false); Compon1.LoadOwnerCatalog(true); Compon2.LoadOwnerCatalog(true); end; bkProjectManager: begin Compon1 := GSCSBase.CurrProject.GetComponentFromReferences(IDCompon1); Compon2 := GSCSBase.CurrProject.GetComponentFromReferences(IDCompon2); end; end; //*** Запрос на удаление соединений DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', Integer(ConnectionList.Items[i]^)); DM.scsQOperat.ExecQuery; //*** Проверить, была ли удалина связь компонентов SetSQLToQuery(DM.scsQSelect, ' select count(id) As Cnt from component_relation where id = '''+IntToStr(Integer(ConnectionList.Items[i]^))+''' '); if DM.scsQSelect.GetFNAsInteger('Cnt') = 0 then begin WasDisconnect := true; case ConnectType of cntUnion: F_ChoiceConnectSide.OnAfterDisJoinCompons(Compon1, Compon2); cntComplect: F_ChoiceConnectSide.OnAfterDisConnectCompons(Compon1, Compon2); end; end else case GDBMode of bkNormBase: begin F_ChoiceConnectSide.DefineObjectFullness(TSCSCatalog(Compon1.OwnerCatalog)); F_ChoiceConnectSide.DefineObjectFullness(TSCSCatalog(Compon2.OwnerCatalog)); end; bkProjectManager: begin F_ChoiceConnectSide.DefineObjectFullness(Compon1.GetFirstParentCatalog); F_ChoiceConnectSide.DefineObjectFullness(Compon2.GetFirstParentCatalog); end; end; if GDBMode = bkNormBase then begin Compon1.Free; Compon2.Free; end; end; //*** поставить признак "не занят" освобожденным интерфейсам SetSQLToQuery(DM.scsQOperat, ' update interface_relation set isbusy = '''+IntTOStr(biFalse)+''' '+ ' where Not(id in (select id_interf_rel from interfofinterf_relation)) and '+ ' Not(id in (select id_interf_to from interfofinterf_relation)) '); //*** Освободить указатели на присоединенные порты if IDConnected > 0 then begin ChangeSQLQuery(DM.scsQOperat, ' update interface_relation set id_connected = ''0'' where id = :id '); DM.scsQOperat.SetParamAsInteger('id', InterfID); DM.scsQOperat.ExecQuery; DM.scsQOperat.Close; DM.scsQOperat.SetParamAsInteger('id', IDConnected); DM.scsQOperat.ExecQuery; end; if WasDisconnect then F_ChoiceConnectSide.RefreshCurrListComponents; RefreshNode; finally FreeList(ConnectionList); end; end; finally Compon1.Free; Compon2.Free; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_FreeMultipleInterfaceExecute: '+E.Message); end; } end; // ##### Длбавить соединение ##### procedure TF_MAIN.Act_AddConnectionExecute(Sender: TObject); begin AddEditComplect(Self, cmAdd, false, cntUnion); end; // ##### Удалить соединение ##### procedure TF_MAIN.Act_DelConnectionExecute(Sender: TObject); var ConnName: String; IDConnection: Integer; ID_Component: Integer; IDConnected: Integer; begin try ConnName := DM.MemTable_Connections.FieldByName('Name').AsString; if DM.MemTable_Connections.FieldByName(fnIsNative).AsBoolean = false then begin ShowMessageByType(0, smtDisplay, cMain_Msg86, Application.Title, MB_OK or MB_ICONINFORMATION); Exit; ///// EXIT ///// end; if MessageModal(cMain_Msg87_1+' "' + ConnName + '" ?', cMain_Msg87_2, MB_YESNO or MB_ICONQUESTION) = IDYES then begin LockTreeAndGrid(true); try IDConnection := DM.MemTable_Connections.FieldByName(fnID).AsInteger; if GDBMode = bkNormBase then begin DM.DeleteRecordFromTableByID(tnCrossConnection, IDConnection, qmPhisical); DM.MemTable_Connections.Delete; end else if GDBMode = bkProjectManager then begin ID_Component := PObjectData(Tree_Catalog.Selected.Data).ObjectID; IDConnected := DM.MemTable_Connections.FieldByName(fnIDChild).AsInteger; DelComplect(DM.MemTable_Connections.FieldByName(fnID).AsInteger, -1, ID_Component, IDConnected, nil, cntUnion); //F_ChoiceConnectSide.RefreshCurrListComponents; RefreshNode; end; EnableEditDel(itAuto); finally LockTreeAndGrid(false); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelConnectionExecute: '+E.Message); end; end; procedure TF_MAIN.DelNodeWithClearFieldInObject(ANode: TTreeNode); var SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; Dat: PObjectData; begin if GDBMode = bkProjectManager then begin Dat := ANode.Data; if IsComponItemType(Dat.ItemType) then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if SCSComponent <> nil then SCSComponent.TreeViewNode := nil; end else if IsCatalogItemType(Dat.ItemType) then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if SCSCatalog <> nil then SCSCatalog.TreeViewNode := nil; end; end; DeleteNode(ANode); end; // ##### Перемещает один узел дерева во второй ##### procedure TF_MAIN.MoveDir(ASrcNode, ATrgNode: TTreeNode); var ParentSNode: TTreeNode; ObjSrcParent: PObjectData; ObjTarget: PObjectData; ObjCurr: PObjectData; ObjSource: PObjectData; CatalogNewParentID: Integer; SrcNodeOldLevel: Integer; SrcOldCurrencyM: PObjectCurrencyRel; SrcCurrencyM: PObjectCurrencyRel; SrcCurrencyMAsOld: PObjectCurrencyRel; ComponOwner: TSCSCatalog; MoveInterface: Boolean; SCSComponent: TSCSComponent; OldCatalog: TSCSCatalog; OldParent: TSCSComponCatalogClass; NewCatalog: TSCSCatalog; SrcCatalog: TSCSCatalog; ParentSrcCatalog: TSCSCatalog; TrgCatalog: TSCSCatalog; MarkName: String; SCSTarget: TSCSComponCatalogClass; SCSSource: TSCSComponCatalogClass; IDObject: Integer; TrgQueryMode: TQueryMode; SrcQueryMode: TQueryMode; begin OldCatalog := nil; NewCatalog := nil; SrcCatalog := nil; ParentSrcCatalog := nil; TrgCatalog := nil; ComponOwner := nil; SCSTarget := nil; SCSSource := nil; TrgQueryMode := GetQueryModeByNode(GDBMode, ATrgNode, GetQueryModeByGDBMode(GDBMode)); SrcQueryMode := GetQueryModeByNode(GDBMode, ASrcNode, GetQueryModeByGDBMode(GDBMode)); ObjSrcParent := ASrcNode.Parent.Data; ObjTarget := ATrgNode.Data; ObjSource := ASrcNode.Data; ParentSNode := ASrcNode.Parent; SrcNodeOldLevel := ASrcNode.Level; SrcOldCurrencyM := nil; SrcCurrencyM := nil; SrcCurrencyMAsOld := nil; //*** Удаление интерфейсов с объекта на CAD-е MoveInterface := false; if (GDBMode = bkProjectManager) and (ObjSource.ItemType in [itComponLine, itComponCon]) then if ObjTarget.ItemType in [itSCSLine, itSCSConnector] then begin if GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID) <> nil then ComponOwner := GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID).GetFirstParentCatalog; //ComponOwner := GSCSBase.CurrProject.GetCatalogFromReferences(DM.GetIDCatalogByIDNoUppCompon(ObjSource.ObjectID)); //DM.GetCatalogByCompon(ObjSource.ObjectID); //*** Если компонента(компл-я) перемещается в другой объект if ComponOwner <> nil then if ComponOwner.ID <> ObjTarget.ObjectID then MoveInterface := true; end; if GDBMode = bkNormBase then begin OldCatalog := TSCSCatalog.Create(Tform(Self)); NewCatalog := TSCSCatalog.Create(Tform(Self)); end; //*** Если перемещаем в компонену if (ObjTarget.ItemType in [itComponLine, itComponCon]) or (ObjSource.ComponKind = ckCompl) then begin case GDBMode of bkNormBase: OldCatalog.LoadCatalogByID(DM.GetIDCatalogByIDNoUppCompon(ObjSource.ObjectID), false); bkProjectManager: begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID); if Assigned(SCSComponent) then OldCatalog := SCSComponent.GetFirstParentCatalog; // UNDO //SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); end; end; MoveCompl(ASrcNode, ATrgNode, smtDisplay, true); case GDBMode of bkNormBase: begin NewCatalog.LoadCatalogByID(DM.GetIDCatalogByIDNoUppCompon(ObjSource.ObjectID), false); SCSComponent := TSCSComponent.Create(TForm(Self)); SCSComponent.LoadComponentByID(ObjTarget.ObjectID); end; bkProjectManager: begin if Assigned(SCSComponent) then NewCatalog := SCSComponent.GetFirstParentCatalog; end; end; if Assigned(NewCatalog) and Assigned(OldCatalog) then begin if NewCatalog.ID = OldCatalog.ID then F_ChoiceConnectSide.OnAfterMoveComponInCatalog(SCSComponent); if NewCatalog.ID <> OldCatalog.ID then F_ChoiceConnectSide.OnAfterMoveComponBetweenCatalogs(SCSComponent, OldCatalog, NewCatalog); end; if GDBMode = bkNormBase then FreeAndNil(SCSComponent); end else //*** Если перемещаем в папку if Not(ObjTarget.ItemType in [itComponLine, itComponCon]) then begin //*** Контроль перемещения подключенных компонент между объектами if ObjSource.ItemType in [itComponLine, itComponCon] then if GDBMode = bkProjectManager then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID); OldCatalog := nil; NewCatalog := nil; if Assigned(SCSComponent) then OldCatalog := SCSComponent.GetFirstParentCatalog; NewCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ObjTarget.ObjectID); if Assigned(OldCatalog) and Assigned(NewCatalog) then if OldCatalog.ID <> NewCatalog.ID then if SCSComponent.HaveJoinWithOtherObject then begin ShowMessageByType(0, smtDisplay, cMain_Msg88_1+' "'+SCSComponent.GetNameForVisible(false)+'" '+cMain_Msg88_2+' "'+NewCatalog.GetNameForVisible(false)+'" '+cMain_Msg88_3, Application.Title, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; // UNDO SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); end; if GDBMode = bkNormBase then begin //*** Определить исходную валюту папки SrcOldCurrencyM := DM.GetCatalogCurrencyByMainFld(ObjSource.ObjectID, ctMain); end; OnAddDeleteNode(ASrcNode, nil, nil, false); MoveNodeTo(ASrcNode, ATrgNode, naAddChild); OnAddDeleteNode(ASrcNode, nil, nil, true); SortByVetv(ATrgNode); case ObjSource.ItemType of itDir, itProject, itList, itRoom, itSCSLine, itSCSConnector: begin CatalogNewParentID := ObjTarget.ObjectID; if GDBMode = bkProjectManager then begin SrcCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ObjSource.ObjectID); if ObjTarget.ItemType = itProject then begin TrgCatalog := GSCSBase.CurrProject; CatalogNewParentID := 0; end else TrgCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ObjTarget.ObjectID); end; if (GDBMode = bkNormBase) or ((ObjTarget.QueryMode = qmPhisical) and (ObjSource.QueryMode = qmPhisical)) then begin DM.UpdateCatalogFieldAsInteger(ObjSource.ObjectID, CatalogNewParentID, fnID, fnParentID, SrcQueryMode); DM.SaveCatalogParentIDToLists(ObjSource.ObjectID, CatalogNewParentID); //*** учет цен if GDBMode = bkNormBase then begin //DM.DeleteObjectCurrencies(ObjSource.ObjectID); //if ASrcNode.Level = dirCurrencyLevel then // DM.CreateDefCurrenciesForObject(ObjSource.ObjectID); //*** папка переместилась из внутри на уровень папок с валютами if (ASrcNode.Level = dirCurrencyLevel) and (SrcNodeOldLevel <> dirCurrencyLevel) then DM.CopyCurrenciesFromOtherObject(ObjSrcParent.ObjectID, ObjSource.ObjectID) else //*** папка переместилась из уровня папок (или из нутри) в внутрь другой if (ASrcNode.Level <> dirCurrencyLevel) and (SrcOldCurrencyM <> nil) then DM.DefineCatalogComponPricesAfterMoveToNewCatalog(ObjSource.ObjectID, SrcOldCurrencyM^); end; end; if Assigned(SrcCatalog) and Assigned(TrgCatalog) then begin ParentSrcCatalog := TSCSCatalog(SrcCatalog.Parent); if Assigned(ParentSrcCatalog) then ParentSrcCatalog.RemoveChildCatalogFromList(SrcCatalog); TrgCatalog.AddChildCatalogToList(SrcCatalog); end; //*** Определить новую маркировку if ObjSource.ItemType in [itSCSLine, itSCSConnector, itRoom] then begin if Assigned(SrcCatalog) then ReDefineObjectComponsNameMarks(SrcCatalog); end; end; itComponLine, itComponCon: begin if GDBMode = bkNormBase then begin OldCatalog.LoadCatalogByID(DM.GetIDCatalogByIDNoUppCompon(ObjSource.ObjectID), false); SCSComponent := TSCSComponent.Create(TForm(Self)); SCSComponent.LoadComponentByID(ObjSource.ObjectID); end; if GDBMode = bkProjectManager then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID); OldCatalog := nil; if Assigned(SCSComponent) then OldCatalog := SCSComponent.GetFirstParentCatalog; end; if GDBMode = bkNormBase then begin DM.UpdateCatRelFieldAsIntegerByFilter(ObjTarget.ObjectID, fnIDCatalog, 'id_component = '''+IntToStr(ObjSource.ObjectID)+''''); DM.SaveComponCatalogIDToLists(ObjSource.ObjectID, ObjSrcParent.ObjectID, ObjTarget.ObjectID); //*** Изменить цену компоненты по курсу новой папки DM.DefineComponPricesAfterMoveToNewCatalog(ObjSource.ObjectID, ObjSrcParent.ObjectID, ObjTarget.ObjectID); end; if GDBMode = bkNormBase then NewCatalog.LoadCatalogByID(ObjTarget.ObjectID, false); if GDBMode = bkProjectManager then begin NewCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(ObjTarget.ObjectID); if Assigned(NewCatalog) and Assigned(OldCatalog) then begin OldParent := TSCSComponCatalogClass(SCSComponent.Parent); OldCatalog.RemoveComponentFromList(SCSComponent); NewCatalog.AddComponentToList(SCSComponent); GSCSBase.CurrProject.ReindexPointComponentAfterChangeCatalogOwner(SCSComponent, OldParent, OldCatalog); { SCSComponent.ObjectID := NewCatalog.ID; SCSComponent.ListID := NewCatalog.ListID; SCSComponent.SaveComponent; } // Группировка по объектам DefineConnectorObjectNodeName(OldCatalog); //DefineObjectGroupForCatalog(OldCatalog); DefineConnectorObjectNodeName(NewCatalog); //DefineObjectGroupForCatalog(NewCatalog); end; end; if Assigned(NewCatalog) and Assigned(OldCatalog) then begin if NewCatalog.ID = OldCatalog.ID then F_ChoiceConnectSide.OnAfterMoveComponInCatalog(SCSComponent); if NewCatalog.ID <> OldCatalog.ID then F_ChoiceConnectSide.OnAfterMoveComponBetweenCatalogs(SCSComponent, OldCatalog, NewCatalog); end; if GDBMode = bkNormBase then FreeAndNil(SCSComponent); //ObjSource.ID_CompRel := 0; //ObjSource.ComponKind := ckCompon; end; end; ATrgNode.Expand(False); SetSortID(ASrcNode, nil); end; if GDBMode = bkNormBase then begin if Assigned(OldCatalog) then OldCatalog.Free; if Assigned(NewCatalog) then NewCatalog.Free; end; if GDBMode = bkProjectManager then //*** Если перемещена компонента, или комплектующая if (ObjSource.ItemType in [itComponLine, itComponCon]) then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ObjSource.ObjectID); if Assigned(SCSComponent) then begin NewCatalog := SCSComponent.GetFirstParentCatalog; if Assigned(NewCatalog) then begin SCSComponent.ObjectID := NewCatalog.ID; SCSComponent.ListID := NewCatalog.ListID; //SCSComponent.NameMark := MakeNameMarkComponent(SCSComponent, NewCatalog, false); //SCSComponent.SaveComponent; SCSComponent.DefineNameMarks; F_ChoiceConnectSide.DefineObjectSignature(NewCatalog); ATrgNode.Text := GetNameNode(ATrgNode, nil, true, true); ASrcNode.Text := GetNameNode(ASrcNode, nil, true, true); //RefreshComponMarks(NewCatalog.ID); //RefreshNodesText(ATrgNode, [itComponCon]); end; //SCSComponent.NameMark := MakeNameMarkComponent(SCSComponent, TSCSCatalog(SCSComponent.OwnerCatalog), true); //ASrcNode.Text := GetComponNameForVisible(SCSComponent.Name, SCSComponent.NameMark); //ASrcNode.Text := GetNameAndKol(ASrcNode.Text, SCSComponent.KolComplect); //*** Добавление интерфейсов на CAD if MoveInterface then begin if Assigned(ComponOwner) then AppendRemoveComponInterfacesInCADByAllParams(ComponOwner, nil, nil, arRemove); ComponOwner := SCSComponent.GetFirstParentCatalog; if Assigned(ComponOwner) then AppendRemoveComponInterfacesInCADByAllParams(ComponOwner, nil, nil, arAppend); end; end; end; if SrcOldCurrencyM <> nil then FreeMem(SrcOldCurrencyM); Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); ////*** Определить имена объектов //if ObjTarget.ItemType = itSCSConnector then // DefineConnectorObjectNodeName(ATrgNode); //*** Если цель была пустая end; // ##### Перемещает комплектующую в компоненту, или папку ##### procedure TF_MAIN.MoveCompl(ASrcNode, ATrgNode: TTreeNode; AShowMessageType: TShowMessageType; AIsFromUser: Boolean=false); var ComponSrc: TSCSComponent; ComponTrg: TSCSComponent; TargetCatalog: TSCSCatalog; CatalogOwner: TSCSCatalog; OldCatalogOwner: TSCSCatalog; ComponentOwner: TSCSComponent; OldParent: TSCSComponCatalogClass; ID_CompRel: Integer; ptrComplect: PComplect; SrcDat: PObjectData; TrgDat: PObjectData; PrntSrcDat: PObjectData; ParentSrcNode: TTreeNode; IDUpperSrcCompon: Integer; UpperCompon: TSCSComponent; //ParentCompon: TSCSComponent; //KolConnectInterfaces: Integer; CanConnect: Boolean; CanConnectInterf: TCanConnectKind; HaveInterfaces: Boolean; CanEdit: Boolean; NewSortID: Integer; QueryMode: TQueryMode; (* procedure DisconnectInterfaces(AID_CompRel: Integer); var InterfToNoBusy: TSCSInterfaces; Interfac: TSCSInterface; ptrComponInterf: TSCSInterface; i: Integer; begin {//*** Освободить интерфейсы SetSQLToQuery(DM.scsQOperat, ' update interface_relation set isbusy = ''0'' '+ ' where (id in ( select id_interf_rel from interfofinterf_relation '+ ' where ID_Comp_Rel = '''+ IntToStr(ID_CompRel) +''')) or '+ ' (id in ( select id_interf_to from interfofinterf_relation '+ ' where ID_Comp_Rel = '''+ IntToStr(ID_CompRel) +''')) '); SetSQLToQuery(DM.scsQOperat, ' DELETE FROM INTERFOFINTERF_RELATION ' + ' WHERE ID_Comp_Rel = '''+ IntToStr(AID_CompRel) +''' ');} InterfToNoBusy := DM.GetInterfacesThatInConnection(AID_CompRel); if Assigned(InterfToNoBusy) then begin for i := 0 to InterfToNoBusy.Count - 1 do begin Interfac := InterfToNoBusy[i]; DM.UpdateInterfFieldAsInteger(Interfac.ID, biFalse, fnIsBusy); DM.DeleteIOfIRelByFilter(fnIDCompRel+' = '''+IntToStr(AID_CompRel)+''''); if GDBMode = bkProjectManager then begin ptrComponInterf := GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(Interfac.ID, Interfac.ID_Component); if ptrComponInterf <> nil then ptrComponInterf.IsBusy := biFalse; end; end; //FreeList(InterfToNoBusy); InterfToNoBusy.Free; end; end; *) begin try HaveInterfaces := true; ComponSrc := nil; //ParentCompon := nil; ComponentOwner := nil; ComponTrg := nil; TargetCatalog := nil; CatalogOwner := nil; QueryMode := GetQueryModeByGDBMode(GDBMode); ParentSrcNode := ASrcNode.Parent; SrcDat := ASrcNode.Data; TrgDat := ATrgNode.Data; PrntSrcDat := ParentSrcNode.Data; if SrcDat.ComponKind = ckCompl then ID_CompRel := SrcDat.ID_CompRel; case GDBMode of bkNormBase: begin ComponSrc := TSCSComponent.Create(Self); ComponSrc.IDCompRel := GetIDCompRelFromNode(ASrcNode); ComponSrc.IDTopComponent := GetTopComponIDByNode(ASrcNode); ComponSrc.LoadComponentByID(PObjectData(ASrcNode.Data).ObjectID, false, true, false); ComponSrc.TreeViewNode := ASrcNode; ComponSrc.LoadChildComplectsQuick(true, false, true, ComponSrc.IDTopComponent, ComponSrc.IDCompRel); ComponSrc.LoadInterfaces; //ParentCompon := TSCSComponent.Create(TForm(Self)); //ParentCompon.LoadComponentByID(PrntSrcDat.ObjectID, false); //ParentCompon.TreeViewNode := ParentSrcNode; //ParentCompon.AddChildComponent(ComponSrc); end; bkProjectManager: begin ComponSrc := GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ASrcNode.Data).ObjectID); //if PrntSrcDat.ItemType in [itComponLine, itComponCon] then // ParentCompon := GSCSBase.CurrProject.GetComponentFromReferences(PrntSrcDat.ObjectID); end; end; if Not Assigned(ComponSrc) then Exit; ///// EXIT ///// try //ComponSrc.ID := PObjectData(ASrcNode.Data).ObjectID; //ComponTrg.ID := PObjectData(ATrgNode.Data).ObjectID; case TrgDat.ItemType of itDir, itList, itSCSConnector, itSCSLine: // Комплектующее перемещается в объект, или папку if SrcDat.ComponKind = ckCompl then begin TargetCatalog := nil; case GDBMode of bkNormBase: begin TargetCatalog := TSCSCatalog.Create(Self); TargetCatalog.LoadCatalogByID(TrgDat.ObjectID, false, false); TargetCatalog.TreeViewNode := ATrgNode; end; bkProjectManager: begin TargetCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(TrgDat.ObjectID); // UNDO if TargetCatalog <> nil then if AIsFromUser then SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); end; end; if Assigned(TargetCatalog) then begin OldCatalogOwner := ComponSrc.GetFirstParentCatalog; OldParent := TSCSComponCatalogClass(ComponSrc.Parent); ComponSrc.DisConnectFromParent; TargetCatalog.AddComponentToCatRel(ComponSrc); if GDBMode = bkProjectManager then GSCSBase.CurrProject.ReindexPointComponentAfterChangeCatalogOwner(ComponSrc, OldParent, OldCatalogOwner); end; (* if GDBMode = bkProjectManager then Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(TrgDat.ObjectID); if Assigned(ParentCompon) then begin if Assigned(Catalog) then begin ComponSrc.DisConnectFromParent; Catalog.AddComponentToList(ComponSrc); end else begin F_ChoiceConnectSide.DisconnectCompons(ParentCompon, ComponSrc, cntComplect); OnAddDeleteNode(ASrcNode, nil, false); end; ASrcNode.MoveTo(ATrgNode, naAddChild); OnAddDeleteNode(ASrcNode, nil, true); if GDBMode = bkNormBase then AppendToCatalRel(TrgDat.ObjectID, SrcDat.ObjectID); SrcDat.ComponKind := ckCompon; SortByVetv(ATrgNode); //SetKol(ATrgNode, nil); //SetKol(ParentSrcNode, nil); //if GDBMode = bkNormBase then //FreeAndNil(ParentCompon); //AppendRemoveComponInterfacesInCAD(ComponSrc.ID, arAppend); //Tree_Catalog.Selected := ASrcNode; end; *) end; itComponCon, itComponLine: begin case GDBMode of bkNormBase: begin ComponTrg := TSCSComponent.Create(Self); ComponTrg.IDCompRel := GetIDCompRelFromNode(ATrgNode); ComponTrg.IDTopComponent := GetTopComponIDByNode(ATrgNode); ComponTrg.LoadComponentByID(PObjectData(ATrgNode.Data).ObjectID, false, true, false); ComponTrg.TreeViewNode := ATrgNode; ComponTrg.LoadComplects(ComponTrg.IDTopComponent, ComponTrg.IDCompRel); ComponTrg.LoadInterfaces; end; bkProjectManager: ComponTrg := GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ATrgNode.Data).ObjectID); end; if Assigned(ComponTrg) then try CanConnect := CanConnCompon(ComponTrg, ComponSrc, cntComplect, AShowMessageType); if CanConnect then begin //CanConnectInterf := CanConnComponByinterf(Self, ComponTrg, ComponSrc, cnkVarious, cntComplect, true); //if CanConnectInterf = cckNone then if ComponTrg.CheckComplectWith(ComponSrc, false, true).CanConnect = false then begin HaveInterfaces := false; if Not GUseVisibleInterfaces then HaveInterfaces := true else if F_InputBox.ChoiceAddCompl(Self, ATrgNode, CanEdit, ComponTrg, ComponSrc, cntComplect, cnkVarious, ' '+cMain_Msg89, AShowMessageType) then HaveInterfaces := true; end; if (HaveInterfaces) or (CanEdit) then begin if AIsFromUser and (GDBMode = bkProjectManager) then SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); CatalogOwner := nil; case SrcDat.ComponKind of ckCompl: case GDBMode of bkNormBase: begin ComponentOwner := TSCSComponent.Create(Self); ComponentOwner.IDTopComponent := GetTopComponIDByNode(ParentSrcNode); ComponentOwner.IDCompRel := GetIDCompRelFromNode(ParentSrcNode); ComponentOwner.LoadComponentByID(PrntSrcDat.ObjectID, false, true, false); ComponentOwner.TreeViewNode := ParentSrcNode; ComponentOwner.AddChildComponent(ComponSrc); end; bkProjectManager: CatalogOwner := GSCSBase.CurrProject.GetCatalogFromReferences(PrntSrcDat.ObjectID); end; ckCompon: case GDBMode of bkNormBase: begin CatalogOwner := TSCSCatalog.Create(Self); CatalogOwner.LoadCatalogByID(PrntSrcDat.ObjectID, false, false); CatalogOwner.TreeViewNode := ParentSrcNode; CatalogOwner.AddComponentToList(ComponSrc); end; bkProjectManager: CatalogOwner := GSCSBase.CurrProject.GetCatalogFromReferences(PrntSrcDat.ObjectID); end; end; OldCatalogOwner := ComponSrc.GetFirstParentCatalog; OldParent := TSCSComponCatalogClass(ComponSrc.Parent); ComponSrc.ServNoDelNodeInDiscomplect := true; ComponSrc.DisConnectFromParent; ComponSrc.ServNoDelNodeInDiscomplect := false; //ComponSrc.TreeViewNode := FindComponOrDirInTree(ComponSrc.ID, true); ptrComplect := ComponTrg.ComplectWith(ComponSrc, -1, CanEdit); if GDBMode = bkProjectManager then GSCSBase.CurrProject.ReindexPointComponentAfterChangeCatalogOwner(ComponSrc, OldParent, OldCatalogOwner); //if HaveInterfaces then // ptrComplect := ComponTrg.ComplectWith(ComponSrc) //else //if CanConnect then //begin // ptrComplect := ComponTrg.ComplectWithOnlyObject(ComponSrc); //if ptrComplect <> nil then // SrcDat.ID_CompRel := ptrComplect.ID; //SrcDat.ComponKind := ckCompl; //SetSortID(ASrcNode); (* //LockTreeAndGrid(true); case SrcDat.ComponKind of ckCompl: begin //*** отсоединиться //F_ChoiceConnectSide.DisconnectCompons(ComponTrg, ComponSrc, cntComplect); ComponSrc.DisConnectFromParent; ID_CompRel := AppendToComponRel(ComponTrg.ID, ComponSrc.ID, 1, cntComplect); NewSortID := DM.GetIntFromTableByID(tnCompPropRelation, fnSortID, ID_CompRel, QueryMode); SrcDat.ID_CompRel := ID_CompRel; SrcDat.SortID := NewSortID; //*** Освободить интерфейсы //DisconnectInterfaces(ID_CompRel); //*** Найти для перемещаемой комплектующей новый SORT_ID //NewSortID := GenNewCompRelSortID(Self, ComponTrg.ID); //SrcDat.SortID := NewSortID; //*** Переместить комплектующую //DM.UpdateCompRelFieldAsInteger(ID_CompRel, ComponTrg.ID, fnIDComponent); //DM.UpdateCompRelFieldAsInteger(ID_CompRel, NewSortID, fnSortID); {//*** Освободить интерфейсы DisconnectInterfaces(ID_CompRel); //*** Найти для перемещаемой комплектующей новый SORT_ID SetSQLToQuery(DM.scsQSelect, ' select MAX(SORT_ID) As Max_Sort_ID from component_relation where id_component = '''+IntToStr(ComponTrg.ID)+''' '); NewSortID := DM.scsQSelect.GetFNAsInteger('Max_Sort_ID') + 1; SrcDat.SortID := NewSortID; //*** Переместить комплектующую SetSQLToQuery(DM.scsQOperat, ' update component_relation set '+ ' id_component = '''+ IntToStr(ComponTrg.ID) +''', '+ ' sort_id = '''+IntToStr(NewSortID)+''' '+ ' where id = '''+ IntToStr(ID_CompRel) +''' '); //CalcPriceForParents(ComponSrc.ID); } end; ckCompon: begin Catalog := nil; case GDBMode of bkNormBase: begin Catalog := TSCSCatalog.Create(Self); Catalog.LoadCatalogByID(PrntSrcDat.ObjectID, false, false); Catalog.AddComponentToList(ComponSrc); end; bkProjectManager: Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(PrntSrcDat.ObjectID); end; if Assigned(Catalog) then Catalog.RemoveComponentFromList(ComponSrc); {if GDBMode = bkProjectManager then begin Catalog := GSCSBase.CurrProject.GetCatalogFromReferences(PrntSrcDat.ObjectID); if Assigned(Catalog) then Catalog.RemoveComponentFromList(ComponSrc); end; DM.DeleteCatalogRelation(PrntSrcDat.ObjectID, SrcDat.ObjectID); ID_CompRel := AppendToComponRel(ComponTrg.ID, ComponSrc.ID, 1, cntComplect); SrcDat.ID_CompRel := ID_CompRel; SrcDat.ComponKind := ckCompl; SetSortID(ASrcNode); } end; end; //CalcPriceForParents(ComponTrg.ID); ConnectCompons(ComponTrg, ComponSrc, cnkVarious, cntComplect, ID_CompRel); if GDBMode = bkProjectManager then begin ComponTrg.AddChildComponent(ComponSrc); ptrComplect := ComponTrg.ComplectWithOnlyObject(ComponSrc); if ptrComplect <> nil then ptrComplect.ID := ID_CompRel; end; F_ChoiceConnectSide.OnAfterConnectCompons(ComponTrg, ComponSrc); ASrcNode.MoveTo(ATrgNode, naAddChild); OnAddDeleteNode(ASrcNode, nil, true); //SetKol(ATrgNode, nil); //SetKol(ParentSrcNode, nil); //Tree_Catalog.Selected := ASrcNode; *) end; end; finally if GDBMode = bkNormBase then begin FreeAndNil(ComponSrc); FreeAndNil(ComponTrg); if Assigned(CatalogOwner) then FreeAndNil(CatalogOwner); if Assigned(ComponentOwner) then FreeAndNil(ComponentOwner); end; end; end; end; //ComponSrc.Free; //Tree_Catalog.OnChange(Tree_Catalog, Tree_Catalog.Selected); //LockTreeAndGrid(false); finally if GDBMode = bkNormBase then begin if ComponSrc <> nil then FreeAndNil(ComponSrc); //FreeAndNil(ParentCompon); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.MoveCompl: '+E.Message); end; end; function TF_MAIN.DeleteDirByNode(ANode: TTreeNode): Boolean; var CurrData: PObjectData; DirName : String; DelMessg: String; DelNode: TTreeNode; NextSelNode: TTreeNode; DirComponIDs: TIntList; NotDel: Boolean; ObjectTypeName: String; ObjectTypeNames: String; ObjectTypeNameGnd: String; UserName: String; UserDateTime: TDateTime; SCSCatalog: TSCSCatalog; ParentObject: TBasicSCSClass; DelObject: TSCSCatalog; CatalogList: TSCSCatalogs; SCSListIDs: TintList; ParentProjNode: TTreeNode; IsSelected: Boolean; OldTick, CurrTick: Cardinal; begin try IsSelected := ANode = Tree_Catalog.Selected; DirName := ANode.Text; CutColFromStr(DirName); NotDel := false; CurrData := ANode.Data; ObjectTypeName := ''; ObjectTypeNames := ''; GetNameNodeType(ANode, ObjectTypeName, ObjectTypeNames, ObjectTypeNameGnd); ParentObject := nil; ParentProjNode := GetParentNodeByItemType(ANode, [itProject]); if (ParentProjNode = nil) or (ParentProjNode = ANode) then if Not CheckWritePM(true) then Exit; ///// EXIT ///// SCSCatalog := nil; try if GDBMode = bkNormBase then begin //16.02.2012 SCSCatalog := GSCSBase.SCSCatalog; SCSCatalog := TSCSCatalog.Create(Self); SCSCatalog.LoadCatalogByID(CurrData.ObjectID); DirComponIDs := DM.GetCatalogAllComponIDs(SCSCatalog.ID, true); try if GUseComponTemplates and Not DM.CheckNoDirComponsTemplates(SCSCatalog, DirComponIDs) then Exit; ///// EXIT ///// if Not DM.CheckNoDirComponsInComplects(SCSCatalog, DirComponIDs) then Exit; ///// EXIT ///// finally DirComponIDs.Free; end; end else if GDBMode = bkProjectManager then begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(CurrData.ObjectID); if SCSCatalog <> nil then begin if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then if Not CanDeleteObjectFromPM(SCSCatalog.ListID, SCSCatalog.SCSID) or IsLockedObject(SCSCatalog.ListID, SCSCatalog.SCSID) then begin PauseProgressByMode(true); try MessageModal(cMain_Msg43+' '+SCSCatalog.GetNameForVisible+'.', ApplicationName, MB_ICONINFORMATION or MB_OK); finally PauseProgressByMode(false); end; Exit; ///// EXIT ///// end; ParentObject := SCSCatalog.Parent; end; end; case CurrData.ItemType of itProject: if CheckProjectInUse(CurrData.ObjectID, UserName, UserDateTime) then if UserName <> GetComputerNetName then begin PauseProgressByMode(true); try ShowMessageByType(0, smtDisplay, cMain_Msg44_1+' '+ObjectTypeName+' '+cMain_Msg44_2+' '+UserName+'. ', cMain_Msg44_3+' '+ObjectTypeNames+'', MB_ICONINFORMATION or MB_OK); finally PauseProgressByMode(false); end; NotDel := True; end; // Есть ли в папке проекты, открытые другими юзерами itDir: if GDBMode = bkProjectManager then if DM.CheckHaveDirProjects(CurrData.ObjectID) then begin PauseProgressByMode(true); try MessageModal(cMain_Msg131, ApplicationName, MB_ICONINFORMATION or MB_OK); finally PauseProgressByMode(false); end; Exit; ///// EXIT ///// end; end; // Tolik // поскольку кабинеты удаляем без удаления содержимого, то и вопрос об удалении будем задавать соответственно // просто: удалить или нет(именно для кабинета) // if Tree_Catalog.Selected.Count > 0 then if ((Tree_Catalog.Selected.Count > 0) and (CurrData.ItemType <> itRoom)) then DelMessg := cMain_Msg45_1+' '+ObjectTypeNames+' "' + DirName + '" '+cMain_Msg45_2+'. '+ cMain_Msg45_3+' "' + DirName +'" ?' else DelMessg := cMain_Msg45_3+' '+ObjectTypeNameGnd+' "' + DirName +'" ?'; if Not NotDel then begin if Not FMultipleAction then if MessageModal(Delmessg, cMain_Msg45_1+' '+ObjectTypeNames+'', MB_YESNO or MB_ICONQUESTION) <> IDYES then NotDel := true; //NotDel := false; if Not NotDel then begin BeginProgress; try //CurrData := ANode.Data; DelNode := ANode; NextSelNode := GetNextSelNodeAfterDel(DelNode); //UNDO if GDBMode = bkProjectManager then if IsSCSObjectItemType(CurrData.ItemType) or (CurrData.ItemType = itRoom) then begin CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(GSCSBase.CurrProject.GetCatalogFromReferences(CurrData.ObjectID)); SCSListIDs := GetVariousListsIDsByObjects(CatalogList, true); try // Спросить - удалять кабели на тек участке, или по всей длине if IsSCSObjectItemType(CurrData.ItemType) and (CatalogList.Count > 0) then NotDel := Not BeforeDelObjectFromPM(cfBase, GSCSBase.CurrProject.CurrList.CurrID, CatalogList[0].SCSID, SCSListIDs); //16.02.2012 else //16.02.2012 SaveListsToUndoStack(SCSListIDs); if Not NotDel and Not FMultipleAction then SaveListsToUndoStack(SCSListIDs); finally FreeAndNil(SCSListIDs); FreeAndNil(CatalogList); end; end; if Not NotDel then begin GDragPrevTickCount := GetTickCount; DM.DelCatalog(cfBase, CurrData.ObjectID, CurrData.ItemType, CurrData.QueryMode, SCSCatalog); OnAddDeleteNode(DelNode, nil, ParentObject, false); if DelNode <> nil then DeleteNode(DelNode); // Новый текущий ноуд if IsSelected and Not FMultipleAction then begin if NextSelNode <> nil then Tree_Catalog.Selected := NextSelNode; SwitchInCAD(Tree_Catalog.Selected, ccOne); end; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; GDragCurrTickCount := GetTickCount - GDragPrevTickCount; //Tree_Catalog.Items.Delete(Tree_Catalog.Selected); end; finally EndProgress; end; end; end; finally if (GDBMode = bkNormBase) and (SCSCatalog <> nil) then FreeAndNil(SCSCatalog); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DeleteDirByNode', E.Message); end; end; procedure TF_MAIN.DeleteCatalog(ACatalog: TSCSCatalog; ANode: TTreeNode; AIgnoreCADConditions: Boolean=false); var Node: TTreeNode; ParentObject: TBasicSCSClass; begin if ACatalog = nil then Exit; ///// EXIT ///// if (GDBMode = bkNormBase) or AIgnoreCADConditions or (Not(ACatalog.ItemType in [itSCSLine, itSCSConnector]) or (CanDeleteObjectFromPM(ACatalog.ListID, ACatalog.SCSID) and Not IsLockedObject(ACatalog.ListID, ACatalog.SCSID)) ) then begin Node := ACatalog.TreeViewNode; if Node = nil then Node := FindComponOrDirInTree(ACatalog.ID, false); ParentObject := ACatalog.Parent; DM.DelCatalog(cfBase, ACatalog.ID, ACatalog.ItemType, ACatalog.QueryMode); if Node <> nil then begin OnAddDeleteNode(Node, nil, ParentObject, false); DeleteNode(Node); end; end; end; procedure TF_MAIN.pmnu_Test2Click(Sender: TObject); var InterfLists: TInterfLists; Txt: String; i: Integer; begin InterfLists := GetLineInterfacesFromPM(11); Txt := 'side1: '; for i := 0 to InterfLists.InterfList1.Count - 1 do Txt := Txt + IntToStr(Integer(InterfLists.InterfList1.Items[i]^)) + ', '; Txt := Txt + #13+'side2: '; for i := 0 to InterfLists.InterfList2.Count - 1 do Txt := Txt + IntToStr(Integer(InterfLists.InterfList2.Items[i]^)) + ', '; ShowMessage(Txt); end; procedure TF_MAIN.pmnu_test4Click(Sender: TObject); var TraceList: TList; i: Integer; MsgText: String; begin //isEmptyFigure(25); {MsgText := ''; TraceList := GetComponLineTrace(8101); for i := 0 to TraceList.Count - 1 do MsgText := MsgText + ', ' + IntToStr(Integer(TraceList.Items[i]^)); ShowMessage(MsgText); } SetLineFigureLengthInPM(71, 77); end; procedure TF_MAIN.GT_INTERFACECoordZPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); {var CurrNode: TTreeNode; ObjNode: TTreeNode; RecNo: Integer; IDFigure: Integer; CurrIDInterface: Integer; SCSCatalog: TSCSCatalog; ObjInterfaces: TInterfLists; } begin { try if GDBMode <> bkProjectManager then Exit; ///// EXIT ///// CurrNode := Tree_Catalog.Selected; ObjNode := GetParentNodeByItemType(CurrNode, [itSCSline, itSCSConnector]); SCSCatalog := TSCSCatalog.Create(TForm(Self)); try SCSCatalog.ID := PObjectData(ObjNode.Data).ObjectID; ObjNode := nil; ObjNode := GetTargetNodeForItemType(CurrNode, PObjectData(CurrNode.Data).ItemType); IDFigure := DM.GetScsIDByIDCatalog(PObjectData(ObjNode.Data).ObjectID); if ObjNode <> nil then begin case PObjectData(ObjNode.Data).ItemType of itSCSConnector: begin //SetPropertyValue(tkCatalog, PObjectData(ObjNode.Data).ObjectID, 'COORDZ', DisplayValue); ChangeConObjectCoordZ(PObjectData(ObjNode.Data).ObjectID, DisplayValue); //*** Изменение высоты на CAD-е SetConFigureCoordZInCAD(IDFigure, DisplayValue); end; itSCSLine: begin CurrIDInterface := DM.MemTable_InterfaceRel.FieldByName('id').AsInteger; ObjInterfaces := SCSCatalog.GetInterfIDLineObject; //GetLineFigureInterfListsFromCAD(IDFigure); if ObjInterfaces.InterfList1 <> nil then if Not CheckNoIDinList(CurrIDInterface, ObjInterfaces.InterfList1) then begin SetInterfacesCoordZ(ObjInterfaces.InterfList1, DisplayValue); //*** Изменить высоту стороны на CAD-e //SetLineFigureCoordZInCAD(IDFigure, 1, DisplayValue); end; if ObjInterfaces.InterfList2 <> nil then if Not CheckNoIDinList(CurrIDInterface, ObjInterfaces.InterfList2) then begin SetInterfacesCoordZ(ObjInterfaces.InterfList2, DisplayValue); //*** Изменить высоту стороны на CAD-e //SetLineFigureCoordZInCAD(IDFigure, 2, DisplayValue); end; end; end; //*** Обновить интерфейсы //GT_INTERFACE.BeginUpdate; DM.MemTable_InterfaceRel.DisableControls; try RecNo := DM.MemTable_InterfaceRel.RecNo; DM.SelectInterfaces(Tree_Catalog.Selected); DM.MemTable_InterfaceRel.RecNo := RecNo; finally DM.MemTable_InterfaceRel.EnableControls; //GT_INTERFACE.EndUpdate; end; end; finally FreeAndNil(SCSCatalog); end; except On E: Exception do AddExceptionToLog('TF_MAIN.GT_INTERFACECoordZPropertiesValidate: '+E.Message); end;} end; procedure TF_MAIN.pmnu__Test1Click(Sender: TObject); var List1, List2: TList; ptrConnectObjectParam: PConnectObjectParam; Dat: PobjectData; IDFigure: Integer; StringList: TStringList; begin DM.scsQ.ExecMemQuery(' select * from component, interface_relation '+ ' where (isline = ''0'') and (id_component.id = id_component) '); end; procedure TF_MAIN.pmnu__Test2Click(Sender: TObject); var List1, List2: TList; ptrId: ^Integer; TraceWithProperties: TTraceWithProperties; ResID: Integer; begin {List1 := Tlist.Create; List2 := Tlist.Create; New(ptrId); ptrId^ := 1801; List1.Add(ptrId); New(ptrId); ptrId^ := 1804; List2.Add(ptrId); DisconnectObjectsInPM(List1, List2);} //DisconnectObjectsInPM(1801, 1804); //DisconnectObjectsInPM(1804, 1802); {TraceWithProperties := GetAllTraceWithProperties(4553, 4555); ShowMessage(FloatToStr(TraceWithProperties.Length));} //HowFillConnectConObj(4614); {GetCurrListHeightRoom; GetCurrListHeightCeiling; //*** для потолка GetCurrListHeightSocket; //*** для розеток } {List1 := GetCurrListInterfaces; FreeList(List1);} //ResID := GetIDLineComponFromNBForAutoTracingByIDInterface(96); end; procedure TF_MAIN.pmnu__Test3Click(Sender: TObject); begin AddExceptionToLog('TF_MAIN.pmnu__Test3Click'+' Error '); end; procedure TF_MAIN.OnAddEditPropertyRel(AMakeEdit: TMakeEdit; APropKind: TPropKind; AMasterID: Integer; var AProperty: TProperty); var SCSCompon: TSCSComponent; SCSCatalog: TSCSCatalog; ptrProperty: PProperty; begin if GDBMode <> bkProjectManager then Exit; ///// EXIT ///// SCSCompon := nil; ptrProperty := nil; case APropKind of pkCompon: begin SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(AMasterID); if Assigned(SCSCompon) then begin case AMakeEdit of meMake: ptrProperty := SCSCompon.GetPropertyAsNew; meEdit: ptrProperty := SCSCompon.GetPropertyByID(AProperty.ID); end; //if ptrProperty <> nil then // ptrProperty^ := Aproperty; end; end; pkCatalog: begin SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(AMasterID); if Assigned(SCSCatalog) then begin case AMakeEdit of meMake: ptrProperty := SCSCatalog.GetPropertyAsNew; meEdit: ptrProperty := SCSCatalog.GetPropertyByID(AProperty.ID); end; //if ptrProperty <> nil then // ptrProperty^ := AProperty; end; end; end; if ptrProperty <> nil then begin ptrProperty.IDMaster := AProperty.IDMaster; ptrProperty.ID_Property := AProperty.ID_Property; ptrProperty.GUIDProperty := AProperty.GUIDProperty; ptrProperty.Name_ := AProperty.Name_; ptrProperty.SysName := AProperty.SysName; ptrProperty.TakeIntoConnect := AProperty.TakeIntoConnect; ptrProperty.TakeIntoJoin := AProperty.TakeIntoJoin; ptrProperty.Value := AProperty.Value; ptrProperty.IsDefault := AProperty.IsDefault; Aproperty.ID := ptrProperty.ID; end; end; procedure TF_MAIN.OnChangeComponPriceCalc(AIDComponent: Integer; AOldPrice, ANewPrice: Double); var ComponentNode: TTreeNode; NodeDat: PObjectData; NodeFontColor: TColor; i: Integer; begin if ((AOldPrice > 0) and (ANewPrice = 0)) or ((AOldPrice = 0) and (ANewPrice > 0)) then begin NodeFontColor := -1; if ANewPrice = 0 then NodeFontColor := GSCSIni.NB.ColorZeroPriceComponent; case GDBMode of bkNormBase: for i := 0 to Tree_Catalog.Items.Count - 1 do begin ComponentNode := Tree_Catalog.Items[i]; NodeDat := ComponentNode.Data; if (NodeDat.ObjectID = AIDComponent) and ((NodeDat.ComponKind = ckCompon) or (NodeDat.ComponKind = ckCompl)) and Not IsArchComponByItemType(NodeDat.ItemType) then NodeDat.FontColor := NodeFontColor; end; bkProjectManager: begin ComponentNode := FindTreeNodeByDat(AIDComponent, [itComponLine, itComponCon, itLinkCompLine, itLinkCompCon]); if (ComponentNode <> nil) and (ComponentNode.Data <> nil) then PObjectData(ComponentNode.Data).FontColor := NodeFontColor; end; end; end; end; procedure TF_MAIN.OnChangeComponPropertyVal(AProperty: PProperty; ACompon: TSCSComponent; AOldProperty: PProperty=nil); var ComponOwner: TSCSCatalog; NeedRefreshNode: Boolean; begin NeedRefreshNode := false; ComponOwner := ACompon.GetFirstParentCatalog; if GDBMode = bkNormBase then begin if GUseLiteFunctional then if ACompon.ID <> 0 then DefineUniversalInterfacesByProperty(ACompon, AProperty); end else if GDBMode = bkProjectManager then begin if ACompon.ID <> 0 then begin if AProperty.SysName = pnSignType then begin F_ChoiceConnectSide.DefineObjectIcon(ACompon.GetFirstParentCatalog); F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(ACompon, false); F_ChoiceConnectSide.DefineJoinedTrunkAfterChangeInFuture(ACompon); end; if AProperty.SysName = pnPercentCableLengthReserv then ACompon.RefreshWholeLengthInFuture; if AProperty.SysName = pnReservAtPointCompon then RefreshLengthInFutureJoinedToPointComponent(ACompon); if AProperty.SysName = pnReservThroughPointCompon then RefreshLengthInFutureNearPointObject(ACompon.GetFirstParentCatalog); if AProperty.SysName = pnDefect then if ComponOwner <> nil then begin F_ChoiceConnectSide.DefineObjectParamsByServFldsInFuture(ComponOwner, [dopStatus]); end; end; // свойства арх объекта, подгрузить на объект КАДа if IsArchComponByIsLine(ACompon.IsLine) then begin OnSetArchObjProp(AProperty, AOldProperty, ACompon); if ACompon.ID <> 0 then begin LoadArchObjPropsToCAD(ACompon); NeedRefreshNode := true; //02.10.2012 RefreshNode(false); end; end; end; if AProperty.SysName = pnHeightInUnits then begin ACompon.SetPropertyValueAsFloat(pnHeight, StrToFloatU(AProperty^.Value) * cUnitHeight, true); NeedRefreshNode := true; end; OnChangeComponProperty(ACompon, AProperty^.SysName); if NeedRefreshNode then RefreshNode(false); end; procedure TF_MAIN.OnChangeComponProperty(ACompon: TSCSComponent; const ASysName: String); var //SprCompType: TNBComponentType; ListOwner: TSCSList; TemplatePropSysName: String; OldNameMark: String; begin if GDBMode = bkProjectManager then begin ListOwner := ACompon.GetListOwner; if ListOwner <> nil then begin // Если в шаблоне маркиривки используется это свойство // так нельзя делать - с одним и тем же системным могут быть разные типы //SprCompType := ListOwner.Spravochnik.GetComponentTypeObjBySysName(ACompon.ComponentType.SysName); //if SprCompType <> nil then begin TemplatePropSysName := ASysName; //if TemplatePropSysName = 'MATERIAL' then // TemplatePropSysName := 'MT'; //if Pos('[TAG_'+TemplatePropSysName+']', SprCompType.ComponentType.MarkMask) > 0 then if Pos('[TAG_'+TemplatePropSysName+']', ACompon.ComponentType.MarkMask) > 0 then begin OldNameMark := ACompon.NameMark; ACompon.NameMark := F_ProjMan.MakeNameMarkComponent(ACompon, ACompon.GetFirstParentCatalog, true); if ACompon.NameMark <> OldNameMark then begin if ACompon.TreeViewNode <> nil then ACompon.TreeViewNode.Text := GetNameNode(ACompon.TreeViewNode, ACompon, true, true); ACompon.ApplyChanges; end; end; end; end; end; end; function TF_MAIN.OnCheckPropRelFormValue(ASender: TObject; AProp: PProperty; aDataSetProps: TDataSet): Boolean; var SCSCompon: TSCSComponent; ParentCompon: TSCSComponent; SiblingCompon: TSCSComponent; SProp: PProperty; i: Integer; PropValInt, SPropValInt: Integer; HeightInUnits, SHeightInUnits: Integer; FailMsg: String; //MTBookMark: String; MTBookMark: TBookMark; begin Result := true; SCSCompon := GetActualSelectedComponent; ParentCompon := nil; if SCSCompon <> nil then ParentCompon := SCSCompon.GetParentComponent; FailMsg := ''; // Позиция для дизайна if AProp.SysName = pnDesignUnitPos then if GDBMode = bkProjectManager then begin // Проверяем нет ли в соседних компонентах такого значения if ParentCompon <> nil then begin PropValInt := StrToIntDef(AProp^.Value, 0); if PropValInt <> 0 then begin // Получить высоту в юнитах текущего компонента HeightInUnits := 0; if aDataSetProps <> nil then begin //MTBookMark := aDataSetProps.Bookmark; MTBookMark := aDataSetProps.GetBookmark; try if aDataSetProps.Locate(fnSysName, pnHeightInUnits, []) then HeightInUnits := aDataSetProps.FieldByName(fnPValue).AsInteger; finally //aDataSetProps.Bookmark := MTBookMark; if MTBookMark <> nil then begin aDataSetProps.GotoBookmark(MTBookMark); aDataSetProps.FreeBookmark(MTBookMark); end; end; end else HeightInUnits := SCSCompon.GetPropertyValueAsInteger(pnHeightInUnits); for i := 0 to ParentCompon.ChildComplects.Count - 1 do begin SiblingCompon := ParentCompon.ChildComplects[i]; if SiblingCompon <> SCSCompon then begin SProp := SiblingCompon.GetPropertyBySysName(pnDesignUnitPos); if SProp <> nil then begin if SProp^.Value = AProp^.Value then begin FailMsg := cMain_Msg197; Break; //// BREAK //// end else // Не пересекается ли позиция по высоте в юнитах с другой позицией begin SPropValInt := StrToIntDef(SProp^.Value, 0); SHeightInUnits := SiblingCompon.GetPropertyValueAsInteger(pnHeightInUnits); if (SPropValInt < PropValInt) and (SHeightInUnits > 0) then begin if (SPropValInt + SHeightInUnits - 1) >= PropValInt then begin FailMsg := cMain_Msg198; Break; //// BREAK //// end; end else if (SPropValInt > PropValInt) and (HeightInUnits > 0) then begin if (PropValInt + HeightInUnits - 1) >= SPropValInt then begin FailMsg := cMain_Msg198; Break; //// BREAK //// end; end; end; end; end; end; end; end; end; if FailMsg <> '' then begin MessageInfo(FailMsg); Result := false; end; end; procedure TF_MAIN.OnSetComponPropertyVal(AMakeEdit: TMakeEdit; AProperty: PProperty; ACompon: TSCSComponent; AOldProperty: PProperty=nil); begin OnChangeComponPropertyVal(AProperty, ACompon, AOldProperty); if ACompon.ID <> 0 then begin if GDBMode = bkProjectManager then begin if AOldProperty^.Value <> AProperty^.Value then begin DefineComponNormResByProperty(ACompon, AProperty); if ACompon.ID = GSCSBase.SCSComponent.ID then DM.SelectNorms(ACompon.NormsResources); end; //*** Значение свойства по всей длине MakeEditPropertyForWholeComponent(AMakeEdit, ACompon, AProperty); end; ACompon.NotifyChange; end; end; procedure TF_MAIN.OnSetPropValueForm(ASender, AObj: TObject; AProp: PProperty; const AOldVal: String; AChecked: Boolean); var OldProp: TProperty; Catalog: TSCSCatalog; Compon: TSCSComponent; ComponProp: PProperty; i: Integer; begin if AObj is TSCSComponent then begin OldProp := AProp^; OldProp.Value := AOldVal; if TSCSComponent(AObj).ID <> 0 then begin OnSetComponPropertyVal(meEdit, AProp, TSCSComponent(AObj), @OldProp); if AChecked and Assigned(ASender) and (TF_ObjsProp(ASender).cbApplyForAllSameType.Checked) then begin // Устанавлиываем свойство для ысех объектов листа Catalog := TSCSComponent(AObj).GetListOwner; if Catalog <> nil then begin for i := 0 to Catalog.ComponentReferences.Count - 1 do begin Compon := Catalog.ComponentReferences[i]; if (Compon <> AObj) and (Compon.IsLine = TSCSComponent(AObj).IsLine) then if AllowApplyObjForAll(TSCSComponent(Compon)) then begin ComponProp := Compon.GetPropertyBySysName(AProp^.SysName); if ComponProp <> nil then begin OldProp.Value := ComponProp^.Value; ComponProp^.Value := AProp^.Value; OnSetComponPropertyVal(meEdit, ComponProp, TSCSComponent(Compon), @OldProp); end; end; end; end; end; end else DefinePropsByVal(TSCSComponent(AObj), AProp.SysName, AProp.Value); end; end; procedure TF_MAIN.OnClickCompon(ACompon: TSCSComponent); begin if (GDBMode = bkNormBase) and (GFormMode = fmNormal) then begin // на клике по компоненте сбросить режим "установка без dran&drop" if IsArchComponByIsLine(ACompon.IsLine) then DropCreateObjectOnClickMode; end; end; procedure TF_MAIN.OnpmiInterfPathClick(Sender: TObject); var Interf: TSCSInterface; Compon: TSCSComponent; begin ShowPathByInterfPosition(TObject(TWinControl(Sender).Tag){, nil, TSCSInterfPosition(TWinControl(Sender).Tag)}); end; procedure TF_MAIN.OnSelectCompon(ACompon: TSCSComponent); begin if GFormMode = fmNormal then begin if GDBMode = bkNormBase then begin // Определяем слой, для режима Drag&Drop DefineCurrLayerByCompon; // Tolik 11/03/2021 -- if GSCSBase.SCSComponent <> nil then if GSCSBase.SCSComponent.IsLine = biTrue then if GCadForm <> nil then GCadForm.FCreateObjectOnClick := False; end; //PageScroller_Cost.Visible := Not IsArchComponByIsLine(ACompon.IsLine); SetPriceCostPanel; end; end; procedure TF_MAIN.OnUpdateComponent(AMakeEdit: TMakeEdit; AOldComponent, ANewComponent: TSCSComponent; AChangedComponIndex, AChangedNameShort: Boolean); var ComponObject: TSCSCatalog; DesignList: TSCSList; i: Integer; JoinedComponent: TSCSComponent; OldNameMark: String; begin DesignList := nil; if Assigned(ANewComponent) then begin if Assigned(ANewComponent.TreeViewNode) then ANewComponent.TreeViewNode.Text := GetNameNode(ANewComponent.TreeViewNode, ANewComponent, true, true); if (AOldComponent = nil) or Not CmpFloatByCP(ANewComponent.Price, RoundCP(AOldComponent.Price)) then CalcPriceForParents(ANewComponent.ID); ComponObject := nil; ComponObject := ANewComponent.GetFirstParentCatalog; if Assigned(ComponObject) then begin //28.08.2013 if AChangedNameShort then begin OldNameMark := ANewComponent.NameMark; ANewComponent.NameMark := MakeNameMarkComponent(ANewComponent, ComponObject, true); if ANewComponent.NameMark <> OldNameMark then if ANewComponent.TreeViewNode <> nil then ANewComponent.TreeViewNode.Text := GetNameNode(ANewComponent.TreeViewNode, ANewComponent, true, true); end; if AChangedComponIndex and ANewComponent.IsTop then F_ChoiceConnectSide.DefineChildComponsMarksByTop(ANewComponent, nil); if ComponObject.ItemType = itSCSConnector then if ANewComponent.IsTop then begin DefineConnectorObjectNodeName(ComponObject); if Assigned(ComponObject.TreeViewNode) then begin //10.08.2012 DefineConnectorObjectNodeName(ComponObject); DefineObjectNodeGroup(ComponObject.TreeViewNode, ANewComponent.GUIDComponentType, biFalse); end; end; //*** Магистральные компоненты if IsTrunkComponent(ANewComponent) then F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(ANewComponent, false); F_ChoiceConnectSide.DefineJoinedTrunkAfterChangeInFuture(ANewComponent); F_ChoiceConnectSide.RefreshApproachInCAD(ANewComponent); F_ChoiceConnectSide.DefineObjectParams(ComponObject); //F_ChoiceConnectSide.DefineObjectParamsInFuture(ComponObject); RefreshLengthInFutureJoinedToPointComponent(ANewComponent); RefreshLengthInFutureNearPointObject(ComponObject); end; if GDBMode = bkProjectManager then begin //*** Переименовать лист с дизайном компоненты if ANewComponent.ComponentType.SysName = ctsnCupBoard then begin DesignList := GSCSBase.CurrProject.GetDesignListByComponent(ANewComponent); if Assigned(DesignList) then begin RenameNode(cfBase, DesignList.TreeViewNode, DesignList, GetListDesignedName(DesignList.Setting.IDFigureForDesignList)); DesignList.TreeViewNode.Text := GetNameNode(DesignList.TreeViewNode, DesignList, true, true); end; end; // Учесть маркировки RemarkComponAfterChangePort(ANewComponent); //*** Отключать демонтированный кабель if ANewComponent.IsDismount = biTrue then begin i := 0; while i <= ANewComponent.JoinedComponents.Count - 1 do begin JoinedComponent := ANewComponent.JoinedComponents[i]; if ANewComponent.GuidNB <> JoinedComponent.GuidNB then ANewComponent.DisJoinFrom(JoinedComponent) else Inc(i); end; end; end; ANewComponent.NotifyChange; end; end; function TF_MAIN.SetComponPropValue(ACompon: TSCSComponent; const APropSN, AValue: String): Boolean; var OldVal: String; Prop: PProperty; begin Result := false; Prop := ACompon.GetPropertyBySysName(APropSN); if Prop <> nil then begin OldVal := Prop.Value; Prop.Value := AValue; Self.OnSetPropValueForm(nil, ACompon, Prop, OldVal, false); Self.RefreshNode(false); Result := true; end; end; function TF_MAIN.RefreshTreeNodeComponent(ANode: TTreeNode): TSCSComponent; var NodeDat: PObjectData; SCSCompon: TSCSComponent; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin Result := nil; NodeDat := nil; SCSCompon := nil; GSCSBase.SCSComponent.Clear; if ANode <> nil then NodeDat := ANode.Data; if (NodeDat <> nil) and (IsComponItemType(NodeDat.ItemType)) then //if (NodeDat <> nil) and (NodeDat.ItemType in [itComponLine, itComponCon]) then if GDBMode = bkNormBase then begin GSCSBase.SCSComponent.Clear; GSCSBase.SCSComponent.IDTopComponent := GetTopComponIDByNode(ANode); GSCSBase.SCSComponent.IDCompRel := GetIDCompRelFromNode(ANode); GSCSBase.SCSComponent.LoadComponentByID(NodeDat.ObjectID, false, true, false); OldTick := GetTickCount; GSCSBase.SCSComponent.LoadChildComplectsQuick(true, false, true, GSCSBase.SCSComponent.IDTopComponent, GSCSBase.SCSComponent.IDCompRel); GSCSBase.SCSComponent.LoadComponentType; GSCSBase.SCSComponent.LoadInterfaces; GSCSBase.SCSComponent.LoadProperties; //Tolik 15/11/2021 - - для труб будем грузить элементы соединений как соединения каб каналов, // поскольку они сидят в одной таблице //if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel then if (GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel) or (GSCSBase.SCSComponent.ComponentType.SysName = ctsnTube) then // GSCSBase.SCSComponent.LoadCableCanalConnectors; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then GSCSBase.SCSComponent.LoadCrossConnections; //GSCSBase.SCSComponent.LoadChildComplectsQuick(true, false, true); GSCSBase.SCSComponent.NormsResources.LoadNorms(false, true); GSCSBase.SCSComponent.NormsResources.LoadResources(true); GSCSBase.SCSComponent.TreeViewNode := ANode; GSCSBase.SCSComponent.ServAllLoaded := false; SCSCompon := GSCSBase.SCSComponent; //SaveComponAllIOfIRelsToFile(GSCSBase.SCSComponent); GSCSBase.SCSCatalog.Clear; end else begin SCSCompon := nil; SCSCompon := GSCSBase.CurrProject.GetComponentFromReferences(NodeDat.ObjectID); if Assigned(SCSCompon) then begin //*** Проверить длину цельного кабеля SCSCompon.RefreshWholeLengthIfNecessary; //*** нормы интерфейсов if FIsDefineInterfaceNormsOnChangeNode then SCSCompon.DefineInterfaceNorms(true); //GSCSBase.SCSComponent.NormsResources.Assign(SCSCompon.NormsResources); if IsArchComponByIsLine(SCSCompon.IsLine) then begin LoadArchObjPropsFromCAD(SCSCompon); end; GSCSBase.SCSComponent.AssignOnlyComponent(SCSCompon); GSCSBase.SCSComponent.ProjectOwner := GSCSBase.CurrProject; end; end; Result := SCSCompon; end; procedure TF_MAIN.ShowComponObjects(ANode: TTreeNode; ACompon: TSCSComponent); var IsArchCompon: Boolean; begin DefineLocalCurrency; if Assigned(GSCSBase.SCSComponent) then begin ShowPrice; {GT_Compon_Relation.DataController.DataSource := nil; GT_PROPERTY.DataController.DataSource := nil; GT_INTERFACE.DataController.DataSource := nil; GT_Connections.DataController.DataSource := nil;} if GFormMode = fmNormal then DM.SelectCompSub(ANode, ACompon); {GT_Compon_Relation.DataController.DataSource := DM.DataSource_MT_Complects; GT_PROPERTY.DataController.DataSource := DM.DataSource_MT_Property; GT_INTERFACE.DataController.DataSource := DM.DataSource_MT_InterfaceRel; GT_Connections.DataController.DataSource := DM.DataSource_MT_Connections;} if GDBMode = bkProjectManager then begin //if Not GL_Compon_Relation.Visible then // GL_Compon_Relation.Visible := true; //if Not GL_INTERFACE.Visible then // GL_INTERFACE.Visible := true; //if Not GL_PORT.Visible then // GL_PORT.Visible := true; //if Not GL_Connections.Visible then // GL_Connections.Visible := true; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, GTemplateContCompl or (GSCSBase.SCSComponent.IsTemplate = biFalse)); SetVisibleGridLevel(GL_Interface, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_INTERFACE, tcGridData, true); SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_Connections, tcGridData, true); SetVisibleGridLevel(GL_NormsRerources, tcGridData, true); tcGridData.TabIndex := GActiveLevelIndex; //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //Grid_CompData.OnActiveTabChanged(Grid_CompData, Grid_CompData.ActiveLevel); end else begin SetVisibleGridLevel(GL_Compon_Relation, tcGridData, true); if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then SetVisibleGridLevel(GL_CrossConnection, tcGridData, true) else SetVisibleGridLevel(GL_CrossConnection, tcGridData, false); //*** подключения в НБ if IsCanNBComponNodeHaveConnection(ANode) then SetVisibleGridLevel(GL_Connections, tcGridData, true) else SetVisibleGridLevel(GL_Connections, tcGridData, false); end; SetVisibleGridLevel(GL_Interface, tcGridData, GUseVisibleInterfaces); if GSCSBase.SCSComponent.IsLine = biTrue then begin GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; SetVisibleGridLevel(GL_PORT, tcGridData, false); //Tolik 12/11/2021 -- заюзаем ту же табличку для элементов трубных соединений, поэтому закладочку и табличку // сделаем видимыми и доступными и для компонентов типа "труба" //SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, (GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel) or (GSCSBase.SCSComponent.ComponentType.SysName = ctsnTube)); if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel then begin tcGridData.Tabs[GL_CableCanalConnectors.Index].Caption := Capt_CableChanElements; //Grid_CompDataActiveTabChanged(tcGridData, GL_CableCanalConnectors); Grid_CompDataActiveTabChanged(Grid_CompData, GL_CableCanalConnectors); //tcGridData.Change; //GL_CableCanalConnectors.Index := GL_CableCanalConnectors.Index; //SetActToToolComponData(Act_AddCableChannelElement, Act_EditCableChannelElement, Act_DelCableChannelElement); end else if GSCSBase.SCSComponent.ComponentType.SysName = ctsnTube then begin tcGridData.Tabs[GL_CableCanalConnectors.Index].Caption := Capt_TubeConnElements; //Grid_CompDataActiveTabChanged(tcGridData, GL_CableCanalConnectors); Grid_CompDataActiveTabChanged(Grid_CompData, GL_CableCanalConnectors); //tcGridData.Change; //GL_CableCanalConnectors.Index := GL_CableCanalConnectors.Index; //SetActToToolComponData(Act_AddTubeElement, Act_EditTubeElement, Act_DelTubeElement); end; // //if GL_PORT.Visible then //begin // GActiveLevelIndex := Grid_CompData.ActiveLevel.Index; // SetVisibleGridLevel(GL_PORT, tcGridData, false); //end; //GT_INTERFACEMultiple.Visible := true; //GT_INTERFACEValueI.Visible := true; GT_InterfaceNumPairsStr.Visible := true; //GT_INTERFACEColor.Visible := true; GT_INTERFACESide.Visible := true; tcGridData.Tabindex := GActiveLevelIndex; // Tolik 15/11/2021 -- end else begin SetVisibleGridLevel(GL_PORT, tcGridData, GUseVisibleInterfaces); //14.05.2009 SetVisibleGridLevel(GL_PORT, tcGridData, true); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, false); //if Not GL_PORT.Visible then //begin // SetVisibleGridLevel(GL_PORT, tcGridData, true); // //Grid_CompData.ActiveLevel := Grid_CompData.Levels.Items[GActiveLevelIndex]; //end; //GT_INTERFACEMultiple.Visible := false; //GT_INTERFACEValueI.Visible := false; GT_InterfaceNumPairsStr.Visible := false; //GT_INTERFACEColor.Visible := false; GT_INTERFACESide.Visible := false; end; GT_NormsResourcesExpenseForLength.Visible := GSCSBase.SCSComponent.IsLine = biTrue; GT_NormsResourcesCountForPoint.Visible := GT_NormsResourcesExpenseForLength.Visible; GT_NormsResourcesStepOfPoint.Visible := GT_NormsResourcesExpenseForLength.Visible; GT_NormsResourcesTotalKolvo.Visible := GT_NormsResourcesExpenseForLength.Visible; end; //if SCSCompon <> nil then // IsLine := SCSCompon.IsLine = biTrue; GT_PROPERTYTakeIntoConnect.Visible := true; GT_PROPERTYTakeIntoJoin.Visible := true; if ACompon.IsLine = biTrue then GT_INTERFACEMultiple.Caption := GetNameInterfaceMultipleForLine //CMultipleLineInterface else GT_INTERFACEMultiple.Caption := CMultiplePoinInterface; IsArchCompon := IsArchComponByIsLine(ACompon.IsLine); if IsArchCompon then begin GT_PROPERTYTakeIntoConnect.Visible := false; GT_PROPERTYTakeIntoJoin.Visible := false; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, false); SetVisibleGridLevel(GL_Interface, tcGridData, false); SetVisibleGridLevel(GL_PORT, tcGridData, false); SetVisibleGridLevel(GL_NormsRerources, tcGridData, false); if (ACompon.IsLine <> ctArhRoofHip) and (ACompon.IsLine <> ctArhRoofHipCorner) and (ACompon.IsLine <> ctArhRoofSeg) then SetVisibleGridLevel(GL_Connections, tcGridData, false); end; GT_ConnectionsIsNative.Visible := Not IsArchCompon; GT_ConnectionsRelType.Visible := IsArchCompon; end; procedure TF_MAIN.GT_PROPERTYInitEdit(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem; AEdit: TcxCustomEdit); begin //FEditingPropertyValue := true; end; {procedure TF_MAIN.Grid_CompDataMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Grid_CompData.ActiveLevel.Index = cdliProperty then if (X <= 25) or (Y <=25) or (X >= Grid_CompData.Width - 25) or (Y >= Grid_CompData.Height - 25) then begin //ShowMessage(IntToStr(X) + ', '+ IntToStr(Y)); if GT_PROPERTY.DataController.IsEditing then GT_PROPERTY.DataController.Post; end; end; } procedure TF_MAIN.GT_PROPERTYEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); begin {if GT_PROPERTY.DataController.IsEditing then begin GT_PROPERTY.OnEditValueChanged := nil; Timer_PostProperty.Enabled := true; end;} end; procedure TF_MAIN.Timer_PostPropertyTimer(Sender: TObject); begin Timer_PostProperty.Enabled := false; GT_PROPERTY.DataController.Post; GT_PROPERTY.OnEditValueChanged := GT_PROPERTYEditValueChanged; end; // ##### Соединит комплектующую (Шкафа -> Патч палель с...) ##### procedure TF_MAIN.Act_ConnectComplWithExecute(Sender: TObject); begin if GDBMode = bkProjectManager then CreateFConnectComplWith.ConnectComplWith(Tree_Catalog.Selected); end; procedure TF_MAIN.GT_InterfaceNppGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33; end; procedure TF_MAIN.GT_PORTNppGetDisplayText(Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33; end; procedure TF_MAIN.Grid_CompDataMouseLeave(Sender: TObject); var PosXY: TPoint; begin //if GT_PROPERTY.DataController.IsEditing then //Beep; //GetCursorPos(PosXY); //SendMessage(Grid_CompData.Handle, WM_LBUTTONDBLCLK, MK_LBUTTON, PosXY.X+300 + PosXY.Y shl 16); //GT_PROPERTY.DataController.Set //Grid_CompData.SetFocus //if GT_PROPERTY.DataController.IsEditing then // Beep; //if FEditingPropertyValue then //if GT_PROPERTY.DataController.IsEditing then // GT_PROPERTY.DataController.Post; end; procedure TF_MAIN.Act_MnuActionsExecute(Sender: TObject); begin // Процедура нужна для Enabled в меню end; procedure TF_MAIN.Act_MnuCADActionsExecute(Sender: TObject); begin // Процедура нужна для Enabled в меню end; procedure TF_MAIN.Act_MnuReportsExecute(Sender: TObject); begin CreateFResourceReport.ShowWizard([rkProject]); end; function TF_MAIN.GetSpravochnik: TSpravochnik; begin Result := nil; if GDBMode = bkNormBase then Result := GSCSBase.NBSpravochnik else if GDBMode = bkProjectManager then if GSCSBase.CurrProject <> nil then Result := GSCSBase.CurrProject.Spravochnik; end; procedure TF_MAIN.StartCreepingNode(ANode: TTreeNode; ACreepText: String); begin if Assigned(ANode) then begin FCreepNode := ANode; FCreepIndex := 5; FNativeNodeText := ANode.Text; FNodeCreepingText := ACreepText; ShowNode(Tree_catalog, ANode); Timer_CreepingNode.Enabled := true; end; end; procedure TF_MAIN.StopCreepingNode; begin Timer_CreepingNode.Enabled := false; FCreepNode.Text := FNativeNodeText; end; procedure TF_MAIN.Timer_CreepingNodeTimer(Sender: TObject); var ResText: String; begin ResText := ''; ResText := FNativeNodeText + DupStr('<', FCreepIndex); ResText := ResText + FNodeCreepingText; FCreepNode.Text := ResText; Dec(FCreepIndex); if FCreepIndex = 0 then FCreepIndex := 5; end; procedure TF_MAIN.AddComponInfoToStrings(AID, AIsLine: Integer; AName: string; AStrings: TStringList); var Dat: PObjectData; begin NewData(Dat, ttComponents); Dat.ObjectID := AID; Dat.ItemType := GetSCSComponType(AIsLine); Dat.ComponKind := ckCompon; Dat.QueryMode := qmUndef; AStrings.AddObject(AName, TObject(Dat)); end; procedure TF_MAIN.LoadItemsToListViewFromStringList(AStringList: TStringList); var i: Integer; ItemDat: PObjectData; ListItem: TListItem; begin AStringList.Sort; ListView_Find.OnChange := nil; ListView_Find.Items.BeginUpdate; try for i := 0 to AStringList.Count - 1 do begin ItemDat := PObjectData(AStringList.Objects[i]); ListItem := ListView_Find.Items.Add; ListItem.Caption := AStringList[i]; ListItem.ImageIndex := 1; ListItem.Data := ItemDat; SetListItemImageIndex(ListItem); end; finally ListView_Find.Items.EndUpdate; ListView_Find.OnChange := ListView_FindChange; end; end; procedure TF_MAIN.ApplyComponentFilter(AOldFilter, ANewFilter: TFilterParams; ADefineUserParams: Boolean); var FilterVarious: Boolean; i: Integer; OldFilterBlock: TFilterBlock; NewFilterBlock: TFilterBlock; OldFilterBlockUse: Boolean; NewFilterBlockUse: Boolean; Nodes: TObjectList; ExpandedNodes: TObjectList; PrevNode: TTreeNode; Node: TTreeNode; NodeDat: PObjectData; ChildNode: TTreeNode; ParentNode: TTreeNode; LoadNextNode: Boolean; SavedUseFilterOnChange: TNotifyEvent; SCSList: TSCSList; function GetIsUse(ANewFilterParams: TFilterParams): Boolean; begin Result := false; if ANewFilterParams <> nil then Result := ANewFilterParams.IsUseFilter; //if ANewFilter <> nil then // if ANewFilter.IsOn then // Result := true; end; begin FilterVarious := false; OldFilterBlockUse := GetIsUse(AOldFilter); NewFilterBlockUse := GetIsUse(ANewFilter); if ADefineUserParams and (ANewFilter.FFilterBlock <> nil) then DefineComponentFilterUserParams(ANewFilter.FFilterBlock); //*** определить разное ли содержание фильтра if OldFilterBlockUse <> NewFilterBlockUse then FilterVarious := true else if NewFilterBlockUse then begin if AOldFilter.FFilterType <> ANewFilter.FFilterType then FilterVarious := true else if Not IsEqualFilterBlocks(AOldFilter.FFilterBlock, ANewFilter.FFilterBlock) then FilterVarious := true; {if (AOldFilter.FFilterBlock.AllChildBlocks.Count <> ANewFilter.FFilterBlock.AllChildBlocks.Count) then FilterVarious := true else for i := 0 to AOldFilter.FFilterBlock.AllChildBlocks.Count - 1 do begin OldFilterBlock := TFilterBlock(AOldFilter.FFilterBlock.AllChildBlocks[i]); NewFilterBlock := TFilterBlock(ANewFilter.FFilterBlock.AllChildBlocks[i]); if OldFilterBlock.BlockType <> NewFilterBlock.BlockType then begin FilterVarious := true; Break; //// BREAK //// end else if OldFilterBlock.ConditionType <> NewFilterBlock.ConditionType then begin FilterVarious := true; Break; //// BREAK //// end else if OldFilterBlock.IsOn <> NewFilterBlock.IsOn then begin FilterVarious := true; Break; //// BREAK //// end else if ((OldFilterBlock.Condition = nil) and (NewFilterBlock.Condition <> nil)) or ((OldFilterBlock.Condition <> nil) and (NewFilterBlock.Condition = nil)) then begin FilterVarious := true; Break; //// BREAK //// end else if (OldFilterBlock.Condition <> nil) and (NewFilterBlock.Condition <> nil) then begin if OldFilterBlock.Condition.CompareType <> NewFilterBlock.Condition.CompareType then begin FilterVarious := true; Break; //// BREAK //// end else if OldFilterBlock.Condition.FieldIndex <> NewFilterBlock.Condition.FieldIndex then begin FilterVarious := true; Break; //// BREAK //// end else if OldFilterBlock.Condition.FilterValue <> NewFilterBlock.Condition.FilterValue then begin FilterVarious := true; Break; //// BREAK //// end; end; end;} end; if FilterVarious then begin Nodes := TObjectList.Create(false); // Tolik 21/05/2018 -- вроде как не юзается здесь.... // ExpandedNodes := TObjectList.Create(false); // Tree_Catalog.Items.BeginUpdate; BeginProgress; try if GDBMode = bkNormBase then ReloadNodes(nil) else if GDBMode = bkProjectManager then for i := 0 to GSCSBase.CurrProject.ProjectLists.Count - 1 do begin SCSList := GSCSBase.CurrProject.ProjectLists[i]; if SCSList.TreeViewNode <> nil then begin ClearTVNodeFieldInChildObjects(SCSList, false); ReloadNodes(SCSList.TreeViewNode); end; end; (* while Node <> nil do begin LoadNextNode := true; if Node.IsVisible and (Node.Expanded or (Node.Count = 0)) then begin NodeDat := Node.Data; //*** Если видимая папка, то знести ее в список if (IsCatalogItemType(NodeDat.ItemType) and (GDBMode = bkNormBase)) or (IsSCSObjectItemType(NodeDat.ItemType) and (GDBMode = bkProjectManager)) then begin //if Node.Expanded then // Nodes.Add(Node); Nodes.Add(Node); if Node.Expanded then ExpandedNodes.Add(Node); //*** Удалить ветви компонент ChildNode := Node.getFirstChild; while ChildNode <> nil do begin if IsComponentNode(ChildNode) then begin PrevNode := ChildNode; ChildNode := ChildNode.getNextSibling; if Node.Count = 1 then Node.Expanded := false; //DeleteNode(PrevNode); DelNodeWithClearFieldInObject(PrevNode); end else ChildNode := ChildNode.GetNextSibling; end; end {else //*** если компонент, то удалить его из дерева if IsComponItemType(NodeDat.ItemType) then begin PrevNode := Node; Node := Node.GetNextVisible; LoadNextNode := false; ParentNode := PrevNode.Parent; //*** если удаляется последняя подветвь if (ParentNode <> nil) and (ParentNode.Count = 1) then ParentNode.Expanded := false; DeleteNode(PrevNode); end;} end else if Node.IsVisible then begin Nodes.Add(Node); if Node.Expanded then ExpandedNodes.Add(Node); Node.Expanded := false; //DeleteChildNodes(Node); ChildNode := Node.getFirstChild; while ChildNode <> nil do begin PrevNode := ChildNode; ChildNode := ChildNode.getNextSibling; DelNodeWithClearFieldInObject(PrevNode); end; end else if Not Node.IsVisible then begin EmptyProcedure; {PrevNode := Node; Node := Node.GetNextVisible; LoadNextNode := false; ParentNode := PrevNode.Parent; //*** если удаляется последняя подветвь if (ParentNode <> nil) and (ParentNode.Count = 1) then ParentNode.Expanded := false; DeleteNode(PrevNode); } end; if LoadNextNode then Node := Node.GetNextVisible; end; //*** востановить компоненты for i := 0 to Nodes.Count - 1 do begin Node := TTreeNode(Nodes[i]); if Node.Count > 0 then begin FillCompons(Node, true, GetQueryModeByGDBMode(GDBMode)); Node.Expanded := true; end else begin DefineCatalogNodeHasChildren(Node, GetCatalogNodeChildCatalogCount(Node), GetCatalogNodeComponCount(Node)); //AddNodes(Node); end; end; for i := 0 to ExpandedNodes.Count - 1 do TTreeNode(ExpandedNodes[i]).Expanded := true;*) finally EndProgress; Tree_Catalog.Items.EndUpdate; FreeAndNil(Nodes); end; RefreshNode(true); end; Act_ComponFilter.Hint := cMain_Msg142_1; SavedUseFilterOnChange := cbUseFilter.OnClick; cbUseFilter.OnClick := nil; try //cbUseFilter.Checked := false; lbFilterUserValue.Caption := ''; lbFilterType.Caption := ''; if ANewFilter.FFilterBlock <> nil then begin lbFilterUserValue.Caption := ANewFilter.FFilterBlock.GetFilterAsString(true); if lbFilterUserValue.Caption = '' then if ANewFilter.FFilterType = fltCustom then ANewFilter.IsUseFilter := false; end; case ANewFilter.FFilterType of fltCustom: begin lbFilterType.Caption := rbFilterTypeUser.Caption; rbFilterTypeUser.OnClick := nil; rbFilterTypeUser.Checked := true; rbFilterTypeUser.OnClick := rbFilterTypeClick; //if ANewFilter.FFilterBlock <> nil then // begin // lbFilterUserValue.Caption := ANewFilter.FFilterBlock.GetFilterAsString(true); // if lbFilterUserValue.Caption = '' then // if ANewFilter.FFilterType = fltCustom then // ANewFilter.IsUseFilter := false; // // //cbUseFilter.Checked := ANewFilter.IsUseFilter; // // {if ANewFilter.IsOn then // Act_ComponFilter.Hint := Act_ComponFilter.Hint + ' = '+cOn // else // Act_ComponFilter.Hint := Act_ComponFilter.Hint + ' = '+cOff; // // Act_ComponFilter.Hint := Act_ComponFilter.Hint +#10#13+ ANewFilter.GetFilterAsString(true);} // end; //cbUseFilter.Enabled := lbFilterUserValue.Caption <> ''; //Act_FindComponsByFilter.Enabled := lbFilterUserValue.Caption <> ''; //pnFilterIsOn.Visible := (GFormMode = fmNormal) and (lbFilterUserValue.Caption <> '') and (cbUseFilter.Checked); end; fltFavorites: begin lbFilterType.Caption := rbFilterTypeFavorites.Caption; rbFilterTypeFavorites.OnClick := nil; rbFilterTypeFavorites.Checked := true; rbFilterTypeFavorites.OnClick := rbFilterTypeClick; end; fltTop: begin lbFilterType.Caption := rbFilterTypeTop.Caption; rbFilterTypeTop.OnClick := nil; rbFilterTypeTop.Checked := true; rbFilterTypeTop.OnClick := rbFilterTypeClick; end; end; //cbUseFilter.Enabled := (ANewFilter.FFilterType<>fltCustom) or (lbFilterUserValue.Caption <> ''); if cbUseFilter.Checked <> ANewFilter.IsUseFilter then cbUseFilter.Checked := ANewFilter.IsUseFilter; Act_FindComponsByFilter.Enabled := (ANewFilter.FFilterType<>fltCustom) or (lbFilterUserValue.Caption <> ''); pnFilterIsOn.Visible := (GFormMode = fmNormal) and ((ANewFilter.FFilterType<>fltCustom) or (lbFilterUserValue.Caption <> '')) and (cbUseFilter.Checked); //pnCustomFilter.Visible := ANewFilter.FFilterType=fltCustom; lbFilterType.Visible := GDBMode = bkNormBase; sbSelectFromFilteredInCAD.Visible := (GDBMode = bkProjectManager) and ANewFilter.IsUseFilter; // Если фильтр включен, то отображать панель с настройками if pnFilterIsOn.Visible then if GFormMode = fmNormal then if Not Act_ChoiceFind.Checked then begin Act_ChoiceFind.Execute; end; finally cbUseFilter.OnClick := SavedUseFilterOnChange; end; end; procedure TF_MAIN.ApplyComponFilterToListIDs(AComponIDList: TIntList); var LookedComponCount: Integer; i: Integer; begin LookedComponCount := 0; i := AComponIDList.Count - 1; while i >= 0 do begin if Not DM.CanShowComponByFilter(AComponIDList[i], FFilterParams, LookedComponCount=0) then AComponIDList.Delete(i); Dec(i); end; end; procedure TF_MAIN.DefineComponentFilterUserParams(AFilter: TFilterBlock); var FilterValues: TObjectList; begin if AFilter <> nil then begin FilterValues := DM.GetFilterValuesBySprElements([vkComponentType, vkProducers, vkNetType]); AFilter.DefineParamsFromFilterFields(FilterValues, true); FreeAndNil(FilterValues); end; end; procedure TF_MAIN.SaveComponFilter; begin if FFilterParams.FFilterBlock <> nil then begin if GDBMode = bkNormBase then begin FFilterParams.FFilterBlock.SaveToFile(GetPathToNBComponFilter, ftComponent); GSCSIni.NB.IsUseFilter := FFilterParams.IsUseFilter; GSCSIni.NB.FilterType := FFilterParams.FFilterType; WriteNBIni(GSCSIni.NB); end else if GDBMode = bkProjectManager then begin GSCSBase.CurrProject.FilterBlock.Assign(FFilterParams.FFilterBlock); SetProjectChanged(true); end; end; end; procedure TF_MAIN.SetFilterBlockForCompType(AComponTypeSysNames: TStringList); var ChildFilterBlock: TFilterBlock; ActualSpravochnik: TSpravochnik; SprComponentType: TNBComponentType; i, j: integer; begin if AComponTypeSysNames <> nil then begin if FFilterParams.FFilterBlock = nil then FFilterParams.FFilterBlock := TFilterBlock.Create(nil, btBlock); if FFilterParams.FFilterBlock <> nil then begin FFilterParams.FFilterBlock.Clear; FFilterParams.FFilterBlock.IsOn := true; FFilterParams.IsUseFilter := true; if GFormMode = fmNormal then ActualSpravochnik := GetSpravochnik else begin if GDBMode = bkNormBase then ActualSpravochnik := F_NormBase.GetSpravochnik else if GDBMode = bkProjectManager then ActualSpravochnik := F_ProjMan.GetSpravochnik; end; if ActualSpravochnik <> nil then for i := 0 to ActualSpravochnik.ComponentTypes.Count - 1 do begin SprComponentType := TNBComponentType(ActualSpravochnik.ComponentTypes[i]); for j := 0 to AComponTypeSysNames.Count - 1 do begin if SprComponentType.ComponentType.SysName = AComponTypeSysNames[j] then begin ChildFilterBlock := TFilterBlock.Create(FFilterParams.FFilterBlock, btCondition); ChildFilterBlock.IsOn := true; ChildFilterBlock.ConditionType := ctOr; ChildFilterBlock.Condition.FieldIndex := fiGuidComponentType; ChildFilterBlock.Condition.FilterValue := SprComponentType.ComponentType.GUID; ChildFilterBlock.Condition.CompareType := ctEqual; end; end; end; ApplyComponentFilter(nil, FFilterParams, false); end; end; end; procedure TF_MAIN.AddEditNorm(AMakeEdit: TMakeEdit); var //07.11.2013 SCSComponent: TSCSComponent; SCSObj: TSCSComponCatalogClass; ComponCurrencyProperGlobalMainInNB: TCurrency; SCSNorm: TSCSNorm; SCSNormFromMemTable: TSCSNorm; SCSNormFromCompon: TSCSNorm; SavedEnabledRefreshNode: Boolean; begin //SCSComponent := GetActualSelectedComponent; SCSObj := GetActualSelectedObj; if SCSObj <> nil then begin ZeroMemory(@ComponCurrencyProperGlobalMainInNB, SizeOf(TCurrency)); if SCSObj is TSCSComponent then ComponCurrencyProperGlobalMainInNB := DM.GetCatalogOrComponCurrencyProperGlobalMainInNB(0, SCSObj.ID) else ComponCurrencyProperGlobalMainInNB := GLocalCurrencyM.Data; SCSNorm := nil; SCSNormFromMemTable := nil; if AMakeEdit = meEdit then SCSNormFromMemTable := TSCSNorm(DM.mtNorms.FieldByName(fnObjectAddress).AsInteger); SavedEnabledRefreshNode := FEnabledRefreshNode; FEnabledRefreshNode := false; try SCSNorm := DM.AddEditNormWithMemTable(AMakeEdit, SCSObj.ID, DM.mtNorms, ComponCurrencyProperGlobalMainInNB, GLocalCurrencyM.Data, true); finally FEnabledRefreshNode := SavedEnabledRefreshNode; end; if SCSNorm <> nil then begin DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); SCSNorm.MasterTableKind := SCSObj.NormsResources.MasterTableKind; if AMakeEdit = meMake then begin //06.11.2013 SCSComponent.NormsResources.Norms.Add(SCSNorm); SCSObj.NormsResources.Norms.Add(SCSNorm); SCSNorm.SaveNormAsNew(SCSNorm.IDMaster); DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnID).AsInteger := SCSNorm.ID; DM.mtNorms.Post; EnableEditDel(itAuto); end else if AMakeEdit = meEdit then begin if SCSNormFromMemTable <> nil then begin SCSNormFromMemTable.Assign(SCSNorm); SCSNormFromMemTable.IsModified := true; SCSNormFromMemTable.SaveByServiceFields(SCSNormFromMemTable.IDMaster); SCSNormFromMemTable.IsModified := false; end; FreeAndNil(SCSNorm); end; SCSObj.NotifyChange; end; end; end; procedure TF_MAIN.AddEditResource(AMakeEdit: TMakeEdit; AMakeFromCompon: Boolean); var SCSComponent: TSCSComponent; ComponCurrencyProperGlobalMainInNB: TCurrency; SCSResourceRel: TSCSResourceRel; SCSResourceRelFromMemTable: TSCSResourceRel; SavedEnabledRefreshNode: Boolean; begin SCSComponent := GetActualSelectedComponent; if SCSComponent <> nil then begin ComponCurrencyProperGlobalMainInNB := DM.GetCatalogOrComponCurrencyProperGlobalMainInNB(0, SCSComponent.ID); SCSResourceRel := nil; SCSResourceRelFromMemTable := nil; if AMakeEdit = meEdit then SCSResourceRelFromMemTable := TSCSResourceRel(DM.mtNorms.FieldByName(fnObjectAddress).AsInteger); SavedEnabledRefreshNode := FEnabledRefreshNode; FEnabledRefreshNode := false; try SCSResourceRel := DM.AddEditResourceWithMemTable(AMakeEdit, SCSComponent.ID, 0, DM.mtNorms, tkNorm, ComponCurrencyProperGlobalMainInNB, GLocalCurrencyM.Data, AMakeFromCompon, true); finally FEnabledRefreshNode := SavedEnabledRefreshNode; end; if SCSResourceRel <> nil then begin DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); SCSResourceRel.MasterTableKind := ctkComponent; if AMakeEdit = meMake then begin SCSComponent.NormsResources.Resources.Add(SCSResourceRel); SCSResourceRel.SaveResourceAsNew(SCSResourceRel.IDMaster); //DM.LoadFromResourceToMT(SCSResourceRel, dm.mtNorms, meEdit, tkNorm, 0, SCSResourceRel); dm.mtNorms.Edit; dm.mtNorms.FieldByName(fnID).AsInteger := SCSResourceRel.ID; dm.mtNorms.FieldByName(fnIDResource).AsInteger := SCSResourceRel.IDResource; dm.mtNorms.FieldByName(fnIDMaster).AsInteger := SCSResourceRel.IDMaster; dm.mtNorms.Post; EnableEditDel(itAuto); end else if AMakeEdit = meEdit then begin if SCSResourceRelFromMemTable <> nil then begin SCSResourceRelFromMemTable.Assign(SCSResourceRel); SCSResourceRelFromMemTable.IsModified := true; SCSResourceRelFromMemTable.SaveByServiceFields(SCSResourceRelFromMemTable.IDMaster); SCSResourceRelFromMemTable.IsModified := false; end; FreeAndNil(SCSResourceRel); end; SCSComponent.NotifyChange; end; end; if GDBMode = bkProjectManager then RefreshNode; // на случай, если было применение свойств однотипных ресурсов end; procedure TF_MAIN.SaveSelectedConnection; var SavedEvent: TcxEditValidateEvent; SCSComponent: TSCSComponent; JoinedCompon: TSCSComponent; Complect: PComplect; IDJoined: Integer; begin SCSComponent := GetActualSelectedComponent; if SCSComponent <> nil then if DM.MemTable_Connections.RecordCount > 0 then begin Complect := SCSComponent.GetConnectionByID(DM.MemTable_Connections.FieldByName(fnID).AsInteger); if Complect = nil then begin IDJoined := 0; if DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger = SCSComponent.ID then IDJoined := DM.MemTable_Connections.FieldByName(fnIDChild).AsInteger else if DM.MemTable_Connections.FieldByName(fnIDChild).AsInteger = SCSComponent.ID then IDJoined := DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger; JoinedCompon := SCSComponent.ProjectOwner.GetComponentFromReferences(IDJoined); if JoinedCompon <> nil then Complect := JoinedCompon.GetConnectionByID(DM.MemTable_Connections.FieldByName(fnID).AsInteger); end; if Complect <> nil then begin Complect^.RelType := DM.MemTable_Connections.FieldByName(fnRelType).AsInteger; Complect^.Fixed := DM.MemTable_Connections.FieldByName(fnFixed).AsInteger; SetProjectChanged(true); end; end; end; procedure TF_MAIN.SaveSelectedNormResource; var //09.11.2013 SCSComponent: TSCSComponent; SCSObj: TSCSComponCatalogClass; SCSNormResourceObj: TSCSNormResBasicClass; IndexNorm: Integer; begin //09.11.2013 SCSComponent := GetActualSelectedComponent; //09.11.2013 if SCSComponent <> nil then SCSObj := GetActualSelectedObj; if SCSObj <> nil then if DM.mtNorms.RecordCount > 0 then begin SCSNormResourceObj := TSCSNormResBasicClass(DM.mtNorms.FieldByName(fnObjectAddress).AsInteger); case DM.mtNorms.FieldByName(fnIsResource).AsBoolean of true: begin DM.LoadFromMTToResource(DM.mtNorms, TSCSResourceRel(SCSNormResourceObj), tkNorm); TSCSResourceRel(SCSNormResourceObj).IsModified := true; TSCSResourceRel(SCSNormResourceObj).IsNew := false; TSCSResourceRel(SCSNormResourceObj).SaveByServiceFields(SCSObj.ID); TSCSResourceRel(SCSNormResourceObj).IsModified := false; end; false: begin IndexNorm := SCSObj.NormsResources.Norms.IndexOf(TSCSNorm(SCSNormResourceObj)); DM.LoadFromMTToNorm(DM.mtNorms, TSCSNorm(SCSNormResourceObj)); SCSNormResourceObj.IsModified := true; SCSNormResourceObj.IsNew := false; TSCSNorm(SCSNormResourceObj).SaveByServiceFields(SCSObj.ID); SCSNormResourceObj.IsModified := false; end; end; SCSNormResourceObj.NotifyChange; end; end; procedure TF_MAIN.Act_ChoiceNBPathExecute(Sender: TObject); begin if GDBMode = bkNormBase then begin CreateFConnect.Execute(bkNormBase, true); end; end; procedure TF_MAIN.Act_ChoicePMPathExecute(Sender: TObject); begin if GDBMode = bkNormBase then begin CreateFConnect.Execute(bkProjectManager, true); end; end; procedure TF_MAIN.pmnu_MakeUpdateFileClick(Sender: TObject); begin // end; procedure TF_MAIN.Act_AddCrossConnectionExecute(Sender: TObject); begin MakeEditCrossConnection(meMake); EnableEditDel(itAuto); end; procedure TF_MAIN.Act_EditCrossConnectionExecute(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- MakeEditCrossConnection(meEdit); end; procedure TF_MAIN.Act_DelCrossConnectionExecute(Sender: TObject); var ptrCrossConnection: TSCSCrossConnection; begin if MessageModal(cMain_Msg90, Application.Title, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ptrCrossConnection := GSCSBase.SCSComponent.GetCrossConnectionByID(DM.MemTable_CrossConnection.FieldByName(fnID).AsInteger); if ptrCrossConnection <> nil then begin GSCSBase.SCSComponent.CrossConnections.Remove(ptrCrossConnection); FreeAndNil(ptrCrossConnection); //FreeMem(ptrCrossConnection); end; DM.DeleteCrossConnection(DM.MemTable_CrossConnection.FieldByName(fnID).AsInteger); DM.MemTable_CrossConnection.Delete; GSCSBase.SCSComponent.NotifyChange; EnableEditDel(itAuto); end; end; procedure TF_MAIN.tcGridDataChange(Sender: TObject); begin if GDBMode = bkProjectManager then CheckCloseReportForm; Grid_CompData.ActiveLevel := Grid_CompData.Levels[tcGridData.TabIndex]; end; procedure TF_MAIN.Act_ConnectConfiguratorExecute(Sender: TObject); //var //NodeDat: PObjectData; //Catalog: TSCSCatalog; begin {NodeDat := nil; Catalog := nil; if Tree_Catalog.Selected <> nil then NodeDat := Tree_Catalog.Selected.Data; if NodeDat <> nil then case NodeDat.ItemType of itList: Catalog := GSCSBase.CurrProject.CurrList; itProject: Catalog := GSCSBase.CurrProject; end; if Catalog <> nil then F_MakeEditCrossConnection.ShowConnectConfigurator(Catalog, fmCableConfigurator);} CreateFMakeEditCrossConnection.ShowConnectConfigurator(GSCSBase.CurrProject.CurrList, fmCableConfigurator, cmNone); RefreshNode; end; procedure TF_MAIN.IdleEventHandler(Sender: TObject; var Done: Boolean); var i: Integer; begin if GDBMode = bkProjectManager then if Assigned(GSCSBase) and Assigned(GSCSBase.CurrProject) then if GSCSBase.CurrProject.Active then if GSCSBase.CurrProject.CanAutoSave then if Not(GIsProgress) and Not(ExistsModalForm) and GProjectChanged then if Not IsNowTracingByUser and Not CheckIsActiveKeyboardOrMouse then begin //*** Собственно сохранение GSCSBase.CurrProject.SaveProject; {GSCSBase.CurrProject.StartStopAutoSaveProject(false); try BeginProgress('Сохранение проекта...'); //s := F_Progress.lbProgressCaption.Caption; //F_Progress.lbProgressCaption.Caption := 'Сохранение проекта...'; //*** Собственно сохранение GSCSBase.CurrProject.SaveProject; finally EndProgress; //F_Progress.lbProgressCaption.Caption := s; GSCSBase.CurrProject.StartStopAutoSaveProject(true); end;} end; {if GDBMode = bkProjectManager then if Assigned(GSCSBase.CurrProject) then if GSCSBase.CurrProject.Active then if GSCSBase.CurrProject.CanAutoSave then if Not GIsProgress then begin GSCSBase.CurrProject.StartStopAutoSaveProject(false); try StartCreepingNode(GSCSBase.CurrProject.TreeViewNode, 'сохранение'); try Application.OnMessage := F_Progress.Action; for i := 0 to 5 do begin sleep(300); Application.ProcessMessages; end; //*** Собственно сохранение GSCSBase.CurrProject.SaveProject; finally Application.OnMessage := nil; StopCreepingNode; end; //ShowMessage('End saving'); finally GSCSBase.CurrProject.StartStopAutoSaveProject(true); end; end; } end; procedure TF_MAIN.SettingChangeEventHandler(Sender: TObject; Flag: Integer; const Section: string; var Result: Longint); begin {SetLocaleInternationalSettings; //Screen.GetMetricSettings; GetMetricSettings;} end; procedure TF_MAIN.tcGridDataMenuClick(Sender: TObject); begin if TMenuItem(Sender).Tag <> -1 then tcGridData.TabIndex := TMenuItem(Sender).Tag; end; procedure TF_MAIN.pmTcGridDataPopup(Sender: TObject); var MenuItem: TMenuItem; i: Integer; Tab: TRzTabCollectionItem; begin pmTcGridData.Items.Clear; for i := 0 to tcGridData.Tabs.Count - 1 do begin Tab := tcGridData.Tabs[i]; if Tab.Visible then begin MenuItem := TMenuItem.Create(pmTcGridData); MenuItem.Caption := Tab.Caption; MenuItem.Tag := Tab.Index; MenuItem.OnClick := tcGridDataMenuClick; if Tab.Index = tcGridData.TabIndex then MenuItem.Checked := true; pmTcGridData.Items.Add(MenuItem); end; end; MenuItem := TMenuItem.Create(pmTcGridData); MenuItem.Caption := '-'; pmTcGridData.Items.Add(MenuItem); MenuItem := TMenuItem.Create(pmTcGridData); MenuItem.Caption := cMain_Msg91; pmTcGridData.Items.Add(MenuItem); XPMenu.Active := false; XPMenu.Active := true; end; //**** Вызывает дизайнер шкафа procedure TF_MAIN.Act_CupBoardDesignerExecute(Sender: TObject); var CupBoardCompon: TSCSComponent; ComponOwner: TSCSCatalog; begin if GDBMode = bkProjectManager then if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then begin CupBoardCompon := GSCSBase.CurrProject.GetComponentFromReferences(GSCSBase.SCSComponent.ID); if Assigned(CupBoardCompon) then begin ComponOwner := CupBoardCompon.GetFirstParentCatalog; if Assigned(ComponOwner) then CreateOpenDesignListFromPM(ComponOwner.ListID, ComponOwner.SCSID); end; end; end; procedure TF_MAIN.Act_CupBoard_PortsExecute(Sender: TObject); begin CreateFResourceReport.ShowPortWizard(GetActualSelectedComponent); end; procedure TF_MAIN.Timer_RefreshNodeTimer(Sender: TObject); var Dat: PObjectData; ListMemTable: TList; //*** Список MemTabl-ов ListPosition: TIntlist; //*** Список с текущеми позициями в MemTabl-ах i: Integer; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; //procedure AddMemTableToList(AMemTable: TkbmMemTable); //begin // if AMemTable = nil then // Exit; //// EXIT //// // ListRecNo.Add(AMemTable.RecNo); // ListMemTable.Add(AMemTable); //end; begin TTimer(Sender).Enabled := false; // Tolik 14/11/2019 -- // if (GIsProgress or GIsProgressHandling) then // exit; // //Exit; //#Del if pcObjects.ActivePage = tsComponents then begin EnableEditDel(itAuto); SCSComponent := nil; SCSCatalog := nil; try try ListMemTable := nil; ListPosition := nil; if Tree_Catalog.Selected = nil then Exit; ///// EXIT ///// Dat := Tree_Catalog.Selected.Data; //ANode.Data; if Dat = nil then Exit; ///// EXIT ///// ListMemTable := Tlist.Create; ListPosition := TIntList.Create; try LockTreeAndGrid(true); //case Dat.ItemType of // itComponCon, itComponLine: if IsComponItemType(Dat.ItemType) then begin if FIsRefreshNodeObject then RefreshTreeNodeComponent(Tree_Catalog.Selected); if GDBMode = bkProjectManager then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Assigned(SCSComponent) then begin SCSComponent.RefreshWholeLengthIfNecessary; if Not FIsRefreshNodeObject and IsArchComponByItemType(Dat.ItemType) then LoadArchObjPropsFromCAD(SCSComponent); end; end; DefineFTraceLength; {AddMemTableToList(DM.MemTable_Complects); AddMemTableToList(DM.MemTable_Property); AddMemTableToList(DM.MemTable_InterfaceRel); AddMemTableToList(DM.MemTable_Port); if GDBMode = bkProjectManager then AddMemTableToList(DM.MemTable_Connections) else if GDBMode = bkNormBase then if FIsRefreshNodeObject then ShowPrice;} DM.SaveComponMemTablesPositions(ListMemTable, ListPosition); if GDBMode = bkNormBase then if FIsRefreshNodeObject then ShowPrice; DM.SelectCompSub(Tree_Catalog.Selected, SCSComponent); //ShowPrice; end else if (GDBMode = bkProjectManager) and IsCatalogItemType(Dat.ItemType) then begin DefineFTraceLength; if Not FIsRefreshNodeObject then begin //AddMemTableToList(DM.MemTable_Property); DM.SaveCatalogMemTablesPositions(ListMemTable, ListPosition); SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); DM.SelectCatalogSub(Tree_Catalog.Selected, SCSCatalog); end else Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); end; //end; //*** Восстановление тек-х позиций в Гридах //for i := 0 to ListMemTable.Count - 1 do // if TkbmMemTable(ListMemTable.Items[i]).Active then // TkbmMemTable(ListMemTable.Items[i]).RecNo := ListRecNo.Items[i]; DM.RestoreMemTablesPositions(ListMemTable, ListPosition); EnableEditDel(itAuto); finally LockTreeAndGrid(false); end; except on E: Exception do AddExceptionToLog('Timer_RefreshNodeTimer: '+E.Message); end; finally FreeAndNil(ListPosition); if ListMemTable <> nil then FreeAndNil(ListMemTable); end; EnableEditDel(itAuto); end else if pcObjects.ActivePage = tsTemplates then lvTemplatesSelectItem(FlvTemplate, FlvTemplate.Selected, true); //lvTemplatesSelectItem(lvTemplates, lvTemplates.Selected, true); end; procedure TF_MAIN.Act_TurnToConnectedComponByPortExecute(Sender: TObject); var Port: TSCSInterface; PortComponent: TSCSComponent; ComponNode: TTreeNode; begin ComponNode := nil; Port := GSCSBase.CurrProject.GetInterfaceByID(DM.MemTable_Port.FieldByName(fnIDConnected).AsInteger); if Assigned(Port) then begin PortComponent := Port.ComponentOwner; if Assigned(PortComponent) then begin ComponNode := PortComponent.TreeViewNode; if Not Assigned(ComponNode) then ComponNode := FindComponOrDirInTree(PortComponent.ID, true); if Assigned(ComponNode) then Tree_Catalog.Selected := ComponNode; end; end; end; procedure TF_MAIN.SaveDialog_ProjectCanClose(Sender: TObject; var CanClose: Boolean); begin CanClose := SaveDialogChecker(TSaveDialog(Sender)); end; procedure TF_MAIN.sdAlPlanCanClose(Sender: TObject; var CanClose: Boolean); begin CanClose := SaveDialogChecker(TSaveDialog(Sender)); end; procedure TF_MAIN.Timer_NodeHintTimer(Sender: TObject); var i: Integer; //Node: TTreeNode; //Dat: PObjectData; //ScreenPos: TPoint; //TreePos: TPoint; ObjAtCursor: TObject; IDComponentToShow: Integer; IDCompRel: Integer; strCompRelSortID: String; SCSComponent: TSCSComponent; Spravochnik: TSpravochnik; SprNetType: TNBNetType; SprProducer: TNBProducer; ComponentTypeName: String; NetTypeName: String; ProducerName: String; NameFromTo: String; ChannelSection: Double; ChannelSectionStr: String; PropRequired: TStringList; Prop: PProperty; SprProperty: TNBProperty; WasSectionProp: Boolean; HintMsg: String; //SortID: Integer; TopCompon: TSCSComponent; ptrComplect: PComplect; begin TTimer(Sender).Enabled := false; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} if GDBMode = bkNormBase then exit; {$IFEND} if Application.Active and (GSCSBase.Active) then begin IDComponentToShow := GetComponIDAtCursor(@ObjAtCursor); IDCompRel := 0; strCompRelSortID := ''; {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} if ObjAtCursor <> nil then if ObjAtCursor is TTreeNode then if TTreeNode(ObjAtCursor).Owner = Tree_Catalog.Items then begin IDCompRel := PObjectData(TTreeNode(ObjAtCursor).Data).ID_CompRel; strCompRelSortID := 'CompRel_SortID '+IntToStr(PObjectData(TTreeNode(ObjAtCursor).Data).SortID)+#10+#13; end; {$IFEND} { GetCursorPos(ScreenPos); TreePos := Tree_Catalog.ScreenToClient(ScreenPos); Node := Tree_Catalog.GetNodeAt(TreePos.X, TreePos.Y); if Assigned(Node) then begin Dat := Node.Data; if Dat.ItemType in [itComponLine, itComponCon] then begin SCSComponent := nil; case GDBMode of bkNormBase: begin SCSComponent := TSCSComponent.Create(Self); if GSCSBase.SCSComponent.ID = Dat.ObjectID then SCSComponent.AssignOnlyComponent(GSCSBase.SCSComponent) else begin SCSComponent.LoadComponentByID(Dat.ObjectID, false); SCSComponent.LoadProperties; end; end; bkProjectManager: begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); end; end; } SCSComponent := nil; if IDComponentToShow <> 0 then case GDBMode of bkNormBase: begin SCSComponent := TSCSComponent.Create(Self); if GSCSBase.SCSComponent.ID = IDComponentToShow then SCSComponent.AssignOnlyComponent(GSCSBase.SCSComponent) else begin SCSComponent.LoadComponentByID(IDComponentToShow, false); SCSComponent.LoadProperties; end; end; bkProjectManager: begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(IDComponentToShow); end; end; if Assigned(SCSComponent) then begin {TopCompon := nil; ptrComplect := nil; SortID := 0; if SCSComponent.Parent is TSCSComponent then begin TopCompon := SCSComponent.GetParentComponent; if TopCompon <> nil then ptrComplect := TopCompon.GetComplectByIDChild(SCSComponent.ID); if ptrComplect <> nil then SortId := ptrComplect.SortID; end else if SCSComponent.Parent is TSCSCatalog then SortID := SCSComponent.SortID; } SCSComponent.LoadComponentType; //ComponentTypeName := SCSComponent.ComponentType.Name; //FNormBase.DM.GetStringFromTableByID(tnComponentTypes, fnName, SCSComponent.ID_ComponentType, qmPhisical); //NetTypeName := FNormBase.DM.GetStringFromTableByID(tnNetType, fnName, SCSComponent.IDNetType, qmPhisical); //ProducerName := FNormBase.DM.GetStringFromTableByID(tnProducers, fnName, SCSComponent.ID_Producer, qmPhisical); //*** Основные данные ComponentTypeName := SCSComponent.ComponentType.Name; Spravochnik := GetSpravochnik; SprNetType := nil; SprProducer := nil; if Spravochnik <> nil then begin if SCSComponent.GUIDNetType <> '' then SprNetType := Spravochnik.GetNetTypeByGUID(SCSComponent.GUIDNetType) else SprNetType := Spravochnik.GetNetTypeByID(SCSComponent.IDNetType); if SprNetType <> nil then NetTypeName := SprNetType.Name else NetTypeName := cNameEmptyBr; if SCSComponent.GUIDProducer <> '' then SprProducer := Spravochnik.GetProducerByGUID(SCSComponent.GUIDProducer) else if SCSComponent.ID_Producer <> 0 then SprProducer := Spravochnik.GetProducerByID(SCSComponent.ID_Producer); if SprProducer <> nil then ProducerName := SprProducer.Name else ProducerName := cNameEmptyBr; end; //*** компонент потключет от и до NameFromTo := ''; if SCSComponent.isLine = biTrue then NameFromTo := NameFromTo + GetNameConnectFromAndTo(SCSComponent); if NameFromTo <> '' then NameFromTo := NameFromTo+#10+#13; // Управляющие свойства компонента PropRequired := CreateStringListSorted; WasSectionProp := false; for i := 0 to SCSComponent.Properties.Count - 1 do begin Prop := SCSComponent.Properties[i]; if GPropRequired.IndexOf(Prop.SysName) <> -1 then begin if (Prop.SysName = pnInSection) or (Prop.SysName = pnOutSection) then WasSectionProp := true; SprProperty := Spravochnik.GetPropertyByGUID(Prop.GUIDProperty); if SprProperty <> nil then PropRequired.Add(SprProperty.PropertyData.Name +': '+ PropValueToCaption(Prop.Value, Prop.SysName, SprProperty.PropertyData.Izm, SprProperty.PropertyData.IDDataType, FUOM, true) ); end; end; //*** Сечение кабельного канала ChannelSectionStr := ''; ChannelSection := 0; if Not WasSectionProp and (SCSComponent.ComponentType.SysName = ctsnCableChannel) then begin ChannelSection := SCSComponent.GetVolume(gtFemale); ChannelSectionStr := FloatToStr(RoundCP(FloatInUOM(ChannelSection, umSM, FUOMMin, 2))); ChannelSectionStr := #10+#13+cMain_Msg145 +': '+ChannelSectionStr+' '+ GetNameUOM2(FUOMMin)+ #10+#13; end; HintMsg := cMain_Msg92_1+': '+SCSComponent.Name+#10+#13+NameFromTo; {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} HintMsg := HintMsg + 'ID '+IntToStr(SCSComponent.ID)+#10+#13+ 'IDCompRel '+IntToStr(IDCompRel)+#10+#13+ strCompRelSortID; {$IFEND} if Not IsArchComponByIsLine(SCSComponent.IsLine) then HintMsg := HintMsg + '______________________________________'+#10+#13+ cMain_Msg92_2+': '+SCSComponent.ArticulProducer+#10+#13+ cMain_Msg92_3+': '+SCSComponent.ArticulDistributor+#10+#13+ cMain_Msg92_4+': '+ComponentTypeName+#10+#13+ cMain_Msg92_5+': '+NetTypeName+#10+#13+ //{$IF NOT Defined (FINAL_SCS)} // 'ID '+IntToStr(SCSComponent.ID)+#10+#13+ // 'IDCompRel '+IntToStr(IDCompRel)+#10+#13+ // strCompRelSortID+ //{$IFEND} cMain_Msg92_6+': '+ProducerName+#10+#13+ PropRequired.Text+ ChannelSectionStr; if Assigned(F_AnswerToQuast) then // Tolik 27/12/2019 -- F_AnswerToQuast.ShowHint(HintMsg, 0); FreeAndNil(PropRequired); if GDBMode = bkNormBase then FreeAndNil(SCSComponent); end; end; end; procedure TF_MAIN.Tree_CatalogMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); const Baund = 2; var MoveNode: TTreeNode; begin MoveNode := TESTreeView(Sender).GetNodeAt(X, Y); if (MoveNode <> nil) and (x > Baund) and (x < (TESTreeView(Sender).Width - Baund)) then begin if MoveNode <> FLastOnHintNode then begin if Assigned(F_AnswerToQuast) then F_AnswerToQuast.HideHint; FLastOnHintNode := MoveNode; RestartTimer(Timer_NodeHint); end; end else begin if FLastOnHintNode <> nil then begin FLastOnHintNode := nil; F_AnswerToQuast.HideHint; end; end; TESTreeView(Sender).FLastOnMoveNode := MoveNode; end; procedure TF_MAIN.Panel_TreeMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if FLastOnHintNode <> nil then begin FLastOnHintNode := nil; F_AnswerToQuast.HideHint; end; end; procedure TF_MAIN.Act_DefineNumPairsExecute(Sender: TObject); var IDComponList: TList; SCSComponent: TSCSComponent; i, j: integer; Interfac1: TSCSInterface; Interfac2: TSCSInterface; NumPair: Integer; begin with DM do begin if MessageModal(cMain_Msg93, Application.Title, MB_ICONQUESTION or MB_YESNO) = IDYES then begin IDComponList := TList.Create; SCSComponent := TSCSComponent.Create(Self); BeginProgress; try SetSQLToQuery(scsQSelect, 'select id from component'); IntFieldToList(IDComponList, scsQSelect, fnID); for i := 0 to IDComponList.Count - 1 do begin SCSComponent.LoadComponentByID(integer(IDComponList[i]^), false); SCSComponent.LoadInterfaces(-1, false); NumPair := 0; if SCSComponent.IsLine = biTrue then begin for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac1 := SCSComponent.Interfaces[j]; if (Interfac1.TypeI = itFunctional) and (Interfac1.IDAdverse > 0) then if Not Interfac1.IsModified then begin Interfac2 := SCSComponent.GetInterfaceByID(Interfac1.IDAdverse); if Assigned(Interfac2) then if Interfac2.IDAdverse = Interfac1.ID then begin Inc(NumPair); Interfac1.NumPair := NumPair; Interfac2.NumPair := NumPair; Interfac1.IsModified := true; Interfac2.IsModified := true; UpdateInterfFieldAsInteger(Interfac1.ID, Interfac1.NumPair, fnNumPair); UpdateInterfFieldAsInteger(Interfac2.ID, Interfac2.NumPair, fnNumPair); end; end; end; end else begin for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac1 := SCSComponent.Interfaces[j]; if (Interfac1.TypeI = itFunctional) then begin Interfac1.NumPair := NumPair; UpdateInterfFieldAsInteger(Interfac1.ID, Interfac1.NumPair, fnNumPair); if (Interfac1.IDAdverse > 0) then begin Interfac1.IDAdverse := 0; UpdateTableField(tnInterfaceRelation, fnIDAdverse, fnID, Interfac1.ID, null, qmPhisical); end end; end; end; end; finally EndProgress; FreeList(IDComponList); SCSComponent.Free; end; end; end; end; procedure TF_MAIN.Act_ConfiguratorUpdateInfoExecute(Sender: TObject); begin {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} if F_ConfiguratorUpdateInfo = nil then F_ConfiguratorUpdateInfo := TF_ConfiguratorUpdateInfo.Create(Self, TForm(Self)); {$IFEND} if F_ConfiguratorUpdateInfo <> nil then F_ConfiguratorUpdateInfo.Execute; end; procedure TF_MAIN.Act_SaveNBNodeToFileExecute(Sender: TObject); var Node: TTreeNode; Dat: PObjectData; MakeUpdateParams: TMakeUpdateParams; ExtName, ExtDescript: String; ObjectName: String; DialogTitle: String; SaveDialog: TSaveDialog; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin Node := Tree_Catalog.Selected; if (Node <> nil) and (Node.Data <> nil) then begin Dat := Node.Data; ExtName := ''; ExtDescript := ''; ObjectName := ''; //ZeroMemory(@MakeUpdateParams, SizeOf(TMakeUpdateParams)); MakeUpdateParams := TMakeUpdateParams.Create; MakeUpdateParams.ObjectID := Dat.ObjectID; DialogTitle := ''; case Dat.ItemType of itComponLine, itComponCon: begin MakeUpdateParams.DBType := dbtComponent; MakeUpdateParams.ObjectGUID := DM.GetStringFromTableByID(tnComponent, fnGUID, Dat.ObjectID, qmPhisical); ExtName := enCompon; ExtDescript := exdCompon; ObjectName := GSCSBase.SCSComponent.Name; DialogTitle := cMain_Msg94_1; end; itDir: begin MakeUpdateParams.DBType := dbtCatalog; MakeUpdateParams.ObjectGUID := DM.GetStringFromTableByID(tnCatalog, fnGUID, Dat.ObjectID, qmPhisical); ExtName := enFolder; ExtDescript := exdFolder; ObjectName := GSCSBase.SCSCatalog.Name; DialogTitle := cMain_Msg94_2; end; end; SaveDialog := TSaveDialog.Create(Self); try SaveDialog.Title := DialogTitle; SaveDialog.InitialDir := ExtractDirByCategoryType(dctCompons); //14.04.2009 ExtractSaveDirForCategory(sdComponents); //ExtractFileDir(Application.ExeName); SaveDialog.DefaultExt := '*.'+ExtName; SaveDialog.FileName := FileNameCorrect(ObjectName); SaveDialog.Filter := GetDialogFilter(ExtDescript, ExtName); //ExtName+' ('+FullExtName+')|'+FullExtName; SaveDialog.Options := SaveDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if TCommonDialog(SaveDialog).Execute then begin BeginProgress(cMain_Msg95+'...'); try OldTick := GetTickCount; MakeUpdate(SaveDialog.FileName, MakeUpdateParams, true); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; finally // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctCompons, ExtractFileDir(SaveDialog.FileName)); // EndProgress; end; end; finally SaveDialog.Free; end; FreeAndNil(MakeUpdateParams); end; end; procedure TF_MAIN.Act_PackBaseExecute(Sender: TObject); var Base: TBase; BaseFileName: String; BaseServerName: String; BaseName: String; BackUpFileName: String; i: Integer; ProjectNames: TStringList; ProjUserNames: TStringList; MessgStr: String; CanPack: Boolean; begin CanPack := true; BaseFileName := ''; BaseServerName := ''; BackUpFileName := ''; if GDBMode = bkNormBase then begin if CheckWriteNB(true) then CanPack := CheckConnectCountNoMoreOneToNB(cBaseCommon42) else CanPack := false; end else //*** Закрыть открытые проекты if GDBMode = bkProjectManager then begin if CheckWritePM(true) then begin if CheckIsOpenProject(false) then begin CanPack := false; MessageModal(cMain_Msg136, ApplicationName, MB_ICONINFORMATION or MB_OK); end else //*** проверить - открыты проекты другими пользователями begin ProjectNames := TStringList.Create; ProjUserNames := TStringList.Create; DM.GetProjectsInUseInfo(ProjectNames, ProjUserNames); if ProjectNames.Count > 0 then begin CanPack := false; MessgStr := cMain_Msg136 + #10#13 + cMain_Msg137_1; for i := 0 to ProjectNames.Count - 1 do MessgStr := MessgStr + #10#13 + ' - "'+ ProjectNames[i] +'" '+ cMain_Msg137_2 +' '+ ProjUserNames[i]; MessageModal(MessgStr, ApplicationName, MB_ICONINFORMATION or MB_OK); end; ProjectNames.Free; ProjUserNames.Free; end; //*** Контроль на подключение не больше одного юзверя if CanPack then CanPack := CheckConnectCountNoMoreOneToPM(cBaseCommon42); end else CanPack := false; end; //*** Если база находится на другой тачке, сказать юзеру, что не мешало бы сделать бэкап if CanPack then begin ExtractServerName(GSCSBase.DBName, BaseServerName, BaseFileName); if BaseServerName <> '' then begin BaseName := ''; case GDBMode of bkNormBase: BaseName := cOfNormBase; bkProjectManager: BaseName := cOfProjMan; end; if MessageModal(cFileOf+' '+BaseName+' '+cMain_Msg138_1+' "'+BaseServerName+'", '+ cMain_Msg138_2+' "'+BaseFileName+'". '+#10+#13+ cMain_Msg138_3, ApplicationName, MB_ICONQUESTION or MB_YESNO) <> IDYES then CanPack := false; end; end; if CanPack and (MessageModal(cMain_Msg96, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES) then begin BackUpFileName := ''; SetBusyParamsToBase(DM.Query_Select, DM.Query_Operat, bbmPack); GSCSBase.Close; //GSCSBase.SimpleClose(false); try //*** Резервная копия базы на локале if BaseServerName = '' then begin BackUpFileName := GetNoExistsFileNameForCopy(ExtractFileDir(GSCSBase.DBName)+'\'+ ExtractFileName(GSCSBase.DBName) + enBak); if BackUpFileName <> '' then begin BeginProgress; try if Not CopyFileToByName(GSCSBase.DBName, BackUpFileName) then begin PauseProgress(true); if MessageModal(cMain_Msg135_1 + BackUpFileName + cMain_Msg135_2 + GSCSBase.DBName+'. '+cMain_Msg135_3, ApplicationName, MB_ICONQUESTION or MB_YESNO) <> IDYES then CanPack := false; PauseProgress(false); BackUpFileName := ''; end; finally EndProgress; end; end; end; //*** Само сжатие if CanPack then begin Base := TBase.Create(DM.ConnectParams); BeginProgress; try //Base.Open(GSCSBase.DBName); Base.PackBase(GSCSBase.DBName, Base.ConnectParams); finally EndProgress; Base.Free; end; end; finally //GSCSBase.SimpleOpen(false); if GSCSBase.Open(GSCSBase.DBName, true, true, false) <> obrSuccess then begin GSCSBase.Close; if BackUpFileName <> '' then begin MessageModal(cMain_Msg139, ApplicationName, MB_ICONERROR or MB_OK); if CopyBase(BackUpFileName, GSCSBase.DBName, true) then GSCSBase.Open(GSCSBase.DBName, true, true, false); end; end else if CanPack then MessageModal(cMain_Msg140, ApplicationName, MB_ICONINFORMATION or MB_OK); SetBusyParamsToBase(DM.Query_Select, DM.Query_Operat, bbmEmpty); //*** Удалить файл резерва if BackUpFileName <> '' then if MessageModal(cMain_Msg141 +'"'+BackUpFileName+'"', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then DeleteFile(BackUpFileName); end; end; end; procedure TF_MAIN.Tree_CatalogCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean); var HasChildren: Boolean; SCSCompon: TSCSComponent; NodeComp: TTreeNode; begin //if (Self.ActiveControl <> Sender) and Node.Selected then // Sender.Canvas.Brush.Color := ColorToRGB(clInactiveBorder) - $305050 ; // clGreen; // Tolik 03/04/2021 -- //if Not Sender.Focused and Node.Selected then // Sender.Canvas.Brush.Color := ColorToRGB(clInactiveBorder) - $305050 ; // clGreen; if GSelNodeColor = -1 then begin if Not Sender.Focused and Node.Selected then Sender.Canvas.Brush.Color := ColorToRGB(clInactiveBorder) - $305050 ; // clGreen; end else begin if Not Sender.Focused and Node.Selected then Sender.Canvas.Brush.Color := GSelNodeColor; end; // if Node.Data <> nil then begin HasChildren := Node.HasChildren; if (HasChildren = false) and (PObjectData(Node.Data).ChildNodesCount > 0) then Node.HasChildren := true; //else //if HasChildren and (PObjectData(Node.Data).ChildNodesCount = 0) then // Node.HasChildren := false; if PObjectData(Node.Data).FontColor = clGreen then begin Sender.Canvas.Font.Color := PObjectData(Node.Data).FontColor; if (cdsSelected in State) then Sender.Canvas.Font.Color := clLime; Sender.Canvas.Font.Style := [fsBold]; end; if (PObjectData(Node.Data).FontColor <> -1) and Not (cdsSelected in State) then begin Sender.Canvas.Font.Color := PObjectData(Node.Data).FontColor; end; if FSCS_Main.FInteractiveScene = 1 then begin if Not FSCS_Main.FInteractiveWorkColorSet then begin NodeComp := F_NormBase.FindTreeNodeByDat(280410, [itComponCon]); if NodeComp <> nil then begin PObjectData(NodeComp.Data).FontColor := clGreen; FSCS_Main.FInteractiveWorkColorSet := True; F_NormBase.Tree_Catalog.Repaint; end; end; if Not FSCS_Main.FInteractiveRackColorSet then begin NodeComp := F_NormBase.FindTreeNodeByDat(280414, [itComponCon]); if NodeComp <> nil then begin PObjectData(NodeComp.Data).FontColor := clGreen; FSCS_Main.FInteractiveRackColorSet := True; F_NormBase.Tree_Catalog.Repaint; end; end; end; end; {if cdsSelected in State then begin //Sender.Canvas.Font.Style := Sender.Canvas.Font.Style + [fsUnderline]; Sender.Canvas.Font.Color := clLime; end;} end; procedure TF_MAIN.Act_LoadNBNodeFromFileExecute(Sender: TObject); var OpenDialog: TOpenDialog; CurrIDCatalog: Integer; CurrNode: TTreeNode; NodeDat: PObjectData; CatalogNode: TTreeNode; IDToSel: Integer; NodeToSel: TTreeNode; //Tolik BaseNameOf: String; UpdateBaseResults: TUpdateBaseResults; UpdateBaseParams: TUpdateBaseParams; begin // Stolen by Tolik and placed here BaseNameOf := ''; if GDBMode = bkNormBase then BaseNameOf := cOfNormBase else if GDBMode = bkProjectManager then BaseNameOf := cOfProjMan; if MessageModal(cMain_Msg148 + ' ' + BaseNameOf +'?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then FNormBase.CreateFBackUpBase.Execute(fmBackUp, GDBMode); // NodeDat := nil; CurrNode := Tree_catalog.Selected; if CurrNode <> nil then NodeDat := CurrNode.Data; if NodeDat <> nil then begin CurrIDCatalog := -1; CatalogNode := nil; case NodeDat.ItemType of itDir: begin CurrIDCatalog := NodeDat.ObjectID; CatalogNode := CurrNode; //MaxID := end; itComponCon, itComponLine: begin CurrIDCatalog := DM.GetIDCatalogByIDNoUppCompon(NodeDat.ObjectID); CatalogNode := FindComponOrDirInTree(CurrIDCatalog, false); end; end; if (CurrIDCatalog > 0) and (CatalogNode <> nil) then begin OpenDialog := TOpenDialog.Create(nil); try OpenDialog.Title := cMain_Msg97+'...'; OpenDialog.InitialDir := ExtractDirByCategoryType(dctCompons); //14.04.2009 ExtractSaveDirForCategory(sdComponents); //07.04.2009 ExtractFileDir(Application.ExeName); OpenDialog.DefaultExt := '*.'+enFolder; OpenDialog.Filter := GetDialogFilter(exdFolder, enFolder)+'|'+ GetDialogFilter(exdCompon, enCompon)+'|'+ GetDialogFilter(exdAll, '*'); OpenDialog.Options := OpenDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if OpenDialog.Execute then if CheckConnectCountNoMoreOneToNB(cBaseCommon42) then begin // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctCompons, ExtractFileDir(OpenDialog.FileName)); // ZeroMemory(@UpdateBaseParams, SizeOf(TUpdateBaseParams)); UpdateBaseParams.RequiredDBTypes := [dbtCatalog, dbtComponent]; UpdateBaseParams.UpdateBaseMode := ubmLoadData; UpdateBaseParams.DestObjectGUID := DM.GetStringFromTableByID(tnCatalog, fnGUID, CurrIDCatalog, qmPhisical); UpdateBaseResults := UpdateNormBase(OpenDialog.FileName, '', FNormBase.GSCSBase.DBName, UpdateBaseParams, bbmImportData, true); if (ubrSuccessful in UpdateBaseResults) or (UpdateBaseResults = []) then begin if UpdateBaseParams.UpdateNodeResult in [unrNew, unrUpdate, unrGoToExistsObject] then begin if UpdateBaseParams.UpdateNodeResult in [unrNew, unrUpdate] then begin //*** Перенасыпать папку DeleteChildNodes(CatalogNode); AddNodes(CatalogNode); //*** Определить текщее количество попапок и компонент в папке //PObjectData(CatalogNode.Data).ChildNodesCount := 0; //PObjectData(CatalogNode.Data).ChildNodesCount := DM.GetCatalogItemsCntByID(CurrIDCatalog, itDir, qmPhisical); //CatalogNode.HasChildren := PObjectData(CatalogNode.Data).ChildNodesCount > 0; end; IDToSel := DM.GetIntFromTableByGUID(UpdateBaseParams.SrcTableName, fnID, UpdateBaseParams.SrcObjectGUID, qmPhisical); NodeToSel := FindComponOrDirInTree(IDToSel, UpdateBaseParams.SrcDBType = dbtComponent); if NodeToSel <> nil then begin //*** Перенасыпать папку if UpdateBaseParams.UpdateNodeResult = unrUpdate then begin DeleteChildNodes(NodeToSel); AddNodes(NodeToSel); end; NodeToSel.Text := GetNameNode(NodeToSel, nil, true, true); Tree_catalog.Selected := NodeToSel; end; end else if UpdateBaseParams.UpdateNodeResult = unrNoExistsRecord then MessageModal(cMain_Msg98_1+' "'+ExtractFileName(OpenDialog.FileName)+'" '+cMain_Msg98_2, ApplicationName, MB_ICONINFORMATION or MB_OK) end else begin if ubrSrcIsNoProperRequired in UpdateBaseResults then MessageModal(cMain_Msg99_1+' "'+ExtractFileName(OpenDialog.FileName)+'" '+cMain_Msg99_2, ApplicationName, MB_ICONINFORMATION or MB_OK) else UpdateNormBaseResultHandler(UpdateBaseResults, OpenDialog.FileName); end; end; finally OpenDialog.Free; end; end; end; end; procedure TF_MAIN.Act_ImportDBFExecute(Sender: TObject); var CatalogNode: TTreeNode; begin {$IF Not Defined (FINAL_SCS)} CatalogNode := GetParentNodeByItemType(Tree_Catalog.Selected, [itDir]); if CatalogNode <> nil then if F_ImportDBF <> nil then F_ImportDBF.Execute(CatalogNode); {$IFEND} end; procedure TF_MAIN.Act_DefineNodesCountFieldsExecute(Sender: TObject); begin //*** коректировка значений количесв компонент и папок if MessageModal(cMain_Msg100, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin DefineComponKolComplects(DM.Query_Select, DM.Query_Operat); DefineCatalogKolItemsCompons(DM.Query_Select, DM.Query_Operat); end; end; procedure TF_MAIN.Act_ClearComponsFromGarbageExecute(Sender: TObject); begin if MessageModal(cMain_Msg101, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then DM.ClearComponentsFromGarbage; end; procedure TF_MAIN.Act_DublicatePortInterfaceExecute(Sender: TObject); var meInterfacePortRel: TmeInterfaceRel; dsrcPortInterface: TDataSource; IsPort: Integer; begin dsrcPortInterface := nil; IsPort := biFalse; case Grid_CompData.ActiveLevel.Index of cdliInterface: begin dsrcPortInterface := DM.DataSource_MT_InterfaceRel; IsPort := biFalse; end; cdliPort: begin dsrcPortInterface := DM.DataSource_MT_Port; IsPort := biTrue; end; end; if dsrcPortInterface <> nil then begin meInterfacePortRel := DM.GetInterfaceRel(dsrcPortInterface, nil); if meInterfacePortRel.IsNative = false then MessageModal(cMain_Msg102, ApplicationName, MB_ICONINFORMATION or MB_OK) else begin meInterfacePortRel.Count := 1; //meInterfacePortRel.KOLVO := 1; meInterfacePortRel.IsPort := IsPort; meInterfacePortRel.IsBusy := biFalse; meInterfacePortRel.DataSource := nil; meInterfacePortRel.IsLineCompon := GSCSBase.SCSComponent.IsLine; meInterfacePortRel.ServiceIsPair := (meInterfacePortRel.IsLineCompon = biTrue) and (meInterfacePortRel.ID_Adverse > 0); if meInterfacePortRel.ServiceIsPair then Inc(meInterfacePortRel.Count); DM.MakeEditInterfRel(meInterfacePortRel, meMake); end; end; end; procedure TF_MAIN.Act_ClearSpareComponPropertuesExecute(Sender: TObject); begin BeginProgress; try ClearSpareComponPropertues(DM.Query_Select, DM.Query_Operat); finally EndProgress; end; end; procedure TF_MAIN.Act_CopyCurrListExecute(Sender: TObject); var RefreshCadFlag: Boolean; {var NewListOwner: TSCSCatalog; begin BeginProgress; try OpenNoExistsListInCAD(GSCSBase.CurrProject.CurrList); NewListOwner := nil; if GSCSBase.CurrProject.CurrList.Parent <> nil then if (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itDir) or (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itProject) then NewListOwner := TSCSCatalog(GSCSBase.CurrProject.CurrList); GSCSBase.CurrProject.CurrList.SaveCAD; GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, cMain_Msg103+' '+GSCSBase.CurrProject.CurrList.Name, NewListOwner); SwitchListInCAD(GSCSBase.CurrProject.CurrList.CurrID, ''); //SwitchListInPM( finally EndProgress; end;} begin // Tolik -- 22/02/2017 -- RefreshCadFlag := GCanRefreshCad; GCanRefreshCad := False; try BeginProgress; // CopyCurrList(true); // Tolik -- 22/02/2017 -- EndProgress; Except on E: Exception do; end; GCanRefreshCad := RefreshCadFlag; GCadForm.PCaD.rEFRESH; // end; procedure TF_MAIN.Act_CopyCurrListWithoutComponsExecute(Sender: TObject); {var NewListOwner: TSCSCatalog; begin BeginProgress; try OpenNoExistsListInCAD(GSCSBase.CurrProject.CurrList); NewListOwner := nil; if GSCSBase.CurrProject.CurrList.Parent <> nil then if (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itDir) or (TSCSCatalog(GSCSBase.CurrProject.CurrList.Parent).ItemType = itProject) then NewListOwner := TSCSCatalog(GSCSBase.CurrProject.CurrList); GSCSBase.CurrProject.CurrList.SaveCAD; GSCSBase.CurrProject.CopyList(GSCSBase.CurrProject.CurrList, cMain_Msg103+' '+GSCSBase.CurrProject.CurrList.Name, NewListOwner, false); SwitchListInCAD(GSCSBase.CurrProject.CurrList.CurrID, ''); //SwitchListInPM( finally EndProgress; end;} begin CopyCurrList(false); end; procedure TF_MAIN.Act_CablesNoHitToCanalsExecute(Sender: TObject); {var CablesNoInCanals: TSCSComponents; CurrCables: TSCSComponents; CurrCatalog: TSCSCatalog; CurrCompon: TSCSComponent; i, j: Integer; WasMeetCanal: Boolean;} begin if Not Assigned(GSCSBase.CurrProject.CurrList) then Exit; ///// EXIT ///// if Assigned(GSCSBase.CurrProject) then //if Assigned(GSCSBase.CurrProject.CurrList) then ShowConnDisconnCompons(GetCatalogExtendedFromCurrNode, cdCablesNoInCanals); {CablesNoInCanals := TSCSComponents.Create(false); CurrCables := TSCSComponents.Create(false); try BeginProgress; try for i := 0 to GSCSBase.CurrProject.CurrList.ChildCatalogReferences.Count - 1 do begin CurrCatalog := GSCSBase.CurrProject.CurrList.ChildCatalogReferences[i]; WasMeetCanal := false; CurrCables.Clear; for j := 0 to CurrCatalog.SCSComponents.Count - 1 do begin CurrCompon := CurrCatalog.SCSComponents[j]; if CurrCompon.ComponentType.SysName = ctsnCableChannel then WasMeetCanal := true else if CheckSysNameIsCable(CurrCompon.ComponentType.SysName) then CurrCables.Add(CurrCompon); end; if WasMeetCanal then CablesNoInCanals.Assign(CurrCables, laOr); end; finally EndProgress; end; ShowComponentsInList(CablesNoInCanals, Act_CablesNoHitToCanals.Caption, ''); finally CurrCables.Free; CablesNoInCanals.Free; end;} end; procedure TF_MAIN.Act_IndexingComponPriceExecute(Sender: TObject); var Node: TTreeNode; NodeDat: PObjectData; ComponIDs: TIntList; IndexKoef: Double; SCSCatalog: TSCSCatalog; SCSComponents: TSCSComponents; SCSComponent: TSCSComponent; i: Integer; FieldsToSave: TStringList; Spravochnik: TSpravochnik; SprCompType: TNBComponentType; procedure ReindexComponPrice; begin SprCompType := nil; if Spravochnik <> nil then begin if SCSComponent.GUIDComponentType <> '' then SprCompType := Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType) else SprCompType := Spravochnik.GetComponentTypeObjByID(SCSComponent.ID_ComponentType); end; if (SprCompType <> nil) and CheckPriceTransformToUOMByCompType(@SprCompType.ComponentType) then begin // Преобразуем цену из метра в тек. е.и. SCSComponent.Price := FloatInUOM(SCSComponent.Price, FUOM, umMetr); SCSComponent.Price := SCSComponent.Price * IndexKoef; // Преобразуем цену из тек. е.и. в метр SCSComponent.Price := FloatInUOM(SCSComponent.Price, umMetr, FUOM); end else SCSComponent.Price := RoundCP(SCSComponent.Price * IndexKoef); if SCSComponent.PriceSupply <> 0 then SCSComponent.PriceSupply := RoundCP(SCSComponent.PriceSupply * IndexKoef); end; begin if GDBMode = bkNormBase then begin Node := Tree_Catalog.Selected; NodeDat := nil; if Node <> nil then NodeDat := Node.Data; if NodeDat <> nil then if NodeDat.ItemType = itDir then begin ComponIDs := DM.GetCatalogAllComponIDs(NodeDat.ObjectID, true); ApplyComponFilterToListIDs(ComponIDs); SCSComponents := TSCSComponents.Create(true); FieldsToSave := TStringList.Create; try if ComponIDs.Count = 0 then MessageModal(cMain_Msg104, ApplicationName, MB_ICONINFORMATION or MB_OK) else begin IndexKoef := 0.1; IndexKoef := InputForm(Self, ApplicationName, cMain_Msg105, 0, dtFloat); if IndexKoef <> 0 then begin FieldsToSave.Add(fnPrice); FieldsToSave.Add(fnPriceSupply); F_Animate.GMaxProgressPos := ComponIDs.Count * 3; F_Animate.StartAnimate(cMain_Msg106, aviCopyFiles, aiProgressBar); Spravochnik := GetSpravochnik; //*** Загрузить компоненты с ценами for i := 0 to ComponIDs.Count - 1 do begin SCSComponent := TSCSComponent.Create(Self); SCSComponent.LoadComponentByID(ComponIDs[i], false, i=0); SCSComponents.Add(SCSComponent); {//29.08.2012 SprCompType := nil; if Spravochnik <> nil then begin if SCSComponent.GUIDComponentType <> '' then SprCompType := Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType) else SprCompType := Spravochnik.GetComponentTypeObjByID(SCSComponent.ID_ComponentType); end; if (SprCompType <> nil) and CheckPriceTransformToUOMByCompType(@SprCompType.ComponentType) then begin // Преобразуем цену из метра в тек. е.и. SCSComponent.Price := FloatInUOM(SCSComponent.Price, FUOM, umMetr); SCSComponent.Price := SCSComponent.Price * IndexKoef; // Преобразуем цену из тек. е.и. в метр SCSComponent.Price := FloatInUOM(SCSComponent.Price, umMetr, FUOM); end else //SCSComponent.Price := RoundCP(SCSComponent.Price + SCSComponent.Price * IndexKoef); SCSComponent.Price := RoundCP(SCSComponent.Price * IndexKoef); if SCSComponent.PriceSupply <> 0 then //SCSComponent.PriceSupply := RoundCP(SCSComponent.PriceSupply + SCSComponent.PriceSupply * IndexKoef); SCSComponent.PriceSupply := RoundCP(SCSComponent.PriceSupply * IndexKoef);} ReindexComponPrice; F_Animate.SetProgressPos(i); end; //*** Сохранить цены SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnComponent, fnID+' = :'+fnID, FieldsToSave, ''), false); for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents[i]; DM.Query_Operat.Close; DM.Query_Operat.ParamByName(fnID).AsInteger := SCSComponent.ID; DM.Query_Operat.ParamByName(fnPrice).AsFloat := SCSComponent.Price; DM.Query_Operat.ParamByName(fnPriceSupply).AsFloat := SCSComponent.PriceSupply; DM.Query_Operat.ExecQuery; DM.Query_Operat.Close; F_Animate.SetProgressPos(i + SCSComponents.Count); end; //*** пересчитать стоимости компонент for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents[i]; CalcPriceForParents(ComponIDs[i]); F_Animate.SetProgressPos(i + SCSComponents.Count*2); end; F_Animate.StopAnimate; //RecalcNBComponentPrices; end; end; finally FieldsToSave.Free; SCSComponents.Free; ComponIDs.Free; end; end; end else begin SCSCatalog := GetActualSelectedCatalog; if (SCSCatalog = GSCSBase.CurrProject) or (SCSCatalog.GetParentCatalogByItemType(itProject) = GSCSBase.CurrProject) then begin IndexKoef := InputForm(Self, ApplicationName, cMain_Msg105, 0, dtFloat); if IndexKoef <> 0 then begin if SCSCatalog = GSCSBase.CurrProject then SaveCurrProjectToUndoStack else SaveListToUndoStack(SCSCatalog.ListID); BeginProgress('', SCSCatalog.ComponentReferences.Count); try Spravochnik := GetSpravochnik; for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := SCSCatalog.ComponentReferences[i]; ReindexComponPrice; end; finally EndProgress; end; end; end; end; end; procedure TF_MAIN.Act_MasterCableCanalTracingExecute(Sender: TObject); var CompTypeSysNames: TStringList; begin if GDBMode = bkNormBase then if GSCSBase.SCSComponent.ID > 0 then if GSCSBase.SCSComponent.IsLine = biTrue then begin CompTypeSysNames := nil; if CheckSysNameIsCable(GSCSBase.SCSComponent.ComponentType.SysName) then CompTypeSysNames := GCompTypeSysNameCables else if CheckSysNameIsCableChannel(GSCSBase.SCSComponent.ComponentType.SysName) then CompTypeSysNames := GCompTypeSysNameCableChannels; if CompTypeSysNames <> nil then FProjectMan.CreateFMasterCableCanalTracing.Execute(GSCSBase.SCSComponent.ID, GSCSBase.SCSComponent.Name, GSCSBase.SCSComponent.ComponentType.SysName, CompTypeSysNames); end; end; procedure TF_MAIN.pmnu_TurningClick(Sender: TObject); var SCSCable: TSCSComponent; PrevPartComponent: TSCSComponent; NextPartComponent: TSCSComponent; FirstPartComponent: TSCSComponent; LastPartComponent: TSCSComponent; begin Act_TurnToPrevCablePart.Enabled := false; Act_TurnToNextCablePart.Enabled := false; Act_TurnToFirstCablePart.Enabled := false; Act_TurnToLastCablePart.Enabled := false; Act_TurnToFirstCablePoint.Enabled := false; Act_TurnToLastCablePoint.Enabled := false; SCSCable := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin //*** Есть ли инфа о цельном кабеле if SCSCable.WholeComponent.Count = 0 then SCSCable.LoadWholeComponent(true); if SCSCable.WholeComponent.Count > 0 then begin SCSCable.LoadWholeComponent(false); SCSCable.DefineFirstLast(true); if (SCSCable.FirstIDCompon <> 0) and (SCSCable.ID <> SCSCable.FirstIDCompon) then begin Act_TurnToPrevCablePart.Enabled := true; Act_TurnToFirstCablePart.Enabled := true; PrevPartComponent := GetNearComponentFromListIDs(GSCSBase.CurrProject, SCSCable.WholeComponent, SCSCable, -1); if PrevPartComponent <> nil then Act_TurnToPrevCablePart.Hint := PrevPartComponent.GetNameForVisible; FirstPartComponent := GSCSBase.CurrProject.GetComponentFromReferences(SCSCable.FirstIDCompon); if FirstPartComponent <> nil then Act_TurnToFirstCablePart.Hint := FirstPartComponent.GetNameForVisible; end; if (SCSCable.LastIDCompon <> 0) and (SCSCable.ID <> SCSCable.LastIDCompon) then begin Act_TurnToNextCablePart.Enabled := true; Act_TurnToLastCablePart.Enabled := true; NextPartComponent := GetNearComponentFromListIDs(GSCSBase.CurrProject, SCSCable.WholeComponent, SCSCable, 1); if NextPartComponent <> nil then Act_TurnToNextCablePart.Hint := NextPartComponent.GetNameForVisible; LastPartComponent := GSCSBase.CurrProject.GetComponentFromReferences(SCSCable.LastIDCompon); if LastPartComponent <> nil then Act_TurnToLastCablePart.Hint := LastPartComponent.GetNameForVisible; end; if (SCSCable.FirstIDConnectedConnCompon <> 0) then Act_TurnToFirstCablePoint.Enabled := true; if (SCSCable.LastIDConnectedConnCompon <> 0) then Act_TurnToLastCablePoint.Enabled := true; end; end; end; procedure TF_MAIN.Act_TurnToFirstCablePartExecute(Sender: TObject); var SCSCable: TSCSComponent; FirstCablePart: TSCSComponent; begin SCSCable := nil; FirstCablePart := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin FirstCablePart := GSCSBase.CurrProject.GetComponentFromReferences(SCSCable.FirstIDCompon); if FirstCablePart <> nil then SelectComponByIDInTree(FirstCablePart.ID); end; end; procedure TF_MAIN.Act_TurnToLastCablePartExecute(Sender: TObject); var SCSCable: TSCSComponent; LastCablePart: TSCSComponent; begin SCSCable := nil; LastCablePart := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin LastCablePart := GSCSBase.CurrProject.GetComponentFromReferences(SCSCable.LastIDCompon); if LastCablePart <> nil then SelectComponByIDInTree(LastCablePart.ID); end; end; procedure TF_MAIN.Act_TurnToPrevCablePartExecute(Sender: TObject); var SCSCable: TSCSComponent; PrevCablePart: TSCSComponent; begin SCSCable := nil; PrevCablePart := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin PrevCablePart := GetNearComponentFromListIDs(GSCSBase.CurrProject, SCSCable.WholeComponent, SCSCable, -1); if PrevCablePart <> nil then SelectComponByIDInTree(PrevCablePart.ID); end; end; procedure TF_MAIN.Act_TurnToNextCablePartExecute(Sender: TObject); var SCSCable: TSCSComponent; NextCablePart: TSCSComponent; begin SCSCable := nil; NextCablePart := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin NextCablePart := GetNearComponentFromListIDs(GSCSBase.CurrProject, SCSCable.WholeComponent, SCSCable, 1); if NextCablePart <> nil then SelectComponByIDInTree(NextCablePart.ID); end; end; procedure TF_MAIN.Act_TurnToFirstCablePointExecute(Sender: TObject); var SCSCable: TSCSComponent; begin SCSCable := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin if SCSCable.FirstConnectedConnCompon <> nil then SelectComponByIDInTree(SCSCable.FirstConnectedConnCompon.ID); end; end; procedure TF_MAIN.Act_TurnToLastCablePointExecute(Sender: TObject); var SCSCable: TSCSComponent; begin SCSCable := nil; SCSCable := GetComponentFromNode(Tree_Catalog.Selected); if (SCSCable <> nil) and (SCSCable.IsLine = biTrue) then begin if SCSCable.LastConnectedConnCompon <> nil then SelectComponByIDInTree(SCSCable.LastConnectedConnCompon.ID); end; end; procedure TF_MAIN.Act_TurnFromMemTableToSpravochnikExecute( Sender: TObject); var InterfPortMemTable: TkbmMemTable; begin InterfPortMemTable := GetInterfPortMemTable; if InterfPortMemTable <> nil then ShowSpravochnikForInterface(Self, InterfPortMemTable); end; procedure TF_MAIN.Act_AddCableChannelElementExecute(Sender: TObject); begin AddEditCableCanalConnector(meMake); EnableEditDel(itAuto); end; procedure TF_MAIN.Act_EditCableChannelElementExecute(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- AddEditCableCanalConnector(meEdit); end; procedure TF_MAIN.Act_DelCableChannelElementExecute(Sender: TObject); var DelName: String; DelID: Integer; SCSComponent: TSCSComponent; ptrCableCanalConnector: PCableCanalConnector; begin try with DM do begin DelName := mtCableCanalConnectors.FieldByName(fnName).AsString; if MessageModal(cMain_Msg107+' "'+DelName+'"?', Application.Title, MB_YESNO or MB_ICONQUESTION) = IDYES then begin DelID := mtCableCanalConnectors.FieldByName(fnID).AsInteger; mtCableCanalConnectors.Delete; SCSComponent := GetActualSelectedComponent;; if SCSComponent <> nil then begin ptrCableCanalConnector := SCSComponent.GetCableCanalConnectorByID(DelID); if ptrCableCanalConnector <> nil then begin SCSComponent.CableCanalConnectors.Remove(ptrCableCanalConnector); FreeMem(ptrCableCanalConnector); end; end; if GDBMode = bkNormBase then begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnCableCanalConnectors, fnID+' = :'+fnID, nil, ''), false); Query_Operat.ParamByName(fnID).AsInteger := DelID; Query_Operat.ExecQuery; end; GSCSBase.SCSComponent.NotifyChange; end; end; EnableEditDel(itAuto); except on E: Exception do AddExceptionToLog('TF_MAIN.Act_DelCableChannelElementExecute: '+E.Message); end; end; procedure TF_MAIN.GT_CableCanalConnectorsConnectorTypeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText <> '' then AText := GetCableChannelElementName(StrToInt(AText)); end; procedure TF_MAIN.Act_FindComponInNBExecute(Sender: TObject); var Dat: PObjectData; Compon: TSCSComponent; CanMessage: Boolean; begin if GDBMode = bkProjectManager then begin Dat := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if IsComponItemType(Dat.ItemType) then //if Dat.ItemType in [itComponline, itComponCon] then begin Compon := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Compon <> nil then begin CanMessage := false; if FNormBase.SelectComponInPCObjectsByGUID(Compon.GuidNB) <> nil then begin if Compon.IsTemplate = biFalse then if FNormBase.FindComponentByGUIDWithBlink(Compon.GuidNB) = nil then CanMessage := true; end else CanMessage := true; if CanMessage then MessageModal(cMain_Msg108, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; end; end; procedure TF_MAIN.Act_ShowProjectPlanExecute(Sender: TObject); begin CallProjectPlanFromNB; end; procedure TF_MAIN.Act_ShowLineComponsWithoutVolumeExecute(Sender: TObject); var LineComponIDs: TIntList; i: Integer; begin try if GDBMode = bkNormBase then begin LineComponIDs := TIntList.Create; SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnIsLine+' = '''+IntToStr(biTrue)+'''', nil, fnID)); IntFIBFieldToIntList(LineComponIDs, DM.Query_Select, fnID); SetSQLToFIBQuery(DM.Query_Select, 'select count(id) from interface_relation '+ 'where (id_component = :id_component) and '+ '(TypeI = '''+IntToStr(itConstructive)+''') and Not(Multiple = '''+IntToStr(biTrue)+''') and (ValueI > 0)', false); i := 0; while i <= LineComponIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.ParamByName(fnIDComponent).AsInteger := LineComponIDs[i]; DM.Query_Select.ExecQuery; if DM.Query_Select.FN(fnCount).AsInteger > 0 then Inc(i) else LineComponIDs.Delete(i); end; ShowComponentsInListByIDList(LineComponIDs, ApplicationName, Act_ShowLineComponsWithoutVolume.Caption+': '); FreeAndNil(LineComponIDs); end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_ShowLineComponsWithoutVolumeExecute: '+E.Message); end; end; procedure TF_MAIN.tbTest2Click(Sender: TObject); var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // StringList: TStringList; Form: TForm; TestRapList: TRapList; PMenu: TPopupMenu; pmItem: TMenuItem; Capt: String; i: Integer; pt: TPoint; begin SaveProjectRevision; Exit; ///// EXIT ///// StringList := DM.GetComponsFailPortWireCount(true, true); ShowMessage('Найдено '+IntToStr(StringList.Count)+' шт.'); if Not Act_ChoiceFind.Checked then Act_ChoiceFind.Execute; ClearListView(ListView_Find); LoadItemsToListViewFromStringList(StringList); Exit; ///// EXIT ///// GroupRoomNets(FSCS_Main.ActiveMDIChild, nil, true); Exit; ///// EXIT ///// GetNetPathByComponID(6, GCadForm).IsPointIn(54, 25, false); //22.08.2012 GCadForm.PCad.ResetRegions; {for i := 0 to GCadForm.PCad.Figures.Count - 1 do begin if TFigure(GCadForm.PCad.Figures[i]) is TNet then TNet(GCadForm.PCad.Figures[i]).RefreshPaths(true); end;} Exit; ///// EXIT ///// CorrectSILFile; //GCadForm.PCad.TestListFigures(false); //GCadForm.PCad.TestListFigures(true); Exit; ///// EXIT ///// //GCadForm.PCad.DEngine.Canvas; SetBkMode (GCadForm.PCad.DEngine.Canvas.Handle, Transparent); Exit; ///// EXIT ///// //ShowMenuItems(FSCS_Main.pmList.Items, FSCS_Main.pmList.Name); //ShowMenuItems(FSCS_Main.pmSCSObject.Items, FSCS_Main.pmSCSObject.Name); //ShowMenuItems(FSCS_Main.pmHouseDesign.Items, FSCS_Main.pmHouseDesign.Name); //ShowMenuItems(FSCS_Main.pmCadNorms.Items, FSCS_Main.pmCadNorms.Name); //Exit; ///// EXIT ///// //NetPathPerpendSideRotate(nil); SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); //NetDoorRotate; //BalloonHints. {GetCursorPos(pt); Application.Hint := 'asdfasfd sadf safsadf asdf sdfads'; //Application.Hint Application.ActivateHint(pt);} ShowHintRz('Это всплывающая подсказка', 2000); Exit; TNet(nil).SrvDropFComponID; ServDefineNetSegsHeights; Exit; //GCadForm.PCad.Get3DModel(GSCSBase.CurrProject.CurrList.File3D); //LoadCADFromFile('D:\temp\SCS\SCS - Dipro\SCSCAD\E858C7474A804DC4AB3FC07A015D2CEA.tmp'); //LoadCADFromFile('D:\temp\SCS\SCS - Dipro\SCSCAD\'+InputBox('','','')); //ShowCADObjectView(false); GLog.Clear; GLog.Add(''); PMenu := FSCS_Main.pmObject; for i := 0 to PMenu.Items.Count - 1 do begin pmItem := PMenu.Items[i]; if pmItem.Action <> nil then Capt := pmItem.Action.Name else Capt := pmItem.Name; GLog.Add('FSCS_Main.'+ PMenu.Name +'['+IntToStr(i)+'] - '+Capt); end; //FSCS_Main.MainMenu.I //FSCS_Main.pmArchDesign.Items.c {Exit; GLog.Clear; GLog.Add(''); GLog.Add('// Для сегмента'); GLog.Add('if TNet(PCad.Selection[0]).SelPath <> nil then'); GLog.Add('begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[0].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[1].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[2].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[3].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[4].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[5].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[6].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[7].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[9].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[11].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[12].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[13].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[14].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[15].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[16].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[17].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[18].Action.Name +'.Visible := True;'); GLog.Add(' if TNet(PCad.Selection[0]).SelPath.ActiveDoor <> nil then'); GLog.Add(' begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[8].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[10].Action.Name +'.Visible := True;'); GLog.Add(' end'); GLog.Add(' else'); GLog.Add(' begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[8].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[10].Action.Name +'.Visible := False;'); GLog.Add(' end;'); GLog.Add(' if TNet(PCad.Selection[0]).SelPath.FShowLength then'); GLog.Add(' begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[18].Action.Name +'.Checked := True;'); GLog.Add(' end'); GLog.Add(' else'); GLog.Add(' begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[18].Action.Name +'.Checked := False;'); GLog.Add(' end;'); GLog.Add(' FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y);'); GLog.Add('end;'); GLog.Add('// Для колонны'); GLog.Add('if TNet(PCad.Selection[0]).SelCol <> nil then'); GLog.Add('begin'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[0].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[1].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[2].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[3].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[4].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[5].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[6].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[7].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[8].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[9].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[10].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[11].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[12].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[13].Action.Name +'.Visible := True;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[14].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[15].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[16].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[17].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.'+ FSCS_Main.pmArchDesign.Items[18].Action.Name +'.Visible := False;'); GLog.Add(' FSCS_Main.pmArchDesign.Popup(Point.X, Point.Y);'); GLog.Add('end;'); } Exit; FSCS_Main.AddDoorNiche; { if BkgImages <> nil then begin GCadForm.PCad.AutoRefresh := false; try for i := 0 to BkgImages.Count - 1 do begin GCadForm.PCad.Figures.Remove(BkgImages[i]); TFigure(BkgImages[i]).Free; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.tbTest2Click', E.Message); end; GCadForm.PCad.AutoRefresh := true; end; GCadForm.PCad.Refresh; } //CreateApproachInPM(GSCSBase.CurrProject.CurrList.CurrID, GSCSBase.SCSComponent.ID); //ShowCount := 0; Exit; ///// EXIT ///// CreateFMakeMarkPage.Execute(rtMarkCable); Exit; ///// EXIT ///// TestRapList := TRapList.Create; TestRapList.IndexOf(nil); OldTick := GetTickCount; for i := 0 to 5000000 do begin TestRapList.Add(nil); //TestRapList[TestRapList.Count-1] := Pointer(1); TestRapList.List[TestRapList.Count-1] := Pointer(1) //TestRapList.IndexOf(nil); end; for i := 0 to TestRapList.Count - 1 do TestRapList.Delete(TestRapList.Count - 1); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; FreeAndNil(TestRapList); Exit; ///// EXIT ///// //LoginUserToProMan; //if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then // ShowProjUsers(PObjectData(Tree_Catalog.Selected.Data).ObjectID); Form := TF_Kalc.Create(Self); Form.ShowModal; Form.Free; Exit; ///// EXIT ///// CreateFBackUpBase.Execute(fmRestore); Exit; ///// EXIT ///// OldTick := GetTickCount; //GSCSBase.CurrProject.SaveToStreamOrFile(nil, 'c:\temp\ProgLite.prg', true); //GSCSBase.CurrProject.CurrList.ComplexSaveToDir('c:\temp\SCSListFiles'); SaveListToUndoStack(GSCSBase.CurrProject.CurrList.CurrID); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; GSCSBase.CurrProject.CurrList.GetAllStrings; end; procedure TF_MAIN.tbTestClick(Sender: TObject); var //IDConnectorObject: Integer; //SCSCatalog: TSCSCatalog; Interf: TSCSInterface; BusyPosition: TSCSInterfPosition; EmptyPositions: TSCSInterfPositions; EmptyPosition: TSCSInterfPosition; Positions: TStringList; PoinerAdress: Pointer; i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; SCSInterf: TSCSInterface; ClearInterfCount: Integer; ptrProperty: PProperty; SCSProp: TSCSProperty; ptrComponentType: PComponentTypeTmp; ptrComponentTypeTmp: PComponentTypeTmp; ComponentTypeTmp: TComponentTypeTmp; SCSComponentType: TSCSComponentType; ptrPortInterfRel: PPortInterfRel; ptrSuppliesKind: PSuppliesKind; SCSQuery: TSCSQuery; CatIDs: TIntList; CatParentIDs: TIntList; CatRelCatalogIDs: TIntList; CatRelComponIDs: TIntList; KeyState: Short; Dir: string; ptrMemValue: PMemValue; StringList: TStringList; DateTime1: TDateTime; DateTime2: TDateTime; Stream: TMemoryStream; F_UsersEditor: TF_UsersEditor; ReservUsers: TStringList; TestList: TList; RapObjectList: TRapObjectList; IntList: TIntList; Figure: TFigure; FigureID: Integer; //SCSCatalog: TSCSCatalog; DataStream: TDataStream; FileStream: TFileStream; //StringList: TStringList; CountString: Integer; FieldNames: TStringList; FloatVal, FloatVal2: Double; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // GridColumn: TcxGridDBColumn; //F_MasterDefectAct: TF_MasterDefectAct; ListParams: TListParams; //Figure: TFigure; procedure AddBusyPosition(AFrom, ATo: Integer); begin BusyPosition := TSCSInterfPosition.Create(nil); //GetZeroMem(BusyPosition, SizeOf(TInterfPosition)); BusyPosition.FromPos := AFrom; BusyPosition.ToPos := ATo; Interf.BusyPositions.Add(BusyPosition); Positions.Add(IntToStr(AFrom) + ' - ' +IntToStr(ATo)); end; procedure TestConst(Aparam: String); var val: String; begin val := AnsiUpperCase(Aparam); end; function CompareItems(Item1, Item2: Pointer): Integer; begin Result := CompareInt(Integer(Item1), Integer(Item2)); end; begin CreateFProjectRev.Execute; //CreateFNormsComplete.Execute(GetActualSelectedCatalog, true, true, true); //CreateFNormsGroups.Execute(GetActualSelectedCatalog, true, true, true); Exit; ///// EXIT ///// //ExpProjToStroyCalcTest; {if Assigned(GCadForm.PCad.OnTraceDraw) then GCadForm.PCad.OnTraceDraw := nil else GCadForm.PCad.OnTraceDraw := GCadForm.OnTraceDraw;} //Figure := GetFigureByID(GCadForm, 692); try GCadForm.PCad.DeselectAll(0); GCadForm.PCad.SelectAll(7); {for i := 0 to GCadForm.PCad.Figures.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Figures[i]); if Not Figure.Visible then Figure.Visible := true; end; RefreshCAD_T(GCadForm.PCad);} except on E: Exception do AddExceptionToLogExt(ClassName, 'Test', E.Message); end; Exit; ///// EXIT ///// FSCS_Main.aCreateFloorRaiseDown.Execute; Exit; ///// EXIT ///// IntList := TIntList.Create; OldTick := GetTickCount; for i := 174582 downto 1 do begin //RapObjectList := TRapObjectList.Create; InsertValueToSortetIntList(i, IntList); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; IntList.Free; Exit; ///// EXIT ///// ExpProjToStroyCalcTest; //ShowMessage(Trim(' qwerty йцуке ')); Exit; ///// EXIT ///// TestList := TList.Create; OldTick := GetTickCount; for i := 1 to 10000000 do TestList.Add(Pointer(i)); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; TestList.Sort(@CompareItems); //for i := 1 to 10000000 do // InsertValueToSortetList(Pointer(i), TestList); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //GCadForm.PCad.PrintRegion(GMouseDownPos.X, GMouseDownPos.Y, GMouseDownPos.X+150, GMouseDownPos.Y+150); //GCadForm.PCad.PrintRectPreview(DoubleRect(GMouseDownPos.X, GMouseDownPos.Y, GMouseDownPos.X+150, GMouseDownPos.Y+150)); //GCadForm.FCreateObjectOnClick := False; //GCadForm.PCad.SetTool(toFigure, 'TPrintRect'); Exit; ///// EXIT ///// //Figure := TOrthoLine.create(0,0,0,0,0,0,0,0,0,0,0,mydsNormal,nil); {CheckFigureByClassName(Figure, cTOrthoLine); CheckFigureByClassIdx(Figure, ciTOrthoLine); Figure.Free; CheckFigureByClassName(Figure, cTOrthoLine); CheckFigureByClassIdx(Figure, ciTOrthoLine); Exit; ///// EXIT /////} OldTick := GetTickCount; //8523126 for i := 1 to 8521998 do CheckFigureByClassName(Figure, cTRichTextMod); //CheckFigureByClassName(TFigure(GCadForm.PCad.Figures[0]), cTRichTextMod); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; for i := 1 to 8521998 do CheckFigureByClassIdx(TFigure(GCadForm.PCad.Figures[0]), 1); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Exit; ///// EXIT ///// OldTick := GetTickCount; for i := 1 to 1000000000 do begin EmptyProcedure; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Exit; ///// EXIT ///// GCadForm.FCreateObjectOnClick := False; RestoreCadGridStatus; // Tolik 04/03/2021 -- GCadForm.PCad.SetTool(toFigure, 'TArcDimLine'); //GCadForm.PCad.SetTool(toFigure, 'TCDimLine'); Exit; for i := 0 to GCadForm.PCad.Figures.Count - 1 do begin Figure := TFigure(GCadForm.PCad.Figures[i]); if Figure is TNet then DefineArchRoomCornersNamesByCadObj(Figure); end; //GT_PROPERTY.OptionsBehavior.CellHints //GCadForm.PCad. //RotateNetTo2D(TNet(GCadForm.PCad.Selection[0]), nil); //tan(2/3); //MirrorFigure(TFigure(GCadForm.PCad.Selection[0])); Exit; OldTick := GetTickCount; for i := 1 to 1000000000 do begin FloatVal := 50 / 1000; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; for i := 1 to 1000000000 do begin FloatVal := 50 * 0.001; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //Act_SendModelToProject.Execute; //IncDefWallType; //ExpProjToStroyCalcTest; Exit; ///// EXIT ///// //ButtonEdit_Find.Properties.Buttons.Count GetObjectBlockToSubstrateLayer(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID); //FSCS_Main.aInsertBlock.Execute; //GetObjectBlockByID(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID, true); //GetObjectBlockStream(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID); Exit; ///// EXIT ///// SetConnComponToTraces(GCadForm, F_NormBase.GSCSBase.SCSComponent, 1.5, false); //DivideTracesOnRoowWalls(GCadForm); //AutoCreateTraces; Exit; ///// EXIT ///// CreateFResourceReport.ShowCablePathsWizard(GetActualSelectedComponent); Exit; ///// EXIT ///// {TestGetInterfPosIntersectRange(1,2, 1,1, 1,1); TestGetInterfPosIntersectRange(1,2, 2,4, 2,2); TestGetInterfPosIntersectRange(1,2, 3,3, 0,0); TestGetInterfPosIntersectRange(1,2, 3,4, 0,0); TestGetInterfPosIntersectRange(3,5, 2,4, 3,4); TestGetInterfPosIntersectRange(3,5, 5,5, 5,5); TestGetInterfPosIntersectRange(6,8, 5,5, 0,0); TestGetInterfPosIntersectRange(1,1, 1,2, 1,1); TestGetInterfPosIntersectRange(2,4, 1,2, 2,2); TestGetInterfPosIntersectRange(3,3, 1,2, 0,0); TestGetInterfPosIntersectRange(3,4, 1,2, 0,0); TestGetInterfPosIntersectRange(2,4, 3,5, 3,4); TestGetInterfPosIntersectRange(5,5, 3,5, 5,5); TestGetInterfPosIntersectRange(5,5, 6,8, 0,0);} //NetPathToArc; //ExpProjToStroyCalcTest; //ReloadProgram; Exit; //ShowMessage(StringReverse('RDB$FIELD_LENGTH')+#13+#10+StringReverse('RDB$CHARACTER_LENGTH')); //MakeNewList; ListParams := GetListParamsForNewList; MakeEditList(meMake, ListParams, false); FSCS_Main.aOpenVectorDrawing.Execute; //F_ResourceReport.ShowComponSpecifications(GSCSBase.CurrProject.CurrList, nil, nil); //ExpProjToStroyCalcTest; Exit; ShowMessage(CutBeginZeroDefisInArticle('1-1711061-1')); Exit; FSCS_Main.AddDoorEmbrasure; //OpenBackgrImages; //ShowMessage(FloatToStr(pi * power(2.5, 2))); //WinExec(PChar(Application.ExeName), SW_SHOW); // принужденное завершение программы не учитвая флаг ACanExitProc //ExitProcess(0); Exit; ///// EXIT ///// GUseLiteFunctional := Not GUseLiteFunctional; SetControlsByUseLiteFunctional(GLiteVersion, GUseLiteFunctional, true); Exit; ///// EXIT ///// DefinePropSectionForLineCompons(DM.Query_Select, DM.Query_Operat, pnOutSection, GCompTypeSysNameCables, gtMale, true); DefinePropSectionForLineCompons(DM.Query_Select, DM.Query_Operat, pnInSection, GCompTypeSysNameCableChannels, gtFemale, true); // На каб канал доб-м св-во внешнее сечение, если есть инетрфейс папа DefinePropSectionForLineCompons(DM.Query_Select, DM.Query_Operat, pnOutSection, GCompTypeSysNameCableChannels, gtMale, false); Exit; ///// EXIT ///// Dir := Self.MethodName(@TF_MAIN.tbTestClick); Sleep(10); Exit; ///// EXIT ///// SetSQLToFIBQuery(DM.Query_Select, 'select * from GET_CHILD_CATALOGS(:catalog_id)', false); //SetSQLToFIBQuery(DM.Query_Select, 'select id, name from katalog where parent_id = :catalog_id', false); try OldTick := GetTickCount; for i := 0 to 100-1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := 8345; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin DM.Query_Select.Next; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do AddExceptionToLogEx('', E.Message); end; Exit; ///// EXIT ///// BrowseDialog('test', 'c:\temp'); Exit; ///// EXIT ///// OldTick := GetTickCount; for i := 0 to 100000-1 do begin j := GetTickCount; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {EmptyProcedure; OldTick := GetTickCount; for i := 0 to 1000000-1 do begin //SCSCatalog := TSCSCatalog.Create(Self); //GetMem(ptrProperty, SizeOf(TProperty)); //SCSProp := TSCSProperty.Create(Self); New(ptrProperty); //GetMem(ptrComponentType, SizeOf(TComponentType)); //SCSComponentType := TSCSComponentType.Create(Self); //New(ptrComponentTypeTmp); end; CurrTick := GetTickCount - OldTick; i := Integer(ptrProperty.Name_); EmptyProcedure;} Exit; ///// EXIT ///// for i := 0 to GT_NormsResources.ColumnCount - 1 do begin GridColumn := GT_NormsResources.Columns[i]; GLog.Add(' '); GLog.Add('name = '+GridColumn.Name); GLog.Add('FieldName = '+GridColumn.DataBinding.FieldName); GLog.Add('Caption = '+GridColumn.Caption); GLog.Add('Options.Editing = '+BoolToStr(GridColumn.Options.Editing, true)); if GridColumn.Properties <> nil then GLog.Add('Properties.ClassName = '+GridColumn.Properties.ClassName); GLog.Add('Visible = '+BoolToStr(GridColumn.Visible, true)); GLog.Add('Width = '+FloatToStr(GridColumn.Width)); end; Exit; ShowMessage(FloatToStr(GetAngleBetweenLines(1, 3, 5, 4, at_Horizontal))); Exit; Stream := GetObjectBlockStream(GSCSBase.SCSCatalog.ListID, GSCSBase.SCSCatalog.SCSID); Stream.SaveToFile('c:\BlockFromFigure.pwb'); //Figure := GetFigureByID(GCadForm, GSCSBase.SCSCatalog.SCSID); //if Figure <> nil then // if Figure is TOrtholine then // begin // //TOrtholine(Figure).DrawFigure.InFigures // end; { FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnNameShort); SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnComponent, fnID+' = :'+fnID, FieldNames, '')); DM.Query_Operat.ParamByName(fnID).AsInteger := 26069; //DM.Query_Operat.ParamByName(fnName).AsString := 'Розетка RJ45'; DM.Query_Operat.ParamByName(fnNameShort).AsString := 'Р. RJ45'; DM.Query_Operat.ExecQuery; FreeAndNil(FieldNames);} Exit; ///// EXIT ///// {FileStream := TFileStream.Create('myfile.ini'); StringList := TStringList.Create; StringList.Add('[NAME]'); OldTick := GetTickCount; i := 0; CountString := 0; while i <= 1000 do begin StringList.Add('name'+IntToStr(i+1)+'='+'Значение из Query'); CountString := CountString + 1; if CountString = 100 then begin CountString := 0; StringList.SaveToStream(FileStream); StringList.Clear; end; i := i + 1; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; FreeAndNil(StringList); FreeAndNil(FileStream); } OldTick := GetTickCount; for i := 0 to 1000000 do begin TestConst('{AD224D8B-50FF-4591-8708-D6BF16F4E206}{46D9243F-F467-4710-8737-837E53472FBB}'); end; CurrTick := GetTickCount - OldTick; //CurrTick := GetTickCount - OldTick; ShowMessage(IntToStr(CurrTick)); Exit; ///// EXIT ///// RapObjectList := TRapObjectList.Create; SCSComponent := TSCSComponent.Create(Self); SCSComponent.ID := 2020; RapObjectList.Insert(SCSComponent, @SCSComponent.ID); SCSComponent := TSCSComponent.Create(Self); SCSComponent.ID := 20; RapObjectList.Insert(SCSComponent, @SCSComponent.ID); SCSComponent := TSCSComponent.Create(Self); SCSComponent.ID := 3020; RapObjectList.Insert(SCSComponent, @SCSComponent.ID); SCSComponent := TSCSComponent.Create(Self); SCSComponent.ID := 3000; RapObjectList.Insert(SCSComponent, @SCSComponent.ID); SCSComponent := TSCSComponent(RapObjectList.GetObject(20)); PoinerAdress := Pointer(Integer(@SCSComponent.ID) - Integer(SCSComponent)); i := Integer(Pointer(Integer(SCSComponent) + Integer(PoinerAdress))^); Exit; ///// EXIT ///// DataStream := TDataStream.Create; //MemStream.WriteComponent(Self); FileStream := TFileStream.Create('c:\testStream.dat', fmCreate); //MemStream.Position := 0; //MemStream.LoadFromStream(nil); //ObjectBinaryToText(MemStream, FileStream); GSCSBase.CurrProject.MemBase.EmptyAllTables; GSCSBase.CurrProject.MemBase.OpenAllTables; SCSComponent := TSCSComponent.Create(Self); { DataStream.MemoryAllocBy := 8000 * TObject(SCSComponent).InstanceSize; OldTick := GetTickCount; DataStream.BeginWriteTable(tnComponent, 0); for i := 1 to 5000 do SCSComponent.SaveToDataStream(DataStream, GSCSBase.CurrProject.StringsMan, true); DataStream.EndWriteTable; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; if DataStream.BeginReadTable then for i := 0 to DataStream.RecordCount - 1 do begin SCSComponent.LoadFromDataStream(DataStream, GSCSBase.CurrProject.StringsMan); end; DataStream.EndReadTable; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; } DM.tSQL_Component.MemoryTableAllocBy := 5000 * TObject(SCSComponent).InstanceSize; OldTick := GetTickCount; for i := 1 to 5000 do SCSComponent.SaveToMemTable(meMake, GSCSBase.CurrProject.StringsMan, true); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; DM.tSQL_Component.First; while Not DM.tSQL_Component.Eof do begin SCSComponent.LoadFromMemTable(GSCSBase.CurrProject.StringsMan); DM.tSQL_Component.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; FreeAndNil(DataStream); //FreeAndNil(FileStream); //GCadForm.FListType := lt_Normal; //GSCSBase.CurrProject.CurrList.Setting.ListType := lt_Normal; {FigureID := Figure.ID; SCSCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(FigureID); if SCSCatalog <> nil then begin // Список всех компонентов верхнего уровня TSCSComponent SCSCatalog.SCSComponents.Count; if SCSCatalog.SCSComponents[0].ComponentType.SysName = ctsnCable then SCSCatalog.SCSComponents[0].ChildComplects[0].ComponentType end;} {ShowMessage(IntToStr(ShowCount)); ReservUsers := TStringList.Create; ReservUsers.LoadFromFile('c:\BaseconstantsPE.pas'); if CheckStrHaveRusSymb(ReservUsers.Text) then EmptyProcedure; FreeAndNil(ReservUsers);} //ShowMessage(FloatToStr(FloatInUOM(StrToFloat_My(InputBox('', '', '5')), umSantimetr, umInch, 2))); { CatIDs := DecToSN(StrToInt(InputBox('', '', '')), 16); Dir := ''; for i := 0 to CatIDs.Count - 1 do begin if Dir <> '' then Dir := Dir + ', '; Dir := Dir + IntToStr(CatIDs[i]); end; ShowMessage(Dir); FreeAndNil(CatIDs); Exit; ///// EXIT ///// } Exit; ///// EXIT ///// Dir := ''; for i := 0 to 102 - 1 do begin if Dir <> '' then Dir := Dir + ','; Dir := Dir + DecToABC(i); end; ShowMessage(Dir); Exit; ///// EXIT ///// RepMarkPages; Exit; ///// EXIT ///// GT_PROPERTY.OptionsSelection.MultiSelect := true; GT_PROPERTY.BeginUpdate; GT_PROPERTY.DataController.ClearSelection; for i := 0 to GT_PROPERTY.DataController.RecordCount - 1 do begin if (i mod 2) = 0 then GT_PROPERTY.DataController.ChangeRowSelection(GT_PROPERTY.DataController.GetRowIndexByRecordIndex(i, true), true); end; GT_PROPERTY.EndUpdate; GT_Port.OptionsSelection.MultiSelect := true; //TcxCustomEdit(Self.ActiveControl.Parent).ValidateEdit(false); //TcxCustomComboBoxInnerEdit(AForm.ActiveControl) //ShowKalc; Exit; ///// EXIT ///// OldTick := GetTickCount; GetPointObjectRelationsBetweenListDistr(GSCSBase.CurrProject.CurrList.CurrID); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Exit; ///// EXIT ///// TestList := TList.Create; OldTick := GetTickCount; for i := 0 to 5000000 do if false = true then EmptyProcedure; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; for i := 0 to 5000000 do if TestList.ClassName = 'TObjectList' then EmptyProcedure; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {OldTick := GetTickCount; for i := 0 to 5000000 do begin TestList.Add(nil); TestList[TestList.Count-1] := Pointer(1); //TestList.IndexOf(nil); end; for i := 0 to TestList.Count - 1 do TestList.Delete(TestList.Count - 1); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick;} FreeAndNil(TestList); Exit; ///// EXIT ///// XorStr('abcdef', $FE, true); //MessageDlgLn('Test', ApplicationName, mtConfirmation, mbYesAllNoAllCancel); Exit; ///// EXIT ///// XorStr('abcdef'); {ReservUsers := TStringList.Create; ReservUsers.Add(unAdmin); F_UsersEditor := TF_UsersEditor.Create(Self, Self); F_UsersEditor.Execute(DM.UsersInfoPM, true, cSCSComponent_Msg17, ReservUsers);} ShowCurrUserInfo; ShowPMUsers; Exit; ///// EXIT ///// DM.UsersInfoPM.AddNewUserInfo('ADMIN', 'ADMIN', rwrReadWrite, rwrReadWrite); DM.UsersInfoPM.AddNewUserInfo('USER', 'USER', rwrReadWrite, rwrReadWrite); Stream := TMemoryStream.Create; DM.UsersInfoPM.SaveToStream(Stream); Stream.Position := 0; DM.UsersInfoPM.LoadFromStream(Stream); FreeAndNil(Stream); Exit; ///// EXIT ///// BrowseDialog('test', ''); Exit; ///// EXIT ///// ShowMessage(BrowseDialogRemote(Handle, '', 'Select base')); Exit; ///// EXIT ///// FindComputers(nil, nil); Exit; ///// EXIT ///// //ShowMessage(ShowServerDialog(Handle)); //Exit; ///// EXIT ///// CreateFBackUpBase.Execute(fmBackUp); Exit; ///// EXIT ///// GetComponGUIDsFromNBFavorites; Exit; ///// EXIT ///// CatIDs := TIntList.Create; CatParentIDs := TIntList.Create; CatRelCatalogIDs := TIntList.Create; CatRelComponIDs := TIntList.Create; OldTick := GetTickCount; SetSQLToFIBQuery(DM.Query_Select, 'select id, parent_id from '+tnCatalog{+' order by parent_id, sort_id'}); while Not DM.Query_Select.Eof do begin CatIDs.Add(DM.Query_Select.Fields[0].AsInteger); CatParentIDs.Add(DM.Query_Select.Fields[1].AsInteger); DM.Query_Select.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; SetSQLToFIBQuery(DM.Query_Select, 'select id_catalog, id_component from '+tnCatalogRelation{+' order by id_catalog'} {' order by id_catalog, id_component'}); while Not DM.Query_Select.Eof do begin CatRelCatalogIDs.Add(DM.Query_Select.Fields[0].AsInteger); CatRelComponIDs.Add(DM.Query_Select.Fields[1].AsInteger); DM.Query_Select.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; GCadForm.PCad.RefreshSelection; //SetSQLToFIBQuery(DM.Query_Select, 'select cast(now as timestamp) as DatTim from RDB$Database'); //ShowMessage(DateTimeToStr(DM.Query_Select.Fields[0].AsDateTime)); //DateTime1 := StrToDateTime('13.11.2007 22:59:20'); //DateTime2 := StrToDateTime('12.11.2007 23:53:10'); //ShowMessage(DateTimeToStr(DateTime1 - DateTime2)); { SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, 'UPPER('+fnArticulProducer+') = :'+fnArticulProducer, nil, fnName), false); DM.Query_Select.ParamByName(fnArticulProducer).AsString := 'at-k 1801pb'; DM.Query_Select.ExecQuery; while Not DM.Query_Select.Eof do begin DM.Query_Select.Next; end; Exit; ///// EXIT /////} {try for i := 0 to 15 do begin GetMem(ptrMemValue, SizeOf(TMemValue)); ptrMemValue.FieldName := 'str1'; ptrMemValue.Str := 'Str2'; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end;} { EmptyProcedure; OldTick := GetTickCount; for i := 0 to 100000-1 do begin //GetMem(ptrComponentType, SizeOf(TComponentType)); New(ptrComponentType); ZeroMemory(ptrComponentType, SizeOf(TComponentTypeTmp)); ptrComponentType.Name := 'Str2'; ptrComponentType.ID := ptrComponentType.ID; ptrComponentType.GUID := ptrComponentType.GUID; ptrComponentType.Name := ptrComponentType.Name; ptrComponentType.NamePlural := ptrComponentType.NamePlural; ptrComponentType.SysName := ptrComponentType.SysName; ptrComponentType.MarkMask := ptrComponentType.MarkMask; ptrComponentType.PortKind := ptrComponentType.PortKind; ptrComponentType.ActiveState := ptrComponentType.ActiveState; ptrComponentType.IDDesignIcon := ptrComponentType.IDDesignIcon; ptrComponentType.GUIDDesignIcon := ptrComponentType.GUIDDesignIcon; ptrComponentType.IsLine := ptrComponentType.IsLine; ptrComponentType.IsStandart := ptrComponentType.IsStandart; ptrComponentType.CoordZ := ptrComponentType.CoordZ; ptrComponentType.IDComponTemplate := ptrComponentType.IDComponTemplate; ptrComponentType.ComponentIndex := ptrComponentType.ComponentIndex; ComponentTypeTmp := ptrComponentType^; ZeroMemory(@ComponentTypeTmp, SizeOf(TComponentTypeTmp)); //New(ptrComponentTypeTmp); end; EmptyProcedure; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick;} Exit; ///// EXIT ///// OldTick := GetTickCount; //GSCSBase.CurrProject.ComplexSaveToDir('c:\temp\SCSProjFiles'); SaveCurrProjectToUndoStack; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; GSCSBase.CurrProject.CurrList.GetAllStrings; Exit; ///// EXIT ///// CreateFMasterUpdatePrice.Execute(fmUpdateCompons, Self); Exit; ///// EXIT ///// ShowMessage(IntToStr(RoundUp( StrToFloat_My(InputBox('', '', '2,5')) ))); Exit; ///// EXIT ///// //BrowseDialog('Создание папки для Excel отчетов...'); //Dir := ExtractSaveDir; //if SelectDirectory(Dir, [sdAllowCreate, sdPerformCreate, sdPrompt], 1000) then // ShowMessage(Dir); //Exit; ///// EXIT ///// BrowseNewDirName(cResourceReport_Msg26, ExtractSaveDir, FileNameCorrect(cResourceReport_Msg26+' '+DateTimeToStr(Now))); { BeginProgress; while true do begin Application.ProcessMessages; KeyState := GetKeyState(VK_LBUTTON); if (KeyState and 128) <> 0 then Break; //// BREAK //// end; EndProgress;} Exit; ///// EXIT ///////27.08.2007 EmptyProcedure; for i := 0 to 100000-1 do begin SCSComponent := TSCSComponent.Create(Self); //SCSCatalog := TSCSCatalog.Create(Self); //GetMem(ptrProperty, SizeOf(TProperty)); //SCSProp := TSCSProperty.Create(Self); //GetMem(ptrComponentType, SizeOf(TComponentType)); //SCSComponentType := TSCSComponentType.Create(Self); //New(ptrComponentTypeTmp); end; EmptyProcedure; if true or true and false then Beep; Exit; ///// EXIT ///// CheckProtectionBase(true); Exit; ///// EXIT ///// ShowMessage(GetMACAddrFromIP(GetIPAddressFromName(InputBox('', '', '192.168.1.20')))); Exit; ///// EXIT ///// OldTick := GetTickCount; DefineIndividualComplectsByEmptyIDTopCompon(DM.Query_Select, DM.Query_Operat); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Exit; if CheckExistsTableInBase(DM.Query_Select, InputBox('', 'Input table name', '')) then ShowMessage('true') else ShowMessage('false'); Exit; Act_PackBase.Execute; Exit; ///// EXIT ///// GetNoExistsFileNameForCopy(Application.ExeName); //ShowMessage(GetTopNodeByNBMode(nbmUser, itDir).Text); Exit; ///// EXIT ///// DM.CreateDefCurrenciesForObjectsByLevel; Exit; ///// EXIT ///// GetZeroMem(ptrSuppliesKind, SizeOf(TSuppliesKind)); ptrSuppliesKind.Izm := 'шт'; ptrSuppliesKind.UnitKolvo := 777; ptrSuppliesKind.Name := CPacking+' ' +FloatToStr(RoundCP(ptrSuppliesKind.UnitKolvo))+' '+ptrSuppliesKind.Izm; DM.SaveSuppliesKind(meMake, ptrSuppliesKind); Exit; ///// EXIT ///// ShowMessage(GetStringByTemplate(InputBox('#-#######-#', '', '012345-6'), '#-#######-#')); Exit; if MessageModal('Сбросить количество занятых позиций в свободных интерфейсах ?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ClearInterfCount := 0; for i := 0 to GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin SCSComponent := GSCSBase.CurrProject.ComponentReferences[i]; for j := 0 to SCSComponent.Interfaces.Count - 1 do begin SCSInterf := SCSComponent.Interfaces[j]; if (SCSInterf.KolvoBusy <> 0) and (SCSInterf.BusyPositions.Count = 0) then begin SCSInterf.KolvoBusy := 0; Inc(ClearInterfCount); end; end; end; ShowMessage(cMain_Msg203+IntToStr(ClearInterfCount)+cMain_Msg204); end; Exit; ///// EXIT ///// //**** //GetNormsForCad(GSCSBase.CurrProject.CurrList.CurrID); Positions := TStringList.Create; Interf := TSCSInterface.Create(Self); Interf.Kolvo := 500; AddBusyPosition(2, 100); AddBusyPosition(151, 400); AddBusyPosition(451, 499); Positions.Add(DupStr('_', 15)); EmptyPositions := Interf.GetEmptyPositions; for i := 0 to EmptyPositions.Positions.Count - 1 do begin EmptyPosition := TSCSInterfPosition(EmptyPositions.Positions[i]); Positions.Add(IntToStr(EmptyPosition.FromPos) + ' - ' +IntToStr(EmptyPosition.ToPos)); end; Positions.Add(DupStr('_', 15)); Positions.Add(IntToStr(EmptyPositions.Kolvo)); ShowMessage(Positions.Text); FreeAndNil(EmptyPositions); FreeAndNil(Positions); FreeAndNil(Interf); //GetAnsiTempPath; {if GDBMode = bkProjectManager then begin SCSCatalog := nil; if Tree_catalog.Selected <> nil then if Tree_catalog.Selected.Data <> nil then if PObjectData(Tree_catalog.Selected.Data).ItemType = itSCSConnector then SCSCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(Tree_catalog.Selected.Data).ObjectID); if SCSCatalog <> nil then begin F_MakeEditCrossConnection.ShowPointObjectConfigurator(SCSCatalog); end; end;} end; procedure TF_MAIN.Act_SaveCurrListToFileExecute(Sender: TObject); var SaveDialog: TSaveDialog; Saved: Boolean; begin if GDBMode = bkProjectManager then if GSCSBase.CurrProject.Active and (GSCSBase.CurrProject.CurrList <> nil) then begin if CheckWriteProj(GSCSBase.CurrProject.CurrID, true) then begin SaveDialog := TSaveDialog.Create(Self); try SaveDialog.Title := cMain_Msg109; SaveDialog.InitialDir := ExtractSaveDir; SaveDialog.DefaultExt := '*.'+enList; SaveDialog.FileName := FileNameCorrect(GSCSBase.CurrProject.CurrList.GetNameForVisible); SaveDialog.Filter := GetDialogFilter(exdList, enList); //ExtName+' ('+FullExtName+')|'+FullExtName; SaveDialog.Options := SaveDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if SaveDialog.Execute then begin BeginProgress(cMain_Msg110+'...'); try Saved := GSCSBase.CurrProject.CurrList.SaveToStreamOrFile(nil, SaveDialog.FileName); finally EndProgress; end; if Not Saved then AddExceptionToLog(cSCSComponent_Msg22_5, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_5); end; finally SaveDialog.Free; end; end; end else ShowMessageByType(0, smtDisplay, cMain_Msg111, Application.Title, MB_OK or MB_ICONINFORMATION); end; procedure TF_MAIN.Act_LoadListFromFileExecute(Sender: TObject); var OpenDialog: TOpenDialog; NewList: TSCSList; begin if GDBMode = bkProjectManager then if GSCSBase.CurrProject.Active then begin OpenDialog := TOpenDialog.Create(Self); try OpenDialog.Title := cMain_Msg112; OpenDialog.InitialDir := ExtractSaveDir; OpenDialog.DefaultExt := '*.'+enList; //OpenDialog.FileName := FileNameCorrect(GSCSBase.CurrProject.CurrList.GetNameForVisible); OpenDialog.Filter := GetDialogFilter(exdList, enList); //ExtName+' ('+FullExtName+')|'+FullExtName; OpenDialog.Options := OpenDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if OpenDialog.Execute then begin BeginProgress; try NewList := GSCSBase.CurrProject.AddListFromFile(OpenDialog.FileName); if NewList <> nil then ChangeCurrList(GIDLastList, NewList.CurrID); finally EndProgress; end; end; finally OpenDialog.Free; end; end else ShowMessageByType(0, smtDisplay, cMain_Msg113, Application.Title, MB_OK or MB_ICONINFORMATION); end; procedure TF_MAIN.Act_PairLineInterfacesExecute(Sender: TObject); var Dat: PObjectData; ComponIDs: TIntList; SCSComponent: TSCSComponent; InterfI: TSCSInterface; InterfJ: TSCSInterface; i, j, k: Integer; begin Dat := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; ComponIDs := nil; BeginProgress; try ComponIDs := GetComponIDsWithNoPairInterfaces(Dat.ObjectID, Dat.ItemType); finally EndProgress; end; if ComponIDs.Count > 0 then begin ShowComponentsInListByIDList(ComponIDs, cMain_Msg114, ''); if MessageModal(cMain_Msg115, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin BeginProgress; try SCSComponent := TSCSComponent.Create(Self); for i := 0 to ComponIDs.Count - 1 do begin SCSComponent.LoadComponentByID(ComponIDs[i], false); if SCSComponent.IsLine = biTrue then begin SCSComponent.LoadInterfaces; for j := 0 to SCSComponent.Interfaces.Count - 1 do begin InterfI := SCSComponent.Interfaces[j]; if (InterfI.TypeI = itFunctional) and (InterfI.IDAdverse = 0) then for k := j+1 to SCSComponent.Interfaces.Count - 1 do begin InterfJ := SCSComponent.Interfaces[k]; if (InterfJ.TypeI = itFunctional) and (InterfJ.IDAdverse = 0) then if (InterfI.NumPair = InterfJ.NumPair) or ((InterfI.NumPair = 0) and (InterfJ.NumPair = 0)) then //if (((InterfI.Side <> InterfJ.Side) and (InterfI.Side > 0)) or // ((InterfI.Side = 0) and (InterfJ.Side = 0))) then begin InterfI.IDAdverse := InterfJ.ID; InterfJ.IDAdverse := InterfI.ID; DM.UpdateInterfFieldAsInteger(InterfI.ID, InterfI.IDAdverse, fnIDAdverse); DM.UpdateInterfFieldAsInteger(InterfJ.ID, InterfJ.IDAdverse, fnIDAdverse); if ((InterfI.Side = 0) and (InterfJ.Side = 0)) or (InterfI.Side = InterfJ.Side) then begin InterfI.Side := 1; InterfJ.Side := 2; DM.UpdateInterfFieldAsInteger(InterfI.ID, InterfI.Side, fnSide); DM.UpdateInterfFieldAsInteger(InterfJ.ID, InterfJ.Side, fnSide); end; if (InterfI.NumPair = 0) and (InterfJ.NumPair = 0) then begin InterfI.NumPair := GetComponLastNumPair(SCSComponent) + 1; InterfJ.NumPair := InterfI.NumPair; DM.UpdateInterfFieldAsInteger(InterfI.ID, InterfI.NumPair, fnNumPair); DM.UpdateInterfFieldAsInteger(InterfJ.ID, InterfJ.NumPair, fnNumPair); end; end; end; end; end; end; FreeAndNil(SCSComponent); finally EndProgress; end; RefreshNode; end; end else MessageModal(cMain_Msg116, ApplicationName, MB_ICONINFORMATION or MB_OK); ComponIDs.Free; end; procedure TF_MAIN.Act_MakeEmptyNBExecute(Sender: TObject); var Base: TBase; NBEmptyPath: String; UpdateInfo: TUpdateInfo; UpdateInfoItem: TUpdateInfoitem; i: Integer; begin if MessageModal(cMain_Msg117, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin NBEmptyPath := GetPathToNBEmpty; BeginProgress; try GSCSBase.SimpleClose(false); try Base := TBase.Create(DM.ConnectParams); try Base.Open(GSCSBase.DBName); Base.MakeEmptyCopy(NBEmptyPath); {UpdateInfo := Base.GetUpdateInfo; if UpdateInfo <> nil then begin for i := 0 to UpdateInfo.Count - 1 do begin UpdateInfoItem := UpdateInfo[i]; try DelFieldFromTable(UpdateInfoItem.TableName, fnActRowLimit, Base.QOperat); except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_MakeEmptyNBExecute), E.Message); end; end; FreeAndNil(UpdateInfo); end;} Base.Open(NBEmptyPath); // Добавляем поле fnActRowLimit UpdateInfo := Base.GetUpdateInfo; if UpdateInfo <> nil then begin for i := 0 to UpdateInfo.Count - 1 do begin UpdateInfoItem := UpdateInfo[i]; try AddFieldToTable(UpdateInfoItem.TableName, fnActRowLimit, ftSmallint, 0, Base.QOperat); UpdateTableFieldAllRec(Base.QOperat, UpdateInfoItem.TableName, fnActRowLimit, alrNone); except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_MakeEmptyNBExecute), E.Message); end; end; FreeAndNil(UpdateInfo); end; //WriteUpdatePath(dnAdmin+'\'+fnNBEmty, ExtractFilePath(NBEmptyPath)); finally Base.Free; end; finally GSCSBase.SimpleOpen(false); end; finally EndProgress; end; end; end; procedure TF_MAIN.pmiCreateNBUpdateClick(Sender: TObject); var Base: TBase; NBEmptyPath: String; NBUpdatePath: String; FieldList: TStringList; FieldsToUpdate: TStringList; Stream: TMemoryStream; FMakeUpdateBlock: TF_MakeUpdateBlock; begin try FMakeUpdateBlock := TF_MakeUpdateBlock.Create(Self, Self); FMakeUpdateBlock.Execute; FMakeUpdateBlock.Free; { if MessageModal(cMain_Msg117_2, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin NBEmptyPath := GetPathToNBEmpty; NBUpdatePath := ExtractFileDir(Application.ExeName)+'\upd'+ RemoveSymbolFromStr(VersionEXE, '.')+'.'+enUpd; if FileExists(NBUpdatePath) then if Not DeleteFile(NBUpdatePath) then raise Exception.Create('Can''t delete old update file '+NBUpdatePath); if Not FileExists(NBUpdatePath) then begin BeginProgress; try CopyBase(NBEmptyPath, NBUpdatePath, false); Base := TBase.Create(DM.ConnectParams); try Base.Open(NBUpdatePath); // расширяем таблицу с инфой для обновления if Not CheckFieldInTable(tnUpdateInfo, fnActLimit, Base.QSelect) then begin AddFieldToTable(tnUpdateInfo, fnActLimit, ftSmallint, 0, Base.QOperat); SetSQLToFIBQuery(Base.QOperat, GetSQLByParams(qtUpdate, tnUpdateInfo, '', nil, fnActLimit), false); Base.QOperat.ParamByName(fnActLimit).AsInteger := alNone; Base.QOperat.ExecQuery; end; if Not CheckFieldInTable(tnUpdateInfo, fnFieldsToUpdate, Base.QSelect) then AddFieldToTable(tnUpdateInfo, fnFieldsToUpdate, ftBlob, 0, Base.QOperat); // Вносим инфу для обновления УГО FieldList := TStringList.Create; FieldList.Add(fnActLimit); FieldList.Add(fnFieldsToUpdate); SetSQLToFIBQuery(Base.QOperat, GetSQLByParams(qtUpdate, tnUpdateInfo, fnTableName +' = :'+fnTableName, FieldList, ''), false); Base.QOperat.ParamByName(fnTableName).AsString := tnObjectIcons; Base.QOperat.ParamByName(fnActLimit).AsInteger := alUpdate; // Указываем поля, которые нужно обновить FieldsToUpdate := TStringList.Create; FieldsToUpdate.Add(fnProjBlk); FieldsToUpdate.Add(fnActiveBlk); Stream := TMemoryStream.Create; FieldsToUpdate.SaveToStream(Stream); Stream.Position := 0; Base.QOperat.ParamByName(fnFieldsToUpdate).LoadFromStream(Stream); FreeAndNil(Stream); FreeAndNil(FieldsToUpdate); Base.QOperat.ExecQuery; // Удалить поля в таблице tnObjectIcons, данные из которых браться не будут DelFieldFromTable(tnObjectIcons, fnName, Base.QOperat); DelFieldFromTable(tnObjectIcons, fnProjBmp, Base.QOperat); DelFieldFromTable(tnObjectIcons, fnActiveBmp, Base.QOperat); // Перекидываем УГО FieldList.Clear; FieldList.Add(fnID); FieldList.Add(fnGUID); FieldList.Add(fnProjBlk); FieldList.Add(fnActiveBlk); SetSQLToFIBQuery(Base.QOperat, GetSQLByParams(qtInsert, tnObjectIcons, '', FieldList, ''), false); SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnObjectIcons, '', nil, fnAll), true); while Not DM.Query_Select.Eof do begin Base.QOperat.Close; Base.QOperat.ParamByName(fnID).AsInteger := DM.Query_Select.FN(fnID).AsInteger; Base.QOperat.ParamByName(fnGuid).AsString := DM.Query_Select.FN(fnGuid).AsString; CopyBlobFromFNToParamInQuery(Base.QOperat, DM.Query_Select, fnProjBlk, fnProjBlk); CopyBlobFromFNToParamInQuery(Base.QOperat, DM.Query_Select, fnActiveBlk, fnActiveBlk); Base.QOperat.ExecQuery; DM.Query_Select.Next; end; FreeAndNil(FieldList); finally Base.Free; end; finally EndProgress; end; WriteUpdatePath(dnAdmin+'\'+fnNBEmty, ExtractFilePath(NBEmptyPath)); end; end; } except on E: Exception do AddExceptionToLogEx('TF_MAIN.pmiCreateNBUpdateClick', E.Message); end; end; procedure TF_MAIN.Act_ChangeComponArtProducerByTemplateExecute( Sender: TObject); var Dat: PObjectData; ComponIDs: TIntList; Template: String; OldValue, NewValue: String; FieldName: String; i: Integer; begin Dat := nil; if Tree_Catalog.Selected <> nil then Dat := Tree_Catalog.Selected.Data; if (Dat = nil) or (Not IsComponItemType(PObjectData(Dat).ItemType) and Not IsCatalogItemType(PObjectData(Dat).ItemType)) then Exit; ///// EXIT ///// ComponIDs := nil; //Template := InputBox(TAction(Sender).Caption, cMain_Msg118, '#-#######-#'); Template := InputForm(Self, TAction(Sender).Caption, cMain_Msg118, '#-#######-#', dtString); if Template <> '' then begin if IsCatalogItemType(PObjectData(Dat).ItemType) then ComponIDs := DM.GetCatalogAllComponIDs(Dat.ObjectID, true) else if IsComponItemType(PObjectData(Dat).ItemType) then begin ComponIDs := TIntList.Create; ComponIDs.Add(Dat.ObjectID); end; ApplyComponFilterToListIDs(ComponIDs); BeginProgress('', ComponIDs.Count); try FieldName := fnArticulProducer; //*** SQL для получения артикульного номера SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, nil, FieldName), false); //*** SQL для изменения артикульного номера SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnComponent, fnID+' = :'+fnID, nil, FieldName), false); GLog.Add(TimeToStr(Time)+ ' '+cMain_Msg119_1); for i := 0 to ComponIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := ComponIDs[i]; DM.Query_Select.ExecQuery; OldValue := DM.Query_Select.Fields[0].AsString; NewValue := GetStringByTemplate(OldValue, Template); DM.Query_Operat.Close; DM.Query_Operat.ParamByName(fnID).AsInteger := ComponIDs[i]; DM.Query_Operat.ParamByName(FieldName).AsString := NewValue; DM.Query_Operat.ExecQuery; GLog.Add(TimeToStr(Time)+' (ID '+IntToStr(ComponIDs[i])+') '+ OldValue+ ' -> '+NewValue); StepProgress; end; GLog.Add(TimeToStr(Time)+ ' '+cMain_Msg119_2); finally EndProgress; FreeAndNil(ComponIDs); end; RefreshNode; F_AnswerToQuast.ShowContextHelp(cMain_Msg120, GLog.Text); end; end; procedure TF_MAIN.Act_DefineDirTypeItemContentCountsExecute( Sender: TObject); begin DefineDirTypeChildContentCount(DM.Query_Select, DM.Query_Operat); end; procedure TF_MAIN.Act_DelSameComponInListExecute(Sender: TObject); var GuidNB: String; ComponentList: TSCSComponents; SCSComponent: TSCSComponent; CanDelCablesFromOtherList: Integer; i: Integer; begin GuidNB := ''; if GSCSBase.SCSComponent.ID > 0 then GuidNB := GSCSBase.SCSComponent.GuidNB; if GuidNB <> '' then if MessageModal(cMain_Msg121, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ComponentList := TSCSComponents.Create(false); //*** Отобрать все однотипные компоненты for i := 0 to GSCSBase.CurrProject.CurrList.ComponentReferences.Count - 1 do begin SCSComponent := GSCSBase.CurrProject.CurrList.ComponentReferences[i]; if SCSComponent.GuidNB = GuidNB then begin ComponentList.Add(SCSComponent); SCSComponent.ServToDelete := true; end; end; DelComponentsFromList(GSCSBase.CurrProject.CurrList, ComponentList, true); //BeginProgress('', ComponentList.Count); //try // CanDelCablesFromOtherList := biNone; // // //***Удалить компоненты из списка // while ComponentList.Count > 0 do // begin // SCSComponent := ComponentList[0]; // DM.DelComponent(SCSComponent.ID, SCSComponent, dmTrace, @CanDelCablesFromOtherList, ComponentList, true); // //ComponentList.Delete(0); // end; //finally // EndProgress; //end; FreeAndNil(ComponentList); end; end; procedure TF_MAIN.Act_MakeObjectCurrencyExecute(Sender: TObject); begin MakeEditObjectCurrency(meMake, GSCSBase.SCSCatalog.ID); EnableEditDel(itAuto); end; procedure TF_MAIN.Act_EditObjectCurrencyExecute(Sender: TObject); begin MakeEditObjectCurrency(meEdit, GSCSBase.SCSCatalog.ID); end; procedure TF_MAIN.Act_DelObjectCurrencyExecute(Sender: TObject); var ptrObjectCurrency: PObjectCurrencyRel; begin ptrObjectCurrency := DM.GetObjectCurrencyFromMemTable(DM.mtObjectCurrency); if ptrObjectCurrency <> nil then begin if ptrObjectCurrency.Data.Main <> ctSimple then begin MessageModal(cMain_Msg125, ApplicationName, MB_ICONINFORMATION or MB_OK); end else begin if MessageModal(cMain_Msg126, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin DM.DeleteRecordFromTableByID(tnObjectCurrencyRel, ptrObjectCurrency.ID, qmPhisical); DM.mtObjectCurrency.Delete; EnableEditDel(itAuto); end; end; FreeAndNil(ptrObjectCurrency); end; end; procedure TF_MAIN.GT_ObjectCurrencyMainGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := cMain_Msg33 else if AText = '1' then AText := cMain_Msg122 else if AText = '2' then AText := cMain_Msg123; end; procedure TF_MAIN.GT_ObjectCurrencyDblClick(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- Act_EditObjectCurrency.Execute; end; procedure TF_MAIN.Act_ShowComponTypeInDirectoryExecute(Sender: TObject); begin if GDBMode = bkNormBase then begin FNormBase.F_CaseForm.GIDToLocate := GSCSBase.SCSComponent.ID_ComponentType; FNormBase.F_CaseForm.GGUIDToLocate := GSCSBase.SCSComponent.GUIDComponentType; FNormBase.F_CaseForm.Execute(vkComponentType, fmView); end else if GDBMode = bkProjectManager then begin ShowCurrListProperties(vkComponentType, GSCSBase.SCSComponent.GUIDComponentType); end; end; procedure TF_MAIN.Act_ShowComponTypeInProjectDirectoryExecute( Sender: TObject); begin if GDBMode = bkProjectManager then begin ShowCurrProjectProperties(vkComponentType, GSCSBase.SCSComponent.GUIDComponentType); end; end; procedure TF_MAIN.Act_ShowComponNetTypeInDirectoryExecute(Sender: TObject); begin FNormBase.F_CaseForm.GIDToLocate := GSCSBase.SCSComponent.IDNetType; FNormBase.F_CaseForm.GGUIDToLocate := GSCSBase.SCSComponent.GUIDNetType; FNormBase.F_CaseForm.Execute(vkNetType, fmView); end; procedure TF_MAIN.Act_ShowComponProducerInDirectoryExecute( Sender: TObject); begin FNormBase.F_CaseForm.GIDToLocate := GSCSBase.SCSComponent.ID_Producer; FNormBase.F_CaseForm.GGUIDToLocate := GSCSBase.SCSComponent.GUIDProducer; FNormBase.F_CaseForm.Execute(vkProducers, fmView); end; procedure TF_MAIN.Act_ShowComponSupplKindInDirectoryExecute( Sender: TObject); begin FNormBase.F_CaseForm.GIDToLocate := GSCSBase.SCSComponent.IDSuppliesKind; FNormBase.F_CaseForm.GGUIDToLocate := GSCSBase.SCSComponent.GUIDSuppliesKind; FNormBase.F_CaseForm.Execute(VKSuppliesKind, fmView); end; procedure TF_MAIN.pmnuComponDirectoryDataClick(Sender: TObject); begin if GDBMode = bkNormBase then begin Act_ShowComponTypeInProjectDirectory.Visible := false; Act_ShowComponTypeInDirectory.Enabled := GSCSBase.SCSComponent.ID_ComponentType > 0; Act_ShowComponNetTypeInDirectory.Enabled := GSCSBase.SCSComponent.IDNetType > 0; Act_ShowComponProducerInDirectory.Enabled := GSCSBase.SCSComponent.ID_Producer > 0; Act_ShowComponSupplKindInDirectory.Enabled := GSCSBase.SCSComponent.IDSuppliesKind > 0; end else if GDBMode = bkProjectManager then begin Act_ShowComponSupplKindInDirectory.Visible := false; Act_ShowComponTypeInDirectory.Caption := cMain_Msg129; Act_ShowComponTypeInDirectory.Enabled := GSCSBase.SCSComponent.GUIDComponentType <> ''; Act_ShowComponTypeInProjectDirectory.Enabled := Act_ShowComponTypeInDirectory.Enabled; Act_ShowComponNetTypeInDirectory.Enabled := GSCSBase.SCSComponent.GUIDNetType <> ''; Act_ShowComponProducerInDirectory.Enabled := GSCSBase.SCSComponent.GUIDProducer <> ''; end; end; procedure TF_MAIN.Act_DelAllTracesFromListExecute(Sender: TObject); var AllTraces: TSCSCatalogs; SCSCatalog: TSCSCatalog; SCSListIDs: TintList; i: integer; begin if MessageModal(cMain_Msg143, ApplicationName, MB_YESNO or MB_ICONINFORMATION) = IDYES then begin BeginProgress; try if GSCSBase.CurrProject.CurrList <> nil then if Not GSCSBase.CurrProject.CurrList.OpenedInCAD then OpenNoExistsListInCAD(GSCSBase.CurrProject.CurrList); // UNDO AllTraces := TSCSCatalogs.Create(false); for i := 0 to GSCSBase.CurrProject.CurrList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := GSCSBase.CurrProject.CurrList.ChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSLine then AllTraces.Add(SCSCatalog); end; SCSListIDs := GetVariousListsIDsByObjects(AllTraces, true); SaveListsToUndoStack(SCSListIDs); FreeAndNil(SCSListIDs); FreeAndNil(AllTraces); finally EndProgress; end; DeleteAllTraces; end; end; procedure TF_MAIN.Act_ReindexComponentByTypeExecute(Sender: TObject); var Proj: TSCSProject; SprComponentType: TNBComponentType; GUIDComponTypeList: TStringList; CatalogsToDefineParams: TSCSCatalogs; begin if (GDBMode = bkProjectManager) and (GSCSBase.SCSComponent.GUIDComponentType <> '') then if MessageModal(cMain_Msg130, ApplicationName, MB_YESNO or MB_ICONQUESTION) = IDYES then begin //01.02.2011 // BeginProgress; // try // Proj := GSCSBase.CurrProject; // SprComponentType := Proj.Spravochnik.GetComponentTypeByGUID(GSCSBase.SCSComponent.GUIDComponentType); // if SprComponentType <> nil then // begin // SaveCurrProjectToUndoStack; // // GUIDComponTypeList := TStringList.Create; // CatalogsToDefineParams := TSCSCatalogs.Create(false); // // GUIDComponTypeList.Add(SprComponentType.ComponentType.GUID); // SprComponentType.ComponentType.ComponentIndex := 0; // Proj.ReindexComponentsByTypes(GUIDComponTypeList, CatalogsToDefineParams{, Proj.Setting.ReindexOrderType}); // F_ChoiceConnectSide.DefineObjectsParamsAfterChangeComponMark(CatalogsToDefineParams); // // FreeAndNil(CatalogsToDefineParams); // FreeAndNil(GUIDComponTypeList); // end; // finally // EndProgress; // end; ReindexComponsByType(GSCSBase.CurrProject, GSCSBase.SCSComponent.GUIDComponentType, 0, false); end; end; procedure TF_MAIN.Act_ReindexComponentByTypeInListExecute(Sender: TObject); var StartNumVar: Integer; modalres: integer; //Tolik ProjSettingChanged: Boolean; begin //Tolik ProjSettingChanged := False; if (GDBMode = bkProjectManager) and (GSCSBase.SCSComponent.GUIDComponentType <> '') then begin StartNumVar := InputForm(Self, cMain_Msg183_1, cMain_Msg183_2, '1', dtInteger); if (StartNumVar <> null) and (StartNumVar > 0) then begin modalres := MessageModal(cMain_Msg130_1, ApplicationName, MB_YESNOCANCEL or MB_ICONQUESTION); if modalres = IDYES then //Tolik это "костыль", его не трогать без надобности, нужен для выполнения индексации компонент по проекту/листу // из контекстного меню ПМ, иначе не сработает, если в настройках будет выставлено индексировать по листу // ReindexComponsByType(GSCSBase.CurrProject.CurrList, GSCSBase.SCSComponent.GUIDComponentType, StartNumVar-1, true, true) begin if F_ProjMan.GSCSBase.CurrProject.Setting.PointComonIndexingMode = cimInList then begin F_ProjMan.GSCSBase.CurrProject.Setting.PointComonIndexingMode := cimInProject; ProjSettingChanged := True; end; ReindexComponsByType(GSCSBase.CurrProject.CurrList, GSCSBase.SCSComponent.GUIDComponentType, StartNumVar-1, true, true); if ProjSettingChanged then begin F_ProjMan.GSCSBase.CurrProject.Setting.PointComonIndexingMode := cimInProject; ProjSettingChanged := False; end; end // else if modalres = IDNo then ReindexComponsByType(GSCSBase.CurrProject.CurrList, GSCSBase.SCSComponent.GUIDComponentType, StartNumVar-1, true, false); end; end; end; procedure TF_MAIN.Act_OpenBeatenProjectExecute(Sender: TObject); begin if GSCSBase.CurrProject.Active then if GSCSBase.CurrProject.CanOpenFromBeatenBlock then GSCSBase.CurrProject.Open(GSCSBase.CurrProject.CurrID, opmBeatens); end; procedure TF_MAIN.tcGridDataClick(Sender: TObject); begin // end; procedure TF_MAIN.Act_DefineNewPropsFromDefaultExecute(Sender: TObject); var i, j: Integer; FCatalog: TSCSCatalog; Node: TTreeNode; SCSCatalog: TSCSCatalog; NBProperty: TNBProperty; PropValue: String; TraceLength: Double; begin if GDBMode = bkProjectManager then begin FCatalog := nil; Node := Tree_Catalog.Selected; if Node <> nil then case PObjectData(Node.Data).ItemType of itList: FCatalog := GSCSBase.CurrProject.CurrList; itProject: FCatalog := GSCSBase.CurrProject; end; if FCatalog <> nil then begin BeginProgress; try for i := 0 to GSCSBase.CurrProject.ChildCatalogReferences.Count - 1 do begin SCSCatalog := GSCSBase.CurrProject.ChildCatalogReferences[i]; for j := 0 to F_NormBase.GSCSBase.NBSpravochnik.Properties.Count - 1 do begin NBProperty := TNBProperty(F_NormBase.GSCSBase.NBSpravochnik.Properties[j]); if SCSCatalog.GetPropertyBySysName(NBProperty.PropertyData.SysName) = nil then if ((SCSCatalog.ItemType = itSCSLine) and (NBProperty.PropertyData.ISSCSLine = biTrue)) or ((SCSCatalog.ItemType = itSCSConnector) and (NBProperty.PropertyData.ISSCSConnector = biTrue)) then begin PropValue := NBProperty.PropertyData.DefValue; SCSCatalog.AddProperty(NBProperty.PropertyData.ID, NBProperty.PropertyData.GUID, NBProperty.PropertyData.IDDataType, biTrue, PropValue, NBProperty.PropertyData.Name, NBProperty.PropertyData.SysName); if SCSCatalog.ItemType = itSCSLine then begin TraceLength := GetTraceLength(SCSCatalog.ListID, SCSCatalog.SCSID); ChangeLineObjectLength(SCSCatalog, TraceLength); end; end; end; end; finally EndProgress; end; end; end; end; procedure TF_MAIN.Act_AllComponsNormsExecute(Sender: TObject); var CatalogExtended: TSCSCatalogExtended; begin CatalogExtended := GetCatalogExtendedFromCurrNode; if CatalogExtended <> nil then CreateFInterfaceInfo.Execute(iimNormComponents, CatalogExtended); end; procedure TF_MAIN.Act_MasterDefectActExecute(Sender: TObject); var CatalogExtended: TSCSCatalogExtended; F_MasterDefectAct: TF_MasterDefectAct; begin CatalogExtended := GetCatalogExtendedFromCurrNode; if CatalogExtended <> nil then begin F_MasterDefectAct := TF_MasterDefectAct.Create(Self, Self); F_MasterDefectAct.Execute(fmView, CatalogExtended, false, FUOM); FreeAndNil(F_MasterDefectAct); end; end; procedure TF_MAIN.Act_FindComponInNBFromComponDataExecute( Sender: TObject); var GUIDComponent: String; SprComponent: TSCSComponent; Finded: Boolean; StrMessg: String; begin GUIDComponent := ''; Finded := false; StrMessg := ''; if Grid_CompData.ActiveLevel.Index = cdliCableChannelElements then begin StrMessg := cMain_Msg133; if DM.mtCableCanalConnectors.Active and (DM.mtCableCanalConnectors.RecordCount > 0) then GUIDComponent := DM.mtCableCanalConnectors.FieldByName(fnGuidNBConnector).AsString; end else if Grid_CompData.ActiveLevel.Index = cdliNormsResources then begin StrMessg := cMain_Msg167; if DM.mtNorms.Active then if DM.mtNorms.RecordCount > 0 then GUIDComponent := DM.mtNorms.FieldByName(fnGuidNBComponent).AsString; end; if GUIDComponent <> '' then begin //*** если не удалось найти в нормативке элемент каб канала {if FNormBase.FindComponentByGUIDWithBlink(GUIDComponent) = nil then begin //*** Если активный менеджер проектов, то предложить экспортировать его в НБ if GDBMode = bkProjectManager then if CheckWriteNB(false) then begin SprComponent := GSCSBase.CurrProject.GetSprComponentByGUID(GUIDComponent); if SprComponent <> nil then begin Finded := true; if MessageModal(StrMessg, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin if GSCSBase.CurrProject.DefineNBDir then if CopyComponentFromPMToNB(Self, FNormBase, SprComponent, GSCSBase.CurrProject.NBDirID) <> 0 then FNormBase.FindComponentByGUIDWithBlink(GUIDComponent); end; end; end; end else Finded := true;} if CheckExistsSpravComponInNBWithCopy(Self, GUIDComponent, StrMessg) then begin FNormBase.FindComponentByGUIDWithBlink(GUIDComponent); Finded := true; end; //if Not Finded then // MessageModal(cMain_Msg108, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; procedure TF_MAIN.Act_ComponFilterExecute(Sender: TObject); var F_FilterConfigurator: TF_FilterConfigurator; FilterValues: TObjectList; OldFilterParams: TFilterParams; begin F_FilterConfigurator := TF_FilterConfigurator.Create(Self, Self); FilterValues := DM.GetFilterValuesBySprElements([vkComponentType, vkProducers, vkNetType]); F_FilterConfigurator.Caption := cFilterConfigurator1; F_FilterConfigurator.ColumnCaptionConditionType := cFilterConfigurator2_1; F_FilterConfigurator.ColumnCaptionFieldName := cFilterConfigurator2_2; F_FilterConfigurator.ColumnCaptionCompareType := cFilterConfigurator2_3; F_FilterConfigurator.ColumnCaptionValue := cFilterConfigurator2_4; F_FilterConfigurator.OpenSaveDialogFilter := GetDialogFilter(exdComponFilter, enCfr); F_FilterConfigurator.OpenDialog.InitialDir := ExtractDirByCategoryType(dctFilters); //14.04.2009 ExtractSaveDirForCategory(sdFilters); //07.04.2009 ExtractFileDir(ParamStr(0)); F_FilterConfigurator.OpenDialog.Title := exdComponFilter; F_FilterConfigurator.OpenDialog.DefaultExt := '*.'+enCfr; F_FilterConfigurator.SaveDialog.InitialDir := ExtractDirByCategoryType(dctFilters); //14.04.2009 ExtractSaveDirForCategory(sdFilters); //07.04.2009 ExtractFileDir(ParamStr(0)); F_FilterConfigurator.SaveDialog.Title := exdComponFilter; F_FilterConfigurator.SaveDialog.DefaultExt := '*.'+enCfr; if F_FilterConfigurator.Execute(FilterValues, FFilterParams.FFilterBlock, ftComponent) then begin OldFilterParams := TFilterParams.Create(GDBMode); OldFilterParams.Assign(FFilterParams); OldFilterParams.FFilterBlock := FFilterParams.FFilterBlock; FFilterParams.FFilterBlock := F_FilterConfigurator.GetMainFilterBlock; FFilterParams.DefineIsUseFilterField; DM.DefineIsOnFilterBlocks(FFilterParams, false); ApplyComponentFilter(OldFilterParams, FFilterParams, false); SaveComponFilter; if OldFilterParams <> nil then FreeAndNil(OldFilterParams); if cbFindComponsAfterFilterConfigurator.Checked then Act_FindComponsByFilter.Execute; {OldFilterBlock := FFilterParams.FFilterBlock; FFilterParams.FFilterBlock := F_FilterConfigurator.GetMainFilterBlock; FFilterParams.DefineIsUseFilterField; DM.DefineIsOnFilterBlocks(FFilterParams.FFilterBlock, false); ApplyComponentFilter(OldFilterBlock, FFilterParams.FFilterBlock, false); SaveComponFilter; if OldFilterBlock <> nil then FreeAndNil(OldFilterBlock); if cbFindComponsAfterFilterConfigurator.Checked then Act_FindComponsByFilter.Execute;} end; FreeAndNil(FilterValues); FreeAndNil(F_FilterConfigurator); end; procedure TF_MAIN.Act_FindComponsByFilterExecute(Sender: TObject); var FilteredComponsID: TIntList; FieldNames: TStringList; IDComponentType: Integer; IDProducer: Integer; IDNetType: Integer; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; ChildFilterBlock: TFilterBlock; i, j: Integer; SCSComponent: TSCSComponent; ComponsInfo: TStringList; LoadedComponsLists: Boolean; begin if FFilterParams.FFilterBlock <> nil then begin BeginProgress; try ClearListView(ListView_Find); ComponsInfo := TStringList.Create; DM.DefineIsOnFilterBlocks(FFilterParams, true); if GDBMode = bkNormBase then begin { FilteredComponsID := TIntList.Create; FieldNames := TStringList.Create; FieldNames.Add(fnID); FieldNames.Add(fnIDComponentType); FieldNames.Add(fnIDNetType); FieldNames.Add(fnIDProducer); SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, '', FieldNames, '')); while Not DM.Query_Select.Eof do begin IDComponentType := DM.Query_Select.Fields[1].AsInteger; IDNetType := DM.Query_Select.Fields[2].AsInteger; IDProducer := DM.Query_Select.Fields[3].AsInteger; for i := 0 to FFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := FFilterParams.FFilterBlock.AllChildBlocks[i]; if ChildFilterBlock.Condition <> nil then case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin SprComponentType := GSCSBase.NBSpravochnik.GetComponentTypeObjByID(IDComponentType); if SprComponentType <> nil then ChildFilterBlock.Condition.FieldValue := SprComponentType.ComponentType.GUID; end; fiGuidProducer: begin SprProducer := GSCSBase.NBSpravochnik.GetProducerByID(IDProducer); if SprProducer <> nil then ChildFilterBlock.Condition.FieldValue := SprProducer.GUID; end; fiGuidNetType: begin SprNetType := GSCSBase.NBSpravochnik.GetNetTypeByID(IDNetType); if SprNetType <> nil then ChildFilterBlock.Condition.FieldValue := SprNetType.GUID; end; end; end; if FFilterParams.FFilterBlock.Execute then FilteredComponsID.Add(DM.Query_Select.Fields[0].AsInteger); DM.Query_Select.Next; end; //*** Ели найдены ID if FilteredComponsID.Count > 0 then begin FieldNames.Clear; FieldNames.Add(fnIsLine); FieldNames.Add(fnName); SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' =:'+fnID, FieldNames, ''), false); for i := 0 to FilteredComponsID.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := FilteredComponsID[i]; DM.Query_Select.ExecQuery; if DM.Query_Select.RecordCount > 0 then AddComponInfoToStrings(FilteredComponsID[i], DM.Query_Select.Fields[0].AsInteger, DM.Query_Select.Fields[1].AsString, ComponsInfo); end; end; FreeAndNil(FieldNames); FreeAndNil(FilteredComponsID); } LoadedComponsLists := false; if DM.ComponIDs.Count = 0 then begin DM.LoadIDsToComponLists(FFilterParams); LoadedComponsLists := true; end; try //*** Если есть отфильтрованные компоненты if DM.ComponIDs.Count > 0 then begin FilteredComponsID := TIntList.Create; FieldNames := TStringList.Create; FieldNames.Clear; FieldNames.Add(fnIsLine); FieldNames.Add(fnName); SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' =:'+fnID, FieldNames, ''), false); for i := 0 to DM.ComponIDs.Count - 1 do begin DM.Query_Select.Close; DM.Query_Select.Params[0].AsInteger := DM.ComponIDs[i]; DM.Query_Select.ExecQuery; if DM.Query_Select.RecordCount > 0 then AddComponInfoToStrings(DM.ComponIDs[i], DM.Query_Select.Fields[0].AsInteger, DM.Query_Select.Fields[1].AsString, ComponsInfo); end; FreeAndNil(FieldNames); FreeAndNil(FilteredComponsID); end; finally if LoadedComponsLists then DM.ClearComponLists; end; end else if GDBMode = bkProjectManager then begin for i := 0 to GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin SCSComponent := GSCSBase.CurrProject.ComponentReferences[i]; for j := 0 to FFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := FFilterParams.FFilterBlock.AllChildBlocks[j]; if ChildFilterBlock.Condition <> nil then case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDComponentType; fiGuidProducer: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDProducer; fiGuidNetType: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDNetType; end; end; if FFilterParams.FFilterBlock.Execute then AddComponInfoToStrings(SCSComponent.ID, SCSComponent.IsLine, SCSComponent.GetNameForVisible, ComponsInfo); end; end; if ComponsInfo.Count > 0 then begin LoadItemsToListViewFromStringList(ComponsInfo); pcFind.ActivePage := tsFind; end; FreeAndNil(ComponsInfo); finally EndProgress; end; end; end; procedure TF_MAIN.cbUseFilterPropertiesChange(Sender: TObject); var OldFilterParams: TFilterParams; begin OldFilterParams := nil; OldFilterParams := TFilterParams.Create(GDBMode); if FFilterParams.FFilterBlock <> nil then OldFilterParams.FFilterBlock := TFilterBlock.Create(nil, FFilterParams.FFilterBlock.BlockType); OldFilterParams.Assign(FFilterParams); if GDBMode = bkProjectManager then FFilterParams.FFilterBlock.IsOn := cbUseFilter.Checked; FFilterParams.IsUseFilter := cbUseFilter.Checked; ApplyComponentFilter(OldFilterParams, FFilterParams, false); SaveComponFilter; FreeAndNil(OldFilterParams); {if FFilterParams.FFilterBlock <> nil then begin OldFilterBlock := TFilterBlock.Create(nil, FFilterParams.FFilterBlock.BlockType); OldFilterBlock.Assign(FFilterParams.FFilterBlock); if GDBMode = bkProjectManager then FFilterParams.FFilterBlock.IsOn := cbUseFilter.Checked; FFilterParams.IsUseFilter := cbUseFilter.Checked; ApplyComponentFilter(OldFilterBlock, FFilterParams.FFilterBlock, false); SaveComponFilter; FreeAndNil(OldFilterBlock); end; } end; procedure TF_MAIN.Act_AddComplectToComponentExecute(Sender: TObject); begin AddEditComplect(FNormBase, cmAdd, false, cntComplect); end; procedure TF_MAIN.lbFilterIsOnClick(Sender: TObject); begin pcFind.ActivePage := tsFilter; if Not Act_ChoiceFind.Checked then Act_ChoiceFind.Execute; if FFilterParams.FFilterType = fltCustom then begin cbFindComponsAfterFilterConfigurator.Checked := false; Act_ComponFilter.Execute; end; end; procedure TF_MAIN.pmnuCurrencyPreparerClick(Sender: TObject); begin {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} if F_CurrencyPreparer = nil then F_CurrencyPreparer := TF_CurrencyPreparer.Create(Self, TForm(Self)); {$IFEND} if F_CurrencyPreparer <> nil then F_CurrencyPreparer.Execute; end; procedure TF_MAIN.pmnuRecalcComponPricesClick(Sender: TObject); var ComponIDs: TIntList; i: integer; begin ComponIDs := TIntList.Create; SetSQlToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnComponent, '', nil, fnID)); IntFIBFieldToIntList(ComponIDs, DM.Query_Select, fnID); BeginProgress('', ComponIDs.Count); try for i := 0 to ComponIDs.Count - 1 do begin CalcPrice(ComponIDs[i]); StepProgress; end; finally EndProgress; end; FreeAndNil(ComponIDs); end; procedure TF_MAIN.Act_MakeNormExecute(Sender: TObject); begin SetFocusToControl(Grid_CompData); AddEditNorm(meMake); end; procedure TF_MAIN.Act_MakeResourceExecute(Sender: TObject); begin SetFocusToControl(Grid_CompData); AddEditResource(meMake, false); end; procedure TF_MAIN.Act_MakeResourceComponExecute(Sender: TObject); begin SetFocusToControl(Grid_CompData); AddEditResource(meMake, true); end; procedure TF_MAIN.Act_EditNormResourceExecute(Sender: TObject); var EditName: String; begin SetFocusToControl(Grid_CompData); case DM.mtNorms.FieldByName(fnIsResource).AsBoolean of true: AddEditResource(meEdit, false); false: begin EditName := DM.mtNorms.FieldByName(fnName).AsString; if GUseVisibleInterfaces and (DM.mtNorms.FieldByName(fnIsFromInterface).AsInteger = biTrue) then MessageModal(cImpossibleReplaceNorm+' "'+ EditName +'" '+cbMessage5, cReplacingNorm, MB_ICONINFORMATION or MB_OK) else AddEditNorm(meEdit); end; end; end; procedure TF_MAIN.Act_DelNormResourceExecute(Sender: TObject); var SCSComponent: TSCSComponent; DelName: String; IDDel: Integer; CurrNPP: Integer; CanDel: Boolean; SCSNormResourceObj: TSCSNormResBasicClass; StrMessg: String; // Tolik -- 23/06/2016 -- currNormInterfaceGuid: String; i: Integer; sprInterf: TNBInterFace; currNormGuid: String; // begin SetFocusToControl(Grid_CompData); try SCSComponent := GetActualSelectedComponent; if SCSComponent <> nil then begin CanDel := false; DelName := DM.mtNorms.FieldByName(fnName).AsString; case DM.mtNorms.FieldByName(fnIsResource).AsBoolean of true: begin StrMessg := ''; if DM.mtNorms.FieldByName(fnGuidNBComponent).AsString = '' then StrMessg := cQuastDelResource else StrMessg := cQuastDelAccessoryCompon; if MessageModal(StrMessg+' "'+ DelName +'"?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then CanDel := true; end; false: begin //*** Не дать юзеру удалять нормы пришедшие с интерфейсов if GUseVisibleInterfaces and (DM.mtNorms.FieldByName(fnIsFromInterface).AsInteger = biTrue) then //Tolik -- 23/06/2016 -- begin CanDel := False; if MessageModal(cAttentionDelInterfNorm + #13#10 + cQuastDelNorm + ' "' + DelName + '"?' , cDeletingNorm, MB_ICONQUESTION or MB_YESNO) = IDYES then CanDel := True; if CanDel then begin currNormInterfaceGuid := DM.mtNorms.FieldByName('GuidInterface').Value; currNormGuid := DM.mtNorms.FieldByName(fnGuidNB).Value; if ((currNormInterfaceGuid <> '') and (currNormGuid <> '')) then begin //currForm := TF_MAIN(GForm); //if currForm <> nil then if GDBMode = bkProjectManager then begin //if F_ProjMan.GSCSBase.SCSComponent.ID <> 0 then sprInterf := nil; sprInterf := F_ProjMan.GSCSBase.CurrProject.Spravochnik.GetInterfaceWithAssign(currNormInterfaceGuid, F_ProjMan.GSCSBase.NBSpravochnik, false, false); if sprInterf <> nil then begin for i := 0 to sprInterF.InterfaceNorms.Count - 1 do begin if TNBInterFaceNorm(sprInterf.InterfaceNorms[i]).GuidNBNorm = currNormGuid then begin TNBInterFaceNorm(sprInterf.InterfaceNorms[i]).Free; sprInterf.InterfaceNorms[i] := nil; end; end; sprInterF.InterfaceNorms.Pack; end; end; end; end; end // MessageModal(cImpossibleDelNorm+' "'+ DelName +'" '+cbMessage5, ApplicationName, MB_ICONINFORMATION or MB_OK) // else if MessageModal(cQuastDelNorm+' "'+ DelName +'"?', cDeletingNorm, MB_ICONQUESTION or MB_YESNO) = IDYES then CanDel := true; end; end; if CanDel then begin IDDel := DM.mtNorms.FieldByName(fnID).AsInteger; SCSNormResourceObj := TSCSNormResBasicClass(DM.mtNorms.FieldByName(fnObjectAddress).AsInteger); case DM.mtNorms.FieldByName(fnIsResource).AsBoolean of true: begin DM.DelResourceRelByID(IDDel); SCSComponent.NormsResources.Resources.Remove(TSCSResourceRel(SCSNormResourceObj)); end; false: begin DM.DelNormByID(IDDel); SCSComponent.NormsResources.Norms.Remove(TSCSNorm(SCSNormResourceObj)); end; end; FreeAndNil(SCSNormResourceObj); CurrNPP := DM.mtNorms.FieldByName(fnNPP).AsInteger; DM.mtNorms.Delete; DM.SdvigNPPInMemTable(CurrNPP, DM.mtNorms); EnableEditDel(itAuto); end; end; // Tolik 23/06/2016 -- // SCSComponent.DefineInterfaceNorms(True); // переоределить нормы (особенно нужно для каб канала, гофры и т.п.) if GDBMode = bkProjectManager then F_ProjMan.Timer_TreeCatalogChangeTimer(F_ProjMan.Timer_TreeCatalogChange); // except on E: Exception do AddExceptionToLogEx('TF_MAIN.Act_DelNormResourceExecute', E.Message); end; end; procedure TF_MAIN.GT_NormsResourcesNPPGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := IntToStr(ARecord.Index + 1); end; procedure TF_MAIN.GT_NormsResourcesCellClick( Sender: TcxCustomGridTableView; ACellViewInfo: TcxGridTableDataCellViewInfo; AButton: TMouseButton; AShift: TShiftState; var AHandled: Boolean); begin if ACellViewInfo.Item.Index = finIsOn then //*** Поле "Включен" begin DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnIsOn).AsInteger := 1 - DM.mtNorms.FieldByName(fnIsOn).AsInteger; DM.mtNorms.Post; //Timer_PostNormResource.Enabled := true; SaveSelectedNormResource; AHandled := true; end; end; procedure TF_MAIN.GT_NormsResourcesFocusedRecordChanged( Sender: TcxCustomGridTableView; APrevFocusedRecord, AFocusedRecord: TcxCustomGridRecord; ANewItemRecordFocusingChanged: Boolean); var IsResource: Boolean; IsNormFromInterface: Boolean; begin IsResource := false; IsNormFromInterface := false; if DM <> nil then begin if DM.mtNorms.Active and (DM.mtNorms.RecordCount > 0) then begin IsResource := DM.mtNorms.FieldByName(fnIsResource).AsBoolean; if Not IsResource then IsNormFromInterface := IntToBool(DM.mtNorms.FieldByName(fnIsFromInterface).AsInteger); end; GT_NormsResourcesLaborTime.Options.Editing := Not IsResource; //31.10.2013 GT_NormsResourcesPricePerTime.Options.Editing := Not IsResource; //31.10.2013 GT_NormsResourcesCost.Options.Editing := IsResource or Not IsNormFromInterface; //24.09.2010 IsResource; GT_NormsResourcesKolvo.Options.Editing := IsResource or Not IsNormFromInterface; GT_NormsResourcesExpenseForLength.Options.Editing := IsResource or Not IsNormFromInterface; GT_NormsResourcesCountForPoint.Options.Editing := GT_NormsResourcesExpenseForLength.Options.Editing; GT_NormsResourcesStepOfPoint.Options.Editing := GT_NormsResourcesExpenseForLength.Options.Editing; //GT_NormsResourcesTotalCost.Options.Editing := IsResource; //*** Количество знаков после хапятой if IsResource then begin TcxCurrencyEditProperties(GT_NormsResourcesKolvo.Properties).DisplayFormat := GetDisplayFormatForFloat; TcxCurrencyEditProperties(GT_NormsResourcesKolvo.Properties).DecimalPlaces := FloatPrecision; end else begin TcxCurrencyEditProperties(GT_NormsResourcesKolvo.Properties).DisplayFormat := GetDisplayFormatForFloatByPrecision(PrecisionNormKolvo); TcxCurrencyEditProperties(GT_NormsResourcesKolvo.Properties).DecimalPlaces := PrecisionNormKolvo; end; end; //EnableEditDel(itAuto); end; procedure TF_MAIN.GT_NormsResourcesLaborTimePropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; IsCalcNormTotal: Boolean; //LaborTimeHr: Double; begin Error := false; if DisplayValue = '' then begin DisplayValue := DM.mtNorms.FieldByName(fnLaborTime).AsFloat; Exit; ///// EXIT ///// end; //IsCalcNormTotal := false; SavedEvent := TcxSpinEdit(Sender).Properties.OnValidate; TcxSpinEdit(Sender).Properties.OnValidate := nil; try DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnLaborTime).AsInteger := DisplayValue; //LaborTimeHr := RoundX(DM.mtNorms.FieldByName(fnLaborTime).AsInteger / 60, 5); //if DM.mtNorms.FieldByName(fnPricePerTime).AsFloat <> 0 then //begin // IsCalcNormTotal := true; // DM.mtNorms.FieldByName(fnCost).AsFloat := DM.mtNorms.FieldByName(fnPricePerTime).AsFloat * LaborTimeHr; //end //else if DM.mtNorms.FieldByName(fnCost).AsFloat <> 0 then // DM.mtNorms.FieldByName(fnPricePerTime).AsFloat := Round2(DM.mtNorms.FieldByName(fnCost).AsFloat / LaborTimeHr); DM.mtNorms.Post; DM.CalcNormCostTime(DM.mtNorms, fnLaborTime, IsCalcNormTotal); //01.11.2013 if IsCalcNormTotal = true then DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); SaveSelectedNormResource; finally TcxSpinEdit(Sender).Properties.OnValidate := SavedEvent; end; end; procedure TF_MAIN.GT_NormsResourcesPricePerTimePropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; IsCalcNormTotal: Boolean; begin Error := false; if DisplayValue = '' then begin DisplayValue := DM.mtNorms.FieldByName(fnPricePerTime).AsFloat; Exit; ///// EXIT ///// end; SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnPricePerTime).AsFloat := DisplayValue; DM.mtNorms.Post; DM.CalcNormCostTime(DM.mtNorms, fnPricePerTime, IsCalcNormTotal); //01.11.2013 if IsCalcNormTotal = true then DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; end; procedure TF_MAIN.GT_NormsResourcesCostPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; IsCalcNormTotal: Boolean; begin Error := false; if DisplayValue = '' then begin DisplayValue := DM.mtNorms.FieldByName(fnCost).AsFloat; Exit; ///// EXIT ///// end; SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnCost).AsFloat := DisplayValue; DM.mtNorms.Post; DM.CalcNormCostTime(DM.mtNorms, fnCost, IsCalcNormTotal); //01.11.2013 DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); //Timer_PostNormResource.Enabled := true; SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; end; procedure TF_MAIN.GT_NormsResourcesKolvoPropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; begin Error := false; if DisplayValue = '' then begin DisplayValue := DM.mtNorms.FieldByName(fnKolvo).AsFloat; Exit; ///// EXIT ///// end; SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try {DM.CalcNormTatalCostInMT(DM.mtNorms, DM.mtNorms.FieldByName(fnCost).AsFloat, DisplayValue); //Timer_PostNormResource.Enabled := true; DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnExpenseForLength).AsFloat := 0; DM.mtNorms.FieldByName(fnCountForPoint).AsFloat := 0; DM.mtNorms.FieldByName(fnStepOfPoint).AsFloat := 0; DM.mtNorms.Post;} DM.mtNorms.Edit; DM.mtNorms.FieldByName(fnKolvo).AsFloat := DisplayValue; DM.mtNorms.FieldByName(fnExpenseForLength).AsFloat := 0; DM.mtNorms.FieldByName(fnCountForPoint).AsFloat := 0; DM.mtNorms.FieldByName(fnStepOfPoint).AsFloat := 0; DM.mtNorms.Post; DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; end; procedure TF_MAIN.GT_NormsResourcesRTypeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText <> '' then AText := GetResourceTypeName(StrToInt(AText)); end; procedure TF_MAIN.Timer_PostGridTableViewTimer(Sender: TObject); begin if IsOtherTimerToHandleInOrder(TTimer(Sender)) then Exit; ///// EXIT ///// EnableTimerWithOrder(TTimer(Sender), false); //if GT_NormsResources.DataController.IsEditing and (DM.mtNorms.State <> dsBrowse) then //begin // GT_NormsResources.DataController.Post; // SaveSelectedNormResource; //end; if (FTimerPostGrid <> nil) and (FTimerPostDataSet <> nil) then if FTimerPostGrid.DataController.IsEditing and (FTimerPostDataSet.State <> dsBrowse) then begin FTimerPostGrid.DataController.Post; if FTimerPostGrid = GT_NormsResources then SaveSelectedNormResource else if FTimerPostGrid = GT_Connections then SaveSelectedConnection; end; end; procedure TF_MAIN.GT_NormsResourcesEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); begin if (Sender.DataController.IsEditing) and (DM.mtNorms.State <> dsBrowse) then begin EnableTimerWithOrder(Timer_PostGridTableView, true, true); end; end; function TF_MAIN.BrowseNewDirName(aTitle, aDirPath, aDefNewDirName: string): string; var SaveDialog: TSaveDialog; //tbInfo: TTBButtonInfo; ProcAddr: Pointer; LabelText: string; begin Result := ''; SaveDialog := TSaveDialog.Create(nil); SaveDialog.Title := aTitle; SaveDialog.FileName := aDefNewDirName; SaveDialog.InitialDir := aDirPath; SaveDialog.Options := SaveDialog.Options + [ofNoNetworkButton]; //SaveDialog.FileEditStyle SaveDialog.OnCanClose := BrowseNewDirCanClose; SaveDialog.OnShow := BrowseNewDirShow; SaveDialog.OnSelectionChange := BrowseNewDirSelectionChange; //Wnd := FindWindowEx(GetParent(SaveDialog.Handle), 0, '', nil); // if Wnd <> 0 then // begin // LabelText := '111111'; // SendMessage(Wnd, WM_SETTEXT, 0, Integer(@LabelText)); // end; // while Wnd <> 0 do // begin // Break; //// BREAK //// // end; if SaveDialog.Execute then Result := SaveDialog.FileName; FreeAndNil(SaveDialog); end; procedure TF_MAIN.BrowseNewDirCanClose(Sender: TObject; var CanClose: Boolean); var i: Integer; begin for i := 0 to TSaveDialog(Sender).Files.Count - 1 do begin if DirectoryExists(TSaveDialog(Sender).Files[i]) then begin MessageModal(cDirWithName+' "'+ExtractFileName(TSaveDialog(Sender).Files[i])+'" '+cNowExists+'.', TSaveDialog(Sender).Title, MB_ICONINFORMATION or MB_OK); CanClose := false; Break; ///// BREAK ///// end; end; end; procedure TF_MAIN.BrowseNewDirShow(Sender: TObject); const LB_FILETYPES_ID = 1089; // "File types:" label LB_FILENAME_ID = 1090; // "File name:" label LB_DRIVES_ID = 1091; // "Look in:" label CB_FILETYPES_ID = 1136; var hOpenDialog: HWND; i: Integer; begin hOpenDialog := GetParent(TSaveDialog(Sender).Handle); SendMessage(hOpenDialog, CDM_SETCONTROLTEXT, LB_FILENAME_ID, Longint(PChar(cMain_Msg158))); SendMessage(hOpenDialog, CDM_HIDECONTROL, LB_FILETYPES_ID, 0); SendMessage(hOpenDialog, CDM_HIDECONTROL, CB_FILETYPES_ID, 0); end; procedure TF_MAIN.BrowseNewDirSelectionChange(Sender: TObject); begin //EmptyProcedure; //if TSaveDialog(Sender).HistoryList.co end; procedure TF_MAIN.DialogWithCheckBoxOnShow(Sender: TObject); var DialogHandle: HWND; WindowRect, PreviewRect, StaticRect: TRect; begin {DialogHandle := TCommonDialog(Sender).Handle; //DialogHandle := GetParent(DialogHandle); // Получаем область диалога GetWindowRect(GetDlgItem(DialogHandle, stc32), StaticRect); MapWindowPoints(0, DialogHandle, StaticRect, 2); Windows.GetClientRect(DialogHandle, StaticRect); //PreviewRect.Left := 10; //PreviewRect.Top := StaticRect.Bottom - FCheckBoxForDialog.Height; PreviewRect.Left := StaticRect.Left + (StaticRect.Right - StaticRect.Left); FPanelForDialog.BoundsRect := PreviewRect; FPanelForDialog.ParentWindow := DialogHandle;} DialogHandle := TCommonDialog(Sender).Handle; DialogHandle := GetParent(DialogHandle); // Расширяем окно диалога GetWindowRect(DialogHandle, WindowRect); SetWindowPos(DialogHandle, HWND_TOP, 1, 1, WindowRect.Right-WindowRect.Left, //Ширина WindowRect.Bottom-WindowRect.Top + FPanelForDialog.Height+5, //Высота SWP_SHOWWINDOW); GetWindowRect(DialogHandle, WindowRect); FPanelForDialog.ParentWindow := DialogHandle; //FPanelForDialog.Width := 200; //FPanelForDialog.Height := 50; FPanelForDialog.Left := 195; FPanelForDialog.Top := WindowRect.Bottom - WindowRect.Top - FPanelForDialog.Height - 28; FCheckBoxForDialog.Checked := IntToBool(FCheckBoxForDialog.Tag); end; procedure TF_MAIN.DialogWithCheckBoxOnClose(Sender: TObject); begin end; function TF_MAIN.ExecuteDialogWithCheckBox(ADialog: TCommonDialog; ACheckBoxCaption: String; ACheckState: PBoolean): Boolean; var CaptionTagSize: TSize; begin Result := false; ADialog.OnShow := DialogWithCheckBoxOnShow; ADialog.OnClose := DialogWithCheckBoxOnClose; FPanelForDialog := TPanel.Create(ADialog); FCheckBoxForDialog := TRzCheckBox.Create(ADialog); try // вычисляем ширину текста GetTextExtentPoint32(Canvas.Handle, PChar(ACheckBoxCaption), Length(ACheckBoxCaption), CaptionTagSize); FCheckBoxForDialog.SetBounds(1, 1, 20+CaptionTagSize.cx, FCheckBoxForDialog.Height); FCheckBoxForDialog.Caption := ACheckBoxCaption; // Подгоняем размер панели под CheckBox FPanelForDialog.BoundsRect := FCheckBoxForDialog.BoundsRect; FPanelForDialog.BorderStyle := bsNone; FPanelForDialog.BevelInner := bvNone; FPanelForDialog.BevelOuter := bvNone; FCheckBoxForDialog.Parent := FPanelForDialog; if ACheckState <> nil then FCheckBoxForDialog.Tag := BoolToint(ACheckState^); Result := ADialog.Execute; if ACheckState <> nil then ACheckState^ := FCheckBoxForDialog.Checked; finally //FreeAndNil(FCheckBoxForDialog); FreeAndNil(FPanelForDialog); end; end; function TF_MAIN.CheckAdminPM(AShowMessage: Boolean): Boolean; begin Result := true; try if IsUseProjLoginning then if GDBMode = bkProjectManager then begin if FCurrUserInfo <> nil then if (FCurrUserInfo.RightsPM <> rwrAdmin) or GReadOnlyMode then begin Result := false; if AShowMessage then MessageModal(cMain_Msg156, ApplicationName, MB_OK or MB_ICONINFORMATION); end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.CheckWritePM', E.Message); end; end; function TF_MAIN.CheckWriteNB(AShowMessage: Boolean): Boolean; begin Result := Not GSCSIni.NB.DisableEdit and CheckWriteNBByUser; if Not Result and AShowMessage then MessageModal(cMain_Msg155, ApplicationName, MB_OK or MB_ICONINFORMATION); end; function TF_MAIN.CheckWriteNBByUser: Boolean; begin Result := true; if FProjectMan <> nil then if FProjectMan.FCurrUserInfo <> nil then if (FProjectMan.FCurrUserInfo.RightsNB <> rwrReadWrite) or GReadOnlyMode then Result := false; end; function TF_MAIN.CheckWritePM(AShowMessage: Boolean=true): Boolean; begin Result := true; try if IsUseProjLoginning then if GDBMode = bkProjectManager then begin if FCurrUserInfo <> nil then if (FCurrUserInfo.RightsPM = rwrRead) or GReadOnlyMode then begin Result := false; if AShowMessage and Not FMultipleAction then MessageModal(cMain_Msg153, ApplicationName, MB_OK or MB_ICONINFORMATION); end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.CheckWritePM', E.Message); end; end; function TF_MAIN.CheckWriteProj(AProjID: integer; AShowMessage: Boolean=true): Boolean; var ProjRights: Integer; UsersInfo: TUsersInfo; IsProjWithRights: Boolean; begin Result := true; try if IsUseProjLoginning then begin if FProjUserInfo <> nil then begin ProjRights := -1; IsProjWithRights := false; if (FCurrUserInfo.RightsPM <> rwrAdmin) or GReadOnlyMode then begin //*** Если в параметре текущий проект if GSCSBase.CurrProject.Active then if GSCSBase.CurrProject.ID = AProjID then begin if FProjUserInfo.ID <> 0 then begin ProjRights := FProjUserInfo.RightsPM; IsProjWithRights := true; end else ProjRights := FCurrUserInfo.RightsPM; end; //*** Если другой проект if ProjRights = -1 then begin UsersInfo := DM.GetUsersInfoFromProject(AProjID); try if UsersInfo.UsersInfo.Count = 0 then ProjRights := FCurrUserInfo.RightsPM else if LogInUser(UsersInfo, Self, false, false, FCurrUserInfo, '') then begin ProjRights := UsersInfo.LoggedUserInfo.RightsPM; IsProjWithRights := true; end; finally FreeAndNil(UsersInfo); end; end; if (ProjRights = rwrRead) or GReadOnlyMode then begin Result := false; if AShowMessage then begin if Not IsProjWithRights then MessageModal(cMain_Msg153, ApplicationName, MB_OK or MB_ICONINFORMATION) else MessageModal(cMain_Msg154, ApplicationName, MB_OK or MB_ICONINFORMATION); end; end else if ProjRights = -1 then Result := false; end; end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.CheckWriteProj', E.Message); end; end; procedure TF_MAIN.ClearProjUserInfo; begin if FProjUserInfo <> nil then FProjUserInfo.Clear; end; function TF_MAIN.LoginUserToPM(ALoginByDefAdminUser, AReadFromRegister: Boolean): Boolean; begin Result := false; if ALoginByDefAdminUser then if DM.UsersInfoPM.IsDefAdminUser then begin DM.UsersInfoPM.LoggedUserInfo := TUserInfo(DM.UsersInfoPM.UsersInfo[0]); Result := true; end; if Not Result then Result := LogInUser(DM.UsersInfoPM, Self, true, AReadFromRegister, nil, ''); if Result then begin if FCurrUserInfo <> nil then begin FCurrUserInfo.Assign(DM.UsersInfoPM.LoggedUserInfo); FNormBase.EnableDisableEdit(Not GSCSIni.NB.DisableEdit and CheckWriteNBByUser); end; end else FNormBase.EnableDisableEdit(false); end; function TF_MAIN.LoginUserToProject(AProjID: Integer): Boolean; var UsersInfo: TUsersInfo; begin Result := false; try if Not IsUseProjLoginning then Result := true else begin UsersInfo := DM.GetUsersInfoFromProject(AProjID); try if UsersInfo.UsersInfo.Count > 0 then begin if LogInUser(UsersInfo, Self, false, false, FCurrUserInfo, '') then begin Result := true; if FProjUserInfo <> nil then FProjUserInfo.Assign(UsersInfo.LoggedUserInfo); end; end else Result := true; finally FreeAndNil(UsersInfo); end; end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.LoginUserToProject', E.Message); end; end; function TF_MAIN.ShowProjUsers(AProjID: Integer): Boolean; var ProjUsers: TUsersInfo; ProjUserAsActive: TUserInfo; UsedUsers: TStringList; begin Result := false; try UsedUsers := nil; if FProjUserInfo.ID <> 0 then begin UsedUsers := TStringList.Create; UsedUsers.Add(FProjUserInfo.Name); end; ProjUsers := DM.GetUsersInfoFromProject(AProjID); try if ShowUsers(ProjUsers, false, FProjUserInfo.Name, '', UsedUsers) then begin DM.SaveUsersInfoToProject(AProjID, ProjUsers); // Измененный пароль внести в объект if FProjUserInfo.ID <> 0 then begin ProjUserAsActive := ProjUsers.GetUserInfoByName(FProjUserInfo.Name); if ProjUserAsActive <> nil then FProjUserInfo.Pass := ProjUserAsActive.Pass; end; Result := true; end; finally FreeAndNil(ProjUsers); end; if UsedUsers <> nil then FreeAndNil(UsedUsers); except on E: Exception do AddExceptionToLogEx('TF_MAIN.ShowProjUsers', E.Message); end; end; procedure TF_MAIN.rbFilterTypeClick(Sender: TObject); var NewFilterType: TFilterType; OldFilterParams: TFilterParams; begin NewFilterType := fltNone; if Sender = rbFilterTypeUser then NewFilterType := fltCustom else if Sender = rbFilterTypeTop then NewFilterType := fltTop else if Sender = rbFilterTypeFavorites then NewFilterType := fltFavorites; if NewFilterType <> fltNone then begin OldFilterParams := TFilterParams.Create(GDBMode); if FFilterParams.FFilterBlock <> nil then OldFilterParams.FFilterBlock := TFilterBlock.Create(nil, FFilterParams.FFilterBlock.BlockType); OldFilterParams.Assign(FFilterParams); FFilterParams.FFilterType := NewFilterType; ApplyComponentFilter(OldFilterParams, FFilterParams, false); SaveComponFilter; FreeAndNil(OldFilterParams); end; end; procedure TF_MAIN.Act_AddComponToFavoritesExecute(Sender: TObject); var ComponNode: TTreeNode; begin AddComponGUIDToNBFavorites(GSCSBase.SCSComponent.GuidNB); ComponNode := Tree_Catalog.Selected; if ComponNode <> nil then if PObjectData(ComponNode.Data).ObjectID = GSCSBase.SCSComponent.ID then SetNodeState(ComponNode, PObjectData(ComponNode.Data).ItemType, ekNone, GSCSBase.SCSComponent); end; procedure TF_MAIN.Act_DelComponFromFavoritesExecute(Sender: TObject); var ComponNode: TTreeNode; begin DelComponGUIDFromNBFavorites(GSCSBase.SCSComponent.GuidNB); //ApplyComponentFilter(nil, FFilterParams, false); ComponNode := Tree_Catalog.Selected; if ComponNode <> nil then if PObjectData(ComponNode.Data).ObjectID = GSCSBase.SCSComponent.ID then SetNodeState(ComponNode, PObjectData(ComponNode.Data).ItemType, ekNone, GSCSBase.SCSComponent); end; procedure TF_MAIN.Act_ExportAllComponentsToNBExecute(Sender: TObject); var ComponentGroups: TStringList; GomponGroup: TSCSComponents; CurrGomponGroup: TSCSComponents; SprComponentType: TNBComponentType; ComponCountToExport: Integer; SCSComponent: TSCSComponent; LookedComponGUIDs: TStringList; NBProjNode: TTreeNode; TargetNode: TTreeNode; CurrNBIDDir: Integer; CurrNBDir: TTreeNode; i, j: Integer; k, TabIndex: integer; begin try if Not CheckWriteNB(false) then MessageModal(cMain_Msg150, ApplicationName, MB_OK or MB_ICONINFORMATION) else if MessageModal(cMain_Msg146, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ComponentGroups := TStringList.Create; LookedComponGUIDs := TStringList.Create; ComponCountToExport := 0; BeginProgress; try for i := 0 to GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin SCSComponent := GSCSBase.CurrProject.ComponentReferences[i]; if SCSComponent.IsTemplate = biFalse then if LookedComponGUIDs.IndexOf(SCSComponent.GuidNB) = -1 then begin LookedComponGUIDs.Add(SCSComponent.GuidNB); //*** Найти группу по типу компонента GomponGroup := nil; for j := 0 to ComponentGroups.Count - 1 do begin CurrGomponGroup := TSCSComponents(ComponentGroups.Objects[j]); if CurrGomponGroup.Count > 0 then if CurrGomponGroup[0].GUIDComponentType = SCSComponent.GUIDComponentType then begin GomponGroup := CurrGomponGroup; Break; //// BREAK //// end; end; if GomponGroup = nil then begin SprComponentType := GSCSBase.CurrProject.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if SprComponentType <> nil then begin GomponGroup := TSCSComponents.Create(false); ComponentGroups.AddObject(SprComponentType.ComponentType.NamePlural, GomponGroup); end; end; //*** Если группа определена if GomponGroup <> nil then begin GomponGroup.Add(SCSComponent); Inc(ComponCountToExport); end; end; end; finally EndProgress; end; if GSCSBase.CurrProject.DefineNBDir then begin //FNormBase.SetpcObjectsTab(FNormBase.tsComponents.TabIndex); //FNormBase.pcObjects.ActivePage := FNormBase.tsComponents; TabIndex := 0; for k := 0 to FNormBase.pcObjects.PageCount - 1 do if FNormBase.pcObjects.Pages[k].Name = FNormBase.tsComponents.Name then begin TabIndex := k; break; end; FNormBase.SetpcObjectsTab(TabIndex); //FNormBase.pcObjects.ActivePage := FNormBase.tsComponents; NBProjNode := FNormBase.FindComponOrDirInTree(GSCSBase.CurrProject.NBDirID, false); //*** Сам Экспорт BeginProgress('', ComponCountToExport); try TargetNode := FNormBase.MakeDir(cfBase, NBProjNode, cMain_Msg147, itDir, nil); for i := 0 to ComponentGroups.Count - 1 do begin //*** Создать папку с типом компоненты CurrNBDir := FNormBase.MakeDir(cfBase, TargetNode, ComponentGroups[i], itDir, nil); if CurrNBDir <> nil then begin CurrNBIDDir := PObjectData(CurrNBDir.Data).ObjectID; GomponGroup := TSCSComponents(ComponentGroups.Objects[i]); for j := 0 to GomponGroup.Count - 1 do begin SCSComponent := GomponGroup[j]; CopyComponentFromPMToNB(Self, FNormBase, SCSComponent, CurrNBIDDir); StepProgress; end; end; end; finally EndProgress; end; FNormBase.Tree_Catalog.Selected := NBProjNode; end; FreeAndNil(LookedComponGUIDs); //*** Удалить группы for i := 0 to ComponentGroups.Count - 1 do begin GomponGroup := TSCSComponents(ComponentGroups.Objects[i]); if GomponGroup <> nil then FreeAndNil(GomponGroup); ComponentGroups.Objects[i] := nil; end; FreeAndNil(ComponentGroups); end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.Act_ExportAllComponentsToNBExecute', E.Message); end; end; procedure TF_MAIN.pcFindClick(Sender: TObject); begin if pcFind.ActivePage = tsFind then ButtonEdit_Find.SetFocus; end; procedure TF_MAIN.Act_ProjUsersExecute(Sender: TObject); begin try if CheckAdminPM(true) then begin if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then ShowProjUsers(PObjectData(Tree_Catalog.Selected.Data).ObjectID); end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.Act_ProjUsersExecute', E.Message); end; end; procedure TF_MAIN.Act_SelectSameComponsInCADExecute(Sender: TObject); var i, j: Integer; SCSCatalog: TSCSCatalog; Compon: TSCSComponent; ObjectsToSelect: TIntList; NodesToSel: TList; Node: TTreeNode; begin try if GSCSBase.SCSComponent.GuidNB <> '' then if GSCSBase.CurrProject.CurrList <> nil then begin Application.ProcessMessages; Tree_Catalog.Items.BeginUpdate; Screen.Cursor := crHourGlass; try NodesToSel := Tlist.Create; ObjectsToSelect := TIntList.Create; for i := 0 to GSCSBase.CurrProject.CurrList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := GSCSBase.CurrProject.CurrList.ChildCatalogReferences[i]; if IsSCSObjectItemType(SCSCatalog.ItemType) then for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin Compon := SCSCatalog.ComponentReferences[j]; if Compon.GuidNB = GSCSBase.SCSComponent.GuidNB then begin ObjectsToSelect.Add(SCSCatalog.SCSID); Node := Compon.TreeViewNode; if Node = nil then Node := FindComponOrDirInTree(Compon.ID, true); if Node <> nil then NodesToSel.Add(Node); //28.02.2012 Break; //// BREAK //// end; end; end; TESTreeView(Tree_Catalog).Select(NodesToSel); DeselectAllSCSObjectsInCAD(GSCSBase.CurrProject.CurrList.CurrID); SelectObjectsInCADByIDs(GSCSBase.CurrProject.CurrList.CurrID, ObjectsToSelect); FreeAndNil(ObjectsToSelect); FreeAndNil(NodesToSel); finally Screen.Cursor := crDefault; Tree_Catalog.Items.EndUpdate; end; end; except on E: Exception do AddExceptionToLogEx('Act_SelectSameComponsInCADExecute', E.Message); end; end; procedure TF_MAIN.Act_SelectSameComponsInProjExecute(Sender: TObject); var i: Integer; Compon: TSCSComponent; NodesToSel: TList; Node: TTreeNode; begin try if GSCSBase.SCSComponent.GuidNB <> '' then if GSCSBase.CurrProject.Active then begin Application.ProcessMessages; Tree_Catalog.Items.BeginUpdate; Screen.Cursor := crHourGlass; try NodesToSel := Tlist.Create; for i := 0 to GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin Compon := GSCSBase.CurrProject.ComponentReferences[i]; if Compon.GuidNB = GSCSBase.SCSComponent.GuidNB then begin Node := Compon.TreeViewNode; if Node = nil then Node := FindComponOrDirInTree(Compon.ID, true); if Node <> nil then NodesToSel.Add(Node) else EmptyProcedure; end; end; TESTreeView(Tree_Catalog).Select(NodesToSel); FreeAndNil(NodesToSel); finally Screen.Cursor := crDefault; Tree_Catalog.Items.EndUpdate; end; end; except on E: Exception do AddExceptionToLogEx('Act_SelectSameComponsInProjExecute', E.Message); end; end; procedure TF_MAIN.Act_DelSameComponInSelObjExecute(Sender: TObject); var SelectedFigureIDs: TIntList; ComponentList: TSCSComponents; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; JoinedComponent: TSCSComponent; i, j, k: Integer; SameJoinedCount: Integer; DelComponMode: TDelComponMode; CanDelOnWholeLen: Boolean; begin try if GSCSBase.SCSComponent.GuidNB <> '' then begin // Получить список выделенных объектов на КАДе SelectedFigureIDs := GetObjectsListWithSelectedInCAD(GSCSBase.CurrProject.CurrList.CurrID); if SelectedFigureIDs.count > 0 then begin if MessageModal(cMain_Msg159, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin ComponentList := TSCSComponents.Create(false); SameJoinedCount := 0; for i := 0 to SelectedFigureIDs.Count - 1 do begin SCSCatalog := GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(SelectedFigureIDs[i]); if SCSCatalog <> nil then for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := SCSCatalog.ComponentReferences[j]; if SCSComponent.GuidNB = GSCSBase.SCSComponent.GuidNB then begin ComponentList.Add(SCSComponent); SCSComponent.ServToDelete := true; if GSCSBase.SCSComponent.IsLine = biTrue then for k := 0 to SCSComponent.JoinedComponents.Count - 1 do begin JoinedComponent := SCSComponent.JoinedComponents[k]; if JoinedComponent.GuidNB = SCSComponent.GuidNB then Inc(SameJoinedCount); end; end; end; end; if ComponentList.Count > 0 then begin CanDelOnWholeLen := true; // Если еть подключенные линейные компоненты, то спросить удалять по всей длине, илил же на выбранных участках if (SameJoinedCount > 0) and (GSCSBase.SCSComponent.IsLine = biTrue) then begin DelComponMode := F_InputBox.ChoiceDelComponMode(GSCSBase.SCSComponent.Name, true); if DelComponMode = dmArea then CanDelOnWholeLen := false; end; DelComponentsFromList(GSCSBase.CurrProject.CurrList, ComponentList, CanDelOnWholeLen); end else MessageModal(cMain_Msg161, ApplicationName, MB_ICONINFORMATION or MB_OK); FreeAndNil(ComponentList); end end else MessageModal(cMain_Msg160, ApplicationName, MB_ICONINFORMATION or MB_OK); FreeAndNil(SelectedFigureIDs); end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.Act_DelSameComponInSelObjExecute', E.Message); end; end; procedure TF_MAIN.Timer_ChangingTimer(Sender: TObject); var Node: TTreeNode; begin if Timer_Changing.Tag = 999 then begin Timer_Changing.Tag := 999; exit; end; try Timer_Changing.Tag := 999; Timer_Changing.Enabled := false; Node := Tree_Catalog.Selected; if (Node <> nil) and (Node.Data <> nil) then FPrevSelectedNodeDat := PObjectData(Node.Data)^; FPrevSelectionCount := Tree_Catalog.SelectionCount; except on E: Exception do AddExceptionToLogEx('TF_MAIN.Timer_ChangingTimer', E.Message); end; Timer_Changing.Tag := 0; end; procedure TF_MAIN.GT_PROPERTYIZMGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin SetDisplayTextToGridTablePropIzm(AText, ARecord, 7, FUOM); end; procedure TF_MAIN.GT_NormsResourcesExpenseForLengthGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := GetDisplayTextToNORMExpenseForLength(AText, FUOM); end; procedure TF_MAIN.GT_NormsResourcesExpenseForLengthPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; ValueFloat: Double; begin try // Преобразуем расход из TF_Main(GForm).FUOM на метр if DisplayValue = '' then begin DisplayValue := FloatToStr(DM.mtNorms.FieldByName(fnExpenseForLength).AsFloat); Exit; ///// EXIT ///// end; ValueFloat := StrToFloat_My(DisplayValue); ValueFloat := FloatInUOM(ValueFloat, umMetr, FUOM); SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try with DM do begin mtNorms.Edit; mtNorms.FieldByName(fnExpenseForLength).AsFloat := RoundCP(ValueFloat); if mtNorms.FieldByName(fnIsResource).AsBoolean then mtNorms.FieldByName(fnTotalCost).AsFloat := 0; mtNorms.FieldByName(fnKolvo).AsFloat := 0; mtNorms.FieldByName(fnCountForPoint).AsFloat := 0; mtNorms.FieldByName(fnStepOfPoint).AsFloat := 0; mtNorms.Post; DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); end; SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; except end; end; procedure TF_MAIN.GT_NormsResourcesCountForPointPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; ValueFloat: Double; begin try if DisplayValue = '' then begin DisplayValue := FloatToStr(DM.mtNorms.FieldByName(fnCountForPoint).AsFloat); Exit; ///// EXIT ///// end; ValueFloat := StrToFloat_My(DisplayValue); SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try with DM do begin //mtNorms.Edit; //mtNorms.FieldByName(fnCountForPoint).AsFloat := RoundCP(ValueFloat); //mtNorms.Post; InputFloatToRelatedZeroFieldInMT(mtNorms, ValueFloat, fnCountForPoint, fnStepOfPoint, fnKolvo+';'+fnTotalCost+';'+fnExpenseForLength, cAddComponent_Msg20_1, true, FUOM); DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); end; SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; except end; end; procedure TF_MAIN.GT_NormsResourcesStepOfPointGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := GetDisplayTextInFLoatUOM(AText, FUOM); end; procedure TF_MAIN.GT_NormsResourcesStepOfPointPropertiesValidate( Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; ValueFloat: Double; begin try // Преобразуем расход из TF_Main(GForm).FUOM на метр if DisplayValue = '' then begin DisplayValue := FloatToStr(DM.mtNorms.FieldByName(fnStepOfPoint).AsFloat); Exit; ///// EXIT ///// end; ValueFloat := StrToFloat_My(DisplayValue); ValueFloat := FloatInUOM(ValueFloat, FUOM, umMetr); SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try with DM do begin //mtNorms.Edit; //mtNorms.FieldByName(fnStepOfPoint).AsFloat := RoundCP(ValueFloat); //mtNorms.Post; InputFloatToRelatedZeroFieldInMT(mtNorms, ValueFloat, fnStepOfPoint, fnCountForPoint, fnKolvo+';'+fnTotalCost+';'+fnExpenseForLength, cAddComponent_Msg20_2, false, FUOM); DM.CalcNormTatalCostInMT(DM.mtNorms, FTraccaLength); end; SaveSelectedNormResource; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; except end; end; procedure TF_MAIN.GT_NormsResourcesInitEdit(Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem; AEdit: TcxCustomEdit); begin if AItem = GT_NormsResourcesExpenseForLength then AEdit.EditValue := GetDisplayTextToNORMExpenseForLength(AEdit.EditValue, FUOM) else if AItem = GT_NormsResourcesStepOfPoint then AEdit.EditValue := GetDisplayTextInFLoatUOM(AEdit.EditValue, FUOM); end; procedure TF_MAIN.GT_InterfaceCoordZGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := GetDisplayTextInFLoatUOM(AText, FUOM); end; procedure TF_MAIN.Act_ApplyComponForListResourcesExecute(Sender: TObject); begin if CheckIsOpenListBeforeOperation(true, true) then begin BeginProgress; try FProjectMan.ApplyComponPropsForRelatedResources(FProjectMan.GSCSBase.CurrProject.CurrList, GSCSBase.SCSComponent); finally EndProgress; end; end; end; procedure TF_MAIN.Act_ApplyComponForProjResourcesExecute(Sender: TObject); begin if CheckIsOpenProjectBeforeOperation(true) then begin BeginProgress; try FProjectMan.ApplyComponPropsForRelatedResources(FProjectMan.GSCSBase.CurrProject, GSCSBase.SCSComponent); finally EndProgress; end; end; end; procedure TF_MAIN.GT_NormsResourcesCustomDrawCell( Sender: TcxCustomGridTableView; ACanvas: TcxCanvas; AViewInfo: TcxGridTableDataCellViewInfo; var ADone: Boolean); begin OnNormsResourcesCustomDrawCell(ACanvas, AViewInfo, GT_NormsResourcesIsResource.Index, GT_NormsResourcesGUIDNBCompon.Index, GT_NormsResourcesTotalKolvo.Index, true); //Sender.LookAndFeelPainter.DrawBorder(ACanvas, AViewInfo.Bounds); //ADone := true; end; procedure TF_MAIN.GT_NormsResourcesTotalKolvoGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin //AText := GetDisplayTextInFLoatUOM(AText, FUOM); end; procedure TF_MAIN.GT_NormsResourcesDblClick(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- Act_EditNormResource.Execute; end; // Tolik 29/03/2017 -- procedure TF_MAIN.Act_MasterComplExecute(Sender: TObject); var RefreshFlag: Boolean; begin RefreshFlag := GCanRefreshCad; GCanRefreshCad := True; try StartCompl; except on E: exception do AddExceptionToLog('MasterComplErr: ' + E.Message); end; GCanrefreshCad := RefreshFlag; end; { procedure TF_MAIN.Act_MasterComplExecute(Sender: TObject); begin StartCompl; end; } procedure TF_MAIN.Act_DeleteAllCCEExecute(Sender: TObject); begin DelComponsByTypeFromList(GIDLastList, ctsnCableChannelElement); end; procedure TF_MAIN.Timer_ShowHidepcObjectsTimer(Sender: TObject); var StepWidth: Integer; begin StepWidth := TTimer(Sender).Tag; if StepWidth > 0 then begin if (pcObjects.TabWidth + StepWidth) > 20 then begin SetpcObjectsTabWidth(20); //pcObjects.TabWidth := 20; //pcObjects.HotTrackStyle := htsTab; TTimer(Sender).Enabled := false; // После разворота запускаем таймер ожидания сдвига курсора с pcObjects if (FbtStayOnToppcObjects = nil) or Not FbtStayOnToppcObjects.Down then Timer_StartHidepcObjects.Enabled := true; end else SetpcObjectsTabWidth(pcObjects.TabWidth + StepWidth);//pcObjects.TabWidth := pcObjects.TabWidth + StepWidth; end else if StepWidth < 0 then begin if (pcObjects.TabWidth + StepWidth) < 1 then begin SetpcObjectsTabWidth(1); //pcObjects.TabWidth := 1; //pcObjects.HotTrackStyle := htsText; TTimer(Sender).Enabled := false; end else SetpcObjectsTabWidth(pcObjects.TabWidth + StepWidth); //pcObjects.TabWidth := pcObjects.TabWidth + StepWidth; end else TTimer(Sender).Enabled := false; end; procedure TF_MAIN.Timer_StartHidepcObjectsTimer(Sender: TObject); var MouseInTabsRect: Boolean; MouseScrPos: TPoint; ClientPos: TPoint; CheckRectScr: TRect; begin MouseInTabsRect := true; // Координаты курсора на экране MouseScrPos := GetMouseCursorPos; CheckRectScr := pcObjects.ClientRect; // Оставляем область с Табами CheckRectScr.Left := CheckRectScr.Right - pcObjects.TabWidth; CheckRectScr.TopLeft := pcObjects.ClientToScreen(CheckRectScr.TopLeft); CheckRectScr.BottomRight := pcObjects.ClientToScreen(CheckRectScr.BottomRight); // Увеличиваем область просмотра с каждой стороны CheckRectScr.Left := CheckRectScr.Left - 2; CheckRectScr.Right := CheckRectScr.Right + 2; CheckRectScr.Top := CheckRectScr.Top - 2; CheckRectScr.Bottom := CheckRectScr.Bottom + 2; MouseInTabsRect := PtInRect(CheckRectScr, MouseScrPos); if Not MouseInTabsRect then begin TTimer(Sender).Enabled := false; // Запускаем таймер на скрытие Timer_ShowHidepcObjects.Tag := -2; Timer_ShowHidepcObjects.Enabled := true; end; end; procedure TF_MAIN.pcObjectsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin if Shift = [] then begin Timer_ShowHidepcObjects.Tag := 2; Timer_ShowHidepcObjects.Enabled := true; end; end; procedure TF_MAIN.lvTemplatesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); var Data: PTemplateData; begin try if pcObjects.ActivePage = tsTemplates then if Selected then if (GSCSBase <> nil) and (GSCSBase.SCSComponent <> nil) then begin LockTreeAndGrid(true); try GSCSBase.SCSCatalog.Clear; GSCSBase.SCSComponent.Clear; //*** Очистить гриды if GFormMode = fmNormal then begin DM.MemTable_Complects.Active := false; DM.MemTable_Connections.Active := false; DM.MemTable_CrossConnection.Active := false; DM.MemTable_InterfaceRel.Active := false; DM.MemTable_PortInterfRel.Active := false; DM.MemTable_Port.Active := false; DM.mtInterfInternalConn.Active := false; DM.MemTable_Property.Active := false; DM.mtCableCanalConnectors.Active := false; DM.mtNorms.Active := false; DM.mtObjectCurrency.Active := false; end; if (Item <> nil) and (Item.Data <> nil) then begin Data := Item.Data; EnableDisableCost(true); GSCSBase.SCSComponent.Clear; GSCSBase.SCSComponent.IDTopComponent := Data.IDComponent; GSCSBase.SCSComponent.IDCompRel := 0; GSCSBase.SCSComponent.LoadComponentByID(Data.IDComponent, false, true, false); GSCSBase.SCSComponent.LoadChildComplectsQuick(true, false, true, GSCSBase.SCSComponent.IDTopComponent, GSCSBase.SCSComponent.IDCompRel); GSCSBase.SCSComponent.LoadComponentType; GSCSBase.SCSComponent.LoadInterfaces; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel then GSCSBase.SCSComponent.LoadCableCanalConnectors; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then GSCSBase.SCSComponent.LoadCrossConnections; GSCSBase.SCSComponent.NormsResources.LoadNorms(false, true); GSCSBase.SCSComponent.NormsResources.LoadResources(true); GSCSBase.SCSComponent.TreeViewNode := nil; GSCSBase.SCSComponent.ServAllLoaded := false; ShowPrice; if GFormMode = fmNormal then DM.SelectCompSub(nil, GSCSBase.SCSComponent); //DM.SelectComponProperty(GSCSBase.SCSComponent); end; SetVisibleGridLevel(GL_Compon_Relation, tcGridData, false); SetVisibleGridLevel(GL_CrossConnection, tcGridData, false); SetVisibleGridLevel(GL_Connections, tcGridData, false); SetVisibleGridLevel(GL_PORT, tcGridData, false); SetVisibleGridLevel(GL_Interface, tcGridData, false); SetVisibleGridLevel(GL_CableCanalConnectors, tcGridData, false); SetVisibleGridLevel(GL_NormsRerources, tcGridData, false); SetVisibleGridLevel(GL_ObjectCurrency, tcGridData, false); OnSelectCompon(GSCSBase.SCSComponent); EnableEditDelTemplate; finally LockTreeAndGrid(false); end; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.lvTemplatesSelectItem), E.Message); end; end; procedure TF_MAIN.pcObjectsChange(Sender: TObject); var //GroupBlock: TFilterBlock; GroupBlockCondition: TFilterBlock; FilterStr: string; begin if GDBMode = bkProjectManager then CheckCloseReportForm; // Tolik 30/04/2021 -- try if GDBMode = bkNormBase then begin Act_HideHints.Execute; if GSCSBase <> nil then begin if GSCSBase.SCSCatalog <> nil then GSCSBase.SCSCatalog.Clear; if GSCSBase.SCSComponent <> nil then GSCSBase.SCSComponent.Clear; end; if pcObjects.ActivePage = tsTemplates then begin if Assigned(FTemplateGrp) and Not FTemplateGrp.FOwner.Showing then FTemplateGrp.FOwner.Show; if FlvTemplate <> nil then begin ArrangeLVTemplates(FlvTemplate); if FlvTemplate.Selected <> nil then lvTemplatesSelectItem(FlvTemplate, FlvTemplate.Selected, true) else lvTemplatesSelectItem(FlvTemplate, nil, true); end; end else if pcObjects.ActivePage = tsComponents then begin if Tree_Catalog.Selected <> nil then Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected) else EnableEditDel(itAuto); //Timer_TreeCatalogChangeTimer(Timer_TreeCatalogChange); end else if pcObjects.ActivePage = tsComponGroups then begin if DM <> nil then begin if FModsCountBeforeShowGroup <> DM.FModifiedsCount then LoadDataToComponGroup(nil); tvComponGroupsChange(tvComponGroups, tvComponGroups.Selected); //if (GDBMode = bkNormBase) and (FGroupFilterBlock.ChildBlocks.Count = 0) then begin {// Производитель GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.IsOn := true; GroupBlockCondition.Condition.FieldName := tnComponent+'.'+fnIDProducer; //GroupBlockCondition.Condition.FieldValue := tnProducers+'.'+fnName; // Свойство Внешнее сечение //GroupBlock := TFilterBlock.Create(FGroupFilterBlock, bBlock); //GroupBlockCondition := TFilterBlock.Create(GroupBlock, btCondition); //GroupBlockCondition.IsOn := true; //GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+fnSysName; //GroupBlockCondition.Condition.FieldValue := pnOutSection; //GroupBlockCondition := TFilterBlock.Create(GroupBlock, btCondition); //GroupBlockCondition.IsOn := true; //GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+fnPValue; // Свойство Внешнее сечение GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.IsOn := true; GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+pnOutSection; //GroupBlockCondition.Condition.FieldValue := pnOutSection;} { GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.IsOn := true; GroupBlockCondition.Condition.FieldName := tnComponent+'.'+fnIDProducer; GroupBlockCondition.Condition.CompareType := ctEqual; GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.IsOn := true; GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+pnOutSection; GroupBlockCondition.Condition.CompareType := ctEqual; FilterStr := FGroupFilterBlock.GetFilterAsString(false); FGroupFilterBlock.Clear; FGroupFilterBlock.LoadFromStr(FilterStr, nil); tvComponGroups.Items.Clear; LoadDataToComponGroup(nil);} end; end; end; ToolBar_CompData.Visible := pcObjects.ActivePage <> tsComponGroups; if GFormMode = fmNormal then WriteSetting(fnSCSIniFile, dtInteger, scNormBase, idtLastpcObjectsTabIndex, pcObjects.ActivePageIndex); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'pcObjectsChange', E.Message); end; end; procedure TF_MAIN.Act_MakeTemplateExecute(Sender: TObject); begin try if CreateFAddComponent.Execute(fmMake, true) then try LockTreeAndGrid(True); GSCSBase.SCSComponent.SortID := GetTemplateMaxSortID + 1; DM.UpdateIntTableFieldByID(tnComponent, fnSortID, GSCSBase.SCSComponent.ID, GSCSBase.SCSComponent.SortID, qmPhisical); AddTemplateItem(FlvTemplate, GSCSBase.SCSComponent); ShowPrice; EnableEditDelTemplate; finally LockTreeAndGrid(false); end; ArrangeLVTemplates(FlvTemplate); except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_MakeTemplateExecute), E.Message); end; end; procedure TF_MAIN.Act_EditTemplateExecute(Sender: TObject); var Data: PTemplateData; begin try Data := FlvTemplate.Selected.Data; if Data.IDComponent = GSCSBase.SCSComponent.ID then begin if CreateFAddComponent.Execute(fmEdit, true) then try LockTreeAndGrid(True); GSCSBase.SCSComponent.IDTopComponent := Data.IDComponent; GSCSBase.SCSComponent.ServCanConnect := IntToBool(Data.IsStandart); ComponToTemplateItem(meEdit, GSCSBase.SCSComponent, FlvTemplate.Selected); ShowPrice; EnableEditDelTemplate; finally LockTreeAndGrid(false); end; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_EditTemplateExecute), E.Message); end; end; function TF_MAIN.AddTemplateItem(AListView: TRZListView; AComponent: TSCSComponent): TListItem; var ptrTemplateData: PTemplateData; begin Result := AListView.Items.Add; //lvTemplates.Items.Add; try GetMem(ptrTemplateData, SizeOf(TTemplateData)); Result.Data := ptrTemplateData; Result.ImageIndex := 0; ComponToTemplateItem(meMake, AComponent, Result); except on E: Exception do AddExceptionToLogExt(ClassName, 'TF_MAIN.AddTemplateItem', E.Message); end; end; procedure TF_MAIN.ArrangeLVTemplates(AListView: TRZListView); begin if Not AListView.IconOptions.AutoArrange then if AListView.Showing then AListView.Arrange(arAlignTop); end; procedure TF_MAIN.ComponDrawModeChange(AModeIndex: Integer); begin WriteSetting(fnSCSIniFile, dtInteger, scNormBase, idtComponDrawMode, AModeIndex); if (GCadForm.PCad.ToolInfo = TRoomWallRect.ClassName) or (GCadForm.PCad.ToolInfo = TWallPolyPath.ClassName) then lvTemplatesDblClick(FlvTemplate); end; function CompareComponGroupNodes(Item1, Item2: TTreeCollection): Integer; stdcall; var //Node1: TFlyNode; //Node2: TFlyNode; ComponGrpData1: TComponGrpData; ComponGrpData2: TComponGrpData; PropValue1: Double; PropValue2: Double; begin Result := 0; //Result:=CompareStr(item1.Caption, Item2.Caption); ComponGrpData1 := TComponGrpData(Item1.Data); ComponGrpData2 := TComponGrpData(Item2.Data); if (ComponGrpData1.PropDataType <> dtNone) and (ComponGrpData1.PropDataType = ComponGrpData2.PropDataType) then begin if (ComponGrpData1.PropDataType = dtFloat) or (ComponGrpData1.PropDataType = dtInteger) or (ComponGrpData1.PropDataType = dtDate) then begin PropValue1 := 0; PropValue2 := 0; case ComponGrpData1.PropDataType of dtInteger: begin PropValue1 := StrToIntDef(ComponGrpData1.PropValue, 0); PropValue2 := StrToIntDef(ComponGrpData2.PropValue, 0); end; dtFloat: begin PropValue1 := StrToFloatDefU(ComponGrpData1.PropValue, 0); PropValue2 := StrToFloatDefU(ComponGrpData2.PropValue, 0); end; dtDate: begin PropValue1 := StrToDateU(ComponGrpData1.PropValue); PropValue2 := StrToDateU(ComponGrpData2.PropValue); end; end; if PropValue1 < PropValue2 then Result := -1 else if PropValue1 > PropValue2 then Result := 1; end else Result := CompareText(Item1.Caption, Item2.Caption); end else Result := CompareText(Item1.Caption, Item2.Caption); end; procedure TF_MAIN.ComponToTemplateItem(AMakeEdit: TMakeEdit; AComponent: TSCSComponent; AItem: TListItem); var ptrTemplateData: PTemplateData; Spravochnik: TSpravochnik; SprObjectIcon: TNBObjectIcon; SprObjectIconGUID: string; Bitmap: TBitmap; //TmpBitmap: TBitmap; //bRect: TRect; PxCount: integer; //ZoomOut: Double; begin AItem.Caption := AComponent.Name; {$IF Not Defined (FINAL_SCS)} //AItem.Caption := AComponent.Name + ' sortid='+IntToStr(AComponent.SortID); {$IFEND} if AMakeEdit = meMake then AItem.ImageIndex := -1; ptrTemplateData := AItem.Data; ptrTemplateData.ID := AComponent.IDTopComponent; ptrTemplateData.IDComponent := AComponent.ID; ptrTemplateData.IsLine := AComponent.IsLine; ptrTemplateData.CompTypeSysName := AComponent.ComponentType.SysName; ptrTemplateData.IsStandart := BoolToInt(AComponent.ServCanConnect); ptrTemplateData.SortID := AComponent.SortID; if AComponent.IDSymbol <> 0 then begin Spravochnik := GetSpravochnik; SprObjectIcon := nil; if Spravochnik <> nil then begin SprObjectIconGUID := DM.GetStringFromTableByID(tnObjectIcons, fnGUID, AComponent.IDSymbol, qmPhisical); if SprObjectIconGUID <> '' then SprObjectIcon := Spravochnik.GetObjectIconByGUID(SprObjectIconGUID); if SprObjectIcon <> nil then begin SprObjectIcon.ProjBmp.Position := 0; Bitmap := TBitmap.Create; Bitmap.LoadFromStream(SprObjectIcon.ProjBmp); //Bitmap.SaveToFile('c:\test_'+AComponent.Name+'.bmp'); if (Bitmap.Height > 32) or (Bitmap.Width > 32) then begin //TmpBitmap := TBitmap.Create; //TmpBitmap.Height := 32; //TmpBitmap.Width := 32; //bRect := Rect(0, 0, TmpBitmap.Width, TmpBitmap.Height); //TmpBitmap.Canvas.StretchDraw(bRect, Bitmap); //Bitmap.Assign(TmpBitmap); //TmpBitmap.Free; //27.08.2010 Commented //// Определяем кол-во пикселей, выходящее за границы //PxCount := Bitmap.Height - 32; //if PxCount < (Bitmap.Width - 32) then // PxCount := Bitmap.Width - 32; // //if PxCount > 0 then //begin // // Определяем в сколько раз нужно уменьшить // ZoomOut := (32 + PxCount) / 32; // // StretchBitmap(Bitmap, Round(Bitmap.Height/ZoomOut), Round(Bitmap.Width/ZoomOut)); //end; BitmapToNormalSize(Bitmap, 32); Bitmap.Height := 32; Bitmap.Width := 32; //StretchBitmap(Bitmap, 32, 32); end else begin // Определяем кол-во пикселей, которого нехватает до границы PxCount := 32 - Bitmap.Height; if PxCount > (32 - Bitmap.Width) then PxCount := 32 - Bitmap.Width; // Растягиваем битмап на нужное кол-во пикселей if PxCount > 0 then StretchBitmap(Bitmap, Bitmap.Height + PxCount-1, Bitmap.Width + PxCount-1); Bitmap.Height := 32; Bitmap.Width := 32; end; if AItem.ImageIndex = -1 then //if AMakeEdit = meMake then begin AItem.ImageIndex := ilTemplateIcons.Add(Bitmap, nil); end else ilTemplateIcons.Replace(AItem.ImageIndex, Bitmap, nil); end; end; end else AItem.ImageIndex := -1; end; procedure TF_MAIN.ClearTemplateGroups; var i: Integer; Group: TRzGroup; TemplateGrpData: TTemplateGrpData; begin try // Отключаем события for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; Group.OnOpen := nil; Group.OnClose := nil; end; for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; if Group.Tag <> 0 then begin TemplateGrpData := TTemplateGrpData(Group.Tag); if FTemplateGrp = TemplateGrpData then begin FTemplateGrp := nil; FlvTemplate := nil; end; if TemplateGrpData.FListView <> nil then begin ClearListViewRz(TemplateGrpData.FListView); FreeAndNil(TemplateGrpData.FListView); TemplateGrpData.FListView := nil; end; Group.Tag := 0; end; Group.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ClearTemplateGroups', E.Message); end; end; procedure TF_MAIN.CreateTemplateControls(AStayOnTopButton: Boolean); var PageIndex: Integer; begin if AStayOnTopButton then if Not GUseArhOnlyMode then begin FbtStayOnToppcObjects := TSpeedButton.Create(Self); //FbtStayOnToppcObjects.Caption := '/'; FbtStayOnToppcObjects.Parent := pcObjects; FbtStayOnToppcObjects.Flat := true; FbtStayOnToppcObjects.Height := 18; //18; FbtStayOnToppcObjects.Width := 18; //20; //FbtStayOnToppcObjects.Left := (pcObjects.Width - 50) - FbtStayOnToppcObjects.Width - 2; FbtStayOnToppcObjects.Top := 2; FbtStayOnToppcObjects.AllowAllUp := true; FbtStayOnToppcObjects.GroupIndex := 1; FbtStayOnToppcObjects.Transparent := true; FbtStayOnToppcObjects.OnClick := FbtStayOnToppcObjectsClick; FbtStayOnToppcObjects.Hint := cMain_Msg180; FbtStayOnToppcObjects.ShowHint := true; if GFormMode = fmNormal then begin FbtStayOnToppcObjects.Down := ReadSetting(fnSCSIniFile, dtBoolean, scNormBase, idtStayOnTopPCObjects, true); //DM.ImageList_ToolEdit.GetBitmap(15, FbtStayOnToppcObjects.Glyph); DM.ImageList_ToolEdit.GetBitmap(15, FbtStayOnToppcObjects.Glyph); StretchBitmap(FbtStayOnToppcObjects.Glyph, FbtStayOnToppcObjects.Height - 2, FbtStayOnToppcObjects.Width - 2); end else begin FbtStayOnToppcObjects.Down := true; FbtStayOnToppcObjects.Visible := false; pcObjects.Margin := 0; end; end; SetpcObjectsTabWidth(1); //pcObjects.TabWidth := 1; //pcObjects.HotTrackStyle := htsText; if GFormMode = fmNormal then begin PageIndex := tsComponents.TabIndex; if GDBMode = bkNormBase then PageIndex := ReadSetting(fnSCSIniFile, dtInteger, scNormBase, idtLastpcObjectsTabIndex, 1); if PageIndex < pcObjects.PageCount then if pcObjects.Pages[PageIndex].TabVisible then SetpcObjectsTab(PageIndex); end; end; procedure TF_MAIN.DeleteTemplateItem(AItem: TListItem); var Data: PTemplateData; begin try if (AItem <> nil) and (AItem.Data <> nil) then begin Data := AItem.Data; DM.DelSimpleComponent(Data.IDComponent); FreeMem(AItem.Data); AItem.Delete; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DeleteTemplateItem', E.Message); end; end; function TF_MAIN.GetSelectedComponGroups: string; begin Result := ReadSettingMemIni(GetPathToNBComponGroups, dtString, scGeneral, idtSelectedCompType, ctsnCable); end; function TF_MAIN.GetTemplateMaxSortID: Integer; var i: integer; ListItem: TListItem; ptrTemplateData: PTemplateData; begin Result := 0; for i := 0 to FlvTemplate.Items.Count - 1 do begin ListItem := FlvTemplate.Items[i]; ptrTemplateData := ListItem.Data; if ptrTemplateData.SortID > Result then Result := ptrTemplateData.SortID; end; end; procedure TF_MAIN.EditingTemplateName; begin if FlvTemplate.Selected <> nil then FlvTemplate.Selected.EditCaption; end; procedure TF_MAIN.EnableEditDelTemplate; var IsStandart: Boolean; IDCompon: Integer; CanWriteNB: Boolean; CanMakeTemplate: Boolean; CanEditTemplate: Boolean; CanSendModelToProject: Boolean; CanDuplicate: Boolean; IsLineCompon: Integer; IsLineComponBool: Boolean; IsOpenedList: Boolean; CompTypeSysName: String; IsReadOnly: Boolean; MTPropCount: integer; Data: PTemplateData; ActList: TList; GrpType: Integer; SelCompon: TSCSComponent; procedure EnableDisableAct(AActList: TList; ARecordCount: Integer); var Enabl: Boolean; i: Integer; begin if (ARecordCount = 0) or (Not GSCSIni.NB.IsAdministration) or (GFormMode <> fmNormal) then Enabl := false else Enabl := true; for i := 0 to AActList.Count - 1 do TAction(AActList.Items[i]).Enabled := Enabl; AActList.Clear; end; begin try IsStandart := false; IDCompon := 0; SelCompon := nil; CanWriteNB := false; CanMakeTemplate := false; CanEditTemplate := false; CanDuplicate := false; CanSendModelToProject := false; IsLineCompon := ctNone; IsLineComponBool := false; CompTypeSysName := ''; MTPropCount := 0; IsReadOnly := false; IsOpenedList := CheckIsOpenListBeforeOperation(true, false); GrpType := GetTemplateGrpType; CanWriteNB := CheckWriteNB(false); CanMakeTemplate := CanWriteNB; if (FlvTemplate <> nil) and (FlvTemplate.Selected <> nil) and (FlvTemplate.Selected.Data <> nil) then begin Data := FlvTemplate.Selected.Data; IsStandart := IntToBool(Data.IsStandart); {$IF NOT Defined (FINAL_SCS) or Defined(BASEADM_SCS)} IsStandart := false; {$IFEND} IDCompon := Data.IDComponent; IsLineCompon := Data.IsLine; IsLineComponBool := IntToBool(Data.IsLine); CompTypeSysName := Data.CompTypeSysName; SelCompon := GSCSBase.SCSComponent; Act_MasterCableCanalTracing.Caption := GetMasterTracingCaption(Data.CompTypeSysName); if CanWriteNB then begin CanDuplicate := true; if Not IsStandart then begin if DM.MemTable_Property.Active then MTPropCount := DM.MemTable_Property.RecordCount; end; end; end; CanEditTemplate := CanWriteNB and Not IsStandart and (IDCompon <> 0); {$IF Defined (FINAL_SCS)} // Если только арх-й режим, или панель с арх объектами, то все только для чтения IsReadOnly := GUseArhOnlyMode or IsGraphModTemplate(GrpType); //19.09.2011 (GrpType = tgtArh); {$IFEND} //IsReadOnly := GUseArhOnlyMode or (GrpType = tgtArh); if IsReadOnly then begin CanMakeTemplate := false; CanEditTemplate := false; CanDuplicate := false; end; ActList := TList.Create; Act_MakeTemplate.Enabled := CanMakeTemplate; Act_MakeTemplate.Visible := Not IsReadOnly; Act_EditTemplate.Enabled := CanEditTemplate; Act_EditTemplate.Visible := Not IsReadOnly; Act_DelTemplate.Enabled := CanEditTemplate; Act_DelTemplate.Visible := Not IsReadOnly; Act_DuplicateTemplate.Enabled := CanMakeTemplate; Act_DuplicateTemplate.Visible := Not IsReadOnly; if GrpType = tgtArh then begin Act_DrawBasement.Enabled := True; Act_DrawBasement.Visible := True; end else begin Act_DrawBasement.Enabled := False; Act_DrawBasement.Visible := False; end; Act_DrawModeRect.Visible := IsGraphModTemplate(GrpType); //19.09.2011 (GrpType in [tgtArh, tgtRoof]); //Act_DrawModeRect.Enabled := Assigned(SelCompon) and IsArchRoomComponByIsLine(SelCompon.IsLine); Act_DrawModePoly.Visible := Act_DrawModeRect.Visible; //Act_DrawModePoly.Enabled := Act_DrawModeRect.Enabled; //04.07.2012 Act_DrawBasement.Visible := GrpType = tgtArh; //IsGraphModTemplate(GrpType); //19.09.2011 GrpType = tgtArh; //Act_DrawModeRect.Visible; Act_DrawBasement.Visible := false; //FlvTemplate.OnSelectItem := nil; //try // FlvTemplate.ReadOnly := Not Act_EditTemplate.Enabled; //finally // FlvTemplate.OnSelectItem := lvTemplatesSelectItem; //end; FIsReadOnlyLVTemplates := Not Act_EditTemplate.Enabled; Act_DuplicateTemplate.Enabled := CanDuplicate; Act_DuplicateTemplate.Visible := Not IsReadOnly; Act_SendModelToProject.Enabled := IsLineCompon = ctArhRoof; Act_SendModelToProject.Visible := Act_SendModelToProject.Enabled; Act_AutoTraceCable.Visible := IsLineComponBool and (Not CheckSysNameIsCableChannel(CompTypeSysName)) and IsOpenedList; Act_TraceLineComponlBySelectedLines.Visible := IsOpenedList; //18.03.2011 IsLineCompon and IsOpenedList; Act_MasterCableCanalTracing.Visible := IsLineComponBool and IsOpenedList; //*** Если нет Свойств в списке Act_AddProperty.Enabled := Act_EditTemplate.Enabled; ActList.Add(Act_EditProperty); ActList.Add(Act_RemoveProperty); EnableDisableAct(ActList, MTPropCount); //cbTemplates.Visible := Not IsReadOnly; cbTemplates.Visible := GFormMode = fmNormal; if IsGraphModTemplate(GrpType) then Act_TraceLineComponlBySelectedLines.Visible := False; ActList.Free; except on E: Exception do AddExceptionToLogExt(ClassName, 'EnableEditDelTemplate', E.Message); end; end; procedure TF_MAIN.EnableEditDelComponGroup; var IsLoadCompon: Boolean; IsLineCompon: ShortInt; IsCableChannel: Boolean; IsOpenedList: Boolean; begin Act_DelTree.Enabled := false; Act_EditingNode.Enabled := false; Act_EditTree.Enabled := false; Act_CutDir.Enabled := false; Act_MoveUP.Enabled := false; Act_MoveDOWN.Enabled := false; Act_PasteDir.Enabled := false; Act_ClearCopyBuf.Enabled := false; Act_AddCompRelation.Enabled := false; Act_AddProperty.Enabled := false; Act_AddInterface.Enabled := false; Act_AddPort.Enabled := false; Act_AddCrossConnection.Enabled := false; Act_AddCableChannelElement.Enabled := false; //Tolik 13/11/2021 -- Act_AddTubeElement.Enabled := false; // Act_MakeNorm.Enabled := false; Act_MakeResource.Enabled := false; Act_MakeResourceCompon.Enabled := false; Act_MakeComponent.Enabled := false; Act_MakeDir.Enabled := false; Act_ApplyComponForProjResources.Enabled := false; Act_ApplyComponForListResources.Enabled := false; Act_AutoSetGraphicObjects.Enabled := false; Act_IndexingComponPrice.Enabled := false; Act_ChangeComponArtProducerByTemplate.Enabled := false; Act_MasterCompl.Enabled := false; Act_TraceLineComponlBySelectedLines.Enabled := false; Act_LoadNBNodeFromFile.Enabled := false; Act_DelComponent.Enabled := false; Act_EditComponent.Enabled := false; Act_EditInterface.Enabled := false; Act_DelInterface.Enabled := false; Act_EditPort.Enabled := false; Act_DelPort.Enabled := false; Act_DelCompRelation.Enabled := false; Act_EditCompRelation.Enabled := false; Act_EditProperty.Enabled := false; Act_RemoveProperty.Enabled := false; Act_DelConnection.Enabled := false; Act_EditCableChannelElement.Enabled := false; Act_DelCableChannelElement.Enabled := false; Act_EditNormResource.Enabled := false; Act_DelNormResource.Enabled := false; Act_EditCrossConnection.Enabled := false; Act_DelCrossConnection.Enabled := false; IsOpenedList := CheckIsOpenListBeforeOperation(true, false); IsLoadCompon := false; IsLineCompon := biFalse; IsCableChannel := false; if GSCSBase <> nil then if GSCSBase.SCSComponent <> nil then if GSCSBase.SCSComponent.ID <> 0 then begin IsLoadCompon := true; IsLineCompon := GSCSBase.SCSComponent.IsLine; IsCableChannel := CheckSysNameIsCableChannel(GSCSBase.SCSComponent.ComponentType.SysName); Act_MasterCableCanalTracing.Caption := GetMasterTracingCaption(GSCSBase.SCSComponent.ComponentType.SysName); end; Act_TurnToComponFromGroups.Enabled := IsLoadCompon; Act_AutoTraceCable.Visible := (IsLineCompon = biTrue) and (Not IsCableChannel) and (GFormMode = fmNormal) and IsOpenedList; Act_TraceLineComponlBySelectedLines.Visible := (GFormMode = fmNormal) and IsOpenedList; //18.03.2011 (IsLineCompon = biTrue) and (GFormMode = fmNormal) and IsOpenedList; Act_MasterCableCanalTracing.Visible := (IsLineCompon = biTrue) and (GFormMode = fmNormal) and IsOpenedList; end; procedure TF_MAIN.HideTemplateControls; var i: Integer; begin //tsTemplates.TabVisible := false; //tsComponents.TabVisible := false; for i := 0 to pcObjects.PageCount - 1 do pcObjects.Pages[i].TabVisible := false; //SetpcObjectsTab(tsComponents.TabIndex); //pcObjects.ActivePage := tsComponents; SetpcObjectsTab(tsComponents.PageIndex); // На FormCreate tsComponents.TabIndex = -1 pcObjects.ShowCardFrame := false; pcObjects.ShowFullFrame := false; end; //Tolik 13/06/2022 -- { procedure TF_MAIN.HideTemplateEditingControls; begin cbTemplates.Visible := false; FlvTemplate.DragMode := dmManual; //FlvTemplate.ReadOnly := true; FIsReadOnlyLVTemplates := true; FlvTemplate.OnContextPopup := nil; FlvTemplate.OnDblClick := nil; //FlvTemplate.OnItemContextMenu := nil; //FlvTemplate.OnSelectItem := nil; FlvTemplate.OnKeyDown := nil; FlvTemplate.OnMouseDown := nil; //FlvTemplate.OnMouseUp := nil; FlvTemplate.OnStartDrag := nil; end; } procedure TF_MAIN.HideTemplateEditingControls; begin cbTemplates.Visible := false; FIsReadOnlyLVTemplates := true; if FlvTemplate <> nil then //Tolik 13/06/2022 -- begin FlvTemplate.DragMode := dmManual; //FlvTemplate.ReadOnly := true; FIsReadOnlyLVTemplates := true; FlvTemplate.OnContextPopup := nil; FlvTemplate.OnDblClick := nil; //FlvTemplate.OnItemContextMenu := nil; //FlvTemplate.OnSelectItem := nil; FlvTemplate.OnKeyDown := nil; FlvTemplate.OnMouseDown := nil; //FlvTemplate.OnMouseUp := nil; FlvTemplate.OnStartDrag := nil; end; end; procedure TF_MAIN.HideTemplateItems(AExcludedCompType: TStringList; AExcludeWithSysNames: Boolean); var ItemData: PTemplateData; i, j: integer; ExcludedCompType: TStringList; Spravochnik: TSpravochnik; SprExcludeComponentType: TNBComponentType; SprComponentType: TNBComponentType; begin try if AExcludedCompType <> nil then begin {ExcludedCompType := TStringList.Create; if Not AExcludeWithSysNames then begin ExcludedCompType.Assign(AExcludedCompType); if Not ExcludedCompType.Sorted then ExcludedCompType.Sort; end else begin Spravochnik := GetSpravochnik; if Spravochnik <> nil then begin ExcludedCompType.Sorted := true; for i := 0 to AExcludedCompType.Count - 1 do begin SprExcludeComponentType := Spravochnik.GetComponentTypeByGUID(AExcludedCompType[i]); // Закидываем в список другие типы с таким же SysName for j := 0 to Spravochnik.ComponentTypes.Count - 1 do begin SprComponentType := TNBComponentType(Spravochnik.ComponentTypes[j]); if SprComponentType.ComponentType.SysName = SprExcludeComponentType.ComponentType.SysName then if ExcludedCompType.IndexOf(SprComponentType.ComponentType.GUID) = -1 then begin ExcludedCompType.Add(SprComponentType.ComponentType.GUID); end; end; end; end; end; } ExcludedCompType := AExcludedCompType; i := 0; if FlvTemplate <> nil then begin while i <= FlvTemplate.Items.Count - 1 do begin ItemData := FlvTemplate.Items[i].Data; if ExcludedCompType.IndexOf(ItemData.CompTypeSysName) = -1 then begin FreeMem(ItemData); FlvTemplate.Items[i].Data := nil; FlvTemplate.Items[i].Delete; end else i := i + 1; end; //FreeAndNil(ExcludedCompType); end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'TF_MAIN.HideTemplateItems', E.Message); end; end; function TF_MAIN.GetSelectedObjectData(var AObjID, AObjItemType: Integer): PObjectData; begin Result := nil; AObjID := -1; AObjItemType := -1; if pcObjects.ActivePage = tsTemplates then begin AObjID := GSCSBase.SCSComponent.ID; AObjItemType := GSCSBase.SCSComponent.GetItemType; end else if pcObjects.ActivePage = tsComponents then begin Result := Tree_Catalog.Selected.Data; AObjID := Result.ObjectID; AObjItemType := Result.ItemType; end; end; function TF_MAIN.GetTemplateItemByComponID(AListView: TRZListView; AIDCompon: Integer): TListItem; var ListItem: TListItem; ItemData: PTemplateData; i: Integer; begin Result := nil; for i := 0 to AListView.Items.Count - 1 do begin ListItem := AListView.Items[i]; ItemData := ListItem.Data; if ItemData.IDComponent = AIDCompon then begin Result := ListItem; Break; //// BREAK //// end; end; end; function TF_MAIN.GetTemplateGrpByID(AID: Integer): TTemplateGrpData; var i: Integer; Group: TRzGroup; TemplateGrpData: TTemplateGrpData; begin Result := nil; for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; TemplateGrpData := TTemplateGrpData(Group.Tag); if TemplateGrpData.FID = AID then begin Result := TemplateGrpData; Break; //// BREAK //// end; end; end; function TF_MAIN.GetTemplateGrpByType(AType: Integer): TTemplateGrpData; var i: Integer; Group: TRzGroup; TemplateGrpData: TTemplateGrpData; begin Result := nil; for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; TemplateGrpData := TTemplateGrpData(Group.Tag); if TemplateGrpData.FType = AType then begin Result := TemplateGrpData; Break; //// BREAK //// end; end; end; function TF_MAIN.GetTemplateGrpType: Integer; begin Result := 0; if FTemplateGrp <> nil then Result := FTemplateGrp.FType; end; procedure TF_MAIN.InitComponGroup(const ASelectedComponGrp: String); var i: Integer; SortedObjects: TStringList; SprProperty: TNBProperty; //SprCompType: TNBComponentType; GroupBlockCondition: TFilterBlock; procedure AddGroupFieldValueToList(AIsComponTable: Boolean; const AFieldName, ACaption: string); var GroupFieldValue: TFilterField; TableName: String; begin TableName := ''; if AIsComponTable then TableName := tnComponent else TableName := tnCompPropRelation; GroupFieldValue := TFilterField.Create; GroupFieldValue.FieldName := TableName + snPoint + AFieldName; GroupFieldValue.FieldIndex := 0; GroupFieldValue.FieldCaption := ACaption; //FGroupFieldValues.Add(GroupFieldValue); SortedObjects.AddObject(ACaption, GroupFieldValue); end; begin if FGroupFilterBlock = nil then FGroupFilterBlock := TFilterBlock.Create(nil, btBlock); if FGroupFieldValues = nil then begin FGroupFieldValues := TObjectList.Create(true); SortedObjects := CreateStringListSorted; AddGroupFieldValueToList(true, fnIDProducer, cNameProducerB); AddGroupFieldValueToList(true, fnIDNetType, cNameNetTypeB); AddGroupFieldValueToList(true, fnIDSuppliesKind, cNameSuppliesKindB); if FNormBase <> nil then for i := 0 to FNormBase.GSCSBase.NBSpravochnik.Properties.Count - 1 do begin SprProperty := TNBProperty(FNormBase.GSCSBase.NBSpravochnik.Properties[i]); if (SprProperty.PropertyData.ISComponLine = biTrue) or (SprProperty.PropertyData.ISComponConn = biTrue) then if (SprProperty.PropertyData.IDDataType <> dtColor) and (SprProperty.PropertyData.IDDataType <> dtBlob) then if SprProperty.PropertyData.SysName <> '' then AddGroupFieldValueToList(false, SprProperty.PropertyData.SysName, SprProperty.PropertyData.Name); end; // Отсортированные объекты кидаем в общий список for i := 0 to SortedObjects.Count - 1 do FGroupFieldValues.Add(SortedObjects.Objects[i]); FreeAndNil(SortedObjects); end; // Если файл с настройками групп не существует, создаем его с настройками для кабеля и канала if Not FileExists(GetPathToNBComponGroups) then begin // Для кабеля // Производитель GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.Condition.FieldName := tnComponent+'.'+fnIDProducer; // Внешнее сечение GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+pnOutSection; SaveTypeComponGroups(ctsnCable, FGroupFilterBlock); FGroupFilterBlock.Clear; // Для каб канала // Производитель GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.Condition.FieldName := tnComponent+'.'+fnIDProducer; // Внутреннее сечение GroupBlockCondition := TFilterBlock.Create(FGroupFilterBlock, btCondition); GroupBlockCondition.ConditionType := ctAnd; GroupBlockCondition.Condition.FieldName := tnCompPropRelation+'.'+pnInSection; SaveTypeComponGroups(ctsnCableChannel, FGroupFilterBlock); SetSelectedComponGroups(ctsnCable); end; SetComponGroupsToForm(ASelectedComponGrp); end; procedure TF_MAIN.LoadDataToComponGroup(AGroupNode: TFlyNode); var CanAddGroupBlockToList: Boolean; ActiveGroupBlocks: TFilterBlocks; NodeListHierarchy: TList; ParentNode: TFlyNode; NewChildNode: TFlyNode; NewComponGrpData: TComponGrpData; CurrGroupFilterBlock: TFilterBlock; CurrGroupFilterBlockIsProp: Boolean; GroupFilterBlockDefined: TFilterBlock; GroupFilterBlockToDef: TFilterBlock; NewGroupedFilterBlock: TFilterBlock; TableName: string; FieldName: string; ValueTableName: string; ValueFieldName: string; PropSysName: string; NBProperty: TNBProperty; NBComponentType: TNBComponentType; //PropDoubleVal: Double; SQLSelect: string; SQLTableName: String; SQLWhere: string; SQLWhereLocal: string; SQLWhereToAdd: string; SQLComponWithCompPropRel: Boolean; SQLComponInSQLWhere: Boolean; SQLComponPropRelInSQLWhere: Boolean; FieldNames: TStringList; IDList: TIntList; CompTypeSysName: string; SkipTemplates: Boolean; i: integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // function GetNewGroupNode(const ACaption: String): TFlyNode; begin Result := nil; if AGroupNode <> nil then Result := tvComponGroups.Items.AddChild(AGroupNode, ACaption) else Result := tvComponGroups.Items.Add(nil, ACaption); end; function GetValueTableNameByDirFieldName(const ADirFieldName: string): string; begin Result := ''; if ADirFieldName = fnIDProducer then Result := tnProducers else if ADirFieldName = fnIDNetType then Result := tnNetType else if ADirFieldName = fnIDSuppliesKind then Result := tnSuppliesKinds; end; function GetValueFieldNameByDirFieldName(const ADirFieldName: string): string; begin Result := ''; if (ADirFieldName = fnIDProducer) or (ADirFieldName = fnIDNetType) or (ADirFieldName = fnIDSuppliesKind) then Result := fnName; end; begin try Screen.Cursor := crHourGlass; try SkipTemplates := true; if AGroupNode = nil then ClearTreeViewFly(tvComponGroups, true, false, true); if FGroupFilterBlock <> nil then begin NodeListHierarchy := TList.Create; // Определяем список парентов ParentNode := AGroupNode; while ParentNode <> nil do begin NodeListHierarchy.Insert(0, ParentNode); ParentNode := ParentNode.Parent; end; // Определяем включенные елементы ActiveGroupBlocks := TFilterBlocks.Create(false); for i := 0 to FGroupFilterBlock.ChildBlocks.Count - 1 do begin GroupFilterBlockToDef := FGroupFilterBlock.ChildBlocks[i]; if GroupFilterBlockToDef.IsOn then begin CanAddGroupBlockToList := true; // Если это свойство из таблицы свойств, то проверяем сцществует ли оно TableName := GetTableNameFromTableFieldStr(GroupFilterBlockToDef.Condition.FieldName); FieldName := GetFieldNameFromTableFieldStr(GroupFilterBlockToDef.Condition.FieldName); if TableName = tnCompPropRelation then begin NBProperty := FNormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(FieldName); if NBProperty = nil then CanAddGroupBlockToList := false; end; if CanAddGroupBlockToList then ActiveGroupBlocks.Add(GroupFilterBlockToDef); end; end; if ActiveGroupBlocks.Count > 0 then begin SQLWhere := ''; NewChildNode := nil; CurrGroupFilterBlock := nil; CurrGroupFilterBlockIsProp := false; SQLComponWithCompPropRel := false; SQLComponInSQLWhere := false; SQLComponPropRelInSQLWhere := false; // По уровню AGroupNode получаем следующие условие для группировки if NodeListHierarchy.Count <= ActiveGroupBlocks.Count - 1 then CurrGroupFilterBlock := TFilterBlock(ActiveGroupBlocks[NodeListHierarchy.Count]); // Фильтр с подгруженными группами for i := 0 to NodeListHierarchy.Count - 1 do begin ParentNode := TFlyNode(NodeListHierarchy[i]); if ParentNode.Data <> nil then begin GroupFilterBlockDefined := TComponGrpData(ParentNode.Data).FFilterBlock; TableName := GetTableNameFromTableFieldStr(GroupFilterBlockDefined.Condition.FieldName); FieldName := GetFieldNameFromTableFieldStr(GroupFilterBlockDefined.Condition.FieldName); if GroupFilterBlockDefined = CurrGroupFilterBlock then if TableName = tnCompPropRelation then CurrGroupFilterBlockIsProp := true; SQLWhereLocal := ''; if TableName = tnComponent then begin SQLComponInSQLWhere := true; SQLWhereToAdd := '('+TableName+'.'+FieldName+' = '+GroupFilterBlockDefined.Condition.FieldValue+') '; if GroupFilterBlockDefined.Condition.FieldValue = '0' then SQLWhereToAdd := '('+SQLWhereToAdd + ' or ('+TableName+'.'+FieldName+' is null)'+') '; SQLWhereLocal := SQLWhereLocal + SQLWhereToAdd; end else if TableName = tnCompPropRelation then begin PropSysName := FieldName; NBProperty := FNormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(PropSysName); if NBProperty <> nil then begin SQLComponPropRelInSQLWhere := true; // Текущий блок отвечает за компонент SQLWhereLocal := SQLWhereLocal + '('+tnCompPropRelation+'.'+fnIDProperty+' = '+IntToStr(NBProperty.PropertyData.ID)+') AND '+ '('+tnCompPropRelation+'.'+fnPValue+' = '''+GroupFilterBlockDefined.Condition.FieldValue+''') '; end; end; if (SQLWhere <> '') and (SQLWhereLocal <> '') then SQLWhere := SQLWhere + ' AND '; SQLWhere := SQLWhere + SQLWhereLocal; end; end; // По уровню AGroupNode получаем следующие условие для группировки if CurrGroupFilterBlock <> nil then begin // Фильтр с неподгруженными группами for i := NodeListHierarchy.Count to ActiveGroupBlocks.Count - 1 do begin GroupFilterBlockToDef := ActiveGroupBlocks[i]; TableName := GetTableNameFromTableFieldStr(GroupFilterBlockToDef.Condition.FieldName); FieldName := GetFieldNameFromTableFieldStr(GroupFilterBlockToDef.Condition.FieldName); if GroupFilterBlockToDef = CurrGroupFilterBlock then if TableName = tnCompPropRelation then CurrGroupFilterBlockIsProp := true; SQLWhereLocal := ''; if TableName = tnComponent then begin if Not CurrGroupFilterBlockIsProp then SQLComponInSQLWhere := true; end else if TableName = tnCompPropRelation then begin PropSysName := FieldName; NBProperty := FNormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(PropSysName); if NBProperty <> nil then begin SQLComponPropRelInSQLWhere := true; SQLWhereLocal := SQLWhereLocal + '('+tnCompPropRelation+'.'+fnIDProperty+' = '+IntToStr(NBProperty.PropertyData.ID)+')'; end; end; if (SQLWhere <> '') and (SQLWhereLocal <> '') then SQLWhere := SQLWhere + ' AND '; SQLWhere := SQLWhere + SQLWhereLocal; end; end; // добавляем в условие типы компонентов по текущему выбранному CompTypeSysName := GetGUIDFromComboBoxRz(cbGroupCompType); if CompTypeSysName <> '' then begin SQLWhereLocal := ''; for i := 0 to FNormBase.GSCSBase.NBSpravochnik.ComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNormBase.GSCSBase.NBSpravochnik.ComponentTypes[i]); if NBComponentType.ComponentType.SysName = CompTypeSysName then begin if SQLWhereLocal <> '' then SQLWhereLocal := SQLWhereLocal + ','; SQLWhereLocal := SQLWhereLocal + IntToStr(NBComponentType.ComponentType.ID); end; end; if SQLWhereLocal <> '' then begin SQLComponInSQLWhere := true; SQLWhereLocal := '('+tnComponent +snPoint+ fnIDComponentType +' IN ('+SQLWhereLocal+'))'; if SQLWhere <> '' then SQLWhere := ' AND '+SQLWhere; SQLWhere := SQLWhereLocal + SQLWhere; end; end; // Отфильтровуем шаблоны if SkipTemplates then begin SQLComponInSQLWhere := true; if SQLWhere <> '' then SQLWhere := SQLWhere + ' AND '; SQLWhere := SQLWhere + '(('+tnComponent +snPoint+ fnIsTemplate +' = '''+IntToStr(biFalse)+''') or '+ '('+tnComponent +snPoint+ fnIsTemplate +' is null))'; end; if SQLWhere <> '' then begin if SQLComponInSQLWhere and SQLComponPropRelInSQLWhere then SQLWhere := '(COMPONENT.ID = COMP_PROP_RELATION.ID_COMPONENT) AND ('+SQLWhere+')'; end; SQLSelect := ''; if CurrGroupFilterBlock <> nil then begin SQLWhere := ' WHERE ' + SQLWhere; TableName := GetTableNameFromTableFieldStr(CurrGroupFilterBlock.Condition.FieldName); FieldName := GetFieldNameFromTableFieldStr(CurrGroupFilterBlock.Condition.FieldName); //ValueTableName := GetTableNameFromTableFieldStr(CurrGroupFilterBlock.Condition.FieldValue); //ValueFieldName := GetFieldNameFromTableFieldStr(CurrGroupFilterBlock.Condition.FieldValue); ValueTableName := GetValueTableNameByDirFieldName(FieldName); ValueFieldName := GetValueFieldNameByDirFieldName(FieldName); if TableName = tnComponent then begin // Вычитываем поле с таблицы компонентов SQLSelect := 'select '+FieldName+' from '+TableName; if SQLComponPropRelInSQLWhere then SQLSelect := SQLSelect +snCommaS+ tnCompPropRelation+' '; SQLSelect := SQLSelect +' '+ SQLWhere +' group by '+ FieldName; SetSQLToFIBQuery(DM.Query_Select, SQLSelect); if (ValueTableName <> '') and (ValueFieldName <> '') then SetSQLToFIBQuery(DM.Query, GetSQLByParams(qtSelect, ValueTableName, fnID+' =:'+fnID, nil, fnName), false); tvComponGroups.Items.BeginUpdate; try while Not DM.Query_Select.Eof do begin NewChildNode := tvComponGroups.Items.AddChild(AGroupNode, ''); NewComponGrpData := TComponGrpData.Create; NewComponGrpData.FFilterBlock := TFilterBlock.Create(nil, btCondition); NewComponGrpData.FFilterBlock.Condition.FieldName := CurrGroupFilterBlock.Condition.FieldName; NewChildNode.Data := NewComponGrpData; if (DM.Query_Select.Fields[0].Value <> null) and (DM.Query_Select.Fields[0].Value <> 0) then begin NewComponGrpData.FFilterBlock.Condition.FieldValue := DM.Query_Select.Fields[0].Value; if (ValueTableName <> '') and (ValueFieldName <> '') then begin DM.Query.Close; DM.Query.Params[0].Value := DM.Query_Select.Fields[0].Value; DM.Query.ExecQuery; if DM.Query.RecordCount > 0 then NewChildNode.Caption := DM.Query.Fields[0].Value; end else NewChildNode.Caption := DM.Query_Select.Fields[0].Value; end else begin NewComponGrpData.FFilterBlock.Condition.FieldValue := '0'; NewChildNode.Caption := cNameEmptyBr; //' '+cNoDefined; end; NewChildNode.HasChildren := true; DM.Query_Select.Next; end; finally tvComponGroups.Items.EndUpdate; end; DM.Query.Close; DM.Query_Select.Close; //tvComponGroups.SortType := stText; end else if TableName = tnCompPropRelation then begin PropSysName := FieldName; SQLSelect := 'select '+fnIDProperty + snCommaS + fnPValue+' from '+TableName; if SQLComponInSQLWhere then SQLSelect := SQLSelect +snCommaS+ tnComponent; SQLSelect := SQLSelect +' '+SQLWhere +' group by '+ fnIDProperty + snCommaS + fnPValue; SetSQLToFIBQuery(DM.Query_Select, SQLSelect); tvComponGroups.Items.BeginUpdate; try while Not DM.Query_Select.Eof do begin NewChildNode := tvComponGroups.Items.AddChild(AGroupNode, ''); NewComponGrpData := TComponGrpData.Create; NewComponGrpData.FFilterBlock := TFilterBlock.Create(nil, btCondition); NewComponGrpData.FFilterBlock.Condition.FieldName := CurrGroupFilterBlock.Condition.FieldName; NewComponGrpData.FFilterBlock.Condition.FieldValue := DM.Query_Select.Fields[1].AsString; NewChildNode.Data := NewComponGrpData; NBProperty := FNormBase.GSCSBase.NBSpravochnik.GetPropertyByID(DM.Query_Select.Fields[0].AsInteger); if NBProperty <> nil then NewComponGrpData.PropDataType := NBProperty.PropertyData.IDDataType; NewComponGrpData.PropValue := DM.Query_Select.Fields[1].AsString; //if (NBProperty <> nil) and // ((NBProperty.PropertyData.IDDataType = dtFloat) or (NBProperty.PropertyData.IDDataType = dtInteger)) then //begin // PropDoubleVal := StrToFloatDef_My(DM.Query_Select.Fields[1].AsString, 0); // PropValueInUOM(PropDoubleVal, PropSysName, umMetr, FUOM); // NewChildNode.Caption := FloatToStr(RoundCP(PropDoubleVal)); //end //else //if NBProperty.PropertyData.IDDataType = dtDate then // NewChildNode.Caption := DateToStr(StrToDateU(DM.Query_Select.Fields[1].AsString)) //else //if NBProperty.PropertyData.IDDataType = dtCompStateType then // NewChildNode.Caption := GetCompStateTypeName(StrToInt(DM.Query_Select.Fields[1].AsString)) //else //if NBProperty.PropertyData.IDDataType = dtCableCanalElementType then // NewChildNode.Caption := GetCableChannelElementName(StrToInt(DM.Query_Select.Fields[1].AsString)) //else //if NBProperty.PropertyData.IDDataType = dtBoolean then // NewChildNode.Caption := BoolToStrL(IntToBool(StrToInt(DM.Query_Select.Fields[1].AsString))) //else //if NBProperty.PropertyData.IDDataType = dtConnectionKind then // NewChildNode.Caption := GetTubeConnectKindName(StrToInt(DM.Query_Select.Fields[1].AsString)) //else // NewChildNode.Caption := DM.Query_Select.Fields[1].AsString; // //if (NBProperty <> nil) {and (NBProperty.PropertyData.Izm <> '')} then // NewChildNode.Caption := NewChildNode.Caption + ' '+ GetNameUOMForProperty(NBProperty.PropertyData.Izm, PropSysName, FUOM); if NBProperty <> nil then NewChildNode.Caption := PropValueToCaption(DM.Query_Select.Fields[1].AsString, PropSysName, NBProperty.PropertyData.Izm, NBProperty.PropertyData.IDDataType, FUOM, true); NewChildNode.HasChildren := true; DM.Query_Select.Next; end; finally tvComponGroups.Items.EndUpdate; end; end; end else if SQLWhere <> '' then begin // Отбираем сами компоненты FieldNames := TStringList.Create; FieldNames.Add(tnComponent +snPoint+ fnID); FieldNames.Add(tnComponent +snPoint+ fnIsLine); FieldNames.Add(tnComponent +snPoint+ fnName); SQLTableName := tnComponent; if SQLComponPropRelInSQLWhere then SQLTableName := SQLTableName +snCommaS+ tnCompPropRelation; SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, SQLTableName, SQLWhere, FieldNames, ''), false); //DM.Query_Select.SQL.Text := DM.Query_Select.SQL.Text + ' order by '+ fnName; DM.Query_Select.ExecQuery; IDList := TIntList.Create; tvComponGroups.Items.BeginUpdate; try OldTick := GetTickCount; while Not DM.Query_Select.Eof do begin NewChildNode := tvComponGroups.Items.AddChild(AGroupNode, ''); NewChildNode.Caption := DM.Query_Select.Fields[2].AsString; NewComponGrpData := TComponGrpData.Create; NewData(NewComponGrpData.FComponData, ttComponents); NewComponGrpData.FComponData.ObjectID := DM.Query_Select.Fields[0].AsInteger; NewComponGrpData.FComponData.ItemType := GetItemTypeByIsLine(DM.Query_Select.Fields[1].AsInteger); NewChildNode.Data := NewComponGrpData; // IsLine if NewComponGrpData.FComponData.ItemType = itComponCon then NewChildNode.ImageIndex := tciiComponCon else NewChildNode.ImageIndex := tciiComponLine; NewChildNode.SelectedIndex := NewChildNode.ImageIndex; DM.Query_Select.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; finally tvComponGroups.Items.EndUpdate; end; FreeAndNil(IDList); FreeAndNil(FieldNames); end; if NewChildNode <> nil then begin if AGroupNode = nil then begin //tvComponGroups.SortType := stText; tvComponGroups.Items.BeginUpdate; try //tvComponGroups.Items.Sort(@CompareComponGroupNodes, false) //tvComponGroups.Items.CustomSort(nil, false); tvComponGroups.Items.CustomSort(CompareComponGroupNodes, false); finally tvComponGroups.Items.EndUpdate; end; end else begin AGroupNode.BeginUpdate; try AGroupNode.CustomSort(CompareComponGroupNodes, false); finally AGroupNode.EndUpdate; end; end; end; end; FModsCountBeforeShowGroup := DM.FModifiedsCount; FreeAndNil(ActiveGroupBlocks); FreeAndNil(NodeListHierarchy); end; finally Screen.Cursor := crDefault; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'LoadDataToComponGroup', E.Message); end; end; procedure TF_MAIN.LoadSelectedComponGroups(AGroupFilterBlock: TFilterBlock); begin LoadTypeComponGroups(GetSelectedComponGroups, AGroupFilterBlock); end; procedure TF_MAIN.LoadTypeComponGroups(const ACompTypeSysName: string; AGroupFilterBlock: TFilterBlock); begin AGroupFilterBlock.Clear; AGroupFilterBlock.LoadFromStr( ReadSettingMemIni( GetPathToNBComponGroups, dtString, scCompTypeGroups, ACompTypeSysName, ctsnCable), FGroupFieldValues, false); end; procedure TF_MAIN.LoadTemplatesToListView(AGroupType: Integer; AListView: TRZListView); var SCSComponents: TSCSComponents; i: Integer; begin try ClearListViewRz(AListView); SCSComponents := DM.GetTemplateComponents(AGroupType, fnSortID); for i := 0 to SCSComponents.Count - 1 do begin AddTemplateItem(AListView, SCSComponents[i]); end; FreeAndNil(SCSComponents); except on E: Exception do AddExceptionToLogExt(ClassName, 'TF_MAIN.LoadTemplatesToListView', E.Message); end; end; procedure TF_MAIN.LoadTemplateGroups; var i: Integer; Group: TRzGroup; TemplateGrpData: TTemplateGrpData; ListView: TRzListView; CanShowGroup: Boolean; begin try FTemplateGrp := nil; FlvTemplate := nil; //// Очищаем группы //for i := gbTemplateGroups.GroupCount - 1 downto 0 do //begin // gbTemplateGroups.RemoveGroup(gbTemplateGroups.Groups[i]); //end; ClearTemplateGroups; gbTemplateGroups.Align :=alClient; gbTemplateGroups.Style := gbsOutlook; SetSQLToFIBQuery(DM.Query_Select, 'select id, guid, name, ttype from '+tnTemplateGroups+' order by sort_id'); //GUseSCSFunc while Not DM.Query_Select.Eof do begin CanShowGroup := true; // Если это форма не на основном окне, а для выбора компонентов, то оставляем только компоненты //Tolik 21/02/2022 -- нужно показать все, кроме крыш (3), крыши будут в строительном калькуляторе { if (GFormMode <> fmNormal) and (DM.Query_Select.FN(fnTType).AsInteger <> tgtVirtualCompon) then CanShowGroup := false; } if (GFormMode <> fmNormal) and (DM.Query_Select.FN(fnTType).AsInteger <> tgtRoof) then CanShowGroup := false; // //Tolik 21/02/2022 -- архитектурные и крыши не допустить if CanShowGroup then begin {$IF not Defined(ES_GRAPH_SC)} CanShowGroup := ((DM.Query_Select.FN(fnTType).AsInteger <> tgtRoof) and (DM.Query_Select.FN(fnTType).AsInteger <> tgtArh)); {$ELSE} CanShowGroup := ((DM.Query_Select.FN(fnTType).AsInteger = tgtRoof) or (DM.Query_Select.FN(fnTType).AsInteger = tgtArh)); {$IFEND} end; // {$IF Defined(TELECOM)} //31.03.2011 Для TELECOM не отображаем виртуальные объекты //if DM.Query_Select.FN(fnTType).AsInteger = tgtVirtualCompon then // CanShowGroup := false; {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_SPA)} // Для SPA и PE не отображаем архитектурные объекты if IsGraphModTemplate(DM.Query_Select.FN(fnTType).AsInteger) then CanShowGroup := false; {$IFEND} // на вермя для любой финалки скрываем арх. объекты // Откроем когда арх. функционал не будет сыроват {$IF Defined(FINAL_SCS) AND Not Defined(ES_GRAPH_SC)} if IsGraphModTemplate(DM.Query_Select.FN(fnTType).AsInteger) then CanShowGroup := false; {$IFEND} if CanShowGroup then begin Group := TRzGroup.Create(self); //Group.Caption := DM.Query_Select.FN(fnName).AsString; case DM.Query_Select.FN(fnTType).AsInteger of tgtVirtualCompon: Group.Caption := cBaseCommon66; // Виртуальные компоненты tgtArh: Group.Caption := cBaseCommon67; // Архитектурные объекты //Tolik 21/02/2022 -- tgtElectrical: // электрика Group.Caption := cBaseCommon66_1; tgtFAS: // пожарка - Fire Alarm Systems Group.Caption := cBaseCommon66_2; tgtCCTV: // видеонаблюдение Group.Caption := cBaseCommon66_3; // else Group.Caption := DM.Query_Select.FN(fnName).AsString; end; Group.CaptionHotColor := clBlue; Group.OnOpen := TplGrpOpen; TemplateGrpData := TTemplateGrpData.Create; TemplateGrpData.FOwner := Group; TemplateGrpData.FID := DM.Query_Select.FN(fnID).AsInteger; TemplateGrpData.FType := DM.Query_Select.FN(fnTType).AsInteger; ListView := TRzListView.Create(self); ListView.Align := alClient; ListView.Name := 'lvTemplGrp'+IntToStr(DM.Query_Select.FN(fnID).AsInteger); ListView.ColumnClick := false; ListView.DragMode := dmAutomatic; ListView.FullDrag := true; ListView.HideSelection := false; ListView.ShowColumnHeaders := false; ListView.Parent := Group; ListView.LargeImages := ilTemplateIcons; ListView.OnClick := lvTemplatesClick; ListView.OnContextPopup := lvTemplatesContextPopup; ListView.OnDblClick := lvTemplatesDblClick; ListView.OnDragDrop := lvTemplatesDragDrop; ListView.OnDragOver := lvTemplatesDragOver; ListView.OnEdited := lvTemplatesEdited; ListView.OnEditing := lvTemplatesEditing; ListView.OnEndDrag := lvTemplatesEndDrag; ListView.OnExit := lvTemplatesExit; ListView.OnItemContextMenu := lvTemplatesItemContextMenu; ListView.OnMouseDown := lvTemplatesMouseDown; ListView.OnMouseMove := lvTemplatesMouseMove; ListView.OnMouseUp := lvTemplatesMouseUp; ListView.OnResize := lvTemplatesResize; ListView.OnSelectItem := lvTemplatesSelectItem; ListView.OnStartDrag := lvTemplatesStartDrag; TemplateGrpData.FListView := ListView; Group.Tag := Integer(TemplateGrpData); if FTemplateGrp = nil then begin FTemplateGrp := TemplateGrpData; FlvTemplate := ListView; end; gbTemplateGroups.AddGroup(Group); end; DM.Query_Select.Next; end; // Для каждой группы подгружаем шаблоны for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; TemplateGrpData := TTemplateGrpData(Group.Tag); if TemplateGrpData <> nil then LoadTemplatesToListView(TemplateGrpData.FType, TemplateGrpData.FListView); end; // Если только одна группа, то запрещаем ее скрывать if gbTemplateGroups.GroupCount = 1 then begin FTemplateGrp.FOwner.CanClose := false; end; //SetControlsByUseLiteFunctional(GLiteVersion, GUseLiteFunctional, false); except on E: Exception do AddExceptionToLogExt(ClassName, 'LoadTemplateGroups', E.Message); end; end; procedure TF_MAIN.MoveGroupProp(AMoveSteps: Integer); var Itemindex: Integer; NewItemIndex: Integer; begin Itemindex := clGroupProps.ItemIndex; if Itemindex <> -1 then begin NewItemIndex := Itemindex + AMoveSteps; if (NewItemIndex >= 0) and (NewItemIndex <= (clGroupProps.Count - 1)) then begin clGroupProps.Items.Move(ItemIndex, NewItemIndex); clGroupProps.ItemIndex := NewItemIndex; FGroupFilterBlock.ChildBlocks.Move(Itemindex, NewItemIndex); // Сохранение SaveReloadTypeComponGroups; end; end; end; procedure TF_MAIN.MoveTemplateItem(ASrc, ATrg: TListItem); var TmpPos: TPoint; TmpSortID: Integer; SrcData: PTemplateData; TrgData: PTemplateData; begin try if (ASrc <> nil) and (ATrg <> nil) then begin TmpPos := ASrc.Position; ASrc.Position := ATrg.Position; ATrg.Position := TmpPos; SrcData := ASrc.Data; TrgData := ATrg.Data; TmpSortID := SrcData.SortID; SrcData.SortID := TrgData.SortID; TrgData.SortID := TmpSortID; DM.UpdateIntTableFieldByID(tnComponent, fnSortID, SrcData.IDComponent, SrcData.SortID, qmPhisical); DM.UpdateIntTableFieldByID(tnComponent, fnSortID, TrgData.IDComponent, TrgData.SortID, qmPhisical); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'MoveTemplateItem', E.Message); end; end; procedure TF_MAIN.PostGridTableView(AGridDBTableView: TcxCustomGridTableView; ADataSet: TDataSet); begin FTimerPostGrid := AGridDBTableView; FTimerPostDataSet := ADataSet; if (AGridDBTableView.DataController.IsEditing) and (ADataSet.State <> dsBrowse) then EnableTimerWithOrder(Timer_PostGridTableView, true, true); end; procedure TF_MAIN.SaveReloadTypeComponGroups; begin SaveTypeComponGroups(GetSelectedComponGroups, FGroupFilterBlock); LoadDataToComponGroup(nil); end; procedure TF_MAIN.SaveTypeComponGroups(const ACompTypeSysName: string; AGroupFilterBlock: TFilterBlock); var ConfFileName: String; begin try ConfFileName := GetPathToNBComponGroups; WriteSettingMemIni(ConfFileName, dtString, scCompTypeGroups, ACompTypeSysName, AGroupFilterBlock.GetFilterAsString(false)); except on E: Exception do AddExceptionToLogExt(ClassName, 'SaveTypeComponGroups', E.Message); end; end; procedure TF_MAIN.OpenTemplateGroup; begin end; procedure TF_MAIN.ReindexComponsByType(ACatalog: TSCSCatalogExtended; const AComponTypeGUID: string; AStartIndex:Integer=0; ACorrectCompTypeComponIdx: Boolean=false; aOnlySelected: boolean = False); var //Proj: TSCSProject; SprComponentType: TNBComponentType; GUIDComponTypeList: TStringList; CatalogsToDefineParams: TSCSCatalogs; SavedCompTypeComponIdx: Integer; begin BeginProgress; try SprComponentType := GSCSBase.CurrProject.Spravochnik.GetComponentTypeByGUID(AComponTypeGUID); if SprComponentType <> nil then begin if ACatalog = GSCSBase.CurrProject then SaveCurrProjectToUndoStack else SaveListToUndoStack(ACatalog.ListID); GUIDComponTypeList := TStringList.Create; CatalogsToDefineParams := TSCSCatalogs.Create(false); GUIDComponTypeList.Add(SprComponentType.ComponentType.GUID); SavedCompTypeComponIdx := SprComponentType.ComponentType.ComponentIndex; SprComponentType.ComponentType.ComponentIndex := AStartIndex; ACatalog.ReindexComponentsByTypes(GUIDComponTypeList, CatalogsToDefineParams{, Proj.Setting.ReindexOrderType}, AStartIndex, aOnlySelected); F_ChoiceConnectSide.DefineObjectsParamsAfterChangeComponMark(CatalogsToDefineParams); if ACorrectCompTypeComponIdx then begin if SprComponentType.ComponentType.ComponentIndex < SavedCompTypeComponIdx then SprComponentType.ComponentType.ComponentIndex := SavedCompTypeComponIdx; end; FreeAndNil(CatalogsToDefineParams); FreeAndNil(GUIDComponTypeList); end; finally EndProgress; end; end; function TF_MAIN.SelectTemplateItemByComponID(ATemplateID, AIDCompon: Integer): TListItem; var IDGroup: Integer; TemplateGrpData: TTemplateGrpData; begin Result := nil; IDGroup := DM.GetIntFromTableByID(tnTemplateRelation, fnIDGroup, ATemplateID, qmPhisical); if IDGroup <> 0 then begin TemplateGrpData := GetTemplateGrpByID(IDGroup); if TemplateGrpData <> nil then begin Result := GetTemplateItemByComponID(TemplateGrpData.FListView, AIDCompon); if Result <> nil then begin if pcObjects.ActivePage <> tsTemplates then SetpcObjectsTab(tsTemplates.TabIndex); //pcObjects.ActivePage := tsTemplates; if pcObjects.ActivePage = tsTemplates then begin TemplateGrpData.FOwner.Open; TemplateGrpData.FListView.Selected := Result; end; end; end; end; end; function TF_MAIN.SelectComponInPCObjects(AIDComponent: Integer): TObject; var IDTemplate: Integer; begin Result := nil; IDTemplate := 0; if GDBMode = bkNormBase then if tsTemplates.TabVisible then IDTemplate := DM.GetIntFromTable(tnTemplateRelation, fnId, fnIDComponent, AIDComponent, qmPhisical); if IDTemplate <= 0 then Result := SelectComponByIDInTree(AIDComponent) else Result := SelectTemplateItemByComponID(IDTemplate, AIDComponent); end; function TF_MAIN.SelectComponInPCObjectsByGUID(AGUIDComponent: string): TObject; var IDCompon: Integer; begin Result := nil; IDCompon := DM.GetIntFromTableByGUID(tnComponent, fnID, AGUIDComponent, qmPhisical); if IDCompon <> 0 then Result := SelectComponInPCObjects(IDCompon); end; procedure TF_MAIN.SetComponGroupsToCombo(ACombo: TRzComboBox); var ComponTypeGroups: TStringList; begin ComponTypeGroups := TStringList.Create; ReadIniSectionKeys(GetPathToNBComponGroups, scCompTypeGroups, ComponTypeGroups); SetComponGroupsToComboFromCompTypes(ACombo, ComponTypeGroups); FreeAndNil(ComponTypeGroups); end; procedure TF_MAIN.SetComponGroupsToComboFromCompTypes(ACombo: TRzComboBox; ACompTypes: TStringList); var i: integer; SavedonChange: TNotifyEvent; MemTableSysName: TkbmMemTable; begin if FNormBase <> nil then begin MemTableSysName := FNormBase.F_MakeEditComponentType.mtSysNames; SavedonChange := ACombo.OnChange; ACombo.OnChange := nil; MemTableSysName.DisableControls; try ClearComboBoxRz(ACombo); for i := 0 to ACompTypes.Count - 1 do begin if MemTableSysName.Locate(fnSysName, ACompTypes[i], []) then AddIDGUIDToComboRz(0, ACompTypes[i], MemTableSysName.FieldByName(fnDescription).AsString, ACombo); end; finally MemTableSysName.EnableControls; ACombo.OnChange := SavedonChange; end; end; end; procedure TF_MAIN.SetComponGroupsToForm(const ASelectedComponGrp: String); var SelectedComponGroups: string; begin try SetComponGroupsToCombo(cbGroupCompType); SelectedComponGroups := ASelectedComponGrp; if SelectedComponGroups = '' then SelectedComponGroups := GetSelectedComponGroups; SelectItemByGUIDinComboRz(cbGroupCompType, SelectedComponGroups); cbGroupCompTypeChange(cbGroupCompType); except on E: Exception do AddExceptionToLogExt(ClassName, 'SetComponGroupsToForm', E.Message); end; end; procedure TF_MAIN.SetComponsPropValByCurrNode(const APropSN, AVal, AQuestMsg: String; AOnlySelected: Boolean); var SCSCatalog, ChildCatalog: TSCSCatalog; SCSList: TSCSCatalog; ComponList: TSCSComponents; Compon: TSCSComponent; i: integer; begin try SCSCatalog := GetActualSelectedCatalog; if SCSCatalog <> nil then begin ComponList := nil; if AOnlySelected then begin ComponList := TSCSComponents.Create(false); for i := 0 to SCSCatalog.ChildCatalogReferences.Count - 1 do begin ChildCatalog := SCSCatalog.ChildCatalogReferences[i]; if CheckCADObjectSelect(ChildCatalog.ListID, ChildCatalog.SCSID) then begin ComponList.AddItems(ChildCatalog.ComponentReferences); end; end; end else begin ComponList := SCSCatalog.ComponentReferences; end; if ComponList.Count > 0 then begin if MessageQuastYN(AQuestMsg) = IDYES then begin BeginProgress; try // UNDO SCSList := SCSCatalog.GetParentCatalogByItemType(itList); if SCSList <> nil then SaveListToUndoStack(TSCSList(SCSList).CurrID) else SaveCurrProjectToUndoStack; for i := 0 to ComponList.Count - 1 do begin Compon := ComponList[i]; Compon.SetPropertyValueAsString(APropSN, AVal); end; finally EndProgress; end; end; end else begin MessageInfo(cMain_Msg184_5); end; if AOnlySelected then ComponList.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'SetComponsPropValByCurrNode', E.Message); end; end; procedure TF_MAIN.SetControlsByUseLiteFunctional(ALiteVersion, AUseLiteFunctional, ARefresh: Boolean); var ChangedPageControl: Boolean; NextPage: TRzTabSheet; OldLiteVersion: Boolean; OldUseLiteFunctional: Boolean; i: integer; Grp: TRzGroup; GrpVisibleCount: Integer; GrpVisible: Boolean; OpenedGroupsCnt: Integer; FirstVisibleGrp: TRzGroup; TemplateGrpData: TTemplateGrpData; begin SetControlsByArhOnlyMode; if GDBMode = bkNormBase then begin OldLiteVersion := GLiteVersion; OldUseLiteFunctional := GUseLiteFunctional; GLiteVersion := ALiteVersion; GUseLiteFunctional := AUseLiteFunctional; // В лайт версии всегда использовать лайт функционал if GLiteVersion and Not GUseLiteFunctional then GUseLiteFunctional := true; GUseComponTemplates := Not GLiteVersion; GUseVisibleInterfaces := Not GLiteVersion; // КАД и FSCS_Main SetLiteStatus(GLiteVersion); if OldLiteVersion <> GLiteVersion then begin if ARefresh then begin //RefreshNode(true); //FProjectMan.RefreshNode(true); Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); with FProjectMan do Tree_CatalogChange(Tree_Catalog, Tree_Catalog.Selected); end; end; ChangedPageControl := false; // Скрываем/открываем группу "Витруальные компоненты" GrpVisibleCount := 0; OpenedGroupsCnt := 0; FirstVisibleGrp := nil; for i := 0 to gbTemplateGroups.GroupCount - 1 do begin Grp := gbTemplateGroups.Groups[i]; TemplateGrpData := TTemplateGrpData(Grp.Tag); //Grp.Visible := (GUseLiteFunctional) or (TTemplateGrpData(Grp.Tag).FType <> tgtVirtualCompon); GrpVisible := true; if GUseArhOnlyMode and Not IsGraphModTemplate(TTemplateGrpData(Grp.Tag).FType) then GrpVisible := false else if Not GUseLiteFunctional and (TTemplateGrpData(Grp.Tag).FType = tgtVirtualCompon) then GrpVisible := false; // Если на группа пустая, то ее скрываем нах //31.03.2011 {IGOR} //D0000006316 // почему то FListView.Items.Count всегда 0 //if TemplateGrpData.FListView.Items.Count = 0 then // GrpVisible := false; Grp.Visible := GrpVisible; if Grp.Visible then begin Inc(GrpVisibleCount); if FirstVisibleGrp = nil then FirstVisibleGrp := Grp; if Grp.Opened then OpenedGroupsCnt := OpenedGroupsCnt + 1; end; end; //07.06.2010 tsTemplates.TabVisible := GUseLiteFunctional; if (OpenedGroupsCnt = 0) and (FirstVisibleGrp <> nil) then FirstVisibleGrp.Opened := True; tsTemplates.TabVisible := GrpVisibleCount > 0; if (pcObjects.ActivePage = tsTemplates) and Not tsTemplates.TabVisible then begin NextPage := pcObjects.FindNextPage(pcObjects.Pages[0], true, true); if Not ARefresh then pcObjects.OnChange := nil; try pcObjects.ActivePage := NextPage; finally if Not ARefresh then pcObjects.OnChange := pcObjectsChange; end; ChangedPageControl := true; end; //31.03.2011 tsTemplates.TabVisible := GrpVisibleCount > 0; // //if (OpenedGroupsCnt = 0) and (FirstVisibleGrp <> nil) then // FirstVisibleGrp.Opened := True; // // Если скрылась страница, то открываем следущую //if Not GUseLiteFunctional then // if (pcObjects.ActivePage = tsTemplates) and Not tsTemplates.Visible then // begin // NextPage := pcObjects.FindNextPage(pcObjects.Pages[0], true, true); // if Not ARefresh then // pcObjects.OnChange := nil; // try // pcObjects.ActivePage := NextPage; // finally // if Not ARefresh then // pcObjects.OnChange := pcObjectsChange; // end; // ChangedPageControl := true; // end; if ARefresh and Not ChangedPageControl then pcObjectsChange(pcObjects); end; //31.03.2011 SetControlsByArhOnlyMode; end; procedure TF_MAIN.SetControlsByArhOnlyMode; begin if GDBMode = bkNormBase then begin tsTemplates.TabVisible := Not GUseArhOnlyMode; tsComponents.TabVisible := Not GUseArhOnlyMode; tsComponGroups.TabVisible := Not GUseArhOnlyMode; {$IF Defined (FINAL_SCS)} {$IFEND} // Если только арх-й режим, то убираем панеь со свойствами if GUseArhOnlyMode then Panel_Addition.Visible := false; end; if GDBMode = bkProjectManager then begin Act_ChoiceFind.Visible := Not GUseArhOnlyMode; end; ToolButton_TMnuMenu.Visible := Not GUseArhOnlyMode; //ToolButton_TMnuActions.Visible := Not GUseArhOnlyMode; end; procedure TF_MAIN.SetEventsToLVTemplate(AOnSelectItem: TLVSelectItemEvent; AOnDBLClick: TNotifyEvent); var i: Integer; Group: TRzGroup; TemplateGrpData: TTemplateGrpData; begin for i := gbTemplateGroups.GroupCount - 1 downto 0 do begin Group := gbTemplateGroups.Groups[i]; if Group.Tag <> 0 then begin TemplateGrpData := TTemplateGrpData(Group.Tag); if TemplateGrpData.FListView <> nil then begin if Assigned(AOnSelectItem) then TemplateGrpData.FListView.OnSelectItem := AOnSelectItem; if Assigned(AOnDBLClick) then TemplateGrpData.FListView.OnDblClick := AOnDBLClick; end; end; end; end; procedure TF_MAIN.SetFullRepaint(AVal: Boolean); var Control: TControl; Compon: TComponent; i: Integer; begin {for i := 0 to Self.ControlCount - 1 do begin Control := Controls[i]; if Control is TPanel then begin TPanel(Control).FullRepaint := AVal; end; end;} for i := 0 to Self.ComponentCount - 1 do begin Compon := Components[i]; if Compon is TPanel then begin TPanel(Compon).FullRepaint := AVal; end; end; end; procedure TF_MAIN.SetSelectedComponGroups(const ACompType: string); var ConfFileName: String; begin try ConfFileName := GetPathToNBComponGroups; WriteSettingMemIni(ConfFileName, dtString, scGeneral, idtSelectedCompType, ACompType); except on E: Exception do AddExceptionToLogExt(ClassName, 'SaveTypeComponGroups', E.Message); end; end; procedure TF_MAIN.SetpcObjectsTab(AIndex: Integer); begin if AIndex <> -1 then begin if GDBMode = bkNormBase then begin if GUseArhOnlyMode then AIndex := tsTemplates.TabIndex; end; pcObjects.ActivePageIndex := AIndex; end; end; procedure TF_MAIN.SetpcObjectsTabWidth(ATabWidth: Integer); begin DisableAlign; if FbtStayOnToppcObjects <> nil then begin if FbtStayOnToppcObjects.Down then begin ATabWidth := 20; //pcObjects.TabWidth := ATabWidth; end; FbtStayOnToppcObjects.Left := (pcObjects.Width - ATabWidth) - 1; //(pcObjects.Width - 50) - FbtStayOnToppcObjects.Width - 2; end; pcObjects.TabWidth := ATabWidth; //if ATabWidth = 20 then // pcObjects.HotTrackStyle := htsTab //else //if ATabWidth = 1 then // pcObjects.HotTrackStyle := htsText; EnableAlign; end; procedure TF_MAIN.ShowCADObjectView(AContinue: Boolean=true; AComponent: TSCSComponent=nil); var Obj: TSCSComponent; Net: TNet; //SelRect: TDoubleRect; begin try if Not AContinue or (Assigned(F_CADObjectView) and F_CADObjectView.Visible) then begin //Obj := GetActualSelectedComponent; Obj := AComponent; if Obj = nil then Obj := GetActualSelectedComponent; if Obj <> nil then begin if Obj.IsLine = ctArhRoofSeg then begin Net := TNet(GetCADObjByArchObj(Obj)); if Assigned(Net) and (Net is TNet) then begin CreateFCADObjectView; F_CADObjectView.Caption := Obj.GetNameForVisible; F_CADObjectView.PCad.MapScale := GCadForm.PCad.MapScale; CalcAcrhRoofSegAreaByMaterial(Obj, Net, -1, true, F_CADObjectView.PCad); F_CADObjectView.ZoomObject; {F_CADObjectView.PCad.Refresh; F_CADObjectView.PCad.SelectAll(0); SelRect := F_CADObjectView.PCad.GetSelectionRect; // Перемещаем все в начало F_CADObjectView.PCad.MoveSelection(0-SelRect.Left, 0-SelRect.Top); //F_CADObjectView.PCad.DeSelectAll(0); //F_CADObjectView.PCad.SelectAll(0); //F_CADObjectView.PCad.Refresh; // Масштабируем SelRect := F_CADObjectView.PCad.GetSelectionRect; F_CADObjectView.PCad.ZoomArea(F_CADObjectView.PCad.GetSelectionRect); // Zoom Center //F_CADObjectView.PCad.AutoRefresh := false; F_CADObjectView.PCad.ZoomScale := F_CADObjectView.PCad.ZoomScale; F_CADObjectView.PCad.Refresh; F_CADObjectView.PCad.DeSelectAll(0);} if Not F_CADObjectView.Showing then F_CADObjectView.Show; end; end; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowCADObjectView', E.Message); end; end; procedure TF_MAIN.ShowMenuItems(aItem: TMenuItem; const aControlName: string); var i: Integer; begin for i := 0 to aItem.Count - 1 do begin GLog.Add(''); GLog.Add('FSCS_Main.'+aControlName+'.Items['+IntToStr(i)+']'); GLog.Add('FSCS_Main.'+aControlName+'.'+ aItem[i].Name); end; end; procedure TF_MAIN.FbtStayOnToppcObjectsClick(Sender: TObject); begin Timer_StartHidepcObjects.Enabled := Not FbtStayOnToppcObjects.Down; WriteSetting(fnSCSIniFile, dtBoolean, scNormBase, idtStayOnTopPCObjects, FbtStayOnToppcObjects.Down); end; procedure TF_MAIN.lvTemplatesDblClick(Sender: TObject); var ToolClassName: String; ToolData: Integer; begin if GSCSBase.SCSComponent.ID <> 0 then begin if (GDBMode = bkNormBase) and (GFormMode = fmNormal) then begin if IsArchComponByIsLine(GSCSBase.SCSComponent.IsLine) then begin FSCS_Main.aCreateObjectOnClickTool.Execute; if IsArchTopComponByIsLine(GSCSBase.SCSComponent.IsLine) or (GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then begin ToolClassName := ''; ToolData := GSCSBase.SCSComponent.IsLine; if (GSCSBase.SCSComponent.IsLine = ctArhWallDivision) then FSCS_Main.SetToolArch(TWallDivPath.ClassName) //06.10.2010 FSCS_Main.SetToolArch('TWallDivPath') else //if (GSCSBase.SCSComponent.IsLine = ctArhRoom) then //begin // if Act_DrawModePoly.Checked then // ToolClassName := TWallPolyPath.ClassName // else // ToolClassName := TRoomWallRect.ClassName; // //FSCS_Main.SetToolArch(TRoomWallRect.ClassName) //06.10.2010 FSCS_Main.SetToolArch('TRoomWallRect') //end //else //if (GSCSBase.SCSComponent.IsLine = ctArhBrickWall) then //begin // if Act_DrawModePoly.Checked then // ToolClassName := TWallPolyPath.ClassName // else // ToolClassName := TBrickWallRect.ClassName; // //FSCS_Main.SetToolArch(TBrickWallRect.ClassName); //06.10.2010 FSCS_Main.SetToolArch('TBrickWallRect'); //end; if IsArchTopComponByIsLine(GSCSBase.SCSComponent.IsLine) then begin if Act_DrawModePoly.Checked then ToolClassName := TWallPolyPath.ClassName else ToolClassName := TRoomWallRect.ClassName; end; if ToolClassName <> '' then FSCS_Main.SetToolArch(ToolClassName, ToolData); end; end else Act_EditTemplate.Execute; end else Act_EditTemplate.Execute; end; end; procedure TF_MAIN.Act_DelTemplateExecute(Sender: TObject); begin try if MessageQuastYN(cMain_Msg179) = IDYES then begin DeleteTemplateItem(FlvTemplate.Selected); EnableEditDelTemplate; ArrangeLVTemplates(FlvTemplate); end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_DelTemplateExecute), E.Message); end; end; procedure TF_MAIN.lvTemplatesMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ItemAtCursor: TListItem; begin if GDBMOde = bkProjectManager then CheckCloseReportForm; // Tolik 05/05/2021 -- // Элемент под курсором ItemAtCursor := TRzListView(Sender).GetItemAt(X, Y); if Button = mbRight then begin //ItemAtCursor := nil; if ItemAtCursor <> nil then begin TRzListView(Sender).OnSelectItem := nil; try TRzListView(Sender).Selected := ItemAtCursor; finally TRzListView(Sender).OnSelectItem := lvTemplatesSelectItem; end; lvTemplatesSelectItem(Sender, ItemAtCursor, true); end; end; end; procedure TF_MAIN.lvTemplatesMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var ScrPos: TPoint; begin {if Button = mbRight then begin ScrPos.X := X; ScrPos.Y := Y; ScrPos := lvTemplates.ClientToScreen(ScrPos); //pmTemplates.Popup(ScrPos.X, ScrPos.Y); end;} end; procedure TF_MAIN.lvTemplatesContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var ScrPos: TPoint; begin {ScrPos := lvTemplates.ClientToScreen(MousePos); pmTemplates.Popup(ScrPos.X, ScrPos.Y);} end; procedure TF_MAIN.lvTemplatesItemContextMenu(Sender: TObject; Item: TListItem; var Pos: TPoint; var Menu: TPopupMenu); var ScrPos: TPoint; begin ScrPos := TRzListView(Sender).ClientToScreen(Pos); pmTemplates.Popup(ScrPos.X, ScrPos.Y); end; procedure TF_MAIN.lvTemplatesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var TrgItem: TListItem; //ScrPos: TPoint; begin if Sender = Source then begin //ScrPos := Point(X, Y); //ScrPos := lvTemplates.ClientToScreen(ScrPos); TrgItem := TRZListView(Sender).GetItemAt(X, Y); Accept := TrgItem <> nil; end else Accept := false; end; procedure TF_MAIN.lvTemplatesDragDrop(Sender, Source: TObject; X, Y: Integer); var SrcItem: TListItem; Trgtem: TListItem; //SrcPos: TPoint; begin if Sender = Source then begin SrcItem := TRZListView(Sender).Selected; Trgtem := TRZListView(Sender).DropTarget; if (SrcItem <> nil) and (Trgtem <> nil) then begin //SrcPos := SrcItem.Position; //SrcItem.Position := Trgtem.Position; //Trgtem.Position; //Trgtem.Position := SrcPos; MoveTemplateItem(SrcItem, Trgtem); end; end; end; procedure TF_MAIN.lvTemplatesStartDrag(Sender: TObject; var DragObject: TDragObject); var Listitem: TListItem; CurrDat: PTemplateData; Point: TPoint; SCSCompon: TSCSComponent; S: String; begin Act_HideHints.Execute; try GisDragTree := true; Timer_NodeHint.Enabled := false; Act_HideHints.Execute; Listitem := FlvTemplate.Selected; CurrDat := Listitem.Data; GID_CopingCompon := 0; if CurrDat <> nil then GID_CopingCompon := CurrDat.IDComponent; StartDragCompon(GID_CopingCompon); { if CurrDat <> nil then begin GID_CopingCompon := CurrDat.IDComponent; if GDropComponent = nil then begin GDropComponent := TSCSComponent.Create(Self); end; GDropComponent.Clear; GDropComponent.ActiveForm := F_NormBase; GDropComponent.Clear; GDropComponent.IDTopComponent := 0; GDropComponent.IDCompRel := 0; GDropComponent.LoadComponentByID(CurrDat.IDComponent, true, true, false); GDropComponent.IDCompRel := 0; GDropComponent.TreeViewNode := nil; //21.05.2009 CreateShadowObject; // На CAD if GSCSBase.SCSComponent.ID <> GDropComponent.ID then begin GSCSBase.SCSComponent.Assign(GDropComponent, false, true); RefreshNode(true); end; if Assigned(GDropComponent) then begin GDropComponent.Count := 1; if (GDBMode = bkNormBase) then and (GDropComponent.HaveMinimumInterfaces(false)) then begin GCanCopyComponToCAD := true; if FProjectMan <> nil then if FProjectMan.GSCSBase.CurrProject.Active then if FProjectMan.GSCSBase.CurrProject.CurrList <> nil then if FProjectMan.GSCSBase.CurrProject.CurrList.Setting.SCSType = st_Internal then if IsTrunkComponent(GDropComponent) then begin GCanCopyComponToCAD := false; end; end else GCanCopyComponToCAD := false; GisLineCopingCompon := GDropComponent.IsLine; end; end else if GDropComponent <> nil then begin GDropComponent.Clear; GCanCopyComponToCAD := false; end; if GCanCopyComponToCAD then CreateShadowObject; // На CAD } except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.lvTemplatesStartDrag), E.Message); end; end; procedure TF_MAIN.lvTemplatesKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin case Key of VK_F2: if Shift <> [ssCtrl] then EditingTemplateName else Act_EditTemplate.Execute; end; end; procedure TF_MAIN.lvTemplatesEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean); begin AllowEdit := (Not FIsReadOnlyLVTemplates) and (Item <> nil); end; procedure TF_MAIN.lvTemplatesEdited(Sender: TObject; Item: TListItem; var S: String); begin DM.UpdateStrTableFieldByID(tnComponent, fnName, PTemplateData(Item.Data).IDComponent, S, qmPhisical); RefreshNode; end; procedure TF_MAIN.lvTemplatesResize(Sender: TObject); begin ArrangeLVTemplates(TRZListView(Sender)); end; procedure TF_MAIN.Act_DuplicateTemplateExecute(Sender: TObject); var ListItem: TListItem; NewListItem: TListItem; Model: TMemoryStream; begin try ListItem := FlvTemplate.Selected; if ListItem <> nil then if GSCSBase.SCSComponent.ID = PTemplateData(ListItem.Data).IDComponent then begin GSCSBase.SCSComponent.LoadComponentByID(GSCSBase.SCSComponent.ID); GSCSBase.SCSComponent.LoadChildComplects(true, false, true, 0, 0); GSCSBase.SCSComponent.SortID := GetTemplateMaxSortID + 1; //GSCSBase.SCSComponent.SaveComponentAsNew(true, true); SaveComponent(GSCSBase.SCSComponent, nil, nil, Self, Self, nil, nil, false, false, ckCompon); Model := GetStreamFromTableByID(tnTemplateRelation, fnModel, PTemplateData(ListItem.Data).ID, DM.Query_Select); try DM.AppendToTemplateRel(GSCSBase.SCSComponent.ID, FTemplateGrp.FID, biFalse, Model); finally Model.Free; end; NewListItem := AddTemplateItem(FlvTemplate, GSCSBase.SCSComponent); FlvTemplate.Selected := NewListItem; ArrangeLVTemplates(FlvTemplate); end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.Act_DuplicateTemplateExecute), E.Message); end; end; procedure TF_MAIN.lvTemplatesExit(Sender: TObject); begin if Assigned(GSCSBase) and Assigned(GSCSBase.SCSComponent) then GSCSBase.SCSComponent.ServAllLoaded := false; end; procedure TF_MAIN.lvTemplatesEndDrag(Sender, Target: TObject; X, Y: Integer); begin GisDragTree := false; TRzListView(Sender).Repaint; //lvTemplates.Repaint; EndDragCompon; end; procedure TF_MAIN.Panel_MainResize(Sender: TObject); begin if pcObjects.Visible then begin SetpcObjectsTabWidth(pcObjects.TabWidth); end; end; procedure TF_MAIN.tvComponGroupsExpanding(Sender: TObject; Node: TFlyNode; var AllowExpansion: Boolean); begin if Node.Count = 0 then LoadDataToComponGroup(Node); end; procedure TF_MAIN.tvComponGroupsCollapsing(Sender: TObject; Node: TFlyNode; var AllowCollapse: Boolean); begin // end; procedure TF_MAIN.cbGroupCompTypeChange(Sender: TObject); var SelectedComponGroups: string; i: integer; GroupBlock: TFilterBlock; begin try SelectedComponGroups := GetGUIDFromComboBoxRz(cbGroupCompType); SetSelectedComponGroups(SelectedComponGroups); //LoadSelectedComponGroups(FGroupFilterBlock); LoadTypeComponGroups(SelectedComponGroups, FGroupFilterBlock); clGroupProps.Items.Clear; for i := 0 to FGroupFilterBlock.ChildBlocks.Count - 1 do begin GroupBlock := TFilterBlock(FGroupFilterBlock.ChildBlocks[i]); clGroupProps.Items.AddObject(GroupBlock.Condition.UserFieldName, GroupBlock); clGroupProps.ItemChecked[i] := GroupBlock.IsOn; end; if clGroupProps.Items.Count > 0 then clGroupProps.ItemIndex := 0; LoadDataToComponGroup(nil); except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.cbGroupCompTypeChange), E.Message); end; end; procedure TF_MAIN.cbTemplatesBandPaint(Sender: TObject; Control: TControl; Canvas: TCanvas; var ARect: TRect; var Options: TBandPaintOptions); begin Options := []; end; procedure TF_MAIN.btCriterionGroupUpClick(Sender: TObject); begin MoveGroupProp(-1); end; procedure TF_MAIN.CriterionGroupDownClick(Sender: TObject); begin MoveGroupProp(1); end; procedure TF_MAIN.clGroupPropsChange(Sender: TObject; Index: Integer; NewState: TCheckBoxState); var GroupBlock: TFilterBlock; begin GroupBlock := TFilterBlock(clGroupProps.Items.Objects[Index]); if NewState = cbUnchecked then GroupBlock.IsOn := false else if NewState = cbChecked then GroupBlock.IsOn := true; // Сохранение SaveReloadTypeComponGroups; end; procedure TF_MAIN.clGroupPropsChanging(Sender: TObject; Index: Integer; NewState: TCheckBoxState; var AllowChange: Boolean); begin if GFormMode <> fmNormal then AllowChange := false; end; procedure TF_MAIN.btcbGroupsCategorySettingsClick(Sender: TObject); begin ExecuteComponGroups(Self); end; procedure TF_MAIN.tvCompomGroupsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := False; end; procedure TF_MAIN.tvCompomGroupsStartDrag(Sender: TObject; var DragObject: TDragObject); var DragNode: TFlyNode; PosCursor: TPoint; begin GetCursorPos(PosCursor); PosCursor := tvComponGroups.ScreenToClient(PosCursor); DragNode := tvComponGroups.GetNodeAt(PosCursor.X, PosCursor.Y); GID_CopingCompon := 0; if DragNode <> nil then if DragNode.Data <> nil then if TComponGrpData(DragNode.Data).FComponData <> nil then GID_CopingCompon := TComponGrpData(DragNode.Data).FComponData.ObjectID; StartDragCompon(GID_CopingCompon); end; procedure TF_MAIN.tvComponGroupsChange(Sender: TObject; Node: TFlyNode); var NodeDat: TComponGrpData; begin try if pcObjects.ActivePage = tsComponGroups then begin if (Node <> nil) and (Node.Data <> nil) then begin GSCSBase.SCSCatalog.Clear; GSCSBase.SCSComponent.Clear; //*** Очистить гриды if GFormMode = fmNormal then begin DM.MemTable_Complects.Active := false; DM.MemTable_Connections.Active := false; DM.MemTable_CrossConnection.Active := false; DM.MemTable_InterfaceRel.Active := false; DM.MemTable_PortInterfRel.Active := false; DM.MemTable_Port.Active := false; DM.mtInterfInternalConn.Active := false; DM.MemTable_Property.Active := false; DM.mtCableCanalConnectors.Active := false; DM.mtNorms.Active := false; DM.mtObjectCurrency.Active := false; end; NodeDat := Node.Data; if NodeDat.FComponData <> nil then begin EnableDisableCost(true); GSCSBase.SCSComponent.Clear; GSCSBase.SCSComponent.IDTopComponent := NodeDat.FComponData.ObjectID; GSCSBase.SCSComponent.IDCompRel := 0; GSCSBase.SCSComponent.LoadComponentByID(NodeDat.FComponData.ObjectID, false, true, false); GSCSBase.SCSComponent.LoadChildComplectsQuick(true, false, true, GSCSBase.SCSComponent.IDTopComponent, GSCSBase.SCSComponent.IDCompRel); GSCSBase.SCSComponent.LoadComponentType; GSCSBase.SCSComponent.LoadInterfaces; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCableChannel then GSCSBase.SCSComponent.LoadCableCanalConnectors; if GSCSBase.SCSComponent.ComponentType.SysName = ctsnCupBoard then GSCSBase.SCSComponent.LoadCrossConnections; GSCSBase.SCSComponent.NormsResources.LoadNorms(false, true); GSCSBase.SCSComponent.NormsResources.LoadResources(true); GSCSBase.SCSComponent.TreeViewNode := nil; GSCSBase.SCSComponent.ServAllLoaded := false; ShowComponObjects(nil, GSCSBase.SCSComponent); //EnableEditDel(GetItemTypeByIsLine(GSCSBase.SCSComponent.IsLine)); end; end; SetVisibleGridLevel(GL_ObjectCurrency, tcGridData, false); EnableEditDelComponGroup; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.tvComponGroupsChange), E.Message); end; end; procedure TF_MAIN.tvComponGroupsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := false; end; procedure TF_MAIN.tvComponGroupsStartDrag(Sender: TObject; var DragObject: TDragObject); var DragNode: TFlyNode; PosCursor: TPoint; begin GetCursorPos(PosCursor); PosCursor := tvComponGroups.ScreenToClient(PosCursor); DragNode := tvComponGroups.GetNodeAt(PosCursor.X, PosCursor.Y); GID_CopingCompon := 0; if DragNode <> nil then if DragNode.Data <> nil then if TComponGrpData(DragNode.Data).FComponData <> nil then GID_CopingCompon := TComponGrpData(DragNode.Data).FComponData.ObjectID; StartDragCompon(GID_CopingCompon); end; procedure TF_MAIN.tvComponGroupsEndDrag(Sender, Target: TObject; X, Y: Integer); begin GisDragTree := false; EndDragCompon; end; procedure TF_MAIN.Act_TurnToComponFromGroupsExecute(Sender: TObject); var ComponGrpData: TComponGrpData; begin if tvComponGroups.Selected <> nil then begin ComponGrpData := TComponGrpData(FNormBase.tvComponGroups.Selected.Data); if (ComponGrpData <> nil) and (ComponGrpData.FComponData <> nil) then begin SetpcObjectsTab(tsComponents.TabIndex); //pcObjects.ActivePage := tsComponents; if SelectComponByIDInTree(ComponGrpData.FComponData.ObjectID) = nil then begin if FFilterParams.IsUseFilter then MessageInfo(cMain_Msg181); end; end; end; end; procedure TF_MAIN.lvTemplatesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var CursorObject: TObject; begin GetComponIDAtCursor(@CursorObject); if (CursorObject <> nil) and (CursorObject <> FLastOnHintObject) then begin FLastOnHintObject := CursorObject; RestartTimer(Timer_NodeHint); end; end; procedure TF_MAIN.tvComponGroupsMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if GDBMOde = bkProjectManager then CheckCloseReportForm; // Tolik 05/05/2021 -- end; procedure TF_MAIN.tvComponGroupsMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var CursorObject: TObject; begin GetComponIDAtCursor(@CursorObject); if (CursorObject <> nil) and (CursorObject <> FLastOnHintObject) then begin FLastOnHintObject := CursorObject; RestartTimer(Timer_NodeHint); end; end; procedure TF_MAIN.pmTemplatesPopup(Sender: TObject); begin Act_HideHints.Execute; EnableEditDelTemplate; end; procedure TF_MAIN.pmComponGroupPopup(Sender: TObject); begin Act_HideHints.Execute; EnableEditDelComponGroup; end; procedure TF_MAIN.GT_PROPERTYDblClick(Sender: TObject); begin CheckCloseReportForm; // Tolik 05/05/2021 -- Act_EditProperty.Execute; end; procedure TF_MAIN.OpenBackgrImages; var FName: string; FDir: string; OpenPictureDialog: TOpenPictureDialog; Jpeg: TJpegImage; Bmp: TBMPObject; i: integer; bmpHandle: TFigHandle; // Tolik 09/08/2019 -- // Tolik 28/08/2019 - - //oldTick, CurrTick: Cardinal; oldTick, CurrTick: DWord; // MoveX, MoveY: Double; begin Bmp := Nil; try OpenPictureDialog := TOpenPictureDialog.Create(Self); OpenPictureDialog.Title := cMain_Mes121; OpenPictureDialog.InitialDir := ExtractDirByCategoryType(dctPictures);//ExtractSaveDirForCategory('.bmp');//FDir; OpenPictureDialog.DefaultExt := '*.bmp, *.jpg, *.jpeg'; OpenPictureDialog.Filter := cMain_Mes125; OpenPictureDialog.Options := OpenPictureDialog.Options + [ofAllowMultiSelect]; if OpenPictureDialog.Execute then begin // Tolik 01/08/2019 -- сохранить последний путь if GStoreLastPaths then WriteEnvironmentDir(dctPictures, ExtractFileDir(OpenPictureDialog.FileName)); // oldTick := GetTickCount; Screen.Cursor := crHourGlass; BkgImages := TList.Create; GCadForm.PCad.AutoRefresh := false; try FSCS_Main.aSetSubstrateLayer.Execute; MoveX := 0; MoveY := 0; for i := 0 to OpenPictureDialog.Files.Count - 1 do begin FName := OpenPictureDialog.Files[i]; if pos('.bmp', FName) <> 0 then begin // bmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if bmpHandle <> -1 then Bmp := TBMPObject(bmpHandle); //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); // end else begin // Tolik 09/08/2019 -- bmpHandle := GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false); if bmpHandle < -1 then Bmp := TBMPObject(bmpHandle); //Bmp := TBMPObject(GCadForm.PCad.InsertBitmap(1, 0, 0, FName, false, false)); // { 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.Canvas.StretchDraw(Rect(0, 0, 10, 10), Jpeg); Bmp.Picture.PixelFormat := pf24bit; //Bmp.Picture.width := 10; //Bmp.Picture.width := 10; FreeAndNil(Jpeg);} end; if Bmp <> nil then // Tolik begin Bmp.move(MoveX, MoveY); //Bmp.Rotate(45/180 * pi, Bmp.ActualPoints[1]); MoveX := MoveX + 12; if (MoveX + Bmp.Picture.width) >= GCadForm.PCad.WorkWidth then begin MoveY := MoveY + 12; MoveX := 0; end; BkgImages.Add(Bmp); end; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.OpenBackgrImages), E.Message); end; GCadForm.PCad.AutoRefresh := true; Screen.Cursor := crDefault; CurrTick := GetTickCount - oldTick; CurrTick := GetTickCount - oldTick; end; OpenPictureDialog.Free; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_MAIN.OpenBackgrImages), E.Message); end; end; procedure TF_MAIN.CorrectSILFile; var OpenDialog: TOpenDialog; Strings: TStringList; i: Integer; CurrStr: String; strDelim: String; DelimPos: Integer; DelimMatches: Integer; begin strDelim := '~!@#$'; OpenDialog := TOpenDialog.Create(nil); try OpenDialog.Title := 'Выбери SIL файл'; OpenDialog.InitialDir := ExtractFileDir(Application.ExeName); OpenDialog.DefaultExt := '*.sil'; OpenDialog.Filter := GetDialogFilter('Файл с переводами', 'sil')+'|'+ GetDialogFilter(exdAll, '*'); OpenDialog.Options := OpenDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if OpenDialog.Execute then if FileExists(OpenDialog.FileName) then begin Strings := TStringList.Create; Strings.LoadFromFile(OpenDialog.FileName); for i := 0 to Strings.Count - 1 do begin CurrStr := Strings[i]; if Pos(strDelim, CurrStr) <> 0 then if Pos('Delimiter', CurrStr) <> 1 then begin DelimMatches := SubstrMatches(strDelim, CurrStr); if DelimMatches < F_LNG.siLangDisp.LangNames.Count then begin CurrStr := CurrStr + DupeString(strDelim, F_LNG.siLangDisp.LangNames.Count - DelimMatches); Strings[i] := CurrStr; end; end; end; Strings.SaveToFile(GetNoExistsFileNameForCopy( //ExtractFilePathOnly(OpenDialog.FileName)+'\'+ //ExtractFileNameOnly(OpenDialog.FileName)+'_fixed'+ ExtractFilePathOnly(OpenDialog.FileName)+'_fixed'+ ExtractFileExt(OpenDialog.FileName) )); Strings.Free; end; finally OpenDialog.Free; end; end; procedure TF_MAIN.tbAngleChange(Sender: TObject); var i: Integer; Figure: TFigure; begin if BkgImages <> nil then begin GCadForm.PCad.RecordUndo := false; GCadForm.PCad.AutoRefresh := false; try for i := 0 to BkgImages.Count - 1 do begin Figure := TFigure(BkgImages[i]); //Figure.Rotate(tbAngle.Position /180 * pi); end; except on E: Exception do AddExceptionToLogEx('TF_MAIN.tbTest2Click', E.Message); end; GCadForm.PCad.AutoRefresh := true; GCadForm.PCad.Refresh; //GCadForm.PCad.Repaint; end; end; procedure TF_MAIN.TplGrpOpen(Sender: TObject); begin if Sender is TRzGroup then begin FTemplateGrp := TTemplateGrpData(TRzGroup(Sender).Tag); FlvTemplate := FTemplateGrp.FListView; EnableEditDelTemplate; SetPriceCostPanel; pcObjectsChange(pcObjects); end; end; procedure TF_MAIN.lvTemplatesClick(Sender: TObject); var ItemAtCursor: TListItem; CurPos: TPoint; begin CurPos := GetMouseCursorPos; CurPos := TRZListView(Sender).ScreenToClient(CurPos); // Элемент под курсором ItemAtCursor := TRzListView(Sender).GetItemAt(CurPos.X, CurPos.Y); if (ItemAtCursor.Data <> nil) and (PTemplateData(ItemAtCursor.Data).IDComponent = GSCSBase.SCSComponent.ID) then begin OnClickCompon(GSCSBase.SCSComponent); end; end; procedure TF_MAIN.Act_View3DExecute(Sender: TObject); var aRoom: TSCSComponent; CtrlDown: boolean; // 2011-05-10 //xModelNode: TTreeNode; begin aRoom := GetActualSelectedComponent; if aRoom.IsLine = ctArhRoom then begin // 2011-05-10 if (FSCS_Main.ActiveMDIChild = nil) or (aRoom.ListID <> GCadForm.FCADListID) then begin // Tolik -- 21/09/2016 -- // ShowMessage('Лист, которому принадлежит комната должен быть активным!'); ShowMessage(cMain_Msg205); // exit; end; GCurrentRoom3DView := aRoom; // *** MARK *** // 2011-05-10 G3DModelForProject := False; {$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} 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; //16.09.2011 frm3D.F3DModel := T3DModel.Create; // frm3D.ModelTree.Items.Clear; // xModelNode := frm3D.ModelTree.Items.AddFirst(nil, frm3D.F3DModel.FName); // xModelNode.Data := frm3D.F3DModel; // xModelNode.HasChildren := True; frm3D.CreateModel; frm3D.CreateTopNode; frm3D.FZOrder := 0; if GCadForm.FListType = lt_Normal then GCadForm.View3D; EndProgress; frm3d.FCAD := GCadForm; frm3d.ShowModal; FreeAndNil(frm3D); // *** MARK *** end; end; procedure TF_MAIN.Act_DrawModeRectExecute(Sender: TObject); begin ComponDrawModeChange(0); end; procedure TF_MAIN.Act_DrawModePolyExecute(Sender: TObject); begin ComponDrawModeChange(1); end; procedure TF_MAIN.Act_DrawBasementExecute(Sender: TObject); begin WriteSetting(fnSCSIniFile, dtBoolean, scNormBase, idtComponDrawBasement, Act_DrawBasement.Checked); end; procedure TF_MAIN.Timer_NodeShowTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; if FTreeNodeToShow <> nil then begin ShowNode(Tree_Catalog, FTreeNodeToShow); FTreeNodeToShow := nil; end; end; procedure TF_MAIN.pmiInterfPathClick(Sender: TObject); begin // end; procedure TF_MAIN.Act_CablePathExecute(Sender: TObject); begin CreateFResourceReport.ShowCablePathsWizard(GetActualSelectedComponent); end; procedure TF_MAIN.Act_SetActiveToAllComponsExecute(Sender: TObject); var SCSCatalog: TSCSCatalog; SCSList: TSCSCatalog; Compon: TSCSComponent; i: integer; begin SetComponsPropValByCurrNode(pnSignType, IntToStr(oitActive), cMain_Msg184_1, false); {SCSCatalog := GetActualSelectedCatalog; if SCSCatalog <> nil then if MessageQuastYN(cMain_Msg184_1) = IDYES then begin BeginProgress; try // UNDO SCSList := SCSCatalog.GetParentCatalogByItemType(itList); if SCSList <> nil then SaveListToUndoStack(TSCSList(SCSList).CurrID) else SaveCurrProjectToUndoStack; for i := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin Compon := SCSCatalog.ComponentReferences[i]; Compon.SetPropertyValueAsString(pnSignType, IntToStr(oitActive)); end; finally EndProgress; end; end;} end; procedure TF_MAIN.Act_SetProjectibleToAllComponsExecute(Sender: TObject); begin SetComponsPropValByCurrNode(pnSignType, IntToStr(oitProjectible), cMain_Msg184_2, false); end; procedure TF_MAIN.Act_SetActiveToASelComponsExecute(Sender: TObject); begin SetComponsPropValByCurrNode(pnSignType, IntToStr(oitActive), cMain_Msg184_3, true); end; procedure TF_MAIN.Act_SetProjectibleToSelComponsExecute(Sender: TObject); begin SetComponsPropValByCurrNode(pnSignType, IntToStr(oitProjectible), cMain_Msg184_4, true); end; procedure TF_MAIN.sbSelectFromSearchedInCADClick(Sender: TObject); var ObjectList: TSCSCatalogs; ItemDat: PObjectData; i: Integer; SCSObject: TSCSCatalog; SCSComponent: TSCSComponent; begin try if GDBMode = bkProjectManager then begin // Формируем список объектов ObjectList := TSCSCatalogs.Create(false); for i := 0 to ListView_Find.Items.Count - 1 do begin ItemDat := ListView_Find.Items[i].Data; SCSObject := nil; if IsSCSObjectItemType(ItemDat^.ItemType) then begin SCSObject := GSCSBase.CurrProject.GetCatalogFromReferences(ItemDat.ObjectID); end else if IsComponItemType(ItemDat^.ItemType) then begin SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(ItemDat.ObjectID); if SCSComponent <> nil then SCSObject := SCSComponent.GetFirstParentCatalog; end; if (SCSObject <> nil) and (ObjectList.GetByID(SCSObject.ID) = nil) then ObjectList.Add(SCSObject); end; // Выделяем на листе SelectSCSObjectsInCAD(ObjectList); ObjectList.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'sbSelectFromSearchInCADClick', E.Message); end; end; procedure TF_MAIN.sbSelectFromFilteredInCADClick(Sender: TObject); var i, j: integer; SCSComponent: TSCSComponent; SCSObject: TSCSCatalog; ChildFilterBlock: TFilterBlock; ObjectList: TSCSCatalogs; begin try if GDBMode = bkProjectManager then begin // Формируем список объектов ObjectList := TSCSCatalogs.Create(false); for i := 0 to GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin SCSComponent := GSCSBase.CurrProject.ComponentReferences[i]; SCSObject := SCSComponent.GetFirstParentCatalog; if (SCSObject <> nil) and (ObjectList.GetByID(SCSObject.ID) = nil) then begin for j := 0 to FFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := FFilterParams.FFilterBlock.AllChildBlocks[j]; if ChildFilterBlock.Condition <> nil then case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDComponentType; fiGuidProducer: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDProducer; fiGuidNetType: ChildFilterBlock.Condition.FieldValue := SCSComponent.GUIDNetType; end; end; if FFilterParams.FFilterBlock.Execute then ObjectList.Add(SCSObject); end; end; // Выделяем на листе SelectSCSObjectsInCAD(ObjectList); ObjectList.Free; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'sbSelectFromFilteredInCADClick', E.Message); end; end; procedure TF_MAIN.ButtonEdit_FindDblClick(Sender: TObject); begin ButtonEdit_FindPropertiesButtonClick(ButtonEdit_Find, 0); end; procedure TF_MAIN.Act_SaveModelToNBExecute(Sender: TObject); var Data: PTemplateData; FileName: String; ObjName: String; IDTemplRel: Integer; FileStream: TFileStream; TemplateGrp: TTemplateGrpData; SCSCompon: TSCSComponent; SprObjIcon: TNBObjectIcon; begin try if CheckWriteNB(true) then begin if (FNormBase.pcObjects.ActivePage <> FNormBase.tsTemplates) and FNormBase.tsTemplates.TabVisible then FNormBase.pcObjects.ActivePage := FNormBase.tsTemplates; if FNormBase.pcObjects.ActivePage = FNormBase.tsTemplates then begin IDTemplRel := 0; if FNormBase.FTemplateGrp <> nil then begin if (FNormBase.GSCSBase.SCSComponent.ID <> 0) and (FNormBase.FlvTemplate.Selected <> nil) and (FNormBase.FlvTemplate.Selected.Data <> nil) then begin Data := FNormBase.FlvTemplate.Selected.Data; {$IF Defined (FINAL_SCS)} if Data^.IsStandart = biFalse then begin {$IFEND} if FNormBase.GSCSBase.SCSComponent.IsLine = ctArhRoof then IDTemplRel := FNormBase.DM.GetIntFromTable(tnTemplateRelation, fnId, fnIDComponent, FNormBase.GSCSBase.SCSComponent.ID, qmPhisical) else MessageInfo(cMain_Msg188); {$IF Defined (FINAL_SCS)} end else MessageInfo(cMain_Msg187); {$IFEND} end; // Если не определен шаблон, то создаем его if IDTemplRel = 0 then begin // Открываем группу с шаблонами крыш if FNormBase.FTemplateGrp.FType <> tgtRoof then begin TemplateGrp := FNormBase.GetTemplateGrpByType(tgtRoof); if TemplateGrp <> nil then TemplateGrp.FOwner.Open; end; if FNormBase.FTemplateGrp.FType = tgtRoof then begin SCSCompon := FNormBase.GSCSBase.GetComponByType(ctsnArhRoof); try ObjName := InputForm(Self, ApplicationName, cMain_Msg190, SCSCompon.Name); if ObjName <> '' then begin SCSCompon.Name := ObjName; SCSCompon.GUIDSymbol := guidObjIconRoof; SprObjIcon := FNormBase.GSCSBase.NBSpravochnik.GetObjectIconByGUID(SCSCompon.GUIDSymbol); if SprObjIcon <> nil then SCSCompon.IDSymbol := SprObjIcon.ID; SCSCompon.SortID := FNormBase.GetTemplateMaxSortID + 1; FNormBase.SaveComponent(SCSCompon, nil, nil, FNormBase, FNormBase, nil, nil, false, false, ckCompon); //SCSCompon.SaveComponentAsNew(true); FNormBase.DM.AppendToTemplateRel(SCSCompon.ID, FNormBase.FTemplateGrp.FID, biFalse, nil); IDTemplRel := GenIDFromTable(FNormBase.DM.Query_Select, gnTemplateRelationID, 0); FNormBase.FlvTemplate.Selected := FNormBase.AddTemplateItem(FNormBase.FlvTemplate, SCSCompon); FNormBase.ArrangeLVTemplates(FNormBase.FlvTemplate); end; finally FreeAndNil(SCSCompon); end; end; end; end; if IDTemplRel <> 0 then begin FileName := ExtractSCSTempDir + GetUniqueFileName('', enList); if GSCSBase.CurrProject.CurrList.SaveToStreamOrFile(nil, FileName) then begin if FileExists(FileName) then begin FileStream := TFileStream.Create(FileName, fmOpenRead); try SetStreamToTableByID(tnTemplateRelation, fnModel, IDTemplRel, FileStream, FNormBase.DM.Query_Operat); finally FileStream.Free; end; DeleteFile(FileName); end; end else AddExceptionToLog(cSCSComponent_Msg22_5, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_5); end; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'Act_SaveModelToNBExecute', E.Message); end; end; procedure TF_MAIN.Act_SendModelToProjectExecute(Sender: TObject); var IDTemplRel: Integer; FileStream: TFileStream; FileName: String; NewList: TSCSList; Size: Integer; SavedlbHeight: String; RoofTopPoints: TSCSComponents; RoofTopPointsH, NewRoofTopPointsH: Double; begin if CheckIsOpenProject(true) then begin if GSCSBase.SCSComponent.ID <> 0 then begin IDTemplRel := FNormBase.DM.GetIntFromTable(tnTemplateRelation, fnId, fnIDComponent, FNormBase.GSCSBase.SCSComponent.ID, qmPhisical); if IDTemplRel <> 0 then begin FileName := ExtractSCSTempDir + GetUniqueFileName('', enList); FileStream := GetFileStreamFromTableByID(tnTemplateRelation, fnModel, FileName, IDTemplRel, DM.Query_Operat); Size := FileStream.Size; FileStream.Free; if FileExists(FileName) then begin NewList := nil; BeginProgress; try NewList := FProjectMan.GSCSBase.CurrProject.AddListFromFile(FileName, false); if NewList <> nil then ChangeCurrList(GIDLastList, NewList.CurrID); finally EndProgress; end; DeleteFile(FileName); if Assigned(NewList) and (GCadForm.FCADListID = NewList.CurrID) then begin ShowRoofParams(GCadForm, NewList, nil, nil); {GCadForm.CurrentLayer := lnArch; // Определяекм высоту крыши RoofTopPoints := GetTopArchCorners(DefineArchContainer(NewList), @RoofTopPointsH); // Запрашиваем размеры GCadForm.PCad.SelectAll(GCadForm.CurrentLayer); SavedlbHeight := F_BlockParams.lbHeight.Caption; F_BlockParams.Caption := cArchParams_Msg26; F_BlockParams.lbHeight.Caption := cCadClasses_Mes4; F_BlockParams.pnAddition.Visible := RoofTopPointsH > 0; F_BlockParams.lbAddition.Caption := cArchParams_Msg06; F_BlockParams.edAddition.Value := FloatInUOM(RoofTopPointsH, umM, FUOM); try //24.04.2012 FSCS_Main.aBlockParams.Execute; FSCS_Main.ShowBlockParamsForPopupFigure(false, false); finally F_BlockParams.Caption := F_BlockParams.FSrcCaption; F_BlockParams.lbHeight.Caption := SavedlbHeight; F_BlockParams.pnAddition.Visible := false; end; // Меняем высоту точек пропорционально NewRoofTopPointsH := FloatInUOM(F_BlockParams.edAddition.Value, FUOM, umM); if (RoofTopPointsH > 0) and (NewRoofTopPointsH > 0) and (NewRoofTopPointsH <> RoofTopPointsH) then SetTopArchCornersHeight(RoofTopPoints, RoofTopPointsH, NewRoofTopPointsH); FreeAndNil(RoofTopPoints);} end; end; end; end; end; end; procedure TF_MAIN.GT_ConnectionsRelTypePropertiesValidate(Sender: TObject; var DisplayValue: Variant; var ErrorText: TCaption; var Error: Boolean); var SavedEvent: TcxEditValidateEvent; SCSComponent: TSCSComponent; JoinedCompon: TSCSComponent; Complect: PComplect; IDJoined: Integer; begin Error := false; if DisplayValue = '' then begin DisplayValue := GetConnectionRelTypeName(DM.MemTable_Connections.FieldByName(fnRelType).AsInteger); Exit; ///// EXIT ///// end; SavedEvent := TcxCurrencyEdit(Sender).Properties.OnValidate; TcxCurrencyEdit(Sender).Properties.OnValidate := nil; try DM.MemTable_Connections.Edit; DM.MemTable_Connections.FieldByName(fnRelType).AsInteger := TcxCustomEdit(Sender).EditValue; DM.MemTable_Connections.Post; SaveSelectedConnection; //SCSComponent := GetActualSelectedComponent; //if SCSComponent <> nil then // if DM.MemTable_Connections.RecordCount > 0 then // begin // Complect := SCSComponent.GetConnectionByID(DM.MemTable_Connections.FieldByName(fnID).AsInteger); //PComplect(DM.MemTable_Connections.FieldByName(fnObjectAddress).AsInteger); // if Complect = nil then // begin // IDJoined := 0; // if DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger = SCSComponent.ID then // IDJoined := DM.MemTable_Connections.FieldByName(fnIDChild).AsInteger // else if DM.MemTable_Connections.FieldByName(fnIDChild).AsInteger = SCSComponent.ID then // IDJoined := DM.MemTable_Connections.FieldByName(fnIDComponent).AsInteger; // JoinedCompon := SCSComponent.ProjectOwner.GetComponentFromReferences(IDJoined); // if JoinedCompon <> nil then // Complect := JoinedCompon.GetConnectionByID(DM.MemTable_Connections.FieldByName(fnID).AsInteger); // end; // if Complect <> nil then // begin // Complect^.RelType := TcxCustomEdit(Sender).EditValue; // SetProjectChanged(true); // end; // end; finally TcxCurrencyEdit(Sender).Properties.OnValidate := SavedEvent; end; end; procedure TF_MAIN.GT_ConnectionsEditValueChanged( Sender: TcxCustomGridTableView; AItem: TcxCustomGridTableItem); begin PostGridTableView(Sender, DM.MemTable_Connections); end; procedure TF_MAIN.Act_ShowCADObjectViewExecute(Sender: TObject); begin ShowCADObjectView(false); end; procedure TF_MAIN.tsComponentsResize(Sender: TObject); begin // end; procedure TF_MAIN.Act_SetComponGrpNameExecute(Sender: TObject); var Nodes: TList; i: Integer; ComponList: TSCSComponents; Compon: TSCSComponent; Val: String; procedure HandleNode(ANode: TTreeNode); var Dat: PObjectData; Compon, Child: TSCSComponent; i: Integer; begin Dat := ANode.Data; if IsComponItemType(Dat.ItemType) then begin Compon := GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Compon <> nil then begin if ComponList.IndexOf(Compon) = -1 then ComponList.Add(Compon); for i := 0 to Compon.ChildReferences.Count - 1 do begin Child := Compon.ChildReferences[i]; if ComponList.IndexOf(Child) = -1 then ComponList.Add(Child); end; end; end; end; procedure StepNode(ANode: TTreeNode); var Dat: PObjectData; CurrNode: TTreeNode; begin HandleNode(ANode); CurrNode := ANode.getFirstChild; while CurrNode <> nil do begin StepNode(CurrNode); CurrNode := CurrNode.getNextSibling; end; end; begin try Nodes := TList.Create; Tree_Catalog.GetSelections(Nodes); Val := ''; if InputQuery(ApplicationName, cMain_Msg195, Val) then begin ComponList := TSCSComponents.Create(false); for i := 0 to Nodes.Count - 1 do StepNode(TTreeNode(Nodes[i])); for i := 0 to ComponList.Count - 1 do begin Compon := ComponList[i]; AddPropsToComponFromSprBySN(Compon, pnGroupName); Compon.SetPropertyValueAsString(pnGroupName, Val); end; ComponList.Free; RefreshNode(true); end; Nodes.Free; except on E: Exception do AddExceptionToLogExt(ClassName, 'Act_SetComponGrpNameExecute', E.Message); end; end; procedure TF_MAIN.BalloonHintsShowHint(var HintStr: String; var CanShow: Boolean; var HintInfo: THintInfo); begin // end; // Tolik 10/04/2020 -- procedure TF_MAIN.Act_ReindexComponentPortsExecute(Sender: TObject); var ComponList: TList; i: integer; sNode: TTreeNode; currCompon: TSCSComponent; begin if not Assigned(F_PortsReIndex) then Application.CreateForm(TF_PortsReIndex, F_PortsReIndex); F_PortsReIndex.ShowModal; { if F_PortsReIndex.Showmodal = mrOK then begin currCompon := nil; ComponList := Nil; try if F_ProjMan.Tree_Catalog.SelectionCount > 0 then begin ComponList := TList.Create; for i := 0 to F_ProjMan.Tree_Catalog.SelectionCount - 1 do begin sNode := F_ProjMan.Tree_Catalog.Selections[i]; if sNode <> nil then begin if sNode.Data <> nil then begin if PObjectData(sNode.Data).ObjectID > -1 then currCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferencesList(PObjectData(sNode.Data).ListID, PObjectData(sNode.Data).ObjectID); if currCompon <> nil then begin if currCompon.IsLine = biFalse then ComponList.Add(currCompon); end; end; end; end; if ComponList.Count > 0 then begin if ComponList.Count > 1 then SortComponListByPM(ComponList); DM.DefineComponNppPorts(ComponList); end; end; except on E: Exception do AddExceptionToLog('TF_MAIN.Act_ReindexComponentPortsExecute: '+E.Message); end; if ComponList <> nil then ComponList.Free; end; } end; { procedure TF_MAIN.Act_ReindexComponentPortsExecute(Sender: TObject); var Compon: TSCSComponent; begin //Act_ReindexComponentPorts. Compon := GetActualSelectedComponent; if Compon <> nil then DM.DefineComponNppPorts(Compon); end; } // procedure TF_MAIN.Act_ShowRepResourcesExecute(Sender: TObject); begin if GDBMode = bkProjectManager then if GSCSBase.SCSCatalog.ID <> 0 then CreateFReportForm.Execute(GetActualSelectedCatalog, cBaseCommon32, fmRResources, true, true, true); end; procedure TF_MAIN.Act_CrossConnectionExecute(Sender: TObject); begin CreateFResourceReport.ShowCrossConnectionWizard(GetActualSelectedComponent); end; procedure TF_MAIN.N33AdvancedDrawItem(Sender: TObject; ACanvas: TCanvas; ARect: TRect; State: TOwnerDrawState); var OutText: string; begin {$IF Defined(SCS_PE)} 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.FillRect(ARect); DrawText(ACanvas.Handle, PChar(OutText), -1, ARect, DT_VCENTER or dt_LEFT or dt_singleline); end; {$ELSE} if (odFocused in State) or (odSelected in State) then begin end else begin OutText := (Sender as TMenuItem).Caption; ACanvas.Font.Style := [fsBold]; ARect.Left := 32; ARect.Right := ARect.Right - 32; ACanvas.FillRect(ARect); DrawText(ACanvas.Handle, PChar(OutText), -1, ARect, DT_VCENTER or dt_LEFT or dt_singleline); end; {$IFEND} end; procedure TF_MAIN.GT_NormsResourcesLaborTimeGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin AText := GetDisplayTextToNORMLaborTime(AText); end; procedure TF_MAIN.Act_AutoSetGraphicObjectsExecute(Sender: TObject); var Node: TTreeNode; NodeDat: PObjectData; ComponIDs: TIntList; SCSCatalog: TSCSCatalog; SCSComponents: TSCSComponents; SCSComponent: TSCSComponent; i: Integer; FieldsToSave: TStringList; MsgRes: integer; begin if GDBMode = bkNormBase then begin Node := Tree_Catalog.Selected; NodeDat := nil; if Node <> nil then NodeDat := Node.Data; if NodeDat <> nil then begin if NodeDat.ItemType = itDir then begin ComponIDs := DM.GetCatalogAllComponIDs(NodeDat.ObjectID, true); //ApplyComponFilterToListIDs(ComponIDs); SCSComponents := TSCSComponents.Create(true); FieldsToSave := TStringList.Create; try if ComponIDs.Count = 0 then MessageModal(cMain_Msg104, ApplicationName, MB_ICONINFORMATION or MB_OK) else begin MsgRes := MessageModal(cMain_Msg201, ApplicationName, MB_ICONINFORMATION or MB_YESNOCANCEL); if MsgRes <> ID_Cancel then begin FieldsToSave.Add(fnIDSymbol); F_Animate.GMaxProgressPos := ComponIDs.Count * 3; F_Animate.StartAnimate(cMain_Msg200, aviCopyFiles, aiProgressBar); try for i := 0 to ComponIDs.Count - 1 do begin SCSComponent := TSCSComponent.Create(Self); SCSComponent.LoadComponentByID(ComponIDs[i], false, i=0); SCSComponents.Add(SCSComponent); F_Animate.SetProgressPos(i); end; for i := 0 to ComponIDs.Count - 1 do begin SCSComponent := SCSComponents[i]; if (SCSComponent.IDSymbol = 0) or (MsgRes = ID_NO) then begin if Trim(SCSComponent.ArticulProducer) <> '' then begin SetSQLToFIBQuery(DM.Query_Select, GetSQLByParams(qtSelect, tnObjectIcons, '"' + fnName + '" = :NAME_S', nil, fnAll)); DM.Query_Select.Params[0].AsString := Trim(SCSComponent.ArticulProducer); DM.Query_Select.ExecQuery; if DM.Query_Select.RecordCount > 0 then if DM.Query_Select.FieldByName('ID').asInteger <> 0 then SCSComponent.IDSymbol := DM.Query_Select.FieldByName('ID').asInteger; end; end; F_Animate.SetProgressPos(ComponIDs.Count + i); end; SetSQLToFIBQuery(DM.Query_Operat, GetSQLByParams(qtUpdate, tnComponent, fnID+' = :'+fnID, FieldsToSave, ''), false); for i := 0 to ComponIDs.Count - 1 do begin SCSComponent := SCSComponents[i]; if SCSComponent.IDSymbol <> 0 then begin DM.Query_Operat.Close; DM.Query_Operat.ParamByName(fnID).AsInteger := SCSComponent.ID; DM.Query_Operat.ParamByName(fnIDSymbol).AsInteger := SCSComponent.IDSymbol; DM.Query_Operat.ExecQuery; DM.Query_Operat.Close; end; F_Animate.SetProgressPos(ComponIDs.Count*2 + i); end; except end; F_Animate.StopAnimate; end; end; finally FieldsToSave.Free; SCSComponents.Free; ComponIDs.Free; end; end; end; end; end; // Показать повороты(изгибы) кабеля Procedure TF_Main.ShowCableSwerves(ACatalog : TSCSCatalog); Var CurrCatalog: TSCSCatalog; SCSComponent: TSCSComponent; CableIds : TIntList; i,j,k: integer; SCScomponents : TSCSComponents; ListCad : TF_Cad; CurrList, NextList: TSCSList; Figure : TFigure; FirstCatalog, NextCatalog : TSCSCatalog; s : TStringList; Connector1, Connector2, Connector3, Connector4 : TConnectorObject; currTrace,NextTrace : TFigure; // трассы, по которым проходит кабель CurrAngle : double; LookedComponents : TIntList; AnglesList : TStringList; TakeThisCable : boolean; function GetListName(AComponent: TSCSComponent): String; var //ListCatalog: TCatalog; SCSList: TSCSList; begin Result := ''; SCSList := nil; SCSList := AComponent.GetListOwner; //TF_Main(GForm).GSCSBase.CurrProject.GetListBySCSID(AIDList); if Assigned(SCSList) then Result := SCSList.GetNameForVisible(false); //ListCatalog := TF_Main(GForm).DM.GetCatalogByComponAndItemType(AIDComponent, itList); //Result := ListCatalog.Name; end; Procedure SetActualOrderInPartComponent(Component: TSCSComponent; ComponList : TSCSComponents); Var SortedWholeComponent: TIntList; my_comp, ComponentToOrder: TSCSComponent; StepComponent: TSCSComponent; JoinedComponent: TSCSComponent; i, j: Integer; portcount1, portcount2 : integer; ListOwner: TSCSList; EndPointCad : TF_CAD; PointComponent : TSCSComponent; SCSCatalog : TSCSCatalog; SCSInterfaces: TSCSInterfaces; ListName : string; FromNppPort1 : Integer; AnglesCount: Integer; Begin // SCSCatalogs := TSCSCatalogs.Create(false); SortedWholeComponent := TIntList.Create; Component.DefineFirstLast; ComponentToOrder := nil; ListOwner := Component.GetListOwner; if Component.FirstConnectedConnCompon <> nil then begin my_comp := Component.FirstConnectedConnCompon.GetTopComponent; SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount1 := SCSInterfaces.Count; // Tolik -- 20/02/2017 -*- утечка памяти SCSInterfaces.Clear; SCSInterfaces.Free; // my_comp := Component.LastConnectedConnCompon.GetTopComponent; SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount2 := SCSInterfaces.Count; // Tolik -- 20/02/2017 -*- утечка памяти SCSInterfaces.Clear; SCSInterfaces.Free; // ComponentToOrder := Component.FirstConnectedConnCompon; // Сразу же определяем порядок листов для отчета // и порт шкафа { if AResRepFormMode = fmRCableJournal then} begin if Component.FirstConnectedConnCompon.ListID = Component.LastConnectedConnCompon.ListID then ListName := GetListName(Component.FirstConnectedConnCompon) else begin if Portcount1 >= PortCount2 then ListName := GetListName(Component.FirstConnectedConnCompon)+'/'+GetListName(Component.LastConnectedConnCompon) else ListName := GetListName(Component.LastConnectedConnCompon)+'/'+GetListName(Component.FirstConnectedConnCompon); end; end; end; if PortCount1 >= PortCount2 then ComponentToOrder := Component.FirstConnectedConnCompon else begin ComponentToOrder := Component.LastConnectedConnCompon; Component.LastConnectedConnCompon := Component.FirstConnectedConnCompon; Component.FirstConnectedConnCompon := ComponentToOrder; end; FromNppPort1 := Component.FirstConnectedConnCompon.MarkID ; if Component<> nil then begin for i := 0 to Component.WholeComponent.Count - 1 do begin for j := 0 to ComponentToOrder.JoinedComponents.Count - 1 do begin StepComponent := ComponentToOrder.JoinedComponents[j]; if ((SortedWholeComponent.IndexOf(StepComponent.ID)= -1) and (Component.WholeComponent.IndexOf(StepComponent.ID)<> -1)) then begin SortedWholeComponent.Add(StepComponent.ID); ComponList.Add(StepComponent); ComponentToOrder := StepComponent; SCSCatalog := StepComponent.GetFirstParentCatalog; break; end; end; end; end; ComponentToOrder := Component; //*** Не один участок кабеля не ушел в пизду if ComponentToOrder.WholeComponent.Count = SortedWholeComponent.Count then begin ComponentToOrder.WholeComponent.Clear; ComponentToOrder.WholeComponent.Assign(SortedWholeComponent); end; SortedWholeComponent.Free; End; Begin s := TStringList.Create; //CableIds := TIntList.Create; LookedComponents := TIntList.Create; for i := 0 to ACatalog.ComponentReferences.count - 1 do begin SCSComponent := ACatalog.ComponentReferences[i]; // если нашли кабель if CheckSysNameIsCable(SCSComponent.ComponentType.SysName) then begin SCSComponent.LoadWholeComponent(false); TakeThisCable := true; if LookedComponents.Count > 1 then begin for j := 0 to LookedComponents.Count-1 do begin if LookedComponents[j] = SCSComponent.WholeComponent[0] then begin TakeThisCable := false; break; end; end; end; // если кабель еще не попадался, считаем углы if TakeThisCable then begin SCSComponent.LoadWholeComponent(false); // если кусков кабеля больше одного, будем искать повороты if (SCSComponent.WholeComponent.Count > 1) then begin // добавляем айдишники кусков кабеля по всей длине в список отобранных, // чтобы при обнаруженнии следующего куска кабеля снова не обрабатывать // тот же цельный кабель for j := 0 to SCSComponent.WholeComponent.Count - 1 do LookedComponents.Add(SCSComponent.WholeComponent[j]); //SCSComponent.DefineFirstLast(true); SCSComponents := F_ProjMan.GSCSBase.CurrProject.GetComponentsByWholeID(SCSComponent.Whole_ID); for j := 0 to SCSComponents.Count - 2 do begin SCSComponent := SCSComponents[j]; FirstCatalog := SCSComponent.GetFirstParentCatalog; // SCSComponent := SCSComponents[j+1]; NextCatalog := SCSComponent.GetFirstParentCatalog; // currList := FirstCatalog.GetListOwner; nextList := NextCatalog.GetListOwner; begin // получаем линии, между которыми нужно вычислить угол поворота ListCad := GetListByID(FirstCatalog.GetListOwner.SCSID); CurrTrace := TOrthoLine(GetFigureByID(ListCad,FirstCatalog.SCSID)); ListCad := GetListByID(NextCatalog.GetListOwner.SCSID); NextTrace := TOrthoLine(GetFigureByID(ListCad,NextCatalog.SCSID)); { CurrTrace.select; NextTrace.Select;} CurrTrace.Selected := true; // NextTrace.Selected := true; // ищем стык (коннектор) connector1 := TConnectorObject(Tortholine(CurrTrace).JoinConnector1); // showmessage(inttostr(connector1.ID)); connector2 := TConnectorObject(Tortholine(CurrTrace).JoinConnector2); // showmessage(inttostr(connector2.ID)); connector3 := TConnectorObject(Tortholine(NextTrace).JoinConnector1); // showmessage(inttostr(connector3.ID)); connector4 := TConnectorObject(Tortholine(NextTrace).JoinConnector2); // showmessage(inttostr(connector4.ID)); CurrAngle := -1; if (connector1 <> nil) and ((connector1 = connector3) or (connector1 = connector4)) then begin CurrAngle := CalcAngleBetweenLines(TOrthoLine(currTrace),TOrthoLine(NextTrace), connector1); if (CurrAngle < 30) and (CurrAngle<>0) then begin showmessage(floattostr(CurrAngle)); end; end else if (connector2 <> nil) and ((connector2 = connector3) or (connector2 = connector4)) then begin CurrAngle := CalcAngleBetweenLines(TOrthoLine(currTrace),TOrthoLine(NextTrace), connector2); if CurrAngle < 30 then begin // CurrTrace.select; // NextTrace.Select; showmessage(floattostr(CurrAngle)); end; end; if CurrAngle >= 0 then s.Add(floattostr(CurrAngle)); end; end; SCSComponents.free; // Tolik 11/05/2019 -- end; end; // if Cable end; // перебор компонент end; if LookedComponents.Count > 0 then FreeAndNil(LookedComponents); // F_InterfaceInfo.TreeView.Enabled := false; // F_InterFaceInfo.RzPageControl1.Show; // F_InterFaceInfo.FlyTreeViewPro1.Name := '12345678'; // F_InterFaceInfo.FlyTreeViewPro1.Items.Items[0].Caption:='1'; // F_InterFaceInfo.Caption := 'ShowCableSwerves'; // F_InterfaceInfo.Execute(iimCablesNoInCanals, ACatalog); F_InterfaceInfo.showmodal; s.free; End; procedure TF_MAIN.Act_CableSwervesExecute(Sender: TObject); begin // if Not Assigned(GSCSBase.CurrProject.CurrList) then Exit; ///// EXIT ///// if Assigned(GSCSBase.CurrProject) then begin ShowCableSwerves(GSCSBase.CurrProject.CurrList); end; end; //Все,как всегда через (_*_) procedure TF_MAIN.Act_PatternMarkingExecute(Sender: TObject); var Spravochnik: TSpravochnik; List: TSCSList; NBComponentType: TNBComponentType; NewMarkMask,ANeedGUID, ACurrentGuid: String; ListParams: TListParams; i: integer; MyForm: TF_CaseForm; SCSCompon: TSCSComponent; Find, aIsLine: boolean; CurrNode: TTreenode; begin GCadForm.SaveForUndo(uat_None, True, False); Find := false; List := nil; Spravochnik := nil; ACurrentGuid := GSCSBase.SCSComponent.GUIDComponentType; aIsLine := Boolean(GSCSBase.SCSComponent.IsLine); CurrNode := GetNodeByObj(GSCSBase.SCSComponent); if F_ProjMan <> nil then if (F_ProjMan.GSCSBase <> nil) and (F_ProjMan.GSCSBase.CurrProject <> nil) then if F_ProjMan.GSCSBase.CurrProject.CurrList <> nil then begin ListParams := F_ProjMan.GSCSBase.CurrProject.CurrList.GetParams; List := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(ListParams.ID); end; //Если в настройках листа не стоит "Маркировка бла-бла-бла..." if List.Setting.ShowObjectTypeCAD = st_Short then if not aIsLine then MessageModal(lng_Forms.GetText('ListSettings'), lng_Forms.GetText('WarningID'), MB_OK); try //Эта форма нужна, чтоб как-то достучаться к базе MyForm := TF_CaseForm.Create(F_ProjMan, F_ProjMan, F_MasterNewList, itList); if List <> nil then begin Spravochnik := List.Spravochnik; end; MyForm.FSpravochnik := Spravochnik; //Если не стоит галочка "Использовать маркировку в подписях" if GSCSBase.SCSComponent.IsMarkInCaptions = 0 then begin CASE MessageModal(lng_Forms.GetText('CustomizeTemplate'), lng_Forms.GetText('WarningID'),MB_YESNOCANCEL) of IDYES: begin //Ищем первый попавшийся чилд,у которого стоит(Мужик)..."Использовать маркировку в подписях" for i := 0 to GSCSBase.SCSCatalog.SCSComponents[0].ChildReferences.Count - 1 do begin SCSCompon := F_ProjMan.GSCSBase.SCSCatalog.SCSComponents[0].ChildReferences[i]; ScSCOmpon := GSCSBase.CurrProject.GetComponentFromReferences(SCSCompon.ID); CurrNode := GetNodeByObj(ScSCOmpon); if SCSCompon.IsMarkInCaptions = 1 then begin Find := true; ACurrentGuid := SCSCompon.GUIDComponentType; Tree_Catalog.Select(CurrNode); break; end; end; end; IDNO: Begin ACurrentGuid := GSCSBase.SCSComponent.GUIDComponentType; Find := true; end; IDCANCEL: Exit; end; end else Find := true; if not Find then if MessageModal(lng_Forms.GetText('HaveNoTemplate'), lng_Forms.GetText('WarningID'),MB_YESNO) <> ID_YES then exit; //Тут заполняем нашу базу for i := 0 to Spravochnik.ComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(Spravochnik.ComponentTypes[i]); if ACurrentGuid = NBComponentType.ComponentType.GUID then begin //Если нашли нужный нам компон, запоминаем его шаблок маркировки NewMarkMask := NBComponentType.ComponentType.MarkMask; ANeedGUID := NBComponentType.ComponentType.GUID; end; MyForm.AddComponentTypeToMemTable(NBComponentType, false); end; //Локейтим базу MyForm.mtComponentType.Locate('GUID', ANeedGUID, []); //Создаем сразу форму редактирования шаблона маркировки ShowCheckBoxOnTemplateMarkForm := true; if TF_Main(F_MakeEditComponentType.GForm).CreateFMarkMask.MakeEditMarkMask(fmEdit, NewMarkMask) then begin MyForm.mtComponentType.Edit; MyForm.mtComponentType.FieldByName('MARK_MASK').AsString := NewMarkMask; MyForm.mtComponentType.FieldByName(fnIsModified).AsBoolean := true; MyForm.mtComponentType.Post; LoadFromFormToItemSpravochnik(MyForm, ListParams.ID, itList,itList,F_MarkMask.ForAllObjOnList.Checked, F_MarkMask.OnlyForSelectedObj.Checked,false,false,false,false, [vkComponentType],@ListParams); end; ShowCheckBoxOnTemplateMarkForm := false; except end; FreeAndNil(MyForm); end; // Tolik procedure TF_MAIN.Act_SelAllWithSimilarPropsExecute(Sender: TObject); var SCSComponent, SCSCompon : TSCSComponent; i: integer; Prop: PProperty; ACAD: TF_CAD; List: TSCSList; ACatalog: TSCSCatalog; ACatalogs: TSCSCatalogs; CatalogChecked: boolean; Compons: TSCSComponents; SameProp: boolean; figure: TFigure; afigures, anodes: TList; Node: TTreeNode; Procedure CheckProps(PSysName, PValue : string; CheckSameType: boolean); var Compon: TSCScomponent; i,j: integer; Pprop: PProperty; found: boolean; begin found := false; if List <> nil then begin // проверяем все компоненты листа for i := 0 to List.ComponentReferences.Count - 1 do begin found := false; Compon := List.ComponentReferences[i]; // Compon.SaveComponent; if Compon <> nil then begin if Compon.IsLine = 1 then Compon.RefreshWholeLengthIfNecessary; // проверяем наличие свойства for j := 0 to Compon.Properties.Count - 1 do begin Pprop := Compon.Properties[j]; // если отмечать только того же типа if CheckSameType then begin if (Pprop.SysName = PSysName) then begin if (Pprop.Value = PValue) then begin if (Compon.ComponentType.SysName = SCSComponent.ComponentType.SysName) then begin found := true; break; end; end; end; end // если отмечать теми просто с же значениями else begin if ((Pprop.SysName = PSysName) and (Pprop.Value = PValue)) then begin found := true; break; end; end; end; // если свойства компонента подходят, добавляем в список if found then begin Compons.Add(Compon); end; end; end; end; end; begin SCSComponent := GetActualSelectedComponent; ACatalog := nil; ACatalogs := nil; List := nil; Compons := nil; SameProp := false; // на всякий Compons := TSCSComponents.Create(false); afigures := TList.Create; anodes := TList.Create; // если есть таблица свойств if not DM.MemTable_Property.IsEmpty then begin // текущий лист List := F_ProjMan.GSCSBase.CurrProject.CurrList; // КАД текущего листа ACAD := GetListByID(List.SCSID); if ACAD <> nil then begin if MessageModal(SelectCompon_Msg1, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then SameProp := true; CheckProps(DM.MemTable_Property.FieldValues['SYSNAME'], DM.MemTable_Property.FieldValues['PVALUE'], SameProp); // если нашли компоненты с такими же свойствами, делаем выделение // снимаем текущее выделение if Compons <> nil then begin for i := 0 to Compons.Count - 1 do begin SCSCompon := Compons[i]; figure := nil; figure := GetFigureByID(ACAD,SCSCompon.GetFirstParentCatalog.SCSID); node := FindComponOrDirInTree(SCScompon.ID, true); // node := SCSCompon.TreeViewNode; if node <> nil then begin anodes.Add(node); if not node.IsVisible then begin while Not Node.IsVisible do begin Node.Parent.Expanded := true; Node := Node.Parent; if Node = nil then Break; //// BREAK //// end; end; end; if figure <> nil then begin if Figure.Selected then Figure.Selected := false; afigures.Add(figure); end; end; // выделяем if afigures.Count > 0 then ACad.PCad.SelectFigures(afigures); if anodes.Count > 0 then begin Tree_Catalog.ClearSelection; Tree_Catalog.select(anodes); end; Tree_Catalog.Refresh; end; end; end; if Compons <> nil then FreeAndNil(Compons); if aFigures <> nil then FreeAndNil(aFigures); if aNodes <> nil then FreeAndNil(aNodes); end; (* Procedure ShowTracesIntersections(aCrossType: Integer); var LinesCrossPoint: TDoublePoint; i,j: Integer; PointList, LineList, CrossLineList: TList; CurrLine, CrossLine: TOrthoLine; CrossInfo: POrthoLineCrossInfo; RefreshFlag: Boolean; CanAddPoint: Boolean; LineKoeff: Double; Z1, Z2: Double; CadForm, oldGCadForm: Tf_Cad; function CheckForNearPoints(aTrace: TOrthoLine; aPoint: TDoublePoint): Boolean; var i: Integer; begin Result := False; if aTrace.CrossList.Count > 0 then begin for i := 0 to aTrace.CrossList.Count - 1 do begin if PointNear(POrthoLineCrossInfo(aTrace.CrossList[i]).StartPoint, aPoint, 2) then Result := True else if PointNear(POrthoLineCrossInfo(aTrace.CrossList[i]).EndPoint, aPoint, 2) then Result := True; if Result then break; end; end else begin if PointNear(aTrace.JoinConnector1.ap1, aPoint, 2) then Result := True else begin if PointNear(aTrace.JoinConnector2.ap1, aPoint, 2) then Result := True; end; end; end; Procedure AddPointtoLine(aLine, CrossLine: TOrthoLine; aPoint: TDoublePoint; aPointColor: Integer); var FirstLinePoint: TDoublePoint; dist1, dist2: Double; begin dist1 := Sqrt(sqr(aLine.AP1.x) + sqr(aLine.AP1.y)); dist2 := Sqrt(sqr(aLine.AP2.x) + sqr(aLine.AP2.y)); //начальная точка ортолинии if CompareValue(dist1, dist2) = -1 then FirstLinePoint := aLine.AP1 else FirstLinePoint := aLine.AP2; New(CrossInfo); CrossInfo.CrossLineID := CrossLine.ID; CrossInfo.StartPoint.x := aPoint.x; CrossInfo.StartPoint.y := aPoint.y; CrossInfo.isDrawPoint := True; if aPointColor = 0 then CrossInfo.DrawColor := aLine.FDrawColor else CrossInfo.DrawColor := aPointColor; CrossInfo.disttoFirstPoint := SQRT(Sqr(aPoint.x - FirstLinePoint.x) +Sqr(aPoint.y - FirstLinePoint.y)); if aLine.CrossList.Count = 0 then begin aLine.CrossList.Add(CrossInfo); end else begin aLine.CrossList.Add(CrossInfo); end; // Здесь пересечение не рисуем, но точку учитываем, чтобы не прорисовывать над ней УГО // трассы, если есть ложемент, гофра и т.п., чтобы было видно, что здесь будут проблемы с его установкой New(CrossInfo); CrossInfo.CrossLineID := aLine.ID; CrossInfo.StartPoint.x := aPoint.x; CrossInfo.StartPoint.y := aPoint.y; CrossInfo.isDrawPoint := False; //CrossInfo.DrawColor := aPointColor; dist1 := Sqrt(sqr(CrossLine.AP1.x) + sqr(CrossLine.AP1.y)); dist2 := Sqrt(sqr(CrossLine.AP2.x) + sqr(CrossLine.AP2.y)); //начальная точка ортолинии if CompareValue(dist1, dist2) = -1 then FirstLinePoint := CrossLine.AP1 else FirstLinePoint := CrossLine.AP2; CrossInfo.disttoFirstPoint := SQRT(Sqr(aPoint.x - FirstLinePoint.x) +Sqr(aPoint.y - FirstLinePoint.y)); CrossLine.CrossList.Add(CrossInfo); end; Procedure GetPointColor(aTrace1, aTrace2: TOrthoLine; aCrossPoint: TDoublePoint; var aPointColor: Integer); var //z1, z2: Double; CrossPointsDist: Double; LineCatalog1, LineCatalog2: TSCSCatalog; Line1Width, Line2Width: Double; i: integer; currCad: TF_Cad; CadList: TSCSCatalog; SCSComponent: TSCSComponent; ComponProp: PProperty; BetweenLineDelta, ComponHeight: Double; FirstLineHasCableChannel, SecondLineHasCableChannel: Boolean; begin BetweenLineDelta := 0.02;// 2 см FirstLineHasCableChannel := False; SecondLineHasCableChannel := False; // высота первой точки пересечения { LineKoeff := (aCrossPoint.x - aTrace1.AP1.x)/(aTrace1.Ap2.x - aTrace1.Ap1.x); z1 := LineKoeff*(aTrace1.ActualZOrder[2] - aTrace1.ActualZOrder[1]) + aTrace1.ActualZOrder[1]; // высота первой точки пересечения LineKoeff := (aCrossPoint.x - aTrace2.AP1.x)/(aTrace2.Ap2.x - aTrace2.Ap1.x); z2 := LineKoeff*(aTrace2.ActualZOrder[2] - aTrace2.ActualZOrder[1]) + aTrace2.ActualZOrder[1]; } if CompareValue(z1, z2) = 0 then begin aPointColor := 255; end; CrossPointsDist := ABS(z2 - z1);// расстояние между точками по Z currCad := Nil; // КАД, на котором сидят трассы if aTrace1.Owner <> nil then if TPowerCad(aTrace1.Owner).Owner <> nil then currCad := TF_Cad(TPowerCad(aTrace1.Owner).Owner); if currCad = nil then exit; CadList := Nil; // лист (в ПМ) CadList := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(currCaD.FCADListID); if CadList = nil then exit; LineCatalog1 := CadList.GetCatalogFromReferencesBySCSID(aTrace1.ID); LineCatalog2 := CadList.GetCatalogFromReferencesBySCSID(aTrace2.ID); if LineCatalog1 = nil then exit; if LineCatalog2 = nil then exit; //если хоть одна трасса пустая - точку добавлять не нужно if LineCatalog1.ComponentReferences.Count = 0 then exit; if LineCatalog2.ComponentReferences.Count = 0 then exit; Line1Width := 0.01; Line2Width := 0.01; for i := 0 to LineCatalog1.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(LineCatalog1.ComponentReferences[i]); if SCSComponent.ComponentType.SysName = ctsnCableChannel then FirstLineHasCableChannel := true; // есть каб канал на трассе ComponProp := SCSComponent.GetPropertyBySysName(pnHeight); // если есть высота каб канала/гофры и т.п. if ComponProp <> nil then begin ComponHeight := UOMToMetre(StrToFloat_My(ComponProp.Value))/2; if CompareValue(Line1Width, ComponHeight) = -1 then Line1Width := ComponHeight; end; // если нет высоты -- смотрим сечения if ComponProp = nil then begin ComponProp := SCSComponent.GetPropertyBySysName(pnOutSection); // внешнее сечение if ComponProp = nil then ComponProp := SCSComponent.GetPropertyBySysName(pnInSection); // внутр сечение if ComponProp <> nil then begin ComponHeight := Sqrt(StrToFloat_My(ComponProp.Value))/200; if CompareValue(Line1Width, ComponHeight) = -1 then Line1Width := ComponHeight; end; end; // если нет сечений -- смотрим диаметры {if ComponProp = nil then begin ComponProp := SCSComponent.GetPropertyBySysName(pnOutDiametr) // внешнее сечение if ComponProp = nil then ComponProp := SCSComponent.GetPropertyBySysName(pnInDiametr) // внутр сечение end; } end; for i := 0 to LineCatalog2.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(LineCatalog2.ComponentReferences[i]); if SCSComponent.ComponentType.SysName = ctsnCableChannel then SecondLineHasCableChannel := true; // есть каб канал на трассе ComponProp := SCSComponent.GetPropertyBySysName(pnHeight); if ComponProp <> nil then begin ComponHeight := UOMToMetre(StrToFloat_My(ComponProp.Value))/2; if CompareValue(Line2Width, ComponHeight) = -1 then Line2Width := ComponHeight; end; // если нет высоты -- смотрим сечения if ComponProp = nil then begin ComponProp := SCSComponent.GetPropertyBySysName(pnOutSection); // внешнее сечение if ComponProp = nil then ComponProp := SCSComponent.GetPropertyBySysName(pnInSection); // внутр сечение if ComponProp <> nil then begin ComponHeight := Sqrt(StrToFloat_My(ComponProp.Value))/200; if CompareValue(Line2Width, ComponHeight) = -1 then Line2Width := ComponHeight; end; end; end; if CompareValue(UOMToMetre(ABS(z1-z2)), (Line1Width + Line2Width)) = -1 then begin if FirstLineHasCableChannel then begin if SecondLineHasCableChannel then aPointColor := 255; end else aPointColor := clFuchsia; end else if CompareValue(UOMToMetre(ABS(z1-z2)) - (Line1Width + Line2Width), BetweenLineDelta) = -1 then aPointColor := clFuchsia; // если между трассами end; // Добавить точку пересечения в трассы (в зависимости от того, на которой страссе ) // будем отрисовывать пересечение Procedure AddCrossPointToTraces(aTrace1, aTrace2: TOrthoLine; aCrossPoint: TDoublePoint); var UpLine, DownLine: TOrthoLine; PointColor: Integer; begin if Assigned(aTrace1.JoinConnector1) and Assigned(aTrace1.JoinConnector2) and Assigned(aTrace2.JoinConnector1) and Assigned(aTrace2.JoinConnector2) then if (not aTrace1.JoinConnector1.Deleted) and (not aTrace1.JoinConnector2.deleted) and (not aTrace2.JoinConnector1.Deleted) and (not aTrace2.JoinConnector2.deleted) then begin // высота первой точки пересечения if CompareValue(aTrace1.Ap1.x, aTrace1.Ap2.x) <> 0 then LineKoeff := (aCrossPoint.x - aTrace1.AP1.x)/(aTrace1.ap2.x - aTrace1.AP1.x) else if CompareValue(aTrace1.ap1.y, aTrace1.ap2.y) <> 0 then LineKoeff := (aCrossPoint.y - aTrace1.AP1.y)/(aTrace1.ap2.y - aTrace1.AP1.y); z1 := LineKoeff*(aTrace1.ActualZOrder[2] - aTrace1.ActualZOrder[1]) + aTrace1.ActualZOrder[1]; // высота первой точки пересечения //LineKoeff := (aCrossPoint.x - aTrace2.JoinConnector1.AP1.x)/(aTrace2.Joinconnector2.Ap1.x - aTrace2.JoinConnector1.Ap1.x); if CompareValue(aTrace2.Ap1.x, aTrace2.Ap2.x) <> 0 then LineKoeff := (aCrossPoint.x - aTrace2.AP1.x)/(aTrace2.ap2.x - aTrace2.AP1.x) else if CompareValue(aTrace2.ap1.y, aTrace2.ap2.y) <> 0 then LineKoeff := (aCrossPoint.y - aTrace2.AP1.y)/(aTrace2.ap2.y - aTrace2.AP1.y); z2 := LineKoeff*(aTrace2.ActualZOrder[2] - aTrace2.ActualZOrder[1]) + aTrace2.ActualZOrder[1]; CanAddPoint := False; UpLine := aTrace1; DownLine := aTrace2; if comparevalue(z1, z2) = -1 then begin UpLine := aTrace2; DownLine := aTrace1; end; if checkForNearPoints(UpLine, LinesCrossPoint) then begin if not CheckForNearPoints(DownLine, LinesCrossPoint) then begin if UpLine = aTrace1 then begin UpLine := aTrace2; DownLine := aTrace1; end else begin UpLine := aTrace1; DownLine := aTrace2; end; CanAddPoint := True; end; end else CanAddPoint := True; if CanAddPoint then // можно добавить точку begin PointColor := UpLine.FDrawColor; // черный - по умолчанию GetPointColor(UpLine, DownLine, LinesCrossPoint, PointColor); AddPointToLine(UpLine, DownLine, LinesCrossPoint, PointColor); end; end; end; Procedure SortCrossList(aLine: TOrthoLine); var CansortList: Boolean; i, CheckIndex: Integer; TempCrossInfo, CrossSortInfo: POrthoLineCrossInfo; StartPoint: TDoublePoint; begin CanSortList := True; StartPoint := aLine.JoinConnector1.AP1; // выбираем конец линии, относительно которого будем выполнять сортировку if CompareValue(Sqrt(sqr(aLine.JoinConnector1.AP1.x)+ sqr(aLine.JoinConnector1.AP1.y)), Sqrt(sqr(aLine.JoinConnector2.AP1.x)+ sqr(aLine.JoinConnector2.AP1.y))) = 1 then StartPoint := aLine.JoinConnector2.AP1; if aLine.CrossList.Count > 1 then begin While CanSortList do begin CanSortList := False; CheckIndex := 0; for i := 1 to aLine.CrossList.Count - 1 do begin if CompareValue(Sqrt(sqr(POrthoLineCrossInfo(aLine.CrossList[i-1]).StartPoint.x - StartPoint.x)+ sqr(POrthoLineCrossInfo(aLine.CrossList[i-1]).StartPoint.y - StartPoint.y)), Sqrt(sqr(POrthoLineCrossInfo(aLine.CrossList[i]).StartPoint.x - StartPoint.x)+ sqr(POrthoLineCrossInfo(aLine.CrossList[i]).StartPoint.y - StartPoint.y))) = 1 then begin CanSortList := True; CrossSortInfo := POrthoLineCrossInfo(aLine.CrossList[i-1]); aLine.CrossList[i-1] := aLine.CrossList[i]; aLine.CrossList[i] := CrossSortInfo; CheckIndex := i; end; end; end; end; end; begin RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; oldGCadForm := GCadForm; CrossLineList := Nil; Case aCrossType of 1: // если на проекте begin for i := 0 to F_ProjMan.GSCSBase.CurrProject.ChildCatalogs.Count - 1 do begin GCadForm := GetListByID(F_ProjMan.GSCSBase.CurrProject.ChildCatalogs[i].SCSID); if GCadForm <> nil then begin GCadForm.FListSettings.ShowTracesCrossPoints := True; ClearOrthoLinesCrossInfo(GCadForm); LineList := TList.Create; PointList := TList.Create; for j := 0 to GCadForm.FSCSFigures.Count - 1 do // Collect OrthoLines begin if checkFigureByClassName(TFigure(GCadForm.FSCSFigures[j]), cTOrthoLine) then if not TFigure(GCadForm.FSCSFigures[j]).Deleted then if not TorthoLine(TFigure(GCadForm.FSCSFigures[j])).FIsVertical then // исключить вертикали if not TorthoLine(TFigure(GCadForm.FSCSFigures[j])).FIsRaiseUpDown then // исключить райзы if LineList.IndexOf(TFigure(GCadForm.FSCSFigures[j])) = -1 then LineList.Add(TFigure(GCadForm.FSCSFigures[j])); end; if LineList.Count > 1 then begin CrossLineList := TList.Create; //определяем точки пересечения While LineList.Count > 0 do begin CurrLine := TOrthoLine(LineList[0]); LineList.Remove(CurrLine); for j := 0 to LineList.Count - 1 do begin CrossLine := TOrthoLine(LineList[j]); if GetIntersectionPoint(CurrLine.ActualPoints[1], CurrLine.ActualPoints[2], CrossLine.ActualPoints[1], CrossLine.ActualPoints[2], LinesCrossPoint,false) then //если есть точка пересечения begin //ShowMessage('There is Linear Intersection!!!'); AddCrossPointToTraces(CurrLine, CrossLine, LinesCrossPoint); end; end; if CurrLine.CrossList.Count > 1 then SortCrossList(CurrLine); if CurrLine.CrossList.Count > 0 then CurrLine.ReCreateDrawFigureBlock; end; end; LineList.Free; PointList.Free; if CrossLineList <> nil then CrossLineList.Free; { if GCadForm <> CadForm then begin oldGCadForm := GCadForm; GCadForm := CadForm; GCanRefreshCad := True; GCadForm.PCad.Refresh; GCanRefreshCad := False; GCadForm := OldGCadForm; end; } //GCanRefreshCad := RefreshFlag; GCanRefreshCad := True; GCadForm.PCad.Refresh; GCanRefreshCad := False; end; end; GCadform := OldGCadForm; GCanRefreshCad := RefreshFlag; end; 2: // если на листе begin if GCadForm <> nil then begin GCadForm.FListSettings.ShowTracesCrossPoints := True; ClearOrthoLinesCrossInfo(GCadForm); LineList := TList.Create; PointList := TList.Create; for i := 0 to GCadForm.FSCSFigures.Count - 1 do // Collect OrthoLines begin if checkFigureByClassName(TFigure(GCadForm.FSCSFigures[i]), cTOrthoLine) then if not TFigure(GCadForm.FSCSFigures[i]).Deleted then if not TorthoLine(TFigure(GCadForm.FSCSFigures[i])).FIsVertical then // исключить вертикали if not TorthoLine(TFigure(GCadForm.FSCSFigures[i])).FIsRaiseUpDown then // исключить райзы if LineList.IndexOf(TFigure(GCadForm.FSCSFigures[i])) = -1 then LineList.Add(TFigure(GCadForm.FSCSFigures[i])); end; if LineList.Count > 1 then begin CrossLineList := TList.Create; //определяем точки пересечения While LineList.Count > 0 do begin CurrLine := TOrthoLine(LineList[0]); LineList.Remove(CurrLine); for i := 0 to LineList.Count - 1 do begin CrossLine := TOrthoLine(LineList[i]); if GetIntersectionPoint(CurrLine.ActualPoints[1], CurrLine.ActualPoints[2], CrossLine.ActualPoints[1], CrossLine.ActualPoints[2], LinesCrossPoint,false) then //если есть точка пересечения begin //ShowMessage('There is Linear Intersection!!!'); AddCrossPointToTraces(CurrLine, CrossLine, LinesCrossPoint); end; end; if CurrLine.CrossList.Count > 1 then SortCrossList(CurrLine); if CurrLine.CrossList.Count > 0 then CurrLine.ReCreateDrawFigureBlock; end; end; end; LineList.Free; PointList.Free; if CrossLineList <> nil then CrossLineList.Free; end; // На листе (финиш) end; GCanRefreshCad := RefreshFlag; GCadForm.PCad.Refresh; end; *) procedure TF_MAIN.Act_ShowIntersectionsExecute(Sender: TObject); var RefreshFlag: Boolean; begin RefreshFlag := GCanRefreshCad; GCanrefreshCad := False; try if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then ShowTracesIntersections(1, 1) else if PObjectData(Tree_Catalog.Selected.Data).ItemType = itList then begin ShowTracesIntersections(2, 1); end; except on E: Exception do; end; GCanRefreshCad := RefreshFlag; GCadForm.PCad.Refresh; end; procedure TF_MAIN.Act_HideIntersectionsExecute(Sender: TObject); var i: Integer; RefreshFlag: Boolean; OldGCadForm: TF_Cad; CurListParams: TListParams; begin RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; try if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then begin OldGCadForm := GCadForm; for i := 0 to F_ProjMan.GSCSBase.CurrProject.ChildCatalogs.Count - 1 do begin GCadForm := GetListByID(F_ProjMan.GSCSBase.CurrProject.ChildCatalogs[i].SCSID); if GCadForm <> nil then begin if GCadForm.FListSettings.ShowTracesCrossPoints > 0 then begin GCadForm.FListSettings.ShowTracesCrossPoints := 0; // настройка на Каде CurListParams := GetListParams(GCadForm.FCADListID); // !!! теперь - для самого листа, а то не сохранится CurListParams.Settings.ShowTracesCrossPoints := GCadForm.FListSettings.ShowTracesCrossPoints; SaveCADListParams(GCadForm.FCADListID, CurListParams); end; ClearOrthoLinesCrossInfo(GCadForm); end; GCanRefreshCad := True; GCadForm.PCad.Refresh; GCanRefreshCad := False; end; GCadForm := OldGCadForm; end else if PObjectData(Tree_Catalog.Selected.Data).ItemType = itList then begin if GCadForm <> nil then begin if GCadForm.FListSettings.ShowTracesCrossPoints > 0 then begin GCadForm.FListSettings.ShowTracesCrossPoints := 0; // настройка на Каде CurListParams := GetListParams(GCadForm.FCADListID); // !!! теперь - для самого листа, а то не сохранится CurListParams.Settings.ShowTracesCrossPoints := GCadForm.FListSettings.ShowTracesCrossPoints; SaveCADListParams(GCadForm.FCADListID, CurListParams); end; ClearOrthoLinesCrossInfo(GCadForm); end; end; except on E: Exception do end; GCanRefreshCad := RefreshFlag; GCadForm.PCad.Refresh; end; // procedure TF_MAIN.Act_ShowCritIntersectionsExecute(Sender: TObject); var RefreshFlag: Boolean; begin RefreshFlag := GCanRefreshCad; GCanrefreshCad := False; try if PObjectData(Tree_Catalog.Selected.Data).ItemType = itProject then ShowTracesIntersections(1, 2) else if PObjectData(Tree_Catalog.Selected.Data).ItemType = itList then begin ShowTracesIntersections(2, 2); end; except on E: Exception do; end; GCanRefreshCad := RefreshFlag; GCadForm.PCad.Refresh; end; Procedure TF_MAIN.Act_NoConnectedRoutesExecute(Sender: TObject); var i, j: Integer; RouteList: TList; Figure: TFigure; AddRouteToList: Boolean; CurrCatalog: TSCSCatalog; CanShowReport: Boolean; FoundedNode: TTreeNode; OtherFloor: TF_Cad; RaiseConn, otherFloorConnector: TConnectorObject; Procedure AddRouteListToTree(aList: TList; aCatalog: TSCSCatalog); var i: Integer; RouteCatalog: TSCSCatalog; ParentNode, childNode: TFlyNode; begin if aCatalog = nil then ParentNode := nil else begin ParentNode := F_InterfaceInfo.TreeView.Items.Add(nil, aCatalog.GetNameForVisible(false)); ParentNode.Data := aCatalog; if aCatalog.TreeViewNode <> nil then begin ParentNode.SelectedIndex := aCatalog.TreeViewNode.SelectedIndex; ParentNode.ImageIndex := aCatalog.TreeViewNode.ImageIndex; end else begin ParentNode.SelectedIndex := -1; ParentNode.ImageIndex := -1; end; end; if aList.Count > 0 then begin for i := 0 to aList.Count - 1 do begin RouteCatalog := F_ProjMan.GSCSBase.CurrProject.GetCatalogFromReferencesBySCSID(TFigure(aList[i]).ID); if RouteCatalog <> nil then begin if ParentNode <> nil then ChildNode := F_InterfaceInfo.TreeView.Items.AddChild(ParentNode, RouteCatalog.GetNameForVisible(True)) else ChildNode := F_InterfaceInfo.TreeView.Items.Add(ParentNode, RouteCatalog.GetNameForVisible(True)); ChildNode.Data := RouteCatalog; if RouteCatalog.TreeViewNode <> nil then begin ChildNode.ImageIndex := RouteCatalog.TreeViewNode.ImageIndex; ChildNode.SelectedIndex := RouteCatalog.TreeViewNode.SelectedIndex; end else begin FoundedNode := FindComponOrDirInTree(RouteCatalog.Id, false); if FoundedNode <> nil then begin ChildNode.ImageIndex := FoundedNode.ImageIndex; ChildNode.SelectedIndex := FoundedNode.SelectedIndex; end; end; {else begin ChildNode.ImageIndex := -1; ChildNode.SelectedIndex := -1; end; } end; end; aList.Clear; end; end; Procedure AddNoConnectedRoutesToListFromCad(aList: TSCSCatalog; addParent: Boolean = False); var i, j: Integer; catalogGForm: TF_CAD; ParentNode, ChildNode: TFlyNode; begin if aList.ItemType <> itList then exit; //F_ProjMan.GSCSBase.CurrProject.Setting.ListsInReverseOrder CatalogGForm := GetListByID(aList.SCSID); if (CatalogGForm <> nil) then begin for i := 0 to CatalogGForm.FSCSFigures.Count - 1 do begin if checkFigureByClassNAme(TFigure(CatalogGForm.FSCSFigures[i]), cTOrthoLine) then begin Figure := TFigure(CatalogGForm.FSCSFigures[i]); if not Figure.Deleted then begin AddRouteToList := False; if TOrthoLine(Figure).JoinConnector1 <> nil then begin if not (TConnectorObject(TOrthoLine(Figure).JoinConnector1).FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown]) then begin if (TConnectorObject(TOrthoLine(Figure).JoinConnector1).JoinedConnectorsList.Count = 0) and (TConnectorObject(TOrthoLine(Figure).JoinConnector1).JoinedOrtholinesList.Count = 1 ) then AddRouteToList := True; end else begin RaiseConn := (TConnectorObject(TOrthoLine(Figure).JoinConnector1)); if (RaiseConn.FID_ConnToPassage <= 0) then AddRouteToList := True else if (RaiseConn.FID_ListToPassage <= 0) then AddRouteToList := True else begin OtherFloor := GetListById(RaiseConn.FID_ListToPassage); if OtherFloor <> nil then begin otherFloorConnector := nil; for j := 0 to OtherFloor.FSCSFigures.Count - 1 do begin if TFigure(OtherFloor.FSCSFigures[j]).ID = RaiseConn.FID_ListToPassage then if checkFigureByClassName(TFigure(OtherFloor.FSCSFigures[j]), cTConnectorObject) then begin otherFloorConnector := TConnectorObject(OtherFloor.FSCSFigures[j]); if otherFloorConnector.FID_ConnToPassage <> RaiseConn.ID then AddRouteToList := True else if otherFloorConnector.JoinedOrtholinesList.Count = 0 then AddRouteToList := True; end; end; end else AddRouteToList := True; end; end; end; if not AddRouteToList then begin if TOrthoLine(Figure).JoinConnector2 <> nil then begin if not (TConnectorObject(TOrthoLine(Figure).JoinConnector2).FConnRaiseType in [crt_BetweenFloorUp, crt_BetweenFloorDown, crt_TrunkUp, crt_TrunkDown]) then begin if (TConnectorObject(TOrthoLine(Figure).JoinConnector2).JoinedConnectorsList.Count = 0) and (TConnectorObject(TOrthoLine(Figure).JoinConnector2).JoinedOrtholinesList.Count = 1 ) then AddRouteToList := True; end else begin RaiseConn := (TConnectorObject(TOrthoLine(Figure).JoinConnector2)); if (RaiseConn.FID_ConnToPassage <= 0) then AddRouteToList := True else if (RaiseConn.FID_ListToPassage <= 0) then AddRouteToList := True else begin OtherFloor := GetListById(RaiseConn.FID_ListToPassage); if OtherFloor <> nil then begin otherFloorConnector := nil; for j := 0 to OtherFloor.FSCSFigures.Count - 1 do begin if TFigure(OtherFloor.FSCSFigures[j]).ID = RaiseConn.FID_ListToPassage then if checkFigureByClassName(TFigure(OtherFloor.FSCSFigures[j]), cTConnectorObject) then begin otherFloorConnector := TConnectorObject(OtherFloor.FSCSFigures[j]); if otherFloorConnector.FID_ConnToPassage <> RaiseConn.ID then AddRouteToList := True else if otherFloorConnector.JoinedOrtholinesList.Count = 0 then AddRouteToList := True; end; end; end else AddRouteToList := True; end; end; end; end; if AddRouteToList then if RouteList.IndexOf(TFigure(Figure)) = -1 then RouteList.Add(Figure); end; end; end; if RouteList.Count > 0 then begin if addParent then AddRouteListToTree(RouteList, aList) else AddRouteListToTree(RouteList, nil); end; end; end; begin RouteList := Nil; CreateFInterfaceInfo; CurrCatalog := F_ProjMan.GetActualSelectedCatalog; if CurrCatalog = nil then exit; if CurrCatalog.ItemType = itDir then CurrCatalog := CurrCatalog.GetTopParentCatalog; // получить проект, если это просто папка, созданная пользователем if CurrCatalog = nil then exit; if CurrCatalog.ItemType = itProject then // выбрать по проекту begin F_InterFaceInfo.TreeView.Items.Clear; RouteList := TList.create; if F_ProjMan.GSCSBase.CurrProject.Setting.ListsInReverseOrder then begin for i := (CurrCatalog.ChildCatalogs.Count - 1) downto 0 do begin if TSCSCatalog(CurrCatalog.ChildCatalogs[i]).ItemType = itList then begin if TSCSList(CurrCatalog.ChildCatalogs[i]).OpenedInCAD then AddNoConnectedRoutesToListFromCad(TSCSCatalog(CurrCatalog.ChildCatalogs[i]), true); end; end; end else begin for i := 0 to CurrCatalog.ChildCatalogs.Count - 1 do begin if TSCSCatalog(CurrCatalog.ChildCatalogs[i]).ItemType = itList then begin if TSCSList(CurrCatalog.ChildCatalogs[i]).OpenedInCAD then AddNoConnectedRoutesToListFromCad(TSCSCatalog(CurrCatalog.ChildCatalogs[i]), true); end; end; end; // F_InterFaceInfo.RzPageControl1.Hide; // F_InterFaceInfo.TreeView.Show; F_InterfaceInfo.Execute(iimNoConnectedRoutes, CurrCatalog); //F_InterfaceInfo.ShowModal; end else begin // по листу if CurrCatalog.ItemType <> itList then // получить лист, если это не лист а каталог листа begin currCatalog := currCatalog.GetParentCatalogByItemType(itList); if currCatalog = nil then exit; end; F_InterFaceInfo.TreeView.Items.Clear; // выбрать по листу if CurrCatalog.ItemType = itList then if TSCSList(CurrCatalog).OpenedInCAD then begin RouteList := TList.create; AddNoConnectedRoutesToListFromCad(CurrCatalog); end; //F_InterFaceInfo.RzPageControl1.Hide; // F_InterFaceInfo.TreeView.Show; F_InterfaceInfo.Execute(iimNoConnectedRoutes, CurrCatalog); //F_InterfaceInfo.ShowModal; end; if RouteList <> nil then FreeAndNil(RouteList); end; procedure TF_MAIN.Act_SetCurrenciesExecute(Sender: TObject); begin if F_CurrencyPreparer = nil then F_CurrencyPreparer := TF_CurrencyPreparer.Create(Self, TForm(Self)); if F_CurrencyPreparer <> nil then F_CurrencyPreparer.Execute(False); end; end.