unit Unit_DM_SCS; interface uses SysUtils, Classes, Windows, Graphics, Variants, DB, FIB, FIBDatabase, pFIBDatabase, FIBDataSet, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, kbmMemTable, ComCtrls, Math, cxEditRepositoryItems, U_Common_Classes, cxEdit, ImgList, Controls, Forms, RzBHints, cxDropDownEdit, cxImageComboBox, Dialogs, Contnrs, DateUtils, cxDBEditRepository, U_BaseCommon, U_BaseConstants, U_SCSLists, U_SCSComponent, U_SCSClasses, U_TrunkSCS, U_FilterConfigurator, U_ProtectionCommon, RzCmboBx, cxExtEditRepositoryItems, SQLMemMain, SQLMemExcept, ExtCtrls, IB_Services, siComp, siLngLnk, pFIBErrorHandler, {pFIBStoredProc, }U_ProtectionBase, xmldom, Provider, Xmlxform, DBClient, cxClasses, {Tolik 20/03/2019} SQLMemTypes;//, bz2; {const // DataTypes dtFloat = 1; dtInteger = 2; dtBoolean = 3; dtString = 4; dtDate = 5; } const COLOR_HOTLIGHT = 26; COLOR_MENUHILIGHT = 29; COLOR_MENUBAR = 30; clHotLight = TColor(COLOR_HOTLIGHT or $80000000); clMenuHighlight = TColor(COLOR_MENUHILIGHT or $80000000); clMenuBar = TColor(COLOR_MENUBAR or $80000000); //type TComplectFormMode = (cmAdd, cmEdit); type TIDGuidObject = class(TMyObject) ID : Integer; GUID: String; DataStr: string; constructor Create; destructor destroy; override; end; type TDelCADObjectEvent = procedure(ACallFrom: TCallFrom; AIDCatalog, AIDItemType: Integer; AQueryMode: TQueryMode; aCatalogObj: TSCSCatalog=nil; aIsManual: Boolean=false) of object; TDM = class(TDataModule) Database_SCS: TpFIBDatabase; Query: TpFIBQuery; DataSet_INTERFACE_: TpFIBDataSet; Transac_INTERFACE_: TpFIBTransaction; DataSource_INTERFACE_: TDataSource; DataSet_CURRENCY: TpFIBDataSet; Transac_CURRENCY: TpFIBTransaction; DataSource_CURRENCY: TDataSource; DataSet_DATA_TYPE: TpFIBDataSet; Transac_DATA_TYPE: TpFIBTransaction; DataSourcet_DATA_TYPE: TDataSource; DataSet_PROPERTIES: TpFIBDataSet; DataSource_PROPERTIES: TDataSource; DataSource_MT_INTERFACERelEd: TDataSource; DataSource_MT_PropertyEd: TDataSource; DataSource_MT_Complects: TDataSource; EditRepository_PropValue: TcxEditRepository; EditRepositoryCheckBoxItem: TcxEditRepositoryCheckBoxItem; EditRepositorySpinItem: TcxEditRepositorySpinItem; EditRepositoryDateItem: TcxEditRepositoryDateItem; ImageList_ToolEdit: TImageList; ImageList_FoldersFind: TImageList; ImageList_Dir: TImageList; Query1: TpFIBQuery; QTransaction: TpFIBTransaction; QTransaction1: TpFIBTransaction; DataSource_MT_ComplectsEd: TDataSource; Query_TSCSSelect: TpFIBQuery; Transac_TSCSSelect: TpFIBTransaction; DataSource_MT_InterfOfInterf_RelEd: TDataSource; DataSource_MT_InterfaceRel: TDataSource; DataSource_MT_IOFI_REL: TDataSource; ImageList_InterfType: TImageList; DataSet_OBJECT_ICONS: TpFIBDataSet; Transac_OBJECT_ICONS: TpFIBTransaction; DataSource_MT_comp_state_type: TDataSource; DataSource_OBJECT_ICONS: TDataSource; DataSource_MT_ComponentIcons_: TDataSource; DataSource_MT_Property: TDataSource; Query_Operat: TpFIBQuery; Transac_QR_Operat: TpFIBTransaction; DataSet_NB_NORMS: TpFIBDataSet; DataSet_NB_RESOURCES: TpFIBDataSet; Transac_NB_NORMS: TpFIBTransaction; Transac_NB_RESOURCES: TpFIBTransaction; DataSource_NB_NORMS: TDataSource; DataSource_NB_RESOURCES: TDataSource; Query_Select: TpFIBQuery; Transac_QR_Select: TpFIBTransaction; DataSource_MT_NormsEd: TDataSource; DataSource_MT_ResourcesRelEd: TDataSource; EditRepositoryLookupCompSateType: TcxEditRepositoryLookupComboBoxItem; DataSource_MT_Connections: TDataSource; DataSet_nb_norm_resource_rel: TpFIBDataSet; Transac_nb_norm_resource_rel: TpFIBTransaction; DataSource_nb_norm_resource_rel: TDataSource; Query_TSCSOperat: TpFIBQuery; Transac_TSCSOperat: TpFIBTransaction; MemTable_PropertyEd: TkbmMemTable; MemTable_Complects: TkbmMemTable; MemTable_ComplectsEd: TkbmMemTable; MemTable_InterfaceRelEd: TkbmMemTable; MemTable_InterfOfInterf_RelEd: TkbmMemTable; MemTable_ComponentIcons_: TkbmMemTable; MemTable_ComponentIcons_ID: TIntegerField; MemTable_ComponentIcons_ID_OBJECT_ICON: TIntegerField; MemTable_ComponentIcons_NPP_ID_OBJECT_ICON: TIntegerField; MemTable_ComponentIcons_ID_COMP_STATE_TYPE: TIntegerField; MemTable_ComponentIcons_NAME: TStringField; MemTable_ComponentIcons_ICON: TBlobField; MemTable_ComponentIcons_BLOCK: TBlobField; MemTable_ComponentIcons_isModified: TBooleanField; MemTable_ComponentIcons_isNew: TBooleanField; MemTable_InterfaceRel: TkbmMemTable; MemTable_IOFI_REL: TkbmMemTable; MemTable_Property: TkbmMemTable; MemTable_NormsEd: TkbmMemTable; MemTable_ResourcesRelEd: TkbmMemTable; MemTable_Connections: TkbmMemTable; DataSource_PRODUCERS: TDataSource; Transac_PRODUCERS: TpFIBTransaction; DataSet_PRODUCERS: TpFIBDataSet; DataSource_MT_Port: TDataSource; DataSource_MT_PortEd: TDataSource; MemTable_Port: TkbmMemTable; MemTable_PortEd: TkbmMemTable; MemTable_CatalogMarkMask: TkbmMemTable; DataSource_MT_CatalogMarkMask: TDataSource; DataSource_InterfaceLookUp: TDataSource; DataSet_InterfaceLookUp: TpFIBDataSet; Transac_InterfaceLookUp: TpFIBTransaction; tSQL_Katalog: TSQLMemTable; qSQLMQuery: TSQLMemQuery; DataSource1: TDataSource; SQLMemQuery1: TSQLMemQuery; tSQL_CatalogRelation: TSQLMemTable; tSQL_Component: TSQLMemTable; MemTable_Comp_State_Type: TkbmMemTable; DataSet_OBJECT_ICONSID: TFIBIntegerField; DataSet_OBJECT_ICONSNAME: TFIBStringField; DataSet_OBJECT_ICONSPROJ_BLK: TFIBBlobField; DataSet_OBJECT_ICONSPROJ_BMP: TFIBBlobField; DataSet_OBJECT_ICONSACTIVE_BLK: TFIBBlobField; DataSet_OBJECT_ICONSACTIVE_BMP: TFIBBlobField; DataSet_OBJECT_ICONSRESERV_BLK: TFIBBlobField; DataSet_OBJECT_ICONSRESERV_BMP: TFIBBlobField; tSQL_CatalogPropRelation: TSQLMemTable; tSQL_ComponentRelation: TSQLMemTable; tSQL_CompPropRelation: TSQLMemTable; tSQL_ConnectedComponents: TSQLMemTable; tSQL_InterfaceRelation: TSQLMemTable; tSQL_InterfOfInterfRelation: TSQLMemTable; tSQL_Norms: TSQLMemTable; tSQL_NormResourceRel: TSQLMemTable; tSQL_Resources: TSQLMemTable; qSQL_Query: TSQLMemQuery; qSQL_Query1: TSQLMemQuery; qSQL_QueryOperat: TSQLMemQuery; qSQL_QuerySelect: TSQLMemQuery; qSQL_QueryTSCSSelect: TSQLMemQuery; qSQL_QueryTSCSOperat: TSQLMemQuery; DSrc_MT_CableCanalConnectorsEd: TDataSource; MemTable_CableCanalConnectorsEd: TkbmMemTable; tSQL_CableCanalConnectors: TSQLMemTable; EditRepository_Common: TcxEditRepository; seFloatRepositioryCommon: TcxEditRepositorySpinItem; Timer_RepositoryEditChanged: TTimer; ceRepositoryCommon: TcxEditRepositoryCurrencyItem; EditRepositoryButtonItem: TcxEditRepositoryButtonItem; EditRepositoryComboBoxItem: TcxEditRepositoryComboBoxItem; EditRepositoryMRUItem: TcxEditRepositoryMRUItem; DSrc_MT_CrossConnection: TDataSource; MemTable_CrossConnection: TkbmMemTable; EditRepositoryColorComboBox: TcxEditRepositoryColorComboBox; tSQL_PortInterfaceRelation: TSQLMemTable; DSrc_MT_PortInterfRel: TDataSource; DSrc_MT_PortInterfRelEd: TDataSource; MemTable_PortInterfRelEd: TkbmMemTable; MemTable_PortInterfRel: TkbmMemTable; DataSet_Interface: TpFIBDataSet; DataSet_Interface_Norms: TpFIBDataSet; DataSet_InterfAccordance: TpFIBDataSet; Transac_Interface: TpFIBTransaction; Transac_Interface_Norms: TpFIBTransaction; Transac_InterfAccordance: TpFIBTransaction; DataSource_Interface: TDataSource; DataSource_Interface_Norms: TDataSource; DataSource_InterfAccordance: TDataSource; DataSource_NET_TYPE: TDataSource; DataSet_NET_TYPE: TpFIBDataSet; Transac_NET_TYPE: TpFIBTransaction; Transac_Properties: TpFIBTransaction; DataSet_comp_type_prop_relation: TpFIBDataSet; Transac_comp_type_prop_relation: TpFIBTransaction; DataSource_comp_type_prop_relation: TDataSource; DataSet_COMPONENT_TYPES: TpFIBDataSet; Transac_COMPONENT_TYPES: TpFIBTransaction; DataSource_COMPONENT_TYPES: TDataSource; DataSet_SuppliesKinds: TpFIBDataSet; Transac_SuppliesKinds: TpFIBTransaction; DSrc_SuppliesKinds: TDataSource; dsrcUpdStructInfo: TDataSource; dsetUpdStructInfo: TpFIBDataSet; Transac_UpdStructInfo: TpFIBTransaction; dsetUpdInfo: TpFIBDataSet; dsetUpdInfoRel: TpFIBDataSet; Transac_UpdInfo: TpFIBTransaction; Transac_UpdInfoRel: TpFIBTransaction; dSrcUpdInfo: TDataSource; dSrcUpdInfoRel: TDataSource; EditRepositoryLookupCableCanalElementType: TcxEditRepositoryLookupComboBoxItem; dsrcCableCanalElementType: TDataSource; mtCableCanalElementType: TkbmMemTable; EditRepositoryCurrencyItemForFloat: TcxEditRepositoryCurrencyItem; tSQL_ComponentTypes: TSQLMemTable; tSQL_CompTypePropRelation: TSQLMemTable; tSQL_Interface: TSQLMemTable; tSQL_InterfaceNorms: TSQLMemTable; dsrcMTCableCanalConnectors: TDataSource; mtCableCanalConnectors: TkbmMemTable; dsrcMTCrossConnectionEd: TDataSource; mtCrossConnectionEd: TkbmMemTable; tSQL_CADNormStruct: TSQLMemTable; tSQL_CADNormColumn: TSQLMemTable; tSQL_CADCrossObject: TSQLMemTable; tSQL_CADCrossObjectElement: TSQLMemTable; tSQL_InterfPosConnection: TSQLMemTable; DataSet_OBJECT_ICONSGUID: TFIBStringField; mtInterfInternalConn: TkbmMemTable; mtInterfInternalConnEd: TkbmMemTable; dsrcInterfInternalConn: TDataSource; dsrcInterfInternalConnEd: TDataSource; lng_Forms: TsiLangLinked; mtObjectCurrency: TkbmMemTable; dsrcObjectCurrency: TDataSource; tSQL_Currency: TSQLMemTable; tSQL_NetType: TSQLMemTable; tSQL_NBNorms: TSQLMemTable; tSQL_ObjectIcons: TSQLMemTable; tSQL_Producers: TSQLMemTable; tSQL_Properties: TSQLMemTable; tSQL_NBResources: TSQLMemTable; tSQL_SuppliesKinds: TSQLMemTable; tSQL_InterfaceAccordance: TSQLMemTable; EditRepositoryMaskItemSectionSide: TcxEditRepositoryMaskItem; dsetUnitsOfMeasure: TpFIBDataSet; Transac_UnitsOfMeasure: TpFIBTransaction; dsetDimensions: TpFIBDataSet; Transac_Dimensions: TpFIBTransaction; dsrcUnitsOfMeasure: TDataSource; dsrcDimensions: TDataSource; mtNorms: TkbmMemTable; dsrcMTNorms: TDataSource; ImageList_FlyTree: TImageList; tSQL_StringsMan: TSQLMemTable; DatabaseSrc: TpFIBDatabase; iiDirStates: TImageList; tSQL_Filters: TSQLMemTable; EditRepositorySpinItemInt: TcxEditRepositorySpinItem; EditRepositoryImageComboBoxTubeConnectKind: TcxEditRepositoryImageComboBoxItem; tSQL_PropValRel: TSQLMemTable; tSQL_PropValNormRes: TSQLMemTable; tSQL_ObjectsBlobs: TSQLMemTable; dsetCompSpecifications: TpFIBDataSet; Transac_CompSpecifications: TpFIBTransaction; dsrcCompSpecifications: TDataSource; tSQL_NormsComplete: TSQLMemTable; procedure DataModuleCreate(Sender: TObject); procedure MemTable_PropertyAfterEdit(DataSet: TDataSet); procedure MemTable_PropertyAfterPost(DataSet: TDataSet); procedure DataModuleDestroy(Sender: TObject); procedure tSQL_KatalogBeforeInsert(DataSet: TDataSet); procedure DataSet_INTERFACE_AfterOpen(DataSet: TDataSet); procedure DataSet_INTERFACE_BeforeClose(DataSet: TDataSet); procedure tSQL_CableCanalConnectorsBeforeInsert(DataSet: TDataSet); procedure DataSet_INTERFACE_BeforeScroll(DataSet: TDataSet); procedure MemTable_PropertyEdAfterEdit(DataSet: TDataSet); procedure EditRepositioryCommonPropertiesEditValueChanged( Sender: TObject); procedure Timer_RepositoryEditChangedTimer(Sender: TObject); procedure DataSet_nb_norm_resource_relBeforePost(DataSet: TDataSet); procedure MemTable_PortAfterOpen(DataSet: TDataSet); procedure MemTable_PortBeforeClose(DataSet: TDataSet); procedure MemTable_PortAfterScroll(DataSet: TDataSet); procedure MemTable_PortEdAfterOpen(DataSet: TDataSet); procedure MemTable_PortEdBeforeClose(DataSet: TDataSet); procedure MemTable_PortBeforeDelete(DataSet: TDataSet); procedure MemTable_PortEdBeforeDelete(DataSet: TDataSet); procedure MemTable_PortInterfRelAfterOpen(DataSet: TDataSet); procedure FFibErrorHandlerFIBErrorEvent(Sender: TObject; ErrorValue: EFIBError; KindIBError: TKindIBError; var DoRaise: Boolean); procedure Database_SCSLostConnect(Database: TFIBDatabase; E: EFIBError; var Actions: TOnLostConnectActions); //procedure Database_SCSAfterRestoreConnect(Sender: TObject); procedure Database_SCSAfterRestoreConnect; procedure MemTable_NormsEdAfterPost(DataSet: TDataSet); procedure MemTable_NormsEdAfterEdit(DataSet: TDataSet); procedure Database_SCSAfterConnect(Sender: TObject); procedure FIBQueryAfterExecute(Sender: TObject); private FFibErrorHandler: TpFibErrorHandler; { Private declarations } GForm: TForm; FDelCADObjectEvent: TDelCADObjectEvent; FDataSetRepository: TDataSet; FCurrEditRepositoryItem: TcxEditRepositoryItem; procedure OnTimerStoreGuidToReserv(Sender: TObject); procedure RemoveSystemColorsFromRepository(ARepository: TcxEditRepositoryColorComboBox); protected FSQLMemTables: TObjectList; TimerStoreGuidToReserv: TTimer; FCatInfoList: TObjectList; FCatIDs: TIntList; FCatParentIDs: TIntList; FCatRelCatalogIDs: TIntList; FCatRelComponIDs: TIntList; FComponIDs: TIntList; FComponIDProdusers: TIntList; FComponIDNetTypes: TIntList; FComponIDCompTypes: TIntList; FComponCatalogsCanShowByFilter: TIntList; FComponCatalogsNoShowByFilter: TIntList; public FMemBaseCreated: Boolean; FMemBaseActive: Boolean; FMemBaseLoaded: Boolean; //*** Индексы полей таблиц //--- Katalog fiKatalog_ID: Integer; fiKatalog_ParentID: Integer; fiKatalog_ListID: Integer; fiKatalog_Name: Integer; fiKatalog_NameShort: Integer; fiKatalog_NameMark: Integer; fiKatalog_IsUserName: Integer; fiKatalog_SortID: Integer; fiKatalog_KolCompon: Integer; fiKatalog_ItemsCount: Integer; fiKatalog_PropsCount: Integer; fiKatalog_NormsCount: Integer; fiKatalog_ResourcesCount: Integer; //fiKatalog_SpravComponCount: Integer; fiKatalog_IDItemType: Integer; fiKatalog_MarkID: Integer; fiKatalog_ScsID: Integer; fiKatalog_IsIndexWithName: Integer; fiKatalog_IndexConn: Integer; fiKatalog_IndexLine: Integer; fiKatalog_IndexJoiner: Integer; fiKatalog_Settings: Integer; fiKatalog_CompTypeMarkMasks: Integer; fiKatalog_CADBlock: Integer; fiKatalog_PMBlock: Integer; //--- CatalogPropRelation fiCatPropRel_ID: Integer; fiCatPropRel_IDCatalog: Integer; fiCatPropRel_IDProperty: Integer; fiCatPropRel_GUIDProperty: Integer; fiCatPropRel_PValue: Integer; fiCatPropRel_IsDefault: Integer; fiCatPropRel_SortID: Integer; //--- CatalogRelation fiCatRel_ fiCatRel_IDCatalog: Integer; fiCatRel_IDComponent: Integer; //--- Component fiCompon_ID: Integer; fiCompon_GuidNB: Integer; fiCompon_Name: Integer; fiCompon_NameShort: Integer; fiCompon_NameMark: Integer; fiCompon_MarkID: Integer; fiCompon_MarkStr: Integer; fiCompon_Cypher: Integer; fiCompon_Izm: Integer; fiCompon_Notice: Integer; fiCompon_Description: Integer; fiCompon_IsUserMark: Integer; fiCompon_IsMarkInCaptions: Integer; fiCompon_Picture: Integer; fiCompon_Color: Integer; fiCompon_IsLine: Integer; fiCompon_IsComplect: Integer; fiCompon_PriceSupply: Integer; fiCompon_Price: Integer; fiCompon_PriceCalc: Integer; fiCompon_UserLength: Integer; fiCompon_MaxLength: Integer; fiCompon_HasNDS: Integer; fiCompon_IDComponentType: Integer; fiCompon_IDSymbol: Integer; fiCompon_IDObjectIcon: Integer; fiCompon_IDProducer: Integer; fiCompon_IDSuppliesKind: Integer; fiCompon_IDSupplier: Integer; fiCompon_IDNetType: Integer; fiCompon_GUIDComponentType: Integer; fiCompon_GUIDSymbol: Integer; fiCompon_GUIDObjectIcon: Integer; fiCompon_GUIDProducer: Integer; fiCompon_GUIDSuppliesKind: Integer; fiCompon_GUIDSupplier: Integer; fiCompon_GUIDNetType: Integer; fiCompon_ObjectIconStep: Integer; fiCompon_IDCurrency: Integer; fiCompon_ArticulDistributor: Integer; fiCompon_ArticulProducer: Integer; fiCompon_SortID: Integer; fiCompon_IsDismount: Integer; fiCompon_IsUseDismounted: Integer; fiCompon_UseKindInProj: Integer; fiCompon_WholeID: Integer; fiCompon_KolComplect: Integer; fiCompon_CableCanalConnectorsCnt: Integer; fiCompon_InterfCount: Integer; fiCompon_JoinsCount: Integer; fiCompon_NormsCount: Integer; fiCompon_PropsCount: Integer; fiCompon_ResourcesCount: Integer; fiCompon_IDNormBase: Integer; fiCompon_ObjectID: Integer; fiCompon_ListID: Integer; fiCompon_IDRelatedCompon: Integer; fiCompon_ComeFrom: Integer; fiCompon_IsTemplate: Integer; //--- ComponentRelation fiCompRel_ID: Integer; fiCompRel_IDComponent: Integer; fiCompRel_IDChild: Integer; fiCompRel_Kolvo: Integer; fiCompRel_SortID: Integer; fiCompRel_ConnectType: Integer; fiCompRel_RelType: Integer; fiCompRel_Fixed: Integer; //--- ComponentPropRelation fiCompPropRel_ID: Integer; fiCompPropRel_IDComponent: Integer; fiCompPropRel_IDProperty: Integer; fiCompPropRel_GUIDProperty: Integer; fiCompPropRel_PValue: Integer; fiCompPropRel_IsDefault: Integer; fiCompPropRel_SortID: Integer; fiCompPropRel_TakeIntoJoin: Integer; fiCompPropRel_TakeIntoConnect: Integer; fiCompPropRel_IsTakeJoinForPoints: Integer; fiCompPropRel_IsCrossControl: Integer; fiCompPropRel_IDCrossProperty: Integer; fiCompPropRel_GUIDCrossProperty: Integer; //--- CableCanalConnector fiCablCanalConnr_ fiCablCanalConnr_ID: Integer; fiCablCanalConnr_IDComponent: Integer; fiCablCanalConnr_IDNBConnector: Integer; fiCablCanalConnr_GUIDNBConnector: Integer; fiCablCanalConnr_ConnectorType: Integer; //--- CONNECTEDCOMPONENTS fiConnctCompons_ID: Integer; fiConnctCompons_ComponWholeID: Integer; fiConnctCompons_IDConnectObject: Integer; fiConnctCompons_IDConnectCompon: Integer; fiConnctCompons_IDSideCompon: Integer; fiConnctCompons_TypeConnect: Integer; //--- InterfaceRelation fiInterfRel_ID: Integer; fiInterfRel_IDComponent: Integer; fiInterfRel_IDInterface: Integer; fiInterfRel_GUIDInterface: Integer; fiInterfRel_NPP: Integer; fiInterfRel_TypeI: Integer; fiInterfRel_Kind: Integer; fiInterfRel_IsPort: Integer; fiInterfRel_IsUserPort: Integer; fiInterfRel_NppPort: Integer; fiInterfRel_IDConnected: Integer; fiInterfRel_Gender: Integer; fiInterfRel_Multiple: Integer; fiInterfRel_IsBusy: Integer; fiInterfRel_ValueI: Integer; fiInterfRel_CoordZ: Integer; fiInterfRel_SortID: Integer; fiInterfRel_NumPair: Integer; fiInterfRel_Color: Integer; fiInterfRel_IDAdverse: Integer; fiInterfRel_Side: Integer; fiInterfRel_Notice: Integer; fiInterfRel_Kolvo: Integer; fiInterfRel_KolvoBusy: Integer; fiInterfRel_SignType: Integer; fiInterfRel_ConnToAnyGender: Integer; fiInterfRel_SideSection: Integer; fiInterfRel_IOfIRelCount: Integer; fiInterfRel_PortInterfRelCount: Integer; //--- InterfOfInterfRel fiIOfIRel_ID: Integer; fiIOfIRel_IDInterfRel: Integer; fiIOfIRel_IDInterfTo: Integer; fiIOfIRel_IDCompRel: Integer; fiIOfIRel_IDIOfIRelMain: Integer; fiIOfIRel_ConPosition: Integer; fiIOfIRel_ConnectKind: Integer; fiIOfIRel_PosConnectionsCount: Integer; //--- PortInterfRel fiPortInterfRel_ID: Integer; fiPortInterfRel_RelType: Integer; fiPortInterfRel_IDPort: Integer; fiPortInterfRel_IDInterfRel: Integer; fiPortInterfRel_UnitInterfKolvo: Integer; //--- Norms fiNorms_ID: Integer; fiNorms_IDNB: Integer; fiNorms_GUIDNB: Integer; fiNorms_IDMaster: Integer; fiNorms_TableKind: Integer; fiNorms_Npp: Integer; fiNorms_IsOn: Integer; fiNorms_Kolvo: Integer; fiNorms_TotalCost: Integer; fiNorms_Cypher: Integer; fiNorms_Name: Integer; fiNorms_WorkKind: Integer; fiNorms_Izm: Integer; fiNorms_Zarplat: Integer; fiNorms_LaborTime: Integer; fiNorms_PricePerTime: Integer; fiNorms_Price: Integer; fiNorms_Cost: Integer; fiNorms_IsFromInterface: Integer; fiNorms_ExpenseForLength: Integer; fiNorms_CountForPoint: Integer; fiNorms_StepOfPoint: Integer; fiNorms_IDCompPropRel: Integer; //--- NormResRel fiNormResRel_ID: Integer; fiNormResRel_IDMaster: Integer; fiNormResRel_TableKind: Integer; fiNormResRel_Npp: Integer; fiNormResRel_IDResource: Integer; fiNormResRel_Kolvo: Integer; fiNormResRel_IsOn: Integer; fiNormResRel_Cost: Integer; fiNormResRel_RValue: Integer; fiNormResRel_ExpenseForLength: Integer; fiNormResRel_GuidNBComponent: Integer; fiNormResRel_CountForPoint: Integer; fiNormResRel_StepOfPoint: Integer; fiNormResRel_IDCompPropRel: Integer; //--- Resources fiResource_ID: Integer; fiResource_IDNB: Integer; fiResource_GuidNB: Integer; fiResource_TableKindNB: Integer; fiResource_Cypher: Integer; fiResource_Name: Integer; fiResource_Izm: Integer; fiResource_Price: Integer; fiResource_AdditionalPrice: Integer; fiResource_RType: Integer; //--- CADNormStruct fiCADNormStruct_ID: Integer; fiCADNormStruct_IDCatalog: Integer; fiCADNormStruct_IDItemType: Integer; fiCADNormStruct_Npp: Integer; fiCADNormStruct_Name: Integer; fiCADNormStruct_Izm: Integer; fiCADNormStruct_Kolvo: Integer; //--- CADNormColumn fiCADNormColumn_ID: Integer; fiCADNormColumn_IDCADNormStruct: Integer; fiCADNormColumn_Name: Integer; fiCADNormColumn_ChildColumns: Integer; //--- InterfPosConnection fiInterfPosConnection_ID: Integer; fiInterfPosConnection_IDIOfIRel: Integer; fiInterfPosConnection_SelfFromPos: Integer; fiInterfPosConnection_SelfToPos: Integer; fiInterfPosConnection_ConnFromPos: Integer; fiInterfPosConnection_ConnToPos: Integer; //--- StringsMan fiStringsMan_ID: Integer; fiStringsMan_StrType: Integer; fiStringsMan_Name: Integer; { FLastKatalogID: Integer; FLastKatalogSCSID: Integer; FLastCableCanalConnectorID: Integer; FLastComponentID: Integer; FLastComponPropRelID: Integer; FLastCompRelID: Integer; FLastInterfRelID: Integer; FLastInterfOfInterfRel: Integer; FLastPortInterfRelID: Integer; } scsQ: TSCSQuery; scsQ1: TSCSQuery; scsQOperat: TSCSQuery; scsQSelect: TSCSQuery; scsQTSCSSelect: TSCSQuery; scsQTSCSOperat: TSCSQuery; FModifiedsCount: Integer; GIsFillingMemTable: Boolean; UsersInfoPM: TUsersInfo; //BaseUserName: String; //BasePass: String; ConnectParams: TBaseConnectParams; {property LastKatalogID: Integer read FLastKatalogID; property LastKatalogSCSID: Integer read FLastKatalogSCSID; property LastCableCanalConnectorID: Integer read FLastCableCanalConnectorID; property LastComponentID: Integer read FLastComponentID; property LastComponPropRelID: Integer read FLastComponPropRelID; property LastCompRelID: Integer read FLastCompRelID; property LastInterfRelID: Integer read FLastInterfRelID; property LastInterfOfInterfRel: Integer read FLastInterfOfInterfRel; property LastPortInterfRelID: Integer read FLastPortInterfRelID;} property OnDelCADObject: TDelCADObjectEvent read FDelCADObjectEvent write FDelCADObjectEvent; property SQLMemTsbles: TObjectList read FSQLMemTables write FSQLMemTables; property CatIDs: TIntList read FCatIDs; property CatParentIDs: TIntList read FCatParentIDs; property CatRelCatalogIDs: TIntList read FCatRelCatalogIDs; property CatRelComponIDs: TIntList read FCatRelComponIDs; property ComponIDs: TIntList read FComponIDs; property ComponIDProdusers: TIntList read FComponIDProdusers; property ComponIDNetTypes: TIntList read FComponIDNetTypes; property ComponIDCompTypes: TIntList read FComponIDCompTypes; property ComponCatalogsNoShowByFilter: TIntList read FComponCatalogsNoShowByFilter; procedure ActiveAll(AActive: Boolean); procedure CreateSQLMemTables; procedure CreateSQLMemTableByTagIdx(aTIdx: Integer); procedure FreeSQLMemTables; procedure AddToSQLMemTables(var aTable: TSQLMemTable; const aTName: String; aTIdx: Integer); function GetBaseNow: TDateTime; function GetComID: Integer; procedure AddCatalogToLists(AIDCatalog, AParentID: Integer); procedure AddComponToLists(AIDCatalog, AIDCompon: Integer); procedure ClearComponLists; procedure DeleteCatalogFromLists(AIDCatalog: Integer); procedure DeleteComponFromLists(AIDCompon: Integer); function GetCatalogInfoByID(AID: Integer): TCatalogInfo; function GetCatalogParentIDFromLists(ACatalogID: Integer): Integer; function GetCatRelCatalogIDByComponIDFromLists(AComponID: Integer): Integer; procedure LoadIDsToLists; procedure LoadIDsToComponLists(AFilterParams: TFilterParams); procedure SaveCatalogParentIDToLists(AIDCatalog, ANewParentID: Integer); procedure SaveComponCatalogIDToLists(AIDCompon, AOldIDCatalog, ANewIDCatalog: Integer); function GetPMSettingsAsDefault: TPMSettingRecord; function GetNBSettings: TNBSettingRecord; function GetNBType: Integer; function GetPMSettings: TPMSettingRecord; procedure SetNBSettings(ANBSettings: TNBSettingRecord); procedure SetPMSettings(APMSettings: TPMSettingRecord); function GetInterfaceRel(ADataSource: TDataSource; ADataSet: TDataSet): TmeInterfaceRel; procedure MakeEditInterfRel(var AmeInterfaceRel: TmeInterfaceRel; AMakeEdit: TMakeEdit); procedure LoadMT(AID_Component: Integer; ATableKind: TTablekind; AFields: TStringList; AAsNew: Boolean); procedure SaveMTToDS(AID_Component: Integer; ADeletedList: TIntList; ATableKind: TTablekind; AUpdateMT: Boolean); //procedure RenameDir(AID_Dir: Integer; ANewName: String); procedure CorrectSortIDInSiblingNodes(ANode: TTreeNode; ATableKind: TTableKind); procedure ExchangeNodes(ANode1, ANode2: TTreeNode; ATableKind: TTableKind); procedure SaveSortIDByTableKind(AObjectID, ANewSortID: Integer; ATableKind: TTableKind; AQueryMode: TQueryMode; AReloadSQL: Boolean); function LocateMTByOtherMT(AMemTable, AOtherMemTable: TkbmMemTable): Boolean; //procedure SelectComponIcons(AID_ComponIcon: Integer = -1); Procedure SelectInterfaces(ANode: TTreeNode); procedure SelectPorts(ANode: TTreeNode); Procedure SelectCompRel(AComponent: TSCSComponent); procedure SelectConnections(ANode: TTreeNode); procedure SelectProperty(AFormMode: TFormMode; AItemType: TItemType); Procedure SelectComponProperty(ASCSComponent: TSCSComponent); procedure SelectCableChannelsConnectors(AComponent: TSCSComponent); procedure SelectCrossConnections; procedure SelectNorms(aNormsRes: TSCSNormsResources); procedure SelectCatalogCurrency(AIDToLocate: Integer = -1); procedure SelectCatalogProperty(ASCSCatalog: TSCSCatalog); Procedure SelectCompSub(ANode: TTreeNode; AComponent: TSCSComponent); Procedure SelectCatalogSub(ANode: TTreeNode; ACatalog: TSCSCatalog); procedure SelectDSetByDirectoryType(AIDDirectoryType: Integer; ADirTypeInfo: TDirTypeInfo; AWhereParam: string); procedure RestoreMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); procedure SaveCatalogMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); procedure SaveComponMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); procedure SaveMemTablePosition(AMemTable: TkbmMemTable; AMemTables: TList; AListPositions: TIntlist); //procedure SelectCompIconsByNPP(ANPP: Integer) {Function SearchRecord(var SDataSet: TpFIBDataSet; FieldName: String; value: Variant): Boolean; } //Function FillStrings(Var ADtSet: TpFIBDataSet; AIDFieldName, AListField: String): TStrings; function GetMemTableByMemoryTableKind(AMemoryTableKind: TTableKind): TkbmMemTable; procedure DeleteRecords(ADataSet: TDataSet); procedure MTRefreshCurrentCompl(Var AMemTable: TkbmMemTable); Procedure SetPriceToMT(Var AMemTable: TkbmMemTable; AIDCompon, AIDChild: Integer; APrice: Double; AKolvo: Integer); procedure FillMemTableCableCanalConnectors(AMemTable: TkbmMemTable; ACableCanalConnectors: TList; AAsNew: Boolean); procedure FillMemTableProp(AMemTable: TkbmMemTable; APropKind: TPropKind); procedure FillMemTablePropFromMemBase(AMemTable: TkbmMemTable; APropKind: TPropKind); procedure FillMemTablePropFromList(AMemTable: TkbmMemTable; AList: TList; AAsNew: Boolean; ASkipCalcProps: Boolean=false; AReactive: Boolean=true); function CheckNoRepeatPropertyMT(AMemTable: TkbmMemTable; AIDProperty: Integer; AOwnerName: String): Boolean; procedure FillMemTableInterfRel(AComponOrObj: TObject; ANode: TTreeNode; AIsPort: Integer); function GetIDInterfListByNumPair(AIDComponent, ANumPair: Integer): TIntList; //procedure FillMemTableIOfIRel; procedure AddRecToMemTable(Var AMemTable: TkbmMemTable; ATableKind: TTableKind; ADataSource: TDataSource); //procedure AppendIDNameToMemTable(AID: Integer; AName: String; AMemTable: TkbmMemTable); procedure AppendItemToRepositoryImageComboBox(AEditRepository: TcxEditRepositoryImageComboBoxItem; AValue, AImageIndex: Integer; ADescription: String); Procedure ClearMemTableCompl; function GetCountryCurrency: TCurrency; function GetCurrencyByID(ACurrencyID: Integer): TCurrency; function GetCurrencyByType(ACurrencyType: Integer): TCurrency; procedure IntFieldToList(var AList: TList; AQuery: TSCSQuery; AFieldName: String); procedure IntFieldToIntList(var AList: TIntList; AQuery: TSCSQuery; AFieldName: String); procedure IntFieldToListFromSQLMemTable(var AList: TList; AMemTable: TSQLMemTable; AFieldName: String); procedure IntFieldToIntListFromSQLMemTable(var AList: TIntList; AMemTable: TSQLMemTable; AFieldName: String); function GetTableIDFromGuide(AViewKind: TViewKind; ACurrID: Integer; AFormMode: TFormMode; var AGUID: string; APropItemType: Integer = itNone): Integer; function GetIDCompRelByConnectCompons(AIDCompon1, AIDCompon2, AIDTopCompon, AIDParentCompRel: Integer; AConnectType: TConnectType): Integer; function GetMaxFieldValueFromSQLMemTable(ATable: TSQLMemTable; AFieldName: String): Integer; // %Table% procedure AddFieldToTable(ATableName, AFieldName: String; AFieldType: TFieldType; ASize: Integer); procedure AddFieldToAllTables(AFieldName: String; AFieldType: TFieldType; ASize: Integer); procedure DeleteRecordFromTableByID(ATableName: String; AID: Integer; AQueryMode: TQueryMode); procedure DeleteRecordsByGUIDList(ATableName: String; AGUIDList: TStringList); procedure DeleteRecordsByIDList(ATableName: String; AIDList: TIntList; AQueryMode: TQueryMode); function ExistsFieldInTable(ATableName, AFieldName: String; AQueryMoe: TQueryMode): Boolean; function GetDetailRecCount(ADetailTableName, AMasterFldName: String; AMasterID: Integer; AMemTable: TkbmMemTable = nil): Integer; function GetIntFromTable(const ATableName, AResFieldName, AFldBy: String; AFldValue: Variant;AQueryMode: TQueryMode): Integer; function GetIntFromTableByID(ATableName, AResFieldName: String; AIDBy: Integer; AQueryMode: TQueryMode): Integer; function GetIntFromTableByGUID(const ATableName, AResFieldName, AGUID: String; AQueryMode: TQueryMode): Integer; function GetSQLMemTableByIndex(ATableIndex: Integer): TSQLMemTable; function GetSQLMemTableByName(ATableName: String): TSQLMemTable; function GetStreamFromDataSet(ADataSet: TpFIBDataSet; AFieldName: String): TMemoryStream; function GetStreamFromTableByGUID(const ATableName, AFieldName, AGUID: String; AQueryMode: TQueryMode): TStream; function GetStreamFromTableByID(ATableName, AFieldName: String; AID: Integer; AQueryMode: TQueryMode): TMemoryStream; function GetStringFromTableByGUID(ATableName, AFieldName, AGUID: String; AQueryMode: TQueryMode): String; function GetStringFromTableByID(ATableName, AFieldName: String; AID: Integer; AQueryMode: TQueryMode): String; function GetStringFromTableFirst(ATableName, AFieldName: String): String; function GetValueFromTable(ATableName, AResFieldName, AFldBy: String; AFldValue: Variant; AQueryMode: TQueryMode): Variant; function GetValueFromTableFirst(ATableName, AResFieldName: string): Variant; procedure SelectRecordInMTByRecNo(AMemTable: TkbmMemTable; ARecNo: Integer); procedure SetDataSetIntValueAsZeroToNull(ADataSet: TpFIBDataSet; AFieldName: String; AValue: Integer); procedure UpdateBlobTableFieldByID(ATableName, AUpdFieldName: String; AIDBy: Integer; AStream: TStream; AFileName: String); procedure UpdateIntTableFieldByID(ATableName, AUpdFieldName: String; AIDBy, ANewValue: Integer; AQueryMode: TQueryMode); procedure UpdateStrTableFieldByID(ATableName, AUpdFieldName: String; AIDBy: Integer; ANewValue: String; AQueryMode: TQueryMode); procedure UpdateStrTableFieldAllRec(ATableName, AUpdFieldName, ANewValue: String); procedure UpdateAllRecFromField(ATableName, ATrgField, ASrcField: String); procedure UpdateTableField(ATableName, AUpdFieldName, AFldBy: String; AFldByValue, ANewValue: Variant; AQueryMode: TQueryMode); procedure UpdateTableFieldAllRec(ATableName, AUpdFieldName: String; ANewValue: Variant); function GetMaxSortIDFromTable(ATableName, AFNParentID, AFNSortID: String; AParentID: Integer): Integer; //*** Table Field Indexes procedure DefineFieldIndexesForKatalog; procedure DefineFieldIndexesForCatPropRel; procedure DefineFieldIndexesForCatRel; procedure DefineFieldIndexesForComponent; procedure DefineFieldIndexesForCompRel; procedure DefineFieldIndexesForCompPropRel; procedure DefineFieldIndexesForCableCanalConnectors; procedure DefineFieldIndexesForConnectedComponents; procedure DefineFieldIndexesForInterfaceRelation; procedure DefineFieldIndexesForIOfIRel; procedure DefineFieldIndexesForPortInterfRel; procedure DefineFieldIndexesForInterfPosConnection; procedure DefineFieldIndexesForNorms; procedure DefineFieldIndexesForNormResRel; procedure DefineFieldIndexesForResource; procedure DefineFieldIndexesForCADNormStruct; procedure DefineFieldIndexesForCADNormColumn; procedure DefineFieldIndexesForStringsMan; // Katalog //*** преопределить цены компонент папки, после перемещения ее между папками procedure DefineCatalogComponPricesAfterMoveToNewCatalog(AIDCatalog: Integer; AOldCurrencyM: TObjectCurrencyRel); function DelSimpleCatalog(AIDCatalog: Integer; AQueryMode: TQueryMode): Boolean; procedure DelCatalog(ACallFrom: TCallFrom; AIDCatalog, AIDItemType: Integer; AQueryMode: TQueryMode; aCatalogObj: TSCSCatalog=nil; aIsManual: Boolean=false); procedure DelComponent(AIDComponent: Integer; AObject: TSCSComponent; ADelComponMode: TDelComponMode; ACanDelCablesFromOtherList: PInteger = nil; AListWithCompons: TSCSComponents = nil; AStepProgress: Boolean = false); procedure UpdateCatalogFieldAsInteger(AID, AValue: Integer; AFieldBy, AFieldName: String; AMode: TQueryMode); procedure UpdateCatalogFieldAsString(AID: Integer; AValue, AFieldBy, AFieldName: String; AMode: TQueryMode); //function GetCatalogAllChildsIDs(AIDCatalog: Integer): TIntList; function GetCatalogAllComponIDs(AIDCatalog: Integer; AFromChild: Boolean): TIntList; function GetCatalogChildsID(AIDCatalog: Integer; ASCSCatalog: TSCSCatalog; AQueryMode: TQueryMode): TIntList; function GetCatalogComponentsID(AIDCatalog: Integer): TIntList; function GetCatalogComponentsIDByObjectID(AObjectID: Integer): TList; procedure GetCatalogItemsCountAndKolCompon(AIDCatalog: Integer; var AItemsCnt: Integer; var AKolCompon: Integer; AMode: TQueryMode); function GetCatalogKolCompon(AIDCatalog: Integer; AMode: TQueryMode): Integer; function GetCatalogKolComponFromLists(AIDCatalog: Integer): Integer; function GetChildCatalogsID(AParentID: Integer; ASortFld: String; AMode: TQueryMode): TIntList; function GetChildCatalogsIDFromLists(AParentID: Integer): TIntList; function GetListObjectsID(AListID: Integer; ASortFld: String): TList; function GetCatalogComponents(AIDCatalog: Integer; ASortFld: String; AFilterParams: TFilterParams; var ASkipCount: integer; AOnlyOne: Boolean): TSCSComponents; function GetCatalogItemsCntByID(AID, AItemType: Integer; AMode: TQueryMode): Integer; function GetCatalogItemsCntByIDFromList(AIDCatalog: Integer): Integer; function GetCatalogMaxMarkID(AItemType, AProjectID: Integer; AMode: TQueryMode): Integer; function GetCatalogMaxFieldValueByFilter(AFieldName, AFilter: String; AMode: TQueryMode): Integer; function GetCatalogFieldValueAsInteger(AID: Integer; AFieldBy, AFieldName: String; AQueryMode: TQueryMode): Integer; function GetCatalogFieldValueAsIntegerByFilter(AFiledName, AFilter: String; AQueryMode: TQueryMode): Integer; // Project function CheckProjectInUse(AIDProject: Integer; var AUserName: String; var AUserDateTime: TDateTime): Boolean; function GetAllProjectIDs: TIntList; function GetProjectSettings(AID: Integer): TProjectSettingRecord; procedure GetProjectsInUseInfo(AProjectNames, AUserNames: TStringList); function GetProjectsInUseInfoStr: String; //function GetIDCatalogByIDFigure(AIDFigure: Integer): Integer; //function GetIDCatalogByIDList(AIDList: Integer): Integer; //function GetIDCatalogBySCSID(ASCSID: Integer): Integer; //function GetIDListByIDCatalog(AIDCatalog: Integer): Integer; //function GetScsIDByIDCatalog(AIDCatalog: Integer): Integer; function GetIDCatalogByIDNoUppCompon(AIDComponent: Integer): Integer; function GetCatalogIDItemType(AIDCatalog: Integer; AQueryMode: TQueryMode): Integer; function GetCatalogByCompon(AIDComponent: Integer): TCatalog; function GetCatalogByItemType(AIDCatalog: Integer; ACatalogItemType: Integer): TCatalog; function GetCatalogByComponAndItemType(AIDComponent: Integer; ACatalogItemType: Integer): TCatalog; function GetCatalogByID(AIDCatalog: Integer; AQueryMode: TQueryMode): TCatalog; function GetParentCatalogIDByLevel(AIDCatalog, ALevel: Integer): Integer; // Вернет валюту папки AIDCatalog, по полю AMainValue function GetCatalogCurrencyByCurrencyID(AIDCatalog, AIDCurrency: Integer): PObjectCurrencyRel; // Вернет валюту папки AIDCatalog, по полю AMainValue function GetCatalogCurrencyByMainFld(AIDCatalog, AMainValue: Integer): PObjectCurrencyRel; // Вернет валюты для папки procedure GetCatalogCurrencies(AIDCatalog: Integer; var ACurrencyM, ACurrencyS: TObjectCurrencyRel); // Вернет валюту из папки или компоненты, которая соотв-т глобальной базовой валюте в НБ function GetCatalogOrComponCurrencyProperGlobalMainInNB(AIDCatalog, AIDComponent: Integer): TCurrency; // Catalog_Relation procedure DeleteCatalogRelation(AIDCatalog, AIDComponent: Integer); function GetCatRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; procedure UpdateCatRelFieldAsIntegerByFilter(AValue: Integer; AFieldName, AFilter: String); function GetCatRelCountByFilter(AFieldName, AFilter: String; ANoMoreOne: Boolean): Integer; function GetCatalogRelationFromMemTable: PCatalogRelation; procedure SaveCatalogRelation(AMakeEdit: TmakeEdit; AIDCatalog, AIDComponent: Integer); // Component procedure ApplyComponentForDir(ASCSComponent: TSCSComponent; AIDDir: Integer; ARecursive: Boolean); procedure UpdateComponFieldAsInteger(AID, AValue: Integer; AFieldName: String); procedure UpdateComponFieldAsFloat(AID: Integer; AValue: Double; AFieldName: String); procedure UpdateComponFieldAsIntegerByField(AByValue, AValue: Integer; AByFieldName, AUpdFieldName: String); procedure UpdateComponFieldAsString(AIDCompon: Integer; AValue, AFieldName: String); function CheckNBComponentCypher(ACypher: String; ANoIncludingID: Integer): Boolean; function GetComponIDByArtProducer(AArtProducer: String; ADisabledComponID: Integer): integer; function GetComponIDByIsLine(AIsLine: Integer): Integer; function GetComponsIDNameByType(AComponentTypeSysName: String): TIDStringList; function GetComponChilds(AIDComponent, AIDTopCompon, AIDCompRel: Integer; ACompon: TSCSComponent; const AsortFld: String): TSCSComponents; function GetComponCompRels(AIDComponent, AConnectType: Integer): TList; function GetComponChildsCompRels(AIDComponent: Integer): TList; //function GetComponIDsFromCatalogs(ACatalogIDs: TIntList): TIntList; function GetComponKolComplect(AComponent: TSCSComponent): Integer; function GetComponInterfaces(AIDComponent: Integer; ATakeIntoIsPort: Boolean; AIsPort: Integer): TSCSInterfaces; function GetComponFldValueAsString(AIDComponent: Integer; AFldName: String): String; function GenComponentNewCypher: String; function GetIDComponByInterfID(AIDInterface: Integer): Integer; function GetIDUpperComponByIDChild(AIDChild: Integer): Integer; function GetIDFirstComponInCatalog(AIDCatalog: Integer): Integer; function GetComponFieldValueAsInteger(AIDCompon: Integer; AFieldName: String): Integer; function GetComponFieldValuesAsInteger(AFieldName: String; StrWhere: String): TIntList; function GetComponFieldValueAsFloat(AIDCompon: Integer; AFieldName: String): Double; function GetComponCountByFilter(AFilter: String; ANoMoreOne: Boolean): Integer; function GetComponVolume(AIDComponent, AGender: Integer): Double; function GetParentIDsCompon(AIDComponent: Integer): TIntList; // Определить цены компонент после перемещения ее в другую папку procedure DefineComponPricesAfterMoveToNewCatalog(AIDComponent, AIDOldDir, AIDNewDir: Integer); // Вернет ID папки, в которой находится компонент AIDComponent function GetComponCatalogOwnerID(AIDComponent: Integer): Integer; // Вернет ID папки на уровне ALevel, в которой находится компонент AIDComponent function GetComponCatalogOwnerIDByLevel(AIDComponent, ALevel: Integer): Integer; function GetComponCurrencyByCurrencyGUID(AIDComponent: Integer; const AGUIDCurrency: String): PObjectCurrencyRel; // Вернет валюту компоненты AIDComponent, по полю AIDCurrency function GetComponCurrencyByCurrencyID(AIDComponent, AIDCurrency: Integer): PObjectCurrencyRel; function GetComponCurrencyByCurrencyIDFromListOrQuery(AIDComponent, AIDCurrency: Integer; AList: TList): PObjectCurrencyRel; // Вернет валюту компоненты AIDComponent, по полю AMainValue function GetComponCurrencyByMainFld(AIDComponent, AMainValue: Integer): PObjectCurrencyRel; function GetComponCurrencyByMainFldFromListOrQuery(AIDComponent, AMainValue: Integer; AList: TList): PObjectCurrencyRel; // Вернет главную и вторую валюты для компоненты AIDComponent procedure GetComponCurrencies(AIDComponent: Integer; var ACurrencyM, ACurrencyS: TObjectCurrencyRel); function GetComponCatalogNamePath(const AGUIDCompon: String; ALevel: Integer; AIncludeCompon: Boolean): TStringList; // вернет цену комплектующей с перещетом в валюте компоненты AIDComponent function GetChildComponPrice(AIDComponent, AIDChild: Integer; AChildPrice: Double; AComponCurrencies: TList): Double; // Template Relation procedure AppendToTemplateRel(AComponID, AIDGroup, AIsStandart: Integer; AModel: TStream=nil); function GetTemplateComponents(AGroupType: Integer; const ASortFld: string): TSCSComponents; function CheckCypher(ACypher, ACurrTable: String; ACurrID: Integer): Boolean; function GetConnectedIDInterfRels(AIDInterfRel: Integer): TList; function GetConnectedInterfacesValues(AQuery: TSCSQuery; AIDInterface: Integer): Double; function DelSimpleComponent(AIDComponent: Integer): Boolean; function GetComponentChildsID(AIDComponent: Integer): TIntList; function GetComponentType(AIDComponentType: Integer): TComponentType; function GetComponentTypeByIDCompon(AIDComponent: Integer): TComponentType; function DefineIDComponByPortMultiport(AIDComponent: Integer): Integer; function GetComponentLastPort(AIDComponent: Integer): Integer; // Tolik 10/04/2020 -- //procedure DefineComponNppPorts(AComponent: TSCSComponent; aDestChildCompon: TSCSComponent=nil); procedure DefineComponNppPorts(AComponentList: TList; aDestChildCompon: TSCSComponent = nil); // //20.08.2012 procedure DefineComponNppPortsByPortMultiport(AComponent: TSCSComponent); function CheckNoComponInComplects(AComponent: TSCSComponent): Boolean; function CheckNoDirComponsInComplects(ADir: TSCSCatalog; ADirComponsID: TIntList): Boolean; function CheckNoDirComponsTemplates(ADir: TSCSCatalog; ADirComponsID: TIntList): Boolean; function CheckHaveDirProjects(AIDDir: Integer): Boolean; procedure ClearComponentsFromGarbage; // Property procedure DefineNBProperty(ADirItemType: Integer; const AGUIDDirType: string; aPropData: PPropertyData); function GetPropertyIDFromGuide(ACurrID: Integer; AFormMode: TFormMode; AItemType: Integer): Integer; function GetPropertyData(AID: Integer; AGUID: String; ASpravochnik: TSpravochnik = nil): TPropertyData; function GetPropertyFromTable(ADataSource: TDataSource; ADataSet: TDataSet=nil): TProperty; procedure SetPropertyToTable(ADataSource: TDataSource; AProperty: TProperty); procedure SaveProperty(AMakeEdit: TMakeEdit; APropertyData: PPropertyData); // PropValRel procedure SavePropValRel(AMakeEdit: TMakeEdit; APropValRelData: PPropValRelData); // PropValNormRes procedure SavePropValNormRes(AMakeEdit: TMakeEdit; APropValNormResData: PPropValNormResData); // x_prop_relation procedure InsertToPropRelation(APropKind: TPropKind; AIDMaster, AIDProperty: Integer; AValue: String; AIsDefault: Integer; AMode: TQueryMode); procedure DeleteFromPropRelation(APropKind: TPropKind; AObjectID, AIDPropRel: Integer; AMode: TQueryMode); function CanEditProperty(APropertyTable: TkbmMemTable): Boolean; 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 LoadPropertyFromQuery(AProperty: PProperty; AQuery: TpFIBQuery; ATreeElementType: TSCSTreeElementType); procedure SavePropertyRelation(AMakeEdit: TMakeEdit; ATablePropKind: TPropKind; AProperty: PProperty); //procedure AddEditPropertyRelation(APropKind: TPropKind; AIDMaster, // AIDProperty: Integer; AValue: String; AMode: TQueryMode); // comp_prop_relation procedure UpdateCompPropRelFieldAsInteger(AIDPropRel, AValue: Integer; AFieldName: String); function GetCatalogPropertyFromMemTable(ALoadNames: Boolean; AStringsMan: TStringsMan): PProperty; function GetComponPropertyFromMemTable(ALoadNames: Boolean; AStringsMan: TStringsMan): PProperty; procedure LoadPropNamesByID(AIDProperty: Integer; var AName, ASysName: String); procedure RemovePropertyFromComponents(AIDProperty: Integer); procedure SaveCatalogPropertyToMemTable(AMakeEdit: TMakeEdit; AProperty: PProperty; AStringsMan: TStringsMan); procedure SaveComponPropertyToMemTable(AMakeEdit: TMakeEdit; AProperty: PProperty; AStringsMan: TStringsMan); // component_relation procedure DeleteCompRelByID(AIDCompRel: Integer); procedure UpdateCompRelFieldAsInteger(AID, AValue: Integer; AFieldName: String); function GetCompRelByID(AIDCompRel: Integer): TComplect; function GetCompRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; function GetCompRelFieldValueListByFilter(AFieldName, AFilter: String): Tlist; function GetCompRelMaxFieldValueByFilter(AFieldName, AFilter: String): Integer; function HaveCompRelConnectingWithMultipleInterfaces(AIDCompRel: Integer; aIOfIRelList: TList): Boolean; //function GetJoinComponents(AComponent: TSCSComponent): TSCSComponents; procedure DefineIDComponAndIDChild(var AIDCompRel, AIDComponent, AIDChild: Integer); function GetCompRelFromMemTable: PComplect; procedure SaveCompRelToMemTable(AMakeEdit: TMakeEdit; AComplect: PComplect); // connected_components procedure InsertToConnCompons(AComponWholeID, AIDConnectedObject, AIDConnectedCompon, AIDSideCompon, ATypeConnect: Integer); function GetConnectedComponsInfoFromMemTable: TConnectedComponsInfo; procedure SaveConnectedComponsInfoToMemTable(AMakeEdit: TMakeEdit; AConnectedComponsInfo: TConnectedComponsInfo); // CrossConnection // добавляет подключение между комплетующими в MemTable в НБ procedure AddNBConnectionToMemTable(AMemTable: TkbmMemTable; AIDTopCompon, AIDComplect: Integer; ANBConnection: TSCSCrossConnection); procedure DeleteCrossConnection(AID: Integer); //function GetCrossConnectionFromQuery(AQuery: TpFIBQuery): PCrossConnection; procedure LoadCrossConnectionToMemTable(AMakeEdit: TMakeEdit; ADestMemTable: TkbmMemTable; ACrossConnection: TSCSCrossConnection); procedure LoadCrossConnectionFromMemTable(ASrcMemTable: TkbmMemTable; ADestCrossConnection: TSCSCrossConnection); procedure LoadCrossConnectionsNames(ACrossConnections: TSCSObjectList); procedure LoadCrossConnectionsPaths(ACrossConnections: TSCSObjectList); //procedure InsertUpdateCrossConnection(AMakeEdit: TMakeEdit; ACrossConnection: TSCSCrossConnection); // Interface function GetInterfName(AIDInterface: Integer): String; function GetInterfaceInfo(AIDInterfase: Integer): TInterfaceInfo; procedure SaveInterface(AMakeEdit: TMakeEdit; AInterfaceInfo: PInterfaceInfo); procedure SaveInterfaceAccordance(AMakeEdit: TMakeEdit; AInterfaceAccordanceInfo: PInterfaceAccordanceInfo); procedure SaveInterfaceNorm(AMakeEdit: TMakeEDit; AInterfaceNormInfo: PInterfaceNormInfo); // Interface_Relation procedure DefineInterfRelIDsForKolvo(AClearPrevios: Boolean; AInterfRelIDsForKolvo, AInterfRelKolvosForKolvo: TIntList; AmtPortInterfRel: TkbmMemTable); procedure DefineInterfacesKolvoByPortKolvo(ANewPortKolvo: Integer; AmtPortInterfRel, AmtInterfaces: TkbmMemTable; AInterfRelIDsForKolvo, AInterfRelKolvosForKolvo: TIntList); procedure DefineInterfaceNumPairs(AmtInterfaces: TkbmMemTable; AmeInterfaceRel: PmeInterfaceRel); procedure DefineInterfaceNumPairsStr(AmtInterfaces: TkbmMemTable; ANumPair, AKolvo: Integer); procedure DeleteInterfInternalConnFromMTByInterfIDs(AmtInterfInternalConn: TkbmMemTable; AInterfIDs: TIntList); procedure DeleteInterfRelByID(AIDInterfRel: Integer); procedure DeleteInterfRelByFilter(AFilter: String); procedure UpdateInterfFieldAsInteger(AIDInterfRel, AValue: Integer; AFieldName: String); procedure UpdateInterfFieldAsFloat(AIDInterfRel: Integer; AValue: Double; AFieldName: String); function GetInterfaceNewNumPairFromMT(AmtInterfaces: TkbmMemTable): Integer; function GetInterfFldValueAsInteger(AIDInterfRel: Integer; AFldName: String): Integer; function GetInterfCountByFilter(AFilter: String; ANoMoreOne: Boolean): Integer; function GetInterfMaxFldValueByFilter(AFieldName, AFilter: String): Integer; function GetInterfToListByIDCompon(AIDComponent, AIDCompRel: Integer): TIntList; function GetInterfToListByIDInterfRel(AIDInterfRel: Integer): TList; function GetInterfIDListByIDCompon(AIDCompon: Integer): TList; function GetInterfFieldListByFilter(AFieldName, AFilter: String): TList; function GetInterfacesThatInConnection(AIDCompRel: Integer; aIOfIRelList: TList): TSCSInterfaces; function GetInterfacesThatMayBeNoBusy: TSCSInterfaces; procedure CorrectInterfaceAdverseRelation(AIDComponent: Integer); function GetInterfaceIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; function GetIDInterfaceByIDInterfRelFromMemTable(AIDInterfRel: Integer; AMemTable: TkbmMemTable; AInterfKolvo: PInteger): Integer; function GetIDInterfRelByIDInterfaceFromMTThatNoInList(AIDInterface, AKolvo: Integer; AMemTable: TkbmMemTable; AIDList: TIntList): Integer; function GetNameComponFromObject(AIdComponent: Integer): String; function GetNamePortByIDPort(AIDPort: Integer): String; //procedure DefineNppInterfaces(AComponent: TSCSComponent); procedure LoadFromMemTableToInterface(ADestInterface: TSCSInterface; ASrcMemTable: TkbmMemTable); procedure LoadInterfaceToMemTable(AInterface: TSCSInterface; ADestMemTable, APortInterfRelMT, AInterfInternalConn: TkbmMemTable; AMakeEdit: TMakeEdit; AIsLine: Integer; AIsNative, AInterfInConnecting: Boolean); procedure LoadInterfRelNamesToMemTable(AMemTable: TkbmMemtable); procedure RemoveNoNativeInterfacesFromMemTable(AMemTable: TkbmMemtable); procedure UpdateInterfacesFromMemTable(AMemTable: TkbmMemTable; ADataSource: TDataSource); // interfofinterf_relation procedure DeleteIOfIRelByFilter(AFilter: String); procedure DeleteIOfIRelByInterfIDs(AIDInterfRel, AIDInterfTo: Integer; AParamExch: Boolean); procedure DeleteIOfIRelByInterfID(AIDInterfRel: Integer); procedure DeleteIOfIRelByIDCompRel(AIDCompRel: Integer; aIOfIRelList: TList); procedure UpdateIOfIRelFieldAsInteger(AIDIOfIRel, AValue: Integer; AFieldName: String); function InsertToIOfIRel(AIDInterfRel, AIDInterfTo, AIDCompRel: Integer): Integer; function GetIOfIRelFieldValueAsInteger(AID: Integer; AFieldName: String): Integer; function GetIOfIRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; function GetIOfIRelFieldValueAsIntListByFilter(AFieldName, AFilter: String): TList; function GetIOfIRelIDCompRelListByInterfIDs(AIDInterfRel, AIDInterfTo: Integer): TIntList; function GetIOfIRelByFieldValue(AFieldName: String; AValue: Integer): Tlist; function GetIOfIRelCountByFulter(AFilter: String; ANoMoreOne: Boolean): Integer; function GetIOfIRelFromMemTable: TSCSIOfIRel; procedure SaveIOfIRelToMemTable(AMakeEdit: TMakeEdit; AIOfIRel: TSCSIOfIRel); // PortInterfaeRelation function GetPortInterfRelFromMemTable: PPortInterfRel; procedure LoadFromMemTableToPortInterfRel(ADestPortInterfRel: PPortInterfRel; ASrcMemTable: TkbmMemTable); procedure LoadPortInterfRelsToInterfaceFromMT(ADestInterface: TSCSInterface; ASrcMemTable, AmtInterfInternalConn: TkbmMemTable; AMTSetAsNoChanged: Boolean = false); procedure SavePortInterfRelToMemTable(AMakeEdit: TMakeEdit; APortInterfRel: PPortInterfRel); // InterfPos Connection function GetInterfPosConnectionFromMemTable: TSCSInterfPosConnection; procedure SaveInterfPosConnectionToMemTable(AMakeEdit: TMakeEdit; AInterfPosConnection: TSCSInterfPosConnection); // Object Icons function GetIDObjectIconFromGuide(AIDCurrInterf: Integer): Integer; procedure SaveObjectIcon(AMakeEdit: TMakeEdit; AObjectIconInfo: PObjectIconInfo); // CableCanalConnecotrs function GetCableCanalConnectors(AIDCableCanal: Integer): Tlist; function GetCableCanalConnectorFromMemTable(AStringsMan: TStringsMan): PCableCanalConnector; procedure SaveCableCanalConnectorToMemTable(AMakeEdit: TMakeEdit; ACableCanalConnector: PCableCanalConnector; AStringsMan: TStringsMan); procedure SetCableCanalConnectorTokbmMemTable(AMemTable: TkbmMemTable; ACableCanalConnector: PCableCanalConnector); // Norm Resources function AddEditNormWithMemTable(AMakeEdit: TMakeEdit; AIDMaster: Integer; AMemTable: TkbmMemTable; AOldCurrency, ANewCurrency: TCurrency; ASaveObjectAddressIfMake: Boolean): TSCSNorm; function AddEditResourceWithMemTable(AMakeEdit: TMakeEdit; AIDMaster, AIDCatalog: Integer; AMemTable: TkbmMemTable; AMemoryTableKind: TTableKind; AOldCurrency, ANewCurrency: TCurrency; AMakeFromCompon, ASaveObjectAddressIfMake: Boolean): TSCSResourceRel; procedure CalcNormCostTime(AMemTable: TkbmMemTable; const aFieldEdited: String; var aIsCalcNormTotal: Boolean); procedure CalcNormTatalCostInMT(AMemTable: TkbmMemTable; ALength: Double); function GetNewNPPFromMemTable(AMemTable: TkbmMemTable): Integer; procedure LoadFromResourceToMT(AResource: TSCSResourceRel; AMemTable: TkbmMemTable; AMakeEdit: TMakeEdit; AMemoryTableKind: TTableKind; AObjectLength: Double; AObject: TObject); procedure LoadFromNormToMT(ASCSNorm: TSCSNorm; AMemTableNorms: TkbmMemTable; AMakeEdit: TMakeEdit; AKolvo: Double; AObjectLength: Double; AObject: TObject); procedure LoadFromMTToResource(AMemTable: TkbmMemTable; AResourceRel: TSCSResourceRel; AMemoryTableKind: TTableKind); procedure LoadFromMTToNorm(AMemTable: TkbmMemTable; ASCSNorm: TSCSNorm); procedure SdvigNPPInMemTable(ANPPAfter: Integer; AMemTable: TkbmMemTable); // nb_Norms function GetNBNormIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; function GetComponIconByIconType(AIDIcon, AIconType, AIconExt: Integer; AGUIDIcon: String = ''): TMemoryStream; function GetNormFromSpravochnik(AFormMode: TFormMode; AGUIDNorm: string; AIDMaster: Integer; AOldCurrency, ANewCurrency: TCurrency): TSCSNorm; // added by Tolik Returns Expence from IZM function GetExpenceFromIzm(izm:string): real; procedure DelCatRelByIDCompon(AIDComponent: Integer); procedure DelNormsByMasterID(AIDMaster: Integer; ATableKind: Integer); procedure DelNormByID(AIDNorm: Integer); procedure SaveNorm(AMakeEdit: TMakeEdit; ANormInfo: PNormInfo); // Resources procedure DelResourcesByMasterID(AIDMaster: Integer; ATableKind: Integer); procedure DelResourceRelByID(AIDResourceRel: Integer); procedure DelResourceByID(AIDResource: Integer); procedure SaveResource(AMakeEdit: TMakeEdit; AResourceInfo: PResourceInfo); // Currency function GetCurrencyIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; // ObjectCurrencyRel procedure CopyCurrenciesFromOtherObject(AIDSrcCatalog, AIDTrgCatalog: Integer); procedure CreateDefCurrenciesForObject(AIDCatalog: Integer); procedure CreateDefCurrenciesForObjectsByLevel; procedure DeleteObjectCurrencies(AIDCatalog: Integer); function GetDefObjectCurrencyByIDCurrency(AIDCurrency: Integer): PObjectCurrencyRel; function GetDefObjectCurrencyByMainFld(AMainValue: Integer): PObjectCurrencyRel; function GetObjectCurrencyFromMemTable(AMemTable: TkbmMemTable): PObjectCurrencyRel; function GetObjectCurrencyByMainFld(ACatalogID, AMainValue: Integer): PObjectCurrencyRel; function GetObjectCurrencyByIDCurrency(ACatalogID, AIDCurrency: Integer): PObjectCurrencyRel; procedure SetObjectCurrencyToMemTable(AObjectCurrency: PObjectCurrencyRel; AMemTable: TkbmMemTable); procedure SetObjectCurrencyAsMain(AObjectID, ANBCurrencyID: Integer); procedure SaveObjectCurrency(AMakeEdit: TMakeEdit; AObjectCurrency: PObjectCurrencyRel); // SuppliesKinds function GetAllSuppliesKinds: TList; function GetSuppliesKindByID(AID: Integer; AGUID: string): TSuppliesKind; procedure InsertSuppliesKindToTopDirType(ASuppliesKind: PSuppliesKind); procedure SaveSuppliesKind(AMakeEdit: TMakeEdit; ASuppliesKind: PSuppliesKind); // DirectoryType function GetContensCountFromDir(AIDDirType: Integer; ADirTypeInfo: TDirTypeInfo; AWhereStr: string): Integer; function GetIDDirTypeByName(ADirItemType: Integer; AName: String): Integer; function GetTopIDDirType(ADirItemType: Integer): Integer; function InsertDirTypeFolder(AName: String; ADirItemType, AParentID: Integer): Integer; function InsertToTopDirTypeItem(ADirItemType, AIDItem: Integer): Integer; function InsertToDirecoryTypeRel(AIDDirectoryType, AIDPointer: Integer; const APointerFieldName: String): Integer; // добавит в ветку справочника (по имени ADirTypeName) новый элемент AIDItem function InsertToDirTypeItemByDirTypeName(ADirItemType: Integer; ADirTypeName: string; AIDItem: Integer; AOutIDDestDirType: PInteger = nil): Integer; function GetDirectoryTypeByContentItem(AIDItemPointer: Integer; AItemFieldName: String): TDirectoryType; function GetDirectoryTypeByID(AID: Integer): TDirectoryType; function GetIDDirTypeRelByIDPointer(AIDPointer: Integer; APointerFieldName: String): Integer; function GetIDDirTypeRelByParams(AIDDirType, AIDPointer: Integer; APointerFieldName: String): Integer; //*** Producers function GetAllProducers: TList; procedure SaveProducer(AMakeEdit: TMakeEdit; AProducer: PProducer); //*** ComponentTypes procedure RemoveIDComponTemplateFromComponTypes(AIDComponent: Integer); procedure SaveComponentType(AMakeEdit: TMakeEdit; AComponentType: PComponentType); function GetComponentTypesFieldValuesAsInteger(const AFieldName: String; const StrWhere: String): TIntList; //*** NetTypes procedure SaveNetType(AMakeEdit: TMakeEdit; ANetType: PNetType); //*** Input strings function CheckExistsInputString(AString: String; ATypeS: Integer; AMessageIfExists: Boolean): Boolean; procedure LoadInputStringsToTStrings(ATrgStrings: TStrings; ATypeS: Integer); function SendTextToInputStrings(AText: String; ATypeS: Integer; AMessageIfExists: Boolean): Boolean; function SendTextToInputStringsWithAddToTStrings(AText: String; ATypeS: Integer; AMessageIfExists: Boolean; ATrgStrings: TStrings): Boolean; //*** Guide Files function SaveGuideFile(AID, AFType: Integer; const AName, Aext: String; ADescription: TStrings; AContent: TStream; AContentPacked: Boolean=true): Integer; //*** CADNormObjects function GetCADNormStructFromMemTable(AStringsMan: TStringsMan): TCADNormStruct; function GetCADNormColumnFromMemTable(AStringsMan: TStringsMan): TCADNormColumn; procedure SaveCADNormStructToMemTable(AMakeEdit: TMakeEdit; ACADNormStruct: TCADNormStruct; AStringsMan: TStringsMan); procedure SaveCADNormColumnToMemTable(AMakeEdit: TMakeEdit; ACADNormColumn: TCADNormColumn; AStringsMan: TStringsMan); //*** CADCrossObjects function GetCADCrossObjectFromMemTable(AStringsMan: TStringsMan): TCADCrossObject; function GetCADCrossObjectElementFromMemTable(AStringsMan: TStringsMan): TCADCrossObjectElement; procedure SaveCADCrossObjectToMemTable(AMakeEdit: TMakeEdit; ACADCrossObject: TCADCrossObject; AStringsMan: TStringsMan); procedure SaveCADCrossObjectElementToMemTable(AMakeEdit: TMakeEdit; ACADCrossObjectElement: TCADCrossObjectElement; AStringsMan: TStringsMan); // REPORT_SORT_INFO function GetReportSortInfoList: TObjectList; procedure SaveReportSortInfo(AReportSortInfo: TObject); //*** USER REPORTS function GetUserReportsInfo: TList; function InsertUserReportToBase(AUserReportInfo: TUserReportInfo): Integer; function SaveUserReportByIDToFile(AIDUserReport: Integer; ATrgFile: String): Boolean; //*** Filter function CanShowCatalogByFilter(ACatalogID: Integer; AFilterParams: TFilterParams; ALookedComponCount: PInteger=nil): Boolean; function CanShowComponByFilter(AIDComponent: Integer; AFilterParams: TFilterParams; ALoadSQL: Boolean): Boolean; function CanShowOneComponFromListByFilter(AComponIDs: TIntList; {ACatalogID: Integer;} AFilterBlock: TFilterBlock; ALoadSQL: Boolean): Boolean; procedure DefineIsOnFilterBlocks(AMainFilterParams: TFilterParams; AApplyComponentFilter: Boolean); function GetFilterFieldValuesFromTable(AFieldNameValues, AFieldNameCaptions, ATAbleName: string): TFilterField; function GetFilterValuesBySprElements(ASprElements: TSprElements): TObjectList; function GetFilterInfoFromMemTable: TFilterInfo; procedure SaveFilterInfoToMemTable(AFilterInfo: TFilterInfo); //*** Freq Obj Use procedure AddComponGUIDToFreqUseObj(AGuid: string); procedure DelSpareFreqUseObj(AMaxObjCount, AObjType: Integer); function GetComponGUIDsFromFreqUseObj(AMaxCount: Integer): TStringList; //*** UsersInfoPM function GetUsersInfoFromProject(AProjID: Integer): TUsersInfo; procedure SaveUsersInfoPMToBase; procedure SaveUsersInfoToProject(AProjID: Integer; AUsersInfo: TUsersInfo); procedure UpdateNBStructure; procedure UpdateNBValues; procedure StoreGuidsInReservGuidTable; function GetComponsFailPortWireCount(aOnlyPortWithRelInterf: Boolean=false; aAllowCorrect: Boolean=false): TStringList; constructor Create(AOwner: TComponent; AForm: TForm); //destructor Destroy; override; end; //function RoundIBD(Num: Extended; Dig: integer): Extended; function DataSetLocateByID(ADataSet: TpFIBDataSet; AID: Integer): Boolean; procedure RefreshDataSet(ADataSet: TpFIBDataSet); Function SearchRecord(SDataSet: TpFIBDataSet; FieldName: String; value: Variant): Boolean; function SearchRecordMT(var Table: TkbmMemTable; FieldName: String; value: Variant): Boolean; function FieldExistsInTable(ATable: TSQLMemTable; AFieldName: String): Boolean; function AddItemToCombo(const AComboBox: TcxComboBox; AName, AGUIDItem: String; AIDItem: Integer; const AFixGUID: String; AFixID: Integer; AIsFixedItem: PBoolean): TIDGuidObject; procedure FillComboBox(AComboBox: TcxComboBox; AFormBase: TForm; AMakeEmptyItem: Boolean; const ATableName, AIDfld, Alistfld, AEmptyFldName: String; AFixID: Integer = -1; const AFixGUID: String = ''; const ASQLFilter: string=''); procedure FillComboBoxFromMT(AComboBox: TcxComboBox; AMemTable: TkbmMemTable; AMakeEmptyItem: Boolean; AIDfld, AListfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''); procedure FillComboBoxRz(var AComboBox: TRzComboBox; AFormBase: TForm; AMakeEmptyItem: Boolean; ATableName, AIDfld, Alistfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''; AFilter: String = ''); procedure FillComboBoxRzFromMT(AComboBox: TRzComboBox; AMemTable: TkbmMemTable; AMakeEmptyItem: Boolean; AIDfld, AListfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''); function GetGUIDFromComboBox(AComboBox: TcxComboBox): String; function GetGUIDFromComboBoxRz(AComboBox: TRzComboBox): String; function GetIDFromComboBox(AComboBox: TcxComboBox): Integer; function GetIDFromComboBoxRz(AComboBox: TRzComboBox): Integer; function GetNameFromComboByGUIDRz(ACombo: TRzComboBox; AGUID: String): String; function GetNameFromComboByIDRz(ACombo: TRzComboBox; AID: Integer): String; function SelectItemByGUIDinCombo(AComboBox: TcxComboBox; AGUID: String): Boolean; function SelectItemByGUIDinComboRz(AComboBox: TRzComboBox; const AGUID: String): Boolean; function SelectItemByIDinCombo(AComboBox: TcxComboBox; AID: Integer): Boolean; function SelectItemByIDinComboRz(AComboBox: TRzComboBox; AID: Integer): Boolean; function SelectItemByTextinCombo(AComboBox: TcxComboBox; AText: String; ACaseSensitive: Boolean=true): Boolean; procedure AddIDGUIDToComboRz(AID: Integer; const AGUID, AString: String; AComboBox: TRzComboBox); procedure AddIDToCombo(AID: Integer; AString: String; AComboBox: TcxComboBox); procedure AddIDToComboRz(AID: Integer; const AString: String; AComboBox: TRzComboBox); procedure AddIDToStrings(AID: Integer; const AString: String; AStrings: TStrings); procedure ClearComboBox(AComboBox: TcxComboBox); procedure ClearComboBoxRz(AComboBox: TRzComboBox); function IndexOfIDInStrings(AID: Integer; AStrings: TStrings): Integer; procedure WriteToDataSet(var DS: TPFibDataSet; FieldName: String; Value: Variant); procedure WriteToMemTable(AMemTable: TkbmMemTable; AFieldName: String; AValue: Variant); procedure WriteToSQLMemTable(AMemTable: TSQLMemTable; AFieldName: String; AValue: Variant); //function GetDisplayFormat(NameBrief: String): String; //function InputForm(AForm: TForm; ACaption, APrompt, ADefault: Variant; ADataType: Integer = dtString): Variant; function InputFormCombo(AForm: TForm; const ACaption, APrompt, ADefault, ACheckBoxCaption: String; AStringList: TStringList; AChackBoxValue: PBoolean): TStringItem; procedure ShowList(AForm: TForm; ATreeKind: TTreeKind; ASourceFormMode: TFormMode; AMessg: string; AisShowModal: Boolean); procedure SetSQLToQuery(AQuery: TSCSQuery; SQLCode: String; AExec: Boolean = true); procedure SetSellSQLToDataSet(ADataSet: TpFIBDataSet; ASQLCode: String); function SetFilterToSQLMemTable(ATable: TSQLMemTable; AFilterCode: String): Boolean; function GetIndexByFldFomSQLMemTable(ATable: TSQLMemTable; AFieldName: String): String; function GetRecCountFromSQLMemTable(ATable: TSQLMemTable; ANoMoreOne: Boolean): Integer; function GetMaxRecValueFromSQLMemTable(ATable: TSQLMemTable; AFieldName: String): Integer; procedure ChangeSQLQuery(AQuery: TSCSQuery; ASQLCode: String); procedure SQLBuilder(AQuery: TSCSQuery; AQueryType: TQueryType; ATableName, AWherePart: String; AFieldList: TStringList; AExecQuery: Boolean); procedure LoadBufferToMemTableBlobField(AMemTable: TSQLMemTable; AFieldName: String; var ABuffer; ABufSize: Integer); procedure StreamFromQueryToMemTable(AQuery: TSCSQuery; AMemTable: TSQLMemTable; AQFieldName, AMTFieldName: String); procedure StreamFromMemTableToQuery(AMemTable: TSQLMemTable; AQuery: TSCSQuery; AMTFieldName, AQFieldName: String); procedure StreamFromMemTableToFIBQuery(AMemTable: TSQLMemTable; AQuery: TpFIBQuery; AMTFieldName, AQFieldName: String); var GGForm: TForm; // DM: TDM; implementation Uses U_Main, U_InputBox, U_CanDelete, U_CaseForm, U_BaseSettings, U_Common, {, Unit_DM_SCS;} cxGridCustomView, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGrid, U_AddComponent, U_ResourceReport, U_Progress, cxSpinEdit; {$R *.dfm} (* function RoundIBD(Num: Extended; Dig: integer): Extended; var Fakt: Extended; Vrem: Extended; pw: Extended; begin SetPrecisionMode(pmExtended); Set8087CW(Default8087CW); pw := Power(10, Dig); Fakt := Frac(Num); Fakt := pw * Fakt; Vrem := Frac(Fakt); Fakt := Int(Fakt); { if (Vrem - 0.5) >= -epsilon then Fakt := Fakt + 1 else if (Vrem + 0.5) <= -epsilon then Fakt := Fakt - 1; } Result := Int(Num) + Fakt/pw; end; *) // added by Tolik // Если в измерителе есть число (например 100 шт), то берем его оттуда // и получаем количество относительно измерителя - в данном случае, 0,01 // или 1 - если ничего нет function TDM.GetExpenceFromIzm(izm:string): real; var canHaveNumbers : boolean; OtherSimbolFound : boolean; s : string; i : integer; begin Result:=1; // пока, типа, ничего нет canHaveNumbers := false; OtherSimbolFound := false; s:=''; for i:=1 to Length(izm) do begin case izm[i] of // собираем числа из измерителя, (если есть) до единиц измерения(опять же, если есть) ... '0'..'9' : begin canHaveNumbers :=true; // есть цифра! ставим флажок s:=s+izm[i]; end; //... и пробелы(если есть), пробел не есть число, но учитывать надо // пробел просто не выбираем ' ' : begin // Если встречаем пробел после того как уже находили цифры, // то прерываем чтение (выставляем флаг) -- нефиг ... if canHaveNumbers then OtherSimbolFound:=true; end; else // Если встречаем символ - прерываем чтение (выставляем флаг) OtherSimbolFound := true; end; if OtherSimbolFound then break; end; // если надыбали число, высчитаваем единицу относительно нормы // в резалт функции, но только в том случае, если у нас в итоге не получился ноль // (иначе вернем по умолчанию ЕДИНИЦУ) if (Length(s)>0) and (StrToFloat_My(s)<>0) then Result := RoundX((1/StrToFloat_My(s)),4); end; // function FieldExistsInTable(ATable: TSQLMemTable; AFieldName: String): Boolean; var i: Integer; begin Result := false; if Assigned(ATable) then for i := 0 to ATable.FieldDefs.Count - 1 do begin if ATable.FieldDefs[i].Name = AFieldName then begin Result := true; Break; ///// BREAK ////// end; end; end; function AddItemToCombo(const AComboBox: TcxComboBox; AName, AGUIDItem: String; AIDItem: Integer; const AFixGUID: String; AFixID: Integer; AIsFixedItem: PBoolean): TIDGuidObject; var ComboItemObject: TIDGuidObject; begin if AIsFixedItem <> nil then AIsFixedItem^ := false; ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AIDItem; //FN(AIDfld).AsInteger; ComboItemObject.GUID := AGUIDItem; AComboBox.Properties.Items.AddObject(AName, ComboItemObject); Result := ComboItemObject; // Индекс в списке if (AIDItem = AFixID) or (AGUIDItem = AFixGUID) then if AIsFixedItem <> nil then AIsFixedItem^ := true; end; procedure FillComboBox(AComboBox: TcxComboBox; AFormBase: TForm; AMakeEmptyItem: Boolean; const ATableName, AIDfld, AListFld, AEmptyFldName: String; AFixID: Integer = -1; const AFixGUID: String = ''; const ASQLFilter: string=''); var ComboItemObject: TIDGuidObject; CurrItemIndex: Integer; FixComboItemObject: TIDGuidObject; FixID: Integer; FixGUID: String; IsFixedItem: Boolean; SQLWhere: string; ListfldIndex: Integer; GUIDfldIndex: Integer; IDfldIndex: Integer; i: Integer; CCount: Integer; begin AComboBox.Properties.BeginUpdate; AComboBox.Properties.Items.BeginUpdate; FixComboItemObject := nil; try FixID := AFixId; FixGUID := AFixGUID; if (AFixID = -1) and (AFIxGUID = '') then if AComboBox.ItemIndex > -1 then begin CurrItemIndex := AComboBox.ItemIndex; if AComboBox.ItemIndex > AComboBox.Properties.Items.Count - 1 then CurrItemIndex := AComboBox.Properties.Items.Count - 1; ComboItemObject := TIDGuidObject(AComboBox.Properties.Items.Objects[CurrItemIndex]); FixID := ComboItemObject.ID; FixGUID := ComboItemObject.GUID; end; //*** Очистить список ClearComboBox(AComboBox); //*** Внести пустую строку if AMakeEmptyItem then begin ComboItemObject := AddItemToCombo(AComboBox, AEmptyFldName, '', 0, FixGUID, FixID, @IsFixedItem); if IsFixedItem then FixComboItemObject := ComboItemObject; end; //*** Загрузить спиок with TF_Main(AFormBase).DM do begin SQLWhere := ''; if ASQLFilter <> '' then SQLWhere := SQLWhere + ' WHERE '+ASQLFilter+' '; Query_Select.Close; Query_Select.SQL.Text := 'select '+AIDfld+', '+fnGUID+', '+AListFld+' from '+ ATableName+' '+SQLWhere; if AListFld <> '' then Query_Select.SQL.Text := Query_Select.SQL.Text + 'order by '+AListFld; Query_Select.ExecQuery; ListfldIndex := Query_Select.FieldIndex[AListfld]; GUIDfldIndex := Query_Select.FieldIndex[fnGUID]; IDfldIndex := Query_Select.FieldIndex[AIDfld]; while Not Query_Select.Eof do begin //ComboItemObject := AddItemToCombo(AComboBox, Query_Select.FN(AListfld).AsString, Query_Select.FN(fnGUID).AsString, Query_Select.FN(AIDfld).AsInteger, // FixGUID, FixID, @IsFixedItem); ComboItemObject := AddItemToCombo(AComboBox, Query_Select.Fields[ListfldIndex].AsString, Query_Select.Fields[GUIDfldIndex].AsString, Query_Select.Fields[IDfldIndex].AsInteger, FixGUID, FixID, @IsFixedItem); if IsFixedItem then FixComboItemObject := ComboItemObject; Query_Select.Next; end; Query_Select.Close; end; AComboBox.ItemIndex := AComboBox.Properties.Items.IndexOfObject(FixComboItemObject); finally AComboBox.Properties.Items.EndUpdate; AComboBox.Properties.EndUpdate; end; end; procedure FillComboBoxFromMT(AComboBox: TcxComboBox; AMemTable: TkbmMemTable; AMakeEmptyItem: Boolean; AIDfld, AListfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''); var ComboItemObject: TIDGuidObject; FixComboItemObject: TIDGuidObject; FixID: Integer; FixGUID: String; IsFixedItem: Boolean; i: Integer; CCount: Integer; //BookmarkStr: String; BookmarkStr: TBookMark; IDfldIndex: Integer; GUIDfldIndex: Integer; ListfldIndex: Integer; begin FixID := AFixId; FixGUID := AFIxGUID; IsFixedItem := false; if (AFixID = -1) and (AFIxGUID = '') then if AComboBox.ItemIndex > -1 then begin ComboItemObject := TIDGuidObject(AComboBox.Properties.Items.Objects[AComboBox.ItemIndex]); FixID := ComboItemObject.ID; FixGUID := ComboItemObject.GUID; end; //*** Очистить список ClearComboBox(AComboBox); //*** Внести пустую строку if AMakeEmptyItem then begin ComboItemObject := AddItemToCombo(AComboBox, AEmptyFldName, '', 0, FixGUID, FixID, @IsFixedItem); if IsFixedItem then FixComboItemObject := ComboItemObject; end; //*** Загрузить спиок if AMemTable.Active then begin //BookmarkStr := AMemTable.Bookmark; BookmarkStr := AMemTable.GetBookmark; AMemTable.DisableControls; try IDfldIndex := AMemTable.FieldDefs.IndexOf(AIDfld); GUIDfldIndex := AMemTable.FieldDefs.IndexOf(fnGUID); ListfldIndex := AMemTable.FieldDefs.IndexOf(AListfld); AMemTable.First; while Not AMemTable.Eof do begin AddItemToCombo(AComboBox, AMemTable.Fields[ListfldIndex].AsString, AMemTable.Fields[GUIDfldIndex].AsString, AMemTable.Fields[IDfldIndex].AsInteger, FixGUID, FixID, @IsFixedItem); if IsFixedItem then FixComboItemObject := ComboItemObject; AMemTable.Next; end; //AMemTable.Bookmark := BookmarkStr; AMemTable.GotoBookmark(BookmarkStr); AMemTable.FreeBookmark(BookmarkStr); finally AMemTable.EnableControls; end; end; AComboBox.Properties.Sorted := true; AComboBox.ItemIndex := AComboBox.Properties.Items.IndexOfObject(FixComboItemObject); end; procedure FillComboBoxRz(var AComboBox: TRzComboBox; AFormBase: TForm; AMakeEmptyItem: Boolean; ATableName, AIDfld, AListfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''; AFilter: String = ''); var ComboItemObject: TIDGuidObject; FixComboItemObject: TIDGuidObject; FixID: Integer; FixGUID: String; i: Integer; CCount: Integer; IDfldIndex: Integer; GUIDfldIndex: Integer; ListfldIndex: Integer; procedure AddItemToCombo(AName, AGUID: String; AIDItem: Integer); begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AIDItem; //FN(AIDfld).AsInteger; ComboItemObject.GUID := AGUID; AComboBox.Items.AddObject(AName, ComboItemObject); // Индекс в списке if (AIDItem = FixID) or (FixGUID = AGUID) then FixComboItemObject := ComboItemObject; end; begin AComboBox.Items.BeginUpdate; try FixID := AFixId; FixGUID := AFIxGUID; if (AFixID = -1) and (AFIxGUID = '') then if AComboBox.ItemIndex > -1 then begin ComboItemObject := TIDGuidObject(AComboBox.Items.Objects[AComboBox.ItemIndex]); FixID := ComboItemObject.ID; FixGUID := ComboItemObject.GUID; end; //*** Очистить список CCount := AComboBox.Items.Count; for i := 0 to CCount - 1 do AComboBox.Items.Objects[i].Free; AComboBox.Items.Clear; //*** Внести пустую строку if AMakeEmptyItem then AddItemToCombo(AEmptyFldName, '', 0); //*** Загрузить спиок with TF_Main(AFormBase).DM do begin Query_Select.Close; Query_Select.SQL.Text := 'select '+AIDfld+', '+fnGUID+', '+AListFld+' from '+ ATableName+' '; if AFilter <> '' then Query_Select.SQL.Text := Query_Select.SQL.Text + 'where '+AFilter+' '; if AListFld <> '' then Query_Select.SQL.Text := Query_Select.SQL.Text + 'order by '+AListFld; Query_Select.ExecQuery; ListfldIndex := Query_Select.FieldIndex[AListfld]; GUIDfldIndex := Query_Select.FieldIndex[fnGUID]; IDfldIndex := Query_Select.FieldIndex[AIDfld]; while Not Query_Select.Eof do begin //AddItemToCombo(Query_Select.FN(AListfld).AsString, Query_Select.FN(fnGUID).AsString, Query_Select.FN(AIDfld).AsInteger); AddItemToCombo(Query_Select.Fields[ListfldIndex].AsString, Query_Select.Fields[GUIDfldIndex].AsString, Query_Select.Fields[IDfldIndex].AsInteger); Query_Select.Next; end; Query_Select.Close; end; AComboBox.ItemIndex := AComboBox.Items.IndexOfObject(FixComboItemObject); finally AComboBox.Items.EndUpdate; end; end; procedure FillComboBoxRzFromMT(AComboBox: TRzComboBox; AMemTable: TkbmMemTable; AMakeEmptyItem: Boolean; AIDfld, AListfld, AEmptyFldName: String; AFixID: Integer = -1; AFixGUID: String = ''); var ComboItemObject: TIDGuidObject; FixComboItemObject: TIDGuidObject; FixID: Integer; FixGUID: String; i: Integer; CCount: Integer; //BookmarkStr: String; BookmarkStr: TBookMark; IDfldIndex: Integer; GUIDfldIndex: Integer; ListfldIndex: Integer; procedure AddItemToCombo(AName, AGUID: String; AIDItem, AIndex: Integer); begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AIDItem; //FN(AIDfld).AsInteger; ComboItemObject.GUID := AGUID; if AIndex = -1 then AComboBox.Items.AddObject(AName, ComboItemObject) else AComboBox.Items.InsertObject(AIndex, AName, ComboItemObject); // Индекс в списке if (AIDItem = FixID) or (FixGUID = AGUID) then FixComboItemObject := ComboItemObject; end; begin FixID := AFixId; FixGUID := AFIxGUID; if (AFixID = -1) and (AFIxGUID = '') then if AComboBox.ItemIndex > -1 then begin ComboItemObject := TIDGuidObject(AComboBox.Items.Objects[AComboBox.ItemIndex]); FixID := ComboItemObject.ID; FixGUID := ComboItemObject.GUID; end; //*** Очистить список CCount := AComboBox.Items.Count; for i := 0 to CCount - 1 do AComboBox.Items.Objects[i].Free; AComboBox.Items.Clear; //*** Загрузить спиок if AMemTable.Active then begin //BookmarkStr := AMemTable.Bookmark; BookmarkStr := AMemTable.GetBookmark; AMemTable.DisableControls; try IDfldIndex := AMemTable.FieldDefs.IndexOf(AIDfld); GUIDfldIndex := AMemTable.FieldDefs.IndexOf(fnGUID); ListfldIndex := AMemTable.FieldDefs.IndexOf(AListfld); AMemTable.First; while Not AMemTable.Eof do begin AddItemToCombo(AMemTable.Fields[ListfldIndex].AsString, AMemTable.Fields[GUIDfldIndex].AsString, AMemTable.Fields[IDfldIndex].AsInteger, -1); AMemTable.Next; end; //BookmarkStr := AMemTable.Bookmark; BookmarkStr := AMemTable.GetBookmark; finally AMemTable.EnableControls; end; end; AComboBox.Sorted := true; //SortStrings(AComboBox.Items); //*** Внести пустую строку if AMakeEmptyItem then AddItemToCombo(AEmptyFldName, '', 0, 0); AComboBox.ItemIndex := AComboBox.Items.IndexOfObject(FixComboItemObject); end; { procedure FillComboBox(var AComboBox: TcxComboBox; ADataSet: TpFIBDataSet; AMakeEmptyItem: Boolean; AIDfld, Alistfld: String; AFixID: Integer = -1); var ComboItemObject: TComboItemObject; FixComboItemObject: TComboItemObject; FixID: Integer; i: Integer; CCount: Integer; procedure AddItemToCombo(AName: String; AIDItem: Integer); begin ComboItemObject := TComboItemObject.Create; ComboItemObject.ID := AIDItem; //FN(AIDfld).AsInteger; AComboBox.Properties.Items.AddObject(AName, ComboItemObject); // Индекс в списке if AIDItem = FixID then FixComboItemObject := ComboItemObject; end; begin with ADataSet do begin if (AFixID = -1) then begin //FixID := FN(AIDfld).AsInteger if AComboBox.ItemIndex > -1 then begin ComboItemObject := TComboItemObject(AComboBox.Properties.Items.Objects[AComboBox.ItemIndex]); FixID := ComboItemObject.ID; end else FixID := AFixId; end else FixID := AFixId; //*** Очистить список CCount := AComboBox.Properties.Items.Count; for i := 0 to CCount - 1 do (AComboBox.Properties.Items.Objects[i] as TComboItemObject).Free; AComboBox.Properties.Items.Clear; //*** Внести пустую строку if AMakeEmptyItem then AddItemToCombo('', 0); //*** Загрузить спиок first; while not EOF do begin AddItemToCombo(FN(AListfld).AsString, FN(AIDfld).AsInteger); Next; end; end; AComboBox.ItemIndex := AComboBox.Properties.Items.IndexOfObject(FixComboItemObject); end; } function SelectItemByGUIDinCombo(AComboBox: TcxComboBox; AGUID: String): Boolean; var i: Integer; begin Result := false; for i := 0 to AComboBox.Properties.Items.Count - 1 do if TIDGuidObject(AComboBox.Properties.Items.Objects[i]).GUID = AGUID then begin AComboBox.ItemIndex := i; Result := true; Break; //*** Break end; end; function SelectItemByGUIDinComboRz(AComboBox: TRzComboBox; const AGUID: String): Boolean; var i: Integer; begin Result := false; for i := 0 to AComboBox.Items.Count - 1 do if TIDGuidObject(AComboBox.Items.Objects[i]).GUID = AGUID then begin AComboBox.ItemIndex := i; Result := true; Break; //*** Break end; end; function SelectItemByIDinCombo(AComboBox: TcxComboBox; AID: Integer): Boolean; var i: Integer; begin Result := false; for i := 0 to AComboBox.Properties.Items.Count - 1 do if TIDGuidObject(AComboBox.Properties.Items.Objects[i]).ID = AID then begin AComboBox.ItemIndex := i; Result := true; Break; end; end; function SelectItemByIDinComboRz(AComboBox: TRzComboBox; AID: Integer): Boolean; var i: Integer; begin Result := false; for i := 0 to AComboBox.Items.Count - 1 do if TIDGuidObject(AComboBox.Items.Objects[i]).ID = AID then begin AComboBox.ItemIndex := i; Result := true; Break; end; end; function SelectItemByTextinCombo(AComboBox: TcxComboBox; AText: String; ACaseSensitive: Boolean=true): Boolean; var TextIndex: Integer; TextUpper: string; i: Integer; begin Result := false; TextIndex := -1; if ACaseSensitive then TextIndex := AComboBox.Properties.Items.IndexOf(AText) else begin TextUpper := AnsiUpperCase(AText); for i := 0 to AComboBox.Properties.Items.Count - 1 do if TextUpper = AnsiUpperCase(AComboBox.Properties.Items[i]) then begin TextIndex := i; Break; //// BREAK //// end; end; if TextIndex <> -1 then begin AComboBox.ItemIndex := TextIndex; Result := true; end; end; function GetGUIDFromComboBox(AComboBox: TcxComboBox): String; var Item: Integer; ID_NetType: TObject; begin Result := ''; if AComboBox.Properties.Items.Count > 0 then begin Item := AComboBox.ItemIndex; if Item <> -1 then Result := TIDGuidObject(AComboBox.Properties.Items.Objects[item]).GUID; end; end; function GetGUIDFromComboBoxRz(AComboBox: TRzComboBox): String; var Item: Integer; ID_NetType: TObject; begin Result := ''; if AComboBox.Items.Count > 0 then begin Item := AComboBox.ItemIndex; if Item <> -1 then Result := TIDGuidObject(AComboBox.Items.Objects[item]).GUID; end; end; // ##### Получить ID из текущей позиции Комбо списка ##### function GetIDFromComboBox(AComboBox: TcxComboBox): Integer; var Item: Integer; ID_NetType: TObject; begin Result := -1; if AComboBox.Properties.Items.Count > 0 then begin Item := AComboBox.ItemIndex; if Item <> -1 then Result := TIDGuidObject(AComboBox.Properties.Items.Objects[item]).ID; end; end; function GetIDFromComboBoxRz(AComboBox: TRzComboBox): Integer; var Item: Integer; ID_NetType: TObject; begin Result := -1; if AComboBox.Items.Count > 0 then begin Item := AComboBox.ItemIndex; if Item <> -1 then Result := TIDGuidObject(AComboBox.Items.Objects[item]).ID; end; end; function GetNameFromComboByGUIDRz(ACombo: TRzComboBox; AGUID: String): String; var i: Integer; begin Result := ''; for i := 0 to ACombo.Items.Count - 1 do begin if TIDGuidObject(ACombo.Items.Objects[i]).GUID = AGUID then begin Result := ACombo.Items[i]; Break; //// BREAK //// end; end; end; function GetNameFromComboByIDRz(ACombo: TRzComboBox; AID: Integer): String; var i: Integer; begin Result := ''; for i := 0 to ACombo.Items.Count - 1 do begin if TIDGuidObject(ACombo.Items.Objects[i]).ID = AID then begin Result := ACombo.Items[i]; Break; //// BREAK //// end; end; end; procedure AddIDGUIDToComboRz(AID: Integer; const AGUID, AString: String; AComboBox: TRzComboBox); var ComboItemObject: TIDGuidObject; begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AID; ComboItemObject.GUID := AGUID; AComboBox.Items.AddObject(AString, ComboItemObject); end; procedure AddIDToCombo(AID: Integer; AString: String; AComboBox: TcxComboBox); var ComboItemObject: TIDGuidObject; begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AID; AComboBox.Properties.Items.AddObject(AString, ComboItemObject); end; procedure AddIDToComboRz(AID: Integer; const AString: String; AComboBox: TRzComboBox); var ComboItemObject: TIDGuidObject; begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AID; AComboBox.Items.AddObject(AString, ComboItemObject); end; procedure AddIDToStrings(AID: Integer; const AString: String; AStrings: TStrings); var ComboItemObject: TIDGuidObject; begin ComboItemObject := TIDGuidObject.Create; ComboItemObject.ID := AID; AStrings.AddObject(AString, ComboItemObject); end; procedure ClearComboBox(AComboBox: TcxComboBox); var i: Integer; SavedOnChange: TNotifyEvent; Items: TStrings; Obj: TObject; begin try if Assigned(AComboBox) then if AComboBox.Properties.Items.Count > 0 then begin AComboBox.Properties.BeginUpdate; SavedOnChange := AComboBox.Properties.OnChange; AComboBox.Properties.OnChange := nil; try Items := AComboBox.Properties.Items; for i := 0 to Items.Count - 1 do begin Obj := Items.Objects[i]; if Assigned(Obj) then Obj.Free; end; Items.Clear; finally AComboBox.Properties.OnChange := SavedOnChange; AComboBox.Properties.EndUpdate; end; end; except on E: Exception do AddExceptionToLogEx('ClearComboBox', E.Message); end; end; procedure ClearComboBoxRz(AComboBox: TRzComboBox); var i: Integer; begin if Assigned(AComboBox) then for i := 0 to AComboBox.Items.Count - 1 do if Assigned(AComboBox.Items.Objects[i]) then AComboBox.Items.Objects[i].Free; AComboBox.Items.Clear; end; function IndexOfIDInStrings(AID: Integer; AStrings: TStrings): Integer; var i: Integer; begin Result := -1; for i := 0 to AStrings.Count - 1 do if TIDGuidObject(AStrings.Objects[i]).ID = AID then begin Result := i; Break; end; end; Procedure WriteToDataSet(var DS: TPFibDataSet; FieldName: String; Value: Variant); begin DS.Edit; DS.FN(FieldName).Value := Value; DS.Post; end; procedure WriteToMemTable(AMemTable: TkbmMemTable; AFieldName: String; AValue: Variant); begin AMemTable.Edit; AMemTable.FieldByName(AFieldName).Value := AValue; AMemTable.Post; end; procedure WriteToSQLMemTable(AMemTable: TSQLMemTable; AFieldName: String; AValue: Variant); begin if Assigned(AMemTable) then begin AMemTable.Edit; AMemTable.FieldByName(AFieldName).Value := AValue; AMemTable.Post; end; end; //function GetDisplayFormat(NameBrief: String): String; //var Str: String; //begin // //Str := ',0.00 '+ NameBrief +'''.'';-,0.00 ' + NameBrief +'''.'' '; // Str := ',0.000 '+ NameBrief +'''.'' '; // Result := Str; //end; function DataSetLocateByID(ADataSet: TpFIBDataSet; AID: Integer): Boolean; var RecNo: Integer; begin Result := false; if Assigned(ADataSet) then Result := ADataSet.Locate(fnID, AID, []); end; procedure RefreshDataSet(ADataSet: TpFIBDataSet); var RecNo: Integer; begin RecNo := -1;// Tolik 28/12/2019 -- if Assigned(ADataSet) then if ADataSet.Active then begin if ADataSet.RecordCount > 0 then // Tolik 28/12/2019 -- RecNo := ADataSet.RecNo; ADataSet.DisableControls; try ADataSet.Active := false; ADataSet.Active := true; finally if RecNo > -1 then // Tolik 28/12/2019 -- ADataSet.RecNo := RecNo; ADataSet.EnableControls; end; end; end; function SearchRecordMT(var Table: TkbmMemTable; FieldName: String; value: Variant): Boolean; var Finded: Boolean; begin Result := false; try if Table.Active = false then Exit; //// EXIT //// Finded := false; Table.First; while Not Table.Eof do begin if Table.FieldByName(FieldName).Value = Value then begin Finded := true; Break; end; Table.Next; end; Result := Finded; except on E: Exception do AddExceptionToLog('SearchRecordMT: '+E.Message); end; end; // ##### Поиск в таблице ##### function SearchRecord(SDataSet: TpFIBDataSet; FieldName: String; value: Variant): Boolean; begin Result := false; if SDataSet.Active = false then SdataSet.Active := true; //try SDataSet.First; While Not SDataSet.Eof do begin if SDataSet.FN(FieldName).Value = Value then begin Result := true; break; end; SDataSet.Next; end; { except end; } end; procedure SQLBuilder(AQuery: TSCSQuery; AQueryType: TQueryType; ATableName, AWherePart: String; AFieldList: TStringList; AExecQuery: Boolean); var SQLtxt: String; { var SQLtxt: String; FieldsStr: String; i: Integer; function GetFieldsStr(AQType: TQueryType): String; var i: Integer; ResFieldsStr: String; begin ResFieldsStr := ''; for i := 0 to AFieldList.Count - 1 do begin case AQType of qtSelect: ResFieldsStr := ResFieldsStr + AFieldList.Strings[i]; qtInsert: ResFieldsStr := ResFieldsStr +':'+ AFieldList.Strings[i]; qtUpdate: ResFieldsStr := ResFieldsStr + AFieldList.Strings[i]+' = :'+AFieldList.Strings[i]; end; if i < AFieldList.Count - 1 then ResFieldsStr := ResFieldsStr + ', '; end; Result := ResFieldsStr; end; } begin { case AQueryType of qtSelect: begin FieldsStr := GetFieldsStr(qtSelect); SQLtxt := ' select '+FieldsStr+' from '+ATableName+' '; end; qtInsert: begin FieldsStr := GetFieldsStr(qtSelect); SQLtxt := ' insert into '+ATableName+' ('+FieldsStr+') '+' values('; FieldsStr := GetFieldsStr(qtInsert); SQLtxt := SQLtxt + FieldsStr+' )'; end; qtUpdate: begin FieldsStr := GetFieldsStr(qtUpdate); SQLtxt := ' update '+ATableName+' set '+FieldsStr+ ' '; end; qtDelete: SQLtxt := ' delete from '+ATableName+' '; end; if AWherePart <> '' then SQLtxt := SQLtxt + ' where '+AWherePart; } SQLtxt := GetSQLByParams(AQueryType, ATableName, AWherePart, AFieldList, ''); AQuery.Close; AQuery.SQL.Clear; AQuery.SQL.Add(SQLtxt); if AExecQuery then AQuery.ExecQuery; end; procedure LoadBufferToMemTableBlobField(AMemTable: TSQLMemTable; AFieldName: String; var ABuffer; ABufSize: Integer); var Stream: TMemoryStream; begin Stream := TMemoryStream.Create; try Stream.WriteBuffer(ABuffer, ABufSize); Stream.Position := 0; TBlobField(AMemTable.FieldByName(AFieldName)).LoadFromStream(Stream); finally Stream.Free; end; end; procedure StreamFromQueryToMemTable(AQuery: TSCSQuery; AMemTable: TSQLMemTable; AQFieldName, AMTFieldName: String); var Stream: TMemoryStream; begin if Assigned(AQuery) and Assigned(AMemTable) then begin Stream := TMemoryStream.Create; AQuery.FNSaveToStream(AQFieldName, Stream); Stream.Position := 0; TBlobField(AMemTable.FieldByName(AMTFieldName)).LoadFromStream(Stream); Stream.Free; end; end; procedure StreamFromMemTableToQuery(AMemTable: TSQLMemTable; AQuery: TSCSQuery; AMTFieldName, AQFieldName: String); var Stream: TMemoryStream; StreamSize: Integer; begin if Assigned(AMemTable) and Assigned(AQuery) then //if AMemTable.FieldDefs.IndexOf(AMTFieldName) <> - 1 then begin Stream := TMemoryStream.Create; TBlobField(AMemTable.FieldByName(AMTFieldName)).SaveToStream(Stream); Stream.Position := 0; StreamSize := Stream.Size; AQuery.ParamLoadFromStream(AQFieldName, Stream); Stream.Free; end; end; procedure StreamFromMemTableToFIBQuery(AMemTable: TSQLMemTable; AQuery: TpFIBQuery; AMTFieldName, AQFieldName: String); var Stream: TMemoryStream; StreamSize: Integer; begin Stream := TMemoryStream.Create; if AMTFieldName = 'PM_BLOCK' then begin {TODO} // для очень больших стримов - через файл намного быстрее чем через // TBlobField(AMemTable.FieldByName(AMTFieldName)).SaveToStream(Stream); //TBlobField(AMemTable.FieldByName(AMTFieldName)).SaveToFile('c:\1_pm.blb'); //AMemTable.Active := False; //AMemTable.SaveTableToFile('c:\1_table.bin'); //AMemTable.Active := True; ///Stream.LoadFromFile('c:\1_pm.blb'); end; //else begin TBlobField(AMemTable.FieldByName(AMTFieldName)).SaveToStream(Stream); end; Stream.Position := 0; StreamSize := Stream.Size; AQuery.ParamByName(AQFieldName).LoadFromStream(Stream); Stream.Free; end; { TIDGuidObject } constructor TIDGuidObject.Create; begin ID := 0; GUID := ''; inherited; end; destructor TIDGuidObject.destroy; begin inherited; end; { TDM } procedure TDM.CorrectSortIDInSiblingNodes(ANode: TTreeNode; ATableKind: TTableKind); var i, j: Integer; ParentNode: TTreeNode; SiblingNode: TTreeNode; SiblingDataList: TList; NodeI: TTreeNode; NodeJ: TTreeNode; DatI: PObjectData; DatJ: PObjectData; MaxSortID: Integer; FirstFoulIndex: Integer; IsFirstChanging: Boolean; WasBreak: Boolean; ObjectID: Integer; QueryMode: TQueryMode; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin OldTick := GetTickCount; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); case TF_Main(GForm).GDBMode of bkNormBase: QueryMode := qmPhisical; bkProjectManager: QueryMode := GetQueryModeByNode(TF_Main(GForm).GDBMode, ANode, QueryMode); end; MaxSortID := 0; FirstFoulIndex := -1; ParentNode := ANode.Parent; SiblingDataList := TList.Create; SiblingNode := ParentNode.getFirstChild; while SiblingNode <> nil do begin SiblingDataList.Add(SiblingNode.Data); SiblingNode := SiblingNode.getNextSibling; end; //for i := 0 to ParentNode.Count - 1 do //begin // NodeI := ParentNode.Item[i]; // SiblingDataList.Add(NodeI.Data); //end; WasBreak := false; for i := 0 to SiblingDataList.Count - 1 do begin DatI := SiblingDataList[i]; if DatI.SortID > MaxSortID then MaxSortID := DatI.SortID; for j := i to SiblingDataList.Count - 1 do if i < j then begin DatJ := SiblingDataList[j]; if (DatI.SortID = DatJ.SortID) and IsTreeViewItemTypesOfCommonKind(DatI.ItemType, DatJ.ItemType) then begin FirstFoulIndex := i+1; WasBreak := true; Break; ///// BREAK ///// end; end; if WasBreak then Break; ///// BREAK ///// end; //*** Если найден повторяющийся SortID, то перенумеровать их начиная с FirstFoulIndex if FirstFoulIndex <> -1 then begin IsFirstChanging := true; for i := FirstFoulIndex to SiblingDataList.Count - 1 do begin DatI := SiblingDataList[i]; Inc(MaxSortID); DatI.SortID := MaxSortID; //*** Соранить SortID ObjectID := -1; if ATableKind = tkComplect then ObjectID := DatI.ID_CompRel else ObjectID := DatI.ObjectID; SaveSortIDByTableKind(ObjectID, DatI.SortID, ATableKind, QueryMode, IsFirstChanging); IsFirstChanging := false; end; end; SiblingDataList.Free; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; { 2006 08 23 procedure TDM.CorrectSortIDInSiblingNodes(ANode: TTreeNode; ATableKind: TTableKind); var i, j: Integer; ParentNode: TTreeNode; NodeI: TTreeNode; NodeJ: TTreeNode; DatI: PObjectData; DatJ: PObjectData; MaxSortID: Integer; FirstFoulIndex: Integer; IsFirstChanging: Boolean; WasBreak: Boolean; ObjectID: Integer; QueryMode: TQueryMode; OldTick, CurrTick: Cardinal; begin OldTick := GetTickCount; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); case TF_Main(GForm).GDBMode of bkNormBase: QueryMode := qmPhisical; bkProjectManager: QueryMode := GetQueryModeByNode(TF_Main(GForm).GDBMode, ANode, QueryMode); end; MaxSortID := 0; FirstFoulIndex := -1; ParentNode := ANode.Parent; WasBreak := false; for i := 0 to ParentNode.Count - 1 do begin NodeI := ParentNode.Item[i]; DatI := NodeI.Data; if DatI.SortID > MaxSortID then MaxSortID := DatI.SortID; for j := i to ParentNode.Count - 1 do if i < j then begin NodeJ := ParentNode.Item[j]; DatJ := NodeJ.Data; if DatI.SortID = DatJ.SortID then begin FirstFoulIndex := i+1; WasBreak := true; Break; ///// BREAK ///// end; end; if WasBreak then Break; ///// BREAK ///// end; //*** Если найден повторяющийся SortID, то перенумеровать их начиная с FirstFoulIndex if FirstFoulIndex <> -1 then begin IsFirstChanging := true; for i := FirstFoulIndex to ParentNode.Count - 1 do begin NodeI := ParentNode.Item[i]; DatI := NodeI.Data; Inc(MaxSortID); DatI.SortID := MaxSortID; //*** Соранить SortID ObjectID := -1; if ATableKind = tkComplect then ObjectID := DatI.ID_CompRel else ObjectID := DatI.ObjectID; SaveSortIDByTableKind(ObjectID, DatI.SortID, ATableKind, QueryMode, IsFirstChanging); IsFirstChanging := false; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; } // ##### Поменять местами значения поля ##### procedure TDM.ExchangeNodes(ANode1, ANode2: TTreeNode; ATableKind: TTableKind); var Dat1 : PObjectData; Dat2 : PObjectData; SortID : Integer; ObjectID1: Integer; ObjectID2: Integer; GDBMode: TDBKind; QueryMode: TQueryMode; { Catalog1: TSCSCatalog; Catalog2: TSCSCatalog; Compon1: TSCSComponent; Compon2: TSCSComponent; ParentCompon: TSCSComponent; ptrCompl1: PComplect; ptrCompl2: PComplect; TableName: String; SQLMemTable: TSQLMemTable; ID1: Integer; ID2: Integer; QOperat: TSCSQuery; procedure SetCatalogObjSortID(AIDCatalog, ASortID: Integer); var SCSCatalog: TSCSCatalog; begin SCSCatalog := nil; SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if Assigned(SCSCatalog) then SCSCatalog.SortID := ASortID; end; procedure SetComponentObjSortID(AIDComponent, ASortID: Integer); var SCSComponent: TSCSComponent; begin SCSComponent := nil; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then SCSComponent.SortID := ASortID; end; } begin GDBMode := TF_Main(GForm).GDBMode; QueryMode := GetQueryModeByGDBMode(GDBMode); case TF_Main(GForm).GDBMode of bkNormBase: QueryMode := qmPhisical; bkProjectManager: QueryMode := GetQueryModeByNode(GDBMode, ANode1, QueryMode); end; //CorrectSortIDInSiblingNodes(ANode1, ATableKind); Dat1 := ANode1.Data; Dat2 := ANode2.Data; if (Dat1 = nil) or (Dat2 = nil) then Exit; ///// EXIT ///// ObjectID1 := -1; ObjectID2 := -1; if ATableKind = tkComplect then begin ObjectID1 := Dat1.ObjectID; ObjectID2 := Dat2.ObjectID; if GDBMode = bkNormBase then begin ObjectID1 := Dat1.ID_CompRel; ObjectID2 := Dat2.ID_CompRel; end; end else begin ObjectID1 := Dat1.ObjectID; ObjectID2 := Dat2.ObjectID; end; if (ObjectID1 <> -1) and (ObjectID2 <> -1) then begin SortID := Dat1.SortID; Dat1.SortID := Dat2.SortID; Dat2.SortID := SortID; SaveSortIDByTableKind(ObjectID1, Dat1.SortID, ATableKind, QueryMode, true); SaveSortIDByTableKind(ObjectID2, Dat2.SortID, ATableKind, QueryMode, false); CorrectSortIDInSiblingNodes(ANode1, ATableKind); end; (* case ATableKind of tkCatalog: begin SQLMemTable := tSQL_Katalog; TableName := 'KATALOG'; ID1 := Dat1.ObjectID; ID2 := Dat2.ObjectID; if TF_Main(GForm).GDBMode = bkProjectManager then if QueryMode = qmMemory then begin Catalog1 := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(Dat1.ObjectID); Catalog2 := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(Dat2.ObjectID); if Assigned(Catalog1) and Assigned(Catalog2) then begin Catalog1.SortID := Dat2.SortID; Catalog2.SortID := Dat1.SortID; end; end; end; tkComponent: begin SQLMemTable := tSQL_Component; TableName := 'COMPONENT'; ID1 := Dat1.ObjectID; ID2 := Dat2.ObjectID; if TF_Main(GForm).GDBMode = bkProjectManager then begin Compon1 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Dat1.ObjectID); Compon2 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Dat2.ObjectID); if Assigned(Compon1) and Assigned(Compon2) then begin Compon1.SortID := Dat2.SortID; Compon2.SortID := Dat1.SortID; end; end; end; tkComplect: begin SQLMemTable := tSQL_ComponentRelation; TableName := 'COMPONENT_RELATION'; ID1 := Dat1.ID_CompRel; ID2 := Dat2.ID_CompRel; if TF_Main(GForm).GDBMode = bkProjectManager then begin Compon1 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Dat1.ObjectID); Compon2 := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Dat2.ObjectID); if Assigned(Compon1) and Assigned(Compon2) then begin Compon1.CompRelSortID := Dat2.SortID; Compon2.CompRelSortID := Dat1.SortID; ParentCompon := Compon1.GetParentComponent; if Assigned(ParentCompon) then begin ptrCompl1 := ParentCompon.GetComplectByIDChild(Compon1.ID); ptrCompl2 := ParentCompon.GetComplectByIDChild(Compon2.ID); if (ptrCompl1 <> nil) and (ptrCompl2 <> nil) then begin ptrCompl1.SortID := Dat2.SortID; ptrCompl2.SortID := Dat1.SortID; end; end; end; end; end; tkDirectoryType: begin TableName := tnDirectoryType; ID1 := Dat1.ObjectID; ID2 := Dat2.ObjectID; end; end; if (ID1 <> -1) and (ID2 <> -1) then begin SortID := Dat1.SortID; Dat1.SortID := Dat2.SortID; Dat2.SortID := SortID; case QueryMode of qmPhisical: begin Query_Operat.Close; Query_Operat.SQL.Text := 'UPDATE ' + TableName + ' SET '+ ' SORT_ID = :SORT_ID '+ ' WHERE ID = :ID'; Query_Operat.ParamByName(fnID).AsInteger := ID1; Query_Operat.ParamByName(fnSortID).AsInteger := Dat1.SortID; Query_Operat.ExecQuery; Query_Operat.Close; Query_Operat.ParamByName(fnID).AsInteger := ID2; Query_Operat.ParamByName(fnSortID).AsInteger := Dat2.SortID; Query_Operat.ExecQuery; end; qmMemory: if FMemBaseActive then begin {if SetFilterToSQLMemTable(SQLMemTable, 'id = '''+IntToStr(ID1)+'''') then begin SQLMemTable.Edit; SQLMemTable.FieldByName(fnSortID).AsInteger := Dat1.SortID; SQLMemTable.Post; end; if SetFilterToSQLMemTable(SQLMemTable, 'id = '''+IntToStr(ID2)+'''') then begin SQLMemTable.Edit; SQLMemTable.FieldByName(fnSortID).AsInteger := Dat2.SortID; SQLMemTable.Post; end; } {case ATableKind of tkCatalog: begin SetCatalogObjSortID(Dat1.ObjectID, Dat1.SortID); SetCatalogObjSortID(Dat2.ObjectID, Dat2.SortID); end; tkComponent, tkComplect: begin SetComponentObjSortID(Dat1.ObjectID, Dat1.SortID); SetComponentObjSortID(Dat2.ObjectID, Dat2.SortID); end; end;} end; end; end; *) end; procedure TDM.SaveSortIDByTableKind(AObjectID, ANewSortID: Integer; ATableKind: TTableKind; AQueryMode: TQueryMode; AReloadSQL: Boolean); var TableName: String; Catalog: TSCSCatalog; Compon: TSCSComponent; ParentCompon: TSCSComponent; ptrCompl: PComplect; strSQL: String; begin case ATableKind of tkCatalog: begin TableName := tnCatalog; if TF_Main(GForm).GDBMode = bkProjectManager then if AQueryMode = qmMemory then begin Catalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AObjectID); if Assigned(Catalog) then Catalog.SortID := ANewSortID; end; end; tkComponent: begin TableName := tnComponent; if TF_Main(GForm).GDBMode = bkProjectManager then begin Compon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AObjectID); if Assigned(Compon) then Compon.SortID := ANewSortID; end; end; tkComplect: begin TableName := tnComponentRelation; if TF_Main(GForm).GDBMode = bkProjectManager then begin Compon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AObjectID); if Assigned(Compon) then begin Compon.CompRelSortID := ANewSortID; ParentCompon := Compon.GetParentComponent; if Assigned(ParentCompon) then begin ptrCompl := ParentCompon.GetComplectByIDChild(Compon.ID); if (ptrCompl <> nil) then ptrCompl.SortID := ANewSortID; end; end; end; end; tkDirectoryType: TableName := tnDirectoryType; end; if AQueryMode = qmPhisical then begin if ATableKind = tkCatalog then if TF_Main(GForm).GDBMode = bkProjectManager then if Assigned(TF_Main(GForm).GSCSBase.CurrProject) then if TF_Main(GForm).GSCSBase.CurrProject.Active then if TF_Main(GForm).GSCSBase.CurrProject.CurrID = AObjectID then TF_Main(GForm).GSCSBase.CurrProject.SortID := ANewSortID; Query_Operat.Close; if AReloadSQL then begin strSQL := GetSQLByParams(qtUpdate, TableName, 'ID = :ID', nil, fnSortID); if Query_Operat.SQL.Text <> strSQL then SetSQLToFIBQuery(Query_Operat, strSQL, false); end; //Query_Operat.SQL.Text := 'UPDATE ' + TableName + ' SET '+ // ' SORT_ID = :SORT_ID '+ // ' WHERE ID = :ID'; Query_Operat.ParamByName(fnID).AsInteger := AObjectID; Query_Operat.ParamByName(fnSortID).AsInteger := ANewSortID; Query_Operat.ExecQuery; end; end; { function InputForm(AForm: TForm; ACaption, APrompt, ADefault: Variant; ADataType: Integer = dtString): Variant; begin Result := null; case ADataType of dtString: Result := ''; dtFloat, dtInteger: Result := 0; end; TF_Main(AForm).F_InputBox.GInputFormMode := imInputText; TF_Main(AForm).F_InputBox.Caption := ACaption; //TF_Main(AForm).F_InputBox.Label_Prompt.Caption := APrompt; TF_Main(AForm).F_InputBox.pnComboInputPrompt.Caption := APrompt; case ADataType of dtString: begin TF_Main(AForm).F_InputBox.GInputFormMode := imInputText; TF_Main(AForm).F_InputBox.edText.Text := ADefault; end; dtFloat, dtInteger: begin TF_Main(AForm).F_InputBox.GInputFormMode := imInputFloat; if ADataType = dtFloat then TF_Main(AForm).F_InputBox.seValue.Properties.ValueType := vtFloat; if ADataType = dtInteger then TF_Main(AForm).F_InputBox.seValue.Properties.ValueType := vtInt; TF_Main(AForm).F_InputBox.seValue.Value := ADefault; end; end; if TF_Main(AForm).F_InputBox.ShowModal = mrOK then case ADataType of dtString: Result := TF_Main(AForm).F_InputBox.edText.Text; dtFloat, dtInteger: Result := TF_Main(AForm).F_InputBox.seValue.Value; end; end; } function InputFormCombo(AForm: TForm; const ACaption, APrompt, ADefault, ACheckBoxCaption: String; AStringList: TStringList; AChackBoxValue: PBoolean): TStringItem; var i: integer; ItemIndex: integer; SavedFProgressVisible: Boolean; begin Result.FString := ''; Result.FObject := nil; SavedFProgressVisible := F_Progress.Visible; F_Progress.Visible := false; try TF_Main(AForm).F_InputBox.GInputFormMode := imInputCombo; TF_Main(AForm).F_InputBox.Caption := ACaption; //TF_Main(AForm).F_InputBox.Label_Prompt.Caption := APrompt; TF_Main(AForm).F_InputBox.pnComboInputPrompt.Caption := APrompt; TF_Main(AForm).F_InputBox.cbValue.Properties.BeginUpdate; try TF_Main(AForm).F_InputBox.cbValue.Properties.Items.Clear; for i := 0 to AStringList.Count - 1 do TF_Main(AForm).F_InputBox.cbValue.Properties.Items.AddObject(AStringList.Strings[i], AStringList.Objects[i]); finally TF_Main(AForm).F_InputBox.cbValue.Properties.EndUpdate; end; if ADefault <> '' then TF_Main(AForm).F_InputBox.cbValue.Text := ADefault else if AStringList.Count > 0 then TF_Main(AForm).F_InputBox.cbValue.ItemIndex := 0; TF_Main(AForm).F_InputBox.cbInputCombo.Visible := (AChackBoxValue <> nil); if AChackBoxValue <> nil then begin TF_Main(AForm).F_InputBox.cbInputCombo.Checked := AChackBoxValue^; TF_Main(AForm).F_InputBox.cbInputCombo.Caption := ACheckBoxCaption; end; if TF_Main(AForm).F_InputBox.ShowModal = mrOk then begin ItemIndex := TF_Main(AForm).F_InputBox.cbValue.ItemIndex; if ItemIndex <> -1 then begin Result.FString := TF_Main(AForm).F_InputBox.cbValue.Properties.Items.Strings[ItemIndex]; Result.FObject := TF_Main(AForm).F_InputBox.cbValue.Properties.Items.Objects[ItemIndex]; end; if AChackBoxValue <> nil then AChackBoxValue^ := TF_Main(AForm).F_InputBox.cbInputCombo.Checked; end; TF_Main(AForm).F_InputBox.cbInputCombo.Visible := false; TF_Main(AForm).F_InputBox.cbValue.Properties.Items.Clear; finally F_Progress.Visible := SavedFProgressVisible; end; end; // ##### Показать список компонентов, которые нельзя удалить ##### procedure ShowList(AForm: TForm; ATreeKind: TTreeKind; ASourceFormMode: TFormMode; AMessg: string; AisShowModal: Boolean); var ID_Comp: ^Integer; ListItem: TListItem; ItemType: TItemType; isFieldItemType: Boolean; IDIndex: Integer; NameIndex: Integer; begin with TF_Main(AForm).F_InputBox do begin (* isFieldItemType := true; try ItemType := {(GGForm as TF_Main).GetSCSComponType((GGForm as TF_Main).DM.scsQ.FN('ID_ITEM_TYPE').AsInteger); }(AForm as TF_Main).DM.scsQ.FN('ID_ITEM_TYPE').AsInteger; except else isFieldItemType := false; end; *) Label_Messg.Caption := AMessg; ListView_Compons.Items.BeginUpdate; try ListView_Compons.Items.Clear; if Not TF_Main(AForm).DM.scsQ.Eof then begin IDIndex := TF_Main(AForm).DM.scsQ.GetFieldIndex(fnID); NameIndex := TF_Main(AForm).DM.scsQ.GetFieldIndex(fnName); while Not TF_Main(AForm).DM.scsQ.Eof do begin GetMem(ID_Comp, SizeOf(Integer)); ID_Comp^ := TF_Main(AForm).DM.scsQ.GetFNAsInteger(IDIndex); //TF_Main(AForm).DM.scsQ.GetFNAsInteger(fnID); ListItem := ListView_Compons.Items.Add; ListItem.Caption := TF_Main(AForm).DM.scsQ.GetFNAsString(NameIndex); //TF_Main(AForm).DM.scsQ.GetFNAsString(fnName); ListItem.Data := ID_Comp; {if isFieldItemType then ItemType := (AForm as TF_Main).DM.scsQ.FN('ID_ITEM_TYPE').AsInteger else ItemType := (AForm as TF_Main).GetSCSComponType((AForm as TF_Main).DM.scsQ.FN('isLine').AsInteger); ListItem.ImageIndex := ItemType; } ListItem.ImageIndex := -1; TF_Main(AForm).DM.scsQ.Next; end; end; ListView_Compons.SortType := stText; ListView_Compons.SortType := stNone; finally ListView_Compons.Items.EndUpdate; end; GInputFormMode := imListForTree; GTreeKind := ATreeKind; FIsSelectionItem := false; with (AForm as TF_Main).F_InputBox do begin if ASourceFormMode <> fmView then ListView_Compons.OnChange := nil else begin ListView_Compons.OnChange := ListView_ComponsChange; GChangeInMainForm := true; end; case AisShowModal of true: ShowModal; false: Show; end; end; end; end; // ##### SQL Запрос ##### procedure SetSQLToQuery(AQuery: TSCSQuery; SQLCode: String; AExec: Boolean = true); var Str: TStringList; begin AQuery.Close; AQuery.SQL.Clear; AQuery.SQL.Add(SQLCode); if AExec then AQuery.ExecQuery; end; procedure ChangeSQLQuery(AQuery: TSCSQuery; ASQLCode: String); begin AQuery.Close; AQuery.SQL.Clear; AQUery.SQL.Add(ASQLCode); end; procedure SetSellSQLToDataSet(ADataSet: TpFIBDataSet; ASQLCode: String); begin ADataSet.Active := false; ADataSet.SelectSQL.Clear; ADataSet.SelectSQL.Add(ASQLCode); ADataSet.Active := true; end; function SetFilterToSQLMemTable(ATable: TSQLMemTable; AFilterCode: String): Boolean; begin Result := false; try AddExceptionToLog('SCS internal - SetFilterToSQLMemTable: consequence of optimization'); ATable.Filtered := false; ATable.Filter := AFilterCode; ATable.Filtered := true; if ATable.RecordCount > 0 then begin Result := true; ATable.First; end; except end; end; function GetIndexByFldFomSQLMemTable(ATable: TSQLMemTable; AFieldName: String): String; var //FieldNames: TStringList; //AscDesc: TStringList; //CaseSensitivity: TStringList; FieldNames, AscDesc, CaseSensitivity: TSQLMemWideStringList; begin Result := ''; if AFieldName <> '' then begin {FieldNames := TStringList.Create; AscDesc := TStringList.Create; CaseSensitivity := TStringList.Create;} FieldNames := TSQLMemWideStringList.Create; AscDesc := TSQLMemWideStringList.Create; CaseSensitivity := TSQLMemWideStringList.Create; FieldNames.Add(AFieldName); //AscDesc.Add(''); //CaseSensitivity.Add(''); AscDesc.Add(AFieldName); CaseSensitivity.Add(AFieldName); try Result := ATable.FindIndex(FieldNames, AscDesc, CaseSensitivity); except end; FreeAndNil(FieldNames); FreeAndNil(AscDesc); FreeAndNil(CaseSensitivity); end; end; function GetRecCountFromSQLMemTable(ATable: TSQLMemTable; ANoMoreOne: Boolean): Integer; var RecCount: Integer; begin Result := 0; RecCount := 0; if Not ATable.Eof then ATable.First; ATable.Last; Result := ATable.RecordCount; { ATable.First; while Not ATable.Eof do begin Inc(RecCount); if ANoMoreOne then Break; //// BREAK //// ATable.Next; end; Result := RecCount; } end; function GetMaxRecValueFromSQLMemTable(ATable: TSQLMemTable; AFieldName: String): Integer; var CurrMax: Integer; begin Result := 0; if ATable.Eof then Exit; ATable.First; CurrMax := ATable.FieldByName(AFieldName).AsInteger; while Not ATable.Eof do begin if ATable.FieldByName(AFieldName).AsInteger > CurrMax then CurrMax := ATable.FieldByName(AFieldName).AsInteger; ATable.Next; end; Result := CurrMax; end; function TDM.GetCountryCurrency: TCurrency; begin Result := U_BaseCommon.GetCountryCurrency(Query_Select); end; function TDM.GetCurrencyByID(ACurrencyID: Integer): TCurrency; begin Result := U_BaseCommon.GetCurrencyByID(ACurrencyID, Query_Select); end; function TDM.GetCurrencyByType(ACurrencyType: Integer): TCurrency; begin Result := U_BaseCommon.GetCurrencyByType(ACurrencyType, Query_Select); end; // ##### Занести в список значения поля из запроса ##### procedure TDM.IntFieldToList(var AList: TList; AQuery: TSCSQuery; AFieldName: String); var ptrValue: ^Integer; begin while Not AQuery.Eof do begin //New(ptrValue); GetMem(ptrValue, SizeOf(Integer)); ptrValue^ := AQuery.GetFNAsInteger(AFieldName); AList.Add(ptrValue); AQuery.Next; end; end; procedure TDM.IntFieldToIntList(var AList: TIntList; AQuery: TSCSQuery; AFieldName: String); begin while Not AQuery.Eof do begin AList.Add(AQuery.GetFNAsInteger(AFieldName)); AQuery.Next; end; end; procedure TDM.IntFieldToListFromSQLMemTable(var AList: TList; AMemTable: TSQLMemTable; AFieldName: String); var ptrValue: ^Integer; i: Integer; begin //Tolik 28/12/2019 -- if AList <> nil then begin if AMemTable.RecordCount > 0 then begin // for i := 0 to AMemTable.RecordCount - 1 do begin AMemTable.RecNo := i+1; GetMem(ptrValue, SizeOf(Integer)); ptrValue^ := AMemTable.FieldByName(AFieldName).AsInteger; AList.Add(ptrValue); end; end; end; end; procedure TDM.IntFieldToIntListFromSQLMemTable(var AList: TIntList; AMemTable: TSQLMemTable; AFieldName: String); var i: Integer; begin //Tolik 28/12/2019 -- if AList <> nil then begin if AMemTable.RecordCount > 0 then begin // for i := 0 to AMemTable.RecordCount - 1 do begin AMemTable.RecNo := i+1; AList.Add(AMemTable.FieldByName(AFieldName).AsInteger); end; end; end; end; // #########################################################################3### function TDM.GetComID: Integer; begin Result := 0; Result := TF_Main(GForm).GSCSBase.SCSComponent.ID; end; procedure TDM.AddComponToLists(AIDCatalog, AIDCompon: Integer); var IndexToInsert: Integer; CatInfo: TCatalogInfo; begin IndexToInsert := FCatRelCatalogIDs.IndexOf(AIDCatalog); if IndexToInsert = -1 then begin FCatRelCatalogIDs.Add(AIDCatalog); FCatRelComponIDs.Add(AIDCompon); end else begin FCatRelCatalogIDs.Insert(IndexToInsert, AIDCatalog); FCatRelComponIDs.Insert(IndexToInsert, AIDCompon); end; //************* CatInfo := GetCatalogInfoByID(AIDCatalog); if CatInfo <> nil then CatInfo.AddComponID(AIDCompon); end; procedure TDM.ClearComponLists; begin FComponIDs.Clear; FComponIDCompTypes.Clear; FComponIDProdusers.Clear; FComponIDNetTypes.Clear; FComponCatalogsCanShowByFilter.Clear; FComponCatalogsNoShowByFilter.Clear; end; procedure TDM.DeleteCatalogFromLists(AIDCatalog: Integer); var IndexOfCat: Integer; CatInfo: TCatalogInfo; begin try IndexOfCat := FCatIDs.IndexOf(AIDCatalog); if IndexOfCat <> -1 then begin FCatIDs.Delete(IndexOfCat); FCatParentIDs.Delete(IndexOfCat); end; IndexOfCat := FCatRelCatalogIDs.IndexOf(AIDCatalog); if IndexOfCat <> -1 then begin FCatRelCatalogIDs.Delete(IndexOfCat); FCatRelComponIDs.Delete(IndexOfCat); end; //************ CatInfo := GetCatalogInfoByID(AIDCatalog); if CatInfo <> nil then FCatInfoList.Remove(CatInfo); except on E: Exception do AddExceptionToLogEx('TDM.DeleteCatalogFromLists', E.Message); end; end; procedure TDM.DeleteComponFromLists(AIDCompon: Integer); var IndexOfComponent: Integer; i: Integer; begin try IndexOfComponent := FCatRelComponIDs.IndexOf(AIDCompon); if IndexOfComponent <> -1 then begin FCatRelComponIDs.Delete(IndexOfComponent); FCatRelCatalogIDs.Delete(IndexOfComponent); end; except on E: Exception do AddExceptionToLogEx('TDM.DeleteComponFromLists', E.Message); end; //************** for i := 0 to FCatInfoList.Count - 1 do if TCatalogInfo(FCatInfoList[i]).RemoveComponID(AIDCompon) <> -1 then Break; //// BREAK //// end; procedure TDM.AddCatalogToLists(AIDCatalog, AParentID: Integer); var IndexToInsert: Integer; CatInfo: TCatalogInfo; begin IndexToInsert := FCatParentIDs.IndexOf(AParentID); if IndexToInsert = -1 then begin FCatIDs.Add(AIDCatalog); FCatParentIDs.Add(AParentID); end else begin FCatIDs.Insert(IndexToInsert, AIDCatalog); FCatParentIDs.Insert(IndexToInsert, AParentID); end; //************** CatInfo := GetCatalogInfoByID(AIDCatalog); if CatInfo = nil then begin CatInfo := TCatalogInfo.Create; CatInfo.ID := AIDCatalog; FCatInfoList.Add(CatInfo); end; CatInfo.ParentID := AParentID; end; function TDM.GetCatalogInfoByID(AID: Integer): TCatalogInfo; var i: Integer; begin Result := nil; for i := 0 to FCatInfoList.Count - 1 do if TCatalogInfo(FCatInfoList[i]).ID = AID then begin Result := TCatalogInfo(FCatInfoList[i]); Break; //// BREAK //// end; end; function TDM.GetCatalogParentIDFromLists(ACatalogID: Integer): Integer; var IndexOfCatalog: Integer; //CatInfo: TCatalogInfo; begin Result := 0; IndexOfCatalog := FCatIDs.IndexOf(ACatalogID); if IndexOfCatalog <> -1 then Result := FCatParentIDs[IndexOfCatalog]; //CatInfo := GetCatalogInfoByID(ACatalogID); //if CatInfo <> nil then // Result := CatInfo.ParentID; end; function TDM.GetCatRelCatalogIDByComponIDFromLists(AComponID: Integer): Integer; var ItemIndex: Integer; begin Result := 0; ItemIndex := FCatRelComponIDs.IndexOf(AComponID); if ItemIndex <> -1 then Result := FCatRelCatalogIDs[ItemIndex]; end; procedure TDM.LoadIDsToLists; var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // CatID: Integer; CatParentID: Integer; CatRelCatalogID: Integer; CatRelComponID: Integer; PrevCatRelCatalogID: Integer; CatalogInfo: TCatalogInfo; begin FCatIDs.Clear; FCatParentIDs.Clear; FCatRelCatalogIDs.Clear; FCatRelComponIDs.Clear; try FCatInfoList.Clear; except end; OldTick := GetTickCount; SetSQLToFIBQuery(Query_Select, 'select id, parent_id from '+tnCatalog+' order by parent_id'); while Not Query_Select.Eof do begin CatID := Query_Select.Fields[0].AsInteger; CatParentID := Query_Select.Fields[1].AsInteger; FCatIDs.Add(CatID); FCatParentIDs.Add(CatParentID); CatalogInfo := TCatalogInfo.Create; CatalogInfo.ID := CatID; CatalogInfo.ParentID := CatParentID; FCatInfoList.Add(CatalogInfo); Query_Select.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; PrevCatRelCatalogID := 0; CatalogInfo := nil; SetSQLToFIBQuery(Query_Select, 'select id_catalog, id_component from '+tnCatalogRelation+' order by id_catalog' {' order by id_catalog, id_component'}); while Not Query_Select.Eof do begin CatRelCatalogID := Query_Select.Fields[0].AsInteger; CatRelComponID := Query_Select.Fields[1].AsInteger; FCatRelCatalogIDs.Add(CatRelCatalogID); FCatRelComponIDs.Add(CatRelComponID); if (PrevCatRelCatalogID <> CatRelCatalogID) or (CatalogInfo = nil) then CatalogInfo := GetCatalogInfoByID(CatRelCatalogID); if CatalogInfo <> nil then CatalogInfo.AddComponID(CatRelComponID); PrevCatRelCatalogID := CatRelCatalogID; Query_Select.Next; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TDM.LoadIDsToComponLists(AFilterParams: TFilterParams); var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // SQLCondition: String; i: Integer; ChildFilterBlock: TFilterBlock; IDComponTypeList: TIntList; IDProducerList: TIntList; IDNetTypeList: TIntList; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; ComponGUIDs: TStringList; //function GetSQLOpeatorIN(AFieldName, APreviosConditions: String; AIDList: TintList): string; // var // i: integer; // begin // Result := ''; // if AIDList.Count > 0 then // begin // if AIDList.Count = 1 then // Result := '('+AFieldName+' = '''+IntToStr(AIDList[0])+''')' // else // begin // Result := '('+AFieldName+' in ('; // for i := 0 to AIDList.Count - 1 do // begin // if i <> 0 then // Result := Result + ', '; // Result := Result + IntToStr(AIDList[i]); // end; // Result := Result + ')) '; // end; // end; // if (APreviosConditions <> '') and (Result <> '') then // Result := APreviosConditions + ' and '+ Result // else // if Result = '' then // Result := APreviosConditions; // end; begin ClearComponLists; if TF_Main(GForm).GDBMode = bkNormBase then begin OldTick := GetTickCount; //*** В некоторых случаях делается проверка на кол-во в списке FComponIDs // чтобы лишние разы не грузить эту ф-ю, добавим признак(-1) того, что была подгрузка FComponIDs.Add(-1); FComponIDCompTypes.Add(-1); FComponIDProdusers.Add(-1); FComponIDNetTypes.Add(-1); case AFilterParams.FFilterType of fltCustom: begin SQLCondition := ''; //*** Собрать условие для фильтра if (AFilterParams.FFilterBlock <> nil) {and (AFilterParams.IsUseFilter)} then begin IDComponTypeList := TIntList.Create; IDProducerList := TIntList.Create; IDNetTypeList := TIntList.Create; for i := 0 to AFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterParams.FFilterBlock.AllChildBlocks[i]; SprComponentType := nil; SprProducer := nil; SprNetType := nil; if ChildFilterBlock.CheckIsOnUp and (ChildFilterBlock.Condition <> nil) then begin case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin if SprComponentType = nil then SprComponentType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetComponentTypeByGUID(ChildFilterBlock.Condition.FilterValue); if SprComponentType <> nil then if IDComponTypeList.IndexOf(SprComponentType.ComponentType.ID) = -1 then IDComponTypeList.Add(SprComponentType.ComponentType.ID); end; fiGuidProducer: begin if SprProducer = nil then SprProducer := TF_Main(GForm).GSCSBase.NBSpravochnik.GetProducerByGUID(ChildFilterBlock.Condition.FilterValue); if SprProducer <> nil then if IDProducerList.IndexOf(SprProducer.ID) = -1 then IDProducerList.Add(SprProducer.ID); end; fiGuidNetType: begin if SprNetType = nil then SprNetType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetNetTypeByGUID(ChildFilterBlock.Condition.FilterValue); if SprNetType <> nil then if IDNetTypeList.IndexOf(SprNetType.ID) = -1 then IDNetTypeList.Add(SprNetType.ID); end; end; end; end; SQLCondition := GetSQLOpeatorIN(fnIDComponentType, SQLCondition, IDComponTypeList); SQLCondition := GetSQLOpeatorIN(fnIDProducer, SQLCondition, IDProducerList); SQLCondition := GetSQLOpeatorIN(fnIDNetType, SQLCondition, IDNetTypeList); if SQLCondition <> '' then SQLCondition := ' where '+SQLCondition; FreeAndNil(IDComponTypeList); FreeAndNil(IDProducerList); FreeAndNil(IDNetTypeList); end; //SQLCondition := ' where (isline = ''0'') and (id_net_type = 2) '; SetSQLToFIBQuery(Query_Select, 'select '+fnID+', '+fnIDComponentType+', '+fnIDProducer+', '+fnIDNetType+' from '+tnComponent+SQLCondition+' order by id'); while Not Query_Select.Eof do begin FComponIDs.Add(Query_Select.Fields[0].AsInteger); FComponIDCompTypes.Add(Query_Select.Fields[1].AsInteger); FComponIDProdusers.Add(Query_Select.Fields[2].AsInteger); FComponIDNetTypes.Add(Query_Select.Fields[3].AsInteger); Query_Select.Next; end; end; fltFavorites, fltTop: begin ComponGUIDs := nil; if AFilterParams.FFilterType = fltFavorites then ComponGUIDs := GetComponGUIDsFromNBFavorites else if AFilterParams.FFilterType = fltTop then ComponGUIDs := GetComponGUIDsFromFreqUseObj(20); if ComponGUIDs <> nil then if ComponGUIDs.Count > 0 then begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, fnGUID+' = :'+fnGuid, nil, fnID), false); for i := 0 to ComponGUIDs.Count - 1 do begin Query_Select.Close; Query_Select.Params[0].AsString := ComponGUIDs[i]; Query_Select.ExecQuery; if Query_Select.RecordCount > 0 then InsertValueToSortetIntList(Query_Select.Fields[0].AsInteger, FComponIDs); //FComponIDs.Add(Query_Select.Fields[0].AsInteger); end; Query_Select.Close; end; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; end; procedure TDM.SaveCatalogParentIDToLists(AIDCatalog, ANewParentID: Integer); var IndexOfCat: Integer; IndexToMove: Integer; TmpInt: Integer; CatalogInfo: TCatalogInfo; begin IndexToMove := FCatParentIDs.IndexOf(ANewParentID); IndexOfCat := FCatIDs.IndexOf(AIDCatalog); if IndexOfCat <> -1 then begin FCatParentIDs[IndexOfCat] := ANewParentID; //*** Данные должны быть по группам if (IndexToMove <> -1) and (IndexOfCat <> IndexToMove) then begin FCatParentIDs.Move(IndexOfCat, IndexToMove); FCatIDs.Move(IndexOfCat, IndexToMove); end; end; //************** CatalogInfo := GetCatalogInfoByID(AIDCatalog); if CatalogInfo <> nil then CatalogInfo.ParentID := ANewParentID; end; procedure TDM.SaveComponCatalogIDToLists(AIDCompon, AOldIDCatalog, ANewIDCatalog: Integer); var IndexOfCompon: Integer; IndexToMove: Integer; CatalogInfo: TCatalogInfo; begin IndexToMove := FCatRelCatalogIDs.IndexOf(ANewIDCatalog); IndexOfCompon := FCatRelComponIDs.IndexOf(AIDCompon); if IndexOfCompon <> -1 then begin FCatRelCatalogIDs[IndexOfCompon] := ANewIDCatalog; //*** Данные должны быть по группам if (IndexToMove <> -1) and (IndexOfCompon <> IndexToMove) then begin FCatRelComponIDs.Move(IndexOfCompon, IndexToMove); FCatRelCatalogIDs.Move(IndexOfCompon, IndexToMove); end; end; //************* // Удалить компонент из старой папки CatalogInfo := GetCatalogInfoByID(AOldIDCatalog); if CatalogInfo <> nil then CatalogInfo.RemoveComponID(AIDCompon); // Добавить компонент в новую папку CatalogInfo := GetCatalogInfoByID(ANewIDCatalog); if CatalogInfo <> nil then CatalogInfo.AddComponID(AIDCompon); end; function TDM.GetPMSettingsAsDefault: TPMSettingRecord; begin Result.DBName := bnPM; end; function TDM.GetNBSettings: TNBSettingRecord; begin Result := U_BaseCommon.GetNBSettings(Query_Select); {Result := GetNBSettingsAsDefault; Query_Select.Close; Query_Select.SQL.Text := 'select count(*) from '+ tnSettings; Query_Select.ExecQuery; if Query_Select.FN(fnCount).AsInteger > 0 then begin Query_Select.Close; Query_Select.SQL.Text := 'select * from '+ tnSettings; Query_Select.ExecQuery; Result.DBName := Query_Select.FN(fnDBName).AsString; Result.BuildID := Query_Select.FN(fnBuildID).AsInteger; Result.NDS := Query_Select.FN(fnNDS).AsFloat; end; Query_Select.Close;} end; function TDM.GetNBType: Integer; begin Result := nbtNone; GetFieldInfo(tnGradeGrid, fnDescription, Query_Select); if Query_Select.RecordCount > 0 then Result := Trunc(Query_Select.FN(StringReverse('HTGNEL_DLEIF$BDR')).AsInteger / nbTypeKoeff); end; function TDM.GetPMSettings: TPMSettingRecord; var Stream: TMemoryStream; begin Result := GetPMSettingsAsDefault; Query_Select.Close; Query_Select.SQL.Text := 'select count(*) from '+ tnSettings; Query_Select.ExecQuery; if Query_Select.FN(fnCount).AsInteger > 0 then begin Query_Select.Close; Query_Select.SQL.Text := 'select * from '+ tnSettings; Query_Select.ExecQuery; Result.DBName := Query_Select.FN(fnDBName).AsString; Result.BusyDate := Query_Select.FN(fnBusyDate).AsDate; Result.BusyTime := Query_Select.FN(fnBusyTime).AsTime; Result.BusyType := Query_Select.FN(fnBusyType).AsInteger; if Query_Select.FieldIndex[fnBackUpDate] <> -1 then Result.BackUpDate := Query_Select.FN(fnBackUpDate).AsDate; UsersInfoPM.Clear; if Query_Select.FieldIndex[fnUsr] <> -1 then begin Stream := TMemoryStream.Create; Query_Select.FN(fnUsr).SaveToStream(Stream); UsersInfoPM.LoadFromStream(Stream); FreeAndNil(Stream); end; end; Query_Select.Close; end; procedure TDM.SetNBSettings(ANBSettings: TNBSettingRecord); //var // FieldList: TStringList; begin U_BaseCommon.SetNBSettings(ANBSettings, Query_Operat); {FieldList := TStringList.Create; FieldList.Add(fnBuildID); //FieldList.Add(fnDisableEditing); FieldList.Add(fnNDS); FieldList.Add(fnDBName); try SQLBuilder(scsQOperat, qtDelete, tnSettings, '', nil, true); SQLBuilder(scsQOperat, qtInsert, tnSettings, '', FieldList, false); scsQOperat.SetParamAsInteger(fnBuildID, ANBSettings.BuildID); scsQOperat.SetParamAsFloat(fnNDS, ANBSettings.NDS); scsQOperat.SetParamAsString(fnDBName, ANBSettings.DBName); scsQOperat.ExecQuery; scsQOperat.Close; finally FieldList.Free; end;} end; procedure TDM.SetPMSettings(APMSettings: TPMSettingRecord); var FieldList: TStringList; begin FieldList := TStringList.Create; FieldList.Add(fnDBName); try SQLBuilder(scsQOperat, qtDelete, tnSettings, '', nil, true); SQLBuilder(scsQOperat, qtInsert, tnSettings, '', FieldList, false); scsQOperat.SetParamAsString(fnDBName, APMSettings.DBName); scsQOperat.ExecQuery; scsQOperat.Close; finally FieldList.Free; end; end; { // ##### Выбрать условные обозначения компоненты ##### procedure TDM.SelectComponIcons(AID_ComponIcon: Integer); var SQLtxt: String; begin if AID_ComponIcon = -1 then SQLtxt := ' SELECT * FROM COMPONENT_ICONS WHERE ID_COMPONENT = '''+ IntToStr(GetComID) +''' ' else SQLtxt := ' SELECT * FROM COMPONENT_ICONS WHERE ID = '''+ IntToStr(AID_ComponIcon) +''' '; SetSellSQLToDataSet(DataSet_Component_Icons, SQLtxt); end; } function TDM.LocateMTByOtherMT(AMemTable, AOtherMemTable: TkbmMemTable): Boolean; begin Result := false; if AMemTable.Active and AOtherMemTable.Active then if (AMemTable.RecordCount > 0) and (AOtherMemTable.RecordCount > 0) then begin Result := AMemTable.Locate(fnID, AOtherMemTable.FieldByName(fnID).AsInteger, []); end; end; // Выбирает интерфейсы Procedure TDM.SelectInterfaces(ANode: TTreeNode); var //SQLtxt: String; //IDCompon: Integer; //ComponID: Integer; SCSComponent: TSCSComponent; begin {if AID_Interface = -1 then SQLtxt := ' SELECT * FROM INTERFACE_RELATION/*, INTERFACE*/ '+ ' WHERE (INTERFACE_RELATION.ID_COMPONENT = '''+IntToStr(GetComID)+''' ) AND '+ // ' (INTERFACE_RELATION.ID_INTERFACE = INTERFACE.ID) and ' + ' (INTERFACE_RELATION.ID_COMPONENT in (SELECT ID FROM COMPONENT) )' + ' ORDER BY INTERFACE_RELATION.ID ' else SQLtxt := ' SELECT * FROM INTERFACE_RELATION/*, INTERFACE*/ '+ ' WHERE INTERFACE_RELATION.ID = '''+IntToStr(AID_Interface)+''' '+ ' ORDER BY INTERFACE_RELATION.ID '; SetSellSQLToDataSet(pFIBDataSet1, SQLtxt); } //IDCompon := GetComID; SCSComponent := nil; case TF_Main(GForm).GDBMode of bkNormBase: SCSComponent := TF_Main(GForm).GSCSBase.SCSComponent; bkProjectManager: SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(TF_Main(GForm).GSCSBase.SCSComponent.ID); end; FillMemTableInterfRel(SCSComponent, ANode, biFalse); //FillMemTableInterfRel(TF_Main(GForm).GSCSBase.SCSComponent, ANode, biFalse); end; procedure TDM.SelectPorts(ANode: TTreeNode); var SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; begin if (ANode = nil) or (ANode.Data = nil) then Exit; //// EXIT //// case PObjectData(ANode.Data).ItemType of itComponCon: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(TF_Main(GForm).GSCSBase.SCSComponent.ID); if SCSComponent <> nil then FillMemTableInterfRel(SCSComponent, ANode, biTrue); end; itSCSConnector: begin SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(TF_Main(GForm).GSCSBase.SCSCatalog.ID); if SCSCatalog <> nil then FillMemTableInterfRel(SCSCatalog, ANode, biTrue); end; end; end; Procedure TDM.SelectCompRel(AComponent: TSCSComponent); var SQLSel: String; SQLWhr: String; SQLtxt: String; ID_Compon: Integer; i: Integer; ChildCompon: TSCSComponent; ptrComplect: PComplect; { procedure FillMTCompRel(AMemTable: TkbmMemTable; AMakeEdit: TMakeEdit; AConnectType: TConnectType); begin scsQSelect.Close; scsQSelect.SetParamAsInteger('connect_type', AConnectType); scsQSelect.ExecQuery; if AID_CompRel = -1 then FillMemTableCompRel(AMemTable, AMakeEdit, AConnectType); end; } (* procedure FillMTCompRel(AMemTable: TkbmMemTable; AConnectType: TConnectType); var Kolvo: Integer; PriceCalc: Double; IDConnected: Integer; begin AMemTable.Active := false; AMemTable.Active := True; AMemTable.DisableControls; case TF_Main(GForm).GDBMode of bkNormBase: begin scsQSelect.Close; scsQSelect.SetParamAsInteger('connect_type', AConnectType); scsQSelect.ExecQuery; while Not scsQSelect.Eof do begin AMemTable.Last; AMemTable.Append; AMemTable.FieldByName('ID').AsInteger := scsQSelect.GetFNAsInteger('ID'); AMemTable.FieldByName('ID_Component').AsInteger := scsQSelect.GetFNAsInteger('ID_Component'); AMemTable.FieldByName('ID_Child').AsInteger := scsQSelect.GetFNAsInteger('ID_Child'); AMemTable.FieldByName('Name').AsString := scsQSelect.GetFNAsString('Name'); if AConnectType = cntComplect then begin Kolvo := scsQSelect.GetFNAsInteger('Kolvo'); PriceCalc := scsQSelect.GetFNAsFloat('Price_Calc'); AMemTable.FieldByName('Kolvo').AsInteger := Kolvo; SetPriceToMT(AMemTable, PriceCalc, Kolvo); end; AMemTable.Post; scsQSelect.Next; end; end; bkProjectManager: begin { tSQL_ComponentRelation.Filtered := false; case AConnectType of cntComplect: tSQL_ComponentRelation.Filter := 'id_component = '''+IntTostr(ID_Compon)+''''; cntUnion: tSQL_ComponentRelation.Filter := '(id_component = '''+IntTostr(ID_Compon)+''') or (id_child = '''+IntTostr(GetComID)+''')'; end; tSQL_ComponentRelation.Filtered := true; if Not tSQL_ComponentRelation.Eof then tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin if tSQL_ComponentRelation.FieldByName('connect_type').AsInteger = AConnectType then begin case AConnectType of cntComplect: SetFilterToSQLMemTable(tSQL_Component, 'id = '''+IntTostr(tSQL_ComponentRelation.FieldByName('id_child').AsInteger)+''''); cntUnion: begin IDConnected := 0; if tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger <> ID_Compon then IDConnected := tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger; if tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger <> ID_Compon then IDConnected := tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger; SetFilterToSQLMemTable(tSQL_Component, 'id = '''+IntTostr(IDConnected)+''''); end; end; AMemTable.Last; AMemTable.Append; AMemTable.FieldByName('ID').AsInteger := tSQL_ComponentRelation.FieldByName('ID').AsInteger; AMemTable.FieldByName('ID_Component').AsInteger := tSQL_ComponentRelation.FieldByName('ID_Component').AsInteger; AMemTable.FieldByName('ID_Child').AsInteger := tSQL_ComponentRelation.FieldByName('ID_Child').AsInteger; AMemTable.FieldByName('Name').AsString := GetComponNameForVisible(tSQL_Component.FieldByName(fnName).AsString, tSQL_Component.FieldByName(fnNameMark).AsString); if AConnectType = cntComplect then begin Kolvo := tSQL_ComponentRelation.FieldByName('Kolvo').AsInteger; PriceCalc := tSQL_Component.FieldByName('Price_Calc').AsFloat; AMemTable.FieldByName('Kolvo').AsInteger := Kolvo; SetPriceToMT(AMemTable, PriceCalc, Kolvo); end; AMemTable.Post; end; tSQL_ComponentRelation.Next; end; } end; end; if Not AMemTable.Eof then AMemTable.First; AMemTable.EnableControls; end; *) begin try MemTable_Complects.Active := false; MemTable_Complects.Active := true; if AComponent <> nil then for i := 0 to AComponent.Complects.Count - 1 do begin ptrComplect := AComponent.Complects[i]; ChildCompon := AComponent.ChildComplects.GetComponenByID(ptrComplect.ID_Child); //ptrComplect := ChildCompon.LinkToComlectRec; //AComponent.GetComplectByIDChild(ChildCompon.ID); if (ptrComplect <> nil) and (ChildCompon <> nil) then begin MemTable_Complects.Append; MemTable_Complects.FieldByName(fnID).AsInteger := ptrComplect.ID; MemTable_Complects.FieldByName(fnIDComponent).AsInteger := ptrComplect.ID_Component; MemTable_Complects.FieldByName(fnIDChild).AsInteger := ptrComplect.ID_Child; MemTable_Complects.FieldByName(fnName).AsString := ChildCompon.GetNameForVisible(false); MemTable_Complects.FieldByName(fnKolvo).AsInteger := ptrComplect.Kolvo; SetPriceToMT(MemTable_Complects, AComponent.ID, ChildCompon.ID, ChildCompon.Price_Calc, ptrComplect.Kolvo); MemTable_Complects.Post; end; end; if MemTable_Complects.RecordCount > 0 then MemTable_Complects.First; except on E: Exception do AddExceptionToLogEx('TDM.SelectCompRel', E.Message); end; {ID_Compon := GetComID; case TF_Main(GForm).GDBMode of bkNormBase: begin SQLSel := 'select component_relation.id, component.id, name, id_component, id_child, Kolvo, price, price_calc ' + ' from component_relation, component '; SQLWhr := ' where (id_component = '''+IntToStr(GetComID)+''') and '; SQLWhr := SQLWhr + ' ( connect_type = :connect_type ) and '+ ' ( Component.id = id_child) and ' + ' ( id_component in (select id from component) ) order by component_relation.id '; scsQSelect.Close; scsQSelect.SQL.Clear; scsQSelect.SQL.Add(SQLSel + SQLWhr); FillMTCompRel(MemTable_Complects, cntComplect); //FillMTCompRel(MemTable_Connections, cntUnion); end; bkProjectManager: begin //FillMTCompRel(MemTable_Complects, cntComplect); MemTable_Complects.Active := false; MemTable_Complects.Active := true; for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildCompon := AComponent.ChildComplects[i]; ptrComplect := AComponent.GetComplectByIDChild(ChildCompon.ID); if ptrComplect <> nil then begin MemTable_Complects.Append; MemTable_Complects.FieldByName(fnID).AsInteger := ptrComplect.ID; MemTable_Complects.FieldByName(fnIDComponent).AsInteger := ptrComplect.ID_Component; MemTable_Complects.FieldByName(fnIDChild).AsInteger := ptrComplect.ID_Child; MemTable_Complects.FieldByName(fnName).AsString := ChildCompon.GetNameForVisible(false); MemTable_Complects.FieldByName(fnKolvo).AsInteger := ptrComplect.Kolvo; SetPriceToMT(MemTable_Complects, ChildCompon.Price_Calc, ptrComplect.Kolvo); MemTable_Complects.Post; end; end; end; end; } { SQLSel := 'select component_relation.id, component.id, name, id_component, id_child, Kolvo, price, price_calc ' + ' from component_relation, component '; if AID_CompRel = -1 then SQLWhr := ' where (id_component = '''+IntToStr(GetComID)+''') and ' else SQLWhr := ' where (component_relation.id = '''+IntToStr(AID_CompRel)+''' ) and '; SQLWhr := SQLWhr + ' ( connect_type = :connect_type ) and '+ ' ( Component.id = id_child) and ' + ' ( id_component in (select id from component) ) order by component_relation.id '; scsQSelect.Close; scsQSelect.SQL.Clear; scsQSelect.SQL.Add(SQLSel + SQLWhr); FillMTCompRel(MemTable_Complects, meMake, cntComplect); FillMTCompRel(MemTable_Connections, meMake, cntUnion); } end; procedure TDM.SelectConnections(ANode: TTreeNode); var Dat: PObjectData; NodeComponent: TSCSComponent; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; SCSComponents: TSCSComponents; JoinedComponent: TSCSComponent; JoinedParent: TSCSComponent; JoinedTop: TSCSComponent; JoinedOwnerCatalog: TSCSCatalog; ptrConnection: PComplect; i, j: Integer; IDNative: Integer; //IDCompRel: Integer; IDComponent: Integer; IDChild: Integer; NameConnection: String; IDTopComponent: Integer; ParentComponIDs: TIntList; NBConnections: TSCSObjectList; ptrNBConnection: TSCSCrossConnection; ConnectionChk: TSCSCrossConnection; FindedConnection: Boolean; CompRelPathFromNode: TIntList; CanAddConnection: Boolean; begin if Not Assigned(ANode) then Exit; ///// EXIT ///// if TF_Main(GForm).GDBMode = bkNormBase then begin if IsCanNBComponNodeHaveConnection(ANode) then begin MemTable_Connections.Active := false; MemTable_Connections.Active := true; IDComponent := PObjectData(ANode.Parent.Data).ObjectID; IDChild := PObjectData(ANode.Data).ObjectID; NBConnections := TF_Main(GForm).GetComponNodeNBConnections(ANode); ParentComponIDs := TF_Main(GForm).GetComplNodeParentIDs(ANode); CompRelPathFromNode := TIntList.Create; //*** определить самый верхний компоненты IDTopComponent := -1; if ParentComponIDs.Count > 0 then IDTopComponent := ParentComponIDs[0]; TF_Main(GForm).LoadCompRelPathIDsToListFromNode(CompRelPathFromNode, IDTopComponent, ANode); //*** загрузить подключение в Memtable for i := 0 to NBConnections.Count - 1 do begin ptrNBConnection := TSCSCrossConnection(NBConnections[i]); //*** Проверить было ли такое подключение внесено в таблицу {FindedConnection := false; for j := 0 to i - 1 do begin ConnectionChk := TSCSCrossConnection(NBConnections[j]); if ((ConnectionChk.IDCompRelFrom = ptrNBConnection.IDCompRelFrom) and (ConnectionChk.IDCompRelTo = ptrNBConnection.IDCompRelTo) and CheckEqualIntLists(ConnectionChk.CompRelFromPath, ptrNBConnection.CompRelFromPath)) or ((ConnectionChk.IDCompRelFrom = ptrNBConnection.IDCompRelTo) and (ConnectionChk.IDCompRelTo = ptrNBConnection.IDCompRelFrom)) then begin FindedConnection := true; Break; //// BREAK //// end; end; if Not FindedConnection then} CanAddConnection := false; if IDTopComponent = ptrNBConnection.IDComponent then begin if CompRelPathFromNode.Count = 0 then CanAddConnection := true else begin if (ptrNBConnection.CompRelFromPath.Count > 0) and CheckEqualIntLists(ptrNBConnection.CompRelFromPath, CompRelPathFromNode) then CanAddConnection := true else if (ptrNBConnection.CompRelToPath.Count > 0) and CheckEqualIntLists(ptrNBConnection.CompRelToPath, CompRelPathFromNode) then CanAddConnection := true; end; end; //if CheckEqualIntLists(ptrNBConnection.CompRelFromPath, ParentComponIDs) or // CheckEqualIntLists(ptrNBConnection.CompRelToPath, ParentComponIDs) then if CanAddConnection then AddNBConnectionToMemTable(MemTable_Connections, IDTopComponent, IDChild, ptrNBConnection); end; FreeAndNil(CompRelPathFromNode); FreeAndNil(ParentComponIDs); NBConnections.OwnsObjects := true; FreeAndNil(NBConnections); //FreeList(NBConnections); end; end; if TF_Main(GForm).GDBMode = bkProjectManager then begin // MemTable_Connections.Close; MemTable_Connections.Open; {MemTable_Connections.Active := false; MemTable_Connections.Active := true;} Dat := nil; SCSComponent := nil; SCSCatalog := nil; SCSComponents := nil; IDNative := -1; Dat := ANode.Data; if Dat = nil then Exit; ///// EXIT ///// NodeComponent := nil; SCSComponents := TSCSComponents.Create(false); MemTable_Connections.DisableControls; try case Dat.ItemType of itComponCon, itComponLine, itArhRoofSeg, itArhRoofHip, itArhRoofHipCorner: begin NodeComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Dat.ObjectID); if Assigned(NodeComponent) then begin IDNative := NodeComponent.ID; SCSComponents.Add(NodeComponent); SCSComponents.Assign(NodeComponent.ChildReferences, laOr); end; end; itSCSConnector, itSCSLine: begin SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(Dat.ObjectID); if Assigned(SCSCatalog) then SCSComponents.Assign(SCSCatalog.ComponentReferences, laOr); end; end; for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents[i]; if Assigned(SCSComponent) then for j := 0 to SCSComponent.JoinedComponents.Count - 1 do begin JoinedComponent := SCSComponent.JoinedComponents[j]; if Assigned(JoinedComponent) then begin //*** Не отображать внутренние соединения if SCSComponent.GetTopComponent = JoinedComponent.GetTopComponent then begin if (NodeComponent = nil) or (SCSComponent <> NodeComponent) then Continue //// CONTINUE //// end; //IDCompRel := 0; IDComponent := SCSComponent.ID; IDChild := JoinedComponent.ID; //DefineIDComponAndIDChild(IDCompRel, IDComponent, IDChild); ptrConnection := SCSComponent.GetConnectionByConnected(JoinedComponent); if ptrConnection = nil then ptrConnection := JoinedComponent.GetConnectionByConnected(SCSComponent); if ptrConnection <> nil then begin NameConnection := ''; if (SCSComponent.IsLine = biTrue) and (JoinedComponent.IsLine = biFalse) then begin JoinedParent := JoinedComponent.GetParentComponent; JoinedTop := JoinedComponent.GetTopComponent; if Assigned(JoinedTop) and (JoinedTop <> JoinedComponent) then begin NameConnection := JoinedTop.GetNameForVisible(false) + '\'; if Assigned(JoinedParent) and (JoinedParent <> JoinedComponent) then NameConnection := NameConnection + '...\'; end; if Assigned(JoinedParent) and (JoinedParent <> JoinedComponent) then NameConnection := NameConnection + JoinedParent.GetNameForVisible(false) + '\'; end else if JoinedComponent.IsLine = biTrue then begin JoinedOwnerCatalog := JoinedComponent.GetFirstParentCatalog; if Assigned(JoinedOwnerCatalog) then NameConnection := NameConnection + JoinedOwnerCatalog.GetNameForVisible(false)+ '\'; end; NameConnection := NameConnection + JoinedComponent.GetNameForVisible(false); MemTable_Connections.Append; MemTable_Connections.FieldByName(fnID).AsInteger := ptrConnection.ID; //IDCompRel; MemTable_Connections.FieldByName(fnIDComponent).AsInteger := IDComponent; MemTable_Connections.FieldByName(fnIDChild).AsInteger := IDChild; MemTable_Connections.FieldByName(fnIDJoined).AsInteger := JoinedComponent.ID; MemTable_Connections.FieldByName(fnName).AsString := NameConnection; //TF_Main(GForm).GetComponNameForVisible(JoinedComponent.Name, JoinedComponent.NameMark); if SCSComponent.ID = IDNative then MemTable_Connections.FieldByName(fnIsNative).AsBoolean := true else MemTable_Connections.FieldByName(fnIsNative).AsBoolean := false; MemTable_Connections.FieldByName(fnRelType).AsInteger := ptrConnection^.RelType; MemTable_Connections.FieldByName(fnFixed).AsInteger := ptrConnection^.Fixed; MemTable_Connections.Post; end; end; end; end; if MemTable_Connections.RecordCount > 0 then MemTable_Connections.First; finally SCSComponents.Free; MemTable_Connections.EnableControls; end; end; end; procedure TDM.SelectProperty(AFormMode: TFormMode; AItemType: TItemType); var ItemID: Integer; ItemFieldName: String; strFilter: String; begin //ItemType := PObjectData((GForm as TF_Main).Tree_Catalog.Selected.Data).ItemType; //if (GForm as TF_MAIN).GDBMode = bkProjectManager then begin ItemFieldName := ''; ItemFieldName := ItemTypeToIsOwnerFieldName(AItemType); if ItemFieldName <> '' then begin strFilter := ''; if AFormMode <> fmView then strFilter := 'where '+ ItemFieldName +' = '''+IntToStr(biTrue)+''''; SetSellSQLToDataSet(DataSet_Properties, ' SELECT * FROM PROPERTIES '+ strFilter); end; { ItemID := (GForm as TF_Main).DM.DataSet_Properties.FN('ID').AsInteger; //GItemType := PObjectData( (GForm as TF_Main).Tree_Catalog.Selected.Data).ItemType; //*** Свойства компоненты имеют ID_ITEM_TYPE = 4 if AItemType in [itComponLine, itComponCon] then AItemType := itComponent; if AFormMode <> fmView then SetSellSQLToDataSet((GForm as TF_Main).DM.DataSet_Properties, ' SELECT * FROM PROPERTIES ' + ' WHERE (ID_ITEM_TYPE = ''' + IntToStr(AItemType) +''' ) OR'+ ' (ID_ITEM_TYPE = ''' + IntToStr(itCommon) +''' )'); if AFormMode = fmView then SetSellSQLToDataSet((GForm as TF_Main).DM.DataSet_Properties, ' SELECT * FROM PROPERTIES '); SearchRecord((GForm as TF_Main).DM.DataSet_Properties, 'ID', ItemID); } end; end; // ##### Выбор свйств папки ##### procedure TDM.SelectCatalogProperty(ASCSCatalog: TSCSCatalog); var ID_Catalog: Integer; //QueryMode: TQueryMode; begin ID_Catalog := TF_Main(GForm).GSCSBase.SCSCatalog.ID; case TF_Main(GForm).GSCSBase.SCSCatalog.QueryMode of qmPhisical: begin //QueryMode := scsQSelect.QueryMode; //scsQSelect.QueryMode := qmPhisical; try SetSQLToFIBQuery(Query_Select, ' SELECT * FROM CATALOG_PROP_RELATION '+ ' WHERE (CATALOG_PROP_RELATION.ID_CATALOG = '''+IntToStr(ID_Catalog)+''') AND ' + ' (CATALOG_PROP_RELATION.ID_CATALOG IN (SELECT ID FROM KATALOG) )'); FillMemTableProp(MemTable_Property, pkCatalog); finally //scsQSelect.QueryMode := QueryMode; end; end; qmMemory: begin FillMemTablePropFromList(MemTable_Property, ASCSCatalog.Properties, false); //tSQL_CatalogPropRelation.Filtered := false; //tSQL_CatalogPropRelation.Filter := 'ID_CATALOG = '''+IntToStr(ID_Catalog)+''''; ///tSQL_CatalogPropRelation.Filtered := true; //FillMemTablePropFromMemBase(MemTable_Property, pkCatalog); end; end; if Not MemTable_Property.Eof then MemTable_Property.First; {ID_Catalog := TF_Main(GForm).GSCSBase.SCSCatalog.ID; SetSQLToQuery(scsQSelect, ' SELECT * FROM CATALOG_PROP_RELATION '+ ' WHERE (CATALOG_PROP_RELATION.ID_CATALOG = '''+IntToStr(ID_Catalog)+''' ) AND ' + ' (CATALOG_PROP_RELATION.ID_CATALOG IN (SELECT ID FROM KATALOG) )'); FillMemTableProp(MemTable_Property, pkCatalog);} end; procedure TDM.SelectComponProperty(ASCSComponent: TSCSComponent); var IDCompon: Integer; begin //FillMemTablePropFromList(MemTable_Property, ASCSComponent.Properties); case TF_Main(GForm).GDBMode of bkNormBase: begin IDCompon := 0; if ASCSComponent <> nil then IDCompon := ASCSComponent.ID else IDCompon := GetComID; SetSQLToFIBQuery(Query_Select, ' SELECT * FROM COMP_PROP_RELATION '+ ' WHERE (COMP_PROP_RELATION.ID_COMPONENT = '''+IntToStr(IDCompon)+''' ) '+ ' ORDER BY ID ' ); FillMemTableProp(MemTable_Property, pkCompon); end; bkProjectManager: begin if ASCSComponent <> nil then FillMemTablePropFromList(MemTable_Property, ASCSComponent.Properties, false); //tSQL_CompPropRelation.Filtered := false; //tSQL_CompPropRelation.Filter := 'ID_COMPONENT = '''+IntToStr(GetComID)+''''; //tSQL_CompPropRelation.Filtered := true; //FillMemTablePropFromMemBase(MemTable_Property, pkCompon); end; end; if MemTable_Property.RecordCount > 0 then MemTable_Property.First; {SetSQLToQuery(scsQSelect, ' SELECT * FROM COMP_PROP_RELATION '+ ' WHERE (COMP_PROP_RELATION.ID_COMPONENT = '''+IntToStr(GetComID)+''' ) AND ' + ' (COMP_PROP_RELATION.ID_COMPONENT IN (SELECT ID FROM COMPONENT) ) '+ ' ORDER BY ID ' ); FillMemTableProp(MemTable_Property, pkCompon);} end; procedure TDM.SelectCableChannelsConnectors(AComponent: TSCSComponent); begin if AComponent <> nil then //Tolik 15/11/2021 -- поскольку юзаем одну и ту же таблицу и для элементов // кабельного канала и для элементов трубных соединений //if AComponent.ComponentType.SysName = ctsnCableChannel then if (AComponent.ComponentType.SysName = ctsnCableChannel) or (AComponent.ComponentType.SysName = ctsnTube) then // begin mtCableCanalConnectors.Active := false; mtCableCanalConnectors.Active := true; FillMemTableCableCanalConnectors(mtCableCanalConnectors, AComponent.CableCanalConnectors, false); if mtCableCanalConnectors.RecordCount > 0 then mtCableCanalConnectors.First; end; end; procedure TDM.SelectCrossConnections; var i: Integer; ptrCrossConnection: TSCSCrossConnection; begin with TF_Main(GForm) do begin MemTable_CrossConnection.Active := false; MemTable_CrossConnection.Active := true; GSCSBase.SCSComponent.LoadCrossConnections; for i := 0 to GSCSBase.SCSComponent.CrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(GSCSBase.SCSComponent.CrossConnections[i]); //*** если не подключение между компонентами if ptrCrossConnection.IDCompRelWith <> 0 then LoadCrossConnectionToMemTable(meMake, MemTable_CrossConnection, ptrCrossConnection); end; if MemTable_CrossConnection.RecordCount > 0 then MemTable_CrossConnection.First; end; end; procedure TDM.SelectNorms(aNormsRes: TSCSNormsResources); var SCSCompon: TSCSComponent; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; i: Integer; begin try mtNorms.Active := false; mtNorms.Active := true; if aNormsRes <> nil then begin for i := 0 to aNormsRes.Norms.Count - 1 do begin SCSNorm := aNormsRes.Norms.Items[i]; //Tolik TF_MAIN(GForm).DefineFTraceLength; // если не сделать - возьмет предидущую трассу, получится наёб // LoadFromNormToMT(SCSNorm, mtNorms, meNone, -1, TF_Main(GForm).FTraccaLength, SCSNorm); end; for i := 0 to aNormsRes.Resources.Count - 1 do begin SCSResourceRel := aNormsRes.Resources.Items[i]; //Tolik TF_MAIN(GForm).DefineFTraceLength; // если не сделать - возьмет предидущую трассу, получится наёб // LoadFromResourceToMT(SCSResourceRel, mtNorms, meNone, tkNormEd, TF_Main(GForm).FTraccaLength, SCSResourceRel); end; end; except on E: Exception do AddExceptionToLogEx('TDM.SelectNorms', E.Message); end; end; procedure TDM.SelectCatalogCurrency(AIDToLocate: Integer = -1); var IDCatalog: Integer; ptrObjectCurrency: PObjectCurrencyRel; ObjCurrencyList: TList; Currency: TCurrency; i: Integer; begin if Not mtObjectCurrency.Active then mtObjectCurrency.Active := true else if mtObjectCurrency.RecordCount > 0 then mtObjectCurrency.EmptyTable; IDCatalog := TF_MAin(GForm).GSCSBase.SCSCatalog.ID; if IDCatalog > 0 then begin ObjCurrencyList := GetObjectCurrencies(IDCatalog, Query_Select); for i := 0 to ObjCurrencyList.Count - 1 do begin ptrObjectCurrency := ObjCurrencyList[i]; Currency := GetCurrencyByID(ptrObjectCurrency.IDCurrency); ptrObjectCurrency.Data.Name := Currency.Name; ptrObjectCurrency.Data.NameBrief := Currency.NameBrief; mtObjectCurrency.Append; SetObjectCurrencyToMemTable(ptrObjectCurrency, mtObjectCurrency); mtObjectCurrency.Post; end; if mtObjectCurrency.RecordCount > 0 then begin if AIDToLocate = -1 then mtObjectCurrency.First else if Not mtObjectCurrency.Locate(fnID, AIDToLocate, []) then mtObjectCurrency.First; end; Freelist(ObjCurrencyList); end; end; procedure TDM.SelectCompSub(ANode: TTreeNode; AComponent: TSCSComponent); var // Tolik 28/08/2019-- //Old, Curr: Cardinal; Old, Curr: DWord; // SCSCompon: TSCSComponent; begin //Exit; //#Del old := GetTickCount; SCSCompon := AComponent; if (SCSCompon = nil) and (TF_Main(GForm).GDBMode = bkProjectManager) then SCSCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(PObjectData(ANode.Data).ObjectID); if (SCSCompon = nil) and (TF_Main(GForm).GDBMode = bkNormBase) then SCSCompon := TF_Main(GForm).GSCSBase.SCSComponent; //Old := GetTickCount; SelectInterfaces(ANode); //Curr := GetTickCount - Old; //Old := GetTickCount; SelectCompRel(SCSCompon); //Curr := GetTickCount - Old; //Old := GetTickCount; SelectConnections(ANode); //Curr := GetTickCount - Old; //Old := GetTickCount; SelectComponProperty(SCSCompon); //Curr := GetTickCount - Old; //SelectComponIcons; //Old := GetTickCount; SelectCrossConnections; //Curr := GetTickCount - Old; SelectCableChannelsConnectors(SCSCompon); SelectNorms(SCSCompon.NormsResources); Curr := GetTickCount - Old; Curr := GetTickCount - Old; end; Procedure TDM.SelectCatalogSub(ANode: TTreeNode; ACatalog: TSCSCatalog); var SCSCataog: TSCSCatalog; begin SCSCataog := ACatalog; if (SCSCataog = nil) and (TF_Main(GForm).GDBMode = bkProjectManager) then SCSCataog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(PObjectData(ANode.Data).ObjectID); if TF_Main(GForm).GDBMode = bkProjectManager then begin if Assigned(SCSCataog) then begin SelectCatalogProperty(SCSCataog); SelectNorms(SCSCataog.NormsResources); end; SelectPorts(ANode); SelectConnections(ANode); end else if TF_Main(GForm).GDBMode = bkNormBase then begin SelectCatalogCurrency; end; end; procedure TDM.SelectDSetByDirectoryType(AIDDirectoryType: Integer; ADirTypeInfo: TDirTypeInfo; AWhereParam: string); var SQLtxt: String; strWhere: String; begin strWhere := ''; if AIDDirectoryType <> -1 then begin strWhere := ', '+tnDirectoryTypeRel+ ' '+ 'WHERE ('+fnIDDirectoryType+' = '''+IntTostr(AIDDirectoryType)+''') AND '+ '('+ADirTypeInfo.TableName+'.ID = '+tnDirectoryTypeRel+'.'+ADirTypeInfo.MasterFieldName+')'; if AWhereParam <> '' then strWhere := strWhere + ' and '+ AWhereParam; end; // из-за задвоенной записи в DIRECTORY_TYPE_REL в базе РФ сделаем через DISTINCT(NET_TYPE.ID) if (ADirTypeInfo.TableName = 'NET_TYPE') and (ADirTypeInfo.MasterFieldName = 'ID_NET_TYPE') and (ADirTypeInfo.DataSet is TpFIBDataSet) then SQLtxt := ' SELECT DISTINCT(NET_TYPE.ID) , net_type.* FROM '+ADirTypeInfo.TableName + strWhere else SQLtxt := ' SELECT * FROM '+ADirTypeInfo.TableName + strWhere; if ADirTypeInfo.FldName <> '' then SQLtxt := SQLtxt +' ORDER BY '+ADirTypeInfo.FldName+' '; if ADirTypeInfo.DataSet is TpFIBDataSet then SetSellSQLToDataSet(TpFIBDataSet(ADirTypeInfo.DataSet), SQLtxt); end; (* // ##### Отбирает условные обозначения по порядковом номере ##### procedure TDM.SelectCompIconsByNPP(ANPP: Integer); var qSQL: String; Stream: TStream; begin //*** Удалить предведущие иконки {MemTable_ComponentIcons.Active := false; MemTable_ComponentIcons.Active := true; qSQL := ' SELECT * FROM OBJECT_ICONS, COMP_STATE_TYPE '+ ' WHERE (NPP_ID = '''+ IntToStr(ANPP) +''') and '+ ' (ID_COMP_STATE_TYPE = COMP_STATE_TYPE.ID) '+ ' Order By COMP_STATE_TYPE.ID '; SetSQLToQuery(F_NormBase.DM.scsQ, qSQL); while Not F_NormBase.DM.scsQ.Eof do begin MemTable_ComponentIcons.Append; MemTable_ComponentIcons.FieldByName('Name').AsString := F_NormBase.DM.scsQ.FN('Name').AsString; MemTable_ComponentIcons.FieldByName('ID_Object_Icon').AsInteger := F_NormBase.DM.scsQ.FN('ID').AsInteger; MemTable_ComponentIcons.FieldByName('NPP_ID_OBJECT_ICON').AsInteger := F_NormBase.DM.scsQ.FN('NPP_ID').AsInteger; MemTable_ComponentIcons.FieldByName('ID_COMP_STATE_TYPE').AsInteger := F_NormBase.DM.scsQ.FN('ID_COMP_STATE_TYPE').AsInteger; //DM.MemTable_ComponentIcons.FieldByName('Icon').AsVariant := F_NormBase.DM.scsQ.FN('ICON').AsVariant; SaveToStreamFromQr(F_NormBase.DM.scsQ, Stream, 'ICON', true); MemTable_ComponentIconsICON.LoadFromStream(Stream); //AsVariant := F_NormBase.DM.scsQ.FN('ICON').AsVariant; Stream.Free; MemTable_ComponentIcons.FieldByName('isNew').AsBoolean := true; MemTable_ComponentIcons.FieldByName('isModified').AsBoolean := false; MemTable_ComponentIcons.Post; F_NormBase.DM.scsQ.Next; end;} end; *) procedure TDM.RestoreMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); var i: integer; begin for i := 0 to AMemTables.Count - 1 do if TkbmMemTable(AMemTables.Items[i]).Active then // Tolik 28/12/2019 - - if AListPositions.Items[i] > -1 then if TkbmMemTable(AMemTables.Items[i]).RecordCount > 0 then // TkbmMemTable(AMemTables.Items[i]).RecNo := AListPositions.Items[i]; end; procedure TDM.SaveCatalogMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); begin AMemTables.Clear; AListPositions.Clear; SaveMemTablePosition(MemTable_Property, AMemTables, AListPositions); end; procedure TDM.SaveComponMemTablesPositions(AMemTables: Tlist; AListPositions: TIntlist); begin AMemTables.Clear; AListPositions.Clear; SaveMemTablePosition(MemTable_Complects, AMemTables, AListPositions); SaveMemTablePosition(MemTable_Property, AMemTables, AListPositions); SaveMemTablePosition(MemTable_InterfaceRel, AMemTables, AListPositions); SaveMemTablePosition(MemTable_Port, AMemTables, AListPositions); SaveMemTablePosition(MemTable_Connections, AMemTables, AListPositions); SaveMemTablePosition(mtCableCanalConnectors, AMemTables, AListPositions); SaveMemTablePosition(MemTable_CrossConnection, AMemTables, AListPositions); SaveMemTablePosition(mtNorms, AMemTables, AListPositions); end; procedure TDM.SaveMemTablePosition(AMemTable: TkbmMemTable; AMemTables: TList; AListPositions: TIntlist); begin if AMemTable = nil then Exit; //// EXIT //// if AMemTable.Active then begin AMemTables.Add(AMemTable); AListPositions.Add(AMemTable.RecNo); end; end; function TDM.GetMemTableByMemoryTableKind(AMemoryTableKind: TTableKind): TkbmMemTable; begin Result := nil; case AMemoryTableKind of tkResourceRelEd: Result := MemTable_ResourcesRelEd; tkNormEd: Result := MemTable_NormsEd; end; end; procedure TDM.DeleteRecords(ADataSet: TDataSet); begin if ADataSet.RecordCount > 0 then begin ADataSet.Last; while Not ADataSet.Bof do ADataSet.Delete; end; end; procedure TDM.ClearMemTableCompl; begin with MemTable_Complects do begin // Очистка таблици // Tolik 16/12/2019 -- //Active := false; //Active := true; if Active then Close; Open; // end; end; procedure TDM.SetPriceToMT(var AMemTable: TkbmMemTable; AIDCompon, AIDChild: Integer; APrice: Double; AKolvo: Integer); var ChildPrice: Double; begin ChildPrice := APrice; if TF_Main(GForm).GDBMode = bkNormBase then ChildPrice := GetChildComponPrice(AIDCompon, AIDChild, ChildPrice, nil); with AMemTable do begin FieldByName('Price1').AsFloat := Round2(ChildPrice); //FieldByName('Price2').AsString := FloatToStr( RoundX(APrice * (TF_Main(GForm).GCurrencyM.Ratio / TF_Main(GForm).GCurrencyS.Ratio) ,2)); FieldByName('Price2').AsFloat := GetPriceAfterChangeCurrency(ChildPrice, TF_Main(GForm).GLocalCurrencyM.Data, TF_Main(GForm).GLocalCurrencyS.Data); FieldByName('Cost1').AsFloat := Round2(ChildPrice * AKolvo); FieldByName('Cost2').AsFloat := GetPriceAfterChangeCurrency(ChildPrice * AKolvo, TF_Main(GForm).GLocalCurrencyM.Data, TF_Main(GForm).GLocalCurrencyS.Data); //FieldByName('Cost2').AsString := FloatToStr( RoundX(APrice * (TF_Main(GForm).GCurrencyM.Ratio / TF_Main(GForm).GCurrencyS.Ratio) * AKolvo ,2)); end; end; procedure TDM.MTRefreshCurrentCompl(Var AMemTable: TkbmMemTable); var Kolvo: Integer; Price: Double; ComponID: Integer; ChildID: Integer; begin //SetSQLToQuery(scsQSelect, ' select * from component_relation where id = '''+ IntToStr(FieldByName('ID').AsInteger) +''' '); SetSQLToQuery(scsQSelect, ' select component_relation.id, cOMPONENT.id, name, id_component, id_child, Kolvo, price, price_calc ' + ' from component_relation, component '+ ' where (component_relation.id = '''+IntToStr(AMemTable.FieldByName(fnID).AsInteger)+''' ) and ' + ' ( Component.ID = id_cHILD) and ' + ' ( id_component in (select id from component) )'); ComponID := scsQSelect.GetFNAsInteger(fnIDComponent); ChildID := scsQSelect.GetFNAsInteger(fnIDChild); AMemTable.Edit; AMemTable.FieldByName('ID').AsInteger := scsQSelect.GetFNAsInteger('ID'); AMemTable.FieldByName('ID_Component').AsInteger := ComponID; AMemTable.FieldByName('ID_Child').AsInteger := ChildID; AMemTable.FieldByName('Name').AsString := scsQSelect.GetFNAsString('Name'); Kolvo := scsQSelect.GetFNAsInteger('Kolvo'); Price := scsQSelect.GetFNAsFloat('Price_calc'); AMemTable.FieldByName('Kolvo').AsInteger := Kolvo; SetPriceToMT(AMemTable, ComponID, ChildID, Price, Kolvo); AMemTable.Post; end; procedure TDM.ActiveAll(AActive: Boolean); var FieldNames: TStringList; ProcName: String; // Tolik 28/08/2019 -- //OldTick, Currtick: Cardinal; OldTick, Currtick: DWord; // i: Integer; Transact: TFIBTransaction; PropData: TPropertyData; begin ProcName := 'TDM.ActiveAll'; OldTick := GetTickCount; //DataSet_CATALOG.Active := AActive; //DataSet_COMP_STATE_TYPE.Active := AActive; //DataSet_COMPONENT_ICONS.Active := AActive; if TF_Main(GForm).GDBMode = bkNormBase then begin if Not AActive then TimerStoreGuidToReserv.Enabled := false; if AActive then begin GNBSettings := GetNBSettings; TF_Main(GForm).GNDS := GNBSettings.NDS; end else SetNBSettings(GNBSettings); { DataSet_CURRENCY.Active := AActive; DataSet_INTERFACE.Active := AActive; DataSet_InterfaceLookUp.Active := AActive; //DataSet_InterfAccordance.Active := AActive; //DataSet_Interface_Norms.Active := AActive; DataSet_PROPERTIES.Active := AActive; DataSet_DATA_TYPE.Active := AActive; DataSet_NET_TYPE.Active := AActive; DataSet_COMPONENT_TYPES.Active := AActive; //DataSet_COMP_TYPE_PROP_RELATION.Active := AActive; DataSet_PRODUCERS.Active := AActive; DataSet_OBJECT_ICONS.Active := AActive; DataSet_NB_NORMS.Active := AActive; //DataSet_NB_NORM_RESOURCE_REL.Active := AActive; //DataSet_NORM_TZ_REL.Active := true; DataSet_NB_RESOURCES.Active := AActive; //DataSet_TZ.Active := true; DataSet_SuppliesKinds.Active := AActive;} {$IF Not Defined (FINAL_SCS)} try dsetUpdStructInfo.Active := AActive; dsetUpdInfo.Active := AActive; dsetUpdInfoRel.Active := AActive; except end; {$IFEND} if AActive then TimerStoreGuidToReserv.Enabled := true; end; Transac_QR_Select.Active := AActive; Transac_QR_Operat.Active := AActive; Transac_TSCSSelect.Active := AActive; Transac_TSCSOperat.Active := AActive; QTransaction.Active := AActive; QTransaction1.Active := AActive; //*** Поле BuildID для проекта if AActive then begin LoadIDsToLists; case TF_Main(GForm).GDBMode of bkNormBase: begin StoreGuidsInReservGuidTable; //*** Высота размещения для типов компонент //if Not ExistsFieldInTable(tnComponentTypes, fnCoordZ, qmPhisical) then //begin // AddFieldToTable(tnComponentTypes, fnCoordZ, ftFloat, 0); // SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnComponentTypes, '', nil, fnCoordZ), false); // Query_Operat.ParamByName(fnCoordZ).AsInteger := -1; // Query_Operat.ExecQuery; //end; // на buildid 8 //*** расход нормы if Not ExistsFieldInTable(tnNorms, fnExpenseForLength, qmPhisical) then begin AddFieldToTable(tnNorms, fnExpenseForLength, ftFloat, 0); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnNorms, '', nil, fnExpenseForLength), false); Query_Operat.ParamByName(fnExpenseForLength).AsInteger := 0; Query_Operat.ExecQuery; end; //*** Количество соотв-х интерфейсов if Not ExistsFieldInTable(tnInterfaceAccordance, fnKolvo, qmPhisical) then begin AddFieldToTable(tnInterfaceAccordance, fnKolvo, ftInteger, 0); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnInterfaceAccordance, '', nil, fnKolvo), false); Query_Operat.ParamByName(fnKolvo).AsInteger := 1; Query_Operat.ExecQuery; end; if Not ExistsFieldInTable(tnSuppliesKinds, fnNameTradUOM, qmPhisical) then begin AddFieldToTable(tnSuppliesKinds, fnNameTradUOM, ftString, 255); AddFieldToTable(tnSuppliesKinds, fnIzmTradUOM, ftString, 255); AddFieldToTable(tnSuppliesKinds, fnUnitKolvoTradUOM, ftFloat, 0); UpdateAllRecFromField(tnSuppliesKinds, fnNameTradUOM, fnName); UpdateAllRecFromField(tnSuppliesKinds, fnIzmTradUOM, fnIzm); UpdateAllRecFromField(tnSuppliesKinds, fnUnitKolvoTradUOM, fnUnitKolvo); end; DefineUseFieldsInBase(GForm); // Свойство "Группа" ZeroMemory(@PropData, Sizeof(PropData)); PropData.SysName := pnGroupName; PropData.Name := cArchParams_Msg21; PropData.Description := cArchParams_Msg21_2; PropData.IDDataType := dtString; PropData.ValueReq := biTrue; DefineNBProperty(ditProperty, '', @PropData); //Tolik 09/03/2021 -- // Свойство "Не учитывать УГО для границ объекта" ZeroMemory(@PropData, Sizeof(PropData)); PropData.SysName := pnNotUseUgoBounds; PropData.Name := cNotUseUgoBounds; PropData.Description := cNotUseUgoBoundsDesc; PropData.IDDataType := dtBoolean; PropData.ValueReq := biFalse; DefineNBProperty(ditProperty, '', @PropData); // end; bkProjectManager: begin //if Not ExistsFieldInTable(tnCatalog, 'teeeest', qmPhisical) then // AddFieldToTable(tnCatalog, 'teeeest', ftInteger, 0); if Not ExistsFieldInTable(tnCatalog, fnBuildID, qmPhisical) then AddFieldToTable(tnCatalog, fnBuildID, ftInteger, 0); if Not ExistsFieldInTable(tnCatalog, fnIDFromOpened, qmPhisical) then AddFieldToTable(tnCatalog, fnIDFromOpened, ftInteger, 0); if Not ExistsFieldInTable(tnCatalog, fnDefListSettings, qmPhisical) then AddFieldToTable(tnCatalog, fnDefListSettings, ftBlob, 0); if Not ExistsFieldInTable(tnCatalog, fnGenerators, qmPhisical) then AddFieldToTable(tnCatalog, fnGenerators, ftBlob, 0); //*** 2006 09 06 if Not ExistsFieldInTable(tnCatalog, fnIsIndexWithName, qmPhisical) then begin AddFieldToTable(tnCatalog, fnIsIndexWithName, ftInteger, 0); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnCatalog, '', nil, fnIsIndexWithName), false); Query_Operat.ParamByName(fnIsIndexWithName).AsInteger := biTrue; Query_Operat.ExecQuery; end; //*** 2007 03 28 if Not ExistsFieldInTable(tnCatalog, fnBeatenBlock, qmPhisical) then AddFieldToTable(tnCatalog, fnBeatenBlock, ftBlob, 0); //*** 2007 04 25 - Есть ли таблица с пользовательскими шаблонами отчетов if Not ExistsFieldInTable(tnUserReports, fnID, qmPhisical) then begin try SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTable+' '+tnUserReports+' ( '+ fnID+ ' '+scelInteger+', '+ fnRepKind+' '+scelInteger+', '+ fnName+ ' '+scelVarchar255+', '+ fnTemplateType+' '+scelInteger+' '+scelDefault+' 1, '+ fnUseAsShablon+' '+scelInteger+' '+scelDefault+' 0, '+ fnRepBlob+ ' '+scelBlob_SUBTYPE0_SEGMENT_SIZE80+' '+ ');'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelGenerator+' '+gnUserReportsID+';'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTrigger+' '+tnUserReports+'_BI '+scelFor+' '+tnUserReports+' '+ scelActive+' '+scelBefore+' '+scelInsert+' '+scelPosition+' 0 '+ scelAs+' '+ scelBegin+' '+ ' '+scelIf+' ('+scelNew+'.'+fnID+' '+scelISNull+') '+scelThen+' '+ ' '+scelNew+'.'+fnID+' = '+scelGenID+'('+gnUserReportsID+',1); '+ scelEnd+' '); except on E: Exception do AddExceptionToLogEx(ProcName, E.Message); end; end; //15.07.2008 if Not CheckExistsTableInBase(Query_Select, tnReportSortInfo) then begin try SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTable+' '+tnReportSortInfo+' ( '+ fnID+ ' '+scelInteger+' '+scelNotNull+', '+ fnRepKind+' '+scelSmallInt+', '+ fnCaseSensitive+' '+scelSmallInt+', '+ fnDescend+ ' '+scelSmallInt+', '+ fnFieldList+ ' '+scelBlob_SUBTYPE0_SEGMENT_SIZE80+' '+ ');'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelGenerator+' '+gnReportSortInfoID+';'); SetSQLToFIBQuery(Query_Operat, scelAlter+' '+scelTable+' '+tnReportSortInfo+' '+scelAdd+' '+scelConstraint+' '+ scelPK+tnReportSortInfo+' '+scelPrimaryKey+' ('+fnID+');'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTrigger+' '+tnReportSortInfo+'_BI '+scelFor+' '+tnReportSortInfo+' '+ scelActive+' '+scelBefore+' '+scelInsert+' '+scelPosition+' 0 '+ scelAs+' '+ scelBegin+' '+ ' '+scelIf+' ('+scelNew+'.'+fnID+' '+scelISNull+') '+scelThen+' '+ ' '+scelNew+'.'+fnID+' = '+scelGenID+'('+gnReportSortInfoID+',1); '+ scelEnd+' '); except on E: Exception do AddExceptionToLogEx(ProcName, E.Message); end; end; //21.01.2014 if Not CheckExistsTableInBase(Query_Select, tnProjectRev) then begin try SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTable+' '+tnProjectRev+' ( '+ fnID +' '+scelInteger+' '+scelNotNull+', '+ fnIDCatalog +' '+scelInteger+', '+ fnMaterialCost +' '+scelFloat+', '+ fnNormCost +' '+scelFloat+', '+ fnTotalCost +' '+scelFloat+', '+ fnRevision +' '+scelInteger+', '+ fnPMBlock +' '+scelBlob_SUBTYPE0_SEGMENT_SIZE80+', '+ fnComment +' '+scelVarchar255+', '+ fnBaseline +' '+scelSmallInt+', '+ fnDateIn +' '+scelDate+', '+ fnTimeIn +' '+scelTime+ ');'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelGenerator+' '+gnProjectRevID+';'); SetSQLToFIBQuery(Query_Operat, scelAlter+' '+scelTable+' '+tnProjectRev+' '+scelAdd+' '+scelConstraint+' '+ scelPK+tnProjectRev+' '+scelPrimaryKey+' ('+fnID+');'); SetSQLToFIBQuery(Query_Operat, scelCreate+' '+scelTrigger+' '+tnProjectRev+'_BI '+scelFor+' '+tnProjectRev+' '+ scelActive+' '+scelBefore+' '+scelInsert+' '+scelPosition+' 0 '+ scelAs+' '+ scelBegin+' '+ ' '+scelIf+' ('+scelNew+'.'+fnID+' '+scelISNull+') '+scelThen+' '+ ' '+scelNew+'.'+fnID+' = '+scelGenID+'('+gnProjectRevID+',1); '+ scelEnd+' '); SetSQLToFIBQuery(Query_Operat, 'alter table PROJECT_REV add constraint FK_PROJECT_REV foreign key (ID_CATALOG) references KATALOG(ID) on delete CASCADE on update CASCADE'); except on E: Exception do AddExceptionToLogEx(ProcName, E.Message); end; end; //tnReportSortInfo //*** 2007 06 20 if Not ExistsFieldInTable(tnCatalog, fnComponFilterBlock, qmPhisical) then AddFieldToTable(tnCatalog, fnComponFilterBlock, ftBlob, 0); {Query_Select.Close; Query_Select.SQL.Text := 'select max(build_id) from katalog'; try Query_Select.ExecQuery; except Query_Operat.Close; Query_Operat.SQL.Text := 'ALTER TABLE KATALOG '+ 'ADD BUILD_ID INTEGER '+ 'DEFAULT 0 '; try Query_Operat.ExecQuery; except on E: Exception do AddExceptionToLog('', E.Message); end; end; } //01.12.2008 if Not ExistsFieldInTable(tnCatalog, fnNBBuildID, qmPhisical) then AddFieldToTable(tnCatalog, fnNBBuildID, ftInteger, 0); end; end; end else for i := 0 to Database_SCS.TransactionCount - 1 do begin Transact := Database_SCS.Transactions[i]; if Transact.Active then Transact.Active := false; end; Currtick := GetTickCount - OldTick; Currtick := GetTickCount - OldTick; end; procedure TDM.CreateSQLMemTables; var i: Integer; CurrTable: TSQLMemTable; begin if Not FMemBaseCreated then begin tSQL_Katalog := TSQLMemTable.Create(Self); tSQL_Katalog.TableName := tnCatalog; tSQL_CatalogRelation := TSQLMemTable.Create(Self); tSQL_CatalogRelation.TableName := tnCatalogRelation; tSQL_Component := TSQLMemTable.Create(Self); tSQL_Component.TableName := tnComponent; tSQL_CatalogPropRelation := TSQLMemTable.Create(Self); tSQL_CatalogPropRelation.TableName := tnCatalogPropRelation; tSQL_ComponentRelation := TSQLMemTable.Create(Self); tSQL_ComponentRelation.TableName := tnComponentRelation; tSQL_CompPropRelation := TSQLMemTable.Create(Self); tSQL_CompPropRelation.TableName := tnCompPropRelation; tSQL_CableCanalConnectors := TSQLMemTable.Create(Self); tSQL_CableCanalConnectors.TableName := tnCableCanalConnectors; tSQL_ConnectedComponents := TSQLMemTable.Create(Self); tSQL_ConnectedComponents.TableName := tnConnectedComponents; tSQL_InterfaceRelation := TSQLMemTable.Create(Self); tSQL_InterfaceRelation.TableName := tnInterfaceRelation; tSQL_InterfOfInterfRelation := TSQLMemTable.Create(Self); tSQL_InterfOfInterfRelation.TableName := tnInterfOfInterfRelation; tSQL_PortInterfaceRelation := TSQLMemTable.Create(Self); tSQL_PortInterfaceRelation.TableName := tnPortInterfaceRelation; tSQL_Norms := TSQLMemTable.Create(Self); tSQL_Norms.TableName := tnNorms; tSQL_NormResourceRel := TSQLMemTable.Create(Self); tSQL_NormResourceRel.TableName := tnNormResourceRel; tSQL_Resources := TSQLMemTable.Create(Self); tSQL_Resources.TableName := tnResources; //--- tSQL_Currency := TSQLMemTable.Create(Self); tSQL_Currency.TableName := tnCurrency; tSQL_ComponentTypes := TSQLMemTable.Create(Self); tSQL_ComponentTypes.TableName := tnComponentTypes; tSQL_CompTypePropRelation := TSQLMemTable.Create(Self); tSQL_CompTypePropRelation.TableName := tnCompTypePropRelation; tSQL_Interface := TSQLMemTable.Create(Self); tSQL_Interface.TableName := tnInterface; tSQL_InterfaceNorms := TSQLMemTable.Create(Self); tSQL_InterfaceNorms.TableName := tnInterfaceNorms; tSQL_InterfaceAccordance := TSQLMemTable.Create(Self); tSQL_InterfaceAccordance.TableName := tnInterfaceAccordance; tSQL_NetType := TSQLMemTable.Create(Self); tSQL_NetType.TableName := tnNetType; tSQL_NBNorms := TSQLMemTable.Create(Self); tSQL_NBNorms.TableName := tnNBNorms; tSQL_ObjectIcons := TSQLMemTable.Create(Self); tSQL_ObjectIcons.TableName := tnObjectIcons; tSQL_Producers := TSQLMemTable.Create(Self); tSQL_Producers.TableName := tnProducers; tSQL_Properties := TSQLMemTable.Create(Self); tSQL_Properties.TableName := tnProperties; tSQL_NBResources := TSQLMemTable.Create(Self); tSQL_NBResources.TableName := tnNBResources; tSQL_SuppliesKinds := TSQLMemTable.Create(Self); tSQL_SuppliesKinds.TableName := tnSuppliesKinds; //-- tSQL_CADNormStruct := TSQLMemTable.Create(Self); tSQL_CADNormStruct.TableName := tnCADNormStruct; tSQL_CADNormColumn := TSQLMemTable.Create(Self); tSQL_CADNormColumn.TableName := tnCADNormColumn; tSQL_CADCrossObject := TSQLMemTable.Create(Self); tSQL_CADCrossObject.TableName := tnCADCrossObject; tSQL_CADCrossObjectElement := TSQLMemTable.Create(Self); tSQL_CADCrossObjectElement.TableName := tnCADCrossObjectElement; //-- tSQL_InterfPosConnection := TSQLMemTable.Create(Self); tSQL_InterfPosConnection.TableName := tnInterfPosConnection; tSQL_StringsMan := TSQLMemTable.Create(Self); tSQL_StringsMan.TableName := tnStringsMan; tSQL_Filters := TSQLMemTable.Create(Self); tSQL_Filters.TableName := tnFilters; tSQL_PropValRel := TSQLMemTable.Create(Self); tSQL_PropValRel.TableName := tnPropValRel; tSQL_PropValNormRes := TSQLMemTable.Create(Self); tSQL_PropValNormRes.TableName := tnPropValNormRes; tSQL_ObjectsBlobs := TSQLMemTable.Create(Self); tSQL_ObjectsBlobs.TableName := tnObjectsBlobs; end; tSQL_Katalog.Tag := tiKatalog; tSQL_CatalogRelation.Tag := tiCatalogRelation; tSQL_Component.Tag := tiComponent; tSQL_CatalogPropRelation.Tag := tiCatalogPropRelation; tSQL_ComponentRelation.Tag := tiComponentRelation; tSQL_CompPropRelation.Tag := tiCompPropRelation; tSQL_CableCanalConnectors.Tag := tiCableCanalConnectors; tSQL_ConnectedComponents.Tag := tiConnectedComponents; tSQL_InterfaceRelation.Tag := tiInterfaceRelation; tSQL_InterfOfInterfRelation.Tag := tiInterfOfInterfRelation; tSQL_PortInterfaceRelation.Tag := tiPortInterfaceRelation; tSQL_Norms.Tag := tiNorms; tSQL_NormResourceRel.Tag := tiNormResourceRel; tSQL_Resources.Tag := tiResources; //--- tSQL_Currency.Tag := tiCurrency; tSQL_ComponentTypes.Tag := tiComponentTypes; tSQL_CompTypePropRelation.Tag := tiCompTypePropRelation; tSQL_Interface.Tag := tiInterface; tSQL_InterfaceNorms.Tag := tiInterfaceNorms; tSQL_InterfaceAccordance.Tag := tiInterfaceAccordance; tSQL_NetType.Tag := tiNetType; tSQL_NBNorms.Tag := tiNBNorms; tSQL_ObjectIcons.Tag := tiObjectIcons; tSQL_Producers.Tag := tiProducers; tSQL_Properties.Tag := tiProperties; tSQL_NBResources.Tag := tiNBResources; tSQL_SuppliesKinds.Tag := tiSuppliesKinds; //-- tSQL_CADNormStruct.Tag := tiCADNormStruct; tSQL_CADNormColumn.Tag := tiCADNormColumn; tSQL_CADCrossObject.Tag := tiCADCrossObject; tSQL_CADCrossObjectElement.Tag := tiCADCrossObjectElement; //-- tSQL_InterfPosConnection.Tag := tiInterfPosConnection; tSQL_StringsMan.Tag := tiStringsMan; //-- tSQL_Filters.Tag := tiFilters; //-- tSQL_PropValRel.Tag := tiPropValRel; tSQL_PropValNormRes.Tag := tiPropValNormRes; //-- tSQL_ObjectsBlobs.Tag := tiObjectBlobs; FSQLMemTables.Add(tSQL_Katalog); FSQLMemTables.Add(tSQL_CatalogRelation); FSQLMemTables.Add(tSQL_Component); //FSQLMemTables.Add(tSQL_CatalogMarkMask); FSQLMemTables.Add(tSQL_CatalogPropRelation); FSQLMemTables.Add(tSQL_ComponentRelation); FSQLMemTables.Add(tSQL_CompPropRelation); FSQLMemTables.Add(tSQL_CableCanalConnectors); FSQLMemTables.Add(tSQL_ConnectedComponents); FSQLMemTables.Add(tSQL_InterfaceRelation); FSQLMemTables.Add(tSQL_InterfOfInterfRelation); FSQLMemTables.Add(tSQL_PortInterfaceRelation); FSQLMemTables.Add(tSQL_Norms); FSQLMemTables.Add(tSQL_NormResourceRel); FSQLMemTables.Add(tSQL_Resources); // справочники FSQLMemTables.Add(tSQL_Currency); FSQLMemTables.Add(tSQL_ComponentTypes); FSQLMemTables.Add(tSQL_CompTypePropRelation); FSQLMemTables.Add(tSQL_Interface); FSQLMemTables.Add(tSQL_InterfaceNorms); FSQLMemTables.Add(tSQL_InterfaceAccordance); FSQLMemTables.Add(tSQL_NetType); FSQLMemTables.Add(tSQL_NBNorms); FSQLMemTables.Add(tSQL_ObjectIcons); FSQLMemTables.Add(tSQL_Producers); FSQLMemTables.Add(tSQL_Properties); FSQLMemTables.Add(tSQL_NBResources); FSQLMemTables.Add(tSQL_SuppliesKinds); // Нормы КАДа FSQLMemTables.Add(tSQL_CADNormStruct); FSQLMemTables.Add(tSQL_CADNormColumn); // Кросс объекты FSQLMemTables.Add(tSQL_CADCrossObject); FSQLMemTables.Add(tSQL_CADCrossObjectElement); // Соединенные позиции интерфейсов FSQLMemTables.Add(tSQL_InterfPosConnection); // Менеджер строк FSQLMemTables.Add(tSQL_StringsMan); // Фильтра FSQLMemTables.Add(tSQL_Filters); FSQLMemTables.Add(tSQL_PropValRel); FSQLMemTables.Add(tSQL_PropValNormRes); FSQLMemTables.Add(tSQL_ObjectsBlobs); AddToSQLMemTables(tSQL_NormsComplete, tnNormsComplete, tiNormsComplete); //07.01.2014 if Not FMemBaseCreated then FMemBaseCreated := true; for i := 0 to FSQLMemTables.Count - 1 do begin CurrTable := TSQLMemTable(FSQLMemTables[i]); CurrTable.DisableControls; end; end; procedure TDM.CreateSQLMemTableByTagIdx(aTIdx: Integer); begin case aTIdx of tiNormsComplete: begin if Not tSQL_NormsComplete.Exists then begin if tSQL_NormsComplete.FieldDefs.Count = 0 then begin tSQL_NormsComplete.FieldDefs.Add(fnId, ftAutoInc); tSQL_NormsComplete.FieldDefs.Add(fnGuid, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnCYPHER, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnName, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnIzm, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnLaborTime, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnPricePerTime, ftFloat); tSQL_NormsComplete.FieldDefs.Add(fnPrice, ftFloat); tSQL_NormsComplete.FieldDefs.Add(fnCost, ftFloat); tSQL_NormsComplete.FieldDefs.Add(fnTotalCost, ftFloat); tSQL_NormsComplete.FieldDefs.Add(fnTotalLaborTime, ftInteger); //tSQL_NormsComplete.FieldDefs.Add(fnTotalLaborTimeOld, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnWorkersAmount, ftInteger); tSQL_NormsComplete.FieldDefs.Add(fnStartDate, ftDate); tSQL_NormsComplete.FieldDefs.Add(fnEndDate, ftDate); // Выполнение tSQL_NormsComplete.FieldDefs.Add(fnDone, ftSmallint); tSQL_NormsComplete.FieldDefs.Add(fnCompletePct, ftFloat); end; tSQL_NormsComplete.CreateTable; end; end; end; end; procedure TDM.FreeSQLMemTables; var i: Integer; SQLMemTable: TSQLMemTable; begin if FMemBaseCreated then begin try {FreeAndNil(tSQL_Katalog); FreeAndNil(tSQL_CatalogRelation); FreeAndNil(tSQL_Component); FreeAndNil(tSQL_CatalogPropRelation); FreeAndNil(tSQL_ComponentRelation); FreeAndNil(tSQL_CompPropRelation); FreeAndNil(tSQL_CableCanalConnectors); FreeAndNil(tSQL_ConnectedComponents); FreeAndNil(tSQL_InterfaceRelation); FreeAndNil(tSQL_InterfOfInterfRelation); FreeAndNil(tSQL_PortInterfaceRelation); FreeAndNil(tSQL_Norms); FreeAndNil(tSQL_NormResourceRel); FreeAndNil(tSQL_Resources); //--- FreeAndNil(tSQL_Currency); FreeAndNil(tSQL_ComponentTypes); FreeAndNil(tSQL_CompTypePropRelation); FreeAndNil(tSQL_Interface); FreeAndNil(tSQL_InterfaceNorms); FreeAndNil(tSQL_InterfaceAccordance); FreeAndNil(tSQL_NetType); FreeAndNil(tSQL_NBNorms); FreeAndNil(tSQL_ObjectIcons); FreeAndNil(tSQL_Producers); FreeAndNil(tSQL_Properties); FreeAndNil(tSQL_NBResources); FreeAndNil(tSQL_SuppliesKinds); //-- FreeAndNil(tSQL_CADNormStruct); FreeAndNil(tSQL_CADNormColumn); FreeAndNil(tSQL_CADCrossObject); FreeAndNil(tSQL_CADCrossObjectElement); //-- FreeAndNil(tSQL_InterfPosConnection); } for i := 0 to FSQLMemTables.Count - 1 do begin SQLMemTable := TSQLMemTable(FSQLMemTables[i]); try FreeAndNil(SQLMemTable); FSQLMemTables[i] := nil; except end; end; except on E: Exception do AddExceptionToLogEx('TDM.FreeSQLMemTables', E.Message); end; FSQLMemTables.Clear; FMemBaseCreated := false; end; end; procedure TDM.AddToSQLMemTables(var aTable: TSQLMemTable; const aTName: String; aTIdx: Integer); begin if Not FMemBaseCreated then aTable := TSQLMemTable.Create(Self); aTable.TableName := aTName; aTable.Tag := aTIdx; FSQLMemTables.Add(aTable); end; function TDM.GetBaseNow: TDateTime; begin Result := U_BaseCommon.GetBaseNow(Query_Select); {Result := 0; SetSQLToFIBQuery(Query_Select, 'select cast(''now'' as timestamp) as DatTim from '+tnRDBDatabase); Result := Query_Select.Fields[0].AsDateTime;} end; procedure TDM.DataModuleCreate(Sender: TObject); var i: integer; CurrTable: TSQLMemTable; begin FModifiedsCount := 0; FFibErrorHandler := nil; if Not ErrorHandlerRegistered then begin FFibErrorHandler := TpFibErrorHandler.Create(GForm); FFibErrorHandler.OnFIBErrorEvent := FFibErrorHandlerFIBErrorEvent; end; // Параметры подключения try ConnectParams.UserName := unSYSDBA; ConnectParams.Pass := upMasterKey; if TF_Main(GForm).GDBMode = bkNormBase then begin ConnectParams.UserName := GetStrFromRegistry(pnNBUser, unSYSDBA); ConnectParams.Pass := GetStrFromRegistry(pnNBPass, ''); end else if TF_Main(GForm).GDBMode = bkProjectManager then begin ConnectParams.UserName := GetStrFromRegistry(pnPMUser, unSYSDBA); ConnectParams.Pass := GetStrFromRegistry(pnPMPass, ''); end; if ConnectParams.Pass = '' then ConnectParams.Pass := upMasterKey else ConnectParams.Pass := XorStr(ConnectParams.Pass, $AA, true); except on E: Exception do AddExceptionToLogEx('TDM.DataModuleCreate "SetConnParamsToBase"', E.Message); end; //DataSet_OBJECT_ICONS.DataSource := DataSource_COMP_STATE_TYPE; //Query.ParamByName('').va //qSQLMQuery.ParamByName('').v //Query.ExecQuery. RemoveSystemColorsFromRepository(EditRepositoryColorComboBox); EditRepositoryCurrencyItemForFloat.Properties.DisplayFormat := GetDisplayFormatForFloat; EditRepositoryCurrencyItemForFloat.Properties.DecimalPlaces := FloatPrecision; SetCableChannelSectionMaskEditProps(EditRepositoryMaskItemSectionSide.Properties); FDelCADObjectEvent := DelCatalog; Database_SCS.ConnectParams.UserName := 'SYSDBA'; Database_SCS.ConnectParams.Password := 'masterkey'; Database_SCS.ConnectParams.CharSet :='WIN1251'; FSQLMemTables := TObjectList.Create(false); FMemBaseCreated := true; FMemBaseActive := false; FMemBaseLoaded := false; CreateSQLMemTables; if TF_Main(GForm).GDBMode = bkNormBase then begin FreeSQLMemTables; end; FCatInfoList := TObjectList.Create(true); FCatIDs := TIntList.Create; FCatParentIDs := TIntList.Create; FCatRelCatalogIDs := TIntList.Create; FCatRelComponIDs := TIntList.Create; FComponIDs := TIntList.Create; FComponIDProdusers := TIntList.Create; FComponIDNetTypes := TIntList.Create; FComponIDCompTypes := TIntList.Create; FComponCatalogsCanShowByFilter := TIntList.Create; FComponCatalogsNoShowByFilter := TIntList.Create; UsersInfoPM := TUsersInfo.Create; { tSQL_Katalog.DisableControls; tSQL_CatalogRelation.DisableControls; tSQL_Component.DisableControls; tSQL_CatalogMarkMask.DisableControls; tSQL_CatalogPropRelation.DisableControls; tSQL_ComponentRelation.DisableControls; tSQL_CompPropRelation.DisableControls; tSQL_CableCanalConnectors.DisableControls; tSQL_ConnectedComponents.DisableControls; tSQL_InterfaceRelation.DisableControls; tSQL_InterfOfInterfRelation.DisableControls; tSQL_PortInterfaceRelation.DisableControls; tSQL_Norms.DisableControls; tSQL_NormResourceRel.DisableControls; tSQL_Resources.DisableControls;} //tSQL_Katalog.FieldDefs.a //Query.SQL qSQL_Query.DisableControls; qSQL_Query1.DisableControls; qSQL_QueryOperat.DisableControls; qSQL_QuerySelect.DisableControls; qSQL_QueryTSCSSelect.DisableControls; qSQL_QueryTSCSOperat.DisableControls; scsQ := TSCSQuery.Create(GForm, Query, qSQL_Query); scsQ1 := TSCSQuery.Create(GForm, Query1, qSQL_Query1); scsQOperat := TSCSQuery.Create(GForm, Query_Operat, qSQL_QueryOperat); scsQSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); scsQTSCSSelect := TSCSQuery.Create(GForm, Query_TSCSSelect, qSQL_QueryTSCSSelect); scsQTSCSOperat := TSCSQuery.Create(GForm, Query_TSCSOperat, qSQL_QueryTSCSOperat); //DataSet_comp_type_prop_relation.RefreshSQL.Text := DataSet_comp_type_prop_relation.SelectSQL.Text; TimerStoreGuidToReserv := nil; case (GForm as TF_Main).GDBMode of bkProjectManager: begin {DataSet_CATALOG.SQLs.InsertSQL.Clear; DataSet_CATALOG.SQLs.InsertSQL.Add(' INSERT INTO KATALOG ( '+ ' ID, PARENT_ID, NAME, SORT_ID, KOL_COMPON, ID_ITEM_TYPE, SCS_ID)'+ 'VALUES (:ID, :PARENT_ID, :NAME, :SORT_ID, :KOL_COMPON, :ID_ITEM_TYPE, :SCS_ID)' ); } //MemTable_InterfaceRelEd.FieldDefs.Add('CoordZ', ftFloat); {DataSet_INTERFOFINTERF_RELATION.SQLs.SelectSQL.Clear; DataSet_INTERFOFINTERF_RELATION.SQLs.SelectSQL.Add( ' SELECT Interfofinterf_relation.ID, ID_INTERF_REL, ID_CON_COMPON, ID_CON_COMPL, ID_CON_IOFI, CON_POSITION, "POSITION", ISBUSY /*, Name */'+ ' FROM Interfofinterf_relation /*, Component */'+ ' WHERE (ID_INTERF_REL = :ID) /* and '+ ' ((isBUSY = 0) or ( (isBusy = 1) and '+ ' (Component.ID = ID_CON_COMPON ))) */' ); } end; bkNormBase: begin TimerStoreGuidToReserv := TTimer.Create(Self); TimerStoreGuidToReserv.Enabled := false; TimerStoreGuidToReserv.Interval := 10000; TimerStoreGuidToReserv.OnTimer := OnTimerStoreGuidToReserv; {DataSet_CATALOG.SQLs.InsertSQL.Clear; DataSet_CATALOG.SQLs.InsertSQL.Add(' INSERT INTO KATALOG ( '+ ' ID, PARENT_ID, NAME, SORT_ID, KOL_COMPON, ID_ITEM_TYPE)'+ 'VALUES (:ID, :PARENT_ID, :NAME, :SORT_ID, :KOL_COMPON, :ID_ITEM_TYPE)' ); } {DataSet_INTERFOFINTERF_RELATION.SQLs.SelectSQL.Clear; DataSet_INTERFOFINTERF_RELATION.SQLs.SelectSQL.Add( 'SELECT Interfofinterf_relation.ID, ID_INTERF_REL, ID_CON_COMPON, ID_CON_COMPL, ID_CON_IOFI, CON_POSITION, "POSITION", ISBUSY '+ 'FROM Interfofinterf_relation '+ 'WHERE (ID_INTERF_REL = :ID) /*and ' + ' (isBUSY = 0)*/ '); } end; end; // Типы условных обоначений MemTable_Comp_State_Type.FieldDefs.Add('ID', ftInteger); MemTable_Comp_State_Type.FieldDefs.Add('NAME', ftString, 255); MemTable_Comp_State_Type.Active := true; MemTable_Comp_State_Type.Append; MemTable_Comp_State_Type.FieldByName('ID').AsInteger := oitProjectible; MemTable_Comp_State_Type.FieldByName('NAME').AsString := cDM_Msg1; MemTable_Comp_State_Type.Post; MemTable_Comp_State_Type.Append; MemTable_Comp_State_Type.FieldByName('ID').AsInteger := oitActive; MemTable_Comp_State_Type.FieldByName('NAME').AsString := cDM_Msg2; MemTable_Comp_State_Type.Post; EditRepositoryLookupCompSateType.Properties.ListSource := DataSource_MT_comp_state_type; //if TF_Main(GForm).GDBMode = bkNormBase then // EditRepositoryLookupCompSateType.Properties.ListSource := DataSource_COMP_STATE_TYPE //else // EditRepositoryLookupCompSateType.Properties.ListSource := F_NormBase.DM.DataSource_COMP_STATE_TYPE; // Типы элементов кабельных каналов mtCableCanalElementType.FieldDefs.Add(fnID, ftInteger); mtCableCanalElementType.FieldDefs.Add(fnName, ftString, 255); mtCableCanalElementType.Active := true; AppendIDNameToMemTable(contCork, ctnCork, mtCableCanalElementType); AppendIDNameToMemTable(contAnglePlane, ctnAnglePlane, mtCableCanalElementType); AppendIDNameToMemTable(contTjoin, ctnTjoin, mtCableCanalElementType); AppendIDNameToMemTable(contAngleIn, ctnAngleIn, mtCableCanalElementType); AppendIDNameToMemTable(contAngleOut, ctnAngleOut, mtCableCanalElementType); AppendIDNameToMemTable(contADapter, ctnADapter, mtCableCanalElementType); AppendIDNameToMemTable(contConnector, ctnConnector, mtCableCanalElementType); AppendIDNameToMemTable(contWallCork, ctnWallCork, mtCableCanalElementType); AppendIDNameToMemTable(contCross, ctnCross, mtCableCanalElementType); EditRepositoryLookupCableCanalElementType.Properties.KeyFieldNames := fnID; EditRepositoryLookupCableCanalElementType.Properties.ListFieldNames := fnName; EditRepositoryLookupCableCanalElementType.Properties.ListSource := dsrcCableCanalElementType; //EditRepositoryImageComboBoxTubeConnectKind.Properties.Items.Add. //AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckHubOfPipe, -1, tcknHubOfPipe); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckCapillarySoldering, -1, tcknCapillarySoldering); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckMechanicalCompressive, -1, tcknMechanicalCompressive); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckMechanicalPress, -1, tcknMechanicalPress); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckMechanicalTread, -1, tcknMechanicalTread); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckPress, -1, tcknPress); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckWeldingConnection, -1, tcknWeldingConnection); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckWeldingButt, -1, tcknWeldingButt); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckWeldHubOfPipe, -1, tcknWeldHubOfPipe); AppendItemToRepositoryImageComboBox(EditRepositoryImageComboBoxTubeConnectKind, tckWeldElectric, -1, tcknWeldElectric); MemTable_Complects.FieldDefs.Add('id', ftInteger); MemTable_Complects.FieldDefs.Add('id_component', ftInteger); MemTable_Complects.FieldDefs.Add('id_child', ftInteger); MemTable_Complects.FieldDefs.Add('name', ftString, 255); MemTable_Complects.FieldDefs.Add('kolvo', ftInteger); MemTable_Complects.FieldDefs.Add('price1', ftString, 50); MemTable_Complects.FieldDefs.Add('cost1', ftString, 50); MemTable_Complects.FieldDefs.Add('price2', ftString, 50); MemTable_Complects.FieldDefs.Add('cost2', ftString, 50); MemTable_Complects.FieldDefs.Add(fnisModified, ftBoolean); MemTable_Complects.FieldDefs.Add(fnisNew, ftBoolean); for i := 0 to MemTable_Complects.FieldDefs.Count - 1 do MemTable_ComplectsEd.FieldDefs.Add(MemTable_Complects.FieldDefs[i].Name, MemTable_Complects.FieldDefs[i].DataType, MemTable_Complects.FieldDefs[i].Size); { MemTable_ComplectsEd.FieldDefs.Add('id', ftInteger); MemTable_ComplectsEd.FieldDefs.Add('id_component', ftInteger); MemTable_ComplectsEd.FieldDefs.Add('id_child', ftInteger); MemTable_ComplectsEd.FieldDefs.Add('name', ftString, 255); MemTable_ComplectsEd.FieldDefs.Add('kolvo', ftInteger); MemTable_ComplectsEd.FieldDefs.Add('price1', ftString, 50); MemTable_ComplectsEd.FieldDefs.Add('cost1', ftString, 50); MemTable_ComplectsEd.FieldDefs.Add('price2', ftString, 50); MemTable_ComplectsEd.FieldDefs.Add('cost2', ftString, 50); MemTable_ComplectsEd.FieldDefs.Add('isModified', ftBoolean); MemTable_ComplectsEd.FieldDefs.Add('isNew', ftBoolean); } //*** Загрузить поля таблици соединений компоненты MemTable_Connections.FieldDefs.Add(fnID, ftInteger); MemTable_Connections.FieldDefs.Add(fnIDComponent, ftInteger); MemTable_Connections.FieldDefs.Add(fnIDChild, ftInteger); MemTable_Connections.FieldDefs.Add(fnIDJoined, ftInteger); MemTable_Connections.FieldDefs.Add(fnIDCompRelFrom, ftInteger); MemTable_Connections.FieldDefs.Add(fnIDCompRelTo, ftInteger); MemTable_Connections.FieldDefs.Add(fnName, ftString, 255); MemTable_Connections.FieldDefs.Add(fnIsNative, ftBoolean); MemTable_Connections.FieldDefs.Add(fnRelType, ftInteger); MemTable_Connections.FieldDefs.Add(fnFixed, ftInteger); MemTable_InterfaceRel.FieldDefs.Clear; MemTable_InterfaceRel.FieldDefs.Add('ID', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('ID_COMPONENT', ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnGuidInterface, ftString, 40); MemTable_InterfaceRel.FieldDefs.Add('ID_INTERFACE', ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnNpp, ftInteger); MemTable_InterfaceRel.FieldDefs.Add('NAME', ftString, 255); MemTable_InterfaceRel.FieldDefs.Add('TYPEI', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('Kind', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('IsPort', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('GENDER', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('Multiple', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('IsNative', ftBoolean); MemTable_InterfaceRel.FieldDefs.Add('IsBusy', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('ValueI', ftFloat); MemTable_InterfaceRel.FieldDefs.Add('SORT_ID', ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnNumPair, ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnNumPairsStr, ftString, 20); MemTable_InterfaceRel.FieldDefs.Add('COLOR', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('ID_ADVERSE', ftInteger); MemTable_InterfaceRel.FieldDefs.Add('SIDE', ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnNotice, ftString, 255); MemTable_InterfaceRel.FieldDefs.Add(fnKolvo, ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnKolvoBusy, ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnSignType, ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnConnToAnyGender, ftInteger); MemTable_InterfaceRel.FieldDefs.Add(fnSideSection, ftString, 200); if TF_MAIN(GForm).GDBMode = bkProjectManager then MemTable_InterfaceRel.FieldDefs.Add('CoordZ', ftFloat); MemTable_InterfaceRel.FieldDefs.Add('IsModified', ftBoolean); MemTable_InterfaceRel.FieldDefs.Add('IsNew', ftBoolean); for i := 0 to MemTable_InterfaceRel.FieldDefs.Count - 1 do MemTable_InterfaceRelEd.FieldDefs.Add(MemTable_InterfaceRel.FieldDefs[i].Name, MemTable_InterfaceRel.FieldDefs[i].DataType, MemTable_InterfaceRel.FieldDefs[i].Size); //MemTable_InterfaceRelEd.FieldDefs.Add('IsModified', ftBoolean); //MemTable_InterfaceRelEd.FieldDefs.Add('IsNew', ftBoolean); MemTable_Port.FieldDefs.Clear; MemTable_Port.FieldDefs.Add('ID', ftInteger); MemTable_Port.FieldDefs.Add('ID_COMPONENT', ftInteger); MemTable_Port.FieldDefs.Add('ID_INTERFACE', ftInteger); MemTable_Port.FieldDefs.Add(fnGuidInterface, ftString, 40); MemTable_Port.FieldDefs.Add(fnNpp, ftInteger); MemTable_Port.FieldDefs.Add(fnName, ftString, 255); MemTable_Port.FieldDefs.Add(fnInterfRelNames, ftString, 255); MemTable_Port.FieldDefs.Add(fnNameConnectCable, ftString, 255); MemTable_Port.FieldDefs.Add('TYPEI', ftInteger); MemTable_Port.FieldDefs.Add('Kind', ftInteger); MemTable_Port.FieldDefs.Add('IsPort', ftInteger); MemTable_Port.FieldDefs.Add('IsUser_Port', ftInteger); MemTable_Port.FieldDefs.Add('npp_Port', ftInteger); MemTable_Port.FieldDefs.Add('GENDER', ftInteger); MemTable_Port.FieldDefs.Add('Multiple', ftInteger); MemTable_Port.FieldDefs.Add('IsNative', ftBoolean); MemTable_Port.FieldDefs.Add('IsBusy', ftInteger); //MemTable_Port.FieldDefs.Add('ValueI', ftFloat); MemTable_Port.FieldDefs.Add('SORT_ID', ftInteger); //MemTable_Port.FieldDefs.Add('NUM_PAIR', ftInteger); MemTable_Port.FieldDefs.Add('COLOR', ftInteger); //MemTable_Port.FieldDefs.Add('ID_ADVERSE', ftInteger); //MemTable_Port.FieldDefs.Add('SIDE', ftInteger); MemTable_Port.FieldDefs.Add(fnNotice, ftString, 255); MemTable_Port.FieldDefs.Add(fnKolvo, ftInteger); MemTable_Port.FieldDefs.Add(fnKolvoBusy, ftInteger); MemTable_Port.FieldDefs.Add(fnSignType, ftInteger); MemTable_Port.FieldDefs.Add(fnConnToAnyGender, ftInteger); MemTable_Port.FieldDefs.Add(fnSideSection, ftString, 200); if TF_MAIN(GForm).GDBMode = bkProjectManager then begin MemTable_Port.FieldDefs.Add('ID_Connected', ftInteger); MemTable_Port.FieldDefs.Add('Name_Connected', ftString, 255); MemTable_Port.FieldDefs.Add('CoordZ', ftFloat); end; MemTable_Port.FieldDefs.Add('IsModified', ftBoolean); MemTable_Port.FieldDefs.Add('IsNew', ftBoolean); for i := 0 to MemTable_Port.FieldDefs.Count - 1 do MemTable_PortEd.FieldDefs.Add(MemTable_Port.FieldDefs[i].Name, MemTable_Port.FieldDefs[i].DataType, MemTable_Port.FieldDefs[i].Size); //MemTable_PortEd.FieldDefs.Add('IsModified', ftBoolean); //MemTable_PortEd.FieldDefs.Add('IsNew', ftBoolean); MemTable_IOFI_REL.FieldDefs.Add('id', ftInteger); MemTable_IOFI_REL.FieldDefs.Add('id_interf_rel', ftInteger); MemTable_IOFI_REL.FieldDefs.Add('con_position', ftInteger); MemTable_IOFI_REL.FieldDefs.Add('id_interf_to', ftInteger); MemTable_IOFI_REL.FieldDefs.Add('id_comp_rel', ftInteger); MemTable_IOFI_REL.FieldDefs.Add('name', ftString, 255); MemTable_InterfOfInterf_RelEd.FieldDefs.Add(fnId, ftInteger); MemTable_InterfOfInterf_RelEd.FieldDefs.Add(fnIDInterfRel, ftInteger); MemTable_InterfOfInterf_RelEd.FieldDefs.Add('con_position', ftInteger); MemTable_InterfOfInterf_RelEd.FieldDefs.Add(fnIDInterfTo, ftInteger); MemTable_InterfOfInterf_RelEd.FieldDefs.Add(fnIDCompRel, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnID, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnIDPort, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnIDInterfRel, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnRelType, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnName, ftString, 255); MemTable_PortInterfRel.FieldDefs.Add(fnGender, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnUnitInterfKolvo, ftInteger); MemTable_PortInterfRel.FieldDefs.Add(fnIsModified, ftBoolean); MemTable_PortInterfRel.FieldDefs.Add(fnIsNew, ftBoolean); for i := 0 to MemTable_PortInterfRel.FieldDefs.Count - 1 do MemTable_PortInterfRelEd.FieldDefs.Add(MemTable_PortInterfRel.FieldDefs[i].Name, MemTable_PortInterfRel.FieldDefs[i].DataType, MemTable_PortInterfRel.FieldDefs[i].Size); MemTable_PortInterfRel.MasterSource := DataSource_MT_Port; MemTable_PortInterfRel.MasterFields := fnID; MemTable_PortInterfRel.DetailFields := fnIDPort; MemTable_PortInterfRelEd.MasterSource := DataSource_MT_PortEd; MemTable_PortInterfRelEd.MasterFields := fnID; MemTable_PortInterfRelEd.DetailFields := fnIDPort; //*** Внутреннее подключение инетрфейсов for i := 0 to MemTable_PortInterfRel.FieldDefs.Count - 1 do begin mtInterfInternalConn.FieldDefs.Add(MemTable_PortInterfRel.FieldDefs[i].Name, MemTable_PortInterfRel.FieldDefs[i].DataType, MemTable_PortInterfRel.FieldDefs[i].Size); mtInterfInternalConnEd.FieldDefs.Add(MemTable_PortInterfRel.FieldDefs[i].Name, MemTable_PortInterfRel.FieldDefs[i].DataType, MemTable_PortInterfRel.FieldDefs[i].Size); end; MemTable_Property.FieldDefs.Add(fnID, ftInteger); MemTable_Property.FieldDefs.Add(fnIDMaster, ftInteger); MemTable_Property.FieldDefs.Add(fnGuidProperty, ftString, 40); MemTable_Property.FieldDefs.Add(fnIDProperty, ftInteger); MemTable_Property.FieldDefs.Add(fnTakeIntoConnect, ftInteger); MemTable_Property.FieldDefs.Add(fnTakeIntoJoin, ftInteger); MemTable_Property.FieldDefs.Add(fnIDDataType, ftInteger); MemTable_Property.FieldDefs.Add(fnName, ftString, 255); MemTable_Property.FieldDefs.Add(fnSysName, ftString, 255); MemTable_Property.FieldDefs.Add(fnPValue, ftString, 255); MemTable_Property.FieldDefs.Add(fnIzm, ftString, 20); MemTable_Property.FieldDefs.Add(fnDescription, ftString, 255); MemTable_Property.FieldDefs.Add(fnisStandart, ftInteger); MemTable_Property.FieldDefs.Add(fnIsTakeJoinForPoints, ftInteger); MemTable_Property.FieldDefs.Add(fnIsCrossControl, ftInteger); MemTable_Property.FieldDefs.Add(fnGuidCrossProperty, ftString, 40); MemTable_Property.FieldDefs.Add(fnIDCrossProperty, ftInteger); MemTable_Property.FieldDefs.Add(fnIsForWholeComponent, ftInteger); MemTable_Property.FieldDefs.Add(fnIsDefault, ftInteger); MemTable_Property.FieldDefs.Add(fnisModified, ftBoolean); MemTable_Property.FieldDefs.Add(fnisNew, ftBoolean); for i := 0 to MemTable_Property.FieldDefs.Count - 1 do MemTable_PropertyEd.FieldDefs.Add(MemTable_Property.FieldDefs[i].Name, MemTable_Property.FieldDefs[i].DataType, MemTable_Property.FieldDefs[i].Size); { MemTable_PropertyEd.FieldDefs.Add('id', ftInteger); MemTable_PropertyEd.FieldDefs.Add('id_property', ftInteger); MemTable_PropertyEd.FieldDefs.Add('take_into_connect', ftInteger); MemTable_PropertyEd.FieldDefs.Add('take_into_join', ftInteger); MemTable_PropertyEd.FieldDefs.Add('id_data_type', ftInteger); MemTable_PropertyEd.FieldDefs.Add('name', ftString, 255); MemTable_PropertyEd.FieldDefs.Add('SysName', ftString, 255); MemTable_PropertyEd.FieldDefs.Add('PValue', ftString, 255); MemTable_PropertyEd.FieldDefs.Add('Izm', ftString, 20); MemTable_PropertyEd.FieldDefs.Add('Description', ftString, 255); MemTable_PropertyEd.FieldDefs.Add('isStandart', ftInteger); MemTable_PropertyEd.FieldDefs.Add('isModified', ftBoolean); MemTable_PropertyEd.FieldDefs.Add('isNew', ftBoolean); MemTable_PropertyEd.FieldDefs.Add(fnIsDefault, ftInteger); } //*** Соединители кабельных каналов mtCableCanalConnectors.FieldDefs.Add(fnID, ftInteger); mtCableCanalConnectors.FieldDefs.Add(fnIDComponent, ftInteger); mtCableCanalConnectors.FieldDefs.Add(fnIDNBConnector, ftInteger); mtCableCanalConnectors.FieldDefs.Add(fnGuidNBConnector, ftString, 40); mtCableCanalConnectors.FieldDefs.Add(fnConnectorType, ftInteger); mtCableCanalConnectors.FieldDefs.Add(fnName, ftString, 255); // Connector Name MemTable_CableCanalConnectorsEd.FieldDefs.Assign(mtCableCanalConnectors.FieldDefs); MemTable_CableCanalConnectorsEd.FieldDefs.Add(fnIsModified, ftBoolean); MemTable_CableCanalConnectorsEd.FieldDefs.Add(fnIsNew, ftBoolean); //*** Кросс-соединения MemTable_CrossConnection.FieldDefs.Add(fnID, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDComponent, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDComponFrom, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDComponTo, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDComponWith, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDCompRelFrom, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDCompRelTo, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnIDCompRelWith, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnNameFrom, ftString, 255); MemTable_CrossConnection.FieldDefs.Add(fnNameTo, ftString, 255); MemTable_CrossConnection.FieldDefs.Add(fnNameWith, ftString, 255); MemTable_CrossConnection.FieldDefs.Add(fnNppFrom, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnNppTo, ftInteger); MemTable_CrossConnection.FieldDefs.Add(fnNppWith, ftInteger); mtCrossConnectionEd.FieldDefs.Assign(MemTable_CrossConnection.FieldDefs); mtCrossConnectionEd.FieldDefs.Add(fnIsNew, ftBoolean); mtCrossConnectionEd.FieldDefs.Add(fnIsModified, ftBoolean); mtObjectCurrency.FieldDefs.Add(fnID, ftInteger); mtObjectCurrency.FieldDefs.Add(fnGUID, ftString, 40); mtObjectCurrency.FieldDefs.Add(fnIDCurrency, ftInteger); mtObjectCurrency.FieldDefs.Add(fnIDCatalog, ftInteger); mtObjectCurrency.FieldDefs.Add(fnName, ftString, 255); mtObjectCurrency.FieldDefs.Add(fnNameBrief, ftString, 200); mtObjectCurrency.FieldDefs.Add(fnKolvo, ftInteger); mtObjectCurrency.FieldDefs.Add(fnRatio, ftFloat); mtObjectCurrency.FieldDefs.Add(fnMain, ftInteger); //*** Загрузить поля таблици норм для компонентов и SCS объектов mtNorms.FieldDefs.Add('ID', ftAutoInc); mtNorms.FieldDefs.Add('ID_Master', ftInteger); mtNorms.FieldDefs.Add('Table_Kind', ftInteger); mtNorms.FieldDefs.Add('NPP', ftInteger); mtNorms.FieldDefs.Add('ID_Resource', ftInteger); mtNorms.FieldDefs.Add('ID_NB', ftInteger); mtNorms.FieldDefs.Add(fnIDCompPropRel, ftInteger); mtNorms.FieldDefs.Add(fnGuidNB, ftString, 40); mtNorms.FieldDefs.Add('Table_Kind_NB', ftInteger); mtNorms.FieldDefs.Add('ISON', ftInteger); mtNorms.FieldDefs.Add('KOLVO', ftFloat); mtNorms.FieldDefs.Add('Total_Cost', ftFloat); mtNorms.FieldDefs.Add(fnTotalKolvo, ftFloat); mtNorms.FieldDefs.Add('Cypher', ftString, 255); mtNorms.FieldDefs.Add('Name', ftString, 255); mtNorms.FieldDefs.Add('Work_Kind', ftString, 255); mtNorms.FieldDefs.Add('Izm', ftString, 255); mtNorms.FieldDefs.Add(fnLaborTime, ftInteger); mtNorms.FieldDefs.Add(fnPricePerTime, ftFloat); mtNorms.FieldDefs.Add(fnPrice, ftFloat); mtNorms.FieldDefs.Add('Cost', ftFloat); mtNorms.FieldDefs.Add(fnExpenseForLength, ftFloat); mtNorms.FieldDefs.Add(fnGuidNBComponent, ftString, 40); mtNorms.FieldDefs.Add(fnIDNBComponent, ftInteger); mtNorms.FieldDefs.Add(fnCountForPoint, ftFloat); mtNorms.FieldDefs.Add(fnStepOfPoint, ftFloat); mtNorms.FieldDefs.Add(fnIsFromInterface, ftInteger); mtNorms.FieldDefs.Add(fnAdditionalPrice, ftFloat); mtNorms.FieldDefs.Add('Zarplat', ftFloat); mtNorms.FieldDefs.Add('RType', ftInteger); mtNorms.FieldDefs.Add(fnIsResource, ftBoolean); mtNorms.FieldDefs.Add(fnObjectAddress, ftInteger); mtNorms.FieldDefs.Add('IsModified', ftBoolean); mtNorms.FieldDefs.Add('IsNew', ftBoolean); // Tolik mtNorms.FieldDefs.Add('GuidInterface', ftString, 255); mtNorms.FieldDefs.Add('tmp', ftBoolean); // for i := 0 to mtNorms.FieldDefs.Count - 1 do MemTable_NormsEd.FieldDefs.Add(mtNorms.FieldDefs[i].Name, mtNorms.FieldDefs[i].DataType, mtNorms.FieldDefs[i].Size); //*** Загрузить поля таблици ресурсов MemTable_ResourcesRelEd.FieldDefs.Add('ID', ftAutoInc); MemTable_ResourcesRelEd.FieldDefs.Add('ID_Master', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('Table_Kind', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('NPP', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('ID_Resource', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('ID_NB', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add(fnGuidNB, ftString, 40); MemTable_ResourcesRelEd.FieldDefs.Add('Table_Kind_NB', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('Kolvo', ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add('COST', ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add(fnExpenseForLength, ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add(fnGuidNBComponent, ftString, 40); MemTable_ResourcesRelEd.FieldDefs.Add(fnCountForPoint, ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add(fnStepOfPoint, ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add('ison', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('Cypher', ftString, 255); MemTable_ResourcesRelEd.FieldDefs.Add('Name', ftString, 255); MemTable_ResourcesRelEd.FieldDefs.Add('Izm', ftString, 255); MemTable_ResourcesRelEd.FieldDefs.Add('PRICE', ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add(fnAdditionalPrice, ftFloat); MemTable_ResourcesRelEd.FieldDefs.Add('RType', ftInteger); MemTable_ResourcesRelEd.FieldDefs.Add('IsModified', ftBoolean); MemTable_ResourcesRelEd.FieldDefs.Add('IsNew', ftBoolean); //*** Связывание таблиц MemTable_NormsEd и MemTable_ResourcesRelEd MemTable_ResourcesRelEd.MasterSource := DataSource_MT_NormsEd; MemTable_ResourcesRelEd.MasterFields := 'ID'; MemTable_ResourcesRelEd.DetailFields := 'ID_MASTER'; //MemTable_ResourcesRelEd.MasterSource := DataSource_MT_NormRel; {MemTable_ComponentIcons.FieldDefs.Add('ID', ftInteger); MemTable_ComponentIcons.FieldDefs.Add('ID_Object_Icon', ftInteger); MemTable_ComponentIcons.FieldDefs.Add('Name', ftString, 255); MemTable_ComponentIcons.FieldDefs.Add('Icon', ftBlob); MemTable_ComponentIcons.FieldDefs.Add('isModified', ftBoolean); } MemTable_CatalogMarkMask.Active := false; MemTable_CatalogMarkMask.FieldDefs.Add('ID', ftInteger); MemTable_CatalogMarkMask.FieldDefs.Add('ID_Catalog', ftInteger); MemTable_CatalogMarkMask.FieldDefs.Add('ID_Component_Type', ftInteger); MemTable_CatalogMarkMask.FieldDefs.Add('Comp_Type_Name', ftString, 255); MemTable_CatalogMarkMask.FieldDefs.Add('MARK_MASK', ftString, 200); MemTable_CatalogMarkMask.FieldDefs.Add('isModified', ftBoolean); MemTable_CatalogMarkMask.FieldDefs.Add('isNew', ftBoolean); end; procedure TDM.DataModuleDestroy(Sender: TObject); begin DeactiveDataSets(Self); FreeAndNil(FCatInfoList); FreeAndNil(FCatIDs); FreeAndNil(FCatParentIDs); FreeAndNil(FCatRelCatalogIDs); FreeAndNil(FCatRelComponIDs); FreeAndNil(FComponIDs); FreeAndNil(FComponIDProdusers); FreeAndNil(FComponIDNetTypes); FreeAndNil(FComponIDCompTypes); FreeAndNil(FComponCatalogsCanShowByFilter); FreeAndNil(FComponCatalogsNoShowByFilter); FreeAndNil(FSQLMemTables); FreeAndNil(UsersInfoPM); //if TF_Main(GForm).GDBMode = bkNormBase then // ExitProcess(0); end; function TDM.CanShowCatalogByFilter(ACatalogID: Integer; AFilterParams: TFilterParams; ALookedComponCount: PInteger=nil): Boolean; var ParentID: Integer; FLoockedComponCount: integer; CatalogComponIDs: TIntList; DefinedResult: Boolean; CatalogInfo: TCatalogInfo; { function CanShowCatalogByFilterStep(ACatalogCurrID: Integer): Boolean; var i: integer; IndexOfItem: Integer; FindedForI: Boolean; begin Result := false; //*** Пролбежаться по компонентам этой папки CatalogComponIDs.Clear; FindedForI := false; for i := 0 to FCatRelCatalogIDs.Count - 1 do begin if FCatRelCatalogIDs[i] = ACatalogCurrID then begin FindedForI := true; CatalogComponIDs.Add(FCatRelComponIDs[i]); if CanShowComponByFilter(FCatRelComponIDs[i], AFilterParams, FLoockedComponCount=0) then begin Result := true; Break; //// BREAK //// end; Inc(FLoockedComponCount); end else if FindedForI then Break; //// BREAK //// end; //if CanShowOneComponFromListByFilter(CatalogComponIDs, AFilterBlock, FLoockedComponCount=0) then // Result := true; //FLoockedComponCount := FLoockedComponCount + CatalogComponIDs.Count; //if CanShowOneComponFromListByFilter(ACatalogCurrID, AFilterBlock, FLoockedComponCount=0) then // Result := true; //Inc(FLoockedComponCount); if Not Result then begin // пробежаться по подпапкам FindedForI := false; for i := 0 to FCatParentIDs.Count - 1 do begin if FCatParentIDs[i] = ACatalogCurrID then begin FindedForI := true; if CanShowCatalogByFilterStep(FCatIDs[i]) then begin Result := true; Break; //// BREAK //// end; end else if FindedForI then Break; //// BREAK //// end; end; end; } function CanShowCatalogByFilterStep(ACatalogCurrInfo: TCatalogInfo): Boolean; var i: integer; IndexOfItem: Integer; FindedForI: Boolean; CatInfo: TCatalogInfo; begin Result := false; //*** Пролбежаться по компонентам этой папки CatalogComponIDs.Clear; //CatInfo := GetCatalogInfoByID(ACatalogCurrID); CatInfo := ACatalogCurrInfo; if CatInfo <> nil then for i := 0 to CatInfo.ComponCount - 1 do begin CatalogComponIDs.Add(CatInfo.ComponIDs[i]); if CanShowComponByFilter(CatInfo.ComponIDs[i], AFilterParams, FLoockedComponCount=0) then begin Result := true; Break; //// BREAK //// end; Inc(FLoockedComponCount); end; //if CanShowOneComponFromListByFilter(CatalogComponIDs, AFilterBlock, FLoockedComponCount=0) then // Result := true; //FLoockedComponCount := FLoockedComponCount + CatalogComponIDs.Count; //if CanShowOneComponFromListByFilter(ACatalogCurrID, AFilterBlock, FLoockedComponCount=0) then // Result := true; //Inc(FLoockedComponCount); if Not Result then begin // пробежаться по подпапкам for i := 0 to FCatInfoList.Count - 1 do begin if TCatalogInfo(FCatInfoList[i]).ParentID = ACatalogCurrInfo.ID then if CanShowCatalogByFilterStep(TCatalogInfo(FCatInfoList[i])) then begin Result := true; Break; //// BREAK //// end; end; {// пробежаться по подпапкам FindedForI := false; for i := 0 to FCatParentIDs.Count - 1 do begin if FCatParentIDs[i] = ACatalogCurrID then begin FindedForI := true; if CanShowCatalogByFilterStep(FCatIDs[i]) then begin Result := true; Break; //// BREAK //// end; end else if FindedForI then Break; //// BREAK //// end;} end; if FComponIDs.Count > 0 then begin if Result then FComponCatalogsCanShowByFilter.Add(ACatalogCurrInfo.ID) else FComponCatalogsNoShowByFilter.Add(ACatalogCurrInfo.ID); end; end; begin Result := false; if TF_Main(GForm).GDBMode = bkProjectManager then Result := true else if TF_Main(GForm).GDBMode = bkNormBase then begin //ParentID := GetCatalogParentIDFromLists(ACatalogID); //if {(ParentID = 0) or} (AFilterBlock = nil) or Not(AFilterBlock.IsOn) then if Not AFilterParams.IsUseFilter then Result := true else begin DefinedResult := false; if FComponIDs.Count > 0 then begin if FComponCatalogsCanShowByFilter.IndexOf(ACatalogID) <> -1 then begin Result := true; DefinedResult := true; end else if FComponCatalogsNoShowByFilter.IndexOf(ACatalogID) <> -1 then begin Result := false; DefinedResult := true; end; end; if Not DefinedResult then begin FLoockedComponCount := 0; if ALookedComponCount <> nil then FLoockedComponCount := ALookedComponCount^; CatalogInfo := GetCatalogInfoByID(ACatalogID); if CatalogInfo <> nil then begin CatalogComponIDs := TIntList.Create; Result := CanShowCatalogByFilterStep(CatalogInfo); FreeAndNil(CatalogComponIDs); end; if ALookedComponCount <> nil then ALookedComponCount^ := FLoockedComponCount; end; end; end; end; function TDM.CanShowComponByFilter(AIDComponent: Integer; AFilterParams: TFilterParams; ALoadSQL: Boolean): Boolean; var IDComponentType: Integer; IDProducer: Integer; IDNetType: Integer; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; ChildFilterBlock: TFilterBlock; i: Integer; FieldNames: TStringList; IndexOfCompon: Integer; FindedComponData: Boolean; begin Result := false; if Not AFilterParams.IsUseFilter then Result := true else case AFilterParams.FFilterType of fltNone: Result := true; fltCustom: if (AFilterParams.FFilterBlock = nil) or Not(AFilterParams.FFilterBlock.IsOn) then Result := true else begin IDComponentType := 0; IDProducer := 0; IDNetType := 0; FindedComponData := false; if FComponIDs.Count > 0 then begin //IndexOfCompon := FComponIDs.IndexOf(AIDComponent); IndexOfCompon := GetValueIndexFromSortedIntList(AIDComponent, FComponIDs); if IndexOfCompon <> -1 then begin FindedComponData := true; IDComponentType := FComponIDCompTypes[IndexOfCompon]; IDProducer := FComponIDProdusers[IndexOfCompon]; IDNetType := FComponIDNetTypes[IndexOfCompon]; //if GetValueIndexFromSortedIntList(AIDComponent, FComponIDs) = -1 then // GetValueIndexFromSortedIntList(AIDComponent, FComponIDs); end; end; if (Not FindedComponData) and (FComponIDs.Count=0) then begin Query_Select.Close; if ALoadSQL then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDComponentType); FieldNames.Add(fnIDProducer); FieldNames.Add(fnIDNetType); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, FieldNames, ''), false); FreeAndNil(FieldNames); end; Query_Select.Params[0].AsInteger := AIDComponent; Query_Select.ExecQuery; //IDComponentType := Query_Select.FN(fnIDComponentType).AsInteger; //IDProducer := Query_Select.FN(fnIDProducer).AsInteger; //IDNetType := Query_Select.FN(fnIDNetType).AsInteger; IDComponentType := Query_Select.Fields[0].AsInteger; IDProducer := Query_Select.Fields[1].AsInteger; IDNetType := Query_Select.Fields[2].AsInteger; FindedComponData := true; end; if FindedComponData then begin //*** Заполнить фильтр данными компоненты for i := 0 to AFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterParams.FFilterBlock.AllChildBlocks[i]; if (ChildFilterBlock.Condition <> nil) and (ChildFilterBlock.CheckIsOnUp) then begin SprComponentType := nil; SprNetType := nil; SprProducer := nil; case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin if SprComponentType = nil then SprComponentType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetComponentTypeObjByID(IDComponentType); if SprComponentType <> nil then ChildFilterBlock.Condition.FieldValue := SprComponentType.ComponentType.GUID; end; fiGuidProducer: begin if SprProducer = nil then SprProducer := TF_Main(GForm).GSCSBase.NBSpravochnik.GetProducerByID(IDProducer); if SprProducer <> nil then ChildFilterBlock.Condition.FieldValue := SprProducer.GUID; end; fiGuidNetType: begin if SprNetType = nil then SprNetType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetNetTypeByID(IDNetType); if SprNetType <> nil then ChildFilterBlock.Condition.FieldValue := SprNetType.GUID; end; end; end; end; Result := AFilterParams.FFilterBlock.Execute; end; end; fltTop, fltFavorites: begin if FComponIDs.IndexOf(AIDComponent) <> -1 then Result := true; end; end end; function TDM.CanShowOneComponFromListByFilter(AComponIDs: TIntList; {ACatalogID: Integer; }AFilterBlock: TFilterBlock; ALoadSQL: Boolean): Boolean; var IDComponentType: Integer; IDProducer: Integer; IDNetType: Integer; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; ChildFilterBlock: TFilterBlock; i: Integer; SQLCondition: string; FieldNames: TStringList; begin Result := false; if (AFilterBlock = nil) or Not(AFilterBlock.IsOn) then Result := true else if AComponIDs.Count > 0 then begin //SQLCondition := fnID+' in ('; // for i := 0 to AComponIDs.Count - 1 do // begin // if i <> 0 then // SQLCondition := SQLCondition + ', '; // SQLCondition := SQLCondition + IntToStr(AComponIDs[i]); // end; // SQLCondition := SQLCondition + ')'; //FieldNames := TStringList.Create; // FieldNames.Add(fnIDComponentType); // FieldNames.Add(fnIDProducer); // FieldNames.Add(fnIDNetType); // SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, SQLCondition, FieldNames, '')); // FreeAndNil(FieldNames); // Query_Select.ExecQuery; SQLCondition := ''; for i := 0 to AComponIDs.Count - 1 do begin if i = 0 then SQLCondition := SQLCondition + '~'; SQLCondition := SQLCondition + IntToStr(AComponIDs[i]) + '~'; end; Query_Select.Close; if ALoadSQL then begin //SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, ':paramstr containing ''~''||ID||''~'' ', FieldNames, ''), false); SetSQLToFIBQuery(Query_Select, 'select * from component where ''~131435~131436~'' containing ''~''||ID||''~'' ', false); end; //Query_Select.Params[0].AsString := SQLCondition; Query_Select.ExecQuery; {Query_Select.Close; if ALoadSQL then begin SetSQLToFIBQuery(Query_Select, 'SELECT id_component_type, id_producer, id_net_type '+ 'FROM COMPONENT, CATALOG_RELATION '+ 'WHERE (ID_CATALOG = :'+fnIDCatalog+') and '+ '(Component.ID = ID_Component)', false); end; Query_Select.Params[0].AsInteger := ACatalogID; Query_Select.ExecQuery; } while Not Query_Select.Eof do begin IDComponentType := Query_Select.Fields[0].AsInteger; IDProducer := Query_Select.Fields[1].AsInteger; IDNetType := Query_Select.Fields[2].AsInteger; SprComponentType := nil; SprNetType := nil; SprProducer := nil; //*** Заполнить фильтр данными компоненты for i := 0 to AFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterBlock.AllChildBlocks[i]; if ChildFilterBlock.Condition <> nil then begin case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin if SprComponentType = nil then SprComponentType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetComponentTypeObjByID(IDComponentType); if SprComponentType <> nil then ChildFilterBlock.Condition.FieldValue := SprComponentType.ComponentType.GUID; end; fiGuidProducer: begin if SprProducer = nil then SprProducer := TF_Main(GForm).GSCSBase.NBSpravochnik.GetProducerByID(IDProducer); if SprProducer <> nil then ChildFilterBlock.Condition.FieldValue := SprProducer.GUID; end; fiGuidNetType: begin if SprNetType = nil then SprNetType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetNetTypeByID(IDNetType); if SprNetType <> nil then ChildFilterBlock.Condition.FieldValue := SprNetType.GUID; end; end; end; end; Result := AFilterBlock.Execute; if Result then Break; //// BREAK //// Query_Select.Next; end; end; Query_Select.Close; end; procedure TDM.DefineIsOnFilterBlocks(AMainFilterParams: TFilterParams; AApplyComponentFilter: Boolean); var i: Integer; ChildFilterBlock: TFilterBlock; Spravochnik: TSpravochnik; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; Offed: Boolean; begin if (AMainFilterParams <> nil) and (AMainFilterParams.FFilterBlock <> nil) then begin Spravochnik := TF_Main(GForm).GetSpravochnik; if Spravochnik <> nil then begin Offed := false; for i := 0 to AMainFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := TFilterBlock(AMainFilterParams.FFilterBlock.AllChildBlocks[i]); if ChildFilterBlock.IsOn and (ChildFilterBlock.Condition <> nil) then case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin SprComponentType := Spravochnik.GetComponentTypeByGUID(ChildFilterBlock.Condition.FilterValue); if SprComponentType = nil then begin ChildFilterBlock.IsOn := false; Offed := true; end; end; fiGuidProducer: begin SprProducer := Spravochnik.GetProducerByGUID(ChildFilterBlock.Condition.FilterValue); if SprProducer = nil then begin ChildFilterBlock.IsOn := false; Offed := true; end; end; fiGuidNetType: begin SprNetType := Spravochnik.GetNetTypeByGUID(ChildFilterBlock.Condition.FilterValue); if SprNetType = nil then begin ChildFilterBlock.IsOn := false; Offed := true; end; end; end; end; if Offed and AApplyComponentFilter then TF_Main(GForm).ApplyComponentFilter(AMainFilterParams, AMainFilterParams, false); end; end; end; function TDM.GetFilterFieldValuesFromTable(AFieldNameValues, AFieldNameCaptions, ATAbleName: string): TFilterField; begin Result := TFilterField.Create; SetSQlToFIBQuery(Query_Select, GetSQLByParams(qtSelect, ATAbleName, '', nil, AFieldNameValues+', '+AFieldNameCaptions), false); Query_Select.SQL.Add(' order by '+ AFieldNameCaptions); Query_Select.ExecQuery; while Not Query_Select.Eof do begin if (Query_Select.FN(AFieldNameValues).Value <> null) and (Query_Select.FN(AFieldNameCaptions).Value <> null) then begin Result.Values.Add(Query_Select.FN(AFieldNameValues).Value); Result.ValueCaptions.Add(Query_Select.FN(AFieldNameCaptions).Value); end; Query_Select.Next; end; end; function TDM.GetFilterValuesBySprElements(ASprElements: TSprElements): TObjectList; var FilterField: TFilterField; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; i: Integer; {procedure SortComplexStringList(AMainStringList, ASecondStringList: TStringList); var i: Integer; IDGUIDObject: TIDGuidObject; begin for i := 0 to AMainStringList.Count - 1 do begin IDGUIDObject := TIDGuidObject.Create; IDGUIDObject.GUID := ASecondStringList[i]; // запомнем текущий объект строки IDGUIDObject.ID := Integer(AMainStringList.Objects[i]); AMainStringList.Objects[i] := IDGUIDObject; end; AMainStringList.Sort; ASecondStringList.Clear; for i := 0 to AMainStringList.Count - 1 do begin IDGUIDObject := TIDGuidObject(AMainStringList.Objects[i]); ASecondStringList.Add(IDGUIDObject.GUID); AMainStringList.Objects[i] := TObject(IDGUIDObject.ID); FreeAndNil(IDGUIDObject); end; end;} begin Result := TObjectList.Create(true); if vkComponentType in ASprElements then begin FilterField := nil; if TF_Main(GForm).GDBMode = bkNormBase then FilterField := GetFilterFieldValuesFromTable(fnGUID, fnName, tnComponentTypes) else if TF_Main(GForm).GDBMode = bkProjectManager then begin FilterField := TFilterField.Create; for i := 0 to TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.ComponentTypes.Count - 1 do begin SprComponentType := TNBComponentType(TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.ComponentTypes[i]); FilterField.Values.Add(SprComponentType.ComponentType.GUID); FilterField.ValueCaptions.Add(SprComponentType.ComponentType.Name); end; SortComplexStringList(FilterField.ValueCaptions, FilterField.Values); end; Result.Add(FilterField); FilterField.FieldIndex := fiGuidComponentType; FilterField.FieldName := fnGuidComponentType; FilterField.FieldCaption := cComponentType; end; if vkProducers in ASprElements then begin FilterField := nil; if TF_Main(GForm).GDBMode = bkNormBase then FilterField := GetFilterFieldValuesFromTable(fnGUID, fnName, tnProducers) else if TF_Main(GForm).GDBMode = bkProjectManager then begin FilterField := TFilterField.Create; for i := 0 to TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.Producers.Count - 1 do begin SprProducer := TNBProducer(TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.Producers[i]); FilterField.Values.Add(SprProducer.GUID); FilterField.ValueCaptions.Add(SprProducer.Name); end; SortComplexStringList(FilterField.ValueCaptions, FilterField.Values); end; Result.Add(FilterField); FilterField.FieldIndex := fiGuidProducer; FilterField.FieldName := fnGuidProducer; FilterField.FieldCaption := cProducer; FilterField.Values.Insert(0, ''); FilterField.ValueCaptions.Insert(0, ''); end; if vkNetType in ASprElements then begin FilterField := nil; if TF_Main(GForm).GDBMode = bkNormBase then FilterField := GetFilterFieldValuesFromTable(fnGUID, fnName, tnNetType) else if TF_Main(GForm).GDBMode = bkProjectManager then begin FilterField := TFilterField.Create; for i := 0 to TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.NetTypes.Count - 1 do begin SprNetType := TNBNetType(TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.NetTypes[i]); FilterField.Values.Add(SprNetType.GUID); FilterField.ValueCaptions.Add(SprNetType.Name); end; SortComplexStringList(FilterField.ValueCaptions, FilterField.Values); end; Result.Add(FilterField); FilterField.FieldIndex := fiGuidNetType; FilterField.FieldName := fnGuidNetType; FilterField.FieldCaption := cNetType; end; end; function TDM.GetFilterInfoFromMemTable: TFilterInfo; var StringStream: TStringStream; begin Result := TFilterInfo.Create; try Result.ID := tSQL_Filters.FieldByName(fnID).AsInteger; Result.FilterType := tSQL_Filters.FieldByName(fnFilterType).AsInteger; StringStream := TStringStream.Create(''); TBlobField(tSQL_Filters.FieldByName(fnFilterValue)).SaveToStream(StringStream); Result.FilterValue := StringStream.DataString; Result.UseInCAD := false; if tSQL_Filters.FieldDefs.IndexOf(fnUseInCad) <> -1 then Result.UseInCAD := tSQL_Filters.FieldByName(fnUseInCad).AsBoolean; FreeAndNil(StringStream); except on E: Exception do AddExceptionToLogEx('TDM.GetFilterInfoFromMemTable', E.Message); end; end; procedure TDM.SaveFilterInfoToMemTable(AFilterInfo: TFilterInfo); var StringStream: TStringStream; begin try tSQL_Filters.Append; tSQL_Filters.FieldByName(fnID).AsInteger := AFilterInfo.ID; tSQL_Filters.FieldByName(fnFilterType).AsInteger := AFilterInfo.FilterType; StringStream := TStringStream.Create(AFilterInfo.FilterValue); TBlobField(tSQL_Filters.FieldByName(fnFilterValue)).LoadFromStream(StringStream); tSQL_Filters.FieldByName(fnUseInCad).AsBoolean := AFilterInfo.UseInCAD; tSQL_Filters.Post; except on E: Exception do AddExceptionToLogEx('TDM.SaveFilterInfoToMemTable', E.Message); end; end; procedure TDM.AddComponGUIDToFreqUseObj(AGuid: string); var RecID: Integer; ObjUseCount: Integer; FieldNames: TStringList; begin try if TF_Main(GForm).GDBMode = bkNormBase then begin RecID := 0; ObjUseCount := 0; //*** Найти существующую запись SetSQlToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnFreqUseObj, '('+fnObjGUID+' = '''+AGuid+''') and ('+fnObjType+' = '''+IntToStr(itComponent)+''')', nil, fnID+', '+fnUseCount)); //*** Если запись найдена, то инкрементируем ObjUseCount if Query_Select.RecordCount > 0 then begin RecID := Query_Select.Fields[0].AsInteger; ObjUseCount := Query_Select.Fields[1].AsInteger; Inc(ObjUseCount); UpdateIntTableFieldByID(tnFreqUseObj, fnUseCount, RecID, ObjUseCount, qmPhisical); end else //*** ИТначе вносим новую запись begin DelSpareFreqUseObj(30-1, itComponent); FieldNames := TStringList.Create; FieldNames.Add(fnObjGUID); FieldNames.Add(fnObjType); FieldNames.Add(fnUseCount); SetSQlToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnFreqUseObj, '', FieldNames, ''), false); Query_Operat.Params[0].AsString := AGuid; Query_Operat.Params[1].AsInteger := itComponent; Query_Operat.Params[2].AsInteger := 1; Query_Operat.ExecQuery; Query_Operat.Close; FreeAndNil(FieldNames); end; Query_Select.Close; end; except on E: Exception do AddExceptionToLogEx('TDM.AddComponGUIDToFreqUseObj', E.Message); end; end; procedure TDM.DelSpareFreqUseObj(AMaxObjCount, AObjType: Integer); var SpareIDs: TIntList; ObjNo: Integer; i: Integer; begin try //*** Определить лишние ID для удаления SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnFreqUseObj, fnObjType+' = '''+IntToStr(AObjType)+'''', nil, fnID), false); Query_Select.SQL.Text := Query_Select.SQL.Text + ' order by '+fnUseCount+' desc'; Query_Select.ExecQuery; ObjNo := 0; SpareIDs := TIntList.Create; while Not Query_Select.Eof do begin Inc(ObjNo); if ObjNo > AMaxObjCount then SpareIDs.Add(Query_Select.Fields[0].AsInteger); Query_Select.Next; end; Query_Select.Close; //*** Удаление лишних записей if SpareIDs.Count > 0 then begin SetSQlToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnFreqUseObj, fnID+' = :'+fnID, nil, ''), false); for i := 0 to SpareIDs.Count - 1 do begin Query_Operat.Close; Query_Operat.Params[0].AsInteger := SpareIDs[i]; Query_Operat.ExecQuery; end; Query_Operat.Close; end; FreeAndNil(SpareIDs); except on E: Exception do AddExceptionToLogEx('TDM.DelSpareFreqUseObj', E.Message); end; end; function TDM.GetComponGUIDsFromFreqUseObj(AMaxCount: Integer): TStringList; begin Result := TStringList.Create; try //SetSQLToFIBQuery(Query_Select, ' select first '+IntToStr(AMaxCount)+' '+fnObjGUID+' where '+fnObjType+' = '''++''' ' ; //SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnFreqUseObj, fnObjType+' = '''+IntToStr(itComponent)+'''', // nil, ' first '+IntToStr(AMaxCount)+' '+fnObjGUID)); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnFreqUseObj, fnObjType+' = '''+IntToStr(itComponent)+'''', nil, fnObjGUID), false); Query_Select.SQL.Text := Query_Select.SQL.Text + ' order by '+fnUseCount+' desc'; Query_Select.ExecQuery; while Not Query_Select.Eof do begin Result.Add(Query_Select.Fields[0].AsString); if Result.Count = AMaxCount then Break; //// BREAK //// Query_Select.Next; end; Query_Select.Close; except on E: Exception do AddExceptionToLogEx('TDM.GetComponGUIDsFromFreqUseObj', E.Message); end; end; function TDM.GetUsersInfoFromProject(AProjID: Integer): TUsersInfo; var Stream: TMemoryStream; StreamSize: Integer; begin Result := TUsersInfo.Create; try Stream := GetStreamFromTableByID(tnCatalog, fnUsr, AProjID, qmPhisical); StreamSize := Stream.Size; if StreamSize > 0 then begin Result.LoadFromStream(Stream); end; FreeAndNil(Stream); except on E: Exception do AddExceptionToLogEx('TDM.GetUsersInfoFromProject', E.Message); end; end; procedure TDM.SaveUsersInfoPMToBase; var Stream: TMemoryStream; begin try Stream := TMemoryStream.Create; try UsersInfoPM.SaveToStream(Stream); Stream.Position := 0; UpdateTableFieldStreamAllRec(Query_Operat, tnSettings, fnUsr, Stream); finally FreeAndNil(Stream); end except on E: Exception do AddExceptionToLogEx('TDM.SaveUsersInfoPMToBase', E.Message); end; end; procedure TDM.SaveUsersInfoToProject(AProjID: Integer; AUsersInfo: TUsersInfo); var Stream: TStream; begin try Stream := TMemoryStream.Create; AUsersInfo.SaveToStream(Stream); SetStreamToTableByID(tnCatalog, fnUsr, AProjID, Stream, Query_Operat); FreeAndNil(Stream); except on E: Exception do AddExceptionToLogEx('TDM.SaveUsersInfoToProject', E.Message); end; end; procedure TDM.UpdateNBStructure; begin end; procedure TDM.UpdateNBValues; begin if GNBSettings.BuildID = 1 then begin end; end; procedure TDM.StoreGuidsInReservGuidTable; begin U_BaseCommon.StoreGuidsInReservGuidTable(Database_SCS, 0); end; function TDM.GetComponsFailPortWireCount(aOnlyPortWithRelInterf: Boolean=false; aAllowCorrect: Boolean=false): TStringList; var IDProp: Integer; IDList: TIntList; ComponList: TSCSComponents; Compon, TestCompon: TSCSComponent; i: Integer; Dat: PObjectData; InterfWire: TSCSInterface; ActualWireCount, WireCountByProps, CorrectWireCountByProps: Integer; ptrProp: PProperty; OldPropVal, NewPropVal: Integer; PropGUID: String; SaveAllowConvertInterfToUniversal: Boolean; SaveUseLiteFunctional: Boolean; Spravochnik: TSpravochnik; IsComponToRes: Boolean; function CheckPortWithRelInter(ACompon: TSCSComponent): Boolean; var i: Integer; Interf: TSCSInterface; begin Result := false; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interf := ACompon.Interfaces[i]; if (Interf.IsPort = biTrue) and (Interf.TypeI = itFunctional) then if Interf.PortInterfaces.Count > 0 then begin Result := true; Break; //// BREAK //// end; end; end; function GetNewInterfPortRel(const AGUID: string): TSCSInterface; var SprInterface: TNBInterface; begin Result := TSCSInterface.Create(GForm); Result.ID := 1; Result.ID_COMPONENT := 0; Result.IsLineCompon := biTrue; Result.Color := clWhite; Result.ID_INTERFACE := 0; Result.IsBusy := biFalse; Result.SignType := oitProjectible; Result.IsPort := biFalse; SprInterface := Spravochnik.CreateInterfaceByStandartGUID(AGUID); Result.AssignFromSpr(SprInterface); end; function GetComponWireCount(ACompon: TSCSComponent): Integer; var i: Integer; Interf: TSCSInterface; KolvoInterf, KolvoVirtualWire: Integer; begin Result := 0; for i := 0 to ACompon.Interfaces.Count - 1 do begin Interf := ACompon.Interfaces[i]; if (Interf.IsPort = biFalse) and (Interf.TypeI = itFunctional) then begin if TF_Main(GForm).CheckInterf(Interf, InterfWire, cntUnion, @KolvoInterf, @KolvoVirtualWire) then begin Result := Result + Interf.Kolvo * Trunc(KolvoVirtualWire / KolvoInterf); end; end; end; end; begin Result := TStringList.Create; // отбираем всех со свойством колво жил на порт IDProp := GetIntFromTable(tnProperties, fnID, fnSysName, pnPortWireCount, qmPhisical); if IDProp <> 0 then begin SaveAllowConvertInterfToUniversal := GAllowConvertInterfToUniversal; SaveUseLiteFunctional := GUseLiteFunctional; GAllowConvertInterfToUniversal := true; GUseLiteFunctional := true; Spravochnik := TF_Main(GForm).GetSpravochnik; TestCompon := TSCSComponent.Create(GForm); InterfWire := GetNewInterfPortRel(guidUniversalWire); InterfWire.Kolvo := 100000; //Нереально большое колво интерфейсов чтобы везде проходило условие подключения try IDList := TIntList.Create; //SetSQLToFIBQuery(Query_Select, 'SELECT '+fnIDComponent+' FROM '+tnCompPropRelation+' '); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCompPropRelation, fnIDProperty+' = '''+IntToStr(IDProp)+'''', nil, fnIDComponent)); IntFIBFieldToIntList(IDList, Query_Select, fnIDComponent); ComponList := TSCSComponents.Create(true); for i := 0 to IDList.Count - 1 do begin try if IDList[i] = 108495 then EmptyProcedure; Compon := TSCSComponent.Create(GForm); Compon.LoadComponentByID(IDList[i], True); ComponList.Add(Compon); if Not aOnlyPortWithRelInterf or CheckPortWithRelInter(Compon) then begin //PropVal := Compon.GetPropertyValueAsInteger(pnPortWireCount); //ClearAndDisposeList(Compon.Properties); // текщее колво жил OldPropVal := Compon.GetPropertyValueAsInteger(pnPortWireCount); ActualWireCount := GetComponWireCount(Compon); //Compon.Interfaces.Clear; TestCompon.Clear; TestCompon.Assign(Compon, true, true); SetComponAsLite(TestCompon, true); // колво жил по свойствам WireCountByProps := GetComponWireCount(TestCompon); if ActualWireCount <> WireCountByProps then //if Abs(ActualWireCount - WireCountByProps) > Min(ActualWireCount, WireCountByProps) then // Если разница существенная if Abs(ActualWireCount - WireCountByProps) > (Min(ActualWireCount, WireCountByProps)/2) then // Если разница существенная begin IsComponToRes := false; if aAllowCorrect then begin TestCompon.Clear; TestCompon.Assign(Compon, true, true); NewPropVal := Trunc(TestCompon.GetPropertyValueAsInteger(pnPortWireCount)*(ActualWireCount/WireCountByProps)); if NewPropVal <> OldPropVal then begin TestCompon.SetPropertyValueAsFloat(pnPortWireCount, NewPropVal); SetComponAsLite(TestCompon, true); CorrectWireCountByProps := GetComponWireCount(TestCompon); if ActualWireCount = CorrectWireCountByProps then begin IsComponToRes := true; ptrProp := TestCompon.GetPropertyBySysName(pnPortWireCount); if ptrProp <> nil then begin PropGUID := GetStringFromTableByID(tnCompPropRelation, fnGuid, ptrProp.ID, qmPhisical); GLog.Add('UPDATE '+tnCompPropRelation+' SET '+fnPValue+' = '''+ptrProp.Value+''' WHERE GUID = '''+PropGUID+''';'); //UpdateStrTableFieldByID(tnCompPropRelation, fnPValue, ptrProp.ID, ptrProp.Value, qmPhisical); end; end; end; end else IsComponToRes := true; if IsComponToRes then begin NewData(Dat, ttComponents); Dat.ObjectID := Compon.ID; Dat.QueryMode := qmPhisical; Dat.ComponKind := TComponKind(ckNone); Dat.NBMode := nbmUser; Dat.ItemType := Compon.GetItemType; Dat.ChildNodesCount := 0; Result.AddObject(Compon.Name, TObject(Dat)); end; end; end; //if i = 10 then // Break; //// BREAK //// except on E: Exception do AddExceptionToLogExt(ClassName, 'GetComponsFailPortWireCount', E.Message); end; end; finally GAllowConvertInterfToUniversal := SaveAllowConvertInterfToUniversal; GUseLiteFunctional := SaveUseLiteFunctional; IDList.Free; InterfWire.Free; TestCompon.Free; //ComponList.Free; end; end; end; constructor TDM.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; GGForm := AForm; inherited Create(AOwner); end; { destructor TDM.Destroy; begin inherited; end; } // ##### Создание / редактирование интерфейса ##### procedure TDM.MakeEditInterfRel(var AmeInterfaceRel: TmeInterfaceRel; AMakeEdit: TMakeEdit); var //InterfFields: TStringList; //ID_InterfRel: Integer; NewID: Integer; i: Integer; //ID1: integer; //ID2: Integer; //SQLtxt: String; NewInterList: TSCSInterfaces; //ptrID: ^Integer; NumPair: Integer; Side: Integer; Npp: Integer; NppPort: Integer; SelectedID: Integer; DBMode: TDBKind; SCSCompon: TSCSComponent; Interfac: TSCSInterface; AdverseInterface: TSCSInterface; DestMemTable: TkbmMemTable; function GetNewNumPair: Integer; var LastNumPair: Integer; CountInterfPair: Integer; i: Integer; begin Result := 0; {case DBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select MAX(Num_Pair) max_num_pair from interface_relation '+ ' where id_component = '''+IntToStr(AmeInterfaceRel.ID_COMPONENT)+''' '); LastNumPair := scsQSelect.GetFNAsInteger('max_num_pair'); if LastNumPair > 0 then begin for i := 0 to LastNumPair - 1 do begin SetSQLToQuery(scsQSelect, ' select Count(Num_Pair) As Cnt from interface_relation '+ ' where (id_component = '''+IntToStr(AmeInterfaceRel.ID_COMPONENT)+''') and '+ ' (num_pair = '''+IntToStr(i + 1)+''') '); CountInterfPair := scsQSelect.GetFNAsInteger('Cnt'); if (CountInterfPair mod 2 <> 0) or (CountInterfPair = 0) then begin Result := i+1; Exit; ///// EXIT ///// end; end; Result := LastNumPair + 1 end else Result := 1; end; bkProjectManager: Result := SCSCompon.GetNewNumPair; end;} //Result := SCSCompon.GetNewNumPair; Result := GetInterfaceNewNumPairFromMT(DestMemTable); end; function GetLastNpp: Integer; begin Result := 0; case DBMode of bkNormBase: Result := GetInterfMaxFldValueByFilter(fnNpp, '(id_component = '''+IntToStr(AmeInterfaceRel.ID_COMPONENT)+''') and '+ '(id_interface = '''+IntToStr(AmeInterfaceRel.ID_INTERFACE)+''')'); bkProjectManager: Result := SCSCompon.GetLastNppInterface(AmeInterfaceRel.GUIDInterface, AmeInterfaceRel.IsPort, nil); end; end; begin try DBMode := TF_Main(GForm).GDBMode; Npp := 0; Side := 0; NewInterList := nil; NewID := -1; SelectedID := -1; SCSCompon := nil; Interfac := nil; AdverseInterface := nil; DestMemTable := nil; case AmeInterfaceRel.IsPort of biTrue: DestMemTable := MemTable_Port; biFalse: DestMemTable := MemTable_InterfaceRel; end; case DBMode of bkNormBase: SCSCompon := TF_Main(GForm).GSCSBase.SCSComponent; bkProjectManager: begin SCSCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AmeInterfaceRel.ID_COMPONENT); ////*** Обновить магистрали // if AmeInterfaceRel.TYPEI = itFunctional then // TF_Main(GForm).F_ChoiceConnectSide.DefineComponTrunkChangedInterfacesInFuture(SCSCompon, false); end; end; if Assigned(SCSCompon) then begin case AMakeEdit of meMake: begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin NewInterList := TSCSInterfaces.Create(false); NumPair := 1; end else NumPair := 0; Npp := GetLastNpp; //SCSCompon.GetLastNppInterface(AmeInterfaceRel.ID_INTERFACE, AmeInterfaceRel.IsPort, nil); NppPort := 0; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then case DBMode of bkNormBase: NppPort := GetComponentLastPort(AmeInterfaceRel.ID_COMPONENT); bkProjectManager: NppPort := SCSCompon.GetMaxNppPort; end; for i := 0 to AmeInterfaceRel.Count - 1 do begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin //NumPair := GetNewNumPair; //SCSCompon.GetNewNumPair; Side := (i mod 2) + 1; if i mod 2 = 0 then begin Npp := Npp + 1; NumPair := GetNewNumPair; end; end else begin Npp := Npp + 1; if AmeInterfaceRel.TYPEI = itFunctional then begin if AmeInterfaceRel.IsLineCompon = biTrue then Side := AmeInterfaceRel.Side; end else Side := 0; NumPair := 0; end; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then NppPort := NppPort + 1; Interfac := SCSCompon.GetInterfaceAsNew; if DBMode = bkNormBase then Interfac.ID := GenIDFromTable(Query_Select, gnInterfaceRelationID, 0) + 1; NewID := Interfac.ID; AmeInterfaceRel.ID := NewID; //Interfac.ID := NewID; Interfac.ID_Component := AmeInterfaceRel.ID_COMPONENT; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.GUIDInterface := AmeInterfaceRel.GUIDInterface; Interfac.Name := AmeInterfaceRel.Name; Interfac.IsLineCompon := AmeInterfaceRel.IsLineCompon; Interfac.Npp := Npp; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.NppPort := NppPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.isbusy := 0; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.Side := Side; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; Interfac.NumPair := NumPair; //Interfac.Kolvo := 1; Interfac.Kolvo := AmeInterfaceRel.Kolvo; Interfac.SignType := AmeInterfaceRel.SignType; Interfac.ConnToAnyGender := AmeInterfaceRel.ConnToAnyGender; Interfac.SideSection := AmeInterfaceRel.SideSection; LoadInterfaceToMemTable(Interfac, DestMemTable, MemTable_PortInterfRel, mtInterfInternalConn, meMake, SCSCompon.IsLine, true, false); //if Interfac.IsPort = biTrue then ##ISPORT begin LoadPortInterfRelsToInterfaceFromMT(Interfac, MemTable_PortInterfRel, mtInterfInternalConn, true); Interfac.DefineInternalRelations; end; if DBMode = bkNormBase then begin Interfac.SaveAsNew; //if Interfac.IsPort = biTrue then ##ISPORT Interfac.SavePortInterfRelsByServFields; end; if NewInterList <> nil then NewInterList.Add(Interfac); end; //FOR if NewID <> -1 then begin SelectedID := NewID; if NewInterList <> nil then begin i := 0; while i < NewInterList.Count do begin Interfac := NewInterList[i]; AdverseInterface := NewInterList[i+1]; Interfac.IDAdverse := AdverseInterface.ID; Interfac.ParallelInterface := AdverseInterface; AdverseInterface.IDAdverse := Interfac.ID; AdverseInterface.ParallelInterface := Interfac; if DestMemTable.Locate(fnID, Interfac.ID, []) then begin DestMemTable.Edit; DestMemTable.FieldByName(fnIDAdverse).AsInteger := Interfac.IDAdverse; DestMemTable.Post; end; if DestMemTable.Locate(fnID, AdverseInterface.ID, []) then begin DestMemTable.Edit; DestMemTable.FieldByName(fnIDAdverse).AsInteger := AdverseInterface.IDAdverse; DestMemTable.Post; end; if DBMode = bkNormBase then begin UpdateInterfFieldAsInteger(Interfac.ID, Interfac.IDAdverse, fnIDAdverse); UpdateInterfFieldAsInteger(AdverseInterface.ID, AdverseInterface.IDAdverse, fnIDAdverse); end; //Interfac.Save; //AdverseInterface.Save; i := i + 2; end; end; end; end; meEdit: begin Interfac := SCSCompon.GetInterfaceByID(AmeInterfaceRel.ID); if Interfac <> nil then begin //Interfac.IsLineCompon := AmeInterfaceRel.IsLineCompon; Interfac.Name := AmeInterfaceRel.Name; Interfac.Npp := AmeInterfaceRel.Npp; Interfac.NppPort := AmeInterfaceRel.NppPort; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.GUIDInterface := AmeInterfaceRel.GUIDInterface; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.NumPair := AmeInterfaceRel.NumPair; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; Interfac.Kolvo := AmeInterfaceRel.Kolvo; Interfac.SignType := AmeInterfaceRel.SignType; Interfac.ConnToAnyGender := AmeInterfaceRel.ConnToAnyGender; Interfac.SideSection := AmeInterfaceRel.SideSection; Interfac.IDAdverse := AmeInterfaceRel.ID_Adverse; Interfac.NumPair := AmeInterfaceRel.NumPair; if AmeInterfaceRel.ID_Adverse = 0 then Interfac.Side := AmeInterfaceRel.Side; if DestMemTable.Locate(fnID, AmeInterfaceRel.ID, []) then begin Interfac.ClearPortInterfaces; LoadInterfaceToMemTable(Interfac, DestMemTable, MemTable_PortInterfRel, mtInterfInternalConn, meEdit, SCSCompon.IsLine, true, false); end; //if Interfac.IsPort = biTrue then ##ISPORT begin Interfac.ClearPortInterfaces; LoadPortInterfRelsToInterfaceFromMT(Interfac, MemTable_PortInterfRel, mtInterfInternalConn, true); Interfac.DefineInternalRelations; end; Interfac.Save; //if Interfac.IsPort = biTrue then ##ISPORT Interfac.SavePortInterfRelsByServFields; end; if AmeInterfaceRel.ID_Adverse > 0 then begin Interfac := SCSCompon.GetInterfaceByID(AmeInterfaceRel.ID_Adverse); if Interfac <> nil then begin Interfac.Name := AmeInterfaceRel.Name; Interfac.Npp := AmeInterfaceRel.Npp; Interfac.NppPort := AmeInterfaceRel.NppPort; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.GUIDInterface := AmeInterfaceRel.GUIDInterface; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.NumPair := AmeInterfaceRel.NumPair; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; Interfac.Kolvo := AmeInterfaceRel.Kolvo; Interfac.SignType := AmeInterfaceRel.SignType; Interfac.ConnToAnyGender := AmeInterfaceRel.ConnToAnyGender; Interfac.SideSection := AmeInterfaceRel.SideSection; if DestMemTable.Locate(fnID, AmeInterfaceRel.ID_Adverse, []) then LoadInterfaceToMemTable(Interfac, DestMemTable, MemTable_PortInterfRel, mtInterfInternalConn, meEdit, SCSCompon.IsLine, true, false); Interfac.Save; end; end; SelectedID := AmeInterfaceRel.ID; end; end; end; if NewInterList <> nil then NewInterList.Free; if SelectedID > 0 then DestMemTable.Locate(fnID, SelectedID, []); //20.08.2012 - Учесть в маркировке компонента if Assigned(SCSCompon) then if DBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then RemarkComponAfterChangePort(SCSCompon); {case DBMode of bkNormBase: begin InterfFields := TStringList.Create; try InterfFields.Add(fnNpp); InterfFields.Add('id_interface'); InterfFields.Add('TYPEI'); InterfFields.Add('Kind'); InterfFields.Add('IsPort'); InterfFields.Add('IsUser_Port'); InterfFields.Add('Npp_Port'); InterfFields.Add('gender'); InterfFields.Add('multiple'); InterfFields.Add('valuei'); InterfFields.Add('color'); InterfFields.Add(fnNotice); case AMakeEdit of meMake: begin InterfFields.Add('id_component'); InterfFields.Add('isbusy'); InterfFields.Add('num_pair'); InterfFields.Add('id_adverse'); InterfFields.Add('Side'); SQLBuilder(scsQOperat, qtInsert, 'interface_relation', '', InterfFields, false); end; meEdit: SQLBuilder(scsQOperat, qtUpdate, 'interface_relation', 'id = :id', InterfFields, false); end; case AMakeEdit of meMake: begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin NewIDList := TList.Create; NumPair := 1; end else NumPair := 0; //if AmeInterfaceRel.TYPEI = itFunctional then Npp := GetLastNpp; NppPort := 0; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then NppPort := GetComponentLastPort(AmeInterfaceRel.ID_COMPONENT); for i := 0 to AmeInterfaceRel.KOLVO - 1 do begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin NumPair := GetNewNumPair; Side := (i mod 2) + 1; if i mod 2 = 0 then Npp := Npp + 1; end else begin Npp := Npp + 1; if AmeInterfaceRel.TYPEI = itFunctional then begin if AmeInterfaceRel.IsLineCompon = biTrue then Side := AmeInterfaceRel.Side; end else Side := 0; NumPair := 0; end; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then NppPort := NppPort + 1; scsQOperat.Close; scsQOperat.SetParamAsInteger('id_component', AmeInterfaceRel.ID_COMPONENT); scsQOperat.SetParamAsInteger('id_interface', AmeInterfaceRel.ID_INTERFACE); scsQOperat.SetParamAsInteger('typei', AmeInterfaceRel.TYPEI); scsQOperat.SetParamAsInteger('Kind', AmeInterfaceRel.Kind); scsQOperat.SetParamAsInteger('IsUser_Port', AmeInterfaceRel.IsUserPort); scsQOperat.SetParamAsInteger('IsPort', AmeInterfaceRel.IsPort); scsQOperat.SetParamAsInteger(fnNpp, Npp); scsQOperat.SetParamAsInteger('Npp_Port', NppPort); scsQOperat.SetParamAsInteger('gender', AmeInterfaceRel.GENDER); scsQOperat.SetParamAsInteger('isbusy', 0); scsQOperat.SetParamAsInteger('Multiple', AmeInterfaceRel.Multiple); scsQOperat.SetParamAsInteger('Color', AmeInterfaceRel.Color); scsQOperat.SetParamAsInteger('Side', Side); scsQOperat.SetParamAsFloat('ValueI', AmeInterfaceRel.ValueI); scsQOperat.SetParamAsString(fnNotice, AmeInterfaceRel.Notice); scsQOperat.SetParamAsInteger('Num_Pair', NumPair); scsQOperat.ExecQuery; scsQOperat.Close; SetSQLToQuery(scsQSelect, ' select MAX(ID) As max_id from interface_relation '); NewID := scsQSelect.GetFNAsInteger('max_id'); if NewIDList <> nil then begin //New(ptrID); GetMem(ptrID, SizeOf(Integer)); ptrID^ := NewID; NewIDList.Add(ptrID); end; end; if NewID <> -1 then begin SelectedID := NewID; if NewIDList <> nil then begin InterfFields.Clear; InterfFields.Add('id_adverse'); SQLBuilder(scsQOperat, qtUpdate, 'interface_relation', 'id = :id', InterfFields, false); i := 0; while i < NewIDList.Count do begin ID1 := Integer(NewIDList.Items[i]^); ID2 := Integer(NewIDList.Items[i+1]^); scsQOperat.Close; scsQOperat.SetParamAsInteger('id', ID1); scsQOperat.SetParamAsInteger('id_adverse', ID2); scsQOperat.ExecQuery; scsQOperat.Close; scsQOperat.SetParamAsInteger('id', ID2); scsQOperat.SetParamAsInteger('id_adverse', ID1); scsQOperat.ExecQuery; i := i + 2; end; end; end; end; meEdit: begin scsQOperat.SetParamAsInteger('id', AmeInterfaceRel.ID); scsQOperat.SetParamAsInteger('id_interface', AmeInterfaceRel.ID_INTERFACE); scsQOperat.SetParamAsInteger('typei', AmeInterfaceRel.TYPEI); scsQOperat.SetParamAsInteger('Kind', AmeInterfaceRel.Kind); scsQOperat.SetParamAsInteger('IsPort', AmeInterfaceRel.IsPort); scsQOperat.SetParamAsInteger('IsUser_Port', AmeInterfaceRel.IsUserPort); scsQOperat.SetParamAsInteger(fnNpp, AmeInterfaceRel.Npp); scsQOperat.SetParamAsInteger('Npp_Port', AmeInterfaceRel.NppPort); scsQOperat.SetParamAsInteger('gender', AmeInterfaceRel.GENDER); scsQOperat.SetParamAsInteger('Multiple', AmeInterfaceRel.Multiple); scsQOperat.SetParamAsFloat('ValueI', AmeInterfaceRel.ValueI); scsQOperat.SetParamAsInteger('Color', AmeInterfaceRel.Color); scsQOperat.SetParamAsString(fnNotice, AmeInterfaceRel.Notice); scsQOperat.ExecQuery; if AmeInterfaceRel.ID_Adverse > 0 then begin SQLBuilder(scsQOperat, qtUpdate, 'interface_relation', 'id = :id', InterfFields, false); scsQOperat.SetParamAsInteger('id', AmeInterfaceRel.ID_Adverse); scsQOperat.SetParamAsInteger('id_interface', AmeInterfaceRel.ID_INTERFACE); scsQOperat.SetParamAsInteger('typei', AmeInterfaceRel.TYPEI); scsQOperat.SetParamAsInteger('Kind', AmeInterfaceRel.Kind); scsQOperat.SetParamAsInteger('IsPort', AmeInterfaceRel.IsPort); scsQOperat.SetParamAsInteger('IsUser_Port', AmeInterfaceRel.IsUserPort); scsQOperat.SetParamAsInteger(fnNpp, AmeInterfaceRel.Npp); scsQOperat.SetParamAsInteger('Npp_Port', AmeInterfaceRel.NppPort); scsQOperat.SetParamAsInteger('gender', AmeInterfaceRel.GENDER); scsQOperat.SetParamAsInteger('Multiple', AmeInterfaceRel.Multiple); scsQOperat.SetParamAsFloat('ValueI', AmeInterfaceRel.ValueI); scsQOperat.SetParamAsInteger('color', AmeInterfaceRel.Color); scsQOperat.SetParamAsString(fnNotice, AmeInterfaceRel.Notice); scsQOperat.ExecQuery; end; //if AmeInterfaceRel. SelectedID := AmeInterfaceRel.ID; end; end; scsQOperat.Close; finally FreeAndNil(InterfFields); FreeAndNil(NewIDList); end; //end; end; bkProjectManager: begin SCSCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AmeInterfaceRel.ID_COMPONENT); if Assigned(SCSCompon) then case AMakeEdit of meMake: begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin NewIDList := TList.Create; NumPair := 1; end else NumPair := 0; Npp := SCSCompon.GetLastNppInterface(AmeInterfaceRel.ID_INTERFACE, AmeInterfaceRel.IsPort, nil); //GetLastNpp; NppPort := 0; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then NppPort := SCSCompon.GetMaxNumPort; //GetComponentLastPort(AmeInterfaceRel.ID_COMPONENT); for i := 0 to AmeInterfaceRel.KOLVO - 1 do begin if (AmeInterfaceRel.IsLineCompon = biTrue) and (AmeInterfaceRel.TYPEI = itFunctional) and (AmeInterfaceRel.ServiceIsPair = true) then begin NumPair := SCSCompon.GetNewNumPair; //GetNewNumPair; Side := (i mod 2) + 1; if i mod 2 = 0 then Npp := Npp + 1; end else begin Npp := Npp + 1; if AmeInterfaceRel.TYPEI = itFunctional then begin if AmeInterfaceRel.IsLineCompon = biTrue then Side := AmeInterfaceRel.Side; end else Side := 0; NumPair := 0; end; if TF_Main(GForm).GDBMode = bkProjectManager then if AmeInterfaceRel.IsPort = biTrue then NppPort := NppPort + 1; Interfac := SCSCompon.GetInterfaceAsNew; NewID := Interfac.ID; //Interfac.ID := NewID; Interfac.ID_Component := AmeInterfaceRel.ID_COMPONENT; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.Npp := Npp; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.NppPort := NppPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.isbusy := 0; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.Side := Side; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; Interfac.NumPair := NumPair; if NewIDList <> nil then begin //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := NewID; //NewIDList.Add(ptrID); NewIDList.Add(Interfac); end; end; if NewID <> -1 then begin SelectedID := NewID; if NewIDList <> nil then begin i := 0; while i < NewIDList.Count do begin Interfac := NewIDList.Items[i]; ptrAdverseInterface := NewIDList.Items[i+1]; Interfac.IDAdverse := ptrAdverseInterface.ID; Interfac.ParallelInterface := ptrAdverseInterface; ptrAdverseInterface.IDAdverse := Interfac.ID; ptrAdverseInterface.ParallelInterface := Interfac; i := i + 2; end; end; end; end; meEdit: begin Interfac := SCSCompon.GetInterfaceByID(AmeInterfaceRel.ID); if Interfac <> nil then begin Interfac.Npp := AmeInterfaceRel.Npp; Interfac.NppPort := AmeInterfaceRel.NppPort; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; end; if AmeInterfaceRel.ID_Adverse > 0 then begin Interfac := SCSCompon.GetInterfaceByID(AmeInterfaceRel.ID_Adverse); if Interfac <> nil then begin Interfac.Npp := AmeInterfaceRel.Npp; Interfac.NppPort := AmeInterfaceRel.NppPort; Interfac.ID_Interface := AmeInterfaceRel.ID_INTERFACE; Interfac.TypeI := AmeInterfaceRel.TYPEI; Interfac.Kind := AmeInterfaceRel.Kind; Interfac.IsUserPort := AmeInterfaceRel.IsUserPort; Interfac.IsPort := AmeInterfaceRel.IsPort; Interfac.gender := AmeInterfaceRel.GENDER; Interfac.Multiple := AmeInterfaceRel.Multiple; Interfac.Color := AmeInterfaceRel.Color; Interfac.ValueI := AmeInterfaceRel.ValueI; Interfac.Notice := AmeInterfaceRel.Notice; end; end; SelectedID := AmeInterfaceRel.ID; end; end; end; end; if AmeInterfaceRel.IsPort = biTrue then begin Interfac := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin Interfac := TSCSInterface.Create(GForm); Interfac.LoadByID(SelectedID); end; bkProjectManager: begin Interfac := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByIDAndIDComponent(SelectedID, AmeInterfaceRel.ID_COMPONENT); if Assigned(Interfac) then Interfac.ClearPortInterfaces; end; end; if Assigned(Interfac) then begin LoadPortInterfRelsToInterfaceFromMT(Interfac, MemTable_PortInterfRel); Interfac.SavePortInterfRelsByServFields; Interfac.DefinePortInterfaces; if TF_Main(GForm).GDBMode = bkNormBase then Interfac.Free; end end; //*** обновить выйти на текущую/ новую позицию if SelectedID <> -1 then begin TF_Main(GForm).LockTreeAndGrid(true); try if TF_Main(GForm).GDBMode = bkNormBase then TF_Main(GForm).GSCSBase.SCSComponent.LoadInterfaces; FillMemTableInterfRel(TF_Main(GForm).GSCSBase.SCSComponent, TF_Main(GForm).Tree_Catalog.Selected, AmeInterfaceRel.IsPort); case AmeInterfaceRel.IsPort of biTrue: SearchRecordMT(MemTable_Port, fnID, SelectedID); biFalse: SearchRecordMT(MemTable_InterfaceRel, fnID, SelectedID); end; finally TF_Main(GForm).LockTreeAndGrid(false); end; end; } except on E: Exception do AddExceptionToLog('TDM.MakeEditInterfRel: '+E.Message); end; end; function TDM.GetInterfaceRel(ADataSource: TDataSource; ADataSet: TDataSet): TmeInterfaceRel; var InterfaceRel: TmeInterfaceRel; InterfDataSet: TDataSet; begin ZeroMemory(@InterfaceRel, SizeOf(TmeInterfaceRel)); InterfDataSet := ADataSet; if InterfDataSet = nil then if ADataSource <> nil then InterfDataSet := ADataSource.DataSet; with InterfDataSet do begin InterfaceRel.ID := FieldByName('ID').AsInteger; InterfaceRel.ID_COMPONENT := FieldByName('ID_COMPONENT').AsInteger; InterfaceRel.Npp := FieldByName(fnNpp).AsInteger; InterfaceRel.ID_INTERFACE := FieldByName('ID_INTERFACE').AsInteger; InterfaceRel.GUIDInterface := FieldByName(fnGuidInterface).AsString; InterfaceRel.Name := FieldByName(fnName).AsString; InterfaceRel.IsNative := FieldByName(fnIsNative).AsBoolean; InterfaceRel.ISBusy := FieldByName('IsBusy').AsInteger; InterfaceRel.TYPEI := FieldByName('TYPEI').AsInteger; InterfaceRel.Kind := FieldByName('Kind').AsInteger; InterfaceRel.GENDER := FieldByName('GENDER').AsInteger; InterfaceRel.Multiple := FieldByName('Multiple').AsInteger; InterfaceRel.Color := FieldByName('Color').AsInteger; InterfaceRel.Notice := FieldByName(fnNotice).AsString; InterfaceRel.IsPort := FieldByName('IsPort').AsInteger; InterfaceRel.KOLVO := FieldByName(fnKolvo).AsInteger; InterfaceRel.SignType := FieldByName(fnSignType).AsInteger; InterfaceRel.ConnToAnyGender := FieldByName(fnConnToAnyGender).AsInteger; InterfaceRel.SideSection := FieldByName(fnSideSection).AsString; case InterfaceRel.IsPort of biFalse: begin InterfaceRel.IsUserPort := 0; InterfaceRel.NppPort := 0; InterfaceRel.ID_Adverse := FieldByName('ID_Adverse').AsInteger; InterfaceRel.NumPair := FieldByName(fnNumPair).AsInteger; InterfaceRel.Side := FieldByName('Side').AsInteger; InterfaceRel.ValueI := FieldByName('ValueI').AsFloat; end; biTrue: begin InterfaceRel.IsUserPort := FieldByName('IsUser_Port').AsInteger; InterfaceRel.NppPort := FieldByName('Npp_Port').AsInteger; end; end; InterfaceRel.DataSource := ADataSource; end; //InterfaceRel.mtInterfaces := nil; //InterfaceRel.mtPortInterfRel := nil; Result := InterfaceRel; end; { // ##### Загрузка Интерфейсов компоненты AID_Component в MemTable_Interface ##### procedure TDM.LoadMT(AID_Component: Integer; ATableKind: TTableKind; AAdditionalID: Integer = -1); var qSQL: String; i, j: Integer; FCount: Integer; Stream: TStream; MemTableTrg: TkbmMemTable; SelectFields: TStringList; NBSelectFields: TStringList; SQLtxt: String; SavedRecNo: Integer; ID_CompStateType: Integer; begin try SelectFields := TStringList.Create; NBSelectFields := TStringList.Create; case ATableKind of tkComplectED: begin MemTableTrg := MemTable_ComplectsEd; end; tkPropertyRelED: begin SQLtxt := 'select * from comp_prop_relation'; MemTableTrg := MemTable_PropertyEd; end; //*** Выбрать интерфейсы tkInterfRelED: begin MemTableTrg := MemTable_InterfaceRelEd; end; tkComponIconsED: begin qSQL := ' SELECT * FROM COMPONENT_ICONS '+ ' WHERE ID_COMPONENT = '''+IntToStr(AID_Component)+''' '; MemTableTrg := F_NormBase.DM.MemTable_ComponentIcons; end; end; MemTableTrg.Active := false; MemTableTrg.Active := true; case ATableKind of tkComplectED, tkPropertyRelED, tkInterfRelED: begin SavedRecNo := MemTableSrc.RecNo; MemTableSrc.First; while Not MemTableSrc.Eof do begin if ((ATableKind = tkInterfRelED) and (MemTableSrc.FieldByName('isNative').AsBoolean = true)) or ( ATableKind <> tkInterfRelED ) then begin MemTableTrg.Append; MemTableTrg.Edit; for i := 0 to AFields.Count - 1 do MemTableTrg.FieldByName(AFields.Strings[i]).Value := MemTableSrc.FieldByName(AFields.Strings[i]).Value; MemTableTrg.FieldByName('isModified').AsBoolean := false; MemTableTrg.FieldByName('isNew').AsBoolean := false; MemTableTrg.Post; end; MemTableSrc.Next; end; MemTableSrc.RecNo := SavedRecNo; MemTableTrg.RecNo := SavedRecNo; end; tkComponIconsED: begin //*** Если не известно, то найти ID типа условного обознач. данной компоненты if AAdditionalID = -1 then begin //qSQL := ; SetSQLToQuery(TF_Main(GForm).DM.scsQ, ' SELECT PVALUE FROM COMP_PROP_RELATION '+ ' WHERE (ID_PROPERTY IN (SELECT ID FROM PROPERTIES '+ ' WHERE ID_DATA_TYPE = '''+ IntToStr(dtCompStateType) +''' ) ) and '+ ' (ID_COMPONENT = '''+ IntToStr(AID_Component) +''') '); if TF_Main(GForm).DM.scsQ.FN('PVALUE').AsString <> '' then ID_CompStateType := StrToInt(TF_Main(GForm).DM.scsQ.FN('PVALUE').AsString); end else ID_CompStateType := AAdditionalID; SetSQLToQuery(Query_MakeEdit, qSQL); while Not Query_MakeEdit.Eof do begin MemTableTrg.Append; MemTableTrg.Edit; for i := 0 to AFields.Count - 1 do MemTableTrg.FieldByName(AFields.Strings[i]).Value := Query_MakeEdit.FN(AFields.Strings[i]).Value; //*** Подгрузить Условное обозначение (Иконки) if ATableKind = tkComponIconsED then begin SetSQLToQuery(F_NormBase.DM.scsQ, ' SELECT COMP_STATE_TYPE.ID, NPP_ID, ICON, NAME FROM OBJECT_ICONS, COMP_STATE_TYPE '+ ' WHERE (OBJECT_ICONS.ID = '''+ IntToStr(Query_MakeEdit.FN('ID_OBJECT_ICON').AsInteger) +''') AND '+ ' (OBJECT_ICONS.ID_COMP_STATE_TYPE = COMP_STATE_TYPE.ID )'); MemTableTrg.FieldByName('NPP_ID_Object_Icon').AsInteger := F_NormBase.DM.scsQ.FN('ID').AsInteger; MemTableTrg.FieldByName('ID_Comp_State_Type').AsInteger := F_NormBase.DM.scsQ.FN('ID').AsInteger; MemTableTrg.FieldByName('Name').AsString := F_NormBase.DM.scsQ.FN('Name').AsString; Stream := TMemoryStream.Create; Stream.Position := 0; F_NormBase.DM.scsQ.FN('Icon').SaveToStream(Stream); Stream.Position := 0; F_NormBase.DM.MemTable_ComponentIconsIcon.LoadFromStream(Stream); Stream.Free; end; MemTableTrg.FieldByName('isModified').AsBoolean := false; MemTableTrg.FieldByName('isNew').AsBoolean := false; MemTableTrg.Post; Query_MakeEdit.Next; end; //*** Выйти на обозначение по заданому в свойстве типу MemTableTrg.First; while (Not MemTableTrg.Eof) and (MemTableTrg.FieldByName('ID_COMP_STATE_TYPE').AsInteger <> ID_CompStateType) do MemTableTrg.Next end; end; finally SelectFields.Free; NBSelectFields.Free; end; end; } procedure TDM.LoadMT(AID_Component: Integer; ATableKind: TTableKind; AFields: TStringList; AAsNew: Boolean); var qSQL: String; i, j: Integer; FCount: Integer; Stream: TStream; MemTableSrc: TkbmMemTable; MemTableTrg: TkbmMemTable; CableCanalConnectors: TList; SavedTrgAfterEdit: TDataSetNotifyEvent; SavedRecNo: Integer; SavedID: Integer; SavedSrcMasterSource: TDataSource; SavedTrgMasterSource: TDataSource; ID_CompStateType: Integer; begin try ID_CompStateType := -1; MemTableSrc := nil; MemTableTrg := nil; case ATableKind of tkComplectED: begin MemTableSrc := MemTable_Complects; MemTableTrg := MemTable_ComplectsEd; end; tkPropertyRelED: begin MemTableSrc := MemTable_Property; MemTableTrg := MemTable_PropertyEd; end; //*** Выбрать интерфейсы tkInterfRelED: begin MemTableSrc := MemTable_InterfaceRel; MemTableTrg := MemTable_InterfaceRelEd; end; tkPortEd: begin MemTableSrc := MemTable_Port; MemTableTrg := MemTable_PortEd; end; tkPortInterfRelED: begin MemTableSrc := MemTable_PortInterfRel; MemTableTrg := MemTable_PortInterfRelEd; end; tkInterfInternalConnED: begin MemTableSrc := mtInterfInternalConn; MemTableTrg := mtInterfInternalConnEd; end; tkCableCanalConnectorsED: begin MemTableSrc := mtCableCanalConnectors; MemTableTrg := MemTable_CableCanalConnectorsEd; end; tkCrossConnectionED: begin MemTableSrc := MemTable_CrossConnection; MemTableTrg := mtCrossConnectionEd; end; {tkComponIconsED: begin qSQL := ' SELECT * FROM COMPONENT_ICONS '+ ' WHERE ID_COMPONENT = '''+IntToStr(AID_Component)+''' '; MemTableTrg := F_NormBase.DM.MemTable_ComponentIcons; end;} end; if Assigned(MemTableTrg) then begin MemTableTrg.DisableControls; TF_Main(GForm).LockTreeAndGrid(true); try if MemTableTrg <> nil then begin MemTableTrg.Active := false; MemTableTrg.Active := true; end; case ATableKind of tkComplectED, tkPropertyRelED, tkInterfRelED, tkPortEd, tkPortInterfRelED, tkInterfInternalConnED, tkCrossConnectionED, tkCableCanalConnectorsED: if (MemTableTrg <> nil) and (MemTableSrc <> nil) then begin try SavedID := MemTableSrc.FieldByName(fnID).AsInteger; except on E: Exception do AddExceptionToLogEx('AAAVVV: MemTableSrc.Active = '+BoolToStr(MemTableSrc.Active)+', State = '+IntToStr(Ord(MemTableSrc.State)), E.Message); end; SavedSrcMasterSource := MemTableSrc.MasterSource; MemTableSrc.MasterSource := nil; SavedTrgMasterSource := MemTableTrg.MasterSource; MemTableTrg.MasterSource := nil; SavedTrgAfterEdit := MemTableTrg.AfterEdit; MemTableTrg.AfterEdit := nil; try //*** Прогрузить Записи //for i := 0 to MemTableSrc.RecordCount - 1 do // MemTableSrc.RecNo := i+1; //SavedAfterEdit := MemTableTrg.AfterEdit; //MemTableTrg.AfterEdit := nil; //try MemTableTrg.LoadFromDataSet(MemTableSrc, [mtcpoLookup]); if Not MemTableTrg.Eof then MemTableTrg.First; while Not MemTableTrg.Eof do begin MemTableTrg.Edit; MemTableTrg.FieldByName(fnIsModified).AsBoolean := false; MemTableTrg.FieldByName(fnIsNew).AsBoolean := AAsNew; MemTableTrg.Post; MemTableTrg.Next; end; finally MemTableSrc.MasterSource := SavedSrcMasterSource; MemTableTrg.MasterSource := SavedTrgMasterSource; MemTableTrg.AfterEdit := SavedTrgAfterEdit; try MemTableSrc.Locate(fnID, SavedID, []); except on E: Exception do AddExceptionToLogEx('', E.Message); end; try MemTableTrg.Locate(fnID, SavedID, []); except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; { SavedRecNo := MemTableSrc.RecNo; if Not MemTableSrc.Eof then MemTableSrc.First; while Not MemTableSrc.Eof do begin if (ATableKind = tkInterfRelED) or ( ATableKind <> tkInterfRelED ) then begin MemTableTrg.Append; MemTableTrg.Edit; for i := 0 to AFields.Count - 1 do MemTableTrg.FieldByName(AFields.Strings[i]).Value := MemTableSrc.FieldByName(AFields.Strings[i]).Value; MemTableTrg.FieldByName('isModified').AsBoolean := false; MemTableTrg.FieldByName('isNew').AsBoolean := false; MemTableTrg.Post; end; MemTableSrc.Next; end; MemTableSrc.RecNo := SavedRecNo; MemTableTrg.RecNo := SavedRecNo;} end; {tkCableCanalConnectorsED: begin CableCanalConnectors := GetCableCanalConnectors(AID_Component); FillMemTableCableCanalConnectors(MemTableTrg, CableCanalConnectors, AAsNew); if TF_Main(GForm).GDBMode = bkNormBase then FreeList(CableCanalConnectors); if TF_Main(GForm).GDBMode = bkProjectManager then FreeAndNil(CableCanalConnectors); end;} tkComponIconsED: if MemTableTrg <> nil then begin //*** Если не известно, то найти ID типа условного обознач. данной компоненты { if AAdditionalID = -1 then begin //qSQL := ; SetSQLToQuery(TF_Main(GForm).DM.scsQ, ' SELECT PVALUE FROM COMP_PROP_RELATION '+ ' WHERE (ID_PROPERTY IN (SELECT ID FROM PROPERTIES '+ ' WHERE ID_DATA_TYPE = '''+ IntToStr(dtCompStateType) +''' ) ) and '+ ' (ID_COMPONENT = '''+ IntToStr(AID_Component) +''') '); if TF_Main(GForm).DM.scsQ.FN('PVALUE').AsString <> '' then ID_CompStateType := StrToInt(TF_Main(GForm).DM.scsQ.FN('PVALUE').AsString); end else ID_CompStateType := AAdditionalID; SetSQLToQuery(Query_MakeEdit, qSQL); while Not Query_MakeEdit.Eof do begin MemTableTrg.Append; MemTableTrg.Edit; for i := 0 to AFields.Count - 1 do MemTableTrg.FieldByName(AFields.Strings[i]).Value := Query_MakeEdit.FN(AFields.Strings[i]).Value; //*** Подгрузить Условное обозначение (Иконки) if ATableKind = tkComponIconsED then begin SetSQLToQuery(F_NormBase.DM.scsQ, ' SELECT COMP_STATE_TYPE.ID, NPP_ID, ICON, NAME FROM OBJECT_ICONS, COMP_STATE_TYPE '+ ' WHERE (OBJECT_ICONS.ID = '''+ IntToStr(Query_MakeEdit.FN('ID_OBJECT_ICON').AsInteger) +''') AND '+ ' (OBJECT_ICONS.ID_COMP_STATE_TYPE = COMP_STATE_TYPE.ID )'); MemTableTrg.FieldByName('NPP_ID_Object_Icon').AsInteger := F_NormBase.DM.scsQ.FN('ID').AsInteger; MemTableTrg.FieldByName('ID_Comp_State_Type').AsInteger := F_NormBase.DM.scsQ.FN('ID').AsInteger; MemTableTrg.FieldByName('Name').AsString := F_NormBase.DM.scsQ.FN('Name').AsString; Stream := TMemoryStream.Create; Stream.Position := 0; F_NormBase.DM.scsQ.FN('Icon').SaveToStream(Stream); Stream.Position := 0; F_NormBase.DM.MemTable_ComponentIconsIcon.LoadFromStream(Stream); Stream.Free; end; MemTableTrg.FieldByName('isModified').AsBoolean := false; MemTableTrg.FieldByName('isNew').AsBoolean := false; MemTableTrg.Post; Query_MakeEdit.Next; end; //*** Выйти на обозначение по заданому в свойстве типу MemTableTrg.First; if ID_CompStateType <> -1 then while (Not MemTableTrg.Eof) and (MemTableTrg.FieldByName('ID_COMP_STATE_TYPE').AsInteger <> ID_CompStateType) do MemTableTrg.Next; } end; end; finally MemTableTrg.EnableControls; //if Assigned(MemTableSrc) then TF_Main(GForm).LockTreeAndGrid(false); end; end; except on E: Exception do AddExceptionToLog('TDM.LoadMT: '+E.Message); end; end; procedure TDM.SaveMTToDS(AID_Component: Integer; ADeletedList: TIntList; ATableKind: TTablekind; AUpdateMT: Boolean); var ID_DSet: Integer; MemTableEd: TkbmMemTable; MemTable: TkbmMemTable; MainMemTable: TSQLMemTable; SCSCompon: TSCSComponent; i, j: Integer; FCount: Integer; RCount: Integer; FieldsList: TStringList; TableName: String; IsNew: Boolean; RecordNo: Integer; NewID: Integer; begin (* try FieldsList := TStringList.Create; MemTableEd := nil; MemTable := nil; MainMemTable := nil; SCSCompon := nil; RecordNo := 0; case ATablekind of tkComplectED: ; tkCompPropRelED: begin MemTableEd := MemTable_PropertyEd; MemTable := MemTable_Property; MainMemTable := tSQL_CompPropRelation; FieldsList.Add('ID_Property'); FieldsList.Add('PValue'); FieldsList.Add('TAKE_INTO_CONNECT'); FieldsList.Add('TAKE_INTO_JOIN'); FieldsList.Add(fnIsDefault); TableName := tnCompPropRelation; end; tkInterfRelED: begin MemTableEd := MemTable_InterfaceRelEd; MemTable := MemTable_InterfaceRel; MainMemTable := tSQL_InterfaceRelation; //FieldsList.Add('ID_Interface'); //FieldsList.Add('Name'); {FieldsList.Add('TypeI'); FieldsList.Add('Gender'); FieldsList.Add('isBusy'); FieldsList.Add('Multiple'); FieldsList.Add('ValueI'); FieldsList.Add('Sort_ID'); } //FieldsList.Add('ID'); FieldsList.Add('ID_INTERFACE'); FieldsList.Add(fnNpp); FieldsList.Add('TYPEI'); FieldsList.Add('KIND'); FieldsList.Add('IsPort'); FieldsList.Add('GENDER'); FieldsList.Add('Multiple'); FieldsList.Add('ValueI'); FieldsList.Add('SORT_ID'); FieldsList.Add('Num_Pair'); FieldsList.Add('Color'); if TF_Main(GForm).GDBMode = bkProjectManager then FieldsList.Add('id_adverse'); FieldsList.Add('Side'); FieldsList.Add(fnNotice); TableName := 'interface_relation'; end; tkPortED: begin MemTableEd := MemTable_PortEd; MemTable := MemTable_Port; MainMemTable := tSQL_InterfaceRelation; //FieldsList.Add('ID_Interface'); //FieldsList.Add('Name'); {FieldsList.Add('TypeI'); FieldsList.Add('Gender'); FieldsList.Add('isBusy'); FieldsList.Add('Multiple'); FieldsList.Add('ValueI'); FieldsList.Add('Sort_ID'); } //FieldsList.Add('ID'); FieldsList.Add(fnNpp); FieldsList.Add('ID_INTERFACE'); FieldsList.Add('TYPEI'); FieldsList.Add('KIND'); FieldsList.Add('IsPort'); FieldsList.Add('IsUser_Port'); FieldsList.Add('NPP_Port'); FieldsList.Add('GENDER'); FieldsList.Add('Multiple'); FieldsList.Add('Color'); FieldsList.Add(fnNotice); TableName := tnInterfaceRelation; end; tkCableCanalConnectorsED: begin MemTableEd := MemTable_CableCanalConnectorsEd; MemTable := nil; MainMemTable := tSQL_CableCanalConnectors; FieldsList.Add(fnIDNBConnector); FieldsList.Add(fnConnectorType); TableName := tnCableCanalConnectors; end; {tkComponIconsED: begin MemTableEd := F_NormBase.DM.MemTable_ComponentIcons; MemTable := nil; FieldsList.Add('ID_Object_Icon'); FieldsList.Add('NPP_ID_Object_Icon'); TableName := 'component_icons'; end;} end; FieldsList.Add('ID_Component'); //*** Удалить удаленые записи RCount := ADeletedList.Count; for i := 0 to RCount - 1 do case TF_Main(GForm).GDBMode of bkNormBase: SQLBuilder(scsQOperat, qtDelete, TableName, 'id = '''+ADeletedList.Strings[i]+''' ', nil, true); bkProjectManager: if Assigned(MainMemTable) then begin //if SetFilterToSQLMemTable(MainMemTable, 'id = '''+ADeletedList.Strings[i]+'''') then // if Not MainMemTable.Eof then // MainMemTable.Delete; end; end; if MemTableEd <> nil then begin if MemTableEd.Active = false then Exit; //// EXIT ///// //*** Внести в базу добавленные и измененные данные RecordNo := MemTableEd.RecNo; if MemTableEd.RecordCount > 0 then MemTableEd.First; while Not MemTableEd.Eof do begin if (MemTableEd.FieldByName('isNew').AsBoolean = true) or (MemTableEd.FieldByName('isModified').AsBoolean = true) then begin IsNew := false; case TF_Main(GForm).GDBMode of bkNormBase: begin if MemTableEd.FieldByName('isNew').AsBoolean = true then begin //FieldsList.Add(fnID); //IsNew := true; SQLBuilder(scsQOperat, qtInsert, TableName, '', FieldsList, false); end else if MemTableEd.FieldByName('isModified').AsBoolean = true then begin SQLBuilder(scsQOperat, qtUpdate, TableName, 'id = :id', FieldsList, false); scsQOperat.SetParamAsInteger('id', MemTableEd.FieldByName('ID').AsInteger); end; for i := 0 to FieldsList.Count - 2 do if FieldsList.Strings[i] <> fnIDComponent then scsQOperat.SetParamAsVariant(FieldsList.Strings[i], MemTableEd.FieldByName(FieldsList.Strings[i]).Value); scsQOperat.SetParamAsInteger('id_Component', AID_Component); scsQOperat.ExecQuery; { if MemTableEd.FieldByName('isNew').AsBoolean = true then begin SetSQLToQuery(scsQSelect, 'select max(id) from '+TableName); NewID := scsQSelect.GetFNAsInteger(fnMax); if NewID > 0 then begin MemTableEd.Edit; MemTableEd.FieldByName(fnID).AsInteger := NewID; MemTableEd.Post; end; end; } end; bkProjectManager: if Assigned(MainMemTable) then begin if MemTableEd.FieldByName('isNew').AsBoolean = true then begin //FieldsList.Add(fnID); //IsNew := true; MainMemTable.Append; end else if MemTableEd.FieldByName('isModified').AsBoolean = true then begin if SetFilterToSQLMemTable(MainMemTable, 'id = '''+IntToStr(MemTableEd.FieldByName('ID').AsInteger)+'''') then MainMemTable.Edit; end; if MainMemTable.State <> dsBrowse then begin for i := 0 to FieldsList.Count - 2 do if FieldsList.Strings[i] <> fnIDComponent then MainMemTable.FieldByName(FieldsList.Strings[i]).AsVariant := MemTableEd.FieldByName(FieldsList.Strings[i]).Value; MainMemTable.FieldByName(fnIDComponent).AsInteger := AID_Component; MainMemTable.Post; end; end; end; if IsNew then FieldsList.Delete(FieldsList.IndexOf(fnID)); end; MemTableEd.Next; end; end; scsQOperat.Close; //*** Обновить поле ID_ADVERSE для интерфейсов в новых записях if ATableKind = tkInterfRelED then if TF_Main(GForm).GDBMode = bkNormBase then begin if MemTableEd.RecordCount > 0 then MemTableEd.First; while Not MemTableEd.Eof do begin if MemTableEd.FieldByName('isNew').AsBoolean = true then if MemTableEd.FieldByName(fnIDAdverse).AsInteger <> 0 then UpdateInterfFieldAsInteger(MemTableEd.FieldByName(fnID).AsInteger, MemTableEd.FieldByName(fnIDAdverse).AsInteger, fnIDAdverse); MemTableEd.Next; end; end; //*** Обновить MemTable if (AUpdateMT) and (MemTable <> nil) then try TF_Main(GForm).LockTreeAndGrid(true); if TF_Main(GForm).GDBMode = bkProjectManager then begin SCSCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AID_Component); if Assigned(SCSCompon) then case ATableKind of tkInterfRelED, tkPortEd: SCSCompon.LoadInterfaces; tkCompPropRelED: SCSCompon.LoadProperties; end; end; case ATableKind of tkInterfRelED: SelectInterfaces(TF_Main(GForm).Tree_Catalog.Selected); tkPortEd: SelectPorts(TF_Main(GForm).Tree_Catalog.Selected); tkCompPropRelED: SelectComponProperty(nil); end; if (MemTable <> nil) and (MemTable.Active = true) then if MemTable.RecordCount >= RecordNo then MemTable.RecNo := RecordNo else MemTable.Last; finally TF_Main(GForm).LockTreeAndGrid(false); end; FieldsList.Clear; FreeAndNil(FieldsList); except on E: Exception do AddExceptionToLog('TDM.SaveMTToDS: '+E.Message); end; *) end; (* procedure TDM.SaveMTToDS(AID_Component: Integer; ADeletedList: TStringList; ATableKind: TTablekind); var DSet: TpFIBDataSet; ID_DSet: Integer; MemTable: TkbmMemTable; i, j: Integer; FCount: Integer; RCount: Integer; FieldsList: TStringList; begin FieldsList := TStringList.Create; case ATablekind of tkComplectED: DSet := DataSet_COMPONENT_RELATION; tkCompPropRelED: DSet := DataSet_COMP_PROP_RELATION; tkInterfRelED: begin DSet := pFIBDataSet1; MemTable := MemTable_InterfaceRelEd; FieldsList.Add('ID_Interface'); //FieldsList.Add('Name'); FieldsList.Add('TypeI'); FieldsList.Add('Gender'); FieldsList.Add('isBusy'); FieldsList.Add('Multiple'); FieldsList.Add('Sort_ID'); end; tkComponIconsED: begin DSet := DataSet_COMPONENT_ICONS; MemTable := F_NormBase.DM.MemTable_ComponentIcons; FieldsList.Add('ID_Object_Icon'); FieldsList.Add('NPP_ID_Object_Icon'); end; end; ID_DSet := DSet.FN('ID').AsInteger; //*** Удалить удаленые записи RCount := ADeletedList.Count; for i := 0 to RCount - 1 do if SearchRecord(DSet, 'ID', StrToInt(ADeletedList.Strings[i]) ) then DSet.Delete; FCount := FieldsList.Count; MemTable.First; while Not MemTable.Eof do begin if (MemTable.FieldByName('isNew').AsBoolean = true) or (MemTable.FieldByName('isModified').AsBoolean = true) then begin if MemTable.FieldByName('isNew').AsBoolean = true then begin DSet.Append; DSet.Edit; end else if MemTable.FieldByName('isModified').AsBoolean = true then begin SearchRecord(DSet, 'ID', MemTable.FieldByName('ID').AsInteger); DSet.Edit; end; for i := 0 to FCount - 1 do DSet.FN(FieldsList.Strings[i]).Value := MemTable.FieldByName(FieldsList.Strings[i]).Value; DSet.FN('ID_Component').AsInteger := AID_Component; DSet.Post; end; MemTable.Next; end; {case ATableKind of tkInterfRel: SelectInterfaces; end; } SearchRecord(DSet, 'ID', ID_DSet); FieldsList.Clear; FieldsList.Free; end; *) // ##### Заполнить таблицу интерфейсами ##### procedure TDM.FillMemTableInterfRel(AComponOrObj: TObject; ANode: TTreeNode; AIsPort: Integer); type TIDandCount = record ID: Integer; Child_ID: Integer; Count: Integer; end; PIDandCount = ^TIDandCount; var ComplIDIOfI: ^Integer; ParentDat: PObjectData; IDParentCompon: Integer; ParentListInterfTo: TIntList; ChildSumValueI: Double; WasLoadInterf: Boolean; ItemType: TItemType; IsLine: Integer; i: Integer; NBComponent: TSCSComponent; procedure FillStep(ASCSComponent: TSCSComponent; AIDParentCompon, AComplCount: Integer; AParentInterfTo: TIntList; AStepIndex: Integer); var Interfaces: TSCSInterfaces; Interfac: TSCSInterface; //InterfFromPort: TSCSInterface; InterfConnected: TSCSInterface; //ptrPortInterfRel: PPortInterfRel; IDChildList: TList; ChildCount: Integer; ChildComponent: TSCSComponent; strIDParentCompon: String; strIDCurrInterf: String; ptrIDCount: PIDandCount; ptrCompRel: PComplect; i, j, k: Integer; LCount: Integer; //ComplIDIOfIList: TList; //ComplIDIOfI: ^Integer; ListInterfTo: TIntList; CurrListInterfTo: TIntList; MemTable_InterfOrPort: TkbmMemTable; InterfInConnecting: Boolean; InterfInCurrTopInterfTo: Boolean; CanAddInterf: Boolean; SCSComponent: TSCSComponent; begin MemTable_InterfOrPort := nil; ListInterfTo := TIntList.Create; strIDParentCompon := IntToStr(AIDParentCompon); Interfaces := TSCSInterfaces.Create(false); //GetComponInterfaces(AID_Compon, false, -1); Interfaces.Assign(ASCSComponent.Interfaces, laOr); for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces[i]; MemTable_InterfOrPort := nil; case Interfac.IsPort of biTrue: MemTable_InterfOrPort := MemTable_Port; biFalse: MemTable_InterfOrPort := MemTable_InterfaceRel; end; if Not((Interfac.IsPort = biFalse) and (ItemType in [itSCSLine, itSCSConnector])) then if Assigned(MemTable_InterfOrPort) then begin InterfInConnecting := false; InterfInCurrTopInterfTo := false; CanAddInterf := true; //*** Присоединенные Интерфейсы комплектующих if Interfac.TypeI = itConstructive then begin CurrListInterfTo := Interfac.GetInterfToIDs; //}GetInterfToListByIDInterfRel(Interfac.ID); ListInterfTo.Assign(CurrListInterfTo, laOr); if IsLine = biFalse then if CurrListInterfTo.Count > 0 then begin InterfInConnecting := true; if AStepIndex > 0 then CanAddInterf := false; end; FreeAndNil(CurrListInterfTo); if Not InterfInConnecting then if AParentInterfTo <> nil then if AParentInterfTo.IndexOf(Interfac.ID) <> -1 then //if Not CheckNoIDinList(Interfac.ID, AParentInterfTo) then begin InterfInConnecting := true; if AStepIndex <= 1 then // если Parent - не тек компонент InterfInCurrTopInterfTo := true else CanAddInterf := false; end; end; //if (Not InterfInConnecting) or (AStepIndex = 0) then if CanAddInterf then begin for j := 0 to AComplCount - 1 do begin //if (Interfac.IsPort = biTrue) and (AStepIndex = 0) then //begin // if TF_Main(GForm).GDBMode = bkNormBase then // Interfac.LoadPortInterfRels; //end; LoadInterfaceToMemTable(Interfac, MemTable_InterfOrPort, MemTable_PortInterfRel, mtInterfInternalConn, meMake, IsLine, AStepIndex = 0, InterfInConnecting); end; end; end; end; FreeAndNil(Interfaces); //FreeList(Interfaces); if IsLine = biFalse then begin //*** Выбрать ID комплектующих for i := 0 to ASCSComponent.ChildComplects.Count - 1 do begin ChildComponent := ASCSComponent.ChildComplects[i]; ChildCount := AComplCount; if ChildComponent.Count > 0 then ChildCount := ChildComponent.Count * AComplCount; FillStep(ChildComponent, ASCSComponent.ID, ChildCount, ListInterfTo, AStepIndex + 1); end; //IDChildList := GetComponChildsCompRels(AID_Compon); //for i := 0 to IDChildList.Count - 1 do //begin // ptrCompRel := IDChildList.Items[i]; // FillStep(ptrCompRel.ID_Child, AID_Compon, ptrCompRel.Kolvo * AComplCount, ListInterfTo, AStepIndex + 1); //end; end; FreeAndNil(ListInterfTo); //Freelist(ListInterfTo); end; begin try try IDParentCompon := -1; ParentListInterfTo := nil; WasLoadInterf := false; if ANode <> nil then ItemType := PObjectData(ANode.Data).ItemType else if AComponOrObj is TSCSComponent then ItemType := TSCSComponent(AComponOrObj).GetItemType; MemTable_InterfaceRel.Active := false; MemTable_InterfaceRel.Active := true; MemTable_InterfaceRel.DisableControls; MemTable_Port.AfterScroll := nil; MemTable_Port.Active := false; MemTable_Port.Active := true; MemTable_Port.DisableControls; mtInterfInternalConn.Active := false; mtInterfInternalConn.Active := true; mtInterfInternalConn.DisableControls; //*** Загрузка для компоненты if AComponOrObj is TSCSComponent then begin if Assigned(ANode) and Assigned(ANode.Parent) then begin ParentDat := ANode.Parent.Data; //if ParentDat.ItemType = itComponCon then IDParentCompon := ParentDat.ObjectID; //*** Интерфейсы Предка if IsComponItemType(ParentDat.ItemType) then //if ParentDat.ItemType in [itComponCon, itComponLine] then ParentListInterfTo := GetInterfToListByIDCompon(IDParentCompon, PObjectData(ANode.Data).ID_CompRel); {case TF_Main(GForm).GDBMode of bkNormBase: ParentListInterfTo := GetInterfToListByIDCompon(IDParentCompon); bkProjectManager: ParentListInterfTo := TSCSComponent(AComponOrObj.Parent). end;} end; IsLine := TSCSComponent(AComponOrObj).IsLine; FillStep(TSCSComponent(AComponOrObj), IDParentCompon, 1, ParentListInterfTo, 0); //LoadNames; end; if AComponOrObj is TSCSCatalog then if TSCSCatalog(AComponOrObj).ItemType in [itSCSConnector, itSCSLine] then begin case TSCSCatalog(AComponOrObj).ItemType of itSCSLine: IsLine := biTrue; itSCSConnector: isLine := biFalse; end; IDParentCompon := -1; //tSQL_Katalog.Filtered := false; //tSQL_Component.Filtered := false; //tSQL_CatalogRelation.Filtered := false; //TSCSCatalog(AComponOrObj).LoadComponents(TSCSCatalog(AComponOrObj).ID, false); for i := 0 to TSCSCatalog(AComponOrObj).SCSComponents.Count - 1 do begin if i = 0 then FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]), IDParentCompon, 1, ParentListInterfTo, 0) else FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]), IDParentCompon, 1, ParentListInterfTo, 1); WasLoadInterf := true; end; //if WasLoadInterf then //LoadNames; end; //MemTable_InterfOrPort.EnableControls; LoadInterfRelNamesToMemTable(MemTable_InterfaceRel); LoadInterfRelNamesToMemTable(MemTable_Port); except on E: Exception do AddExceptionToLog('TDM.FillMemTableInterfRel: '+E.Message); end; finally MemTable_InterfaceRel.EnableControls; MemTable_Port.EnableControls; MemTable_Port.AfterScroll := MemTable_PortAfterScroll; MemTable_PortAfterScroll(MemTable_Port); mtInterfInternalConn.EnableControls; FreeAndNil(ParentListInterfTo); //FreeList(ParentListInterfTo); end; end; (* // ##### Заполнить таблицу интерфейсами ##### procedure TDM.FillMemTableInterfRel(AComponOrObj: TObject; ANode: TTreeNode; AIsPort: Integer); type TIDandCount = record ID: Integer; Child_ID: Integer; Count: Integer; end; PIDandCount = ^TIDandCount; var ComplIDIOfI: ^Integer; ParentDat: PObjectData; IDParentCompon: Integer; ParentListInterfTo: TIntList; ChildSumValueI: Double; WasLoadInterf: Boolean; ItemType: TItemType; IsLine: Integer; i: Integer; NBComponent: TSCSComponent; procedure FillStep(AID_Compon, AIDParentCompon, AComplCount: Integer; AParentInterfTo: TIntList; AStepIndex: Integer); var Interfaces: TSCSInterfaces; Interfac: TSCSInterface; //InterfFromPort: TSCSInterface; InterfConnected: TSCSInterface; //ptrPortInterfRel: PPortInterfRel; IDChildList: TList; strIDParentCompon: String; strIDCurrInterf: String; ptrIDCount: PIDandCount; ptrCompRel: PComplect; i, j, k: Integer; LCount: Integer; //ComplIDIOfIList: TList; //ComplIDIOfI: ^Integer; ListInterfTo: TIntList; CurrListInterfTo: TIntList; MemTable_InterfOrPort: TkbmMemTable; InterfInConnecting: Boolean; InterfInCurrTopInterfTo: Boolean; CanAddInterf: Boolean; SCSComponent: TSCSComponent; begin MemTable_InterfOrPort := nil; ListInterfTo := TIntList.Create; strIDParentCompon := IntToStr(AIDParentCompon); Interfaces := GetComponInterfaces(AID_Compon, false, -1); for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces[i]; MemTable_InterfOrPort := nil; case Interfac.IsPort of biTrue: MemTable_InterfOrPort := MemTable_Port; biFalse: MemTable_InterfOrPort := MemTable_InterfaceRel; end; if Not((Interfac.IsPort = biFalse) and (ItemType in [itSCSLine, itSCSConnector])) then if Assigned(MemTable_InterfOrPort) then begin InterfInConnecting := false; InterfInCurrTopInterfTo := false; CanAddInterf := true; //*** Присоединенные Интерфейсы комплектующих if Interfac.TypeI = itConstructive then begin CurrListInterfTo := Interfac.GetInterfToIDs; //}GetInterfToListByIDInterfRel(Interfac.ID); ListInterfTo.Assign(CurrListInterfTo, laOr); if IsLine = biFalse then if CurrListInterfTo.Count > 0 then begin InterfInConnecting := true; if AStepIndex > 0 then CanAddInterf := false; end; FreeAndNil(CurrListInterfTo); if Not InterfInConnecting then if AParentInterfTo <> nil then if AParentInterfTo.IndexOf(Interfac.ID) <> -1 then //if Not CheckNoIDinList(Interfac.ID, AParentInterfTo) then begin InterfInConnecting := true; if AStepIndex <= 1 then // если Parent - не тек компонент InterfInCurrTopInterfTo := true else CanAddInterf := false; end; end; //if (Not InterfInConnecting) or (AStepIndex = 0) then if CanAddInterf then begin for j := 0 to AComplCount - 1 do begin if (Interfac.IsPort = biTrue) and (AStepIndex = 0) then begin if TF_Main(GForm).GDBMode = bkNormBase then Interfac.LoadPortInterfRels; end; LoadInterfaceToMemTable(Interfac, MemTable_InterfOrPort, MemTable_PortInterfRel, meMake, IsLine, AStepIndex = 0, InterfInConnecting); { MemTable_InterfOrPort.Append; MemTable_InterfOrPort.Edit; MemTable_InterfOrPort.FieldByName('ID').AsInteger := Interfac.ID; MemTable_InterfOrPort.FieldByName(fnNpp).AsInteger := Interfac.Npp; MemTable_InterfOrPort.FieldByName('ID_COMPONENT').AsInteger := Interfac.ID_Component; MemTable_InterfOrPort.FieldByName('ID_INTERFACE').AsInteger := Interfac.ID_Interface; MemTable_InterfOrPort.FieldByName('TYPEI').AsInteger := Interfac.TypeI; MemTable_InterfOrPort.FieldByName('IsPort').AsInteger := Interfac.IsPort; MemTable_InterfOrPort.FieldByName('Kind').AsInteger := Interfac.Kind; MemTable_InterfOrPort.FieldByName('GENDER').AsInteger := Interfac.Gender; MemTable_InterfOrPort.FieldByName('Multiple').AsInteger := Interfac.Multiple; if Not InterfInConnecting then MemTable_InterfOrPort.FieldByName(fnIsBusy).AsInteger := Interfac.IsBusy else MemTable_InterfOrPort.FieldByName(fnIsBusy).AsInteger := biNone; MemTable_InterfOrPort.FieldByName('SORT_ID').AsInteger := Interfac.SortID; MemTable_InterfOrPort.FieldByName(fnNotice).AsString := Interfac.Notice; MemTable_InterfOrPort.FieldByName('isNative').AsBoolean := AStepIndex = 0; if Interfac.IsPort = biFalse then begin MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI; MemTable_InterfOrPort.FieldByName('Num_Pair').AsInteger := Interfac.NumPair; MemTable_InterfOrPort.FieldByName('id_adverse').AsInteger := Interfac.IDAdverse; MemTable_InterfOrPort.FieldByName('Side').AsInteger := Interfac.Side; end; if Interfac.IsPort = biTrue then begin MemTable_InterfOrPort.FieldByName('IsUser_Port').AsInteger := Interfac.IsUserPort; MemTable_InterfOrPort.FieldByName('Npp_Port').AsInteger := Interfac.NppPort; if TF_Main(GForm).GDBMode = bkProjectManager then begin MemTable_InterfOrPort.FieldByName('id_connected').AsInteger := Interfac.IDConnected; if Interfac.IDConnected > 0 then begin InterfConnected := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(Interfac.IDConnected); if Assigned(InterfConnected) then begin MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(InterfConnected.ID_Component) +' \ Порт '+ IntToStr(InterfConnected.NppPort); //MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(GetIDComponByInterfID(Interfac.IDConnected)); //TF_Main(GForm).GetComponNameForVisible(scsQSelect.FN('NAME_SHORT').AsString, scsQSelect.FN('NAME_MARK').AsString); //MemTable_InterfOrPort.FieldByName('name_connected').AsString := MemTable_InterfOrPort.FieldByName('name_connected').AsString +' \ Порт '+ GetNamePortByIDPort(Interfac.IDConnected); end; end; //*** Загрузить подсоединенный кабель, если он есть SCSComponent := TSCSComponent(Interfac.ComponentOwner); if Assigned(SCSComponent) then if SCSComponent.JoinedComponents.Count > 0 then for k := 0 to SCSComponent.JoinedComponents.Count - 1 do if Assigned(SCSComponent.JoinedComponents[k]) then if SCSComponent.JoinedComponents[k].IsLine = biTrue then begin MemTable_InterfOrPort.FieldByName(fnNameConnectCable).AsString := SCSComponent.JoinedComponents[k].GetNameForVisible(false); //GetComponNameForVisible(SCSComponent.JoinedComponents[k].Name, SCSComponent.JoinedComponents[k].NameMark); Break; ///// BREAK ///// end; end; end; //*** Подгрузить Объем с вычитанием объемов комплектующих if Interfac.TypeI = itConstructive then if IsLine = biTrue then begin ChildSumValueI := GetConnectedInterfacesValues(scsQSelect, Interfac.ID); MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI - ChildSumValueI; end; MemTable_InterfOrPort.FieldByName('Color').AsInteger := Interfac.Color; if TF_Main(GForm).GDBMode = bkProjectManager then MemTable_InterfOrPort.FieldByName('CoordZ').AsFloat := Interfac.CoordZ; MemTable_InterfOrPort.Post; //*** Связь портов с интерфейсами if (Interfac.IsPort = biTrue) and (AStepIndex = 0) then begin if TF_Main(GForm).GDBMode = bkNormBase then Interfac.LoadPortInterfRels; for k := 0 to Interfac.PortInterfRels.Count - 1 do begin ptrPortInterfRel := Interfac.PortInterfRels[k]; InterfFromPort := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin InterfFromPort := TSCSInterface.Create(GForm); InterfFromPort.LoadByID(ptrPortInterfRel.IDInterfRel); end; bkProjectManager: InterfFromPort := TF_Main(GForm).GSCSBase.CurrProject.CurrList.GetInterfaceByIDAndIDComponent(ptrPortInterfRel.IDInterfRel, Interfac.ID_Component); end; MemTable_PortInterfRel.Append; MemTable_PortInterfRel.FieldByName(fnID).AsInteger := ptrPortInterfRel.ID; //MemTable_PortInterfRel.FieldByName(fnIDPort).AsInteger := ptrPortInterfRel.IDPort; MemTable_PortInterfRel.FieldByName(fnIDInterfRel).AsInteger := ptrPortInterfRel.IDInterfRel; if Assigned(InterfFromPort) then MemTable_PortInterfRel.FieldByName(fnName).AsString := F_NormBase.DM.GetInterfaceNameByID(InterfFromPort.ID_Interface); MemTable_PortInterfRel.Post; end; end; } end; end; end; end; FreeAndNil(Interfaces); //FreeList(Interfaces); if IsLine = biFalse then begin //*** Выбрать ID комплектующих //IDChildList := GetComponCompRels(AID_Compon, cntComplect); IDChildList := GetComponChildsCompRels(AID_Compon); for i := 0 to IDChildList.Count - 1 do begin ptrCompRel := IDChildList.Items[i]; FillStep(ptrCompRel.ID_Child, AID_Compon, ptrCompRel.Kolvo * AComplCount, ListInterfTo, AStepIndex + 1); end; FreeList(IDChildList); end; FreeAndNil(ListInterfTo); //Freelist(ListInterfTo); end; begin try try IDParentCompon := -1; ParentListInterfTo := nil; WasLoadInterf := false; ItemType := PObjectData(ANode.Data).ItemType; MemTable_InterfaceRel.Active := false; MemTable_InterfaceRel.Active := true; MemTable_InterfaceRel.DisableControls; MemTable_Port.AfterScroll := nil; MemTable_Port.Active := false; MemTable_Port.Active := true; MemTable_Port.DisableControls; //*** Загрузка для компоненты if AComponOrObj is TSCSComponent then begin if Assigned(ANode) and Assigned(ANode.Parent) then begin ParentDat := ANode.Parent.Data; //if ParentDat.ItemType = itComponCon then IDParentCompon := ParentDat.ObjectID; //*** Интерфейсы Предка if ParentDat.ItemType in [itComponCon, itComponLine] then case TF_Main(GForm).GDBMode of bkNormBase: ParentListInterfTo := GetInterfToListByIDCompon(IDParentCompon); //bkProjectManager: // ParentListInterfTo := end; end; IsLine := TSCSComponent(AComponOrObj).IsLine; FillStep(TSCSComponent(AComponOrObj).ID, IDParentCompon, 1, ParentListInterfTo, 0); //LoadNames; end; if AComponOrObj is TSCSCatalog then if TSCSCatalog(AComponOrObj).ItemType in [itSCSConnector, itSCSLine] then begin case TSCSCatalog(AComponOrObj).ItemType of itSCSLine: IsLine := biTrue; itSCSConnector: isLine := biFalse; end; IDParentCompon := -1; //tSQL_Katalog.Filtered := false; //tSQL_Component.Filtered := false; //tSQL_CatalogRelation.Filtered := false; //TSCSCatalog(AComponOrObj).LoadComponents(TSCSCatalog(AComponOrObj).ID, false); for i := 0 to TSCSCatalog(AComponOrObj).SCSComponents.Count - 1 do begin if i = 0 then FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, 0) else FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, 1); WasLoadInterf := true; end; //if WasLoadInterf then //LoadNames; end; //MemTable_InterfOrPort.EnableControls; LoadInterfRelNamesToMemTable(MemTable_InterfaceRel); LoadInterfRelNamesToMemTable(MemTable_Port); except on E: Exception do AddExceptionToLog('TDM.FillMemTableInterfRel: '+E.Message); end; finally MemTable_InterfaceRel.EnableControls; MemTable_Port.EnableControls; MemTable_Port.AfterScroll := MemTable_PortAfterScroll; MemTable_PortAfterScroll(MemTable_Port); FreeAndNil(ParentListInterfTo); //FreeList(ParentListInterfTo); end; end; *) (* // ##### Заполнить таблицу интерфейсами ##### procedure TDM.FillMemTableInterfRel(AComponOrObj: TObject; ANode: TTreeNode; AIsPort: Integer); var ComplIDIOfI: ^Integer; ParentDat: PObjectData; IDParentCompon: Integer; ParentListInterfTo: Tlist; ChildSumValueI: Double; WasLoadInterf: Boolean; ItemType: TItemType; IsLine: Integer; i: Integer; procedure FillStep(AID_Compon, AIDParentCompon, AComplCount: Integer; AParentInterfTo: TList; isFirstCalling: Boolean); var Interfaces: TSCSInterfaces; Interfac: TSCSInterface; InterfFromPort: TSCSInterface; ptrInterfConnected: TSCSInterface; ptrPortInterfRel: PPortInterfRel; IDChildList: TList; strIDParentCompon: String; strIDCurrInterf: String; ptrIDCount: PIDandCount; ptrCompRel: PComplect; i, j, k: Integer; LCount: Integer; //ComplIDIOfIList: TList; //ComplIDIOfI: ^Integer; ListInterfTo: TList; CurrListInterfTo: TList; MemTable_InterfOrPort: TkbmMemTable; CanAddRecord: Boolean; SCSComponent: TSCSComponent; begin MemTable_InterfOrPort := nil; ListInterfTo := TList.Create; strIDParentCompon := IntToStr(AIDParentCompon); Interfaces := GetComponInterfaces(AID_Compon, false, -1); //if isFirstCalling then // begin // MemTable_InterfOrPort.Active := false; // MemTable_InterfOrPort.Active := true; // end; for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces[i]; MemTable_InterfOrPort := nil; case Interfac.IsPort of biTrue: MemTable_InterfOrPort := MemTable_Port; biFalse: MemTable_InterfOrPort := MemTable_InterfaceRel; end; if Not((Interfac.IsPort = biFalse) and (ItemType in [itSCSLine, itSCSConnector])) then if Assigned(MemTable_InterfOrPort) then begin CanAddRecord := true; //*** Присоединенные Интерфейсы комплектующих if Interfac.TypeI = itConstructive then begin CurrListInterfTo := GetInterfToListByIDInterfRel(Interfac.ID); ListInterfTo.Assign(CurrListInterfTo, laOr); if IsLine = biFalse then if CurrListInterfTo.Count > 0 then CanAddRecord := false; FreeAndNil(CurrListInterfTo); if CanAddRecord then if AParentInterfTo <> nil then if Not CheckNoIDinList(Interfac.ID, AParentInterfTo) then CanAddRecord := false; end; if CanAddRecord then begin for j := 0 to AComplCount - 1 do begin MemTable_InterfOrPort.Append; MemTable_InterfOrPort.Edit; MemTable_InterfOrPort.FieldByName('ID').AsInteger := Interfac.ID; MemTable_InterfOrPort.FieldByName(fnNpp).AsInteger := Interfac.Npp; MemTable_InterfOrPort.FieldByName('ID_COMPONENT').AsInteger := Interfac.ID_Component; MemTable_InterfOrPort.FieldByName('ID_INTERFACE').AsInteger := Interfac.ID_Interface; MemTable_InterfOrPort.FieldByName('TYPEI').AsInteger := Interfac.TypeI; MemTable_InterfOrPort.FieldByName('IsPort').AsInteger := Interfac.IsPort; MemTable_InterfOrPort.FieldByName('Kind').AsInteger := Interfac.Kind; MemTable_InterfOrPort.FieldByName('GENDER').AsInteger := Interfac.Gender; MemTable_InterfOrPort.FieldByName('Multiple').AsInteger := Interfac.Multiple; MemTable_InterfOrPort.FieldByName('ISBUSY').AsInteger := Interfac.IsBusy; MemTable_InterfOrPort.FieldByName('SORT_ID').AsInteger := Interfac.SortID; MemTable_InterfOrPort.FieldByName(fnNotice).AsString := Interfac.Notice; MemTable_InterfOrPort.FieldByName('isNative').AsBoolean := isFirstCalling; if Interfac.IsPort = biFalse then begin MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI; MemTable_InterfOrPort.FieldByName('Num_Pair').AsInteger := Interfac.NumPair; MemTable_InterfOrPort.FieldByName('id_adverse').AsInteger := Interfac.IDAdverse; MemTable_InterfOrPort.FieldByName('Side').AsInteger := Interfac.Side; end; if Interfac.IsPort = biTrue then begin MemTable_InterfOrPort.FieldByName('IsUser_Port').AsInteger := Interfac.IsUserPort; MemTable_InterfOrPort.FieldByName('Npp_Port').AsInteger := Interfac.NppPort; if TF_Main(GForm).GDBMode = bkProjectManager then begin MemTable_InterfOrPort.FieldByName('id_connected').AsInteger := Interfac.IDConnected; if Interfac.IDConnected > 0 then begin MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(GetIDComponByInterfID(Interfac.IDConnected)); //TF_Main(GForm).GetComponNameForVisible(scsQSelect.FN('NAME_SHORT').AsString, scsQSelect.FN('NAME_MARK').AsString); MemTable_InterfOrPort.FieldByName('name_connected').AsString := MemTable_InterfOrPort.FieldByName('name_connected').AsString +' \ Порт '+ GetNamePortByIDPort(Interfac.IDConnected); end; //*** Загрузить подсоединенный кабель, если он есть SCSComponent := TSCSComponent(Interfac.ComponentOwner); if Assigned(SCSComponent) then if SCSComponent.JoinedComponents.Count > 0 then for k := 0 to SCSComponent.JoinedComponents.Count - 1 do if Assigned(SCSComponent.JoinedComponents[k]) then if SCSComponent.JoinedComponents[k].IsLine = biTrue then begin MemTable_InterfOrPort.FieldByName(fnNameConnectCable).AsString := SCSComponent.JoinedComponents[k].GetNameForVisible(false); //GetComponNameForVisible(SCSComponent.JoinedComponents[k].Name, SCSComponent.JoinedComponents[k].NameMark); Break; ///// BREAK ///// end; end; end; //*** Подгрузить Объем с вычитанием объемов комплектующих if Interfac.TypeI = itConstructive then if IsLine = biTrue then begin ChildSumValueI := GetConnectedInterfacesValues(scsQSelect, Interfac.ID); MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI - ChildSumValueI; end; MemTable_InterfOrPort.FieldByName('Color').AsInteger := Interfac.Color; if TF_Main(GForm).GDBMode = bkProjectManager then MemTable_InterfOrPort.FieldByName('CoordZ').AsFloat := Interfac.CoordZ; MemTable_InterfOrPort.Post; //*** Связь портов с интерфейсами if (Interfac.IsPort = biTrue) and (isFirstCalling) then begin if TF_Main(GForm).GDBMode = bkNormBase then Interfac.LoadPortInterfRels; for k := 0 to Interfac.PortInterfRels.Count - 1 do begin ptrPortInterfRel := Interfac.PortInterfRels[k]; InterfFromPort := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin InterfFromPort := TSCSInterface.Create(GForm); InterfFromPort.LoadByID(ptrPortInterfRel.IDInterfRel); end; bkProjectManager: InterfFromPort := TF_Main(GForm).GSCSBase.CurrProject.CurrList.GetInterfaceByIDAndIDComponent(ptrPortInterfRel.IDInterfRel, Interfac.ID_Component); end; MemTable_PortInterfRel.Append; MemTable_PortInterfRel.FieldByName(fnID).AsInteger := ptrPortInterfRel.ID; //MemTable_PortInterfRel.FieldByName(fnIDPort).AsInteger := ptrPortInterfRel.IDPort; MemTable_PortInterfRel.FieldByName(fnIDInterfRel).AsInteger := ptrPortInterfRel.IDInterfRel; if Assigned(InterfFromPort) then MemTable_PortInterfRel.FieldByName(fnName).AsString := F_NormBase.DM.GetInterfaceNameByID(InterfFromPort.ID_Interface); MemTable_PortInterfRel.Post; end; end; end; end; end; end; FreeAndNil(Interfaces); //FreeList(Interfaces); if IsLine = biFalse then begin //*** Выбрать ID комплектующих //IDChildList := GetComponCompRels(AID_Compon, cntComplect); IDChildList := GetComponChildsCompRels(AID_Compon); for i := 0 to IDChildList.Count - 1 do begin ptrCompRel := IDChildList.Items[i]; FillStep(ptrCompRel.ID_Child, AID_Compon, ptrCompRel.Kolvo * AComplCount, ListInterfTo, false); end; FreeList(IDChildList); end; Freelist(ListInterfTo); end; //*** Подгружает Названия интерфейсов procedure LoadNames(AMemTable: TkbmMemTable); var i: Integer; ID_Interf: Integer; ptrInterfaceInfo: PInterfaceInfo; InterfaceInfoList: TList; begin if Not AMemTable.Active then Exit; ///// EXIT ///// InterfaceInfoList := TList.Create; AMemTable.Last; with F_NormBase.DM do ChangeSQLQuery(scsQ, ' select name from interface where id = :id '); while Not AMemTable.Bof do begin ID_Interf := AMemTable.FieldByName('ID_Interface').AsInteger; ptrInterfaceInfo := nil; //*** Найти наименование интерфейса for i := 0 to InterfaceInfoList.Count - 1 do begin if TInterfaceInfo(InterfaceInfoList[i]^).ID = ID_Interf then begin ptrInterfaceInfo := InterfaceInfoList[i]; Break; ///// BREAK ///// end; END; if ptrInterfaceInfo = nil then with F_NormBase.DM do begin //SetSQLToQuery(scsQ, ' SELECT NAME FROM INTERFACE WHERE ID = '''+ IntToStr(ID_Interf) +''' '); scsQ.Close; scsQ.SetParamAsInteger('id', ID_Interf); scsQ.ExecQuery; GetMem(ptrInterfaceInfo, SizeOf(TInterfaceInfo)); ptrInterfaceInfo.ID := ID_Interf; ptrInterfaceInfo.Name := scsQ.GetFNAsString('Name'); InterfaceInfoList.Add(ptrInterfaceInfo); end; if ptrInterfaceInfo <> nil then begin AMemTable.Edit; AMemTable.FieldByName('Name').AsString := ptrInterfaceInfo.Name; AMemTable.Post; end; AMemTable.Prior; { AMemTable.Edit; AMemTable.FieldByName('Name').AsString := F_NormBase.DM.scsQ.GetFNAsString('Name'); AMemTable.Post; AMemTable.Prior; } end; scsQ.Close; FreeList(InterfaceInfoList); end; begin try try IDParentCompon := -1; ParentListInterfTo := nil; WasLoadInterf := false; //case AIsPort of // biTrue: // MemTable_InterfOrPort := MemTable_Port; // biFalse: // MemTable_InterfOrPort := MemTable_InterfaceRel; //end; //MemTable_InterfOrPort.DisableControls; ItemType := PObjectData(ANode.Data).ItemType; MemTable_InterfaceRel.Active := false; MemTable_InterfaceRel.Active := true; MemTable_InterfaceRel.DisableControls; MemTable_Port.AfterScroll := nil; MemTable_Port.Active := false; MemTable_Port.Active := true; MemTable_Port.DisableControls; //*** Загрузка для компоненты if AComponOrObj is TSCSComponent then begin if Assigned(ANode) and Assigned(ANode.Parent) then begin ParentDat := ANode.Parent.Data; //if ParentDat.ItemType = itComponCon then IDParentCompon := ParentDat.ObjectID; //*** Интерфейсы Предка if ParentDat.ItemType in [itComponCon, itComponLine] then ParentListInterfTo := GetInterfToListByIDCompon(IDParentCompon); end; IsLine := TSCSComponent(AComponOrObj).IsLine; FillStep(TSCSComponent(AComponOrObj).ID, IDParentCompon, 1, ParentListInterfTo, true); //LoadNames; end; if AComponOrObj is TSCSCatalog then if TSCSCatalog(AComponOrObj).ItemType in [itSCSConnector, itSCSLine] then begin case TSCSCatalog(AComponOrObj).ItemType of itSCSLine: IsLine := biTrue; itSCSConnector: isLine := biFalse; end; IDParentCompon := -1; tSQL_Katalog.Filtered := false; tSQL_Component.Filtered := false; tSQL_CatalogRelation.Filtered := false; TSCSCatalog(AComponOrObj).LoadComponents(TSCSCatalog(AComponOrObj).ID, false); for i := 0 to TSCSCatalog(AComponOrObj).SCSComponents.Count - 1 do begin if i = 0 then FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, true) else FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, false); WasLoadInterf := true; end; //if WasLoadInterf then //LoadNames; end; //MemTable_InterfOrPort.EnableControls; LoadNames(MemTable_InterfaceRel); LoadNames(MemTable_Port); except on E: Exception do AddExceptionToLog('TDM.FillMemTableInterfRel: '+E.Message); end; finally MemTable_InterfaceRel.EnableControls; MemTable_Port.EnableControls; MemTable_Port.AfterScroll := MemTable_PortAfterScroll; MemTable_PortAfterScroll(MemTable_Port); FreeList(ParentListInterfTo); end; end; *) (* // ##### Заполнить таблицу интерфейсами ##### procedure TDM.FillMemTableInterfRel(AComponOrObj: TObject; ANode: TTreeNode; AIsPort: Integer); type TIDandCount = record ID: Integer; Child_ID: Integer; Count: Integer; end; PIDandCount = ^TIDandCount; var MemTable_InterfOrPort: TkbmMemTable; ComplIDIOfI: ^Integer; ParentDat: PObjectData; IDParentCompon: Integer; ParentListInterfTo: Tlist; ChildSumValueI: Double; WasLoadInterf: Boolean; IsLine: Integer; i: Integer; procedure FillStep(AID_Compon, AIDParentCompon, AComplCount: Integer; AParentInterfTo: TList; isFirstCalling: Boolean); var Interfaces: TList; Interfac: TSCSInterface; ptrInterfConnected: TSCSInterface; IDChildList: TList; strIDParentCompon: String; strIDCurrInterf: String; ptrIDCount: PIDandCount; ptrCompRel: PComplect; i, j, k: Integer; LCount: Integer; //ComplIDIOfIList: TList; //ComplIDIOfI: ^Integer; ListInterfTo: TList; CurrListInterfTo: TList; CanAddRecord: Boolean; SCSComponent: TSCSComponent; begin ListInterfTo := TList.Create; strIDParentCompon := IntToStr(AIDParentCompon); Interfaces := GetComponInterfaces(AID_Compon, AIsPort); if isFirstCalling then begin MemTable_InterfOrPort.Active := false; MemTable_InterfOrPort.Active := true; end; for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces[i]; //*** Присоединенные Интерфейсы комплектующих CurrListInterfTo := GetInterfToListByIDInterfRel(Interfac.ID); ListInterfTo.Assign(CurrListInterfTo, laOr); CanAddRecord := true; if IsLine = biFalse then if CurrListInterfTo.Count > 0 then CanAddRecord := false; FreeAndNil(CurrListInterfTo); if CanAddRecord then if AParentInterfTo <> nil then if Not CheckNoIDinList(Interfac.ID, AParentInterfTo) then CanAddRecord := false; if CanAddRecord then begin for j := 0 to AComplCount - 1 do begin MemTable_InterfOrPort.Append; MemTable_InterfOrPort.Edit; MemTable_InterfOrPort.FieldByName('ID').AsInteger := Interfac.ID; MemTable_InterfOrPort.FieldByName(fnNpp).AsInteger := Interfac.Npp; MemTable_InterfOrPort.FieldByName('ID_COMPONENT').AsInteger := Interfac.ID_Component; MemTable_InterfOrPort.FieldByName('ID_INTERFACE').AsInteger := Interfac.ID_Interface; MemTable_InterfOrPort.FieldByName('TYPEI').AsInteger := Interfac.TypeI; MemTable_InterfOrPort.FieldByName('IsPort').AsInteger := Interfac.IsPort; MemTable_InterfOrPort.FieldByName('Kind').AsInteger := Interfac.Kind; MemTable_InterfOrPort.FieldByName('GENDER').AsInteger := Interfac.Gender; MemTable_InterfOrPort.FieldByName('Multiple').AsInteger := Interfac.Multiple; MemTable_InterfOrPort.FieldByName('ISBUSY').AsInteger := Interfac.IsBusy; MemTable_InterfOrPort.FieldByName('SORT_ID').AsInteger := Interfac.SortID; MemTable_InterfOrPort.FieldByName(fnNotice).AsString := Interfac.Notice; MemTable_InterfOrPort.FieldByName('isNative').AsBoolean := isFirstCalling; if AIsPort = biFalse then begin MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI; MemTable_InterfOrPort.FieldByName('Num_Pair').AsInteger := Interfac.NumPair; MemTable_InterfOrPort.FieldByName('id_adverse').AsInteger := Interfac.IDAdverse; MemTable_InterfOrPort.FieldByName('Side').AsInteger := Interfac.Side; end; if AIsPort = biTrue then begin MemTable_InterfOrPort.FieldByName('IsUser_Port').AsInteger := Interfac.IsUserPort; MemTable_InterfOrPort.FieldByName('Npp_Port').AsInteger := Interfac.NppPort; if TF_Main(GForm).GDBMode = bkProjectManager then begin MemTable_InterfOrPort.FieldByName('id_connected').AsInteger := Interfac.IDConnected; if Interfac.IDConnected > 0 then begin MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(GetIDComponByInterfID(Interfac.IDConnected)); //TF_Main(GForm).GetComponNameForVisible(scsQSelect.FN('NAME_SHORT').AsString, scsQSelect.FN('NAME_MARK').AsString); MemTable_InterfOrPort.FieldByName('name_connected').AsString := MemTable_InterfOrPort.FieldByName('name_connected').AsString +' \ Порт '+ GetNamePortByIDPort(Interfac.IDConnected); end; //*** Загрузить подсоединенный кабель, если он есть SCSComponent := TSCSComponent(Interfac.ComponentOwner); if Assigned(SCSComponent) then if SCSComponent.JoinedComponents.Count > 0 then for k := 0 to SCSComponent.JoinedComponents.Count - 1 do if Assigned(SCSComponent.JoinedComponents[k]) then if SCSComponent.JoinedComponents[k].IsLine = biTrue then begin MemTable_InterfOrPort.FieldByName(fnNameConnectCable).AsString := SCSComponent.JoinedComponents[k].GetNameForVisible(false); //GetComponNameForVisible(SCSComponent.JoinedComponents[k].Name, SCSComponent.JoinedComponents[k].NameMark); Break; ///// BREAK ///// end; end; { MemTable_InterfOrPort.FieldByName('IsUser_Port').AsInteger := Interfac.IsUserPort; MemTable_InterfOrPort.FieldByName('Npp_Port').AsInteger := Interfac.NppPort; if TF_Main(GForm).GDBMode = bkProjectManager then begin MemTable_InterfOrPort.FieldByName('id_connected').AsInteger := Interfac.IDConnected; if Interfac.IDConnected > 0 then begin MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(GetIDComponByInterfID(Interfac.IDConnected)); //TF_Main(GForm).GetComponNameForVisible(scsQSelect.FN('NAME_SHORT').AsString, scsQSelect.FN('NAME_MARK').AsString); MemTable_InterfOrPort.FieldByName('name_connected').AsString := MemTable_InterfOrPort.FieldByName('name_connected').AsString +'/Порт '+ GetNamePortByIDPort(Interfac.IDConnected); end; end; //*** Загрузить подсоединенный кабель, если он есть if Assigned(Interfac.ConnectedInterfaces) then for k := 0 to Interfac.ConnectedInterfaces.Count - 1 do begin ptrInterfConnected := Interfac.ConnectedInterfaces[k]; if Interfac.ID_Component <> ptrInterfConnected.ID_Component then if Assigned(ptrInterfConnected.ComponentOwner) then if TSCSComponent(ptrInterfConnected.ComponentOwner).IsLine = biTrue then MemTable_InterfOrPort.FieldByName(fnNameConnectCable).AsString := TF_Main(GForm).GetComponNameForVisible(TSCSComponent(ptrInterfConnected.ComponentOwner).Name, TSCSComponent(ptrInterfConnected.ComponentOwner).NameMark); end; } end; //*** Подгрузить Объем с вычитанием объемов комплектующих if Interfac.TypeI = itConstructive then if IsLine = biTrue then begin ChildSumValueI := GetConnectedInterfacesValues(scsQSelect, Interfac.ID); MemTable_InterfOrPort.FieldByName('ValueI').AsFloat := Interfac.ValueI - ChildSumValueI; end; MemTable_InterfOrPort.FieldByName('Color').AsInteger := Interfac.Color; if TF_Main(GForm).GDBMode = bkProjectManager then MemTable_InterfOrPort.FieldByName('CoordZ').AsFloat := Interfac.Color; MemTable_InterfOrPort.Post; end; end; end; FreeList(Interfaces); if IsLine = biFalse then begin //*** Выбрать ID комплектующих IDChildList := GetComponCompRels(AID_Compon, cntComplect); for i := 0 to IDChildList.Count - 1 do begin ptrCompRel := IDChildList.Items[i]; FillStep(ptrCompRel.ID_Child, AID_Compon, ptrCompRel.Kolvo * AComplCount, ListInterfTo, false); end; FreeList(IDChildList); end; Freelist(ListInterfTo); end; //*** Подгружает Названия интерфейсов procedure LoadNames; var i: Integer; ID_Interf: Integer; begin if Not MemTable_InterfOrPort.Active then Exit; ///// EXIT ///// MemTable_InterfOrPort.Last; with F_NormBase.DM do ChangeSQLQuery(scsQ, ' select name from interface where id = :id '); while Not MemTable_InterfOrPort.Bof do begin ID_Interf := MemTable_InterfOrPort.FieldByName('ID_Interface').AsInteger; with F_NormBase.DM do begin //SetSQLToQuery(scsQ, ' SELECT NAME FROM INTERFACE WHERE ID = '''+ IntToStr(ID_Interf) +''' '); scsQ.Close; scsQ.SetParamAsInteger('id', ID_Interf); scsQ.ExecQuery; end; MemTable_InterfOrPort.Edit; MemTable_InterfOrPort.FieldByName('Name').AsString := F_NormBase.DM.scsQ.GetFNAsString('Name'); MemTable_InterfOrPort.Post; MemTable_InterfOrPort.Prior; end; scsQ.Close; end; begin try try IDParentCompon := -1; ParentListInterfTo := nil; WasLoadInterf := false; case AIsPort of biTrue: MemTable_InterfOrPort := MemTable_Port; biFalse: MemTable_InterfOrPort := MemTable_InterfaceRel; end; MemTable_InterfOrPort.DisableControls; //*** Загрузка для компоненты if AComponOrObj is TSCSComponent then begin if Assigned(ANode) and Assigned(ANode.Parent) then begin ParentDat := ANode.Parent.Data; //if ParentDat.ItemType = itComponCon then IDParentCompon := ParentDat.ObjectID; //*** Интерфейсы Предка if ParentDat.ItemType in [itComponCon, itComponLine] then ParentListInterfTo := GetInterfToListByIDCompon(IDParentCompon); end; IsLine := TSCSComponent(AComponOrObj).IsLine; FillStep(TSCSComponent(AComponOrObj).ID, IDParentCompon, 1, ParentListInterfTo, true); LoadNames; end; if AComponOrObj is TSCSCatalog then if TSCSCatalog(AComponOrObj).ItemType in [itSCSConnector, itSCSLine] then begin case TSCSCatalog(AComponOrObj).ItemType of itSCSLine: IsLine := biTrue; itSCSConnector: isLine := biFalse; end; IDParentCompon := -1; tSQL_Katalog.Filtered := false; tSQL_Component.Filtered := false; tSQL_CatalogRelation.Filtered := false; TSCSCatalog(AComponOrObj).LoadComponents(TSCSCatalog(AComponOrObj).ID, false); for i := 0 to TSCSCatalog(AComponOrObj).SCSComponents.Count - 1 do begin if i = 0 then FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, true) else FillStep(TSCSComponent(TSCSCatalog(AComponOrObj).SCSComponents[i]).ID, IDParentCompon, 1, ParentListInterfTo, false); WasLoadInterf := true; end; if WasLoadInterf then LoadNames; end; MemTable_InterfOrPort.EnableControls; except on E: Exception do AddExceptionToLog('TDM.FillMemTableInterfRel', E.Message); end; finally FreeList(ParentListInterfTo); end; end; *) function TDM.GetIDInterfListByNumPair(AIDComponent, ANumPair: Integer): TIntList; var SCSComponent: TSCSComponent; Interf: TSCSInterface; i: Integer; begin Result := nil; try Result := TIntList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select id from interface_relation '+ ' where (id_component = '''+IntToStr(AIDComponent)+''') and '+ ' (Num_Pair = '''+IntTOStr(ANumPair)+''') '); IntFieldToIntList(Result, scsQSelect, fnID); end; bkProjectManager: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interf := SCSComponent.Interfaces[i]; if Interf.NumPair = ANumPair then Result.Add(Interf.ID); end; end; end; except on E: Exception do AddExceptionToLog('TDM.GetIDInterfListByNumPair: '+E.Message); end; end; {// ##### Заполнить таблицу интерфейсами ##### procedure TDM.FillMemTableInterfRel(AID_Component: Integer); type TIDandCount = record ID: Integer; Child_ID: Integer; Count: Integer; end; PIDandCount = ^TIDandCount; var //ComplIDIOfIList: TList; ComplIDIOfI: ^Integer; //*** Добавлет в список занятые интерфейсы компоненты procedure AddBusyComplID(AID_InterfaceRel: Integer; var AList: TList); begin SetSQLToQuery(scsQ1, ' SELECT ID_CON_IOFI FROM INTERFOFINTERF_RELATION '+ ' WHERE (ID_INTERF_REL = '''+ IntToStr(AID_InterfaceRel) +''')/* and '+ ' (isBusy = 1) */' ); while Not scsQ1.Eof do begin new(ComplIDIOfI); ComplIDIOfI^ := scsQ1.FN('ID_CON_IOFI').AsInteger; AList.Add(ComplIDIOfI); scsQ1.Next; end; end; //*** Проверка на наличие ID в списке всех данных интерфейса, ID которого = AID_Interface function CheckBusyComplID(AID_Interface : Integer; AList: TList): Boolean; var i: Integer; ComplID: Integer; Finded: Boolean; begin Result := true; SetSQLToQuery(scsQ1, ' SELECT ID FROM INTERFOFINTERF_RELATION '+ ' WHERE ID_INTERF_REL = '''+ IntToStr(AID_Interface) +''' '); while Not scsQ1.Eof do begin Finded := false; for i := 0 to AList.Count - 1 do if Integer(AList.Items[i]^) = scsQ1.FN('ID').AsInteger then Finded := true; if Not Finded then begin Result := false; Break; end; scsQ1.Next; end; end; procedure FillStep(AID_Compon, AComplCount: Integer; ABusyComplIDList: TList; isFirstCalling: Boolean); var IDChildList: TList; //IDChild: ^integer; IDCount: PIDandCount; i: Integer; LCount: Integer; ComplIDIOfIList: TList; ComplIDIOfI: ^Integer; CanAddRecord: Boolean; begin ComplIDIOfIList := TList.Create; SetSQLToQuery(scsQ, ' SELECT * FROM INTERFACE_RELATION/*, INTERFACE */'+ ' WHERE (INTERFACE_RELATION.ID_COMPONENT = '''+IntToStr(AID_Compon)+''' ) AND '+ //' (INTERFACE_RELATION.ID_INTERFACE = INTERFACE.ID) and ' + ' (INTERFACE_RELATION.ID_COMPONENT in (SELECT ID FROM COMPONENT) )' + ' ORDER BY INTERFACE_RELATION.ID ' ); if isFirstCalling then begin MemTable_InterfaceRel.Active := false; MemTable_InterfaceRel.Active := true; end; while Not scsQ.Eof do begin //*** Добавить ID-ки присоединенных данных интерфейса (ID которого в параметре ниже) // в не выводимых позицииях в список ComplIDIOfIList AddBusyComplID(scsQ.FN('ID').AsInteger, ComplIDIOfIList); if isFirstCalling = false then CanAddRecord := Not(CheckBusyComplID(scsQ.FN('ID').AsInteger, ABusyComplIDList) ) else CanAddRecord := true; //*** Определить количество интерфейсов SetSQLToQuery(scsQ1, ' SELECT COUNT(*) FROM INTERFOFINTERF_RELATION ' + ' WHERE (ID_INTERF_REL = '''+ IntToStr(scsQ.FN('ID').AsInteger) +''') /*and '+ ' (ISBUSY = 0)*/ '); if (scsQ1.FN('Count').AsInteger > 0) and //*** Если занятые не все позиции (CanAddRecord) then begin for i := 0 to AComplCount - 1 do begin MemTable_InterfaceRel.Append; MemTable_InterfaceRel.Edit; MemTable_InterfaceRel.FieldByName('ID').AsInteger := scsQ.FN('ID').AsInteger; MemTable_InterfaceRel.FieldByName('ID_COMPONENT').AsInteger := scsQ.FN('ID_COMPONENT').AsInteger; MemTable_InterfaceRel.FieldByName('ID_INTERFACE').AsInteger := scsQ.FN('ID_INTERFACE').AsInteger; //MemTable_InterfaceRel.FieldByName('NAME').AsString := scsQ.FN('NAME').AsString; MemTable_InterfaceRel.FieldByName('TYPEI').AsInteger := scsQ.FN('TYPEI').AsInteger; MemTable_InterfaceRel.FieldByName('GENDER').AsInteger := scsQ.FN('GENDER').AsInteger; MemTable_InterfaceRel.FieldByName('KOLVO').AsInteger := scsQ.FN('KOLVO').AsInteger; MemTable_InterfaceRel.FieldByName('SORT_ID').AsInteger := scsQ.FN('SORT_ID').AsInteger; MemTable_InterfaceRel.FieldByName('isNative').AsBoolean := isFirstCalling; MemTable_InterfaceRel.Post; end; end; scsQ.Next; end; //(GForm as TF_Main).FreeList(ComplIDIOfIList); //*** Выбрать ID комплектующих SetSQLToQuery(scsQ, ' SELECT ID, ID_Child, KOLVO FROM COMPONENT_RELATION '+ ' WHERE (CONNECT_TYPE = '''+ IntToStr(cntComplect) +''') and '+ ' (ID_COMPONENT = '''+ IntToStr(AID_Compon) +''') and '+ ' (ID_COMPONENT IN (SELECT ID FROM COMPONENT) ) ' ); IDChildList := TList.create; while Not scsQ.Eof do begin New(IDCount); IDCount.ID := scsQ.FN('ID').AsInteger; IDCount.Child_ID := scsQ.FN('ID_Child').AsInteger; IDCount.Count := scsQ.FN('Kolvo').AsInteger; IDChildList.Add(IDCount); scsQ.Next; end; LCount := IDChildList.Count; for i := 0 to LCount - 1 do begin IDCount := IDChildList.Items[i]; FillStep(IDCount.Child_ID, IDCount.Count * AComplCount, ComplIDIOfIList, false); end; FreeList(ComplIDIOfIList); FreeList(IDChildList); end; //*** Подгружает Названия интерфейсов procedure LoadNames; var i: Integer; ID_Interf: Integer; begin MemTable_InterfaceRel.Last; while Not MemTable_InterfaceRel.Bof do begin ID_Interf := MemTable_InterfaceRel.FieldByName('ID_Interface').AsInteger; with F_NormBase.DM do SetSQLToQuery(scsQ, ' SELECT NAME FROM INTERFACE WHERE ID = '''+ IntToStr(ID_Interf) +''' '); MemTable_InterfaceRel.Edit; MemTable_InterfaceRel.FieldByName('Name').AsString := F_NormBase.DM.scsQ.FN('Name').AsString; MemTable_InterfaceRel.Post; MemTable_InterfaceRel.Prior; end; end; begin //(GForm as TF_Main).Grid_CompData.BeginUpdate; FillStep(AID_Component, 1, nil, true); LoadNames; //(GForm as TF_Main).Grid_CompData.EndUpdate; end; } procedure TDM.FillMemTableCableCanalConnectors(AMemTable: TkbmMemTable; ACableCanalConnectors: TList; AAsNew: Boolean); var ConnectorName: String; ptrCableCanalConnector: PCableCanalConnector; i: Integer; begin if Not AMemTable.Active then AMemTable.Active := true; for i := 0 to ACableCanalConnectors.Count - 1 do begin ptrCableCanalConnector := ACableCanalConnectors[i]; AMemTable.Append; SetCableCanalConnectorTokbmMemTable(AMemTable, ptrCableCanalConnector); if AMemTable.FieldDefs.IndexOf(fnIsModified) <> -1 then AMemTable.FieldByName(fnIsModified).AsBoolean := false; if AMemTable.FieldDefs.IndexOf(fnIsNew) <> -1 then AMemTable.FieldByName(fnIsNew).AsBoolean := AAsNew; AMemTable.Post; end; if AAsNew then if AMemTable.RecordCount > 0 then AMemTable.First; end; // ##### Заполнить таблицу свойтсвами ##### procedure TDM.FillMemTableProp(AMemTable: TkbmMemTable; APropKind: TPropKind); var //SQuery: TSCSQuery; MasterField: String; PropertyData: TPropertyData; begin //SQuery := scsQSelect; case APropKind of pkCatalog: MasterField := 'ID_CATALOG'; pkCompon : MasterField := 'ID_COMPONENT'; end; AMemTable.Active := false; AMemTable.Active := true; AMemTable.DisableControls; while Not Query_Select.Eof do begin AMemTable.Append; AMemTable.Edit; AMemTable.FieldByName('ID').AsInteger := Query_Select.FN('ID').AsInteger; AMemTable.FieldByName('ID_Master').AsInteger := Query_Select.FN(MasterField).AsInteger; AMemTable.FieldByName('ID_Property').AsInteger := Query_Select.FN('ID_Property').AsInteger; AMemTable.FieldByName('PValue').AsString := Query_Select.FN('PValue').AsString; AMemTable.FieldByName(fnIsDefault).AsInteger := Query_Select.FN(fnIsDefault).AsInteger; if APropKind = pkCompon then begin AMemTable.FieldByName('take_into_connect').AsInteger := Query_Select.FN('take_into_connect').AsInteger; AMemTable.FieldByName('take_into_join').AsInteger := Query_Select.FN('take_into_join').AsInteger; AMemTable.FieldByName(fnIsCrossControl).AsInteger := Query_Select.FN(fnIsCrossControl).AsInteger; AMemTable.FieldByName(fnIDCrossProperty).AsInteger := Query_Select.FN(fnIDCrossProperty).AsInteger; end; PropertyData := GetPropertyData(AMemTable.FieldByName(fnIDProperty).AsInteger, ''); AMemTable.FieldByName(fnIDDataType).AsInteger := PropertyData.IDDataType; AMemTable.FieldByName(fnName).AsString := PropertyData.Name; AMemTable.FieldByName(fnSysName).AsString := PropertyData.SysName; AMemTable.FieldByName(fnIzm).AsString := PropertyData.Izm; AMemTable.FieldByName(fnDescription).AsString := PropertyData.Description; AMemTable.FieldByName(fnisStandart).AsInteger := PropertyData.IsStandart; AMemTable.FieldByName(fnIsForWholeComponent).AsInteger := PropertyData.IsForWholeComponent; {with F_NormBase.DM do begin SetSQLToQuery(scsQ, ' SELECT NAME, SYSNAME, IZM, DESCRIPTION, ID_DATA_TYPE, IsStandart FROM PROPERTIES '+ ' WHERE ID = '''+ IntToStr(AMemTable.FieldByName('ID_Property').AsInteger) +''' '); AMemTable.FieldByName('ID_DATA_TYPE').AsInteger := scsQ.GetFNAsInteger('ID_DATA_TYPE'); AMemTable.FieldByName('NAME').AsString := scsQ.GetFNAsString('NAME'); AMemTable.FieldByName('SYSNAME').AsString := scsQ.GetFNAsString('SYSNAME'); AMemTable.FieldByName('IZM').AsString := scsQ.GetFNAsString('IZM'); AMemTable.FieldByName('DESCRIPTION').AsString := scsQ.GetFNAsString('DESCRIPTION'); AMemTable.FieldByName('isStandart').AsInteger := scsQ.GetFNAsInteger('isStandart'); end;} AMemTable.Post; Query_Select.Next; end; //if Not AMemTable.Eof then //AMemTable.First; AMemTable.EnableControls; end; procedure TDM.FillMemTablePropFromMemBase(AMemTable: TkbmMemTable; APropKind: TPropKind); var MasterTable: TSQLMemTable; MasterField: String; PValue: String; PropertyData: TPropertyData; begin try case APropKind of pkCatalog: begin MasterTable := tSQL_CatalogPropRelation; MasterField := 'ID_CATALOG'; end; pkCompon : begin MasterTable := tSQL_CompPropRelation; MasterField := 'ID_COMPONENT'; end; end; try try TF_Main(GForm).GT_PROPERTY.DataController.DataSource := nil; finally AMemTable.Active := false; end; except end; AMemTable.Active := true; TF_Main(GForm).GT_PROPERTY.DataController.DataSource := DataSource_MT_Property; AMemTable.DisableControls; if Not MasterTable.Eof then MasterTable.First; while Not MasterTable.Eof do begin AMemTable.Append; AMemTable.Edit; AMemTable.FieldByName('ID').AsInteger := MasterTable.FieldByName('ID').AsInteger; AMemTable.FieldByName('ID_Master').AsInteger := MasterTable.FieldByName(MasterField).AsInteger; AMemTable.FieldByName('ID_Property').AsInteger := MasterTable.FieldByName('ID_Property').AsInteger; AMemTable.FieldByName(fnGUIDProperty).AsString := MasterTable.FieldByName(fnGUIDProperty).AsString; AMemTable.FieldByName('PValue').AsString := MasterTable.FieldByName('PValue').AsString; AMemTable.FieldByName(fnIsDefault).AsInteger := MasterTable.FieldByName(fnIsDefault).AsInteger; if APropKind = pkCompon then begin AMemTable.FieldByName('take_into_connect').AsInteger := MasterTable.FieldByName('take_into_connect').AsInteger; AMemTable.FieldByName('take_into_join').AsInteger := MasterTable.FieldByName('take_into_join').AsInteger; end; PropertyData := GetPropertyData(AMemTable.FieldByName(fnIDProperty).AsInteger, AMemTable.FieldByName(fnGUIDProperty).AsString); AMemTable.FieldByName(fnIDDataType).AsInteger := PropertyData.IDDataType; AMemTable.FieldByName(fnName).AsString := PropertyData.Name; AMemTable.FieldByName(fnSysName).AsString := PropertyData.SysName; AMemTable.FieldByName(fnIzm).AsString := PropertyData.Izm; AMemTable.FieldByName(fnDescription).AsString := PropertyData.Description; AMemTable.FieldByName(fnisStandart).AsInteger := PropertyData.IsStandart; {with F_NormBase.DM do begin SetSQLToQuery(scsQ, ' SELECT NAME, SYSNAME, IZM, DESCRIPTION, ID_DATA_TYPE, IsStandart FROM PROPERTIES '+ ' WHERE ID = '''+ IntToStr(AMemTable.FieldByName('ID_Property').AsInteger) +''' '); AMemTable.FieldByName('ID_DATA_TYPE').AsInteger := scsQ.GetFNAsInteger('ID_DATA_TYPE'); AMemTable.FieldByName('NAME').AsString := scsQ.GetFNAsString('NAME'); AMemTable.FieldByName('SYSNAME').AsString := scsQ.GetFNAsString('SYSNAME'); AMemTable.FieldByName('IZM').AsString := scsQ.GetFNAsString('IZM'); AMemTable.FieldByName('DESCRIPTION').AsString := scsQ.GetFNAsString('DESCRIPTION'); AMemTable.FieldByName('isStandart').AsInteger := scsQ.GetFNAsInteger('isStandart'); AMemTable.FieldByName('PValue').AsString := PValue; end;} AMemTable.Post; MasterTable.Next; end; if Not AMemTable.Eof then AMemTable.First; AMemTable.EnableControls; except on E: Exception do AddExceptionToLog('TDM.FillMemTablePropFromMemBase: '+E.Message); end; end; procedure TDM.FillMemTablePropFromList(AMemTable: TkbmMemTable; AList: TList; AAsNew: Boolean; ASkipCalcProps: Boolean=false; AReactive: Boolean=true); var i: Integer; ptrProperty: PProperty; PropertyData: TPropertyData; IsObjAdress: Boolean; begin AMemTable.DisableControls; try IsObjAdress := AMemTable.FieldDefs.IndexOf(fnObjectAddress) <> -1; if AReactive then begin AMemTable.Active := false; AMemTable.Active := true; end; for i := 0 to AList.Count - 1 do begin ptrProperty := AList[i]; if Not ASkipCalcProps or (GPropSysNameCalc.IndexOf(ptrProperty.SysName) = -1) then begin AMemTable.Append; AMemTable.FieldByName(fnID).AsInteger := ptrProperty.ID; AMemTable.FieldByName(fnIDMaster).AsInteger := ptrProperty.IDMaster; AMemTable.FieldByName(fnGuidProperty).AsString := ptrProperty.GUIDProperty; AMemTable.FieldByName(fnIDProperty).AsInteger := ptrProperty.ID_Property; AMemTable.FieldByName(fnIsDefault).AsInteger := ptrProperty.IsDefault; AMemTable.FieldByName(fnTakeIntoConnect).AsInteger := ptrProperty.TakeIntoConnect; AMemTable.FieldByName(fnTakeIntoJoin).AsInteger := ptrProperty.TakeIntoJoin; AMemTable.FieldByName(fnIsCrossControl).AsInteger := ptrProperty.IsCrossControl; AMemTable.FieldByName(fnIDCrossProperty).AsInteger := ptrProperty.IDCrossProperty; AMemTable.FieldByName(fnGUIDCrossProperty).AsString := ptrProperty.GUIDCrossProperty; AMemTable.FieldByName(fnPValue).AsString := ptrProperty.Value; PropertyData := GetPropertyData(AMemTable.FieldByName(fnIDProperty).AsInteger, ptrProperty.GUIDProperty); if PropertyData.ID <> 0 then begin AMemTable.FieldByName(fnIDDataType).AsInteger := PropertyData.IDDataType; AMemTable.FieldByName(fnName).AsString := PropertyData.Name; AMemTable.FieldByName(fnSysName).AsString := PropertyData.SysName; AMemTable.FieldByName(fnIzm).AsString := PropertyData.Izm; AMemTable.FieldByName(fnDescription).AsString := PropertyData.Description; AMemTable.FieldByName(fnIsForWholeComponent).AsInteger := PropertyData.IsForWholeComponent; AMemTable.FieldByName(fnisStandart).AsInteger := PropertyData.IsStandart; end else begin AMemTable.FieldByName(fnIDDataType).AsInteger := ptrProperty.IDDataType; AMemTable.FieldByName(fnName).AsString := ptrProperty.Name_; AMemTable.FieldByName(fnSysName).AsString := ptrProperty.SysName; //AMemTable.FieldByName(fnIzm).AsString := ptrProperty.Izm; //AMemTable.FieldByName(fnDescription).AsString := ptrProperty.Description; AMemTable.FieldByName(fnIsForWholeComponent).AsInteger := ptrProperty.IsForWholeComponent; AMemTable.FieldByName(fnisStandart).AsInteger := ptrProperty.IsDefault; end; if AMemTable.FieldDefs.IndexOf(fnIsModified) <> -1 then AMemTable.FieldByName(fnIsModified).AsBoolean := false; if AMemTable.FieldDefs.IndexOf(fnIsNew) <> -1 then AMemTable.FieldByName(fnIsNew).AsBoolean := AAsNew; if IsObjAdress then AMemTable.FieldByName(fnObjectAddress).AsInteger := Integer(ptrProperty); AMemTable.Post; end; end; if AAsNew then if AMemTable.RecordCount > 0 then AMemTable.First; finally AMemTable.EnableControls; end; end; function TDM.CheckNoRepeatPropertyMT(AMemTable: TkbmMemTable; AIDProperty: Integer; AOwnerName: String): Boolean; var RecNo: Integer; begin Result := true; if AMemTable = nil then Exit; ///// EXIT ////// RecNo := AMemTable.RecNo; try try if Not AMemTable.Eof then AMemTable.First; while Not AMemTable.Eof do begin if AMemTable.FieldByName('id_property').AsInteger = AIDProperty then begin //MessageModal(Self.Handle, PChar('В "'+AOwnerName+'" уже есть свойство "'+AMemTable.FieldByName('Name').AsString+'"'), 'Добавление свойства', MB_ICONINFORMATION or MB_OK); MessageModal(cIn+' "'+AOwnerName+'" '+cExistsProperty+' "'+AMemTable.FieldByName('Name').AsString+'"', ApplicationName, MB_ICONINFORMATION or mb_Ok); Result := false; Break; end; AMemTable.Next; end; except on E: Exception do AddExceptionToLog('TDM.CheckNoRepeatPropertyMT: '+E.Message); end; finally if RecNo > -1 then // Tolik 28/12/2019 -- AMemTable.RecNo := RecNo; end; end; procedure TDM.AddRecToMemTable(var AMemTable: TkbmMemTable; ATableKind: TTableKind; ADataSource: TDataSource); var FieldList: TStringList; i: Integer; LCount: Integer; begin FieldList := TStringList.Create; case ATablekind of tkInterfRel: begin FieldList.Add('ID'); FieldList.Add('ID_COMPONENT'); FieldList.Add('ID_INTERFACE'); //FieldList.Add('Name'); FieldList.Add('TYPEI'); FieldList.Add('GENDER'); FieldList.Add('IsBusy'); FieldList.Add('SORT_ID'); end; end; if AMemTable.Active = false then AMemTable.Active := true; AMemTable.Append; LCount := FieldList.Count; for i := 0 to LCount - 1 do begin AMemTable.FieldByName(FieldList.Strings[i]).Value := ADataSource.DataSet.FieldByName(FieldList.Strings[i]).Value; if ATablekind = tkInterfRel then begin SetSQLToQuery(F_NormBase.DM.scsQ, ' SELECT NAME FROM INTERFACE '+ ' WHERE ID = '''+ IntToStr(ADataSource.DataSet.FieldByName('ID_INTERFACE').Value) +''' '); AMemTable.FieldByName('Name').AsString := F_NormBase.DM.scsQ.GetFNAsString('Name'); AMemTable.FieldByName('isNative').AsBoolean := true; end; end; AMemTable.Post; FieldList.Clear; FreeAndNil(FieldList); end; //procedure TDM.AppendIDNameToMemTable(AID: Integer; AName: String; AMemTable: TkbmMemTable); //begin // AMemTable.Append; // AMemTable.FieldByName(fnID).AsInteger := AID; // AMemTable.FieldByName(fnName).AsString := AName; // AMemTable.Post; //end; procedure TDM.AppendItemToRepositoryImageComboBox(AEditRepository: TcxEditRepositoryImageComboBoxItem; AValue, AImageIndex: Integer; ADescription: String); var ColumnItemObject: TObject; //TcxImageComboBoxItem; ColumnItem: TcxImageComboBoxItem; begin ColumnItemObject := AEditRepository.Properties.Items.Add; ColumnItem := nil; if ColumnItemObject is TcxImageComboBoxItem then ColumnItem := TcxImageComboBoxItem(ColumnItemObject); if ColumnItem <> nil then begin ColumnItem.Value := AValue; ColumnItem.ImageIndex := AImageIndex; ColumnItem.Description := ADescription; end; end; { function TDM.GetTableIDFromGuide(ATableKind: TTableKind; ACurrID: Integer; AFormMode: TFormMode): Integer; var ModRes: TModalResult; GuideForm: TF_Main; TableDataSet: TpFIBDataSet; ViewKind: TViewKind; begin Result := ACurrID; try GGDBMode := bkNormBase; GuideForm := TF_MAIN.Create(GForm, bkNormBase, fmNormal); GuideForm.Visible := false; try with GuideForm do begin TableDataSet := nil; case ATableKind of tkInterface: begin GuideForm.F_CaseForm.Tree_InterfType.Selected := GuideForm.F_CaseForm.Tree_InterfType.TopItem; TableDataSet := DM.DataSet_INTERFACE; ViewKind := vkInterface; end; tkNBNorm: begin TableDataSet := DM.DataSet_NB_NORMS; ViewKind := vkNorm; end; end; if Assigned(TableDataSet) then begin if Not SearchRecord(TableDataSet, fnID, ACurrID) then TableDataSet.First; GuideForm.F_CaseForm.GFormMode := AFormMode; GuideForm.F_CaseForm.GViewKind := ViewKind; ModRes := GuideForm.F_CaseForm.ShowModal; if ModRes = mrOk then Result := TableDataSet.FN(fnID).AsInteger; end; end; finally GuideForm.Free; end; except on E: Exception do AddExceptionToLog('TDM.GetTableIDFromForm', E.Message); end; end; } function TDM.GetTableIDFromGuide(AViewKind: TViewKind; ACurrID: Integer; AFormMode: TFormMode; var AGUID: string; APropItemType: Integer = itNone): Integer; var //ModRes: TModalResult; GuideForm: TF_CaseForm; TableDataSet: TpFIBDataSet; ViewKind: TViewKind; // Tolik 28/08/2019 -- //Old, Curr: Cardinal; Old, Curr: DWord; // begin Result := ACurrID; Old := GetTickCount; AGUID := ''; try GuideForm := TF_CaseForm.Create(F_NormBase, F_NormBase, nil, itNone); {GuideForm.GT_ComponentTypes.DataController.DataSource := nil; GuideForm.GT_CompTypeProp.DataController.DataSource := nil; GuideForm.GT_CURRENCY.DataController.DataSource := nil; GuideForm.GT_InterfAccordance.DataController.DataSource := nil; GuideForm.GT_InterfaceNorms.DataController.DataSource := nil; GuideForm.GT_Interfaces.DataController.DataSource := nil; GuideForm.GT_NB_NormResourceRel.DataController.DataSource := nil; GuideForm.GT_NB_Norms.DataController.DataSource := nil; GuideForm.GT_NB_Resources.DataController.DataSource := nil; GuideForm.GT_PROPERTIES.DataController.DataSource := nil; GuideForm.GT_TZ.DataController.DataSource := nil; } try with TF_Main(GForm).FNormBase do begin TableDataSet := nil; ViewKind := AViewKind; case AViewKind of vkCurrency: begin TableDataSet := DM.DataSet_CURRENCY; end; vkInterface: begin GuideForm.Tree_InterfType.Selected := GuideForm.Tree_InterfType.TopItem; TableDataSet := DM.DataSet_INTERFACE; //GuideForm.GT_Interfaces.DataController.DataSource := F_NormBase.DM.DataSource_INTERFACE; end; vkObjectIcons: begin TableDataSet := DM.DataSet_OBJECT_ICONS; end; vkNorm: begin TableDataSet := DM.DataSet_NB_NORMS; FreeAndNil(GuideForm.Panel_Kolvo); //GuideForm.Panel_Kolvo.Visible := false; //GuideForm.GT_NB_Norms.DataController.DataSource := F_NormBase.DM.DataSource_NB_NORMS; end; vkProperty: begin TableDataSet := DM.DataSet_PROPERTIES; end; end; //if Assigned(TableDataSet) then begin //if Not SearchRecord(TableDataSet, fnID, ACurrID) then // TableDataSet.First; //if Not DataSetLocateByID(TableDataSet, ACurrID) then // TableDataSet.First; Curr := GetTickCount - Old; Curr := GetTickCount - Old; GuideForm.GIDToLocate := ACurrID; GuideForm.GItemType := APropItemType; //GuideForm.GFormMode := AFormMode; //GuideForm.GViewKind := ViewKind; //ModRes := GuideForm.ShowModal; //if ModRes = mrOk then //if GuideForm.Execute(ViewKind, AFormMode) then // Result := TableDataSet.FN(fnID).AsInteger; if GuideForm.Execute(ViewKind, AFormMode) then begin if GuideForm.DirTypeInfo.DataSet <> nil then if GuideForm.DirTypeInfo.DataSet is TpFIBDataSet then begin Result := TpFIBDataSet(GuideForm.DirTypeInfo.DataSet).FN(fnID).AsInteger; AGUID := TpFIBDataSet(GuideForm.DirTypeInfo.DataSet).FN(fnGUID).AsString; end; end; end; end; finally FreeAndNil(GuideForm); end; except on E: Exception do AddExceptionToLog('TDM.GetTableIDFromForm: '+E.Message); end; end; // ##### Верет ID соединения ##### function TDM.GetIDCompRelByConnectCompons(AIDCompon1, AIDCompon2, AIDTopCompon, AIDParentCompRel: Integer; AConnectType: TConnectType): Integer; var strFilter: String; strID1, strID2: String; begin Result := 0; //strID1 := IntToStr(AIDCompon1); //strID2 := IntToStr(AIDCompon2); //strFilter :='((id_component = '''+strID1+''') and (id_child = '''+strID2+''') ) or '+ // '((id_component = '''+strID2+''') and (id_child = '''+strID1+''')) and '+ // 'Connect_type = '''+IntToStr(AConnectType)+''''; strFilter :='('+fnIDTopCompon+' = '''+IntToStr(AIDTopCompon)+''') and ('+fnIDParentCompRel+' = '+IntToStr(AIDParentCompRel)+') and '+ '('+fnIDComponent+' = '''+IntToStr(AIDCompon1)+''') and ('+fnIDChild+' = '''+IntToStr(AIDCompon2)+''') and '+ '('+fnConnectType+' = '''+IntToStr(AConnectType)+''')'; try case TF_Main(GForm).GDBMode of bkNormBase: begin ChangeSQLQuery(scsQSelect, ' select id from component_relation '+ ' where '+ strFilter); scsQSelect.ExecQuery; Result := scsQSelect.GetFNAsInteger('id'); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_ComponentRelation, strFilter) then // if Not tSQL_ComponentRelation.Eof then // Result := tSQL_ComponentRelation.FieldByName(fnID).AsInteger; end; end; except on E: Exception do AddExceptionToLog('TDM.GetIDCompRelByConnectCompons: '+E.Message); end; end; function TDM.GetComponFldValueAsString(AIDComponent: Integer; AFldName: String): String; begin Result := ''; case TF_Main(GForm).GDBMode of bkNormBase: if AIDComponent > 0 then begin SetSQLToQuery(scsQSelect, ' select '+AFldName+' from component where id = '''+IntTostr(AIDComponent)+''' '); Result := scsQSelect.GetFNAsString(AFldName); end; bkProjectManager: begin tSQL_Component.Filtered := false; tSQL_Component.Filter := 'id = '''+IntTostr(AIDComponent)+''''; tSQL_Component.Filtered := true; Result := tSQL_Component.FieldByName(AFldName).AsString; end; end; end; function TDM.GenComponentNewCypher: String; begin Result := GenNewComponentCypher(Query, Query_Select); end; function TDM.GetMaxFieldValueFromSQLMemTable(ATable: TSQLMemTable; AFieldName: String): Integer; var MaxVal: Integer; begin Result := 0; if (ATable = nil) or (ATable.Active = false) then Exit; //// EXIT //// if Not ATable.Eof then ATable.First; MaxVal := ATable.FieldByName(AFieldName).AsInteger; while Not ATable.Eof do begin if ATable.FieldByName(AFieldName).AsInteger > MaxVal then MaxVal := ATable.FieldByName(AFieldName).AsInteger; ATable.Next; end; Result := MaxVal; end; procedure TDM.AddFieldToTable(ATableName, AFieldName: String; AFieldType: TFieldType; ASize: Integer); //var // strSQL: string; // strFieldType: String; begin U_BaseCommon.AddFieldToTable(ATableName, AFieldName, AFieldType, ASize, Query_Operat); //strSQL := GetSQLForAddFieldToTable(ATableName, AFieldName, AFieldType, ASize, qmPhisical); // if strSQL <> '' then // begin // Query_Operat.Close; // Query_Operat.SQL.Text := strSQL; // Query_Operat.ExecQuery; // Query_Operat.Close; // end; end; procedure TDM.AddFieldToAllTables(AFieldName: String; AFieldType: TFieldType; ASize: Integer); var Tables: TStringList; i: Integer; begin Tables := TStringList.Create; try Tables.Add('CABLE_CANAL_CONNECTORS'); Tables.Add('CATALOG_RELATION'); Tables.Add('COMPONENT'); Tables.Add('COMPONENT_RELATION'); Tables.Add('COMPONENT_TYPES'); Tables.Add('COMP_PROP_RELATION'); Tables.Add('COMP_TYPE_PROP_RELATION'); Tables.Add('CURRENCY'); Tables.Add('DATA_TYPE'); Tables.Add('DIRECTORY_TYPE'); Tables.Add('DIRECTORY_TYPE_REL'); Tables.Add('GRADE_GRID'); Tables.Add('INTERFACE'); Tables.Add('INTERFACE_ACCORDANCE'); Tables.Add('INTERFACE_NORMS'); Tables.Add('INTERFACE_RELATION'); Tables.Add('INTERFACE_TYPE'); Tables.Add('INTERFACE_TYPE_REL'); Tables.Add('INTERFOFINTERF_RELATION'); Tables.Add('KATALOG'); Tables.Add('NB_NORMS'); Tables.Add('NB_NORM_RESOURCE_REL'); Tables.Add('NB_RESOURCES'); Tables.Add('NET_TYPE'); Tables.Add('NORMS'); Tables.Add('NORM_RESOURCE_REL'); Tables.Add('OBJECT_ICONS'); Tables.Add('PRODUCERS'); Tables.Add('PROPERTIES'); Tables.Add('RESOURCES'); Tables.Add('SETTINGS'); Tables.Add('SUPPLIER'); Tables.Add('SUPPLIER_RELATION'); Tables.Add('TZ'); for I := 0 to Tables.Count - 1 do AddFieldToTable(Tables[i], AFieldName, AFieldType, ASize); finally Tables.Free; end; end; function TDM.ExistsFieldInTable(ATableName, AFieldName: String; AQueryMoe: TQueryMode): Boolean; var SQLMemTable: TSQlMemTable; FirstID: Integer; begin Result := true; FirstID := 0; SQLMemTable := nil; case AQueryMoe of qmPhisical: begin Result := CheckFieldInTable(ATableName, AFieldName, Query_Select); end; qmMemory: begin Result := false; SQLMemTable := GetSQLMemTableByName(ATableName); if Assigned(SQLMemTable) then if SQLMemTable.FieldDefs.IndexOf(AFieldName) <> -1 then Result := true; end; end; end; function TDM.GetDetailRecCount(ADetailTableName, AMasterFldName: String; AMasterID: Integer; AMemTable: TkbmMemTable = nil): Integer; begin Result := 0; if AMemTable <> nil then begin if AMemTable.Active then Result := AMemTable.RecordCount; end else begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, ADetailTableName, AMasterFldName+' = '''+IntToStr(AMasterID)+'''', nil, fnCount+'(id)')); Result := Query_Select.FN(fnCount).AsInteger; end; end; procedure TDM.DeleteRecordFromTableByID(ATableName: String; AID: Integer; AQueryMode: TQueryMode); var SQLMemTable: TSQLMemTable; begin SQLMemTable := nil; case AQueryMode of qmPhisical: SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, ATableName, 'id = '''+IntToStr(AID)+'''', nil, '')); qmMemory: begin SQLMemTable := GetSQLMemTableByName(ATableName); if Assigned(SQLMemTable) then begin SQLMemTable.Filtered := false; if SQLMemTable.Locate(fnID, AID, []) then SQLMemTable.Delete; end; end; end; end; procedure TDM.DeleteRecordsByGUIDList(ATableName: String; AGUIDList: TStringList); var i: Integer; begin try if AGUIDList.Count > 0 then begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, ATableName, fnGUID+' = :'+fnGUID, nil, ''), false); for i := 0 to AGUIDList.Count - 1 do begin Query_Operat.Close; Query_Operat.Params[0].AsString := AGUIDList[i]; Query_Operat.ExecQuery; end; Query_Operat.Close; end; except on E: Exception do AddExceptionToLogEx('TDM.DeleteRecordsByGUIDList', E.Message); end; end; procedure TDM.DeleteRecordsByIDList(ATableName: String; AIDList: TIntList; AQueryMode: TQueryMode); var i: Integer; begin for i := 0 to AIDList.Count - 1 do DeleteRecordFromTableByID(ATableName, AIDList[i], AQueryMode); end; function TDM.GetIntFromTable(const ATableName, AResFieldName, AFldBy: String; AFldValue: Variant;AQueryMode: TQueryMode): Integer; var ValRes: Variant; begin Result := -1; ValRes := GetValueFromTable(ATableName, AResFieldName, AFldBy, AFldValue, AQueryMode); if ValRes <> null then Result := ValRes; end; function TDM.GetIntFromTableByID(ATableName, AResFieldName: String; AIDBy: Integer; AQueryMode: TQueryMode): Integer; var ValRes: Variant; begin Result := 0; ValRes := GetValueFromTable(ATableName, AResFieldName, fnID, AIDBy, AQueryMode); if ValRes <> null then Result := ValRes; end; function TDM.GetIntFromTableByGUID(const ATableName, AResFieldName, AGUID: String; AQueryMode: TQueryMode): Integer; var ValRes: Variant; begin Result := 0; ValRes := GetValueFromTable(ATableName, AResFieldName, fnGUID, AGUID, AQueryMode); if ValRes <> null then Result := ValRes; end; function TDM.GetSQLMemTableByIndex(ATableIndex: Integer): TSQLMemTable; var i: Integer; CurrMemTable: TSQLMemTable; begin Result := nil; if ATableIndex >= 0 then for i := 0 to FSQLMemTables.Count - 1 do begin CurrMemTable := TSQLMemTable(FSQLMemTables[i]); if CurrMemTable.Tag = ATableIndex then begin Result := CurrMemTable; Break; ///// BREAK ///// end; end; end; function TDM.GetSQLMemTableByName(ATableName: String): TSQLMemTable; begin Result := nil; if ATableName = '' then Exit; ///// EXIT ///// if ATableName = tnCatalog then Result := tSQL_Katalog else //if ATableName = tnCatalogMarkMask then // Result := tSQL_CatalogMarkMask //else if ATableName = tnCatalogPropRelation then Result := tSQL_CatalogPropRelation else if ATableName = tnCatalogRelation then Result := tSQL_CatalogRelation else if ATableName = tnComponent then Result := tSQL_Component else if ATableName = tnComponentRelation then Result := tSQL_ComponentRelation else if ATableName = tnCompPropRelation then Result := tSQL_CompPropRelation else if ATableName = tnConnectedComponents then Result := tSQL_ConnectedComponents else if ATableName = tnInterfaceRelation then Result := tSQL_InterfaceRelation else if ATableName = tnInterfOfInterfRelation then Result := tSQL_InterfOfInterfRelation else if ATableName = tnPortInterfaceRelation then Result := tSQL_PortInterfaceRelation else if ATableName = tnNorms then Result := tSQL_Norms else if ATableName = tnNormResourceRel then Result := tSQL_NormResourceRel else if ATableName = tnResources then Result := tSQL_Resources; end; function TDM.GetStreamFromDataSet(ADataSet: TpFIBDataSet; AFieldName: String): TMemoryStream; begin Result := TMemoryStream.Create; Result.Position := 0; TBlobField(ADataSet.FN(AFieldName)).SaveToStream(Result); end; function TDM.GetStreamFromTableByGUID(const ATableName, AFieldName, AGUID: String; AQueryMode: TQueryMode): TStream; var MemTable: TSQLMemTable; strFilter: String; begin Result := TMemoryStream.Create; strFilter := 'guid = '''+AGUID+''''; case AQueryMode of qmPhisical: begin Query_Select.Close; Query_Select.SQL.Text := 'select '+AFieldName+' from '+ATableName+' '+ 'where '+strFilter; Query_Select.ExecQuery; Query_Select.FN(AFieldName).SaveToStream(Result); Query_Select.Close; end; qmMemory: begin MemTable := GetSQLMemTableByName(ATableName); if Assigned(MemTable) then begin MemTable.Filtered := false; if MemTable.Locate(fnGUID, AGUID, []) then TBlobField(MemTable.FieldByName(AFieldName)).SaveToStream(Result); end; end; end; Result.Position := 0; end; function TDM.GetStreamFromTableByID(ATableName, AFieldName: String; AID: Integer; AQueryMode: TQueryMode): TMemoryStream; var MemTable: TSQLMemTable; strFilter: String; begin Result := TMemoryStream.Create; Result.Position := 0; strFilter := 'id = '''+IntToStr(AID)+''''; case AQueryMode of qmPhisical: begin Query_Select.Close; Query_Select.SQL.Text := 'select '+AFieldName+' from '+ATableName+' '+ 'where '+strFilter; Query_Select.ExecQuery; Query_Select.FN(AFieldName).SaveToStream(Result); Query_Select.Close; end; qmMemory: begin MemTable := GetSQLMemTableByName(ATableName); if Assigned(MemTable) then begin MemTable.Filtered := false; if MemTable.Locate(fnID, AID, []) then TBlobField(MemTable.FieldByName(AFieldName)).SaveToStream(Result); end; end; end; Result.Position := 0; end; function TDM.GetStringFromTableByGUID(ATableName, AFieldName, AGUID: String; AQueryMode: TQueryMode): String; begin Result := ''; if AQueryMode = qmPhisical then Result := U_BaseCommon.GetStringFromTableByGUID(ATableName, AFieldName,AGUID, Query_Select); end; function TDM.GetStringFromTableByID(ATableName, AFieldName: String; AID: Integer; AQueryMode: TQueryMode): String; var ValRes: Variant; begin Result := ''; ValRes := GetValueFromTable(ATableName, AFieldName, fnID, AID, AQueryMode); if ValRes <> null then Result := ValRes; end; function TDM.GetStringFromTableFirst(ATableName, AFieldName: String): String; var ValRes: Variant; begin Result := ''; ValRes := GetValueFromTableFirst(ATableName, AFieldName); if ValRes <> null then Result := ValRes; end; function TDM.GetValueFromTable(ATableName, AResFieldName, AFldBy: String; AFldValue: Variant; AQueryMode: TQueryMode): Variant; var MemTable: TSQLMemTable; //strFilter: String; //strValue: String; begin Result := null; //strValue := AFldValue; //strFilter := AFldBy+' = '''+strValue+''''; case AQueryMode of qmPhisical: begin Result := U_BaseCommon.GetValueFromTable(ATableName, AResFieldName, AFldBy, AFldValue, Query_Select); {Query_Select.Close; Query_Select.SQL.Text := 'select '+AResFieldName+' from '+ATableName+' '+ 'where '+strFilter; Query_Select.ExecQuery; Result := Query_Select.FN(AResFieldName).Value; Query_Select.Close;} end; qmMemory: begin MemTable := GetSQLMemTableByName(ATableName); if Assigned(MemTable) then begin MemTable.Filtered := false; if MemTable.Locate(AFldBy, AFldValue, []) then Result := MemTable.FieldByName(AResFieldName).Value; end; end; end; end; function TDM.GetValueFromTableFirst(ATableName, AResFieldName: string): Variant; begin Result := U_BaseCommon.GetValueFromTableFirst(ATableName, AResFieldName, Query_Select); end; procedure TDM.SelectRecordInMTByRecNo(AMemTable: TkbmMemTable; ARecNo: Integer); var RecNo: Integer; begin if AMemTable.Active then begin RecNo := ARecNo; if AMemTable.RecordCount > ARecNo then RecNo := AMemTable.RecordCount; if RecNo > 0 then AMemTable.RecNo := RecNo; end; end; procedure TDM.SetDataSetIntValueAsZeroToNull(ADataSet: TpFIBDataSet; AFieldName: String; AValue: Integer); begin if AValue > 0 then ADataSet.FN(AFieldName).AsInteger := AValue else ADataSet.FN(AFieldName).AsVariant := null; end; procedure TDM.UpdateBlobTableFieldByID(ATableName, AUpdFieldName: String; AIDBy: Integer; AStream: TStream; AFileName: String); begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, ATableName, fnID+' = :'+fnID, nil, AUpdFieldName), false); Query_Operat.ParamByName(fnID).AsInteger := AIDBy; if AStream <> nil then Query_Operat.ParamByName(AUpdFieldName).LoadFromStream(AStream) else if FileExists(AFileName) then Query_Operat.ParamByName(AUpdFieldName).LoadFromFile(AFileName); Query_Operat.ExecQuery; end; procedure TDM.UpdateIntTableFieldByID(ATableName, AUpdFieldName: String; AIDBy, ANewValue: Integer; AQueryMode: TQueryMode); begin UpdateTableField(ATableName, AUpdFieldName, fnID, AIDBy, ANewValue, AQueryMode); end; procedure TDM.UpdateStrTableFieldByID(ATableName, AUpdFieldName: String; AIDBy: Integer; ANewValue: String; AQueryMode: TQueryMode); begin UpdateTableField(ATableName, AUpdFieldName, fnID, AIDBy, ANewValue, AQueryMode); end; procedure TDM.UpdateStrTableFieldAllRec(ATableName, AUpdFieldName, ANewValue: String); begin UpdateTableFieldAllRec(ATableName, AUpdFieldName, ANewValue); end; procedure TDM.UpdateAllRecFromField(ATableName, ATrgField, ASrcField: String); begin try SetSQLToFIBQuery(Query_Operat, 'update '+ATableName+' set '+ ATrgField+' = '+ASrcField); except on E: Exception do AddExceptionToLogEx('TDM.UpdateAllRecFromField(', E.Message); end; end; procedure TDM.UpdateTableField(ATableName, AUpdFieldName, AFldBy: String; AFldByValue, ANewValue: Variant; AQueryMode: TQueryMode); var MemTable: TSQLMemTable; strFilter: String; strValue: String; begin strValue := AFldByValue; strFilter := AFldBy+' = '''+strValue+''''; case AQueryMode of qmPhisical: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, ATableName, strFilter, nil, AUpdFieldName), false); Query_Operat.ParamByName(AUpdFieldName).Value := ANewValue; Query_Operat.ExecQuery; Query_Operat.Close; end; qmMemory: begin MemTable := GetSQLMemTableByName(ATableName); if Assigned(MemTable) then begin MemTable.Filtered := false; if MemTable.Locate(AFldBy, AFldByValue, []) then begin MemTable.Edit; MemTable.FieldByName(AUpdFieldName).Value := ANewValue; MemTable.Post; end; end; end; end; end; procedure TDM.UpdateTableFieldAllRec(ATableName, AUpdFieldName: String; ANewValue: Variant); begin U_BaseCommon.UpdateTableFieldAllRec(Query_Operat, ATableName, AUpdFieldName, ANewValue); {SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, ATableName, '', nil, AUpdFieldName), false); Query_Operat.ParamByName(AUpdFieldName).Value := ANewValue; Query_Operat.ExecQuery; Query_Operat.Close;} end; function TDM.GetMaxSortIDFromTable(ATableName, AFNParentID, AFNSortID: String; AParentID: Integer): Integer; begin Result := 0; SetSQLToFIBQuery(Query_Select, 'SELECT MAX('+AFNSortID+') as max_sort_id FROM '+ATableName+' '+ 'WHERE '+AFNParentID+' = '''+ IntTostr(AParentID) +''''); Result := Query_Select.FN('max_sort_id').AsInteger; end; procedure TDM.DefineFieldIndexesForKatalog; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiKatalog_ID := -1; fiKatalog_ParentID := -1; fiKatalog_ListID := -1; fiKatalog_Name := -1; fiKatalog_NameShort := -1; fiKatalog_NameMark := -1; fiKatalog_IsUserName := -1; fiKatalog_SortID := -1; fiKatalog_KolCompon := -1; fiKatalog_ItemsCount := -1; fiKatalog_PropsCount := -1; fiKatalog_NormsCount := -1; fiKatalog_ResourcesCount := -1; //fiKatalog_SpravComponCount := -1; fiKatalog_IDItemType := -1; fiKatalog_MarkID := -1; fiKatalog_ScsID := -1; fiKatalog_IsIndexWithName := -1; fiKatalog_IndexConn := -1; fiKatalog_IndexLine := -1; fiKatalog_IndexJoiner := -1; fiKatalog_Settings := -1; fiKatalog_CompTypeMarkMasks := -1; fiKatalog_CADBlock := -1; fiKatalog_PMBlock := -1; for i := 0 to tSQL_Katalog.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_Katalog.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiKatalog_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnParentID then begin fiKatalog_ParentID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnListID then begin fiKatalog_ListID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnName then begin fiKatalog_Name := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNameShort then begin fiKatalog_NameShort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNameMark then begin fiKatalog_NameMark := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsUserName then begin fiKatalog_IsUserName := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiKatalog_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolCompon then begin fiKatalog_KolCompon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnItemsCount then begin fiKatalog_ItemsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPropsCount then begin fiKatalog_PropsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNormsCount then begin fiKatalog_NormsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnResourcesCount then begin fiKatalog_ResourcesCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else {if FldName = fnSpravComponCount then begin fiKatalog_SpravComponCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else} if FldName = fnIDItemType then begin fiKatalog_IDItemType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnMarkID then begin fiKatalog_MarkID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnScsID then begin fiKatalog_ScsID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsIndexWithName then begin fiKatalog_IsIndexWithName := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIndexConn then begin fiKatalog_IndexConn := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIndexLine then begin fiKatalog_IndexLine := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIndexJoiner then begin fiKatalog_IndexJoiner := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSettings then begin fiKatalog_Settings := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCompTypeMarkMasks then begin fiKatalog_CompTypeMarkMasks := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCADBlock then begin fiKatalog_CADBlock := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPMBlock then begin fiKatalog_PMBlock := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCatPropRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCatPropRel_ID := -1; fiCatPropRel_IDCatalog := -1; fiCatPropRel_IDProperty := -1; fiCatPropRel_GUIDProperty := -1; fiCatPropRel_PValue := -1; fiCatPropRel_IsDefault := -1; fiCatPropRel_SortID := -1; for i := 0 to tSQL_CatalogPropRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CatalogPropRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCatPropRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCatalog then begin fiCatPropRel_IDCatalog := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDProperty then begin fiCatPropRel_IDProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDProperty then begin fiCatPropRel_GUIDProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPValue then begin fiCatPropRel_PValue := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsDefault then begin fiCatPropRel_IsDefault := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiCatPropRel_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCatRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCatRel_IDCatalog := -1; fiCatRel_IDComponent := -1; for i := 0 to tSQL_CatalogRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CatalogRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnIDCatalog then begin fiCatRel_IDCatalog := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponent then begin fiCatRel_IDComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForComponent; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCompon_ID := -1; fiCompon_GuidNB := -1; fiCompon_Name := -1; fiCompon_NameShort := -1; fiCompon_NameMark := -1; fiCompon_MarkID := -1; fiCompon_MarkStr := -1; fiCompon_Cypher := -1; fiCompon_Izm := -1; fiCompon_Notice := -1; fiCompon_Description := -1; fiCompon_IsUserMark := -1; fiCompon_IsMarkInCaptions := -1; fiCompon_Picture := -1; fiCompon_Color := -1; fiCompon_IsLine := -1; fiCompon_IsComplect := -1; fiCompon_PriceSupply := -1; fiCompon_Price := -1; fiCompon_PriceCalc := -1; fiCompon_UserLength := -1; fiCompon_MaxLength := -1; fiCompon_HasNDS := -1; fiCompon_IDComponentType := -1; fiCompon_IDSymbol := -1; fiCompon_IDObjectIcon := -1; fiCompon_IDProducer := -1; fiCompon_IDSuppliesKind := -1; fiCompon_IDSupplier := -1; fiCompon_IDNetType := -1; fiCompon_GUIDComponentType := -1; fiCompon_GUIDSymbol := -1; fiCompon_GUIDObjectIcon := -1; fiCompon_GUIDProducer := -1; fiCompon_GUIDSuppliesKind := -1; fiCompon_GUIDSupplier := -1; fiCompon_GUIDNetType := -1; fiCompon_ObjectIconStep := -1; fiCompon_IDCurrency := -1; fiCompon_ArticulDistributor := -1; fiCompon_ArticulProducer := -1; fiCompon_SortID := -1; fiCompon_IsDismount := -1; fiCompon_IsUseDismounted := -1; fiCompon_UseKindInProj := -1; fiCompon_WholeID := -1; fiCompon_KolComplect := -1; fiCompon_CableCanalConnectorsCnt := -1; fiCompon_InterfCount := -1; fiCompon_JoinsCount := -1; fiCompon_NormsCount := -1; fiCompon_PropsCount := -1; fiCompon_ResourcesCount := -1; fiCompon_IDNormBase := -1; fiCompon_ObjectID := -1; fiCompon_ListID := -1; fiCompon_IDRelatedCompon := -1; fiCompon_ComeFrom := -1; fiCompon_IsTemplate := -1; for i := 0 to tSQL_Component.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_Component.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCompon_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGuidNB then begin fiCompon_GuidNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnName then begin fiCompon_Name := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNameShort then begin fiCompon_NameShort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNameMark then begin fiCompon_NameMark := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnMarkID then begin fiCompon_MarkID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnMarkStr then begin fiCompon_MarkStr := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCypher then begin fiCompon_Cypher := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIzm then begin fiCompon_Izm := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNotice then begin fiCompon_Notice := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnDescription then begin fiCompon_Description := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsUserMark then begin fiCompon_IsUserMark := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsMarkInCaptions then begin fiCompon_IsMarkInCaptions := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPicture then begin fiCompon_Picture := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnColor then begin fiCompon_Color := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsLine then begin fiCompon_IsLine := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsComplect then begin fiCompon_IsComplect := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPriceSupply then begin fiCompon_PriceSupply := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPrice then begin fiCompon_Price := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPriceCalc then begin fiCompon_PriceCalc := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnUserLength then begin fiCompon_UserLength := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnMaxLength then begin fiCompon_MaxLength := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnHasNDS then begin fiCompon_HasNDS := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponentType then begin fiCompon_IDComponentType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDSymbol then begin fiCompon_IDSymbol := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDObjectIcon then begin fiCompon_IDObjectIcon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDProducer then begin fiCompon_IDProducer := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDSuppliesKind then begin fiCompon_IDSuppliesKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDSupplier then begin fiCompon_IDSupplier := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDNetType then begin fiCompon_IDNetType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDComponentType then begin fiCompon_GUIDComponentType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDSymbol then begin fiCompon_GUIDSymbol := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDObjectIcon then begin fiCompon_GUIDObjectIcon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDProducer then begin fiCompon_GUIDProducer := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDSuppliesKind then begin fiCompon_GUIDSuppliesKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDSupplier then begin fiCompon_GUIDSupplier := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDNetType then begin fiCompon_GUIDNetType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnObjectIconStep then begin fiCompon_ObjectIconStep := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCurrency then begin fiCompon_IDCurrency := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnArticulDistributor then begin fiCompon_ArticulDistributor := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnArticulProducer then begin fiCompon_ArticulProducer := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiCompon_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsDismount then begin fiCompon_IsDismount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsUseDismounted then begin fiCompon_IsUseDismounted := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnUseKindInProj then begin fiCompon_UseKindInProj := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnWholeID then begin fiCompon_WholeID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolComplect then begin fiCompon_KolComplect := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCableCanalConnectorsCnt then begin fiCompon_CableCanalConnectorsCnt := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnInterfCount then begin fiCompon_InterfCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnJoinsCount then begin fiCompon_JoinsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNormsCount then begin fiCompon_NormsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPropsCount then begin fiCompon_PropsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnResourcesCount then begin fiCompon_ResourcesCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDNormBase then begin fiCompon_IDNormBase := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnObjectID then begin fiCompon_ObjectID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnListID then begin fiCompon_ListID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDRelatedCompon then begin fiCompon_IDRelatedCompon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnComeFrom then begin fiCompon_ComeFrom := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsTemplate then begin fiCompon_IsTemplate := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCompRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCompRel_ID := -1; fiCompRel_IDComponent := -1; fiCompRel_IDChild := -1; fiCompRel_Kolvo := -1; fiCompRel_SortID := -1; fiCompRel_ConnectType := -1; fiCompRel_RelType := -1; fiCompRel_Fixed := -1; for i := 0 to tSQL_ComponentRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_ComponentRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCompRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponent then begin fiCompRel_IDComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDChild then begin fiCompRel_IDChild := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolvo then begin fiCompRel_Kolvo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiCompRel_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnectType then begin fiCompRel_ConnectType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnRelType then begin fiCompRel_RelType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnFixed then begin fiCompRel_Fixed := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCompPropRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCompPropRel_ID := -1; fiCompPropRel_IDComponent := -1; fiCompPropRel_IDProperty := -1; fiCompPropRel_GUIDProperty := -1; fiCompPropRel_PValue := -1; fiCompPropRel_IsDefault := -1; fiCompPropRel_SortID := -1; fiCompPropRel_TakeIntoJoin := -1; fiCompPropRel_TakeIntoConnect := -1; fiCompPropRel_IsTakeJoinForPoints := -1; fiCompPropRel_IsCrossControl := -1; fiCompPropRel_IDCrossProperty := -1; fiCompPropRel_GUIDCrossProperty := -1; for i := 0 to tSQL_CompPropRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CompPropRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCompPropRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponent then begin fiCompPropRel_IDComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDProperty then begin fiCompPropRel_IDProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDProperty then begin fiCompPropRel_GUIDProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPValue then begin fiCompPropRel_PValue := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsDefault then begin fiCompPropRel_IsDefault := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiCompPropRel_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTakeIntoJoin then begin fiCompPropRel_TakeIntoJoin := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTakeIntoConnect then begin fiCompPropRel_TakeIntoConnect := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsTakeJoinForPoints then begin fiCompPropRel_IsTakeJoinForPoints := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsCrossControl then begin fiCompPropRel_IsCrossControl := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCrossProperty then begin fiCompPropRel_IDCrossProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDCrossProperty then begin fiCompPropRel_GUIDCrossProperty := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCableCanalConnectors; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCablCanalConnr_ID := -1; fiCablCanalConnr_IDComponent := -1; fiCablCanalConnr_IDNBConnector := -1; fiCablCanalConnr_GUIDNBConnector := -1; fiCablCanalConnr_ConnectorType := -1; for i := 0 to tSQL_CableCanalConnectors.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CableCanalConnectors.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCablCanalConnr_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponent then begin fiCablCanalConnr_IDComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDNBConnector then begin fiCablCanalConnr_IDNBConnector := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDNBConnector then begin fiCablCanalConnr_GUIDNBConnector := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnectorType then begin fiCablCanalConnr_ConnectorType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForConnectedComponents; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiConnctCompons_ID := -1; fiConnctCompons_ComponWholeID := -1; fiConnctCompons_IDConnectObject := -1; fiConnctCompons_IDConnectCompon := -1; fiConnctCompons_IDSideCompon := -1; fiConnctCompons_TypeConnect := -1; for i := 0 to tSQL_ConnectedComponents.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_ConnectedComponents.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiConnctCompons_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnComponWholeID then begin fiConnctCompons_ComponWholeID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDConnectObject then begin fiConnctCompons_IDConnectObject := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDConnectCompon then begin fiConnctCompons_IDConnectCompon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDSideCompon then begin fiConnctCompons_IDSideCompon := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTypeConnect then begin fiConnctCompons_TypeConnect := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForInterfaceRelation; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiInterfRel_ID := -1; fiInterfRel_IDComponent := -1; fiInterfRel_IDInterface := -1; fiInterfRel_GUIDInterface := -1; fiInterfRel_NPP := -1; fiInterfRel_TypeI := -1; fiInterfRel_Kind := -1; fiInterfRel_IsPort := -1; fiInterfRel_IsUserPort := -1; fiInterfRel_NppPort := -1; fiInterfRel_IDConnected := -1; fiInterfRel_Gender := -1; fiInterfRel_Multiple := -1; fiInterfRel_IsBusy := -1; fiInterfRel_ValueI := -1; fiInterfRel_CoordZ := -1; fiInterfRel_SortID := -1; fiInterfRel_NumPair := -1; fiInterfRel_Color := -1; fiInterfRel_IDAdverse := -1; fiInterfRel_Side := -1; fiInterfRel_Notice := -1; fiInterfRel_Kolvo := -1; fiInterfRel_KolvoBusy := -1; fiInterfRel_SignType := -1; fiInterfRel_ConnToAnyGender := -1; fiInterfRel_SideSection := -1; fiInterfRel_IOfIRelCount := -1; fiInterfRel_PortInterfRelCount := -1; for i := 0 to tSQL_InterfaceRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_InterfaceRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiInterfRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDComponent then begin fiInterfRel_IDComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDInterface then begin fiInterfRel_IDInterface := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDInterface then begin fiInterfRel_GUIDInterface := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNPP then begin fiInterfRel_NPP := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTypeI then begin fiInterfRel_TypeI := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKind then begin fiInterfRel_Kind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsPort then begin fiInterfRel_IsPort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsUserPort then begin fiInterfRel_IsUserPort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNppPort then begin fiInterfRel_NppPort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDConnected then begin fiInterfRel_IDConnected := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGender then begin fiInterfRel_Gender := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnMultiple then begin fiInterfRel_Multiple := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsBusy then begin fiInterfRel_IsBusy := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnValueI then begin fiInterfRel_ValueI := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCoordZ then begin fiInterfRel_CoordZ := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSortID then begin fiInterfRel_SortID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNumPair then begin fiInterfRel_NumPair := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnColor then begin fiInterfRel_Color := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDAdverse then begin fiInterfRel_IDAdverse := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSide then begin fiInterfRel_Side := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNotice then begin fiInterfRel_Notice := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolvo then begin fiInterfRel_Kolvo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolvoBusy then begin fiInterfRel_KolvoBusy := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSignType then begin fiInterfRel_SignType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnToAnyGender then begin fiInterfRel_ConnToAnyGender := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSideSection then begin fiInterfRel_SideSection := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIOfIRelCount then begin fiInterfRel_IOfIRelCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPortInterfRelCount then begin fiInterfRel_PortInterfRelCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForIOfIRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiIOfIRel_ID := -1; fiIOfIRel_IDInterfRel := -1; fiIOfIRel_IDInterfTo := -1; fiIOfIRel_IDCompRel := -1; fiIOfIRel_IDIOfIRelMain := -1; fiIOfIRel_ConPosition := -1; fiIOfIRel_ConnectKind := -1; fiIOfIRel_PosConnectionsCount := -1; for i := 0 to tSQL_InterfOfInterfRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_InterfOfInterfRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiIOfIRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDInterfRel then begin fiIOfIRel_IDInterfRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDInterfTo then begin fiIOfIRel_IDInterfTo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCompRel then begin fiIOfIRel_IDCompRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDIOfIRelMain then begin fiIOfIRel_IDIOfIRelMain := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPosConnectionsCount then begin fiIOfIRel_PosConnectionsCount := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; { else if FldName = fnConPosition then begin fiIOfIRel_ConPosition := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnectKind then begin fiIOfIRel_ConnectKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end;} end; end; procedure TDM.DefineFieldIndexesForPortInterfRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiPortInterfRel_ID := -1; fiPortInterfRel_RelType := -1; fiPortInterfRel_IDPort := -1; fiPortInterfRel_IDInterfRel := -1; fiPortInterfRel_UnitInterfKolvo := -1; for i := 0 to tSQL_PortInterfaceRelation.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_PortInterfaceRelation.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiPortInterfRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnRelType then begin fiPortInterfRel_RelType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDPort then begin fiPortInterfRel_IDPort := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDInterfRel then begin fiPortInterfRel_IDInterfRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnUnitInterfKolvo then begin fiPortInterfRel_UnitInterfKolvo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForInterfPosConnection; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiInterfPosConnection_ID := -1; fiInterfPosConnection_IDIOfIRel := -1; fiInterfPosConnection_SelfFromPos := -1; fiInterfPosConnection_SelfToPos := -1; fiInterfPosConnection_ConnFromPos := -1; fiInterfPosConnection_ConnToPos := -1; for i := 0 to tSQL_InterfPosConnection.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_InterfPosConnection.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiInterfPosConnection_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDIOfIRel then begin fiInterfPosConnection_IDIOfIRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSelfFromPos then begin fiInterfPosConnection_SelfFromPos := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnSelfToPos then begin fiInterfPosConnection_SelfToPos := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnFromPos then begin fiInterfPosConnection_ConnFromPos := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnConnToPos then begin fiInterfPosConnection_ConnToPos := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForNorms; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiNorms_ID := -1; fiNorms_IDNB := -1; fiNorms_GUIDNB := -1; fiNorms_IDMaster := -1; fiNorms_TableKind := -1; fiNorms_Npp := -1; fiNorms_IsOn := -1; fiNorms_Kolvo := -1; fiNorms_TotalCost := -1; fiNorms_Cypher := -1; fiNorms_Name := -1; fiNorms_WorkKind := -1; fiNorms_Izm := -1; fiNorms_Zarplat := -1; fiNorms_LaborTime := -1; fiNorms_PricePerTime := -1; fiNorms_Price := -1; fiNorms_Cost := -1; fiNorms_IsFromInterface := -1; fiNorms_ExpenseForLength := -1; fiNorms_CountForPoint := -1; fiNorms_StepOfPoint := -1; fiNorms_IDCompPropRel := -1; for i := 0 to tSQL_Norms.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_Norms.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiNorms_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDNB then begin fiNorms_IDNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGUIDNB then begin fiNorms_GUIDNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDMaster then begin fiNorms_IDMaster := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTableKind then begin fiNorms_TableKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNpp then begin fiNorms_Npp := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsOn then begin fiNorms_IsOn := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolvo then begin fiNorms_Kolvo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTotalCost then begin fiNorms_TotalCost := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCypher then begin fiNorms_Cypher := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnName then begin fiNorms_Name := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnWorkKind then begin fiNorms_WorkKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIzm then begin fiNorms_Izm := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end {else if FldName = fnZarplat then begin fiNorms_Zarplat := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end} else if FldName = fnLaborTime then begin fiNorms_LaborTime := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPricePerTime then begin fiNorms_PricePerTime := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPrice then begin fiNorms_Price := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCost then begin fiNorms_Cost := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsFromInterface then begin fiNorms_IsFromInterface := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnExpenseForLength then begin fiNorms_ExpenseForLength := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCountForPoint then begin fiNorms_CountForPoint := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnStepOfPoint then begin fiNorms_StepOfPoint := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCompPropRel then begin fiNorms_IDCompPropRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForNormResRel; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiNormResRel_ID := -1; fiNormResRel_IDMaster := -1; fiNormResRel_TableKind := -1; fiNormResRel_Npp := -1; fiNormResRel_IDResource := -1; fiNormResRel_Kolvo := -1; fiNormResRel_IsOn := -1; fiNormResRel_Cost := -1; fiNormResRel_RValue := -1; fiNormResRel_ExpenseForLength := -1; fiNormResRel_GuidNBComponent := -1; fiNormResRel_CountForPoint := -1; fiNormResRel_StepOfPoint := -1; fiNormResRel_IDCompPropRel := -1; for i := 0 to tSQL_NormResourceRel.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_NormResourceRel.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiNormResRel_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDMaster then begin fiNormResRel_IDMaster := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTableKind then begin fiNormResRel_TableKind := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnNpp then begin fiNormResRel_Npp := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDResource then begin fiNormResRel_IDResource := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnKolvo then begin fiNormResRel_Kolvo := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIsOn then begin fiNormResRel_IsOn := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCost then begin fiNormResRel_Cost := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnRValue then begin fiNormResRel_RValue := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnExpenseForLength then begin fiNormResRel_ExpenseForLength := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGuidNBComponent then begin fiNormResRel_GuidNBComponent := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCountForPoint then begin fiNormResRel_CountForPoint := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnStepOfPoint then begin fiNormResRel_StepOfPoint := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDCompPropRel then begin fiNormResRel_IDCompPropRel := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForResource; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiResource_ID := -1; fiResource_IDNB := -1; fiResource_GuidNB := -1; fiResource_TableKindNB := -1; fiResource_Cypher := -1; fiResource_Name := -1; fiResource_Izm := -1; fiResource_Price := -1; fiResource_AdditionalPrice := -1; fiResource_RType := -1; for i := 0 to tSQL_Resources.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_Resources.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiResource_ID := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIDNB then begin fiResource_IDNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnGuidNB then begin fiResource_GuidNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnTableKindNB then begin fiResource_TableKindNB := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnCypher then begin fiResource_Cypher := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnName then begin fiResource_Name := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnIzm then begin fiResource_Izm := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnPrice then begin fiResource_Price := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnAdditionalPrice then begin fiResource_AdditionalPrice := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end else if FldName = fnRType then begin fiResource_RType := CurrFieldDef.Index; Continue; ///// CONTINUE ///// end; end; end; procedure TDM.DefineFieldIndexesForCADNormStruct; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCADNormStruct_ID := -1; fiCADNormStruct_IDCatalog := -1; fiCADNormStruct_IDItemType := -1; fiCADNormStruct_Npp := -1; fiCADNormStruct_Name := -1; fiCADNormStruct_Izm := -1; fiCADNormStruct_Kolvo := -1; for i := 0 to tSQL_CADNormStruct.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CADNormStruct.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCADNormStruct_ID := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnIDCatalog then begin fiCADNormStruct_IDCatalog := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnIDItemType then begin fiCADNormStruct_IDItemType := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnNpp then begin fiCADNormStruct_Npp := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnName then begin fiCADNormStruct_Name := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnIzm then begin fiCADNormStruct_Izm := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnKolvo then begin fiCADNormStruct_Kolvo := CurrFieldDef.Index; Continue; //// CONTINUE //// end; end; end; procedure TDM.DefineFieldIndexesForCADNormColumn; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiCADNormColumn_ID := -1; fiCADNormColumn_IDCADNormStruct := -1; fiCADNormColumn_Name := -1; fiCADNormColumn_ChildColumns := -1; for i := 0 to tSQL_CADNormColumn.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_CADNormColumn.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiCADNormColumn_ID := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnIDCADNormStruct then begin fiCADNormColumn_IDCADNormStruct := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnName then begin fiCADNormColumn_Name := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnChildColumns then begin fiCADNormColumn_ChildColumns := CurrFieldDef.Index; Continue; //// CONTINUE //// end; end; end; procedure TDM.DefineFieldIndexesForStringsMan; var i: Integer; CurrFieldDef: TFieldDef; FldName: String; begin fiStringsMan_ID := -1; fiStringsMan_StrType := -1; fiStringsMan_Name := -1; for i := 0 to tSQL_StringsMan.FieldDefs.Count - 1 do begin CurrFieldDef := tSQL_StringsMan.FieldDefs[i]; FldName := AnsiUpperCase(CurrFieldDef.Name); if FldName = fnID then begin fiStringsMan_ID := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnStrType then begin fiStringsMan_StrType := CurrFieldDef.Index; Continue; //// CONTINUE //// end else if FldName = fnName then begin fiStringsMan_Name := CurrFieldDef.Index; Continue; //// CONTINUE //// end; end; end; procedure TDM.DefineCatalogComponPricesAfterMoveToNewCatalog(AIDCatalog: Integer; AOldCurrencyM: TObjectCurrencyRel); var CurrencyM: PObjectCurrencyRel; CurrencyMAsOld: PObjectCurrencyRel; ComponIDs: TIntList; begin CurrencyM := nil; CurrencyMAsOld := nil; CurrencyM := GetCatalogCurrencyByMainFld(AIDCatalog, ctMain); if (CurrencyM <> nil) and (CurrencyM.IDCurrency <> AOldCurrencyM.IDCurrency) then begin CurrencyMAsOld := GetCatalogCurrencyByCurrencyID(AIDCatalog, AOldCurrencyM.IDCurrency); if (CurrencyM <> nil) and (CurrencyMAsOld <> nil) then begin ComponIDs := GetCatalogAllComponIDs(AIDCatalog, true); ChangeComponsCurrencyRatiosWithPrices(ComponIDs, CurrencyMAsOld.Data, CurrencyM.Data, Query_Select, Query_Operat); FreeAndNil(ComponIDs); end; end; if CurrencyM <> nil then FreeMem(CurrencyM); if CurrencyMAsOld <> nil then FreeMem(CurrencyMAsOld); end; // ##### Удаляет папку из базы ##### function TDM.DelSimpleCatalog(AIDCatalog: Integer; AQueryMode: TQueryMode): Boolean; var strWhere: String; QOperat: TSCSQuery; begin Result := false; try strWhere := 'ID = '''+ IntToStr(AIDCatalog) +''''; case AQueryMode of qmPhisical: begin QOperat := TSCSQuery.Create(GForm, Query_Operat, qSQL_QueryOperat); QOperat.QueryMode := AQueryMode; SetSQLToQuery(QOperat, ' DELETE FROM KATALOG WHERE '+strWhere); Result := true; QOperat.Close; FreeAndNil(QOperat); DeleteCatalogFromLists(AIDCatalog); end; qmMemory: if FMemBaseActive then begin{ //tSQL_CatalogPropRelation.DeleteAllIndexes; //SetFilterToSQLMemTable(tSQL_CatalogMarkMask, ''); SetFilterToSQLMemTable(tSQL_CatalogPropRelation, ''); SetFilterToSQLMemTable(tSQL_CatalogRelation, ''); //SetFilterToSQLMemTable(tSQL_Katalog, ''); tSQL_Katalog.Filtered := false; if tSQL_Katalog.Locate(fnID, AIDCatalog, []) then tSQL_Katalog.Delete; } end; end; except on E: Exception do AddExceptionToLog('TDM.DelSimpleCatalog: '+E.Message); end; end; procedure TDM.DelCatalog(ACallFrom: TCallFrom; AIDCatalog, AIDItemType: Integer; AQueryMode: TQueryMode; aCatalogObj: TSCSCatalog=nil; aIsManual: Boolean=false); var HaveMeetList: Boolean; HaveMeetProject: Boolean; SCSList: TSCSList; CatalogToDel: TSCSCatalog; ChildCatalog: TSCSCatalog; QueryMode: TQueryMode; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // procedure StepDelCompon(aCompon: TSCSComponent); var i: Integer; Child: TSCSComponent; begin if CheckSysNameIsCableChannel(aCompon.ComponentType.SysName) = true then for i := aCompon.ChildComplects.Count-1 downto 0 do StepDelCompon(aCompon.ChildComplects[i]); DelComponent(aCompon.ID, aCompon, dmTrace); end; procedure Step(AID_Dir, AItemType: Integer; aDirObj: TSCSCatalog); var SubDirsID: TIntList; //SubDirID: ^Integer; DirCompons: TIntList; SCSCatalog: TSCSCatalog; SCSCompon: TSCSComponent; ChildCatalogs: TSCSCatalogs; CatalogCompons: TSCSComponents; i: Integer; //ItemType: Integer; ChildItemType: Integer; ChildQueryMode: TQueryMode; SCSID: Integer; ListID: integer; DesignLists: TSCSLists; DesignList: TSCSList; SCSDir: TSCSCatalog; SCSChild: TSCSCatalog; begin SCSDir := aDirObj; //22.01.2013 nil; DirCompons := nil; ChildQueryMode := QueryMode; if AItemType = itProject then begin QueryMode := qmPhisical; ChildQueryMode := qmMemory; SCSDir := TF_Main(GForm).GSCSBase.CurrProject; end else if (AItemType = itDir) and (AQueryMode = qmPhisical) and Not HaveMeetProject then begin QueryMode := qmPhisical; ChildQueryMode := qmPhisical; end; if QueryMode = qmMemory then begin if SCSDir = nil then SCSDir := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AID_Dir); if SCSDir <> nil then SCSDir.ServDeleting := true; end; DesignLists := nil; //ItemType := GetCatalogFieldValueAsInteger(AID_Dir, fnID, fnIDItemType, QueryMode); if TF_Main(GForm).GDBMode = bkProjectManager then begin if Not HaveMeetList then if AItemType = itList then HaveMeetList := true; if Not HaveMeetProject then if AItemType = itProject then HaveMeetProject := true; end; //*** Удалить подпапки if Not(HaveMeetProject) then begin //22.01.2013 //SubDirsID := GetCatalogChildsID(AID_Dir, SCSDir, ChildQueryMode); //if SubDirsID <> nil then //begin // for i := 0 to SubDirsID.Count - 1 do // begin // if ChildQueryMode = qmPhisical then // ChildItemType := GetCatalogFieldValueAsInteger(SubDirsID[i], fnID, fnIDItemType, ChildQueryMode) // else // begin // SCSChild := SCSDir.GetCatalogFromReferences(SubDirsID[i]); // ChildItemType := SCSChild.ItemType; // end; // Step(SubDirsID[i], ChildItemType); // end; // FreeAndNil(SubDirsID); //end; if ChildQueryMode = qmPhisical then begin SubDirsID := GetCatalogChildsID(AID_Dir, SCSDir, ChildQueryMode); if SubDirsID <> nil then begin for i := 0 to SubDirsID.Count - 1 do begin ChildItemType := GetCatalogFieldValueAsInteger(SubDirsID[i], fnID, fnIDItemType, ChildQueryMode); Step(SubDirsID[i], ChildItemType, nil); end; FreeAndNil(SubDirsID); end; end else begin ChildCatalogs := TSCSCatalogs.Create(false); ChildCatalogs.Assign(SCSDir.ChildCatalogs); for i := 0 to ChildCatalogs.Count - 1 do begin SCSChild := ChildCatalogs[i]; Step(SCSChild.ID, SCSChild.ItemType, SCSChild); end; FreeAndNil(ChildCatalogs); end; end; ////*** Отобрать подпапки //SubDirsID := GetCatalogChildsID(AID_Dir, QueryMode); //if SubDirsID <> nil then //begin // for i := 0 to SubDirsID.Count - 1 do // begin // ChildItemType := GetCatalogFieldValueAsInteger(SubDirsID[i], fnID, fnIDItemType, ChildQueryMode); // Step(SubDirsID[i], ChildItemType); // end; // FreeAndNil(SubDirsID); //end; //*** Снести компоненты папки AID_Dir if Not(HaveMeetList) and Not(HaveMeetProject) then begin //22.01.2013 //case ChildQueryMode of // qmPhisical: // DirCompons := GetCatalogComponentsID(AID_Dir); // qmMemory: // if SCSDir <> nil then // DirCompons := SCSDir.GetComponentsIDList; //end; //if DirCompons <> nil then //begin // for i := 0 to DirCompons.Count - 1 do // begin // SCSCompon := nil; // if TF_Main(GForm).GDBMode = bkNormBase then // begin // SCSCompon := TSCSComponent.Create(GForm); // SCSCompon.LoadComponentByID(DirCompons[i], false); // end // else // SCSCompon := SCSDir.GetComponentFromReferences(DirCompons[i]); //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(Integer(DirCompons.Items[i]^)); // if Assigned(SCSCompon) then // TF_Main(GForm).DelCompon(SCSCompon, nil, true, false, false, false); // end; // FreeAndNil(DirCompons); //end; if ChildQueryMode = qmPhisical then begin DirCompons := GetCatalogComponentsID(AID_Dir); if DirCompons <> nil then begin for i := 0 to DirCompons.Count - 1 do begin SCSCompon := TSCSComponent.Create(GForm); SCSCompon.LoadComponentByID(DirCompons[i], false); TF_Main(GForm).DelCompon(SCSCompon, nil, true, false, false, false); end; FreeAndNil(DirCompons); end; end else begin CatalogCompons := TSCSComponents.Create(false); CatalogCompons.Assign(SCSDir.SCSComponents); for i := 0 to CatalogCompons.Count - 1 do //24.07.2013 TF_Main(GForm).DelCompon(CatalogCompons[i], nil, true, false, false, false); //02.08.2013 - если удаление вручную с КАДа, то удалять по всей длине, если авто удаление, то на участке трассы if aIsManual then StepDelCompon(CatalogCompons[i]) else TF_Main(GForm).DelCompon(CatalogCompons[i], nil, true, false, false, false); FreeAndNil(CatalogCompons); end; end; //if AIDItemType <> itProject then // begin // DelNormsByMasterID(AID_Dir, ctkCatalog); // DelResourcesByMasterID(AID_Dir, ctkCatalog); // end; //*** Снести папку AID_Dir if TF_Main(GForm).GDBMode = bkProjectManager then begin //SCSCatalog := TSCSCatalog.Create(GForm); //SCSCatalog.QueryMode := QueryMode; //SCSCatalog.LoadCatalogByID(AID_Dir, false, false); SCSCatalog := nil; case AItemType of itSCSConnector, itSCSLine: if Not(HaveMeetList) and Not(HaveMeetProject) then begin SCSCatalog := SCSDir; //22.01.2013 SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AID_Dir); if SCSCatalog <> nil then begin SCSID := SCSCatalog.SCSID; ListID := SCSCatalog.ListID; TF_Main(GForm).GSCSBase.CurrProject.RemoveChildCatalogByID(AID_Dir); if ACallFrom = cfBase then if Not HaveMeetList then DeleteObjectFromCad(ListID, SCSID, ''); end; //DelSimpleCatalog(AID_Dir, QueryMode); end; itDir: if Not HaveMeetProject then begin TF_Main(GForm).GSCSBase.CurrProject.RemoveChildCatalogByID(AID_Dir); DelSimpleCatalog(AID_Dir, QueryMode); end; itRoom: if Not(HaveMeetList) and Not(HaveMeetProject) then begin if ACallFrom = cfBase then begin SCSCatalog := SCSDir; //22.01.2013 SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AID_Dir); if SCSCatalog <> nil then DeleteCabinetOnCAD(SCSCatalog.ListID, SCSCatalog.SCSID); end; TF_Main(GForm).GSCSBase.CurrProject.RemoveChildCatalogByID(AID_Dir); //DelSimpleCatalog(AID_Dir, QueryMode); end; itList: //if Not HaveMeetProject then begin SCSCatalog := SCSDir; //22.01.2013 SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AID_Dir); if SCSCatalog <> nil then begin SCSCatalog.IsDeleting := true; //*** Удалить Листы с дизайном компонент, кот-е находятся на удаляемомо Листе DesignLists := TF_Main(GForm).GSCSBase.CurrProject.GetDesignListsFromList(TSCSList(SCSCatalog)); for i := 0 to DesignLists.Count - 1 do begin DesignList := DesignLists[i]; DesignList.Delete(ACallFrom); //DeleteNode(DesignList.TreeViewNode); end; DesignLists.Free; if ACallFrom = cfBase then begin DeleteListInCAD(SCSCatalog.SCSID, SCSCatalog.Name); end; TF_Main(GForm).GSCSBase.CurrProject.RemoveListByID(SCSCatalog.SCSID); //TF_Main(GForm).SwitchInCAD(); end; //DelSimpleCatalog(AID_Dir, QueryMode); end; itProject: begin //if SCSCatalog.ID = GIDLastPoject then if AID_Dir = TF_Main(GForm).GSCSBase.CurrProject.CurrID then if TF_Main(GForm).GSCSBase.CurrProject.Active then begin GisOpenProjectDelFromPM := True; // // Tolik 21/01/2021 -- TF_Main(GForm).GSCSBase.CurrProject.ReadOnly := true; TF_Main(GForm).GSCSBase.CurrProject.IsDeleting := true; try TF_Main(GForm).GSCSBase.CurrProject.Close; //ChangeCurrProject(GIDLastPoject, -1); finally TF_Main(GForm).GSCSBase.CurrProject.IsDeleting := false; TF_Main(GForm).GSCSBase.CurrProject.ReadOnly := false; end; end; DelSimpleCatalog(AID_Dir, QueryMode); end; end; //SCSCatalog.Free; end else DelSimpleCatalog(AID_Dir, QueryMode); end; begin //OnDelCADObject := nil; F_ProjMan.LockTreeAndGrid(True); // Tolik 27/11/2017 -- try OldTick := GetTickCount; HaveMeetList := false; HaveMeetProject := false; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); CatalogToDel := nil; //*** Не удалять объекты комнаты if TF_Main(GForm).GDBMode = bkProjectManager then begin if aCatalogObj <> nil then CatalogToDel := aCatalogObj else CatalogToDel := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); // проверим еще раньше... //в - Procedure DeleteObjectFromPM(ID_Figure: Integer; const ObjName: String; aIsManual: Boolean=false); (* if ACallFrom = cfCAD then begin if (CatalogToDel <> nil) and (CatalogToDel.ListID <> GCadForm.FCADListID) then begin {$IF Defined(BASEADM_SCS)} ShowMessage('Невозможно удалить данный компонент'); {$IFEND} exit; end; end; *) if CatalogToDel <> nil then begin CatalogToDel.NotifyChange; SCSList := CatalogToDel.GetListOwner; OpenNoExistsListInCAD(SCSList); if CatalogToDel.ItemType = itRoom then begin if SCSList <> nil then while CatalogToDel.ChildCatalogs.Count > 0 do begin ChildCatalog := CatalogToDel.ChildCatalogs[0]; MoveSCSTreeObject(ChildCatalog, SCSList); end; end; end; end; Step(AIDCatalog, AIDItemType, CatalogToDel); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; finally //OnDelCADObject := DelCatalog; end; F_ProjMan.LockTreeAndGrid(False); // Tolik 27/11/2017 -- end; procedure TDM.DelComponent(AIDComponent: Integer; AObject: TSCSComponent; ADelComponMode: TDelComponMode; ACanDelCablesFromOtherList: PInteger = nil; AListWithCompons: TSCSComponents = nil; AStepProgress: Boolean = false); var ComponentToDel: TSCSComponent; ComponToDelListID: Integer; WholeComponent: TSCSComponents; PartComponent: TSCSComponent; CanDelLineComponent: Boolean; WasSetCablesToDelForOtherList: Boolean; i, j: Integer; { procedure FreeComponsFromComplect(AIDCompon, AIDComplect: Integer; AComponNode: TTreeNode); var IDCompRel: Integer; ptrComplect: PComplect; Compon: TSCSComponent; //Child: TSCSComponent; begin IDCompRel := 0; case GDBMode of bkNormBase: IDCompRel := DM.GetIDCompRelByConnectCompons(AIDCompon, AIDComplect, cntComplect); bkProjectManager: begin ptrComplect := nil; Compon := GscsBase.CurrProject.GetComponentFromReferences(AIDCompon); //Child := GscsBase.CurrProject.GetComponentFromReferences(AIDComplect); if Compon <> nil then ptrComplect := Compon.GetComplectByIDChild(AIDComplect); if ptrComplect <> nil then IDCompRel := ptrComplect.ID; end; end; DelComplect(IDCompRel, AIDCompon, AIDComplect, AComponNode, cntComplect); end; } begin ComponentToDel := nil; ComponToDelListID := 0; if AObject <> nil then begin ComponentToDel := AObject; ComponToDelListID := ComponentToDel.ListID; end; case TF_Main(GForm).GDBMode of bkNormBase: begin if ComponentToDel = nil then ComponentToDel := TSCSComponent.Create(GForm); ComponentToDel.LoadComponentByID(AIDComponent); ComponentToDel.TreeViewNode := TF_Main(GForm).FindTreeNodeByDat(AIDComponent, [itComponLine, itComponCon]); if ComponentToDel.TreeViewNode = nil then ComponentToDel.TreeViewNode := TF_Main(GForm).FindComponOrDirInTree(AIDComponent, true); //if ComponentToDel.IsLine = biTrue then // TF_Main(GForm).MoveComponComplectsToUp(ComponentToDel.TreeViewNode); if Assigned(AListWithCompons) then begin AListWithCompons.Remove(ComponentToDel); AListWithCompons.RemoveByList(ComponentToDel.ChildReferences); end; TF_Main(GForm).DelCompon(ComponentToDel, nil, true, true, false, false); //DM.DataSet.Delete; //OnAddDeleteNode(DelNode, nil, false); //SetKol(ParentNode, nil); //DeleteNode(DelNode); end; bkProjectManager: begin if ComponentToDel = nil then ComponentToDel := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if ComponentToDel <> nil then begin if ComponentToDel.TreeViewNode = nil then ComponentToDel.TreeViewNode := TF_Main(GForm).FindTreeNodeByDat(AIDComponent, [itComponLine, itComponCon]); if ComponentToDel.TreeViewNode = nil then ComponentToDel.TreeViewNode := TF_Main(GForm).FindComponOrDirInTree(AIDComponent, true); if ComponentToDel.IsLine = biTrue then TF_Main(GForm).MoveComponComplectsToUp(ComponentToDel, ComponentToDel.TreeViewNode); if (ADelComponMode <> dmTrace) or (ComponentToDel.IsLine = biFalse) then begin if ComponentToDel.Parent is TSCSComponent then begin ComponentToDel.DisJoinFromAll(true, true).free; ComponentToDel.DisConnectFromParent; //FreeComponsFromComplect(ParentDat.ObjectID, GSCSBase.SCSComponent.ID, ParentNode) end; if AStepProgress then StepProgress; if Assigned(AListWithCompons) then begin AListWithCompons.Remove(ComponentToDel); AListWithCompons.RemoveByList(ComponentToDel.ChildReferences); end; TF_Main(GForm).DelCompon(ComponentToDel, nil, true, true, true, false); //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 begin WholeComponent := ComponentToDel.ProjectOwner.GetComponentsByWholeID(ComponentToDel.Whole_ID); WasSetCablesToDelForOtherList := false; for i := 0 to WholeComponent.Count - 1 do begin PartComponent := nil; PartComponent := WholeComponent[i]; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(TraceCompons.Items[i]); if Assigned(PartComponent) then begin CanDelLineComponent := false; if PartComponent.ListID = ComponToDelListID then begin CanDelLineComponent := true; if AStepProgress then StepProgress; end else begin //*** Удалять кабели с других листов if ACanDelCablesFromOtherList <> nil then begin //**** ХЗ - Удалять лапшу на других этажах if ACanDelCablesFromOtherList^ = biNone then begin if GIsProgress then PauseProgress(true); try if MessageModal(cMain_Msg24, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then ACanDelCablesFromOtherList^ := biTrue else ACanDelCablesFromOtherList^ := biFalse; finally if GIsProgress then PauseProgress(false); end; end; if ACanDelCablesFromOtherList^ = biTrue then begin CanDelLineComponent := true; //*** пометить компоненты с другого листа как удаляемые if Not WasSetCablesToDelForOtherList then for j := i to WholeComponent.Count - 1 do WholeComponent[j].ServToDelete := true; end; end else CanDelLineComponent := true; end; if CanDelLineComponent then begin if Assigned(AListWithCompons) then begin AListWithCompons.Remove(PartComponent); AListWithCompons.RemoveByList(PartComponent.ChildReferences); end; TF_Main(GForm).DelCompon(PartComponent, nil, true, true, true, false); end; //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; FreeAndNil(WholeComponent); end; end; end; end; end; procedure TDM.UpdateCatalogFieldAsInteger(AID, AValue: Integer; AFieldBy, AFieldName: String; AMode: TQueryMode); var strWhere: String; QOperat: TSCSQuery; begin strWhere := AFieldBy +'='+ IntTostr(AID); case AMode of qmPhisical: begin QOperat := TSCSQuery.Create(GForm, Query_Operat, qSQL_QueryOperat); QOperat.QueryMode := qmPhisical; SetSQLToQuery(QOperat, ' update katalog set '+AFieldName+' = '''+IntToStr(AValue)+''' where '+strWhere); QOperat.Close; FreeAndNil(QOperat); end; qmMemory: if FMemBaseActive then begin { tSQL_Katalog.Filtered := false; if tSQL_Katalog.Locate(AFieldBy, AID, []) then begin tSQL_Katalog.Edit; tSQL_Katalog.FieldByName(AFieldName).AsInteger := AValue; tSQL_Katalog.Post; end; } //if SetFilterToSQLMemTable(tSQL_Katalog, strWhere) then // if Not tSQL_Katalog.Eof then // begin // tSQL_Katalog.Edit; // tSQL_Katalog.FieldByName(AFieldName).AsInteger := AValue; // tSQL_Katalog.Post; // end; end; end; end; procedure TDM.UpdateCatalogFieldAsString(AID: Integer; AValue, AFieldBy, AFieldName: String; AMode: TQueryMode); var strWhere: String; QOperat: TSCSQuery; begin strWhere := AFieldBy +'='+ IntTostr(AID); case AMode of qmPhisical: begin QOperat := TSCSQuery.Create(GForm, Query_Operat, qSQL_QueryOperat); QOperat.QueryMode := AMode; SetSQLToQuery(QOperat, ' update katalog set '+AFieldName+' = '''+AValue+''' where '+strWhere); QOperat.Close; FreeAndNil(QOperat); end; qmMemory: if FMemBaseActive then begin //if SetFilterToSQLMemTable(tSQL_Katalog, strWhere) then // if Not tSQL_Katalog.Eof then // begin // tSQL_Katalog.Edit; // tSQL_Katalog.FieldByName(AFieldName).AsString := AValue; // tSQL_Katalog.Post; // end; end; end; end; {// ##### Вернет список Id-в всех Подпапок всех уровней ##### function TDM.GetCatalogAllChildsIDs(AIDCatalog: Integer): TIntList; procedure Step(AParentID: Integer); var ChildIDs: TIntList; i: Integer; CurrID: Integer; begin //***Отобрать подпапки Query_Select.Close; Query_Select.ParamByName(fnParentID).AsInteger := AParentID; Query_Select.ExecQuery; ChildIDs := TIntList.Create; IntFIBFieldToIntList(ChildIDs, Query_Select, fnID); for i := 0 to ChildIDs.Count - 1 do begin CurrID := ChildIDs[i]; Result.Add(CurrID); Step(CurrID); end; end; begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalog, fnParentID+' = :'+fnParentID, nil, fnID), false); Result := TIntList.Create; Step(AIDCatalog); end;} function TDM.GetCatalogAllComponIDs(AIDCatalog: Integer; AFromChild: Boolean): TIntList; //var // DirIDs: TIntList; begin Result := U_BaseCommon.GetCatalogAllComponIDs(AIDCatalog, AFromChild, Query_Select); {Result := nil; DirIDs := nil; if AFromChild then DirIDs := GetCatalogAllChildsIDs(AIDCatalog) else DirIDs := TIntList.Create; DirIDs.Insert(0, AIDCatalog); try Result := GetComponIDsFromCatalogs(DirIDs); finally DirIDs.Free; end;} end; // ##### Вернет Подпапки ##### function TDM.GetCatalogChildsID(AIDCatalog: Integer; ASCSCatalog: TSCSCatalog; AQueryMode: TQueryMode): TIntList; var ResList: TIntList; QSelect: TSCSQuery; strFilter: String; i: Integer; SCSChild: TSCSCatalog; begin Result := nil; try ResList := TIntList.Create; strFilter := 'PARENT_ID = '''+ IntToStr(AIDCatalog) +''''; case AQueryMode of qmPhisical: begin SetSQLToFIBQuery(Query_Select, ' SELECT ID FROM KATALOG WHERE '+ strFilter); IntFIBFieldToIntList(ResList, Query_Select, fnID); end; qmMemory: begin if Assigned(ASCSCatalog) then for i := 0 to ASCSCatalog.ChildCatalogs.Count - 1 do begin SCSChild := ASCSCatalog.ChildCatalogs[i]; ResList.Add(SCSChild.ID); end; //if SetFilterToSQLMemTable(tSQL_Katalog, strFilter) then // IntFieldToIntListFromSQLMemTable(ResList, tSQL_Katalog, fnID); end; end; Result := ResList; except on E: Exception do AddExceptionToLog('TDM.GetCatalogChildsID: '+E.Message); end; end; // ##### Вернет список ID-в компонент папки #### function TDM.GetCatalogComponentsID(AIDCatalog: Integer): TIntList; var ResList: TIntList; strWhere: String; begin Result := nil; try strWhere := 'id_catalog = '''+IntToStr(AIDCatalog)+''''; ResList := TIntList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select id_component from catalog_relation where '+ strWhere); IntFieldToIntList(ResList, scsQSelect, fnIDComponent); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, strWhere) then // IntFieldToIntListFromSQLMemTable(ResList, tSQL_CatalogRelation, fnIDComponent); end; end; Result := ResList; except on E: Exception do AddExceptionToLog('TDM.GetCatalogComponentsID: '+E.Message); end; end; function TDM.GetCatalogComponentsIDByObjectID(AObjectID: Integer): TList; var ResList: TList; strWhere: String; begin Result := nil; try strWhere := 'object_id = '''+IntToStr(AObjectID)+''''; ResList := TList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select id from component where '+ strWhere); IntFieldToList(ResList, scsQSelect, fnIDComponent); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Component, strWhere) then // IntFieldToListFromSQLMemTable(ResList, tSQL_Component, fnID); end; end; Result := ResList; except on E: Exception do AddExceptionToLog('TDM.GetCatalogComponentsID: '+E.Message); end; end; procedure TDM.GetCatalogItemsCountAndKolCompon(AIDCatalog: Integer; var AItemsCnt: Integer; var AKolCompon: Integer; AMode: TQueryMode); var QSelect: TSCSQuery; SCSCatalog: TSCSCatalog; begin case AMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := AMode; SetSQLToQuery(QSelect, ' SELECT KOL_COMPON, ITEMS_COUNT FROM KATALOG ' + ' WHERE ID = ''' +IntToStr(AIDCatalog)+ ''' '); AItemsCnt := QSelect.GetFNAsInteger('Items_Count'); AKolCompon := QSelect.GetFNAsInteger('KOL_COMPON'); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: begin SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if Assigned(SCSCatalog) then begin AItemsCnt := SCSCatalog.ItemsCount; AKolCompon := SCSCatalog.KolCompon; end; end; {if FMemBaseActive then begin tSQL_Katalog.Filtered := false; tSQL_Katalog.Filter := 'ID = ''' +IntToStr(AIDCatalog)+ ''''; tSQL_Katalog.Filtered := true; AItemsCnt := tSQL_Katalog.FieldByName('ITEMS_COUNT').AsInteger; AKolCompon := tSQL_Katalog.FieldByName('KOL_COMPON').AsInteger; end;} end; end; function TDM.GetCatalogKolCompon(AIDCatalog: Integer; AMode: TQueryMode): Integer; var QSelect: TSCSQuery; begin Result := 0; case AMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := AMode; SetSQLToQuery(QSelect, ' SELECT KOL_COMPON FROM KATALOG ' + ' WHERE ID = ''' + IntToStr(AIDCatalog) + ''''); Result := QSelect.GetFNAsInteger('KOL_COMPON'); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: if FMemBaseActive then begin tSQL_Katalog.Filtered := false; tSQL_Katalog.Filter := 'id = '''+IntToStr(AIDCatalog)+''''; tSQL_Katalog.Filtered := true; Result := tSQL_Katalog.FieldByName('KOL_COMPON').AsInteger; end; end; end; function TDM.GetCatalogKolComponFromLists(AIDCatalog: Integer): Integer; var i: Integer; begin Result := 0; for i := 0 to FCatRelCatalogIDs.Count - 1 do begin if FCatRelCatalogIDs[i] = AIDCatalog then Inc(Result); end; end; function TDM.GetChildCatalogsID(AParentID: Integer; ASortFld: String; AMode: TQueryMode): TIntList; var strQrderBy: String; strFilter: String; //ptrID: ^Integer; i: Integer; ParentCatalog: TSCSCatalog; ChildCatalog: TSCSCatalog; begin Result := nil; ParentCatalog := nil; ChildCatalog := nil; case AMode of qmPhisical: begin Result := U_BaseCommon.GetCatalogChildsID(AParentID, ASortFld, Query_Select); end; qmMemory: //if FMemBaseActive then with TF_Main(GForm) do begin Result := TIntList.Create; if AParentID = 0 then ParentCatalog := GSCSBase.CurrProject else ParentCatalog := GSCSBase.CurrProject.GetCatalogFromReferences(AParentID); if Assigned(ParentCatalog) then for i := 0 to ParentCatalog.ChildCatalogs.Count - 1 do begin ChildCatalog := ParentCatalog.ChildCatalogs[i]; if Assigned(ChildCatalog) then Result.Add(ChildCatalog.ID); {begin GetMem(ptrID, SizeOf(Integer)); ptrID^ := ChildCatalog.ID; Result.Add(ptrID); end;} end; {if AParentID = 0 then begin for i := 0 to end else begin tSQL_Katalog.Filtered := false; tSQL_Katalog.Filter := 'Parent_ID = ''' +IntToStr(AParentID)+ ''''; tSQL_Katalog.Filtered := true; tSQL_Katalog.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Katalog, ASortFld); IntFieldToListFromSQLMemTable(Result, tSQL_Katalog, 'ID'); tSQL_Katalog.IndexName := ''; end;} end; end; end; function TDM.GetChildCatalogsIDFromLists(AParentID: Integer): TIntList; var i: Integer; begin Result := TIntList.Create; for i := 0 to FCatParentIDs.Count - 1 do begin if FCatParentIDs[i] = AParentID then Result.Add(FCatIDs[i]); end; end; function TDM.GetListObjectsID(AListID: Integer; ASortFld: String): TList; begin Result := TList.Create; tSQL_Katalog.Filtered := false; tSQL_Katalog.Filter := '(List_ID = ''' +IntToStr(AListID)+ ''') and ((id_item_type = '''+IntTostr(itSCSLine)+''') or (id_item_type = '''+IntTostr(itSCSConnector)+'''))'; tSQL_Katalog.Filtered := true; tSQL_Katalog.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Katalog, ASortFld); IntFieldToListFromSQLMemTable(Result, tSQL_Katalog, 'ID'); tSQL_Katalog.IndexName := ''; end; function TDM.GetCatalogComponents(AIDCatalog: Integer; ASortFld: String; AFilterParams: TFilterParams; var ASkipCount: integer; AOnlyOne: Boolean): TSCSComponents; var //ptrCompData: PComponData; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; //IDComponList: TList; i, j: Integer; strOrderBy: String; CanAddComponToRes: Boolean; IDComponentType: Integer; IDProducer: Integer; IDNetType: Integer; //GuidComponentType: String; //GuidProducer: String; //GuidNetType: String; ChildFilterBlock: TFilterBlock; SprComponentType: TNBComponentType; SprNetType: TNBNetTYpe; SprProducer: TNBProducer; ComponIDList: TIntList; CurrComponID: Integer; LookedComponCount: Integer; FieldNames: TStringList; CatInfo: TCatalogInfo; begin Result := nil; ASkipCount := 0; if AFilterParams.IsUseFilter then //if (AFilterParams.FFilterBlock <> nil) and AFilterParams.FFilterBlock.IsOn then if AFilterParams.FFilterType = fltCustom then DefineIsOnFilterBlocks(AFilterParams, true); case TF_Main(GForm).GDBMode of bkNormBase: begin Result := TSCSComponents.Create(true); //*** Отобрать компоненты папки в список ComponIDList := TIntList.Create; LookedComponCount := 0; CatInfo := GetCatalogInfoByID(AIDCatalog); if CatInfo <> nil then for i := 0 to CatInfo.ComponCount - 1 do begin CurrComponID := CatInfo.ComponIDs[i]; if CanShowComponByFilter(CurrComponID, AFilterParams, LookedComponCount=0) then ComponIDList.Add(CurrComponID); Inc(LookedComponCount); end; //*** Отобрать компоненты папки в список //ComponIDList := TIntList.Create; // LookedComponCount := 0; // for i := 0 to FCatRelCatalogIDs.Count - 1 do // if FCatRelCatalogIDs[i] = AIDCatalog then // begin // CurrComponID := FCatRelComponIDs[i]; // if CanShowComponByFilter(CurrComponID, AFilterParams, LookedComponCount=0) then // ComponIDList.Add(CurrComponID); // Inc(LookedComponCount); // end; if ComponIDList.Count > 0 then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnIsLine); FieldNames.Add(fnPrice); FieldNames.Add(fnPriceCalc); FieldNames.Add(fnIDComponentType); FieldNames.Add(fnKolComplect); FieldNames.Add(fnSortID); FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, FieldNames, ''), false); //Tolik 22/05/2018 -- FieldNames.free; // for i := 0 to ComponIDList.Count - 1 do begin Query_Select.Close; Query_Select.Params[0].AsInteger := ComponIDList[i]; Query_Select.ExecQuery; SCSComponent := TSCSComponent.Create(GForm); SCSComponent.ID := ComponIDList[i]; SCSComponent.Name := Query_Select.Fields[0].AsString; SCSComponent.IsLine := Query_Select.Fields[1].AsInteger; SCSComponent.Price := Query_Select.Fields[2].AsFloat; SCSComponent.Price_Calc := Query_Select.Fields[3].AsFloat; SCSComponent.ID_ComponentType := Query_Select.Fields[4].AsInteger; SCSComponent.KolComplect := Query_Select.Fields[5].AsInteger; SCSComponent.SortID := Query_Select.Fields[6].AsInteger; SCSComponent.GuidNB := Query_Select.Fields[7].AsString; SCSComponent.LoadComponentType; Result.Add(SCSComponent); if AOnlyOne then Break; //// BREAK //// end; Result.SortBySortID; end; FreeAndNil(ComponIDList); { Result := TSCSComponents.Create(true); strOrderBy := ''; if ASortFld <> '' then strOrderBy := 'ORDER BY '+ASortFld; SetSQLToFIBQuery(Query_Select, 'SELECT Component.ID, Component.NAME, ISlINE, PRICE, PRICE_CALC, '+ 'id_component_type, id_producer, id_net_type, '+ 'Kol_Complect, Component.Sort_ID '+ 'FROM COMPONENT, CATALOG_RELATION '+ ' WHERE (ID_CATALOG = '''+IntToStr(AIDCatalog)+''') and '+ ' (Component.ID = ID_Component) '+ ' '+strOrderBy); while Not Query_Select.Eof do begin CanAddComponToRes := true; IDComponentType := Query_Select.FN(fnIDComponentType).AsInteger; IDProducer := Query_Select.FN(fnIDProducer).AsInteger; IDNetType := Query_Select.FN(fnIDNetType).AsInteger; if AFilterBlock <> nil then if AFilterBlock.IsOn then begin //GuidComponentType := ''; //GuidProducer := ''; //GuidNetType := ''; SprComponentType := nil; SprNetType := nil; SprProducer := nil; //*** Заполнить фильтр данными компоненты for i := 0 to AFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterBlock.AllChildBlocks[i]; if ChildFilterBlock.Condition <> nil then begin case ChildFilterBlock.Condition.FieldIndex of fiGuidComponentType: begin if SprComponentType = nil then SprComponentType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetComponentTypeObjByID(IDComponentType); if SprComponentType <> nil then ChildFilterBlock.Condition.FieldValue := SprComponentType.ComponentType.GUID; end; fiGuidProducer: begin if SprProducer = nil then SprProducer := TF_Main(GForm).GSCSBase.NBSpravochnik.GetProducerByID(IDProducer); if SprProducer <> nil then ChildFilterBlock.Condition.FieldValue := SprProducer.GUID; end; fiGuidNetType: begin if SprNetType = nil then SprNetType := TF_Main(GForm).GSCSBase.NBSpravochnik.GetNetTypeByID(IDNetType); if SprNetType <> nil then ChildFilterBlock.Condition.FieldValue := SprNetType.GUID; end; end; end; end; CanAddComponToRes := AFilterBlock.Execute; end; if CanAddComponToRes then begin; SCSComponent := TSCSComponent.Create(GForm); SCSComponent.ID := Query_Select.FN(fnID).AsInteger; SCSComponent.Name := Query_Select.FN(fnName).AsString; SCSComponent.IsLine := Query_Select.FN(fnIsLine).AsInteger; SCSComponent.Price := Query_Select.FN(fnPrice).AsFloat; SCSComponent.Price_Calc := Query_Select.FN(fnPriceCalc).AsFloat; SCSComponent.ID_ComponentType := IDComponentType; SCSComponent.KolComplect := Query_Select.FN(fnKolComplect).AsInteger; SCSComponent.SortID := Query_Select.FN(fnSortID).AsInteger; SCSComponent.LoadComponentType; Result.Add(SCSComponent); if AOnlyOne then Break; //// BREAK //// end else Inc(ASkipCount); Query_Select.Next; end;} end; bkProjectManager: begin Result := TSCSComponents.Create(false); SCSCatalog := nil; SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AIDCatalog); if Assigned(SCSCatalog) then begin if (AFilterParams <> nil) and AFilterParams.IsUseFilter then begin for i := 0 to SCSCatalog.SCSComponents.Count - 1 do begin SCSComponent := SCSCatalog.SCSComponents[i]; for j := 0 to AFilterParams.FFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterParams.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 AFilterParams.FFilterBlock.Execute then begin Result.Add(SCSComponent); if AOnlyOne then Break; //// BREAK //// end else Inc(ASkipCount); end; end else Result.Assign(SCSCatalog.SCSComponents); end; {SetFilterToSQLMemTable(tSQL_CatalogRelation, 'id_catalog = '''+IntToStr(AIDCatalog)+''''); tSQL_Component.Filtered := false; tSQL_Component.Filter := ' object_id = '''+IntToStr(AIDCatalog)+''''; tSQL_Component.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Component, ASortFld); tSQL_Component.Filtered := true; if Not tSQL_Component.Eof then tSQL_Component.First; while Not tSQL_Component.Eof do begin tSQL_CatalogRelation.First; while Not tSQL_CatalogRelation.Eof do begin if tSQL_Component.FieldByName(fnID).AsInteger = tSQL_CatalogRelation.FieldByName(fnIDComponent).AsInteger then begin GetMem(ptrCompData, SizeOf(TComponData)); ptrCompData.ID := tSQL_Component.FieldByName('ID').AsInteger; ptrCompData.Name := tSQL_Component.FieldByName('Name').AsString; ptrCompData.NameMark := tSQL_Component.FieldByName('Name_Mark').AsString; ptrCompData.WholeID := tSQL_Component.FieldByName('Whole_ID').AsInteger; ptrCompData.isLine := tSQL_Component.FieldByName('isLine').AsInteger; ptrCompData.Kol_Complect := tSQL_Component.FieldByName('Kol_Complect').AsInteger; ptrCompData.IDComponentType := tSQL_Component.FieldByName('id_component_type').AsInteger; ptrCompData.Sort_Id := tSQL_Component.FieldByName('Sort_Id').AsInteger; Result.Add(ptrCompData); end; tSQL_CatalogRelation.Next; end; tSQL_Component.Next; end; tSQL_Component.IndexName := ''; } end; end; end; function TDM.GetCatalogItemsCntByID(AID, AItemType: Integer; AMode: TQueryMode): Integer; begin Result := 0; case AMode of qmPhisical: begin SetSQLToFIBQuery(Query_Select, ' select count(id) from katalog '+ ' where (parent_id = '''+IntTostr(AID)+''')'); Result := Query_Select.FN('count').AsInteger; Query_Select.Close; end; qmMemory: {if FMemBaseActive then begin if SetFilterToSQLMemTable(tSQL_Katalog, '(id = '''+IntTostr(AID)+''') and (id_item_type = '''+IntToStr(AItemType)+''')') then begin tSQL_Katalog.First; tSQL_Katalog.Last; Result := tSQL_Katalog.RecordCount; end; end;} end; end; function TDM.GetCatalogItemsCntByIDFromList(AIDCatalog: Integer): Integer; var i: Integer; begin Result := 0; for i := 0 to FCatParentIDs.Count - 1 do begin if FCatParentIDs[i] = AIDCatalog then Inc(Result); end; end; function TDM.GetCatalogMaxMarkID(AItemType, AProjectID: Integer; AMode: TQueryMode): Integer; var strProjID: String; MaxMarkID: Integer; QSelect: TSCSQuery; SCSCatalog: TSCSCatalog; i: Integer; begin Result := 0; MaxMarkID := 0; strProjID := ''; //if AProjectID <> -1 then // strProjID := '(project_id = '''+IntTOStr(AProjectID)+''') and '; case AMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := AMode; SetSQLToQuery(QSelect, ' select Max(Mark_ID) As max_mark_id from katalog '+ ' where '+strProjID+ ' (id_item_type = '''+IntToStr(AItemType)+''')'); Result := QSelect.GetFNAsInteger('max_mark_id'); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: with TF_Main(GForm) do if GSCSBase.CurrProject.Active then begin for i := 0 to GSCSBase.CurrProject.ChildCatalogReferences.Count - 1 do begin SCSCatalog := GSCSBase.CurrProject.ChildCatalogReferences[i]; if Assigned(SCSCatalog) then if SCSCatalog.ItemType = AItemType then if SCSCatalog.MarkID > MaxMarkID then MaxMarkID := SCSCatalog.MarkID; end; Result := MaxMarkID; end; {if FMemBaseActive then if SetFilterToSQLMemTable(tSQL_Katalog, strProjID+' (id_item_type = '''+IntToStr(AItemType)+''')') then begin tSQL_Katalog.First; MaxMarkID := tSQL_Katalog.FieldByName('mark_id').AsInteger; while Not tSQL_Katalog.Eof do begin if tSQL_Katalog.FieldByName('mark_id').AsInteger > MaxMarkID then MaxMarkID := tSQL_Katalog.FieldByName('mark_id').AsInteger; tSQL_Katalog.Next; end; Result := MaxMarkID; end;} end; end; function TDM.GetCatalogMaxFieldValueByFilter(AFieldName, AFilter: String; AMode: TQueryMode): Integer; var QSelect: TSCSQuery; begin Result := 0; case AMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := qmPhisical; SetSQLToQuery(QSelect, 'select MAX('+AFieldName+') from katalog where '+AFilter); Result := QSelect.GetFNAsInteger(fnMax); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: begin //if SetFilterToSQLMemTable(tSQL_Katalog, AFilter) then // Result := GetMaxRecValueFromSQLMemTable(tSQL_Katalog, AFieldName); end; end; end; function TDM.GetCatalogFieldValueAsInteger(AID: Integer; AFieldBy, AFieldName: String; AQueryMode: TQueryMode): Integer; var strWhere: String; QSelect: TSCSQuery; begin Result := 0; strWhere := AFieldBy +'='+IntTostr(AID); case AQueryMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := AQueryMode; SetSQLToQuery(QSelect, ' select '+AFieldName+' from katalog where '+strWhere); Result := QSelect.GetFNAsInteger(AFieldName); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: if FMemBaseActive then begin //tSQL_Katalog.Filtered := false; //if tSQL_Katalog.Locate(AFieldBy, AID, []) then // Result := tSQL_Katalog.FieldByName(AFieldName).AsInteger; //if SetFilterToSQLMemTable(tSQL_Katalog, strWhere) then // if Not tSQL_Katalog.Eof then // Result := tSQL_Katalog.FieldByName(AFieldName).AsInteger; end; end; end; function TDM.GetCatalogFieldValueAsIntegerByFilter(AFiledName, AFilter: String; AQueryMode: TQueryMode): Integer; var QSelect: TSCSQuery; begin Result := 0; case AQueryMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := AQueryMode; SetSQLToQuery(QSelect, ' select '+AFiledName+' where '+AFilter); Result := QSelect.GetFNAsInteger(AFiledName); QSelect.Close; FreeAndNil(QSelect); end; qmMemory: if FMemBaseActive then begin //if SetFilterToSQLMemTable(tSQL_Katalog, AFilter) then // if Not tSQL_Katalog.Eof then // Result := tSQL_Katalog.FieldByName(AFiledName).AsInteger; end; end; end; (* // ##### Вернет ID "SCS объекта (папки)" по IDFigure ##### function TDM.GetIDCatalogByIDFigure(AIDFigure: Integer): Integer; var QueryMode: TQueryMode; begin Result := 0; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); Result := GetCatalogFieldValueAsInteger(AIDFigure, fnSCSID, fnID, QueryMode); {SetSQLToQuery(scsQ, ' SELECT ID FROM KATALOG '+ ' WHERE (SCS_ID = '''+ IntToStr(AIDFigure) +''') AND '+ ' ((ID_ITEM_TYPE = '''+ IntToStr(itSCSConnector) +''') '+ ' OR (ID_ITEM_TYPE = '''+ IntToStr(itSCSLine) +''') ) ' ); Result := scsQ.GetFNAsInteger('ID'); } { SetFilterToSQLMemTable(tSQL_Katalog, 'SCS_ID = '''+ IntToStr(AIDFigure) +''''); if Not tSQL_Katalog.Eof then Result := tSQL_Katalog.FieldByName(fnID).AsInteger;} //Result := AIDFigure; end; *) (* // ##### Вернет ID "Листа (папки)" по IDList ##### function TDM.GetIDCatalogByIDList(AIDList: Integer): Integer; begin Result := 0; //SetSQLToQuery(scsQ, ' SELECT ID FROM KATALOG '+ // ' WHERE (SCS_ID = '''+ IntToStr(AIDList) +''') AND '+ // ' (ID_ITEM_TYPE = '''+ IntToStr(itList) +''') ' // ); //Result := scsQ.GetFNAsInteger('ID'); if SetFilterToSQLMemTable(tSQL_Katalog, '(SCS_ID = '''+IntToStr(AIDList)+''') and (id_item_Type = '''+IntToStr(itList)+''')') then if Not tSQL_Katalog.Eof then Result := tSQL_Katalog.FieldByName(fnID).AsInteger; //Result := AIDList; end; *) (* function TDM.GetIDCatalogBySCSID(ASCSID: Integer): Integer; var QueryMode: TQueryMode; begin Result := 0; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); Result := GetCatalogFieldValueAsInteger(ASCSID, fnSCSID, fnID, QueryMode); //SetSQLToQuery(scsQ, ' SELECT ID FROM KATALOG '+ // ' WHERE SCS_ID = '''+ IntToStr(ASCSID) +''' '); //Result := scsQ.GetFNAsInteger('SCS_ID'); { SetFilterToSQLMemTable(tSQL_Katalog, 'SCS_ID = '''+IntToStr(ASCSID)+''''); if Not tSQL_Katalog.Eof then Result := tSQL_Katalog.FieldByName(fnID).AsInteger; } //Result := ASCSID; end; *) (* function TDM.GetIDListByIDCatalog(AIDCatalog: Integer): Integer; begin Result := 0; //SetSQLToQuery(scsQ, ' SELECT SCS_ID FROM KATALOG '+ // ' WHERE (ID = '''+ IntToStr(AIDCatalog) +''') AND '+ // ' (ID_ITEM_TYPE = '''+ IntToStr(itList) +''') ' // ); //Result := scsQ.GetFNAsInteger('SCS_ID'); if SetFilterToSQLMemTable(tSQL_Katalog, '(ID = '''+IntToStr(AIDCatalog)+''') and (id_item_type = '''+IntToStr(itList)+''')') then if Not tSQL_Katalog.Eof then Result := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; end;*) (* function TDM.GetScsIDByIDCatalog(AIDCatalog: Integer): Integer; begin Result := 0; //SetSQLToQuery(scsQ, ' SELECT SCS_ID FROM KATALOG '+ // ' WHERE ID = '''+ IntToStr(AIDCatalog) +''' '); //Result := scsQ.GetFNAsInteger('SCS_ID'); if SetFilterToSQLMemTable(tSQL_Katalog, 'ID = '''+IntToStr(AIDCatalog)+'''') then if Not tSQL_Katalog.Eof then Result := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; end; *) function TDM.CheckProjectInUse(AIDProject: Integer; var AUserName: String; var AUserDateTime: TDateTime): Boolean; var UserDate: TDate; UserTime: TTime; CurrDateTime: TDateTime; DeltaTime: TDateTime; ProjSetting: TProjectSettingRecord; begin Result := false; ProjSetting := GetProjectSettings(AIDProject); Query_Select.Close; Query_Select.SQL.Text := 'select '+fnUserDate+', '+fnUserTime+', '+fnUserName+' '+ 'from katalog '+ 'where id = '''+IntToStr(AIDProject)+''''; Query_Select.ExecQuery; UserDate := Query_Select.FN(fnUserDate).AsDate; UserTime := Query_Select.FN(fnUserTime).AsTime; AUserName := Query_Select.FN(fnUserName).AsString; Query_Select.Close; if AUserName <> GetComputerNetName then begin AUserDateTime := UserDate + UserTime; CurrDateTime := GetPMNow; DeltaTime := Abs(CurrDateTime - AUserDateTime); if Trunc(DeltaTime) = 0 then //*** Даты одинаковы if (HourOf(DeltaTime)*60 + MinuteOf(DeltaTime)) <= ProjSetting.AutoSaveDateTimeMinutes then Result := true; end; end; function TDM.GetAllProjectIDs: TIntList; begin Result := TIntList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalog, fnIDItemType+' = '''+IntToStr(itProject)+'''', nil, fnID)); IntFIBFieldToIntList(Result, Query_Select, fnID); end; function TDM.GetProjectSettings(AID: Integer): TProjectSettingRecord; var SettingsStream: TStream; StreamSize: Integer; begin Result := GetDefaultProjectSettings; try StreamSize := 0; SetSQLToFIBQuery(Query_Select, ' select settings from katalog '+ ' where (id = '''+IntToStr(AID)+''') and (id_item_type = '''+IntToStr(itProject)+''') '); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; Query_Select.FN(fnSettings).SaveToStream(SettingsStream); Query_Select.Close; StreamSize := SettingsStream.Size; SettingsStream.Position := 0; if StreamSize <= sizeof(TProjectSettingRecord) then SettingsStream.ReadBuffer(Result, StreamSize); FreeAndNil(SettingsStream); except on E: Exception do AddExceptionToLog('TSCSProject.GetProjectSettings: '+E.Message); end; end; procedure TDM.GetProjectsInUseInfo(AProjectNames, AUserNames: TStringList); var ProjIDs: TIntList; i: Integer; ProjName: String; ProjNameIndex: Integer; IsIndexWithName: string; UserName: String; UserDateTime: TDateTime; FieldNames: TStringList; begin AProjectNames.Clear; AUserNames.Clear; ProjIDs := GetAllProjectIDs; if ProjIDs.Count > 0 then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnMarkID); FieldNames.Add(fnIsIndexWithName); for i := 0 to ProjIDs.Count - 1 do if CheckProjectInUse(ProjIDs[i], UserName, UserDateTime) then begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalog, fnID+' = '''+IntToStr(ProjIDs[i])+'''', FieldNames, '')); if Query_Select.RecordCount > 0 then begin ProjName := Query_Select.FN(fnName).AsString; if Query_Select.FN(fnIsIndexWithName).AsInteger = biTrue then ProjName := ProjName + ' ' + IntToStr(Query_Select.FN(fnMarkID).AsInteger); AProjectNames.Add(ProjName); AUserNames.Add(UserName); end; end; FieldNames.Free; end; FreeAndNil(ProjIDs); end; function TDM.GetProjectsInUseInfoStr: String; var ProjectNames: TStringList; ProjUserNames: TStringList; i: integer; begin ProjectNames := TStringList.Create; ProjUserNames := TStringList.Create; try Result := ''; GetProjectsInUseInfo(ProjectNames, ProjUserNames); if ProjectNames.Count > 0 then begin Result := cMain_Msg137_1; for i := 0 to ProjectNames.Count - 1 do Result := Result + #10#13 + ' - "'+ ProjectNames[i] +'" '+ cMain_Msg137_2 +' '+ ProjUserNames[i]; end; except on E: Exception do AddExceptionToLogEx('TDM.GetProjectsInUseInfoStr', E.Message); end; // Tolik 22/05/2018 -- ProjectNames.free; ProjUserNames.free; // end; // ##### Вернет ID Каталога к которомку пренадлежит компонент ##### function TDM.GetIDCatalogByIDNoUppCompon(AIDComponent: Integer): Integer; var IDObject: Integer; IDUpperCompon: Integer; begin Result := -1; try IDUpperCompon := GetIDUpperComponByIDChild(AIDComponent); Result := GetCatRelFieldValueAsIntByFilter(fnIDCatalog, 'id_component = '''+IntToStr(IDUpperCompon)+''''); //SetSQLToQuery(scsQSelect, ' select id_catalog from catalog_relation '+ // ' where id_component = '''+IntToStr(IDUpperCompon)+''' '); //Result := scsQSelect.GetFNAsInteger('ID_Catalog'); except on E: Exception do AddExceptionToLog('TDM.GetIDCatalogByIDNoUppCompon: '+E.Message); end; end; function TDM.GetCatalogIDItemType(AIDCatalog: Integer; AQueryMode: TQueryMode): Integer; begin Result := -1; try Result := GetCatalogFieldValueAsInteger(AIDCatalog, fnID, fnIDItemType, AQueryMode); //SetSQLToQuery(scsQSelect, ' select id_item_type from katalog where id = '''+IntTostr(AIDCatalog)+''' '); //Result := scsQSelect.GetFNAsInteger('id_item_type'); except on E: Exception do AddExceptionToLog('TDM.GetCatalogIDItemType: '+E.Message); end; end; // ##### Вернет ID объекта в которой находится компонент (в том числе компл-я) ##### function TDM.GetCatalogByCompon(AIDComponent: Integer): TCatalog; var IDCurrCompon: Integer; //IDParentCompon: integer; //IDCurrCatalog: Integer; //IDParentCatalog: integer; //HaveParent: Boolean; IDCatalog: Integer; ResCatalog: TCatalog; QueryMode: TQueryMode; begin ResCatalog.ID := 0; Result := ResCatalog; IDCurrCompon := 0; QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); IDCurrCompon := GetIDUpperComponByIDChild(AIDComponent); if IDCurrCompon <> 0 then begin IDCatalog := 0; case QueryMode of qmPhisical: begin SetSQLToQuery(scsQSelect, ' select id_catalog from catalog_relation '+ ' where (id_component = '''+IntToStr(IDCurrCompon)+''' ) and (id_catalog in (select id from katalog)) '); IDCatalog := scsQSelect.GetFNAsInteger('id_catalog'); scsQSelect.Close; end; qmMemory: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, 'id_component = '''+IntTostr(IDCurrCompon)+'''') then // if Not tSQL_CatalogRelation.Eof then // IDCatalog := tSQL_CatalogRelation.FieldByName(fnIDCatalog).AsInteger; end; end; if IDCatalog > 0 then Result := GetCatalogByID(IDCatalog, QueryMode); end; end; function TDM.GetCatalogByItemType(AIDCatalog: Integer; ACatalogItemType: Integer): TCatalog; var //Catalog: TCatalog; IDCurrCatalog: Integer; IDParentCatalog: integer; HaveParent: Boolean; CurrCatalog: TCatalog; ResCatalog: TCatalog; QueryMode: TQueryMode; begin try QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); IDParentCatalog := AIDCatalog; HaveParent := true; while HaveParent do begin IDCurrCatalog := IDParentCatalog; CurrCatalog := GetCatalogByID(IDCurrCatalog, QueryMode); if CurrCatalog.ID > 0 then begin if CurrCatalog.ItemType = ACatalogItemType then begin ResCatalog := CurrCatalog; HaveParent := false; end else IDParentCatalog := CurrCatalog.Parent_ID; //scsQSelect.GetFNAsInteger('Parent_id'); end else HaveParent := false; end; { while HaveParent do begin IDCurrCatalog := IDParentCatalog; SetSQLToQuery(scsQSelect, ' select * from katalog '+ ' where id = '''+IntToStr(IDCurrCatalog)+''' '); if scsQSelect.GetFNAsInteger('ID') > 0 then begin if scsQSelect.GetFNAsInteger('ID_Item_Type') = ACatalogItemType then begin ResCatalog.ID := scsQSelect.GetFNAsInteger('id'); ResCatalog.Name := scsQSelect.GetFNAsString('Name'); ResCatalog.ItemType := scsQSelect.GetFNAsInteger('ID_Item_Type'); if TF_Main(GForm).GDBMode = bkProjectManager then begin ResCatalog.Project_ID := scsQSelect.GetFNAsInteger('Project_ID'); ResCatalog.NameShort := scsQSelect.GetFNAsString('Name_Short'); ResCatalog.NameMark := scsQSelect.GetFNAsString('Name_Mark'); ResCatalog.MarkID := scsQSelect.GetFNAsInteger('Mark_ID'); ResCatalog.IsUserName := scsQSelect.GetFNAsInteger('IsUSER_Name'); ResCatalog.Scs_ID := scsQSelect.GetFNAsInteger('scs_id'); end; Result := ResCatalog; scsQSelect.Close; HaveParent := false; end else IDParentCatalog := scsQSelect.GetFNAsInteger('Parent_id'); end else HaveParent := false; end; } except on E: Exception do AddExceptionToLog('GetCatalogByItemType: '+E.Message); end; end; function TDM.GetCatalogByComponAndItemType(AIDComponent: Integer; ACatalogItemType: Integer): TCatalog; var OwnerCompon: TCatalog; IDCurrCatalog: Integer; IDParentCatalog: integer; HaveParent: Boolean; ResCatalog: TCatalog; begin try OwnerCompon.ID := 0; OwnerCompon := GetCatalogByCompon(AIDComponent); Result := GetCatalogByItemType(OwnerCompon.ID, ACatalogItemType); {if OwnerCompon.ID <> 0 then begin IDParentCatalog := OwnerCompon.ID; HaveParent := true; while HaveParent do begin IDCurrCatalog := IDParentCatalog; SetSQLToQuery(scsQSelect, ' select * from katalog '+ ' where id = '''+IntToStr(IDCurrCatalog)+''' '); if scsQSelect.GetFNAsInteger('ID') > 0 then begin if scsQSelect.GetFNAsInteger('ID_Item_Type') = ACatalogItemType then begin ResCatalog.ID := scsQSelect.GetFNAsInteger('id'); ResCatalog.Name := scsQSelect.GetFNAsString('Name'); ResCatalog.ItemType := scsQSelect.GetFNAsInteger('ID_Item_Type'); if TF_Main(GForm).GDBMode = bkProjectManager then begin ResCatalog.Project_ID := scsQSelect.GetFNAsInteger('Project_ID'); ResCatalog.NameShort := scsQSelect.GetFNAsString('Name_Short'); ResCatalog.NameMark := scsQSelect.GetFNAsString('Name_Mark'); ResCatalog.MarkID := scsQSelect.GetFNAsInteger('Mark_ID'); ResCatalog.IsUserName := scsQSelect.GetFNAsInteger('IsUSER_Name'); ResCatalog.Scs_ID := scsQSelect.GetFNAsInteger('scs_id'); end; Result := ResCatalog; scsQSelect.Close; HaveParent := false; end else IDParentCatalog := scsQSelect.GetFNAsInteger('Parent_id'); end else HaveParent := false; end; end; } except on E: Exception do AddExceptionToLog('GetCatalogByComponAndItemType: '+E.Message); end; end; function TDM.GetCatalogByID(AIDCatalog: Integer; AQueryMode: TQueryMode): TCatalog; var ResCatalog: TCatalog; QSelect: TSCSQuery; strFilter: String; begin try strFilter := 'id = '''+IntTostr(AIDCatalog)+''''; case AQueryMode of qmPhisical: begin QSelect := TSCSQuery.Create(GForm, Query_Select, qSQL_QuerySelect); QSelect.QueryMode := qmPhisical; SetSQLToQuery(QSelect, 'select * from katalog where '+strFilter); ResCatalog.ID := QSelect.GetFNAsInteger('ID'); ResCatalog.Parent_ID := QSelect.GetFNAsInteger('Parent_ID'); ResCatalog.Name := QSelect.GetFNAsString('Name'); ResCatalog.Sort_ID := QSelect.GetFNAsInteger('Sort_ID'); ResCatalog.Kol_Compon := QSelect.GetFNAsInteger('Kol_Compon'); ResCatalog.ItemsCount := QSelect.GetFNAsInteger('items_count'); if TF_Main(GForm).GDBMode = bkProjectManager then begin //ResCatalog.Project_ID := QSelect.GetFNAsInteger('Project_ID'); ResCatalog.List_ID := QSelect.GetFNAsInteger('List_ID'); ResCatalog.NameShort := QSelect.GetFNAsString('Name_Short'); ResCatalog.NameMark := QSelect.GetFNAsString('Name_Mark'); ResCatalog.MarkID := QSelect.GetFNAsInteger('Mark_ID'); ResCatalog.IsUserName := QSelect.GetFNAsInteger('IsUSER_Name'); ResCatalog.Scs_ID := QSelect.GetFNAsInteger('SCS_ID'); ResCatalog.ItemType := QSelect.GetFNAsInteger('ID_Item_Type'); ResCatalog.IndexPointObj := QSelect.GetFNAsInteger('Index_Conn'); ResCatalog.IndexConnector := QSelect.GetFNAsInteger('Index_Joiner'); ResCatalog.IndexLine := QSelect.GetFNAsInteger('Index_Line'); end; QSelect.Close; FreeAndNil(QSelect); end; qmMemory: begin {if SetFilterToSQLMemTable(tSQL_Katalog, strFilter) then if Not tSQL_Katalog.Eof then begin ResCatalog.ID := tSQL_Katalog.FieldByName('ID').AsInteger; ResCatalog.Parent_ID := tSQL_Katalog.FieldByName('Parent_ID').AsInteger; ResCatalog.Name := tSQL_Katalog.FieldByName('Name').AsString; ResCatalog.Sort_ID := tSQL_Katalog.FieldByName('Sort_ID').AsInteger; ResCatalog.Kol_Compon := tSQL_Katalog.FieldByName('Kol_Compon').AsInteger; ResCatalog.ItemsCount := tSQL_Katalog.FieldByName('items_count').AsInteger; if TF_Main(GForm).GDBMode = bkProjectManager then begin //ResCatalog.Project_ID := tSQL_Katalog.FieldByName('Project_ID').AsInteger; ResCatalog.List_ID := tSQL_Katalog.FieldByName('List_ID').AsInteger; ResCatalog.NameShort := tSQL_Katalog.FieldByName('Name_Short').AsString; ResCatalog.NameMark := tSQL_Katalog.FieldByName('Name_Mark').AsString; ResCatalog.MarkID := tSQL_Katalog.FieldByName('Mark_ID').AsInteger; ResCatalog.IsUserName := tSQL_Katalog.FieldByName('IsUSER_Name').AsInteger; ResCatalog.Scs_ID := tSQL_Katalog.FieldByName('SCS_ID').AsInteger; ResCatalog.ItemType := tSQL_Katalog.FieldByName('ID_Item_Type').AsInteger; ResCatalog.IndexPointObj := tSQL_Katalog.FieldByName('Index_Conn').AsInteger; ResCatalog.IndexConnector := tSQL_Katalog.FieldByName('Index_Joiner').AsInteger; ResCatalog.IndexLine := tSQL_Katalog.FieldByName('Index_Line').AsInteger; end; end; } end; end; Result := ResCatalog; except on E:Exception do AddExceptionToLog('GetCatalogByID: '+E.Message); end; end; function TDM.GetParentCatalogIDByLevel(AIDCatalog, ALevel: Integer): Integer; begin Result := U_BaseCommon.GetParentCatalogIDByLevel(AIDCatalog, ALevel, Query_Select); end; function TDM.GetCatalogCurrencyByCurrencyID(AIDCatalog, AIDCurrency: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetCatalogCurrencyByCurrencyID(AIDCatalog, AIDCurrency, Query_Select); end; function TDM.GetCatalogCurrencyByMainFld(AIDCatalog, AMainValue: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetCatalogCurrencyByMainFld(AIDCatalog, AMainValue, Query_Select); end; procedure TDM.GetCatalogCurrencies(AIDCatalog: Integer; var ACurrencyM, ACurrencyS: TObjectCurrencyRel); var IDLevelCatalog: Integer; ptrObjectCurrencyM: PObjectCurrencyRel; ptrObjectCurrencyS: PObjectCurrencyRel; begin ZeroMemory(@ACurrencyM, SizeOf(TObjectCurrencyRel)); ZeroMemory(@ACurrencyS, SizeOf(TObjectCurrencyRel)); IDLevelCatalog := GetParentCatalogIDByLevel(AIDCatalog, dirCurrencyLevel); if IDLevelCatalog > 0 then begin ptrObjectCurrencyM := GetObjectCurrencyByMainFld(IDLevelCatalog, ctMain); if ptrObjectCurrencyM <> nil then begin ACurrencyM := ptrObjectCurrencyM^; ptrObjectCurrencyS := GetObjectCurrencyByMainFld(IDLevelCatalog, ctSecond); if ptrObjectCurrencyS <> nil then begin ACurrencyS := ptrObjectCurrencyS^; FreeMem(ptrObjectCurrencyS); end; FreeMem(ptrObjectCurrencyM); end; end; if ACurrencyM.ID = 0 then begin ACurrencyM.Data := TF_Main(GForm).GCurrencyM; ACurrencyM.IDCurrency := ACurrencyM.Data.ID; end; if ACurrencyS.ID = 0 then begin ACurrencyS.Data := TF_Main(GForm).GCurrencyS; ACurrencyS.IDCurrency := ACurrencyS.Data.ID; end; end; function TDM.GetCatalogOrComponCurrencyProperGlobalMainInNB(AIDCatalog, AIDComponent: Integer): TCurrency; var IDCatalog: Integer; ptrObjectCurrency: PObjectCurrencyRel; SprCurrency: TNBCurrency; begin ZeroMemory(@Result, SizeOf(TCurrency)); Result := TF_Main(GForm).FNormBase.GCurrencyM; if TF_Main(GForm).GDBMode = bkNormBase then begin IDCatalog := AIDCatalog; if IDCatalog = 0 then IDCatalog := GetComponCatalogOwnerID(AIDComponent); if IDCatalog <> 0 then begin ptrObjectCurrency := GetCatalogCurrencyByCurrencyID(IDCatalog, TF_Main(GForm).FNormBase.GCurrencyM.ID); if ptrObjectCurrency <> nil then begin Result := ptrObjectCurrency.Data; FreeMem(ptrObjectCurrency); end; end; end else if TF_Main(GForm).GDBMode = bkprojectManager then begin SprCurrency := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.GetCurrencyByGUID(TF_Main(GForm).FNormBase.GCurrencyM.GUID); if SprCurrency <> nil then Result := SprCurrency.Data; end; end; procedure TDM.DeleteCatalogRelation(AIDCatalog, AIDComponent: Integer); var strFilter: String; begin strFilter := '(id_catalog = '''+IntTostr(AIDCatalog)+''') and (id_component = '''+IntTostr(AIDComponent)+''')'; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'delete from catalog_relation where '+ strFilter); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, strFilter) then // if Not tSQL_CatalogRelation.Eof then // tSQL_CatalogRelation.Delete; end; end; end; function TDM.GetCatRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Select, ' select '+AFieldName+' from catalog_relation where '+AFilter); Result := Query_Select.Fields[0].AsInteger; //scsQSelect.GetFNAsInteger(AFieldName); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, AFilter) then // if Not tSQL_CatalogRelation.Eof then // Result := tSQL_CatalogRelation.FieldByName(AFieldName).AsInteger; end; end; end; procedure TDM.UpdateCatRelFieldAsIntegerByFilter(AValue: Integer; AFieldName, AFilter: String); begin case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update catalog_relation set '+AFieldName+' = '''+IntToStr(AValue)+''''+ ' where '+AFilter); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, AFilter) then //begin // tSQL_CatalogRelation.First; // while Not tSQL_CatalogRelation.Eof do // begin // tSQL_CatalogRelation.Edit; // tSQL_CatalogRelation.FieldByName(AFieldName).AsInteger := AValue; // tSQL_CatalogRelation.Post; // tSQL_CatalogRelation.Next; // end; //end; end; end; end; function TDM.GetCatRelCountByFilter(AFieldName, AFilter: String; ANoMoreOne: Boolean): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select count(id) from catalog_relation '+ ' where '+ AFilter); Result := scsQSelect.GetFNAsInteger(fnCount); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_CatalogRelation, AFilter) then // Result := GetRecCountFromSQLMemTable(tSQL_CatalogRelation, ANoMoreOne); end; end; end; function TDM.GetCatalogRelationFromMemTable: PCatalogRelation; begin GetMem(Result, SizeOf(TCatalogRelation)); try Result.IDCatalog := tSQL_CatalogRelation.Fields[fiCatRel_IDCatalog].AsInteger; Result.IDComponent := tSQL_CatalogRelation.Fields[fiCatRel_IDComponent].AsInteger; except on E: Exception do AddExceptionToLog('TDM.GetCatalogRelationFromMemTable: '+E.Message); end; end; procedure TDM.SaveCatalogRelation(AMakeEdit: TmakeEdit; AIDCatalog, AIDComponent: Integer); begin try if AMakeEdit = meMake then tSQL_CatalogRelation.Append; if tSQL_CatalogRelation.State <> dsBrowse then begin tSQL_CatalogRelation.Fields[fiCatRel_IDCatalog].AsInteger := AIDCatalog; tSQL_CatalogRelation.Fields[fiCatRel_IDComponent].AsInteger := AIDComponent; tSQL_CatalogRelation.Post; { tSQL_CatalogRelation.FieldByName(fnIDCatalog).AsInteger := AIDCatalog; tSQL_CatalogRelation.FieldByName(fnIDComponent).AsInteger := AIDComponent; tSQL_CatalogRelation.Post; } end; except on E: Exception do AddExceptionToLog('TDM.SaveCatalogRelation: '+E.Message); end; end; procedure AssignOnePropertyBySysName(AToProperties, AFromProperties: TList; AFromNew: Boolean = false; aToIndex: integer = 0; aSysName: string = ''); var ptrProperty: PProperty; i: integer; begin if Not Assigned(AFromProperties) then Exit; ///// EXIT ///// New(ptrProperty); ZeroMemory(ptrProperty, SizeOf(TProperty)); for i := 0 to AFromProperties.Count - 1 do begin if PProperty(AFromProperties[i]).SysName = aSysName then begin if aToIndex <> -1 then begin if AToProperties[aToIndex] <> nil then Dispose(AToProperties[aToIndex]); end; ptrProperty^ := TProperty(AFromProperties[i]^); if AFromNew then ptrProperty.ID := ptrProperty.NewID; if aToIndex <> -1 then AToProperties[aToIndex] := ptrProperty else AToProperties.Add(ptrProperty); break; end; end; end; procedure TDM.ApplyComponentForDir(ASCSComponent: TSCSComponent; AIDDir: Integer; ARecursive: Boolean); var QueryMode: TQueryMode; i, j, k, propnum: Integer; ComponIDList: TIntList; ChildCatalogIDList: TIntList; ComponElementsToLoad: TCompDataFlags; ComponSuppliesKind: TSuppliesKind; DirComponents: TSCSComponents; CurrDirComponent: TSCSComponent; Interf: TSCSInterface; SavedID: Integer; SavedName: String; SavedNameShort: String; SavedArticulDistributor: String; SavedArticulProducer: String; SavedIzm: String; SavedCypher: String; SavedPriceSupply: Double; SavedPrice: Double; SavedHasNDS: Integer; SavedIDSuppliesKind: Integer; SavedSortID: Integer; Messg: String; ComponNode: TTreeNode; PropSysName: string; PropFound: boolean; NeedSaveInterfacesByServFields: Boolean; begin if TF_Main(GForm).GDBMode <> bkNormBase then Exit; ///// EXIT ///// Messg := ''; QueryMode := qmPhisical; SetSQLToQuery(scsQSelect, GetSQLByParams(qtSelect, tnCatalogRelation, fnIDCatalog+' = '''+IntToStr(AIDDir)+'''', nil, fnIDComponent)); ComponIDList := TIntList.Create; DirComponents := TSCSComponents.Create(true); CurrDirComponent := TSCSComponent.Create(GForm); try IntFieldToIntList(ComponIDList, scsQSelect, fnIDComponent); //*** Применить фильтр TF_Main(GForm).ApplyComponFilterToListIDs(ComponIDList); TF_Main(GForm).CreateFAddComponent; with TF_Main(GForm).F_AddComponent do begin //*** Определить параметры вида поставки компоненты ASCSComponent ComponSuppliesKind := GetSuppliesKindByID(ASCSComponent.IDSuppliesKind, ASCSComponent.GUIDSuppliesKind); //*** Определить загружаемые элементы компонент ComponElementsToLoad := []; if (ApplyComponElementsChecked[liPort] = biTrue) and (ApplyComponElementsChecked[liInterface] = biTrue) then ComponElementsToLoad := ComponElementsToLoad + [cdInterfaces]; if ApplyComponElementsChecked[liProperty] = biTrue then ComponElementsToLoad := ComponElementsToLoad + [cdProperties]; //if FApplyComponElementsChecked[liComplects] = biTrue then // ComponElementsToLoad := ComponElementsToLoad + []; if ApplyComponElementsChecked[liCableCanalConnectors] = biTrue then ComponElementsToLoad := ComponElementsToLoad + [cdCableCanalConnectors]; if cbApplyComponentType.Checked then ComponElementsToLoad := ComponElementsToLoad + [cdComponentType]; if cbApplyNorms.Checked then ComponElementsToLoad := ComponElementsToLoad + [cdNorms]; if cbApplyResources.Checked then ComponElementsToLoad := ComponElementsToLoad + [cdResources]; if cdInterfaces in ComponElementsToLoad then ComponElementsToLoad := ComponElementsToLoad + [cdProperties]; if cdProperties in ComponElementsToLoad then ComponElementsToLoad := ComponElementsToLoad + [cdInterfaces]; //*** загрузить компоненты в список for i := 0 to ComponIDList.Count - 1 do if ComponIDList[i] <> ASCSComponent.ID then begin CurrDirComponent.Clear; CurrDirComponent.LoadComponentByID(ComponIDList[i], false); {CurrDirComponent.LoadComponentData([ cdCableCanalConnectors, //cdConections, //cdCrossConnections, cdProperties, cdInterfaces, cdComponentType, cdNorms, cdResources]);} //*** Не забыть про тип компоненты if Not (cdComponentType in ComponElementsToLoad) then CurrDirComponent.LoadComponentType; //*** и все остальное CurrDirComponent.LoadComponentData(ComponElementsToLoad); ComponNode := TF_Main(GForm).FindTreeNodeByDat(CurrDirComponent.ID, [CurrDirComponent.GetItemType]); {SavedID := CurrDirComponent.ID; SavedName := CurrDirComponent.Name; SavedNameShort := CurrDirComponent.NameShort; SavedArticulDistributor := CurrDirComponent.ArticulDistributor; SavedArticulProducer := CurrDirComponent.ArticulProducer; SavedIzm := CurrDirComponent.Izm; SavedCypher := CurrDirComponent.Cypher; SavedPriceSupply := CurrDirComponent.PriceSupply; SavedPrice := CurrDirComponent.Price; SavedHasNDS := CurrDirComponent.HASNDS; //Saved SavedSortID := CurrDirComponent.SortID; CurrDirComponent.AssignOnlyComponent(ASCSComponent); CurrDirComponent.ID := SavedID; CurrDirComponent.Name := SavedName; CurrDirComponent.NameShort := SavedNameShort; CurrDirComponent.ArticulDistributor := SavedArticulDistributor; CurrDirComponent.ArticulProducer := SavedArticulProducer; CurrDirComponent.Izm := SavedIzm; CurrDirComponent.Cypher := SavedCypher; CurrDirComponent.Price := SavedPrice; CurrDirComponent.HASNDS := SavedHasNDS; CurrDirComponent.SortID := SavedSortID; } //*** Загрузка полей SavedID := CurrDirComponent.ID; SavedSortID := CurrDirComponent.SortID; if cbApplyName.Checked then CurrDirComponent.Name := ASCSComponent.Name; if cbApplyNameShort.Checked then CurrDirComponent.NameShort := ASCSComponent.NameShort; if cbApplyArticulProducer.Checked then CurrDirComponent.ArticulProducer := ASCSComponent.ArticulProducer; if cbApplyArticulDistributor.Checked then CurrDirComponent.ArticulDistributor := ASCSComponent.ArticulDistributor; if cbApplyIzm.Checked then CurrDirComponent.Izm := ASCSComponent.Izm; if cbApplyUserLength.Checked then CurrDirComponent.UserLength := ASCSComponent.UserLength; if cbApplyComponentType.Checked then begin CurrDirComponent.ID_ComponentType := ASCSComponent.ID_ComponentType; CurrDirComponent.GUIDComponentType := ASCSComponent.GUIDComponentType; CurrDirComponent.ComponentType := ASCSComponent.ComponentType; CurrDirComponent.IsLine := ASCSComponent.IsLine; end; if cbApplyNetType.Checked then CurrDirComponent.IDNetType := ASCSComponent.IDNetType; if cbApplyProducer.Checked then CurrDirComponent.ID_Producer := ASCSComponent.ID_Producer; if cbApplyIsMarkInCaptions.Checked then CurrDirComponent.IsMarkInCaptions := ASCSComponent.IsMarkInCaptions; if cbApplyNotice.Checked then CurrDirComponent.Notice := ASCSComponent.Notice; if cbApplyCanComplect.Checked then CurrDirComponent.ISComplect := ASCSComponent.ISComplect; if cbApplyPrice.Checked then begin CurrDirComponent.IDSuppliesKind := ASCSComponent.IDSuppliesKind; CurrDirComponent.PriceSupply := ASCSComponent.PriceSupply; CurrDirComponent.Price_Calc := CurrDirComponent.Price_Calc - CurrDirComponent.Price + ASCSComponent.Price; CurrDirComponent.Price := ASCSComponent.Price; CurrDirComponent.HasNDS := ASCSComponent.HasNDS; //*** корректировать единицу измерения if ComponSuppliesKind.ID > 0 then CurrDirComponent.Izm := ComponSuppliesKind.Izm; end; if cbApplyImage.Checked then CurrDirComponent.AssignPicture(ASCSComponent.Picture); if cbApplySpecification.Checked then CurrDirComponent.IDCompSpecification := ASCSComponent.IDCompSpecification; if cbApplyComponIcon.Checked then CurrDirComponent.IDObjectIcon := ASCSComponent.IDObjectIcon; if cbApplySymbol.Checked then CurrDirComponent.IDSymbol := ASCSComponent.IDSymbol; if cbApplyDescription.Checked then CurrDirComponent.AssignDescription(ASCSComponent.Description); CurrDirComponent.ID := SavedID; CurrDirComponent.SortID := SavedSortID; CurrDirComponent.SaveComponent; if Assigned(ComponNode) then begin PObjectData(ComponNode.Data).ItemType := CurrDirComponent.GetItemType; TF_Main(GForm).SetNodeState(ComponNode, PObjectData(ComponNode.Data).ItemType, ekNone, CurrDirComponent); end; // ---- Элементы кабельных каналов ----- if (ApplyComponElementsChecked[liCableCanalConnectors] = biTrue) and (ASCSComponent.ComponentType.SysName = ctsnCableChannel) and (CurrDirComponent.ComponentType.SysName = ctsnCableChannel) then begin //*** Удаление старых for j := 0 to CurrDirComponent.CableCanalConnectors.Count - 1 do DeleteRecordFromTableByID(tnCableCanalConnectors, PCableCanalConnector(CurrDirComponent.CableCanalConnectors[j]).ID, QueryMode); //*** Добавление новых CurrDirComponent.AssignCableCanalConnectors(ASCSComponent.CableCanalConnectors); for j := 0 to CurrDirComponent.CableCanalConnectors.Count - 1 do PCableCanalConnector(CurrDirComponent.CableCanalConnectors[j]).IsNew := true; CurrDirComponent.SaveCableCanalConnectorsByServFields; end; // ---- Свойства ---- if ApplyComponElementsChecked[liProperty] = biTrue then begin if cbApplyForFocusedProp.Checked then begin try PropSysName := ''; PropFound := False; if GT_Property.DataController.FocusedRecordIndex >= 0 then begin PropSysName := GT_Property.ViewData.Records[GT_Property.DataController.FocusedRecordIndex].Values[GT_Property.GetColumnByFieldName('SYSNAME').Index]; end; if PropSysName <> '' then begin for j := 0 to CurrDirComponent.Properties.Count - 1 do begin if PProperty(CurrDirComponent.Properties[j]).SysName = PropSysName then begin PropFound := True; DeleteRecordFromTableByID(tnCompPropRelation, PProperty(CurrDirComponent.Properties[j]).ID, QueryMode); AssignOnePropertyBySysName(CurrDirComponent.Properties, ASCSComponent.Properties, False, j, PropSysName); PProperty(CurrDirComponent.Properties[j]).IsNew := true; break; end; end; if Not PropFound then begin AssignOnePropertyBySysName(CurrDirComponent.Properties, ASCSComponent.Properties, False, -1, PropSysName); PProperty(CurrDirComponent.Properties[CurrDirComponent.Properties.Count - 1]).IsNew := true; end; end; except end; end else begin //*** Удаление старых for j := 0 to CurrDirComponent.Properties.Count - 1 do DeleteRecordFromTableByID(tnCompPropRelation, PProperty(CurrDirComponent.Properties[j]).ID, QueryMode); //*** Добавление новых CurrDirComponent.AssignProperties(ASCSComponent.Properties); for j := 0 to CurrDirComponent.Properties.Count - 1 do PProperty(CurrDirComponent.Properties[j]).IsNew := true; end; CurrDirComponent.SavePropertiesByServFields(CurrDirComponent.ID); end; NeedSaveInterfacesByServFields := False; // ---- Интерфейсы ---- if (ApplyComponElementsChecked[liPort] = biTrue) and (ApplyComponElementsChecked[liInterface] = biTrue) then begin //*** Удаление старых for j := 0 to CurrDirComponent.Interfaces.Count - 1 do begin Interf := CurrDirComponent.Interfaces[j]; if CheckInterfIsUse(GForm, CurrDirComponent.ID, Interf.ID, Interf.NumPair) then begin if GUseVisibleInterfaces then Messg := Messg + '- '+cDM_Msg3_1+' "'+Interf.LoadName+'" '+cDM_Msg3_2+' "'+ CurrDirComponent.Name+'" '+cDM_Msg3_3+';'+#10+#13 end else DeleteRecordFromTableByID(tnInterfaceRelation, Interf.ID, QueryMode); end; //*** Добавление новых CurrDirComponent.AssignInterfaces(ASCSComponent.Interfaces, true, false); for j := 0 to CurrDirComponent.Interfaces.Count - 1 do begin Interf := CurrDirComponent.Interfaces[j]; Interf.IOfIRelOut.Clear; // никаких соединений Interf.IsBusy := biFalse; Interf.IsNew := true; for k := 0 to Interf.PortInterfRels.Count - 1 do PPortInterfRel(Interf.PortInterfRels[k]).IsNew := true; end; NeedSaveInterfacesByServFields := True; //CurrDirComponent.SaveInterfacesByServFields; end; if ((ApplyComponElementsChecked[liPort] = biTrue) and (ApplyComponElementsChecked[liInterface] = biTrue)) or (ApplyComponElementsChecked[liProperty] = biTrue) then begin if GUseLiteFunctional then begin try if TF_Main(GForm).GDBMode = bkNormBase then begin for propnum := 0 to CurrDirComponent.Properties.Count - 1 do TF_Main(GForm).ReDefineConstrInterfacesByProperty(CurrDirComponent, PProperty(CurrDirComponent.Properties[propnum]), cbAutoAddInter.Checked); NeedSaveInterfacesByServFields := True; //CurrDirComponent.SaveInterfacesByServFields; end; except end; end; end; if NeedSaveInterfacesByServFields then CurrDirComponent.SaveInterfacesByServFields; //--- Нормы и ресурсы if cbApplyNorms.Checked then begin //*** Удаление старых for j := 0 to CurrDirComponent.NormsResources.Norms.Count - 1 do DeleteRecordFromTableByID(tnNorms, CurrDirComponent.NormsResources.Norms[j].ID, QueryMode); //#Ресурсы нах...# for j := 0 to CurrDirComponent.NormsResources.Resources.Count - 1 do // DeleteRecordFromTableByID(tnNormResourceRel, CurrDirComponent.NormsResources.Resources[j].ID, QueryMode); //*** Добавление новых //CurrDirComponent.AssignNormsResources(ASCSComponent.NormsResources); CurrDirComponent.NormsResources.AssignNorms(ASCSComponent.NormsResources.Norms); for j := 0 to CurrDirComponent.NormsResources.Norms.Count - 1 do begin CurrDirComponent.NormsResources.Norms[j].IsNew := true; for k := 0 to CurrDirComponent.NormsResources.Norms[j].Resources.Count - 1 do CurrDirComponent.NormsResources.Norms[j].Resources[k].IsNew := true; end; //#Ресурсы нах...# for j := 0 to CurrDirComponent.NormsResources.Resources.Count - 1 do // CurrDirComponent.NormsResources.Resources[j].IsNew := true; CurrDirComponent.NormsResources.SaveByServiceFields(CurrDirComponent.ID); end; if cbApplyResources.Checked then begin //*** Удаление старых for j := 0 to CurrDirComponent.NormsResources.Resources.Count - 1 do DeleteRecordFromTableByID(tnResources, CurrDirComponent.NormsResources.Resources[j].ID, QueryMode); //*** Добавление новых CurrDirComponent.NormsResources.AssignResources(ASCSComponent.NormsResources.Resources); for j := 0 to CurrDirComponent.NormsResources.Resources.Count - 1 do CurrDirComponent.NormsResources.Resources[j].IsNew := true; CurrDirComponent.NormsResources.SaveByServiceFields(CurrDirComponent.ID); end; ComponNode := TF_Main(GForm).FindTreeNodeByDat(CurrDirComponent.ID, [CurrDirComponent.GetItemType]); if ComponNode <> nil then ComponNode.Text := TF_Main(GForm).GetNameNode( ComponNode, CurrDirComponent, true, true); end; end; finally CurrDirComponent.Free; DirComponents.Free; ComponIDList.Free; end; if ARecursive then begin ChildCatalogIDList := GetCatalogChildsID(AIDDir, nil, qmPhisical); if Assigned(ChildCatalogIDList) then begin for i := 0 to ChildCatalogIDList.Count - 1 do ApplyComponentForDir(ASCSComponent, ChildCatalogIDList[i], ARecursive); FreeAndNil(ChildCatalogIDList); end; end; end; procedure TDM.UpdateComponFieldAsInteger(AID, AValue: Integer; AFieldName: String); var strWhere: String; begin strWhere := 'id = '''+IntToStr(AID)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update component set '+AFieldName+' = '+IntToStr(AValue)+ ' where '+ strWhere); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Component, strWhere) then //if Not tSQL_Component.Eof then {tSQL_Component.Filtered := false; if tSQL_Component.Locate(fnID, AID, []) then begin tSQL_Component.Edit; tSQL_Component.FieldByName(AFieldName).AsInteger := AValue; tSQL_Component.Post; end;} end; end; end; procedure TDM.UpdateComponFieldAsFloat(AID: Integer; AValue: Double; AFieldName: String); var strWhere: String; begin strWhere := 'id = '''+IntToStr(AID)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnComponent, strWhere, nil, AFieldName), false); Query_Operat.Params[0].AsFloat := AValue; Query_Operat.ExecQuery; Query_Operat.Close; //ChangeSQLQuery(scsQOperat, ' update component set '+AFieldName+' = :FieldValue where '+ strWhere); //scsQOperat.SetParamAsFloat('FieldValue', AValue); //scsQOperat.ExecQuery; //scsQOperat.Close; end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_Component, strWhere) then if Not tSQL_Component.Eof then begin tSQL_Component.Edit; tSQL_Component.FieldByName(AFieldName).AsFloat := AValue; tSQL_Component.Post; end;} end; end; end; procedure TDM.UpdateComponFieldAsIntegerByField(AByValue, AValue: Integer; AByFieldName, AUpdFieldName: String); var strWhere: String; i: Integer; begin strWhere := AByFieldName + ' = '''+IntToStr(AByValue)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update component set '+AUpdFieldName+' = '+IntToStr(AValue)+ ' where '+ strWhere); scsQOperat.Close; end; bkProjectManager: begin {SetFilterToSQLMemTable(tSQL_Component, strWhere); //tSQL_Component.First; for i := 0 to tSQL_Component.RecordCount - 1 do begin tSQL_Component.RecNo := i+1; tSQL_Component.Edit; tSQL_Component.FieldByName(AUpdFieldName).AsInteger := AValue; tSQL_Component.Post; //tSQL_Component.Next; end;} end; end; end; procedure TDM.UpdateComponFieldAsString(AIDCompon: Integer; AValue, AFieldName: String); var strWhere: String; begin strWhere := 'id = '''+IntToStr(AIDCompon)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update component set '+AFieldName+' = '+AValue+ ' where '+ strWhere); scsQOperat.Close; end; bkProjectManager: begin tSQL_Component.Filtered := false; if tSQL_Component.Locate(fnID, AFieldName, []) then begin tSQL_Component.Edit; tSQL_Component.FieldByName(AFieldName).AsString := AValue; tSQL_Component.Post; end; {if SetFilterToSQLMemTable(tSQL_Component, strWhere) then if Not tSQL_Component.Eof then begin tSQL_Component.Edit; tSQL_Component.FieldByName(AFieldName).AsString := AValue; tSQL_Component.Post; strWhere := strWhere; end;} end; end; strWhere := strWhere; end; function TDM.CheckNBComponentCypher(ACypher: String; ANoIncludingID: Integer): Boolean; begin Result := true; if TF_Main(GForm).GDBMode = bkNormBase then begin Result := Not CheckStrValueInTable(tnComponent, fnCypher, ACypher, ANoIncludingID, Query_Select); //SetSQLToQuery(scsQSelect, 'select count(id) from component '+ // 'where (cypher = '''+ACypher+''') and '+ // ' Not(id = '''+IntToStr(ANoIncludingID)+''')'); //if scsQSelect.GetFNAsInteger(fnCount) > 0 then // Result := false; end; end; function TDM.GetComponIDByArtProducer(AArtProducer: String; ADisabledComponID: Integer): integer; begin Result := 0; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, 'UPPER('+fnArticulProducer+') = :'+fnArticulProducer, nil, fnID), false); Query_Select.Params[0].AsString := AnsiUpperCase(AArtProducer); Query_Select.ExecQuery; if Query_Select.RecordCount > 0 then while Not Query_Select.Eof do begin if Query_Select.Fields[0].AsInteger <> ADisabledComponID then begin Result := Query_Select.Fields[0].AsInteger; Break; //// BREAK //// end; Query_Select.Next; end; end; function TDM.GetComponIDByIsLine(AIsLine: Integer): Integer; begin Result := GetIntFromTable(tnComponent, fnID, fnIsLine, AIsLine, qmPhisical); end; function TDM.GetComponsIDNameByType(AComponentTypeSysName: String): TIDStringList; var i: Integer; IDComponentTypes: TIntList; FieldNames: TStringList; begin Result := nil; if TF_Main(GForm).GDBMode = bkNormBase then begin Result := TIDStringList.Create; IDComponentTypes := TIntList.Create; FieldNames := TStringList.Create; FieldNames.Add(fnID); FieldNames.Add(fnName); try //*** Отобрать ID типы компонент по системному имени SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponentTypes, fnSysName+' = '''+AComponentTypeSysName+'''', FieldNames, '')); IntFIBFieldToIntList(IDComponentTypes, Query_Select, fnID); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, fnIDComponentType+' = :'+fnIDComponentType, FieldNames, ''), false); for i := 0 to IDComponentTypes.Count - 1 do begin Query_Select.Close; Query_Select.ParamByName(fnIDComponentType).AsInteger := IDComponentTypes[i]; Query_Select.ExecQuery; while Not Query_Select.Eof do begin Result.Add(Query_Select.FN(fnID).AsInteger, Query_Select.FN(fnName).AsString); Query_Select.Next; end; end; finally IDComponentTypes.Free; FieldNames.Free; end; end; end; function TDM.GetComponChilds(AIDComponent, AIDTopCompon, AIDCompRel: Integer; ACompon: TSCSComponent; const AsortFld: String): TSCSComponents; var SCSComponent: TSCSComponent; CurrCompon: TSCSComponent; ChildCompon: TSCSComponent; ptrComplect: PComplect; strOrderBy: String; i: Integer; begin Result := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin Result := TSCSComponents.Create(true); strOrderBy := ''; if AsortFld <> '' then strOrderBy := 'order by COMPONENT_RELATION.'+AsortFld; SetSQLToFIBQuery(Query_Select, 'SELECT COMPONENT_RELATION.ID, KOLVO, Component.ID, NAME, PRICE, PRICE_CALC, IsLine, ID_COMPONENT, ID_COMPONENT_TYPE, ID_CHILD, /*Kol_Complect,*/ component_relation.Sort_ID, ' + fnKolSubComplect+' '+ 'FROM Component, COMPONENT_RELATION '+ 'WHERE '+ '('+fnIDTopCompon+' = '''+IntToStr(AIDTopCompon)+''') and '+ '('+GetZeroConditionAsNull(fnIDParentCompRel, AIDCompRel)+') and '+ '(ID_COMPONENT = '''+IntToStr(AIDComponent)+''' ) and ' + '(Component.ID = ID_Child) AND ' + '(CONNECT_TYPE = '''+IntToStr(cntComplect)+''') /*and '+ '(ID_COMPONENT IN (SELECT ID FROM COMPONENT)) */'+ strOrderBy); while Not Query_Select.Eof do begin SCSComponent := TSCSComponent.Create(GForm); SCSComponent.ID := Query_Select.FN(fnIDChild).AsInteger; SCSComponent.IDCompRel := Query_Select.FN(fnID).AsInteger; SCSComponent.isLine := Query_Select.FN(fnisline).AsInteger; //SCSComponent.KolComplect := Query_Select.FN(fnKolComplect).AsInteger; SCSComponent.KolComplect := Query_Select.FN(fnKolSubComplect).AsInteger; SCSComponent.Name := Query_Select.FN(fnName).AsString; SCSComponent.PRICE := Query_Select.FN(fnPrice).AsFloat; SCSComponent.PRICE_CALC := Query_Select.FN(fnPriceCalc).AsFloat; SCSComponent.ID_ComponentType := Query_Select.FN(fnIDComponentType).AsInteger; SCSComponent.CompRelSortID := Query_Select.FN(fnSortID).AsInteger; SCSComponent.Count := Query_Select.FN(fnKolvo).AsInteger; Result.Add(SCSComponent); Query_Select.Next; end; Query_Select.Close; end; bkProjectManager: begin Result := TSCSComponents.Create(false); CurrCompon := nil; if ACompon <> nil then CurrCompon := ACompon else CurrCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(CurrCompon) then begin for i := 0 to CurrCompon.ChildComplects.Count - 1 do begin ChildCompon := CurrCompon.ChildComplects[i]; if Assigned(ChildCompon) then begin ptrComplect := CurrCompon.GetComplectByIDChild(ChildCompon.ID); if ptrComplect <> nil then ChildCompon.CompRelSortID := ptrComplect.SortID; end; end; Result.Assign(CurrCompon.ChildComplects); end; { tSQL_ComponentRelation.Filtered := false; tSQL_ComponentRelation.Filter := 'id_component = '''+IntTostr(AIDComponent)+''''; tSQL_ComponentRelation.Filtered := true; tSQL_ComponentRelation.IndexName := GetIndexByFldFomSQLMemTable(tSQL_ComponentRelation, ASortFld); tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin if tSQL_ComponentRelation.FieldByName('connect_type').AsInteger = cntComplect then begin tSQL_Component.Filtered := false; tSQL_Component.Filter := 'id = '''+IntTostr(tSQL_ComponentRelation.FieldByName('id_child').AsInteger)+''''; tSQL_Component.Filtered := true; for i := 0 to tSQL_ComponentRelation.FieldByName('KOLVO').AsInteger - 1 do begin SCSComponent := TSCSComponent.Create(GForm); SCSComponent.ID := tSQL_ComponentRelation.FieldByName('ID_Child').AsInteger; SCSComponent.IDCompRel := tSQL_ComponentRelation.FieldByName('ID').AsInteger; SCSComponent.isLine := tSQL_Component.FieldByName('isline').AsInteger; SCSComponent.KolComplect := tSQL_Component.FieldByName('Kol_Complect').AsInteger; SCSComponent.Name := tSQL_Component.FieldByName('Name').AsString; SCSComponent.NameMark := tSQL_Component.FieldByName('Name_Mark').AsString; SCSComponent.PRICE := tSQL_Component.FieldByName(fnPrice).AsFloat; SCSComponent.PRICE_CALC := tSQL_Component.FieldByName(fnPriceCalc).AsFloat; SCSComponent.SortID := tSQL_Component.FieldByName(fnSortID).AsInteger; SCSComponent.Whole_ID := tSQL_Component.FieldByName('whole_id').AsInteger; Result.Add(SCSComponent); end; end; tSQL_ComponentRelation.Next; end; tSQL_ComponentRelation.IndexName := ''; } end; end; end; function TDM.GetComponCompRels(AIDComponent, AConnectType: Integer): TList; var ptrCompRel: PComplect; i: Integer; begin Result := nil; Result := TList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' SELECT * FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+ IntToStr(AIDComponent) +''') and '+ ' (CONNECT_TYPE = '''+ IntToStr(AConnectType) +''') /*and '+ ' (ID_COMPONENT IN (SELECT ID FROM COMPONENT)) */'); while Not scsQSelect.Eof do begin GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := scsQSelect.GetFNAsInteger('ID'); ptrCompRel.ID_Component := scsQSelect.GetFNAsInteger('ID_Component'); ptrCompRel.ID_Child := scsQSelect.GetFNAsInteger('ID_Child'); ptrCompRel.Kolvo := scsQSelect.GetFNAsInteger('Kolvo'); ptrCompRel.ConnectType := scsQSelect.GetFNAsInteger('Connect_Type'); ptrCompRel.SortID := scsQSelect.GetFNAsInteger('Sort_ID'); scsQSelect.Next; Result.Add(ptrCompRel); end; end; bkProjectManager: begin tSQL_ComponentRelation.Filtered := false; tSQL_ComponentRelation.Filter := '(ID_COMPONENT = '''+ IntToStr(AIDComponent) +''') and '+ '(CONNECT_TYPE = '''+ IntToStr(AConnectType) +''')'; tSQL_ComponentRelation.Filtered := true; //tSQL_ComponentRelation.First; //tSQL_ComponentRelation.First; if tSQL_ComponentRelation.RecordCount > 0 then // Tolik 28/12/2019 -- begin for i := 0 to tSQL_ComponentRelation.RecordCount - 1 do begin tSQL_ComponentRelation.RecNo := i + 1; GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := tSQL_ComponentRelation.FieldByName('ID').AsInteger; ptrCompRel.ID_Component := tSQL_ComponentRelation.FieldByName('ID_Component').AsInteger; ptrCompRel.ID_Child := tSQL_ComponentRelation.FieldByName('ID_Child').AsInteger; ptrCompRel.Kolvo := tSQL_ComponentRelation.FieldByName('Kolvo').AsInteger; ptrCompRel.ConnectType := tSQL_ComponentRelation.FieldByName('Connect_Type').AsInteger; ptrCompRel.SortID := tSQL_ComponentRelation.FieldByName('Sort_ID').AsInteger; //tSQL_ComponentRelation.Next; Result.Add(ptrCompRel); end; end; { while Not tSQL_ComponentRelation.Eof do begin GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := tSQL_ComponentRelation.FieldByName('ID').AsInteger; ptrCompRel.ID_Component := tSQL_ComponentRelation.FieldByName('ID_Component').AsInteger; ptrCompRel.ID_Child := tSQL_ComponentRelation.FieldByName('ID_Child').AsInteger; ptrCompRel.Kolvo := tSQL_ComponentRelation.FieldByName('Kolvo').AsInteger; ptrCompRel.ConnectType := tSQL_ComponentRelation.FieldByName('Connect_Type').AsInteger; ptrCompRel.SortID := tSQL_ComponentRelation.FieldByName('Sort_ID').AsInteger; tSQL_ComponentRelation.Next; Result.Add(ptrCompRel); end; } end; end; end; function TDM.GetComponChildsCompRels(AIDComponent: Integer): TList; var SCSComponent: TSCSComponent; ChildComponent: TSCSComponent; ptrCompRel: PComplect; i: integer; begin case TF_Main(GForm).GDBMode of bkNormBase: Result := GetComponCompRels(AIDComponent, cntComplect); bkProjectManager: begin Result := Tlist.Create; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then for i := 0 to SCSComponent.ChildComplects.Count - 1 do begin ChildComponent := SCSComponent.ChildComplects[i]; if Assigned(ChildComponent) then begin GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := -1; ptrCompRel.ID_Component := AIDComponent; ptrCompRel.ID_Child := ChildComponent.ID; ptrCompRel.Kolvo := 1; ptrCompRel.ConnectType := cntComplect; ptrCompRel.SortID := -1; Result.Add(ptrCompRel); end; end; end; end; end; {function TDM.GetComponIDsFromCatalogs(ACatalogIDs: TIntList): TIntList; var i: Integer; begin Result := TIntList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalogRelation, fnIDCatalog+'= :'+fnIDCatalog, nil, fnIDComponent), false); for i := 0 to ACatalogIDs.Count - 1 do begin Query_Select.Close; Query_Select.ParamByName(fnIDCatalog).AsInteger := ACatalogIDs[i]; Query_Select.ExecQuery; IntFIBFieldToIntList(Result, Query_Select, fnIDComponent); end; end;} function TDM.GetComponKolComplect(AComponent: TSCSComponent): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' SELECT COUNT(ID) FROM COMPONENT_RELATION '+ ' WHERE (ID_COMPONENT = '''+IntToStr(AComponent.ID)+''') and '+ ' (CONNECT_TYPE = '''+IntToStr(cntComplect)+''')'); Result := scsQSelect.GetFNAsInteger(fnCount); end; bkProjectManager: Result := AComponent.Complects.Count; end; end; function TDM.GetComponInterfaces(AIDComponent: Integer; ATakeIntoIsPort: Boolean; AIsPort: Integer): TSCSInterfaces; var Interfac: TSCSInterface; strFilter: String; SCSCompon: TSCSComponent; i: Integer; IncludeInterface: Boolean; begin Result := nil; SCSCompon := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin Result := TSCSInterfaces.Create(true); strFilter := ' SELECT * FROM INTERFACE_RELATION '+ 'WHERE (ID_COMPONENT = '''+IntToStr(AIDComponent)+''' ) /*AND*/ '; if ATakeIntoIsPort then strFilter := strFilter + '(IsPort = '''+IntToStr(AIsPort)+''') /*AND*/ '; strFilter := strFilter + //'(ID_COMPONENT in (SELECT ID FROM COMPONENT) )' + 'ORDER BY ID '; SetSQLToQuery(scsQSelect, strFilter); while Not scsQSelect.Eof do begin //GetMem(Interfac, SizeOf(TInterface)); Interfac := TSCSInterface.Create(GForm); Interfac.ID := scsQSelect.GetFNAsInteger('ID'); Interfac.ID_Interface := scsQSelect.GetFNAsInteger('ID_Interface'); Interfac.ID_Component := scsQSelect.GetFNAsInteger('ID_Component'); Interfac.Npp := scsQSelect.GetFNAsInteger(fnNpp); //Interfac.IsLineCompon := IsLine; Interfac.TypeI := scsQSelect.GetFNAsInteger('TypeI'); Interfac.Kind := scsQSelect.GetFNAsInteger('Kind'); Interfac.IsPort := scsQSelect.GetFNAsInteger('IsPort'); Interfac.IsUserPort := scsQSelect.GetFNAsInteger('IsUser_Port'); Interfac.NppPort := scsQSelect.GetFNAsInteger('Npp_Port'); Interfac.IsBusy := scsQSelect.GetFNAsInteger('isBusy'); Interfac.Gender := scsQSelect.GetFNAsInteger('GENDER'); Interfac.Multiple := scsQSelect.GetFNAsInteger('Multiple'); Interfac.ValueI := scsQSelect.GetFNAsFloat('ValueI'); Interfac.NumPair := scsQSelect.GetFNAsInteger('Num_Pair'); Interfac.Color := scsQSelect.GetFNAsInteger('Color'); Interfac.IDAdverse := scsQSelect.GetFNAsInteger('ID_Adverse'); Interfac.Side := scsQSelect.GetFNAsInteger('Side'); Interfac.SortID := scsQSelect.GetFNAsInteger('Sort_ID'); Interfac.Notice := scsQSelect.GetFNAsString(fnNotice); //Interfac.IOfIRelOut := nil; //Interfac.ConnectedInterfaces := nil; //Interfac.ParallelInterface := nil; Interfac.IDConnected := 0; Interfac.CoordZ := 0; if Interfac.TypeI = itConstructive then Interfac.LoadIOfIRels; Result.Add(Interfac); scsQSelect.Next; end; end; bkProjectManager: begin Result := TSCSInterfaces.Create(false); SCSCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSCompon) then for i := 0 to SCSCompon.Interfaces.Count - 1 do begin IncludeInterface := false; if (ATakeIntoIsPort) and (TSCSInterface(SCSCompon.Interfaces[i]).IsPort = AIsPort) then IncludeInterface := true else IncludeInterface := true; if IncludeInterface then begin Result.Add(SCSCompon.Interfaces[i]); //GetMem(Interfac, SizeOf(TInterface)); //Interfac^ := TInterface(SCSCompon.Interfaces[i]^); //Interfac := TSCSInterface.Create(GForm); //Interfac.Assign(SCSCompon.Interfaces[i]); //Result.Add(Interfac); end; end; { tSQL_InterfaceRelation.Filtered := false; tSQL_InterfaceRelation.Filter := '(ID_COMPONENT = '''+IntToStr(AIDComponent)+''') and (IsPort = '''+IntToStr(AIsPort)+''')'; tSQL_InterfaceRelation.Filtered := true; while Not tSQL_InterfaceRelation.Eof do begin GetMem(Interfac, SizeOf(TInterface)); Interfac.ID := tSQL_InterfaceRelation.FieldByName('ID').AsInteger; Interfac.ID_Interface := tSQL_InterfaceRelation.FieldByName('ID_Interface').AsInteger; Interfac.ID_Component := tSQL_InterfaceRelation.FieldByName('ID_Component').AsInteger; //Interfac.IsLineCompon := IsLine; Interfac.TypeI := tSQL_InterfaceRelation.FieldByName('TypeI').AsInteger; Interfac.Kind := tSQL_InterfaceRelation.FieldByName('Kind').AsInteger; Interfac.IsPort := tSQL_InterfaceRelation.FieldByName('IsPort').AsInteger; Interfac.IsUserPort := tSQL_InterfaceRelation.FieldByName('IsUser_Port').AsInteger; Interfac.NppPort := tSQL_InterfaceRelation.FieldByName('Npp_Port').AsInteger; Interfac.IsBusy := tSQL_InterfaceRelation.FieldByName('isBusy').AsInteger; Interfac.Gender := tSQL_InterfaceRelation.FieldByName('GENDER').AsInteger; Interfac.Multiple := tSQL_InterfaceRelation.FieldByName('Multiple').AsInteger; Interfac.ValueI := tSQL_InterfaceRelation.FieldByName('ValueI').AsFloat; Interfac.NumPair := tSQL_InterfaceRelation.FieldByName('Num_Pair').AsInteger; Interfac.Color := tSQL_InterfaceRelation.FieldByName('Color').AsInteger; Interfac.IDAdverse := tSQL_InterfaceRelation.FieldByName('ID_Adverse').AsInteger; Interfac.Side := tSQL_InterfaceRelation.FieldByName('Side').AsInteger; Interfac.SortID := tSQL_InterfaceRelation.FieldByName('Sort_ID').AsInteger; Interfac.IOfIRel := nil; Interfac.IDConnected := tSQL_InterfaceRelation.FieldByName(fnIDConnected).AsInteger; Interfac.CoordZ := tSQL_InterfaceRelation.FieldByName(fnCoordZ).AsFloat; Result.Add(Interfac); tSQL_InterfaceRelation.Next; end; } end; end; end; function TDM.GetIDComponByInterfID(AIDInterface: Integer): Integer; var Interf: TSCSInterface; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin {SetSQLToQuery(scsQSelect, ' select Component.ID from component, interface_relation '+ ' where (interface_relation.id = '''+IntTostr(AIDInterface)+''') and (component.id = id_component) '); Result := scsQSelect.GetFNAsInteger('ID');} SetSQLToQuery(scsQSelect, ' select ID_Component from interface_relation '+ ' where id = '''+IntTostr(AIDInterface)+''''); Result := scsQSelect.GetFNAsInteger('ID_Component'); end; bkProjectManager: with TF_Main(GForm) do begin Interf := nil; Interf := GSCSBase.CurrProject.GetInterfaceByID(AIDInterface); if Assigned(Interf) then Result := Interf.ID_Component; //tSQL_InterfaceRelation.Filtered := false; //tSQL_InterfaceRelation.Filter := 'id = '''+IntTostr(AIDInterface)+''''; //tSQL_InterfaceRelation.Filtered := true; //if Not tSQL_InterfaceRelation.Eof then // Result := tSQL_InterfaceRelation.FieldByName('id_component').AsInteger; end; end; end; // ##### Вернет ID самой верхней компоненты ###### function TDM.GetIDUpperComponByIDChild(AIDChild: Integer): Integer; var IDCurrCompon: Integer; IDParentCompon: Integer; HaveParent: Boolean; begin Result := AIDChild; try IDParentCompon := AIDChild; //*** Определить самую верхнюю компонент HaveParent := true; while HaveParent do begin IDCurrCompon := IDParentCompon; IDParentCompon := GetCompRelFieldValueAsIntByFilter(fnIDComponent, '(id_child = '''+IntToStr(IDCurrCompon)+''') and (connect_type = '''+IntToStr(cntComplect)+''')'); if (IDParentCompon = 0) or (IDCurrCompon = IDParentCompon) then begin HaveParent := false; Result := IDCurrCompon; end; end; { IDParentCompon := AIDChild; //*** Определить самую верхнюю компонент HaveParent := true; while HaveParent do begin IDCurrCompon := IDParentCompon; SetSQLToQuery(scsQSelect, ' select id_component from component_relation where (id_child = '''+IntToStr(IDCurrCompon)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDParentCompon := scsQSelect.GetFNAsInteger('id_component'); if IDParentCompon = 0 then begin HaveParent := false; Result := IDCurrCompon; end; end; } except on E: Exception do AddExceptionToLog('TDM.GetIDUpperComponByIDChild: '+E.Message); end; end; function TDM.GetIDFirstComponInCatalog(AIDCatalog: Integer): Integer; begin Result := 0; try case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select component.id, id_object_icon from component, katalog, catalog_relation '+ ' where (katalog.id = '''+IntTostr(AIDCatalog)+''') and '+ ' (id_catalog = katalog.id) and (id_component = component.id) '+ ' order by component.sort_id '); Result := scsQSelect.GetFNAsInteger('id'); end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_CatalogRelation, 'id_catalog = '''+IntToStr(AIDCatalog)+'''') then if Not tSQL_CatalogRelation.Eof then begin tSQL_Component.Filtered := false; tSQL_Component.Filter := ' object_id = '''+IntToStr(AIDCatalog)+''''; tSQL_Component.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Component, fnSortID); tSQL_Component.Filtered := true; tSQL_Component.First; while Not tSQL_Component.Eof do begin if tSQL_Component.FieldByName(fnID).AsInteger = tSQL_CatalogRelation.FieldByName(fnIDComponent).AsInteger then begin Result := tSQL_Component.FieldByName(fnID).AsInteger; tSQL_Component.IndexName := ''; Exit; ///// EXIT ////// end; tSQL_Component.Next; end; tSQL_Component.IndexName := ''; end;} end; end; except on E: Exception do AddExceptionToLog('TDM.GetIDFirstComponInCatalog: '+E.Message); end; end; function TDM.GetComponFieldValueAsInteger(AIDCompon: Integer; AFieldName: String): Integer; var strWhere: String; begin Result := 0; strWhere := 'id = '''+IntToStr(AIDCompon)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Select, ' select '+AFieldName+' from '+tnComponent+' where '+strWhere); Result := Query_Select.FN(AFieldName).AsInteger; Query_Select.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Component, strWhere) then // if Not tSQL_Component.Eof then // Result := tSQL_Component.FieldByName(AFieldName).AsInteger; {tSQL_Component.Filtered := false; if tSQL_Component.Locate(fnID, AIDCompon, []) then Result := tSQL_Component.FieldByName(AFieldName).AsInteger;} end; end; end; function TDM.GetComponFieldValuesAsInteger(AFieldName: String; StrWhere: String): TIntList; begin Result := TIntList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Select, ' select '+AFieldName+' from '+tnComponent +' where '+ StrWhere); while not Query_Select.Eof do begin Result.Add(Query_Select.FN(AFieldName).AsInteger); Query_Select.Next; end; Query_Select.Close; end; bkProjectManager: begin end; end; end; function TDM.GetComponFieldValueAsFloat(AIDCompon: Integer; AFieldName: String): Double; var strWhere: String; begin Result := 0; strWhere := 'id = '''+IntToStr(AIDCompon)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Select,' select '+AFieldName+' from '+tnComponent+' where '+strWhere); Result := Query_Select.Fields[0].AsFloat; //scsQSelect.GetFNAsFloat(AFieldName); Query_Select.Close; //scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Component, strWhere) then // if Not tSQL_Component.Eof then // Result := tSQL_Component.FieldByName(AFieldName).AsFloat; tSQL_Component.Filtered := false; if tSQL_Component.Locate(fnID, AIDCompon, []) then Result := tSQL_Component.FieldByName(AFieldName).AsFloat; end; end; end; function TDM.GetComponCountByFilter(AFilter: String; ANoMoreOne: Boolean): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select count(id) from Component '+ ' where '+ AFilter); Result := scsQSelect.GetFNAsInteger(fnCount); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Component, AFilter) then // Result := GetRecCountFromSQLMemTable(tSQL_Component, ANoMoreOne); end; end; end; function TDM.GetComponVolume(AIDComponent, AGender: Integer): Double; var NBComponent: TSCSComponent; begin Result := 0; NBComponent := TSCSComponent.Create(GForm); try NBComponent.LoadComponentByID(AIDComponent, false); NBComponent.LoadInterfaces(-1, false); Result := NBComponent.GetVolume(AGender); finally FreeAndNil(NBComponent); end; end; function TDM.GetParentIDsCompon(AIDComponent: Integer): TIntList; begin Result := TIntList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponentRelation, '(ID_CHILD = '''+ IntToStr(AIDComponent) +''') and (connect_type = '''+IntToStr(cntComplect)+''')', nil, fnIDComponent)); IntFIBFieldToIntList(Result, Query_Select, fnIDComponent); end; procedure TDM.DefineComponPricesAfterMoveToNewCatalog(AIDComponent, AIDOldDir, AIDNewDir: Integer); var ptrNewDirCurrencyM: PObjectCurrencyRel; //*** базовая валюта новой папки ptrOldDirCurrencyM: PObjectCurrencyRel; //*** базовая валюта старой папки ptrOldDirCurrencyMFromNewDir: PObjectCurrencyRel; //*** базовая валюта старой папки, получаемая из новой пипки ComponIDs: TIntList; begin ptrNewDirCurrencyM := GetCatalogCurrencyByMainFld(AIDNewDir, ctMain); if ptrNewDirCurrencyM <> nil then begin ptrOldDirCurrencyM := GetCatalogCurrencyByMainFld(AIDOldDir, ctMain); if ptrOldDirCurrencyM <> nil then begin //*** еси папки имеют разные валюты if ptrNewDirCurrencyM.IDCurrency <> ptrOldDirCurrencyM.IDCurrency then begin //*** найти валюту (которая для старой папки базовая) в новой папке ptrOldDirCurrencyMFromNewDir := GetCatalogCurrencyByCurrencyID(AIDNewDir, ptrOldDirCurrencyM.IDCurrency); if ptrOldDirCurrencyMFromNewDir <> nil then begin ComponIDs := TIntList.Create; ComponIDs.Add(AIDComponent); ChangeComponsCurrencyRatiosWithPrices(ComponIDs, ptrOldDirCurrencyMFromNewDir.Data, ptrNewDirCurrencyM.Data, Query_Select, Query_Operat); FreeAndNil(ComponIDs); FreeMem(ptrOldDirCurrencyMFromNewDir); end; end; FreeMem(ptrOldDirCurrencyM); end; FreeMem(ptrNewDirCurrencyM); end; end; function TDM.GetComponCatalogOwnerID(AIDComponent: Integer): Integer; begin Result := U_BaseCommon.GetComponCatalogOwnerID(AIDComponent, Query_Select); end; function TDM.GetComponCatalogOwnerIDByLevel(AIDComponent, ALevel: Integer): Integer; begin Result := U_BaseCommon.GetComponCatalogOwnerIDByLevel(AIDComponent, ALevel, Query_Select); end; function TDM.GetComponCurrencyByCurrencyGUID(AIDComponent: Integer; const AGUIDCurrency: String): PObjectCurrencyRel; var CurrID: Integer; begin Result := nil; CurrID := GetIntFromTableByGUID(tnCurrency, fnID, AGUIDCurrency, qmPhisical); if CurrID <> 0 then Result := GetComponCurrencyByCurrencyID(AIDComponent, CurrID); end; function TDM.GetComponCurrencyByCurrencyID(AIDComponent, AIDCurrency: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetComponCurrencyByCurrencyID(AIDComponent, AIDCurrency, Query_Select); end; function TDM.GetComponCurrencyByCurrencyIDFromListOrQuery(AIDComponent, AIDCurrency: Integer; AList: TList): PObjectCurrencyRel; begin Result := nil; if AList <> nil then Result := GetObjectCurrencyByCurrencyIDFromList(AIDCurrency, AList); if Result = nil then Result := GetComponCurrencyByCurrencyID(AIDComponent, AIDCurrency); end; function TDM.GetComponCurrencyByMainFld(AIDComponent, AMainValue: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetComponCurrencyByMainFld(AIDComponent, AMainValue, Query_Select); end; function TDM.GetComponCurrencyByMainFldFromListOrQuery(AIDComponent, AMainValue: Integer; AList: TList): PObjectCurrencyRel; begin Result := nil; if AList <> nil then Result := GetObjectCurrencyByMainFldFromList(AMainValue, AList); if Result = nil then Result := GetComponCurrencyByMainFld(AIDComponent, AMainValue); end; procedure TDM.GetComponCurrencies(AIDComponent: Integer; var ACurrencyM, ACurrencyS: TObjectCurrencyRel); var IDCatalog: Integer; begin ZeroMemory(@ACurrencyM, SizeOf(TObjectCurrencyRel)); ZeroMemory(@ACurrencyS, SizeOf(TObjectCurrencyRel)); IDCatalog := GetComponCatalogOwnerID(AIDComponent); if IDCatalog > 0 then GetCatalogCurrencies(IDCatalog, ACurrencyM, ACurrencyS); end; function TDM.GetComponCatalogNamePath(const AGUIDCompon: String; ALevel: Integer; AIncludeCompon: Boolean): TStringList; var ComponID: Integer; IDCatalogOwner: Integer; begin //ComponID := GetIntFromTableByGUID(const ATableName, AResFieldName, AGUIDCompon); //IDCatalogOwner := GetComponCatalogOwnerID(ComponID, Query_Select); end; function TDM.GetChildComponPrice(AIDComponent, AIDChild: Integer; AChildPrice: Double; AComponCurrencies: TList): Double; var ptrComponCurrencyM: PObjectCurrencyRel; ptrChildCurrencyM: PObjectCurrencyRel; ptrChildCurrencyMFromComponDir: PObjectCurrencyRel; begin Result := AChildPrice; ptrComponCurrencyM := GetComponCurrencyByMainFldFromListOrQuery(AIDComponent, ctMain, AComponCurrencies); ptrChildCurrencyM := GetComponCurrencyByMainFldFromListOrQuery(AIDChild, ctMain, nil); if ptrComponCurrencyM <> nil then begin if ptrChildCurrencyM <> nil then begin //*** еси компонента и комплектующее имеют разные валюты if ptrComponCurrencyM.IDCurrency <> ptrChildCurrencyM.IDCurrency then begin //*** найти валюту (которая для компл-й базовая) в папке компоненты ptrChildCurrencyMFromComponDir := GetComponCurrencyByCurrencyIDFromListOrQuery(AIDComponent, ptrChildCurrencyM.IDCurrency, AComponCurrencies); if ptrChildCurrencyMFromComponDir <> nil then begin Result := GetPriceAfterChangeCurrency(AChildPrice, ptrChildCurrencyMFromComponDir.Data, ptrComponCurrencyM.Data, valEpsilonCurrency); if AComponCurrencies <> nil then begin if AComponCurrencies.IndexOf(ptrChildCurrencyMFromComponDir) = -1 then AComponCurrencies.Add(ptrChildCurrencyMFromComponDir); end else FreeMem(ptrChildCurrencyMFromComponDir); end; end; FreeMem(ptrChildCurrencyM); end; if AComponCurrencies <> nil then begin if AComponCurrencies.IndexOf(ptrComponCurrencyM) = -1 then AComponCurrencies.Add(ptrComponCurrencyM); end else FreeMem(ptrComponCurrencyM); end; end; { // ##### Переименование Папки ##### procedure TDM.RenameDir(AID_Dir: Integer; ANewName: String); var Node: TTreeNode; Catalog: TCatalog; begin try SetSQLToQuery(scsQOperat, ' UPDATE kATALOG SET ' + ' NAME = '''+ ANewName +''' '+ ' WHERE ID = '''+ IntToStr(AID_Dir) +''' '); Catalog := GetCatalogByID(AID_Dir); with TF_Main(GForm) do begin Node := FindComponOrDirInTree(AID_Dir, false); if Node <> nil then begin Node.Text := GetNameAndIndex(ANewName, Catalog.ItemType, Catalog.IndexPointObj, Catalog.IndexConnector, Catalog.IndexLine); Node.Text := GetNameAndKol(ANewName, Catalog.Kol_Compon); end; end; except on E: Exception do AddExceptionToLog('TDM.RenameDir', E.Message); end; end; } {// ##### Заполнить таблицу INTERFOFINTERF_RELATION ##### procedure TDM.FillMemTableIOfIRel; var IDInterfRel: Integer; IDConCompon: Integer; IDsInterfRel: TList; //*** Список прошедших ID-в для предотвращения загрузки по ним по несколько раз IDIRel: ^Integer; function WasID(AID: Integer): Boolean; var i: Integer; begin Result := false; for i := 0 to IDsInterfRel.Count - 1 do if Integer(IDsInterfRel.Items[i]^) = AID then begin Result := true; Break; end; end; begin IDsInterfRel := TList.Create; MemTable_IOFI_REL.Active := false; MemTable_IOFI_REL.Active := true; MemTable_InterfaceRel.Last; while Not MemTable_InterfaceRel.Bof do begin IDInterfRel := MemTable_InterfaceRel.FieldByName('ID').AsInteger; if Not WasID(IDInterfRel) then begin New(IDIRel); IDIRel^ := IDInterfRel; IDsInterfRel.Add(IDIRel); SetSQLToQuery(scsQ, 'SELECT Interfofinterf_relation.ID, ID_INTERF_REL, ID_CON_COMPON, ID_CON_COMPL, ID_CON_IOFI, CON_POSITION, "POSITION", ISBUSY '+ 'FROM Interfofinterf_relation '+ 'WHERE ID_INTERF_REL = '''+ IntToStr(IDInterfRel) +''' '); while Not scsQ.Eof do begin MemTable_IOFI_REL.Append; MemTable_IOFI_REL.FieldByName('ID').AsInteger := scsQ.FN('ID').AsInteger; MemTable_IOFI_REL.FieldByName('ID_INTERF_REL').AsInteger := scsQ.FN('ID_INTERF_REL').AsInteger; MemTable_IOFI_REL.FieldByName('ID_CON_COMPON').AsInteger := scsQ.FN('ID_CON_COMPON').AsInteger; MemTable_IOFI_REL.FieldByName('ID_CON_COMPL').AsInteger := scsQ.FN('ID_CON_COMPL').AsInteger; MemTable_IOFI_REL.FieldByName('ID_CON_IOFI').AsInteger := scsQ.FN('ID_CON_IOFI').AsInteger; MemTable_IOFI_REL.FieldByName('CON_POSITION').AsInteger := scsQ.FN('CON_POSITION').AsInteger; MemTable_IOFI_REL.FieldByName('POSITION').AsInteger := scsQ.FN('POSITION').AsInteger; MemTable_IOFI_REL.FieldByName('ISBUSY').AsInteger := scsQ.FN('ISBUSY').AsInteger; MemTable_IOFI_REL.Post; scsQ.Next; end; end; MemTable_InterfaceRel.Prior; end; //*** Удалить список ID-в (GForm as TF_Main).FreeList(IDsInterfRel); //*** Загрузить наим-я компонентов с кот. соед. интерфейс MemTable_IOFI_REL.Last; while Not MemTable_IOFI_REL.Bof do begin if MemTable_IOFI_REL.FieldByName('IsBusy').AsInteger = 1 then begin IDConCompon := MemTable_IOFI_REL.FieldByName('ID_CON_COMPON').AsInteger; SetSQLToQuery(scsQ, ' SELECT NAME FROM COMPONENT ' + ' WHERE ID = '''+ IntToStr(IDConCompon) +''' ' ); if scsQ.RecordCount > 0 then begin MemTable_IOFI_REL.Edit; MemTable_IOFI_REL.FieldByName('Name').AsString := scsQ.FN('Name').AsString; MemTable_IOFI_REL.Post; end; end; MemTable_IOFI_REL.Prior; end; end; } procedure TDM.AppendToTemplateRel(AComponID, AIDGroup, AIsStandart: Integer; AModel: TStream=nil); var FieldNames: TStringList; begin try FieldNames := TStringList.Create; FieldNames.Add(fnGUID); FieldNames.Add(fnIDComponent); FieldNames.Add(fnIDGroup); FieldNames.Add(fnisStandart); if AModel <> nil then FieldNames.Add(fnModel); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnTemplateRelation, '', FieldNames, ''), false); Query_Operat.Params[0].AsString := CreateGUID; Query_Operat.Params[1].AsInteger := AComponID; Query_Operat.Params[2].AsInteger := AIDGroup; Query_Operat.Params[3].AsInteger := AIsStandart; if AModel <> nil then begin AModel.Position := 0; Query_Operat.Params[4].LoadFromStream(AModel); end; Query_Operat.ExecQuery; Query_Operat.Close; FreeAndNil(FieldNames); except on E: Exception do AddExceptionToLogExt(ClassName, 'AppendToTemplateRel', E.Message); end; end; function TDM.GetTemplateComponents(AGroupType: Integer; const ASortFld: string): TSCSComponents; var SCSCompon: TSCSComponent; FieldNames: string; strSQL: String; begin Result := TSCSComponents.Create(true); try FieldNames := tnComponent +snPoint +fnID +snCommaS+ tnComponent +snPoint +fnName +snCommaS+ tnComponent +snPoint +fnIsLine +snCommaS+ tnComponent +snPoint +fnPrice +snCommaS+ tnComponent +snPoint +fnPriceCalc +snCommaS+ tnComponent +snPoint +fnIDComponentType +snCommaS+ tnComponent +snPoint +fnIDObjectIcon +snCommaS+ tnComponent +snPoint +fnIDSymbol +snCommaS+ tnComponent +snPoint +fnKolComplect +snCommaS+ tnComponent +snPoint +fnSortID +snCommaS+ tnComponent +snPoint +fnGuid +snCommaS+ tnTemplateRelation +snPoint +fnID +snCommaS+ tnTemplateRelation +snPoint +fnisStandart; strSQL := 'SELECT '+FieldNames+' FROM COMPONENT '+ 'JOIN TEMPLATE_RELATION '+ 'ON COMPONENT.ID = TEMPLATE_RELATION.ID_COMPONENT '+ 'WHERE TEMPLATE_RELATION.ID_GROUP IN (SELECT ID FROM TEMPLATE_GROUPS WHERE TTYPE = '''+IntToStr(AGroupType)+''') '; if ASortFld <> '' then strSQL := strSQL + ' order by ' + ASortFld; SetSQLToFIBQuery(Query_Select, strSQL); while Not Query_Select.Eof do begin SCSCompon := TSCSComponent.Create(GForm); SCSCompon.ID := Query_Select.Fields[0].AsInteger; SCSCompon.Name := Query_Select.Fields[1].AsString; SCSCompon.IsLine := Query_Select.Fields[2].AsInteger; SCSCompon.Price := Query_Select.Fields[3].AsFloat; SCSCompon.Price_Calc := Query_Select.Fields[4].AsFloat; SCSCompon.ID_ComponentType := Query_Select.Fields[5].AsInteger; SCSCompon.IDObjectIcon := Query_Select.Fields[6].AsInteger; SCSCompon.IDSymbol := Query_Select.Fields[7].AsInteger; SCSCompon.KolComplect := Query_Select.Fields[8].AsInteger; SCSCompon.SortID := Query_Select.Fields[9].AsInteger; SCSCompon.GuidNB := Query_Select.Fields[10].AsString; SCSCompon.IDTopComponent := Query_Select.Fields[11].AsInteger; //TemplateRelation.ID SCSCompon.ServCanConnect := IntToBool(Query_Select.Fields[12].AsInteger); //IsStandart SCSCompon.LoadComponentType; Result.Add(SCSCompon); Query_Select.Next; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'GetTemplateComponents', E.Message); end; end; // ##### Не повторяется ли шифр ##### function TDM.CheckCypher(ACypher, ACurrTable: String; ACurrID: Integer): Boolean; var HowCheck: Boolean; function CheckCypherInTable(ATableName: String): Boolean; var qSQL: String; begin Result := false; qSQL := ' SELECT COUNT(*) As Cnt FROM '+ ATableName +' WHERE '; if AnsiLowerCase(ACurrTable) = AnsiLowerCase(ATableName) then qSQL := qSQL + ' ( ID <> '''+ IntToStr(ACurrID) +''' ) and (CYPHER = '''+ ACypher +''' ) ' else qSQL := qSQL + ' CYPHER = '''+ ACypher +''' '; SetSQLToQuery(scsQ, qSQL); if scsQ.GetFNAsInteger('Cnt') = 0 then Result := true; end; begin Result := false; HowCheck := CheckCypherInTable('NB_Norms'); if HowCheck = true then begin HowCheck := CheckCypherInTable('NB_Resources'); if HowCheck = true then HowCheck := CheckCypherInTable('Tz'); end; Result := HowCheck; end; // ##### Вернет ID подсоединенного интерфейса ##### function TDM.GetConnectedIDInterfRels(AIDInterfRel: Integer): TList; var sqlSelect: String; procedure LoadInterfacesFromIOfIByFld(AValueField, AByFieldName: String); var ConnectedList: TList; i: Integer; begin ConnectedList := GetIOfIRelFieldValueAsIntListByFilter(AValueField, AByFieldName+' = '''+IntTostr(AIDInterfRel)+''''); if Assigned(ConnectedList) then begin //*** Убрать AIDInterfRel из списка for i := 0 to ConnectedList.Count - 1 do if Integer(ConnectedList[i]^) = AIDInterfRel then begin FreeMem(ConnectedList[i]); ConnectedList[i] := nil; end; ConnectedList.Pack; Result.Assign(ConnectedList, laOr); // Tolik 07/02/2017 -- FreeAndNil(ConnectedList); // end; end; begin Result := nil; Result := TList.Create; LoadInterfacesFromIOfIByFld(fnIDInterfRel, fnIDInterfTo); LoadInterfacesFromIOfIByFld(fnIDInterfTo, fnIDInterfRel); { Result := 0; SetSQLToQuery(scsQSelect, ' select interf_to from interfofinterf_relation '+ ' where id_interf_rel = '''+IntToStr(AIDInterfRel)+''' '); if scsQSelect.GetFNAsInteger('interf_to') > 0 then Result := scsQSelect.GetFNAsInteger('interf_to') else begin SetSQLToQuery(scsQSelect, ' select interf_rel from interfofinterf_relation '+ ' where id_interf_to = '''+IntToStr(AIDInterfRel)+''' '); if scsQSelect.GetFNAsInteger('interf_rel') > 0 then Result := scsQSelect.GetFNAsInteger('interf_rel') end;} end; // ##### Вернет сумму объемов подсоединенных интерфейсов ч-з комплектующие ##### function TDM.GetConnectedInterfacesValues(AQuery: TSCSQuery; AIDInterface: Integer): Double; var CurrVal: Double; ConnInterfList: TList; i: Integer; Interf: TSCSInterface; begin Result := 0; try Currval := 0; ConnInterfList := TList.Create; try case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(AQuery, ' select id_interf_to from interfofinterf_relation '+ ' where id_interf_rel = '''+IntToStr(AIDInterface)+''''); IntFieldToList(ConnInterfList, AQuery, 'id_interf_to'); AQuery.Close; AQuery.SQL.Clear; AQuery.SQL.Add('select valuei from interface_relation where (id = :id) and (multiple = '''+IntToStr(biTrue)+''')'); for i := 0 to ConnInterfList.Count - 1 do begin AQuery.Close; AQuery.SetParamAsInteger('id', Integer(ConnInterfList.Items[i]^)); AQuery.ExecQuery; CurrVal := CurrVal + AQuery.GetFNAsFloat('valuei'); end; AQuery.Close; Result := CurrVal; end; bkProjectManager: begin Interf := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(AIDInterface); if Assigned(Interf) then Result := Interf.GetInterfToValues; {if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, 'id_interf_rel = '''+IntToStr(AIDInterface)+'''') then begin IntFieldToListFromSQLMemTable(ConnInterfList, tSQL_InterfOfInterfRelation, 'id_interf_to'); tSQL_InterfaceRelation.Filtered := false; for i := 0 to ConnInterfList.Count - 1 do begin //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, 'id = '''+IntToStr(Integer(ConnInterfList.Items[i]^))+'''') then if tSQL_InterfaceRelation.Locate(fnID, Integer(ConnInterfList.Items[i]^), []) then CurrVal := CurrVal + tSQL_InterfaceRelation.FieldByName(fnValueI).AsFloat; end; Result := CurrVal; end; } end; end; finally FreeList(ConnInterfList); end; except on E: Exception do AddExceptionToLog('TDM.GetConnectedInterfacesValues: '+E.Message); end; end; function TDM.DelSimpleComponent(AIDComponent: Integer): Boolean; var strWhere: String; begin Result := false; try strWhere := 'ID = '''+ IntToStr(AIDComponent) +''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' DELETE FROM COMPONENT WHERE '+ strWhere); scsQOperat.Close; DeleteComponFromLists(AIDComponent); end; bkProjectManager: begin tSQL_Component.Filtered := false; if tSQL_Component.Locate(fnID, AIDComponent, []) then tSQL_Component.Delete; end; end; Result := true; except on E: Exception do AddExceptionToLog('TDM.DelSimpleComponent: '+E.Message); end; end; function TDM.GetComponentChildsID(AIDComponent: Integer): TIntList; var //ResList: TIntList; strWhere: String; SCSComponent: TSCSComponent; i: Integer; SCSChild: TSCSComponent; begin Result := TIntList.Create; try strWhere := '(ID_COMPONENT = '''+ IntToStr(AIDComponent) +''') and '+ '(Connect_Type = '''+ IntToStr(cntComplect) +''')'; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' SELECT ID_CHILD FROM COMPONENT_RELATION ' + ' WHERE '+strWhere); IntFieldToIntList(Result, scsQSelect, fnIDChild); //Result := ResList; end; bkProjectManager: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then for i := 0 to SCSComponent.ChildComplects.Count - 1 do begin SCSChild := SCSComponent.ChildComplects[i]; if Assigned(SCSChild) then Result.Add(SCSChild.ID); end; { if SetFilterToSQLMemTable(tSQL_ComponentRelation, strWhere) then IntFieldToIntListFromSQLMemTable(ResList, tSQL_ComponentRelation, 'ID_CHILD'); Result := ResList; } end; end; except on E: Exception do AddExceptionToLog('TDM.GetComponentChildsID: '+E.Message); end; end; function TDM.GetComponentType(AIdComponentType: Integer): TComponentType; begin Result := TF_Main(GForm).FNormBase.GSCSBase.NBSpravochnik.GetComponentTypeByID(AIDComponentType); {Result.ID := -1; Result.NAME := ''; Result.PortKind := -1; Result.ActiveState := -1; Result.IsLine := -1; Result.IDDesignIcon := -1; try if TF_Main(GForm).GDBMode <> bkNormBase then Exit; ///// EXIt ///// SetSQLToFIBQuery(Query_Select, ' select * from component_types where id = '''+IntToStr(AIdComponentType)+''' '); Result := GetComponentTypeFromQuery(Query_Select); except on E: Exception do AddExceptionToLog('TDM.GetComponentType: '+E.Message); end;} end; function TDM.GetComponentTypeByIDCompon(AIDComponent: integer): TComponentType; var IDComponentType: Integer; begin try SetSQLToFIBQuery(Query_Select, 'select id_component_type from component '+ 'where id = '''+IntToStr(AIDComponent)+ ''' '); IDComponentType := Query_Select.FN(fnIDComponentType).AsInteger; Result := GetComponentType(IDComponentType); except on E: Exception do AddExceptionToLog('TDM.GetComponentTypeByIDCompon: '+E.Message); end; end; // ##### Определяет компоненту по Порту/Мультипорту ##### function TDM.DefineIDComponByPortMultiport(AIDComponent: Integer): Integer; var ComponentType: TComponentType; IDParentComponent: Integer; IDCurrComponent: Integer; IDComponentType: Integer; SCSComponent: TSCSComponent; HaveParent: Boolean; begin Result := AIDComponent; SCSComponent := nil; try case TF_Main(GForm).GDBMode of bkNormBase: begin if isLineCompon(GForm, AIDComponent) then Exit; //// EXIT //// IDParentComponent := AIDComponent; HaveParent := true; while HaveParent do begin IDCurrComponent := IDParentComponent; //*** Получить тип компоненты SetSQLToQuery(scsQSelect, ' select id_component_type from component where id = '''+IntTostr(IDCurrComponent)+''' '); IDComponentType := scsQSelect.GetFNAsInteger('id_component_type'); //*** Определить тип порта найденого типа with TF_Main(GForm).FNormBase.DM do begin SetSQLToQuery(scsQSelect, ' select port_kind from component_types where id = '''+IntToStr(IDComponentType)+''' '); if scsQSelect.GetFNAsInteger('port_kind') = pkMultiPort then begin Result := IDCurrComponent; Break; //// BREAK //// end; end; //*** Определить отцовский компонент SetSQLToQuery(scsQSelect, ' select id_component from component_relation '+ ' where (id_child = '''+IntToStr(IDCurrComponent)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDParentComponent := scsQSelect.GetFNAsInteger('id_component'); if IDParentComponent = 0 then begin Result := IDCurrComponent; HaveParent := false; end; end; end; bkProjectManager: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then if SCSComponent.IsLine = biFalse then begin HaveParent := true; while HaveParent do begin if SCSComponent.ComponentType.PortKind = pkMultiPort then begin Result := SCSComponent.ID; Break; //// BREAK //// end; SCSComponent := SCSComponent.GetParentComponent; if Not Assigned(SCSComponent) then HaveParent := false; end; end; end; end; except on E: Exception do AddExceptionToLog('TDM.DefineIDComponByMultiport: '+E.Message); end; { Result := AIDComponent; try if isLineCompon(GForm, AIDComponent) then Exit; //// EXIT //// IDParentComponent := AIDComponent; HaveParent := true; while HaveParent do begin IDCurrComponent := IDParentComponent; //*** Получить тип компоненты SetSQLToQuery(scsQSelect, ' select id_component_type from component where id = '''+IntTostr(IDCurrComponent)+''' '); IDComponentType := scsQSelect.GetFNAsInteger('id_component_type'); //*** Определить тип порта найденого типа with TF_Main(GForm).FNormBase.DM do begin SetSQLToQuery(scsQSelect, ' select port_kind from component_types where id = '''+IntToStr(IDComponentType)+''' '); if scsQSelect.GetFNAsInteger('port_kind') = pkMultiPort then begin Result := IDCurrComponent; Break; //// BREAK //// end; end; //*** Определить отцовский компонент SetSQLToQuery(scsQSelect, ' select id_component from component_relation '+ ' where (id_child = '''+IntToStr(IDCurrComponent)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDParentComponent := scsQSelect.GetFNAsInteger('id_component'); if IDParentComponent = 0 then begin Result := IDCurrComponent; HaveParent := false; end; end; except on E: Exception do AddExceptionToLog('TDM.DefineIDComponByMultiport', E.Message); end; } end; // ##### Вернет максимальный номер порта компоненты ##### function TDM.GetComponentLastPort(AIDComponent: Integer): Integer; var IDComponent: Integer; SCSComponent: TSCSComponent; InterfIDList: TList; i: Integer; IDInterface: Integer; MaxNumPort: Integer; begin // Tolik 08/02/2017 -- InterfIDList := Nil; // Result := 0; try SCSComponent := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin if isLineCompon(GForm, AIDComponent) then Exit; //// EXIT //// IDComponent := DefineIDComponByPortMultiport(AIDComponent); if IDComponent = 0 then Exit; ///// Exit ///// SCSComponent := TSCSComponent.Create(GForm); try SCSComponent.LoadComponentByID(IDCOmponent); //*** Получить все интерфейсы InterfIDList := SCSComponent.GetAllInterfIDCompon; MaxNumPort := 0; for i := 0 to InterfIDList.Count - 1 do begin IDInterface := Integer(InterfIDList[i]^); SetSQLToQuery(scsQSelect, ' select IsPort, npp_port from interface_relation where id = '''+IntToStr(IDInterface)+''' '); if scsQSelect.GetFNAsInteger('isPort') = biTrue then if scsQSelect.GetFNAsInteger('npp_port') > MaxNumPort then MaxNumPort := scsQSelect.GetFNAsInteger('npp_port'); end; Result := MaxNumPort; finally FreeAndNil(SCSComponent); end; end; bkProjectManager: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then if SCSComponent.IsLine = biFalse then begin SCSComponent := SCSComponent.DefinedComponByPortMultiport; if SCSComponent <> nil then Result := SCSComponent.GetMaxNppPort; //IDComponent := DefineIDComponByPortMultiport(SCSComponent.ID); //if IDComponent = 0 then // Exit; ///// Exit ///// //if IDComponent <> SCSComponent.ID then // SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(IDComponent); //if Assigned(SCSComponent) then // Result := SCSComponent.GetMaxNumPort; end; end; end; except on E: Exception do AddExceptionToLog('TDM.GetComponentLastPort: '+E.Message); end; // Tolik -- 08/02/2017 -- if InterfIDList <> nil then FreeAndNil(InterfIDList); // end; // Tolik 10/04/2020 -- старая закомменчена -- см ниже procedure TDM.DefineComponNppPorts(AComponentList: TList; aDestChildCompon: TSCSComponent = nil); var IDUpperComponent: Integer; NppPort: Integer; ChangedCompons: TSCSComponents; i: Integer; procedure FillListByUsersPorts(ASCSCompon: TSCSComponent; AUserPortsList: TIntList); var SCSComponent: TSCSComponent; ChildComponent: TSCSComponent; //ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TIntList; ChildComponentType: TComponentType; CurrCompon: TSCSComponent; //ptrID: ^Integer; //IsNoUserPort: Boolean; begin UserPortsList := TIntList.Create; SCSComponent := nil; SCSComponent := ASCSCompon; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDCompon); if Assigned(SCSComponent) then begin //if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then UserPortsList.Assign(AUserPortsList); //*** Загрузить комплектующие //SCSComponent.LoadComplects; for i := 0 to SCSComponent.ChildComplects.Count - 1 do if Assigned(SCSComponent.ChildComplects[i]) then begin ChildComponent := SCSComponent.ChildComplects[i]; //if ChildComponent.ComponentType.PortKind <> pkMultiPort then FillListByUsersPorts(ChildComponent, UserPortsList); end; //*** Определить Номера портов //SCSComponent.LoadInterfaces(-1, false); for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then if Interfac.IsUserPort = biTrue then begin //New(ptrID); //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := Interfac.NppPort; UserPortsList.Add(Interfac.NppPort); end; end; //if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then AUserPortsList.Assign(UserPortsList, laCopy); //*** Освобождение памяти FreeAndNil(UserPortsList); // List будет освобождаться в DefineStep //SCSComponent.Free; end; end; procedure DefineStep(ASCSCompon: TSCSComponent; var ALastNppPort: Integer; AUserPortsList: TIntList); var CurrNppPort: Integer; SCSComponent: TSCSComponent; //ChildComponent: TSCSComponet; //ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TIntList; //ptrID: ^Integer; IsNoUserPort: Boolean; PortChangedCount: Integer; begin CurrNppPort := 0; UserPortsList := TIntList.Create; //SCSComponent := TSCSComponent.Create(GForm); //SCSComponent.LoadComponentByID(AIDCompon, false); //SCSComponent.LoadComponentType; SCSComponent := nil; SCSComponent := ASCSCompon; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDCompon); if Assigned(SCSComponent) then begin //if SCSComponent.ComponentType.PortKind = pkPort then begin CurrNppPort := ALastNppPort; if AUserPortsList = nil then FillListByUsersPorts(SCSComponent, UserPortsList) else UserPortsList.Assign(AUserPortsList); end; {else FillListByUsersPorts(SCSComponent, UserPortsList);} //*** Загрузить комплектующие //SCSComponent.LoadComplects; for i := 0 to SCSComponent.ChildComplects.Count - 1 do if Assigned(SCSComponent.ChildComplects[i]) then DefineStep(SCSComponent.ChildComplects[i], CurrNppPort, UserPortsList); //*** Определить Номера портов //SCSComponent.LoadInterfaces(-1, false); PortChangedCount := 0; for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin if Interfac.IsUserPort = biFalse then begin IsNoUserPort := false; while IsNoUserPort = false do begin //CurrNppPort := CurrNppPort + 1; CurrNppPort := CurrNppPort + 1; if UserPortsList.IndexOf(CurrNppPort) = -1 then //if CheckNoIDinList(CurrNppPort, UserPortsList) then IsNoUserPort := true; //*** Внести номер порта в базу //UpdateInterfFieldAsFloat(Interfac.ID, CurrNppPort, fnNppPort); //if (aDestChildCompon = nil) or (aDestChildCompon = SCSComponent) then begin if Interfac.NppPort <> CurrNppPort then Inc(PortChangedCount); Interfac.NppPort := CurrNppPort; end; CurrNppPort := CurrNppPort + Interfac.Kolvo - 1; end; end; end; end; //20.08.2012 запоминаем компонеты, для которых переопределены порты if PortChangedCount > 0 then ChangedCompons.Add(SCSComponent); //if SCSComponent.ComponentType.PortKind = pkPort then ALastNppPort := CurrNppPort; //*** Освобождение памяти { if (AUserPortsList = nil) or (SCSComponent.ComponentType.PortKind = pkMultiPort) then FreeAndNil(UserPortsList) else } FreeAndNil(UserPortsList); //SCSComponent.Free; end; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; //// EXIT //// ChangedCompons := TSCSComponents.Create(false); //NppPort := 0; for i := 0 to AComponentList.Count - 1 do begin NppPort := 0; DefineStep(TSCSComponent(AComponentList[i]), NppPort, nil); end; //20.08.2012 Переопределяем маркировку компонентов for i := 0 to ChangedCompons.Count - 1 do RemarkComponAfterChangePort(ChangedCompons[i]); ChangedCompons.Free; except on E: Exception do AddExceptionToLog('TDM.DefineComponNppPorts: '+E.Message); end; end; (* procedure TDM.DefineComponNppPorts(AComponent: TSCSComponent; aDestChildCompon: TSCSComponent=nil); var IDUpperComponent: Integer; NppPort: Integer; ChangedCompons: TSCSComponents; i: Integer; procedure FillListByUsersPorts(ASCSCompon: TSCSComponent; AUserPortsList: TIntList); var SCSComponent: TSCSComponent; ChildComponent: TSCSComponent; //ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TIntList; ChildComponentType: TComponentType; //ptrID: ^Integer; //IsNoUserPort: Boolean; begin UserPortsList := TIntList.Create; SCSComponent := nil; SCSComponent := ASCSCompon; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDCompon); if Assigned(SCSComponent) then begin if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then UserPortsList.Assign(AUserPortsList); //*** Загрузить комплектующие //SCSComponent.LoadComplects; for i := 0 to SCSComponent.ChildComplects.Count - 1 do if Assigned(SCSComponent.ChildComplects[i]) then begin ChildComponent := SCSComponent.ChildComplects[i]; if ChildComponent.ComponentType.PortKind <> pkMultiPort then FillListByUsersPorts(ChildComponent, UserPortsList); end; //*** Определить Номера портов //SCSComponent.LoadInterfaces(-1, false); for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then if Interfac.IsUserPort = biTrue then begin //New(ptrID); //GetMem(ptrID, SizeOf(Integer)); //ptrID^ := Interfac.NppPort; UserPortsList.Add(Interfac.NppPort); end; end; if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then AUserPortsList.Assign(UserPortsList, laCopy); //*** Освобождение памяти FreeAndNil(UserPortsList); // List будет освобождаться в DefineStep //SCSComponent.Free; end; end; procedure DefineStep(ASCSCompon: TSCSComponent; var ALastNppPort: Integer; AUserPortsList: TIntList); var CurrNppPort: Integer; SCSComponent: TSCSComponent; //ChildComponent: TSCSComponet; //ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TIntList; //ptrID: ^Integer; IsNoUserPort: Boolean; PortChangedCount: Integer; begin CurrNppPort := 0; UserPortsList := TIntList.Create; //SCSComponent := TSCSComponent.Create(GForm); //SCSComponent.LoadComponentByID(AIDCompon, false); //SCSComponent.LoadComponentType; SCSComponent := nil; SCSComponent := ASCSCompon; //TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDCompon); if Assigned(SCSComponent) then begin if SCSComponent.ComponentType.PortKind = pkPort then begin CurrNppPort := ALastNppPort; if AUserPortsList = nil then FillListByUsersPorts(SCSComponent, UserPortsList) else UserPortsList.Assign(AUserPortsList); end else FillListByUsersPorts(SCSComponent, UserPortsList); //*** Загрузить комплектующие //SCSComponent.LoadComplects; for i := 0 to SCSComponent.ChildComplects.Count - 1 do if Assigned(SCSComponent.ChildComplects[i]) then DefineStep(SCSComponent.ChildComplects[i], CurrNppPort, UserPortsList); //*** Определить Номера портов //SCSComponent.LoadInterfaces(-1, false); PortChangedCount := 0; for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin if Interfac.IsUserPort = biFalse then begin IsNoUserPort := false; while IsNoUserPort = false do begin //CurrNppPort := CurrNppPort + 1; CurrNppPort := CurrNppPort + 1; if UserPortsList.IndexOf(CurrNppPort) = -1 then //if CheckNoIDinList(CurrNppPort, UserPortsList) then IsNoUserPort := true; //*** Внести номер порта в базу //UpdateInterfFieldAsFloat(Interfac.ID, CurrNppPort, fnNppPort); //if (aDestChildCompon = nil) or (aDestChildCompon = SCSComponent) then begin if Interfac.NppPort <> CurrNppPort then Inc(PortChangedCount); Interfac.NppPort := CurrNppPort; end; CurrNppPort := CurrNppPort + Interfac.Kolvo - 1; end; end; end; end; //20.08.2012 запоминаем компонеты, для которых переопределены порты if PortChangedCount > 0 then ChangedCompons.Add(SCSComponent); if SCSComponent.ComponentType.PortKind = pkPort then ALastNppPort := CurrNppPort; //*** Освобождение памяти if (AUserPortsList = nil) or (SCSComponent.ComponentType.PortKind = pkMultiPort) then FreeAndNil(UserPortsList) else FreeAndNil(UserPortsList); //SCSComponent.Free; end; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; //// EXIT //// if AComponent.IsLine = biTrue then Exit; //// EXIT //// //IDUpperComponent := GetIDUpperComponByIDChild(AIDComponent); //SetSQLToQuery(scsQOperat, ' update interface_relation set npp_port = :npp_port where id = :id '); ChangedCompons := TSCSComponents.Create(false); NppPort := 0; DefineStep(AComponent.GetTopComponent, NppPort, nil); //20.08.2012 Переопределяем маркировку компонентов for i := 0 to ChangedCompons.Count - 1 do RemarkComponAfterChangePort(ChangedCompons[i]); ChangedCompons.Free; except on E: Exception do AddExceptionToLog('TDM.DefineComponNppPorts: '+E.Message); end; end; *) { procedure TDM.DefineComponNppPorts(AIDComponent: Integer); var IDUpperComponent: Integer; NppPort: Integer; procedure FillListByUsersPorts(AIDCompon: Integer; AUserPortsList: TList); var SCSComponent: TSCSComponent; ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TList; ChildComponentType: TComponentType; ptrID: ^Integer; //IsNoUserPort: Boolean; begin UserPortsList := TList.Create; SCSComponent := TSCSComponent.Create(GForm); SCSComponent.LoadComponentByID(AIDCompon, false); SCSComponent.LoadComponentType; if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then UserPortsList.Assign(AUserPortsList); //*** Загрузить комплектующие SCSComponent.LoadComplects; for i := 0 to SCSComponent.Complects.Count - 1 do begin ptrComplect := SCSComponent.Complects[i]; ChildComponentType := GetComponentTypeByIDCompon(ptrComplect.ID_Child); if ChildComponentType.PortKind <> pkMultiPort then FillListByUsersPorts(ptrComplect.ID_Child, UserPortsList); end; //*** Определить Номера портов SCSComponent.LoadInterfaces(-1, false); for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then if Interfac.IsUserPort = biTrue then begin //New(ptrID); GetMem(ptrID, SizeOf(Integer)); ptrID^ := Interfac.NppPort; UserPortsList.Add(ptrID); end; end; if SCSComponent.ComponentType.PortKind = pkPort then if AUserPortsList <> nil then AUserPortsList.Assign(UserPortsList, laCopy); //*** Освобождение памяти UserPortsList.Free; // List будет освобождаться в DefineStep SCSComponent.Free; end; procedure DefineStep(AIDCompon: Integer; var ALastNppPort: Integer; AUserPortsList: TList); var CurrNppPort: Integer; SCSComponent: TSCSComponent; ptrComplect: PComplect; Interfac: TSCSInterface; i: Integer; UserPortsList: TList; ptrID: ^Integer; IsNoUserPort: Boolean; begin CurrNppPort := 0; UserPortsList := TList.Create; SCSComponent := TSCSComponent.Create(GForm); SCSComponent.LoadComponentByID(AIDCompon, false); SCSComponent.LoadComponentType; if SCSComponent.ComponentType.PortKind = pkPort then begin CurrNppPort := ALastNppPort; if AUserPortsList = nil then FillListByUsersPorts(SCSComponent.ID, UserPortsList) else UserPortsList.Assign(AUserPortsList); end else FillListByUsersPorts(SCSComponent.ID, UserPortsList); //*** Загрузить комплектующие SCSComponent.LoadComplects; for i := 0 to SCSComponent.Complects.Count - 1 do begin ptrComplect := SCSComponent.Complects[i]; DefineStep(ptrComplect.ID_Child, CurrNppPort, UserPortsList); end; //*** Определить Номера портов SCSComponent.LoadInterfaces(-1, false); for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin if Interfac.IsUserPort = biFalse then begin IsNoUserPort := false; while IsNoUserPort = false do begin CurrNppPort := CurrNppPort + 1; if CheckNoIDinList(CurrNppPort, UserPortsList) then IsNoUserPort := true; //*** Внести номер порта в базу UpdateInterfFieldAsFloat(Interfac.ID, CurrNppPort, fnNppPort); //scsQOperat.Close; //scsQOperat.SetParamAsInteger('id', Interfac.ID); //scsQOperat.SetParamAsInteger('npp_port', CurrNppPort); //scsQOperat.ExecQuery; end; scsQOperat.Close; end; end; end; if SCSComponent.ComponentType.PortKind = pkPort then ALastNppPort := CurrNppPort; //*** Освобождение памяти if (AUserPortsList = nil) or (SCSComponent.ComponentType.PortKind = pkMultiPort) then FreeList(UserPortsList) else UserPortsList.Free; SCSComponent.Free; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; //// EXIT //// if isLineCompon(GForm, AIDComponent) then Exit; //// EXIT //// IDUpperComponent := GetIDUpperComponByIDChild(AIDComponent); SetSQLToQuery(scsQOperat, ' update interface_relation set npp_port = :npp_port where id = :id '); NppPort := 0; DefineStep(IDUpperComponent, NppPort, nil); except on E: Exception do AddExceptionToLog('TDM.DefineComponNppPorts', E.Message); end; end; } {//20.08.2012 procedure TDM.DefineComponNppPortsByPortMultiport(AComponent: TSCSComponent); var //IDComponent: Integer; DefinedComponByPortMultiport: TSCSComponent; begin //IDComponent := DefineIDComponByPortMultiport(AIDComponent); DefinedComponByPortMultiport := AComponent.DefinedComponByPortMultiport; DefineComponNppPorts(DefinedComponByPortMultiport); end;} // ##### Проверяет, не явл ли компонент компл-й в других комп-х ##### function TDM.CheckNoComponInComplects(AComponent: TSCSComponent): Boolean; var ComponOwnerIDs: TIntList; begin Result := true; if TF_Main(GForm).GDBMode = bkNormBase then begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponentRelation, fnIDChild+' = '''+IntToStr(AComponent.ID)+'''', nil, fnIDComponent)); if Query_Select.RecordCount > 0 then begin Result := false; ComponOwnerIDs := TIntList.Create; IntFIBFieldToIntList(ComponOwnerIDs, Query_Select, fnIDComponent); try ComponOwnerIDs.RemoveDublicates; PauseProgressByMode(true); try TF_Main(GForm).ShowComponentsInListByIDList(ComponOwnerIDs, cDM_Msg11, cDM_Msg12_1+' "'+AComponent.Name+'", '+cDM_Msg12_2+': '); finally PauseProgressByMode(false); end; finally ComponOwnerIDs.Free; end; end; end; end; // ##### Проверяет, не содержит ли папка компоненты, которые явл компл-ми в компонентах других папок ##### function TDM.CheckNoDirComponsInComplects(ADir: TSCSCatalog; ADirComponsID: TIntList): Boolean; var //DirIDs: TIntList; DirComponIDs: TIntList; CurrOwnerComponIDs: TIntList; CompponsInComplects: TIntList; // Список компонент, кот явл компл-ми вне папки AIDDir i, j: Integer; CurrDirComponID: Integer; begin Result := true; //*** Создать список со всех подпапок + AIDDir //DirIDs := GetCatalogAllChildsIDs(ADir.ID); //DirIDs.Insert(0, ADir.ID); DirComponIDs := nil; CurrOwnerComponIDs := TIntList.Create; CompponsInComplects := TIntList.Create; try //*** Создать список всех компонент этих папок //SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalogRelation, // fnIDCatalog+'= :'+fnIDCatalog, nil, fnIDComponent), false); //for i := 0 to DirIDs.Count - 1 do //begin // Query_Select.Close; // Query_Select.ParamByName(fnIDCatalog).AsInteger := DirIDs[i]; // Query_Select.ExecQuery; // IntFIBFieldToIntList(DirComponIDs, Query_Select, fnIDComponent); //end; if ADirComponsID = nil then DirComponIDs := GetCatalogAllComponIDs(ADir.ID, true) else begin DirComponIDs := TIntList.Create; DirComponIDs.Assign(ADirComponsID, laOr); end; //*** SQL для отбора компонент, кот явл владельцами компл-х SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponentRelation, fnIDChild+' = :'+fnIDChild, nil, fnIDComponent), false); //*** Отбор компонент, кот явл комл-ми в компонентах других папок for i := 0 to DirComponIDs.Count - 1 do begin CurrDirComponID := DirComponIDs[i]; CurrOwnerComponIDs.Clear; Query_Select.Close; Query_Select.ParamByName(fnIDChild).AsInteger := CurrDirComponID; Query_Select.ExecQuery; IntFIBFieldToIntList(CurrOwnerComponIDs, Query_Select, fnIDComponent); //*** Если среди владельцев компл-й CurrDirComponID, существуют такие что не входят // в список всех компонент DirComponIDs, папки ADir.ID и ее подпапок, то добавл-м CurrDirComponID // в CompponsInComplects for j := 0 to CurrOwnerComponIDs.Count - 1 do if DirComponIDs.IndexOf(CurrOwnerComponIDs[j]) = -1 then begin CompponsInComplects.Add(CurrDirComponID); Break; ///// BREAK ///// end; end; //*** Вывести компоненты CompponsInComplects if CompponsInComplects.Count > 0 then begin Result := false; //TF_Main(GForm).ShowComponentsInList(CompponsInComplects, 'Удаление папки', // 'Нельзя удалить папку "'+ADir.Name+'", в который следующие компоненты являются комплектующими в компонентах других папок: '); PauseProgressByMode(true); try TF_Main(GForm).ShowComponentsInListByIDList(CompponsInComplects, cDM_Msg4_1+' '+ADir.GetNameForVisible, cDM_Msg4_2+': '); finally PauseProgressByMode(false); end; end; finally //DirIDs.Free; if DirComponIDs <> nil then DirComponIDs.Free; CurrOwnerComponIDs.Free; CompponsInComplects.Free; end; end; function TDM.CheckNoDirComponsTemplates(ADir: TSCSCatalog; ADirComponsID: TIntList): Boolean; var ComponTemplateIDs: TIntList; i: Integer; begin Result := true; ComponTemplateIDs := TIntList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponentTypes, fnIDComponTemplate+'= :'+fnIDComponTemplate, nil, fnID), false); for i := 0 to ADirComponsID.Count - 1 do begin Query_Select.Close; Query_Select.ParamByName(fnIDComponTemplate).AsInteger := ADirComponsID[i]; Query_Select.ExecQuery; if Query_Select.RecordCount > 0 then ComponTemplateIDs.Add(ADirComponsID[i]); end; if ComponTemplateIDs.Count > 0 then begin Result := false; PauseProgressByMode(true); try TF_Main(GForm).ShowComponentsInListByIDList(ComponTemplateIDs, cDM_Msg5_1, cDM_Msg5_2); finally PauseProgressByMode(false); end; end; ComponTemplateIDs.Free; end; function TDM.CheckHaveDirProjects(AIDDir: Integer): Boolean; var i: Integer; DirIDs: TIntList; begin Result := false; DirIDs := GetCatalogAllChildsIDs(AIDDir, Query_Select); DirIDs.Insert(0, AIDDir); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnCatalog, '('+fnParentID+' = :'+fnParentID+') and ('+fnIDItemType+' = '''+IntToStr(itProject)+''')', nil, fnCount+'('+fnID+')'), false); for i := 0 to DirIDs.Count - 1 do begin Query_Select.Close; Query_Select.Params[0].AsInteger := DirIDs[i]; Query_Select.ExecQuery; if Query_Select.Fields[0].AsInteger > 0 then begin Result := true; Break; //// BREAK //// end; end; FreeAndNil(DirIDs); end; procedure TDM.ClearComponentsFromGarbage; var InterfListForNoBusy: TSCSInterfaces; InterfToEmpty: TSCSInterface; i: Integer; begin //*** Удалить мертвые ссылки на комплектующие SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnComponentRelation, '(id_child is null) or (id_child = 0)', nil, '')); //*** Освождение интерфейсов InterfListForNoBusy := GetInterfacesThatMayBeNoBusy; if InterfListForNoBusy <> nil then for i := 0 to InterfListForNoBusy.Count - 1 do begin InterfToEmpty := InterfListForNoBusy[i]; if TF_Main(GForm).GDBMode = bkNormBase then UpdateInterfFieldAsInteger(InterfToEmpty.ID, biFalse, fnIsBusy); end; InterfListForNoBusy.Free; DefineComponKolComplects(Query_Select, Query_Operat); end; function TDM.GetPropertyData(AID: Integer; AGUID: String; ASpravochnik: TSpravochnik = nil): TPropertyData; var Spravochnik: TSpravochnik; SprProperty: TNBProperty; begin ZeroMemory(@Result, SizeOf(TPropertyData)); Spravochnik := ASpravochnik; if Spravochnik = nil then case TF_Main(GForm).GDBMode of bkNormBase: Spravochnik := TF_Main(GForm).GSCSBase.NBSpravochnik; bkProjectManager: Spravochnik := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik; end; if Spravochnik <> nil then begin if AGUID = '' then Result := Spravochnik.GetPropertyDataByID(AID) else begin SprProperty := Spravochnik.GetPropertyByGUID(AGUID); if SprProperty <> nil then Result := SprProperty.PropertyData; end; end; //ZeroMemory(@Result, SizeOF(TPropertyData)); //with TF_Main(GForm).FNormBase.DM do //begin // SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnProperties, fnID+' = '''+IntToStr(AID)+'''', nil, fnAll)); // Result := GetPropertyDataFromQuery(Query_Select); {Result.ID := scsQSelect.GetFNAsInteger(fnID); Result.GUID := scsQSelect.GetFNAsString(fnGUID); Result.IDDataType := scsQSelect.GetFNAsInteger(fnIDDataType); Result.Name := scsQSelect.GetFNAsString(fnName); Result.SysName := scsQSelect.GetFNAsString(fnSysName); Result.Izm := scsQSelect.GetFNAsString(fnIzm); Result.ValueReq := scsQSelect.GetFNAsInteger(fnValueReq); Result.MinValue := scsQSelect.GetFNAsFloat(fnMinValue); Result.MaxValue := scsQSelect.GetFNAsFloat(fnMaxValue); Result.DefValue := scsQSelect.GetFNAsString(fnDefValue); Result.Description := scsQSelect.GetFNAsString(fnDescription); Result.IsStandart := scsQSelect.GetFNAsInteger(fnIsStandart); Result.SortID := scsQSelect.GetFNAsInteger(fnSortID); Result.IDItemType := scsQSelect.GetFNAsInteger(fnIDItemType); Result.ISProject := scsQSelect.GetFNAsInteger(fnISProject); Result.ISFolder := scsQSelect.GetFNAsInteger(fnISFolder); Result.ISList := scsQSelect.GetFNAsInteger(fnISList); Result.ISRoom := scsQSelect.GetFNAsInteger(fnISRoom); Result.ISSCSLine := scsQSelect.GetFNAsInteger(fnISSCSLine); Result.ISSCSConnector := scsQSelect.GetFNAsInteger(fnISSCSConnector); Result.ISComponLine := scsQSelect.GetFNAsInteger(fnISComponLine); Result.ISComponConn := scsQSelect.GetFNAsInteger(fnISComponConn);} //end; end; procedure TDM.DefineNBProperty(ADirItemType: Integer; const AGUIDDirType: string; aPropData: PPropertyData); var PropID, DirTypeID: Integer; begin PropID := GetIntFromTableByFld(tnProperties, fnSysName, fnID, aPropData^.SysName, Query_Select); if PropID <= 0 then begin // Заносим свойство в базу SaveProperty(meMake, aPropData); PropID := aPropData^.ID; if PropID > 0 then begin DirTypeID := 0; // ищем id папки справочника if AGUIDDirType <> '' then DirTypeID := U_BaseCommon.GetIntFromTableByGUID(tnDirectoryType, fnID, AGUIDDirType, Query_Select); if DirTypeID <= 0 then DirTypeID := GetTopIDDirType(ADirItemType); if DirTypeID > 0 then InsertToDirecoryTypeRel(DirTypeID, PropID, fnIDProperty); end; end; end; function TDM.GetPropertyIDFromGuide(ACurrID: Integer; AFormMode: TFormMode; AItemType: Integer): Integer; var GUID: String; begin Result := GetTableIDFromGuide(vkProperty, ACurrID, AFormMode, GUID, AItemType); end; function TDM.GetPropertyFromTable(ADataSource: TDataSource; ADataSet: TDataSet): TProperty; var PropDataSet: TDataSet; begin ZeroMemory(@Result, SizeOf(TProperty)); PropDataSet := ADataSet; if PropDataSet = nil then PropDataSet := ADataSource.DataSet; Result.ID := PropDataSet.FieldByName(fnID).AsInteger; Result.ID_Property := PropDataSet.FieldByName(fnIDProperty).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnGuidProperty) <> -1 then Result.GUIDProperty := PropDataSet.FieldByName(fnGuidProperty).AsString; if PropDataSet.FieldDefs.IndexOf(fnIDMaster) <> -1 then Result.IDMaster := PropDataSet.FieldByName(fnIDMaster).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnName) <> -1 then Result.Name_ := PropDataSet.FieldByName(fnName).AsString; if PropDataSet.FieldDefs.IndexOf(fnSysName) <> -1 then Result.SysName := PropDataSet.FieldByName(fnSysName).AsString; if PropDataSet.FieldDefs.IndexOf(fnIDDataType) <> -1 then Result.IDDataType := PropDataSet.FieldByName(fnIDDataType).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnPValue) <> -1 then Result.Value := PropDataSet.FieldByName(fnPValue).AsString; if PropDataSet.FieldDefs.IndexOf(fnTakeIntoConnect) <> -1 then Result.TakeIntoConnect := PropDataSet.FieldByName(fnTakeIntoConnect).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnTakeIntoJoin) <> -1 then Result.TakeIntoJoin := PropDataSet.FieldByName(fnTakeIntoJoin).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnIsTakeJoinForPoints) <> -1 then Result.IsTakeJoinforPoint := PropDataSet.FieldByName(fnIsTakeJoinForPoints).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnIsCrossControl) <> -1 then Result.IsCrossControl := PropDataSet.FieldByName(fnIsCrossControl).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnIDCrossProperty) <> -1 then Result.IDCrossProperty := PropDataSet.FieldByName(fnIDCrossProperty).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnGUIDCrossProperty) <> -1 then Result.GUIDCrossProperty := PropDataSet.FieldByName(fnGUIDCrossProperty).AsString; if PropDataSet.FieldDefs.IndexOf(fnIsForWholeComponent) <> -1 then Result.IsForWholeComponent := PropDataSet.FieldByName(fnIsForWholeComponent).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnIsDefault) <> -1 then Result.IsDefault := PropDataSet.FieldByName(fnIsDefault).AsInteger; if PropDataSet.FieldDefs.IndexOf(fnIsNew) <> -1 then Result.IsNew := PropDataSet.FieldByName(fnIsNew).AsBoolean; if PropDataSet.FieldDefs.IndexOf(fnIsModified) <> -1 then Result.IsModified := PropDataSet.FieldByName(fnIsModified).AsBoolean; end; procedure TDM.SetPropertyToTable(ADataSource: TDataSource; AProperty: TProperty); begin try if AProperty.ID > 0 then ADataSource.DataSet.FieldByName(fnID).AsInteger := AProperty.ID; ADataSource.DataSet.FieldByName(fnIDProperty).AsInteger := AProperty.ID_Property; if ADataSource.DataSet.FieldDefs.IndexOf(fnGuidProperty) <> -1 then ADataSource.DataSet.FieldByName(fnGuidProperty).AsString := AProperty.GUIDProperty; if ADataSource.DataSet.FieldDefs.IndexOf(fnIDDataType) <> -1 then ADataSource.DataSet.FieldByName(fnIDDataType).AsInteger := AProperty.IDDataType; if ADataSource.DataSet.FieldDefs.IndexOf(fnName) <> -1 then ADataSource.DataSet.FieldByName(fnName).AsString := AProperty.Name_; if ADataSource.DataSet.FieldDefs.IndexOf(fnSysName) <> -1 then ADataSource.DataSet.FieldByName(fnSysName).AsString := AProperty.SysName; if ADataSource.DataSet.FieldDefs.IndexOf(fnPValue) <> -1 then ADataSource.DataSet.FieldByName(fnPValue).AsString := AProperty.Value; if ADataSource.DataSet.FieldDefs.IndexOf(fnTakeIntoConnect) <> -1 then ADataSource.DataSet.FieldByName(fnTakeIntoConnect).AsInteger := AProperty.TakeIntoConnect; if ADataSource.DataSet.FieldDefs.IndexOf(fnTakeIntoJoin) <> -1 then ADataSource.DataSet.FieldByName(fnTakeIntoJoin).AsInteger := AProperty.TakeIntoJoin; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsTakeJoinForPoints) <> -1 then ADataSource.DataSet.FieldByName(fnIsTakeJoinForPoints).AsInteger := AProperty.IsTakeJoinforPoint; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsCrossControl) <> -1 then ADataSource.DataSet.FieldByName(fnIsCrossControl).AsInteger := AProperty.IsCrossControl; if ADataSource.DataSet.FieldDefs.IndexOf(fnIDCrossProperty) <> -1 then ADataSource.DataSet.FieldByName(fnIDCrossProperty).AsInteger := AProperty.IDCrossProperty; if ADataSource.DataSet.FieldDefs.IndexOf(fnGUIDCrossProperty) <> -1 then ADataSource.DataSet.FieldByName(fnGUIDCrossProperty).AsString := AProperty.GUIDCrossProperty; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsForWholeComponent) <> -1 then ADataSource.DataSet.FieldByName(fnIsForWholeComponent).AsInteger := AProperty.IsForWholeComponent; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsDefault) <> -1 then ADataSource.DataSet.FieldByName(fnIsDefault).AsInteger := AProperty.IsDefault; if ADataSource.DataSet.FieldDefs.IndexOf(fnisStandart) <> -1 then ADataSource.DataSet.FieldByName(fnisStandart).AsInteger := AProperty.IsDefault; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsNew) <> -1 then ADataSource.DataSet.FieldByName(fnIsNew).AsBoolean := AProperty.IsNew; if ADataSource.DataSet.FieldDefs.IndexOf(fnIsModified) <> -1 then ADataSource.DataSet.FieldByName(fnIsModified).AsBoolean := AProperty.IsModified; except on E: Exception do AddExceptionToLog('TDM.SetPropertyToTable: '+E.Message); end; end; procedure TDM.SaveProperty(AMakeEdit: TMakeEdit; APropertyData: PPropertyData); var FieldNames: TStringList; begin if APropertyData <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDDataType); FieldNames.Add(fnName); FieldNames.Add(fnSysName); FieldNames.Add(fnIzm); FieldNames.Add(fnValueReq); FieldNames.Add(fnMinValue); FieldNames.Add(fnMaxValue); FieldNames.Add(fnDefValue); FieldNames.Add(fnDescription); FieldNames.Add(fnIsStandart); FieldNames.Add(fnISProject); FieldNames.Add(fnISFolder); FieldNames.Add(fnISList); FieldNames.Add(fnISRoom); FieldNames.Add(fnISSCSLine); FieldNames.Add(fnISSCSConnector); FieldNames.Add(fnISComponLine); FieldNames.Add(fnISComponConn); FieldNames.Add(fnIsForWholeComponent); FieldNames.Add(fnIsValueRelToObj); case AMakeEdit of meMake: begin if APropertyData.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnProperties, '', FieldNames, ''), false); if APropertyData.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := APropertyData.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnProperties, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := APropertyData.ID; end; end; Query_Operat.ParamByName(fnIDDataType).AsInteger := APropertyData.IDDataType; Query_Operat.ParamByName(fnName).AsString := APropertyData.Name; Query_Operat.ParamByName(fnSysName).AsString := APropertyData.SysName; Query_Operat.ParamByName(fnIzm).AsString := APropertyData.Izm; Query_Operat.ParamByName(fnValueReq).AsInteger := APropertyData.ValueReq; Query_Operat.ParamByName(fnMinValue).AsFloat := APropertyData.MinValue; Query_Operat.ParamByName(fnMaxValue).AsFloat := APropertyData.MaxValue; Query_Operat.ParamByName(fnDefValue).AsString := APropertyData.DefValue; Query_Operat.ParamByName(fnDescription).AsString := APropertyData.Description; Query_Operat.ParamByName(fnIsStandart).AsInteger := APropertyData.IsStandart; Query_Operat.ParamByName(fnISProject).AsInteger := APropertyData.ISProject; Query_Operat.ParamByName(fnISFolder).AsInteger := APropertyData.ISFolder; Query_Operat.ParamByName(fnISList).AsInteger := APropertyData.ISList; Query_Operat.ParamByName(fnISRoom).AsInteger := APropertyData.ISRoom; Query_Operat.ParamByName(fnISSCSLine).AsInteger := APropertyData.ISSCSLine; Query_Operat.ParamByName(fnISSCSConnector).AsInteger := APropertyData.ISSCSConnector; Query_Operat.ParamByName(fnISComponLine).AsInteger := APropertyData.ISComponLine; Query_Operat.ParamByName(fnISComponConn).AsInteger := APropertyData.ISComponConn; Query_Operat.ParamByName(fnIsForWholeComponent).AsInteger := APropertyData.IsForWholeComponent; Query_Operat.ParamByName(fnIsValueRelToObj).AsInteger := APropertyData.IsValueRelToObj; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then APropertyData.ID := GenIDFromTable(Query_Select, gnPropertiesID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.SavePropValRel(AMakeEdit: TMakeEdit; APropValRelData: PPropValRelData); var FieldNames: TStringList; begin if APropValRelData <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDProperty); FieldNames.Add(fnPValue); FieldNames.Add(fnMinValue); FieldNames.Add(fnMaxValue); case AMakeEdit of meMake: begin if APropValRelData.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnPropValRel, '', FieldNames, ''), false); if APropValRelData.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := APropValRelData.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnPropValRel, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := APropValRelData.ID; end; end; Query_Operat.ParamByName(fnIDProperty).AsInteger := APropValRelData.IDProperty; SetParamAsStringEmptyAsNullToQuery(Query_Operat, fnPValue, APropValRelData.PValue); SetParamAsStringEmptyAsNullToQuery(Query_Operat, fnMinValue, APropValRelData.MinValue); SetParamAsStringEmptyAsNullToQuery(Query_Operat, fnMaxValue, APropValRelData.MaxValue); //Query_Operat.ParamByName(fnPValue).AsString := APropValRelData.PValue; //Query_Operat.ParamByName(fnMinValue).AsString := APropValRelData.MinValue; //Query_Operat.ParamByName(fnMaxValue).AsString := APropValRelData.MaxValue; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then APropValRelData.ID := GenIDFromTable(Query_Select, gnPropValRelID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.SavePropValNormRes(AMakeEdit: TMakeEdit; APropValNormResData: PPropValNormResData); var FieldNames: TStringList; begin if APropValNormResData <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDPropValRel); FieldNames.Add(fnIDNBComponent); FieldNames.Add(fnIDNBRes); FieldNames.Add(fnIDNBNorm); FieldNames.Add(fnKolvo); FieldNames.Add(fnExpenseForLength); FieldNames.Add(fnCountForPoint); FieldNames.Add(fnStepOfPoint); case AMakeEdit of meMake: begin if APropValNormResData.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnPropValNormRes, '', FieldNames, ''), false); if APropValNormResData.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := APropValNormResData.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnPropValNormRes, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := APropValNormResData.ID; end; end; Query_Operat.ParamByName(fnIDPropValRel).AsInteger := APropValNormResData.IDPropValRel; SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDNBComponent, APropValNormResData.IDNBComponent); SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDNBRes, APropValNormResData.IDNBRes); SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDNBNorm, APropValNormResData.IDNBNorm); Query_Operat.ParamByName(fnKolvo).AsDouble := APropValNormResData.Kolvo; Query_Operat.ParamByName(fnExpenseForLength).AsDouble := APropValNormResData.ExpenseForLength; Query_Operat.ParamByName(fnCountForPoint).AsDouble := APropValNormResData.CountForPoint; Query_Operat.ParamByName(fnStepOfPoint).AsDouble := APropValNormResData.StepOfPoint; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then APropValNormResData.ID := GenIDFromTable(Query_Select, gnPropValNormResID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.InsertToPropRelation(APropKind: TPropKind; AIDMaster, AIDProperty: Integer; AValue: String; AIsDefault: Integer; AMode: TQueryMode); var SQLTable: TSQLMemTable; TableName: String; MasterIDName: String; begin SQLTable := nil; TableName := ''; MasterIDName := ''; case APropKind of pkCatalog: begin SQLTable := tSQL_CatalogPropRelation; TableName := tnCatalogPropRelation; MasterIDName := 'id_catalog'; end; pkCompon: begin SQLTable := tSQL_CompPropRelation; TableName := tnCompPropRelation; MasterIDName := fnIDComponent; end; end; case AMode of qmPhisical: begin {QOperat.QueryMode := qmPhisical; ChangeSQLQuery(QOperat, ' insert into '+TableName+' ('+MasterIDName+', id_property, pvalue, isdefault) '+ ' values(:id_master, :id_property, :pvalue, :isdefault) '); QOperat.SetParamAsInteger('ID_Master', AIDMaster); QOperat.SetParamAsInteger('ID_Property', AIDProperty); QOperat.SetParamAsString('pvalue', AValue); QOperat.SetParamAsInteger(fnIsDefault, AIsDefault); QOperat.ExecQuery; QOperat.Close;} end; qmMemory: if FMemBaseActive then begin {SQLTable.Append; //SQLTable.Edit; SQLTable.FieldByName(MasterIDName).AsInteger := AIDMaster; SQLTable.FieldByName('ID_Property').AsInteger := AIDProperty; SQLTable.FieldByName('pvalue').AsString := AValue; SQLTable.FieldByName(fnIsDefault).AsInteger := AIsDefault; SQLTable.Post;} end; end; end; procedure TDM.DeleteFromPropRelation(APropKind: TPropKind; AObjectID, AIDPropRel: Integer; AMode: TQueryMode); var SQLTable: TSQLMemTable; TableName: String; MasterIDName: String; QOperat: TSCSQuery; strFilter: String; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; WholeComponents: TSCSComponents; PartComponent: TSCSComponent; SCSComponCatalogClass: TSCSComponCatalogClass; ptrProperty: PProperty; ptrPartProperty: PProperty; i: Integer; begin TableName := ''; SCSComponCatalogClass := nil; case APropKind of pkCatalog: begin case AMode of qmPhisical: TableName := tnCatalogPropRelation; qmMemory: begin SCSCatalog := TF_Main(GForm).GSCSBase.CurrProject.GetCatalogFromReferences(AObjectID); if SCSCatalog <> nil then SCSComponCatalogClass := TSCSComponCatalogClass(SCSCatalog); end; end; end; pkCompon: begin case AMode of qmPhisical: TableName := tnCompPropRelation; qmMemory: begin SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AObjectID); if SCSComponent <> nil then SCSComponCatalogClass := TSCSComponCatalogClass(SCSComponent); end; end; end; end; if SCSComponCatalogClass <> nil then SCSComponCatalogClass.NotifyChange; strFilter := 'id = '''+IntToStr(AIDPropRel)+''''; case AMode of qmPhisical: if TableName <> '' then begin QOperat := TSCSQuery.Create(GForm, Query_Operat, qSQL_QueryOperat); QOperat.QueryMode := qmPhisical; ChangeSQLQuery(QOperat, ' delete from '+TableName+' where '+strFilter); QOperat.ExecQuery; QOperat.Close; FreeAndNil(QOperat); end; qmMemory: if SCSComponCatalogClass <> nil then begin ptrProperty := SCSComponCatalogClass.GetPropertyByID(AIDPropRel); //*** Удалить свойство по всей компоненте if SCSComponCatalogClass is TSCSComponent then begin TF_Main(GForm).OnChangeComponPropertyVal(ptrProperty, TSCSComponent(SCSComponCatalogClass)); if TSCSComponent(SCSComponCatalogClass).IsLine = biTrue then if (ptrProperty <> nil) and (ptrProperty.IsForWholeComponent = biTrue) then begin WholeComponents := TF_Main(GForm).GSCSBase.CurrProject.GetComponentsByWholeID(TSCSComponent(SCSComponCatalogClass).Whole_ID); if WholeComponents <> nil then begin for i := 0 to WholeComponents.Count - 1 do begin PartComponent := WholeComponents[i]; if PartComponent <> SCSComponCatalogClass then begin ptrPartProperty := PartComponent.GetPropertyBySysName(ptrProperty.SysName); if ptrPartProperty <> nil then begin PartComponent.RemovePropertyByID(ptrPartProperty.ID); TF_Main(GForm).OnChangeComponPropertyVal(ptrPartProperty, PartComponent); end; end; end; FreeAndNil(WholeComponents); end; end; end; SCSComponCatalogClass.RemovePropertyByID(AIDPropRel); end; end; end; function TDM.CanEditProperty(APropertyTable: TkbmMemTable): Boolean; var PropSysName: String; begin Result := true; if Assigned(APropertyTable) then if APropertyTable.Active then begin PropSysName := APropertyTable.FieldByName(fnSysName).AsString; //if PropSyssName = pnAutotracing then // Result := false; //if PropSyssName = pnSignType then // Result := false; //if PropSysName = pnHeight then // Result := false; if PropSysName = pnLength then Result := false; //pnCategory = 'CATEGORY'; //pnColor = 'COLOR'; if PropSysName = pnCoordZ then Result := false; if PropSysName = pnHeightRoom then Result := false; if PropSysName = pnHeightCeiling then Result := false; if PropSysName = pnHeightSocket then Result := false; if PropSysName = pnHeightCorob then Result := false; if PropSysName = pnHeightSide1 then Result := false; if PropSysName = pnHeightSide2 then Result := false; if PropSysName = pnLengthKoef then Result := false; if PropSysName = pnPortReserv then Result := false; if PropSysName = pnMultiPortReserv then Result := false; //pnTraceCabinig = 'TRACE_CABINING'; if Result then if GPropRequired.IndexOf(PropSysName) <> -1 then Result := false; end; end; // ##### Вернет ID свойства ##### function TDM.GetIDPropertyBySysName(ATableKind: TTableKind; AID: Integer; APropSysName: String; AIDItemType: Integer): Integer; var ItemType: Integer; QueryMode: TQueryMode; IsOwnerFieldName: String; begin Result := 0; try {QueryMode := GetQueryModeByGDBMode(GDBMode); if AIDItemType = itProject then QueryMode := qmPhisical; ItemType := -1; IsOwnerFieldName := ''; //*** Определение типа пренадлежности свойств if AIDItemType > -1 then ItemType := AIDItemType else case ATableKind of tkComponent: ItemType := itComponent; tkCatalog: ItemType := DM.GetCatalogFieldValueAsInteger(AID, fnId, fnIDItemType, QueryMode); //begin // SetSQLToQuery(DM.scsQSelect, ' select id_item_type from katalog where id = '''+IntToStr(AID)+''' '); // ItemType := DM.scsQSelect.GetFNAsInteger('id_item_type'); //end; end; } //IsOwnerFieldName := ItemTypeToIsOwnerFieldName(ItemType); //if IsOwnerFieldName <> '' then with TF_Main(GForm).FNormBase.DM do begin //SetSQLToQuery(scsQSelect, ' select id from properties where ((id_item_type = '''+IntTostr(ItemType)+''') or (id_item_type = '''+IntTostr(itCommon)+''')) and (sysname = '''+APropSysName+''') '); //SetSQLToQuery(scsQSelect, 'select id from properties where '+ // '(sysname = '''+APropSysName+''') and ('+IsOwnerFieldName+' = '''+IntToStr()+''')'); SetSQLToQuery(scsQSelect, 'select id from properties where '+ 'sysname = '''+APropSysName+''''); Result := scsQSelect.GetFNAsInteger('id'); end; except on E: Exception do AddExceptionToLog('TDM.GetIDPropertyBySysName: '+E.Message); end; end; // ##### Устанавливает значение для свойства ##### procedure TDM.SetPropertyValue(ATableKind: TTableKind; AID: Integer; APropSysName, AValue: String; AQueryMode: TQueryMode; AIDProperty: Integer); var SQLTable: TSQLMemTable; TableName: String; WhereField: String; PropList: TList; IDProperty: Integer; QueryMode: TQueryMode; BufQueryMode: TQueryMode; begin SQLTable := nil; try try QueryMode := AQueryMode; if QueryMode = qmUndef then QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); if AIDProperty > -1 then IDProperty := AIDProperty else IDProperty := GetIDPropertyBySysName(ATableKind, AID, APropSysName, -1); case ATableKind of tkCatalog: begin SQLTable := tSQL_CatalogPropRelation; TableName := tnCatalogPropRelation; WhereField := 'ID_Catalog'; end; tkComponent: begin SQLTable := tSQL_CompPropRelation; TableName := tnCompPropRelation; WhereField := 'ID_Component'; end; tkComponentTypes: begin TableName := tnCompTypePropRelation; WhereField := fnIDComponentType; end; end; //*** Изменение свойства if IDProperty > 0 then case QueryMode of qmPhisical: begin BufQueryMode := scsQOperat.QueryMode; scsQOperat.QueryMode := qmPhisical; try SetSQLToQuery(scsQOperat, ' update '+TableName+' set pvalue = '''+AValue+''' '+ ' where ('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''') '); finally scsQOperat.QueryMode := BufQueryMode; end; end; qmMemory: begin //if SetFilterToSQLMemTable(SQLTable, '('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''')') then // if Not SQLTable.Eof then // begin // SQLTable.Edit; // SQLTable.FieldByName('pvalue').AsString := AValue; // SQLTable.Post; // end; end; end; {//**** Поиск ID свойства с APropSysName IDProperty := 0; PropList := TList.Create; SetSQLToQuery(DM.scsQSelect, ' select id_property from '+TableName+' where '+WhereField+' = '''+IntToStr(AID)+''' '); DM.IntFieldToList(PropList, DM.scsQSelect, 'id_property'); with F_NormBase.DM do begin SetSQLToQuery(scsQSelect, ' select id from properties where sysname = '''+APropSysName+''' '); while Not scsQSelect.Eof do begin if Not CheckNoIDinList(scsQSelect.FN('id').AsInteger, PropList) then begin IDProperty := scsQSelect.FN('id').AsInteger; Break; end; scsQSelect.Next; end; end; } { //*** Изменение свойства if IDProperty > 0 then SetSQLToQuery(DM.scsQOperat, ' update '+TableName+' set pvalue = '''+AValue+''' '+ ' where ('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''') ');} except on E: Exception do AddExceptionToLog('TDM.SetPropertyValue: '+E.Message); end; finally //FreeList(PropList); end; end; // ##### Устанавливает значение для войства типа FLOAT ##### procedure TDM.SetPropertyValueAsFloat(ATableKind: TTableKind; AID: Integer; APropSysName: String; AValue: Double; AQueryMode: TQueryMode; AIDProperty: Integer); var strPropValue: String; begin try strPropValue := FloatToStrU(AValue); SetPropertyValue(ATableKind, AID, APropSysName, strPropValue, AQueryMode, AIDProperty); except on E: Exception do AddExceptionToLog('TDM.SetPropertyValueAsFloat: '+E.Message); end; end; // ##### Устанавливает значение для свойства ##### function TDM.GetPropertyValue(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): String; var SQLTable: TSQLMemTable; TableName: String; WhereField: String; PropList: TList; IDProperty: Integer; QueryMode: TQueryMode; begin try try Result := ''; QueryMode := AQueryMode; if QueryMode = qmUndef then QueryMode := GetQueryModeByGDBMode(TF_Main(GForm).GDBMode); if AIDProperty > -1 then IDProperty := AIDProperty else IDProperty := GetIDPropertyBySysName(ATableKind, AID, APropSysName, -1); case ATableKind of tkCatalog: begin SQLTable := tSQL_CatalogPropRelation; TableName := tnCatalogPropRelation; WhereField := 'ID_Catalog'; end; tkComponent: begin SQLTable := tSQL_CompPropRelation; TableName := tnCompPropRelation; WhereField := 'ID_Component'; end; tkComponentTypes: begin TableName := tnCompTypePropRelation; WhereField := fnIDComponentType; end; end; //*** Изменение свойства if IDProperty > 0 then case QueryMode of qmPhisical: begin SetSQLToQuery(scsQSelect, ' select pvalue from '+TableName+' '+ ' where ('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''') '); Result := scsQSelect.GetFNAsString('pvalue'); end; qmMemory: begin //if SetFilterToSQLMemTable(SQLTable, '('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''')') then // if Not SQLTable.Eof then // Result := SQLTable.FieldByName('pvalue').AsString; end; end; {//**** Поиск ID свойства с APropSysName IDProperty := 0; PropList := TList.Create; SetSQLToQuery(DM.scsQSelect, ' select id_property from '+TableName+' where '+WhereField+' = '''+IntToStr(AID)+''' '); DM.IntFieldToList(PropList, DM.scsQSelect, 'id_property'); with F_NormBase.DM do begin SetSQLToQuery(scsQSelect, ' select id from properties where sysname = '''+APropSysName+''' '); while Not scsQSelect.Eof do begin if Not CheckNoIDinList(scsQSelect.FN('id').AsInteger, PropList) then begin IDProperty := scsQSelect.FN('id').AsInteger; Break; end; scsQSelect.Next; end; end; } {if IDProperty <> 0 then begin SetSQLToQuery(DM.scsQSelect, ' select pvalue from '+TableName+' '+ ' where ('+WhereField+' = '''+IntToStr(AID)+''') and (id_property = '''+IntToStr(IDProperty)+''') '); Result := DM.scsQSelect.GetFNAsString('pvalue'); end;} except on E: Exception do AddExceptionToLog('TDM.GetPropertyValue: '+E.Message); end; finally //FreeList(PropList); end; end; function TDM.GetPropertyValueAsFloat(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): Double; var StrValue: String; begin Result := 0; try StrValue := GetPropertyValue(ATableKind, AID, APropSysName, AQueryMode, AIDProperty); if StrValue <> '' then Result := StrToFloatU(CorrectStrToFloat(StrValue)); except on E: Exception do AddExceptionToLog('TDM.GetPropertyValueAsFloat: '+E.Message); end; end; function TDM.GetPropertyValueAsInteger(ATableKind: TTableKind; AID: Integer; APropSysName: String; AQueryMode: TQueryMode; AIDProperty: Integer): Integer; var StrValue: String; begin Result := 0; try StrValue := GetPropertyValue(ATableKind, AID, APropSysName, AQueryMode, AIDProperty); if StrValue <> '' then Result := StrToInt(StrValue); except on E: Exception do AddExceptionToLog('TDM.GetPropertyValueAsInteger: '+E.Message); end; end; procedure TDM.LoadPropertyFromQuery(AProperty: PProperty; AQuery: TpFIBQuery; ATreeElementType: TSCSTreeElementType); var MasterFieldName: String; begin ZeroMemory(AProperty, SizeOf(TProperty)); MasterFieldName := ''; if ATreeElementType = teCatalog then MasterFieldName := fnIDCatalog else if ATreeElementType = teComponent then MasterFieldName := fnIDComponent; with AQuery do begin AProperty.ID := FN(fnID).AsInteger; if MasterFieldName <> '' then AProperty.IDMaster := FN(MasterFieldName).AsInteger; AProperty.ID_Property := FN(fnIDProperty).AsInteger; AProperty.Value := FN(fnPValue).AsString; AProperty.IsDefault := FN(fnIsDefault).AsInteger; if ATreeElementType = teComponent then begin AProperty.TakeIntoConnect := FN(fnTakeIntoConnect).AsInteger; AProperty.TakeIntoJoin := FN(fnTakeIntoJoin).AsInteger; AProperty.IsTakeJoinforPoint := FN(fnIsTakeJoinForPoints).AsInteger; AProperty.IsCrossControl := FN(fnIsCrossControl).AsInteger; AProperty.IDCrossProperty := FN(fnIDCrossProperty).AsInteger; end; AProperty.IsNew := false; AProperty.IsModified := false; end; end; procedure TDM.SavePropertyRelation(AMakeEdit: TMakeEdit; ATablePropKind: TPropKind; AProperty: PProperty); var FieldNames: TStringList; TableName: String; MasterFieldName: String; GeneratorName: String; begin if AProperty <> nil then begin FieldNames := TStringList.Create; TableName := ''; GeneratorName := ''; MasterFieldName := ''; FieldNames.Add(fnIDProperty); FieldNames.Add(fnPValue); case ATablePropKind of pkCatalog: begin TableName := tnCatalog; MasterFieldName := fnIDCatalog; GeneratorName := gnCatalogPropRelationID; FieldNames.Add(fnIsDefault); end; pkCompon, pkCompTypePropRel: begin FieldNames.Add(fnTakeIntoConnect); FieldNames.Add(fnTakeIntoJoin); if ATablePropKind = pkCompon then begin TableName := tnComponent; MasterFieldName := fnIDComponent; GeneratorName := gnCompPropRelationID; FieldNames.Add(fnIsDefault); FieldNames.Add(fnIsTakeJoinForPoints); FieldNames.Add(fnIsCrossControl); FieldNames.Add(fnIDCrossProperty); end else if ATablePropKind = pkCompTypePropRel then begin TableName := tnCompTypePropRelation; MasterFieldName := fnIDComponentType; GeneratorName := gnCompTypePropRelationID; FieldNames.Add(fnisStandart); end; end; end; if (TableName <> '') and (MasterFieldName <> '') then begin FieldNames.Add(MasterFieldName); case AMakeEdit of meMake: begin if AProperty.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, TableName, '', FieldNames, ''), false); if AProperty.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AProperty.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, TableName, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AProperty.ID; end; end; Query_Operat.ParamByName(fnIDProperty).AsInteger := AProperty.ID_Property; Query_Operat.ParamByName(MasterFieldName).AsInteger := AProperty.IDMaster; Query_Operat.ParamByName(fnPValue).AsString := AProperty.Value; case ATablePropKind of pkCatalog: begin //TableName := tnCatalog; //MasterFieldName := fnIDCatalog; //GeneratorName := gnCatalogPropRelationID; Query_Operat.ParamByName(fnIsDefault).AsInteger := AProperty.IsDefault; end; pkCompon, pkCompTypePropRel: begin Query_Operat.ParamByName(fnTakeIntoConnect).AsInteger := AProperty.TakeIntoConnect; Query_Operat.ParamByName(fnTakeIntoJoin).AsInteger := AProperty.TakeIntoJoin; if ATablePropKind = pkCompon then begin //TableName := tnComponent; //MasterFieldName := fnIDComponent; //GeneratorName := gnCompPropRelationID; Query_Operat.ParamByName(fnIsDefault).AsInteger := AProperty.IsDefault; Query_Operat.ParamByName(fnIsTakeJoinForPoints).AsInteger := AProperty.IsTakeJoinforPoint; Query_Operat.ParamByName(fnIsCrossControl).AsInteger := AProperty.IsCrossControl; SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDCrossProperty, AProperty.IDCrossProperty); end else if ATablePropKind = pkCompTypePropRel then begin //TableName := tnCompTypePropRelation; //MasterFieldName := fnIDComponentType; //GeneratorName := gnCompTypePropRelationID; Query_Operat.ParamByName(fnisStandart).AsInteger := AProperty.IsDefault; end; end; end; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then if GeneratorName <> '' then AProperty.ID := GenIDFromTable(Query_Select, GeneratorName, 0); end; FreeAndNil(FieldNames); end; end; procedure TDM.UpdateCompPropRelFieldAsInteger(AIDPropRel, AValue: Integer; AFieldName: String); var strFilter: String; begin strFilter := 'id = '''+IntToStr(AIDPropRel)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'update comp_prop_relation set '+AFieldName+' = '''+IntToStr(AValue)+''' where '+strFilter); scsQOperat.Close; end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_CompPropRelation, strFilter) then if Not tSQL_CompPropRelation.Eof then begin tSQL_CompPropRelation.Edit; tSQL_CompPropRelation.FieldByName(AFieldName).AsInteger := AValue; tSQL_CompPropRelation.Post; end;} end; end; end; function TDM.GetCatalogPropertyFromMemTable(ALoadNames: Boolean; AStringsMan: TStringsMan): PProperty; var PropName: String; PropSysName: String; begin //16.10.2007 GetMem(Result, SizeOf(TProperty)); New(Result); ZeroMemory(Result, SizeOf(TProperty)); try if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin Result.Value := tSQL_CatalogPropRelation.Fields[fiCatPropRel_PValue].AsString; Result.GUIDProperty := tSQL_CatalogPropRelation.Fields[fiCatPropRel_GUIDProperty].AsString; end else begin Result.Value := AStringsMan.GetStrByID(tSQL_CatalogPropRelation.Fields[fiCatPropRel_PValue].AsInteger, AStringsMan.PropertyValueStrings); Result.GUIDProperty := AStringsMan.GetStrByID(tSQL_CatalogPropRelation.Fields[fiCatPropRel_GUIDProperty].Asinteger, AStringsMan.PropertyGUIDStrings); end; Result.ID := tSQL_CatalogPropRelation.Fields[fiCatPropRel_ID].AsInteger; Result.IDMaster := tSQL_CatalogPropRelation.Fields[fiCatPropRel_IDCatalog].AsInteger; Result.ID_Property := tSQL_CatalogPropRelation.Fields[fiCatPropRel_IDProperty].AsInteger; Result.IsDefault := tSQL_CatalogPropRelation.Fields[fiCatPropRel_IsDefault].AsInteger; //Result.TakeIntoConnect := tSQL_CatalogPropRelation.FieldByName('TAKE_INTO_CONNECT').AsInteger; //Result.TakeIntoJoin := tSQL_CatalogPropRelation.FieldByName('TAKE_INTO_JOIN').AsInteger; Result.IsNew := false; Result.IsModified := false; PropName := ''; PropSysName := ''; if ALoadNames then LoadPropNamesByID(Result.ID_Property, PropName, PropSysName); Result.Name_ := PropName; Result.SysName := PropSysName; { Result.ID := tSQL_CatalogPropRelation.FieldByName('ID').AsInteger; Result.IDMaster := tSQL_CatalogPropRelation.FieldByName(fnIDCatalog).AsInteger; Result.ID_Property := tSQL_CatalogPropRelation.FieldByName('ID_Property').AsInteger; Result.Value := tSQL_CatalogPropRelation.FieldByName('PValue').AsString; Result.IsDefault := tSQL_CatalogPropRelation.FieldByName(fnIsDefault).AsInteger; Result.GUIDProperty := tSQL_CatalogPropRelation.FieldByName(fnGUIDProperty).AsString; //Result.TakeIntoConnect := tSQL_CatalogPropRelation.FieldByName('TAKE_INTO_CONNECT').AsInteger; //Result.TakeIntoJoin := tSQL_CatalogPropRelation.FieldByName('TAKE_INTO_JOIN').AsInteger; Result.IsNew := false; Result.IsModified := false; PropName := ''; PropSysName := ''; if ALoadNames then LoadPropNamesByID(Result.ID_Property, PropName, PropSysName); Result.Name := PropName; Result.SysName := PropSysName; } except on E: Exception do AddExceptionToLog('TDM.GetCatalogPropertyFromMemTable: '+E.Message); end; end; function TDM.GetComponPropertyFromMemTable(ALoadNames: Boolean; AStringsMan: TStringsMan): PProperty; var PropName: String; PropSysName: String; begin Result := nil; //16.10.2007 GetMem(Result, SizeOf(TProperty)); New(Result); ZeroMemory(Result, SizeOf(TProperty)); try if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin Result.Value := tSQL_CompPropRelation.Fields[fiCompPropRel_PValue].AsString; Result.GUIDProperty := tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDProperty].AsString; if fiCompPropRel_GUIDCrossProperty <> -1 then Result.GUIDCrossProperty := tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDCrossProperty].AsString; end else begin Result.Value := AStringsMan.GetStrByID(tSQL_CompPropRelation.Fields[fiCompPropRel_PValue].AsInteger, AStringsMan.PropertyValueStrings); Result.GUIDProperty := AStringsMan.GetStrByID(tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDProperty].AsInteger, AStringsMan.PropertyGUIDStrings); if fiCompPropRel_GUIDCrossProperty <> -1 then Result.GUIDCrossProperty := AStringsMan.GetStrByID(tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDCrossProperty].AsInteger, AStringsMan.PropertyGUIDStrings); end; Result.ID := tSQL_CompPropRelation.Fields[fiCompPropRel_ID].AsInteger; Result.IDMaster := tSQL_CompPropRelation.Fields[fiCompPropRel_IDComponent].AsInteger; Result.ID_Property := tSQL_CompPropRelation.Fields[fiCompPropRel_IDProperty].AsInteger; Result.TakeIntoConnect := tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoConnect].AsInteger; Result.TakeIntoJoin := tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoJoin].AsInteger; if fiCompPropRel_IsTakeJoinForPoints <> -1 then Result.IsTakeJoinforPoint := tSQL_CompPropRelation.Fields[fiCompPropRel_IsTakeJoinForPoints].AsInteger; if fiCompPropRel_IsCrossControl <> -1 then Result.IsCrossControl := tSQL_CompPropRelation.Fields[fiCompPropRel_IsCrossControl].AsInteger; if fiCompPropRel_IDCrossProperty <> -1 then Result.IDCrossProperty := tSQL_CompPropRelation.Fields[fiCompPropRel_IDCrossProperty].AsInteger; Result.IsDefault := tSQL_CompPropRelation.Fields[fiCompPropRel_IsDefault].AsInteger; Result.IsNew := false; Result.IsModified := false; PropName := ''; PropSysName := ''; if ALoadNames then LoadPropNamesByID(Result.ID_Property, PropName, PropSysName); Result.Name_ := PropName; Result.SysName := PropSysName; { Result.ID := tSQL_CompPropRelation.FieldByName('ID').AsInteger; Result.IDMaster := tSQL_CompPropRelation.FieldByName(fnIDComponent).AsInteger; Result.ID_Property := tSQL_CompPropRelation.FieldByName('ID_Property').AsInteger; Result.TakeIntoConnect := tSQL_CompPropRelation.FieldByName('TAKE_INTO_CONNECT').AsInteger; Result.TakeIntoJoin := tSQL_CompPropRelation.FieldByName(fnTakeIntoJoin).AsInteger; if tSQL_CompPropRelation.FieldDefs.IndexOf(fnIsTakeJoinForPoints) <> -1 then Result.IsTakeJoinforPoint := tSQL_CompPropRelation.FieldByName(fnIsTakeJoinForPoints).AsInteger; if tSQL_CompPropRelation.FieldDefs.IndexOf(fnIsCrossControl) <> -1 then Result.IsCrossControl := tSQL_CompPropRelation.FieldByName(fnIsCrossControl).AsInteger; if tSQL_CompPropRelation.FieldDefs.IndexOf(fnIDCrossProperty) <> -1 then Result.IDCrossProperty := tSQL_CompPropRelation.FieldByName(fnIDCrossProperty).AsInteger; if tSQL_CompPropRelation.FieldDefs.IndexOf(fnGuidCrossProperty) <> -1 then Result.GUIDCrossProperty := tSQL_CompPropRelation.FieldByName(fnGuidCrossProperty).AsString; Result.Value := tSQL_CompPropRelation.FieldByName('PValue').AsString; Result.IsDefault := tSQL_CompPropRelation.FieldByName(fnIsDefault).AsInteger; Result.GUIDProperty := tSQL_CompPropRelation.FieldByName(fnGUIDProperty).AsString; Result.IsNew := false; Result.IsModified := false; PropName := ''; PropSysName := ''; if ALoadNames then LoadPropNamesByID(Result.ID_Property, PropName, PropSysName); Result.Name := PropName; Result.SysName := PropSysName; } //with F_NormBase.DM do //begin // SetSQLToQuery(scsQSelect, ' select name, sysname from properties '+ // ' where id = '''+IntToStr(Result.ID_Property)+''''); // Result.Name := scsQSelect.GetFNAsString(fnName); // Result.SysName := scsQSelect.GetFNAsString(fnSysName); //end; except on E: Exception do AddExceptionToLog('TDM.GetComponPropertyFromMemTable: '+E.Message); end; end; procedure TDM.LoadPropNamesByID(AIDProperty: Integer; var AName, ASysName: String); begin AName := ''; ASysName := ''; with F_NormBase.DM do begin SetSQLToQuery(scsQSelect, ' select name, sysname from properties '+ ' where id = '''+IntToStr(AIDProperty)+''''); AName := scsQSelect.GetFNAsString(fnName); ASysName := scsQSelect.GetFNAsString(fnSysName); end; end; procedure TDM.RemovePropertyFromComponents(AIDProperty: Integer); begin SetSQlToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnCompPropRelation, fnIDProperty+' = '''+IntToStr(AIDProperty)+'''', nil, '')); end; procedure TDM.SaveCatalogPropertyToMemTable(AMakeEdit: TMakeEdit; AProperty: PProperty; AStringsMan: TStringsMan); begin try case AMakeEdit of meMake: begin tSQL_CatalogPropRelation.Append; tSQL_CatalogPropRelation.Fields[fiCatPropRel_ID].AsInteger := AProperty.ID; end; meEdit: begin tSQL_CatalogPropRelation.Filtered := false; if tSQL_CatalogPropRelation.Locate(fnID, AProperty.ID, []) then tSQL_CatalogPropRelation.Edit; end; end; if tSQL_CatalogPropRelation.State <> dsBrowse then begin tSQL_CatalogPropRelation.Fields[fiCatPropRel_IDCatalog].AsInteger := AProperty.IDMaster; tSQL_CatalogPropRelation.Fields[fiCatPropRel_IDProperty].AsInteger := AProperty.ID_Property; tSQL_CatalogPropRelation.Fields[fiCatPropRel_PValue].AsInteger := AStringsMan.GenStrID(AProperty.Value, AStringsMan.PropertyValueStrings); tSQL_CatalogPropRelation.Fields[fiCatPropRel_IsDefault].AsInteger := AProperty.IsDefault; tSQL_CatalogPropRelation.Fields[fiCatPropRel_GUIDProperty].AsInteger := AStringsMan.GenStrID(AProperty.GUIDProperty, AStringsMan.PropertyGUIDStrings); tSQL_CatalogPropRelation.Post; end; { case AMakeEdit of meMake: begin tSQL_CatalogPropRelation.Append; tSQL_CatalogPropRelation.FieldByName(fnID).AsInteger := AProperty.ID; end; meEdit: begin tSQL_CatalogPropRelation.Filtered := false; if tSQL_CatalogPropRelation.Locate(fnID, AProperty.ID, []) then tSQL_CatalogPropRelation.Edit; end; end; if tSQL_CatalogPropRelation.State <> dsBrowse then begin tSQL_CatalogPropRelation.FieldByName(fnIDCatalog).AsInteger := AProperty.IDMaster; tSQL_CatalogPropRelation.FieldByName(fnIDProperty).AsInteger := AProperty.ID_Property; tSQL_CatalogPropRelation.FieldByName(fnPValue).AsString := AProperty.Value; tSQL_CatalogPropRelation.FieldByName(fnIsDefault).AsInteger := AProperty.IsDefault; tSQL_CatalogPropRelation.FieldByName(fnGUIDProperty).AsString := AProperty.GUIDProperty; tSQL_CatalogPropRelation.Post; end; } except on E: Exception do AddExceptionToLog('TDM.SaveCatalogPropertyToMemTable: '+E.Message); end; end; procedure TDM.SaveComponPropertyToMemTable(AMakeEdit: TMakeEdit; AProperty: PProperty; AStringsMan: TStringsMan); begin try {tSQL_CompPropRelation.Append; tSQL_CompPropRelation.Fields[fiCompPropRel_ID].AsInteger := AProperty.ID; tSQL_CompPropRelation.Fields[fiCompPropRel_IDComponent].AsInteger := AProperty.IDMaster; tSQL_CompPropRelation.Fields[fiCompPropRel_IDProperty].AsInteger := AProperty.ID_Property; tSQL_CompPropRelation.Fields[fiCompPropRel_PValue].AsInteger := AStringsMan.GenStrID(AProperty.Value, AStringsMan.PropertyValueStrings); tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoConnect].AsInteger := AProperty.TakeIntoConnect; tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoJoin].AsInteger := AProperty.TakeIntoJoin; tSQL_CompPropRelation.Fields[fiCompPropRel_IsTakeJoinForPoints].AsInteger := AProperty.IsTakeJoinforPoint; tSQL_CompPropRelation.Fields[fiCompPropRel_IsCrossControl].AsInteger := AProperty.IsCrossControl; tSQL_CompPropRelation.Fields[fiCompPropRel_IDCrossProperty].AsInteger := AProperty.IDCrossProperty; tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDProperty].AsInteger := AStringsMan.GenStrID(AProperty.GUIDProperty, AStringsMan.PropertyGUIDStrings); tSQL_CompPropRelation.Fields[fiCompPropRel_GuidCrossProperty].AsInteger := AStringsMan.GenStrID(AProperty.GUIDCrossProperty, AStringsMan.PropertyGUIDStrings); tSQL_CompPropRelation.Post;} case AMakeEdit of meMake: begin tSQL_CompPropRelation.Append; tSQL_CompPropRelation.Fields[fiCompPropRel_ID].AsInteger := AProperty.ID; end; meEdit: begin tSQL_CompPropRelation.Filtered := false; if tSQL_CompPropRelation.Locate(fnID, AProperty.ID, []) then tSQL_CompPropRelation.Edit; end; end; if tSQL_CompPropRelation.State <> dsBrowse then begin tSQL_CompPropRelation.Fields[fiCompPropRel_IDComponent].AsInteger := AProperty.IDMaster; tSQL_CompPropRelation.Fields[fiCompPropRel_IDProperty].AsInteger := AProperty.ID_Property; tSQL_CompPropRelation.Fields[fiCompPropRel_PValue].AsInteger := AStringsMan.GenStrID(AProperty.Value, AStringsMan.PropertyValueStrings); tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoConnect].AsInteger := AProperty.TakeIntoConnect; tSQL_CompPropRelation.Fields[fiCompPropRel_TakeIntoJoin].AsInteger := AProperty.TakeIntoJoin; tSQL_CompPropRelation.Fields[fiCompPropRel_IsTakeJoinForPoints].AsInteger := AProperty.IsTakeJoinforPoint; tSQL_CompPropRelation.Fields[fiCompPropRel_IsCrossControl].AsInteger := AProperty.IsCrossControl; tSQL_CompPropRelation.Fields[fiCompPropRel_IDCrossProperty].AsInteger := AProperty.IDCrossProperty; tSQL_CompPropRelation.Fields[fiCompPropRel_GUIDProperty].AsInteger := AStringsMan.GenStrID(AProperty.GUIDProperty, AStringsMan.PropertyGUIDStrings); tSQL_CompPropRelation.Fields[fiCompPropRel_GuidCrossProperty].AsInteger := AStringsMan.GenStrID(AProperty.GUIDCrossProperty, AStringsMan.PropertyGUIDStrings); tSQL_CompPropRelation.Post; end; except on E: Exception do AddExceptionToLog('TDM.SaveComponPropertyToMemTable: '+E.Message); end; end; procedure TDM.DeleteCompRelByID(AIDCompRel: Integer); begin //DeleteCompRelByFilter(fnID+' = '''+IntToStr(AIDCompRel)+''''); case TF_Main(GForm).GDBMode of bkNormBase: begin DeleteRecordFromTableByID(tnComponentRelation, AIDCompRel, qmPhisical); end; bkProjectManager: begin tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.Locate(fnID, AIDCompRel, []) then tSQL_ComponentRelation.Delete; end; end; end; procedure TDM.UpdateCompRelFieldAsInteger(AID, AValue: Integer; AFieldName: String); var strFilter: String; begin strFilter := 'id = '''+IntTostr(AID)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'update component_relation set '+AFieldName+' = '''+IntTostr(AValue)+''' where '+strFilter); scsQOperat.Close; end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_ComponentRelation, strFilter) then if Not tSQL_ComponentRelation.Eof then begin tSQL_ComponentRelation.Edit; tSQL_ComponentRelation.FieldByName(AFieldName).AsInteger := AValue; tSQL_ComponentRelation.Post; end;} end; end; end; function TDM.GetCompRelByID(AIDCompRel: Integer): TComplect; var StrFilter: string; ptrCompRel: PComplect; begin ZeroMemory(@Result, SizeOF(TComplect)); StrFilter := 'id = '''+IntToStr(AIDCompRel)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select * from '+tnComponentRelation+' where '+StrFilter); Result.ID := scsQSelect.GetFNAsInteger(fnID); Result.ID_Component := scsQSelect.GetFNAsInteger(fnIDComponent); Result.ID_Child := scsQSelect.GetFNAsInteger(fnIDChild); Result.Kolvo := scsQSelect.GetFNAsInteger(fnKolvo); Result.SortID := scsQSelect.GetFNAsInteger(fnSortID); Result.ConnectType := scsQSelect.GetFNAsInteger(fnConnectType); scsQSelect.Close; end; bkProjectManager: begin ptrCompRel := TF_Main(GForm).GSCSBase.CurrProject.GetCompRelByID(AIDCompRel); if ptrCompRel <> nil then Result := ptrCompRel^; //if SetFilterToSQLMemTable(tSQL_ComponentRelation, strFilter) then //if Not tSQL_ComponentRelation.Eof then {tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.Locate(fnID, AIDCompRel, []) then begin Result.ID := tSQL_ComponentRelation.FieldByName(fnID).AsInteger; Result.ID_Component := tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger; Result.ID_Child := tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger; Result.Kolvo := tSQL_ComponentRelation.FieldByName(fnKolvo).AsInteger; Result.SortID := tSQL_ComponentRelation.FieldByName(fnSortID).AsInteger; Result.ConnectType := tSQL_ComponentRelation.FieldByName(fnConnectType).AsInteger; end;} end; end; end; function TDM.GetCompRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select '+AFieldName+' from component_relation where '+AFilter); Result := scsQSelect.GetFNAsInteger(AFieldName); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_ComponentRelation, AFilter) then // if Not tSQL_ComponentRelation.Eof then // Result := tSQL_ComponentRelation.FieldByName(AFieldName).AsInteger; end; end; end; function TDM.GetCompRelFieldValueListByFilter(AFieldName, AFilter: String): TList; begin Result := nil; Result := TList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, AFilter); IntFieldToList(Result, scsQSelect, AFieldName); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_ComponentRelation, AFilter) then // IntFieldToListFromSQLMemTable(Result, tSQL_ComponentRelation, AFieldName); end; end; end; function TDM.GetCompRelMaxFieldValueByFilter(AFieldName, AFilter: String): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select MAX('+AFieldName+') from component_relation where '+AFilter); Result := scsQSelect.GetFNAsInteger(fnMax); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_ComponentRelation, AFilter) then // Result := GetMaxRecValueFromSQLMemTable(tSQL_ComponentRelation, AFieldName); end; end; end; function TDM.HaveCompRelConnectingWithMultipleInterfaces(AIDCompRel: Integer; aIOfIRelList: TList): Boolean; var IOfIRelList: TList; i: Integer; IOfIRel: TSCSIOfIRel; SCSInterface: TSCSInterface; begin Result := false; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select count(interface_relation.id) from interface_relation, interfofinterf_relation '+ ' where (multiple = '''+IntToStr(biTrue)+''') and '+ ' (typei = '''+IntToStr(itFunctional)+''') and '+ ' (isbusy = '''+IntToStr(biTrue)+''') and '+ ' (id_comp_rel = '''+IntToStr(AIDCompRel)+''') and '+ ' ((interface_relation.id = id_interf_rel) or '+ ' (interface_relation.id = id_interf_to)) '); if scsQSelect.GetFNAsInteger(fnCount) > 0 then Result := true; end; bkProjectManager: begin IOfIRelList := aIOfIRelList; if IOfIRelList = nil then IOfIRelList := TF_Main(GForm).GSCSBase.CurrProject.GetIOfIRelsByIDCompRel(AIDCompRel); if Assigned(IOfIRelList) then begin try for i := 0 to IOfIRelList.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRelList[i]); if IOfIRel <> nil then if Assigned(IOfIRel.InterfaceOwner) then if (IOfIRel.InterfaceOwner.Multiple = biTrue) and (IOfIRel.InterfaceOwner.IsBusy = biTrue) and (IOfIRel.InterfaceOwner.TypeI = itFunctional) then begin Result := true; Break; ///// BREAK ///// end; end; finally if aIOfIRelList = nil then IOfIRelList.Free; end; end; {if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, 'id_comp_rel = '''+IntToStr(AIDCompRel)+'''') then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin if SetFilterToSQLMemTable(tSQL_InterfaceRelation, '(id = '''+IntTostr(tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger)+''') or'+ ' (id = '''+IntTostr(tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger)+''')') then while Not tSQL_InterfaceRelation.Eof do begin if (tSQL_InterfaceRelation.FieldByName(fnMultiple).AsInteger = biTrue) and (tSQL_InterfaceRelation.FieldByName(fnIsBusy).AsInteger = biTrue) and (tSQL_InterfaceRelation.FieldByName(fnTypeI).AsInteger = itFunctional) then begin Result := true; Exit; ///// EXIT ///// end; tSQL_InterfaceRelation.Next; end; tSQL_InterfOfInterfRelation.Next; end; end;} end; end; end; { function TDM.GetJoinComponents(AComponent: TSCSComponent): TSCSComponents; var strFilter: String; i: Integer; IDJoinCompon: Integer; JoinedCompon: TSCSComponent; begin Result := nil; if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// Result := TSCSComponents.Create(false); strFilter := '((id_child = '''+IntToStr(AComponent.ID)+''') or (id_component = '''+IntToStr(AComponent.ID)+''')) and (connect_type = '''+IntToStr(cntUnion)+''')'; SetFilterToSQLMemTable(tSQL_ComponentRelation, strFilter); for i := 0 to tSQL_ComponentRelation.RecordCount - 1 do begin tSQL_ComponentRelation.RecNo := i+1; IDJoinCompon := -1; if tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger <> AComponent.ID then IDJoinCompon := tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger; if tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger <> AComponent.ID then IDJoinCompon := tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger; if IDJoinCompon <> -1 then begin JoinedCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(IDJoinCompon); if Assigned(JoinedCompon) then Result.Add(JoinedCompon); end; end; end; } procedure TDM.DefineIDComponAndIDChild(var AIDCompRel, AIDComponent, AIDChild: Integer); var strFilter: String; begin strFilter := '(('+fnIDComponent+' = '''+IntTostr(AIDComponent)+''') and ('+ fnIDChild+' = '''+IntTostr(AIDChild)+''')) or '+ '(('+fnIDChild+' = '''+IntTostr(AIDComponent)+''') and ('+ fnIDComponent+' = '''+IntTostr(AIDChild)+'''))'; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select '+fnID+', '+fnIDComponent+', '+fnIDChild+' from '+tnComponentRelation+ ' where '+strFilter); if Not scsQSelect.Eof then begin AIDCompRel := scsQSelect.GetFNAsInteger(fnID); AIDComponent := scsQSelect.GetFNAsInteger(fnIDComponent); AIDChild := scsQSelect.GetFNAsInteger(fnIDChild); end; end; bkProjectManager: begin {SetFilterToSQLMemTable(tSQL_ComponentRelation, strFilter); if tSQL_ComponentRelation.RecordCount > 0 then begin AIDCompRel := tSQL_ComponentRelation.FieldByName(fnID).AsInteger; AIDComponent := tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger; AIDChild := tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger; end;} end; end; end; function TDM.GetCompRelFromMemTable: PComplect; begin GetMem(Result, SizeOf(TComplect)); try Result.ID := tSQL_ComponentRelation.Fields[fiCompRel_ID].AsInteger; Result.ID_Component := tSQL_ComponentRelation.Fields[fiCompRel_IDComponent].AsInteger; Result.ID_Child := tSQL_ComponentRelation.Fields[fiCompRel_IDChild].AsInteger; Result.Kolvo := tSQL_ComponentRelation.Fields[fiCompRel_Kolvo].AsInteger; Result.ConnectType := tSQL_ComponentRelation.Fields[fiCompRel_ConnectType].AsInteger; Result.SortID := tSQL_ComponentRelation.Fields[fiCompRel_SortID].AsInteger; if fiCompRel_RelType <> -1 then Result.RelType := tSQL_ComponentRelation.Fields[fiCompRel_RelType].AsInteger else if Result.ConnectType = cntUnion then Result.RelType := crtDirect else Result.RelType := 0; if fiCompRel_Fixed <> -1 then Result.Fixed := tSQL_ComponentRelation.Fields[fiCompRel_Fixed].AsInteger else Result.Fixed := biFalse; Result.ID_NewChild := 0; Result.ID_NewComponent := 0; { Result.ID := tSQL_ComponentRelation.FieldByName(fnID).AsInteger; Result.ID_Component := tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger; Result.ID_Child := tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger; Result.Kolvo := tSQL_ComponentRelation.FieldByName(fnKolvo).AsInteger; Result.ConnectType := tSQL_ComponentRelation.FieldByName(fnConnectType).AsInteger; Result.SortID := tSQL_ComponentRelation.FieldByName(fnSortID).AsInteger; Result.ID_NewChild := 0; Result.ID_NewComponent := 0; } except on E: Exception do AddExceptionToLog('TDM.GetCompRelFromMemTable: '+E.Message); end; end; procedure TDM.SaveCompRelToMemTable(AMakeEdit: TMakeEdit; AComplect: PComplect); begin try {case AMakeEdit of meMake: begin tSQL_ComponentRelation.Append; tSQL_ComponentRelation.FieldByName(fnID).AsInteger := AComplect.ID; end; meEdit: begin tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.Locate(fnID, AComplect.ID, []) then tSQL_ComponentRelation.Edit; end; end; if tSQL_ComponentRelation.State <> dsBrowse then begin tSQL_ComponentRelation.FieldByName(fnIDComponent).AsInteger := AComplect.ID_Component; tSQL_ComponentRelation.FieldByName(fnIDChild).AsInteger := AComplect.ID_Child; tSQL_ComponentRelation.FieldByName(fnKolvo).AsInteger := AComplect.Kolvo; tSQL_ComponentRelation.FieldByName(fnConnectType).AsInteger := AComplect.ConnectType; tSQL_ComponentRelation.FieldByName(fnSortID).AsInteger := AComplect.SortID; tSQL_ComponentRelation.Post; end;} case AMakeEdit of meMake: begin tSQL_ComponentRelation.Append; tSQL_ComponentRelation.Fields[fiCompRel_ID].AsInteger := AComplect.ID; end; meEdit: begin tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.Locate(fnID, AComplect.ID, []) then tSQL_ComponentRelation.Edit; end; end; if tSQL_ComponentRelation.State <> dsBrowse then begin tSQL_ComponentRelation.Fields[fiCompRel_IDComponent].AsInteger := AComplect.ID_Component; tSQL_ComponentRelation.Fields[fiCompRel_IDChild].AsInteger := AComplect.ID_Child; tSQL_ComponentRelation.Fields[fiCompRel_Kolvo].AsInteger := AComplect.Kolvo; tSQL_ComponentRelation.Fields[fiCompRel_ConnectType].AsInteger := AComplect.ConnectType; tSQL_ComponentRelation.Fields[fiCompRel_SortID].AsInteger := AComplect.SortID; tSQL_ComponentRelation.Fields[fiCompRel_RelType].AsInteger := AComplect.RelType; tSQL_ComponentRelation.Fields[fiCompRel_Fixed].AsInteger := AComplect.Fixed; tSQL_ComponentRelation.Post; end; except on E: Exception do AddExceptionToLog('TDM.SaveCompRelToMemTable: '+E.Message); end; end; procedure TDM.InsertToConnCompons(AComponWholeID, AIDConnectedObject, AIDConnectedCompon, AIDSideCompon, ATypeConnect: Integer); begin if TF_Main(GForm).GDBMode = bkProjectManager then begin tSQL_ConnectedComponents.Append; tSQL_ConnectedComponents.FieldByName(fnComponWholeID).AsInteger := AComponWholeID; tSQL_ConnectedComponents.FieldByName(fnIDConnectObject).AsInteger := AIDConnectedObject; tSQL_ConnectedComponents.FieldByName(fnIDConnectCompon).AsInteger := AIDConnectedCompon; tSQL_ConnectedComponents.FieldByName(fnIDSideCompon).AsInteger := AIDSideCompon; tSQL_ConnectedComponents.FieldByName(fnTypeConnect).AsInteger := ATypeConnect; tSQL_ConnectedComponents.Post; end; end; function TDM.GetConnectedComponsInfoFromMemTable: TConnectedComponsInfo; begin try //GetMem(Result, SizeOf(TConnectedComponsInfo)); ZeroMemory(@Result, SizeOf(TConnectedComponsInfo)); Result.ID := tSQL_ConnectedComponents.Fields[fiConnctCompons_ID].AsInteger; Result.ComponWholeID := tSQL_ConnectedComponents.Fields[fiConnctCompons_ComponWholeID].AsInteger; Result.IDConnectObject := tSQL_ConnectedComponents.Fields[fiConnctCompons_IDConnectObject].AsInteger; Result.IDConnectCompon := tSQL_ConnectedComponents.Fields[fiConnctCompons_IDConnectCompon].AsInteger; Result.IDSideCompon := tSQL_ConnectedComponents.Fields[fiConnctCompons_IDSideCompon].AsInteger; Result.TypeConnect := tSQL_ConnectedComponents.Fields[fiConnctCompons_TypeConnect].AsInteger; { Result.ID := tSQL_ConnectedComponents.FieldByName(fnID).AsInteger; Result.ComponWholeID := tSQL_ConnectedComponents.FieldByName(fnComponWholeID).AsInteger; Result.IDConnectObject := tSQL_ConnectedComponents.FieldByName(fnIDConnectObject).AsInteger; Result.IDConnectCompon := tSQL_ConnectedComponents.FieldByName(fnIDConnectCompon).AsInteger; Result.IDSideCompon := tSQL_ConnectedComponents.FieldByName(fnIDSideCompon).AsInteger; Result.TypeConnect := tSQL_ConnectedComponents.FieldByName(fnTypeConnect).AsInteger; } except on E: Exception do AddExceptionToLog('TDM.GetConnectedComponsInfoFromMemTable: '+E.Message); end; end; procedure TDM.SaveConnectedComponsInfoToMemTable(AMakeEdit: TMakeEdit; AConnectedComponsInfo: TConnectedComponsInfo); begin try //if AConnectedComponsInfo <> nil then begin case AMakeEdit of meMake: begin tSQL_ConnectedComponents.Append; tSQL_ConnectedComponents.Fields[fiConnctCompons_ID].AsInteger := AConnectedComponsInfo.ID; end; meEdit: begin tSQL_ConnectedComponents.Filtered := false; if tSQL_ConnectedComponents.Locate(fnID, AConnectedComponsInfo.ID, []) then tSQL_ConnectedComponents.Edit; end; end; if tSQL_ConnectedComponents.State <> dsBrowse then begin tSQL_ConnectedComponents.Fields[fiConnctCompons_ComponWholeID].AsInteger := AConnectedComponsInfo.ComponWholeID; tSQL_ConnectedComponents.Fields[fiConnctCompons_IDConnectObject].AsInteger := AConnectedComponsInfo.IDConnectObject; tSQL_ConnectedComponents.Fields[fiConnctCompons_IDConnectCompon].AsInteger := AConnectedComponsInfo.IDConnectCompon; tSQL_ConnectedComponents.Fields[fiConnctCompons_IDSideCompon].AsInteger := AConnectedComponsInfo.IDSideCompon; tSQL_ConnectedComponents.Fields[fiConnctCompons_TypeConnect].AsInteger := AConnectedComponsInfo.TypeConnect; tSQL_ConnectedComponents.Post; end; { case AMakeEdit of meMake: begin tSQL_ConnectedComponents.Append; tSQL_ConnectedComponents.FieldByName(fnID).AsInteger := AConnectedComponsInfo.ID; end; meEdit: begin tSQL_ConnectedComponents.Filtered := false; if tSQL_ConnectedComponents.Locate(fnID, AConnectedComponsInfo.ID, []) then tSQL_ConnectedComponents.Edit; end; end; if tSQL_ConnectedComponents.State <> dsBrowse then begin tSQL_ConnectedComponents.FieldByName(fnComponWholeID).AsInteger := AConnectedComponsInfo.ComponWholeID; tSQL_ConnectedComponents.FieldByName(fnIDConnectObject).AsInteger := AConnectedComponsInfo.IDConnectObject; tSQL_ConnectedComponents.FieldByName(fnIDConnectCompon).AsInteger := AConnectedComponsInfo.IDConnectCompon; tSQL_ConnectedComponents.FieldByName(fnIDSideCompon).AsInteger := AConnectedComponsInfo.IDSideCompon; tSQL_ConnectedComponents.FieldByName(fnTypeConnect).AsInteger := AConnectedComponsInfo.TypeConnect; tSQL_ConnectedComponents.Post; end; } end; except on E: Exception do AddExceptionToLog('TDM.SaveConnectedComponsInfoToMemTable: '+E.Message); end; end; procedure TDM.DeleteCrossConnection(AID: Integer); begin DeleteRecordFromTableByID(tnCrossConnection, AID, qmPhisical); end; procedure TDM.AddNBConnectionToMemTable(AMemTable: TkbmMemTable; AIDTopCompon, AIDComplect: Integer; ANBConnection: TSCSCrossConnection); begin AMemTable.Append; AMemTable.FieldByName(fnID).AsInteger := ANBConnection.ID; AMemTable.FieldByName(fnIDComponent).AsInteger := ANBConnection.IDComponent; AMemTable.FieldByName(fnIDChild).AsInteger := 0; AMemTable.FieldByName(fnIDJoined).AsInteger := 0; AMemTable.FieldByName(fnIDCompRelFrom).AsInteger := ANBConnection.IDCompRelFrom; AMemTable.FieldByName(fnIDCompRelTo).AsInteger := ANBConnection.IDCompRelTo; if ANBConnection.IDComponFrom = AIDComplect then AMemTable.FieldByName(fnName).AsString := ANBConnection.NameTo else if ANBConnection.IDComponTo = AIDComplect then AMemTable.FieldByName(fnName).AsString := ANBConnection.NameFrom; AMemTable.FieldByName(fnIsNative).AsBoolean := AIDTopCompon = ANBConnection.IDComponent; AMemTable.Post; end; { function TDM.GetCrossConnectionFromQuery(AQuery: TpFIBQuery): PCrossConnection; begin GetZeroMem(Result, SizeOf(TCrossConnection)); Result.ID := AQuery.FN(fnID).AsInteger; Result.IDComponent := AQuery.FN(fnIDComponent).AsInteger; Result.IDCompRelFrom := AQuery.FN(fnIDCompRelFrom).AsInteger; Result.IDCompRelTo := AQuery.FN(fnIDCompRelTo).AsInteger; Result.IDCompRelWith := AQuery.FN(fnIDCompRelWith).AsInteger; Result.NppFrom := AQuery.FN(fnNppFrom).AsInteger; Result.NppTo := AQuery.FN(fnNppTo).AsInteger; Result.NppWith := AQuery.FN(fnNppWith).AsInteger; end; } procedure TDM.LoadCrossConnectionToMemTable(AMakeEdit: TMakeEdit; ADestMemTable: TkbmMemTable; ACrossConnection: TSCSCrossConnection); begin case AMakeEdit of meMake: begin ADestMemTable.Append; if ADestMemTable.FieldDefs.IndexOf(fnIsNew) <> -1 then ADestMemTable.FieldByName(fnIsNew).AsBoolean := true; end; meEdit: begin ADestMemTable.Edit; if ADestMemTable.FieldDefs.IndexOf(fnIsModified) <> -1 then ADestMemTable.FieldByName(fnIsModified).AsBoolean := true; end; end; if ADestMemTable.State <> dsBrowse then begin ADestMemTable.FieldByName(fnID).AsInteger := ACrossConnection.ID; ADestMemTable.FieldByName(fnIDComponent).AsInteger := ACrossConnection.IDComponent; ADestMemTable.FieldByName(fnIDComponFrom).AsInteger := ACrossConnection.IDComponFrom; ADestMemTable.FieldByName(fnIDComponTo).AsInteger := ACrossConnection.IDComponTo; ADestMemTable.FieldByName(fnIDComponWith).AsInteger := ACrossConnection.IDComponWith; ADestMemTable.FieldByName(fnIDCompRelFrom).AsInteger := ACrossConnection.IDCompRelFrom; ADestMemTable.FieldByName(fnIDCompRelTo).AsInteger := ACrossConnection.IDCompRelTo; ADestMemTable.FieldByName(fnIDCompRelWith).AsInteger := ACrossConnection.IDCompRelWith; ADestMemTable.FieldByName(fnNameFrom).AsString := ACrossConnection.NameFrom; ADestMemTable.FieldByName(fnNameTo).AsString := ACrossConnection.NameTo; ADestMemTable.FieldByName(fnNameWith).AsString := ACrossConnection.NameWith; ADestMemTable.FieldByName(fnNppFrom).AsInteger := ACrossConnection.NppFrom; ADestMemTable.FieldByName(fnNppTo).AsInteger := ACrossConnection.NppTo; ADestMemTable.FieldByName(fnNppWith).AsInteger := ACrossConnection.NppWith; ADestMemTable.Post; end; end; procedure TDM.LoadCrossConnectionFromMemTable(ASrcMemTable: TkbmMemTable; ADestCrossConnection: TSCSCrossConnection); begin if ADestCrossConnection <> nil then begin ADestCrossConnection.ID := ASrcMemTable.FieldByName(fnID).AsInteger; ADestCrossConnection.IDComponent := ASrcMemTable.FieldByName(fnIDComponent).AsInteger; ADestCrossConnection.IDCompRelFrom := ASrcMemTable.FieldByName(fnIDCompRelFrom).AsInteger; ADestCrossConnection.IDCompRelTo := ASrcMemTable.FieldByName(fnIDCompRelTo).AsInteger; ADestCrossConnection.IDCompRelWith := ASrcMemTable.FieldByName(fnIDCompRelWith).AsInteger; ADestCrossConnection.IDComponFrom := ASrcMemTable.FieldByName(fnIDComponFrom).AsInteger; ADestCrossConnection.IDComponTo := ASrcMemTable.FieldByName(fnIDComponTo).AsInteger; ADestCrossConnection.IDComponWith := ASrcMemTable.FieldByName(fnIDComponWith).AsInteger; ADestCrossConnection.NameFrom := ASrcMemTable.FieldByName(fnNameFrom).AsString; ADestCrossConnection.NameTo := ASrcMemTable.FieldByName(fnNameTo).AsString; ADestCrossConnection.NameWith := ASrcMemTable.FieldByName(fnNameWith).AsString; ADestCrossConnection.NppFrom := ASrcMemTable.FieldByName(fnNppFrom).AsInteger; ADestCrossConnection.NppTo := ASrcMemTable.FieldByName(fnNppTo).AsInteger; ADestCrossConnection.NppWith := ASrcMemTable.FieldByName(fnNppWith).AsInteger; ADestCrossConnection.IsNew := false; ADestCrossConnection.IsModified := false; if ASrcMemTable.FieldDefs.IndexOf(fnIsNew) <> -1 then ADestCrossConnection.IsNew := ASrcMemTable.FieldByName(fnIsNew).AsBoolean; if ASrcMemTable.FieldDefs.IndexOf(fnIsModified) <> -1 then ADestCrossConnection.IsModified := ASrcMemTable.FieldByName(fnIsModified).AsBoolean; end; end; procedure TDM.LoadCrossConnectionsNames(ACrossConnections: TSCSObjectList); var i: Integer; ptrCrossConnection: TSCSCrossConnection; IsHaveZeroID: Boolean; procedure LoadIDNameFromQuery(AIDCompRel: Integer; var AIDChild: Integer; var AName: String); begin Query_Select.Close; Query_Select.ParamByName(fnIDCompRel).AsInteger := AIDCompRel; Query_Select.ExecQuery; AIDChild := Query_Select.FN(fnID).AsInteger; AName := Query_Select.FN(fnName).AsString; Query_Select.Close; end; begin SetSQLToFIBQuery(Query_Select, 'select component.id, name from '+tnComponent+', '+tnComponentRelation +' '+ 'where ('+tnComponentRelation +'.id = :'+fnIDCompRel+') and (component.id = id_child)'); IsHaveZeroID := false; for i := 0 to ACrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(ACrossConnections[i]); with ptrCrossConnection do begin LoadIDNameFromQuery(IDCompRelFrom, IDComponFrom, NameFrom); LoadIDNameFromQuery(IDCompRelTo, IDComponTo, NameTo); LoadIDNameFromQuery(IDCompRelWith, IDComponWith, NameWith); if (IDCompRelFrom = 0) or (IDCompRelTo = 0) then IsHaveZeroID := true; end; end; // Если подключение к верхнему компоненту if IsHaveZeroID then begin SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, nil, fnName), false); for i := 0 to ACrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(ACrossConnections[i]); if (ptrCrossConnection.IDCompRelFrom = 0) or (ptrCrossConnection.IDCompRelTo = 0) then begin Query_Select.Close; Query_Select.ParamByName(fnID).AsInteger := ptrCrossConnection.IDComponent; Query_Select.ExecQuery; if ptrCrossConnection.IDCompRelFrom = 0 then begin ptrCrossConnection.NameFrom := Query_Select.FN(fnName).AsString; ptrCrossConnection.IDComponFrom := ptrCrossConnection.IDComponent; end else if ptrCrossConnection.IDCompRelTo = 0 then begin ptrCrossConnection.NameFrom := Query_Select.FN(fnName).AsString; ptrCrossConnection.IDComponTo := ptrCrossConnection.IDComponent; end; end; end; end; end; procedure TDM.LoadCrossConnectionsPaths(ACrossConnections: TSCSObjectList); var i: Integer; CrossConnection: TSCSCrossConnection; begin if ACrossConnections.Count > 0 then begin SetSQLToFIBQuery(Query_Select, 'select * from '+tnCrossConnectionPath+ ' where '+fnIDCrossConnection+' = :'+fnIDCrossConnection+ ' order by '+fnID, false); for i := 0 to ACrossConnections.Count - 1 do begin CrossConnection := TSCSCrossConnection(ACrossConnections[i]); Query_Select.Close; Query_Select.Params[0].AsInteger := CrossConnection.ID; Query_Select.ExecQuery; while Not Query_Select.Eof do begin case Query_Select.FN(fnPathType).AsInteger of ptFrom: CrossConnection.CompRelFromPath.Add(Query_Select.FN(fnIDCompRel).AsInteger); ptTo: CrossConnection.CompRelToPath.Add(Query_Select.FN(fnIDCompRel).AsInteger); ptWith: CrossConnection.CompRelWithPath.Add(Query_Select.FN(fnIDCompRel).AsInteger); end; Query_Select.Next; end; end; end; end; {procedure TDM.InsertUpdateCrossConnection(AMakeEdit: TMakeEdit; ACrossConnection: TSCSCrossConnection); var FieldNames: TStringList; begin FieldNames := TStringList.Create; try FieldNames.Add(fnIDComponent); FieldNames.Add(fnIDCompRelFrom); FieldNames.Add(fnIDCompRelTo); FieldNames.Add(fnIDCompRelWith); FieldNames.Add(fnNppFrom); FieldNames.Add(fnNppTo); FieldNames.Add(fnNppWith); case AMakeEdit of meMake: begin SQLBuilder(scsQOperat, qtInsert, tnCrossConnection, '', FieldNames, false); end; meEdit: begin FieldNames.Add(fnID); SQLBuilder(scsQOperat, qtUpdate, tnCrossConnection, 'id = :id', FieldNames, false); scsQOperat.SetParamAsInteger(fnID, ACrossConnection.ID); end; end; scsQOperat.SetParamAsInteger(fnIDComponent, ACrossConnection.IDComponent); scsQOperat.SetParamAsInteger(fnIDCompRelFrom, ACrossConnection.IDCompRelFrom); scsQOperat.SetParamAsInteger(fnIDCompRelTo, ACrossConnection.IDCompRelTo); scsQOperat.SetParamAsInteger0AsNull(fnIDCompRelWith, ACrossConnection.IDCompRelWith); scsQOperat.SetParamAsInteger(fnNppFrom, ACrossConnection.NppFrom); scsQOperat.SetParamAsInteger(fnNppTo, ACrossConnection.NppTo); scsQOperat.SetParamAsInteger(fnNppWith, ACrossConnection.NppWith); scsQOperat.ExecQuery; if AMakeEdit = meMake then ACrossConnection.ID := GenIDFromTable(Query_Select, gnCrossConnectionID, 0); finally FieldNames.Free; end; end;} function TDM.GetInterfName(AIDInterface: Integer): String; begin Result := ''; with TF_Main(GForm).FNormBase do begin //SetSQLToQuery(scsQSelect, 'select name from interface where id = '''+IntToStr(AIDInterface)+''''); //Result := scsQSelect.GetFNAsString(fnName); Result := GSCSBase.NBSpravochnik.GetInterfaceNameByID(AIDInterface); end; end; function TDM.GetInterfaceInfo(AIDInterfase: Integer): TInterfaceInfo; begin ZeroMemory(@Result, SizeOf(TInterfaceInfo)); if TF_Main(GForm).GDBMode = bkNormBase then begin SetSQLToFIBQuery(Query_Select, 'select * from interface where id = '''+IntToStr(AIDInterfase)+''''); Result.ID := Query_Select.FN(fnID).AsInteger; Result.Name := Query_Select.FN(fnName).AsString; Result.ConstructiveWidth := Query_Select.FN(fnConstructiveWidth).AsFloat; Result.IDNetType := Query_Select.FN(fnIDNetType).AsInteger; Result.Description := Query_Select.FN(fnDescription).AsString; Result.IsVisible := Query_Select.FN(fnDescription).AsInteger; end; end; procedure TDM.SaveInterface(AMakeEdit: TMakeEdit; AInterfaceInfo: PInterfaceInfo); var FieldNames: TStringList; begin if AInterfaceInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnIDNetType); FieldNames.Add(fnConstructiveWidth); FieldNames.Add(fnDescription); FieldNames.Add(fnIsVisible); FieldNames.Add(fnIsUniversal); case AMakeEdit of meMake: begin if AInterfaceInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnInterface, '', FieldNames, ''), false); if AInterfaceInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AInterfaceInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnInterface, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AInterfaceInfo.ID; end; end; Query_Operat.ParamByName(fnName).AsString := AInterfaceInfo.Name; SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDNetType, AInterfaceInfo.IDNetType); if AInterfaceInfo.ConstructiveWidth <> 0 then Query_Operat.ParamByName(fnConstructiveWidth).AsFloat := AInterfaceInfo.ConstructiveWidth else Query_Operat.ParamByName(fnConstructiveWidth).Value := null; Query_Operat.ParamByName(fnDescription).AsString := AInterfaceInfo.Description; Query_Operat.ParamByName(fnIsVisible).AsInteger := AInterfaceInfo.IsVisible; Query_Operat.ParamByName(fnIsUniversal).AsInteger := AInterfaceInfo.IsUniversal; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AInterfaceInfo.ID := GenIDFromTable(Query_Select, gnInterfaceID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.SaveInterfaceAccordance(AMakeEdit: TMakeEdit; AInterfaceAccordanceInfo: PInterfaceAccordanceInfo); var FieldNames: TStringList; begin if AInterfaceAccordanceInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDInterface); FieldNames.Add(fnInterfComponIsLine); FieldNames.Add(fnIDAccordance); FieldNames.Add(fnAccordComponIsLine); FieldNames.Add(fnKolvo); case AMakeEdit of meMake: begin if AInterfaceAccordanceInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnInterfaceAccordance, '', FieldNames, ''), false); if AInterfaceAccordanceInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AInterfaceAccordanceInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnInterfaceAccordance, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AInterfaceAccordanceInfo.ID; end; end; Query_Operat.ParamByName(fnIDInterface).AsInteger := AInterfaceAccordanceInfo.IDInterface; Query_Operat.ParamByName(fnInterfComponIsLine).AsInteger := AInterfaceAccordanceInfo.InterfComponIsLine; Query_Operat.ParamByName(fnIDAccordance).AsInteger := AInterfaceAccordanceInfo.IDAccordance; Query_Operat.ParamByName(fnAccordComponIsLine).AsInteger := AInterfaceAccordanceInfo.AccordComponIsLine; Query_Operat.ParamByName(fnKolvo).AsInteger := AInterfaceAccordanceInfo.Kolvo; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AInterfaceAccordanceInfo.ID := GenIDFromTable(Query_Select, gnInterfaceAccordanceID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.SaveInterfaceNorm(AMakeEdit: TMakeEDit; AInterfaceNormInfo: PInterfaceNormInfo); var FieldNames: TStringList; begin if AInterfaceNormInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnIDInterface); FieldNames.Add(fnIDNBNorm); FieldNames.Add(fnExpense); FieldNames.Add(fnIDComponentType); FieldNames.Add(fnInterfaceIsBusy); FieldNames.Add(fnKoefLengthForCompl); case AMakeEdit of meMake: begin if AInterfaceNormInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnInterfaceNorms, '', FieldNames, ''), false); if AInterfaceNormInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AInterfaceNormInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnInterfaceNorms, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AInterfaceNormInfo.ID; end; end; Query_Operat.ParamByName(fnIDInterface).AsInteger := AInterfaceNormInfo.IDInterface; Query_Operat.ParamByName(fnIDNBNorm).AsInteger := AInterfaceNormInfo.IDNBNorm; Query_Operat.ParamByName(fnExpense).AsFloat := AInterfaceNormInfo.Expense; SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDComponentType, AInterfaceNormInfo.IDComponentType); Query_Operat.ParamByName(fnInterfaceIsBusy).AsInteger := AInterfaceNormInfo.InterfaceIsBusy; Query_Operat.ParamByName(fnKoefLengthForCompl).AsFloat := AInterfaceNormInfo.KoefLengthForCompl; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AInterfaceNormInfo.ID := GenIDFromTable(Query_Select, gnInterfaceNormsID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.DefineInterfRelIDsForKolvo(AClearPrevios: Boolean; AInterfRelIDsForKolvo, AInterfRelKolvosForKolvo: TIntList; AmtPortInterfRel: TkbmMemTable); var i: Integer; PortInterfRelRecNo: Integer; begin if AClearPrevios then begin AInterfRelIDsForKolvo.Clear; AInterfRelKolvosForKolvo.Clear; end; if (AmtPortInterfRel <> nil) and (AmtPortInterfRel.RecordCount > 0) then begin PortInterfRelRecNo := AmtPortInterfRel.RecNo; try AmtPortInterfRel.First; while Not AmtPortInterfRel.Eof do begin if AInterfRelIDsForKolvo.IndexOf(AmtPortInterfRel.FieldByName(fnIDInterfRel).AsInteger) = -1 then begin AInterfRelIDsForKolvo.Add(AmtPortInterfRel.FieldByName(fnIDInterfRel).AsInteger); AInterfRelKolvosForKolvo.Add(AmtPortInterfRel.FieldByName(fnUnitInterfKolvo).AsInteger); end; AmtPortInterfRel.Next; end; finally AmtPortInterfRel.RecNo := PortInterfRelRecNo; end; end; end; procedure TDM.DefineInterfacesKolvoByPortKolvo(ANewPortKolvo: Integer; AmtPortInterfRel, AmtInterfaces: TkbmMemTable; AInterfRelIDsForKolvo, AInterfRelKolvosForKolvo: TIntList); var InterfRelRecNo: Integer; InterfKolvo: Integer; i: Integer; begin if (AmtPortInterfRel <> nil) and (AmtInterfaces <> nil) and (AmtInterfaces.RecordCount > 0) then begin //*** Доопределить интерфейсы и их количества //DefineInterfRelIDsForKolvo(false); InterfRelRecNo := AmtInterfaces.RecNo; try for i := 0 to AInterfRelIDsForKolvo.Count - 1 do begin InterfKolvo := AInterfRelKolvosForKolvo[i]; //*** Найти связь этого интерфейса в порте if (AmtPortInterfRel.Locate(fnIDInterfRel, AInterfRelIDsForKolvo[i], [])) and (ANewPortKolvo > 0) then InterfKolvo := InterfKolvo * ANewPortKolvo; //*** Найти сам интерфейс, и изменить его количество, если необходимо if AmtInterfaces.Locate(fnID, AInterfRelIDsForKolvo[i], []) then if AmtInterfaces.FieldByName(fnKolvo).AsInteger <> InterfKolvo then begin AmtInterfaces.Edit; AmtInterfaces.FieldByName(fnIsModified).AsBoolean := true; AmtInterfaces.FieldByName(fnKolvo).AsInteger := InterfKolvo; AmtInterfaces.Post; end; end; finally AmtInterfaces.RecNo := InterfRelRecNo; end; end; end; procedure TDM.DefineInterfaceNumPairs(AmtInterfaces: TkbmMemTable; AmeInterfaceRel: PmeInterfaceRel); var i: Integer; //Bookmark: TBookmarkStr; Bookmark: TBookmark; LastNumPair: Integer; CurrNumPair: Integer; NewNumPair: Integer; CurrInterfRelID: Integer; CurrInterfRelKolvo: Integer; AdverseIDs: TIntList; AdverveNumPairs: TIntList; IndexIDAdverse: Integer; begin if AmtInterfaces.Active then begin AdverseIDs := TIntList.Create; AdverveNumPairs := TIntList.Create; // Bookmark := AmtInterfaces.Bookmark; Bookmark := AmtInterfaces.getBookmark; AmtInterfaces.DisableControls; try LastNumPair := 0; //AmtInterfaces.SortOn(fnNumPair, []); AmtInterfaces.First; while Not AmtInterfaces.Eof do begin if AmtInterfaces.FieldByName(fnTypeI).AsInteger = itFunctional then begin NewNumPair := -1; CurrNumPair := AmtInterfaces.FieldByName(fnNumPair).AsInteger; CurrInterfRelID := AmtInterfaces.FieldByName(fnID).AsInteger; IndexIDAdverse := AdverseIDs.IndexOf(CurrInterfRelID); CurrInterfRelKolvo := 0; if Assigned(AmeInterfaceRel) and ((AmeInterfaceRel.ID = CurrInterfRelID) or (AmeInterfaceRel.ID_Adverse = CurrInterfRelID)) then CurrInterfRelKolvo := AmeInterfaceRel.Kolvo else CurrInterfRelKolvo := AmtInterfaces.FieldByName(fnKolvo).AsInteger; if IndexIDAdverse <> -1 then NewNumPair := AdverveNumPairs[IndexIDAdverse] else begin NewNumPair := LastNumPair + 1; LastNumPair := NewNumPair + (CurrInterfRelKolvo - 1); end; if NewNumPair <> -1 then begin if NewNumPair <> CurrNumPair then begin AmtInterfaces.Edit; AmtInterfaces.FieldByName(fnNumPair).AsInteger := NewNumPair; AmtInterfaces.FieldByName(fnIsModified).AsBoolean := true; DefineInterfaceNumPairsStr(AmtInterfaces, NewNumPair, CurrInterfRelKolvo); AmtInterfaces.Post; end else DefineInterfaceNumPairsStr(AmtInterfaces, NewNumPair, CurrInterfRelKolvo); if Assigned(AmeInterfaceRel) and (AmeInterfaceRel.ID = CurrInterfRelID) then AmeInterfaceRel.NumPair := NewNumPair; AdverseIDs.Add(AmtInterfaces.FieldByName(fnIDAdverse).AsInteger); AdverveNumPairs.Add(NewNumPair); end; end; AmtInterfaces.Next; end; AmtInterfaces.SortFields := ''; //AmtInterfaces.Bookmark := Bookmark; AmtInterfaces.GotoBookmark(Bookmark); AmtInterfaces.FreeBookmark(Bookmark); finally AmtInterfaces.EnableControls; FreeAndNil(AdverseIDs); FreeAndNil(AdverveNumPairs); end; end; end; procedure TDM.DefineInterfaceNumPairsStr(AmtInterfaces: TkbmMemTable; ANumPair, AKolvo: Integer); var IsEditing: Boolean; NumPair: Integer; Kolvo: Integer; begin if AmtInterfaces.Active then begin IsEditing := AmtInterfaces.State <> dsBrowse; if Not IsEditing then AmtInterfaces.Edit; NumPair := 0; if ANumPair > 0 then NumPair := ANumPair else NumPair := AmtInterfaces.FieldByName(fnNumPair).AsInteger; Kolvo := 0; if AKolvo > 0 then Kolvo := AKolvo else Kolvo := AmtInterfaces.FieldByName(fnKolvo).AsInteger; if Kolvo = 1 then AmtInterfaces.FieldByName(fnNumPairsStr).AsString := IntToStr(NumPair) else if Kolvo > 1 then AmtInterfaces.FieldByName(fnNumPairsStr).AsString := IntToStr(NumPair) +'-'+IntToStr(NumPair + (Kolvo - 1)); if Not IsEditing then AmtInterfaces.Post; end; end; procedure TDM.DeleteInterfInternalConnFromMTByInterfIDs(AmtInterfInternalConn: TkbmMemTable; AInterfIDs: TIntList); var SavedMasterSource: TDataSource; begin try SavedMasterSource := AmtInterfInternalConn.MasterSource; try AmtInterfInternalConn.MasterSource := nil; AmtInterfInternalConn.DisableControls; try AmtInterfInternalConn.Last; while Not AmtInterfInternalConn.Bof do begin if (AInterfIDs.IndexOf(AmtInterfInternalConn.FieldByName(fnIDInterfRel).AsInteger) <> -1) or (AInterfIDs.IndexOf(AmtInterfInternalConn.FieldByName(fnIDPort).AsInteger) <> -1) then begin AmtInterfInternalConn.Delete; end else AmtInterfInternalConn.Prior; end; finally AmtInterfInternalConn.EnableControls; end; finally AmtInterfInternalConn.MasterSource := SavedMasterSource; end; except on E: Exception do AddExceptionToLogEx('TDM.DeleteInterfInternalConnFromMTByInterfIDs', E.Message); end; end; procedure TDM.DeleteInterfRelByID(AIDInterfRel: Integer); var strFilter: String; begin strFilter := 'id = '''+IntToStr(AIDInterfRel)+''''; DeleteInterfRelByFilter(strFilter); end; procedure TDM.DeleteInterfRelByFilter(AFilter: String); begin case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' delete from interface_relation where '+AFilter); scsQOperat.Close; end; bkProjectManager: if FMemBaseActive then begin //tSQL_InterfOfInterfRelation.Filtered := false; //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, AFilter) then // while tSQL_InterfaceRelation.RecordCount > 0 do // tSQL_InterfaceRelation.Delete; end; end; end; procedure TDM.UpdateInterfFieldAsInteger(AIDInterfRel, AValue: Integer; AFieldName: String); begin case TF_MAIN(GForm).GDBMode of bkNormBase: begin //SetSQLToQuery(scsQOperat, ' update interface_relation set '+AFieldName+' = '''+IntTostr(AValue)+''' where id = '''+IntTostr(AIDInterfRel)+''''); //scsQOperat.Close; SetSQLToFIBQuery(Query_Operat, 'update interface_relation set '+AFieldName+' = '''+IntTostr(AValue)+''' where id = '''+IntTostr(AIDInterfRel)+''''); Query_Operat.Close; end; bkProjectManager: if FMemBaseActive then begin {tSQL_InterfaceRelation.Filtered := false; //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, 'id = '''+IntTostr(AIDInterfRel)+'''') then if tSQL_InterfaceRelation.Locate(fnID, AIDInterfRel, []) then begin tSQL_InterfaceRelation.Edit; tSQL_InterfaceRelation.FieldByName(AFieldName).AsInteger := AValue; tSQL_InterfaceRelation.Post; end;} end; end; end; procedure TDM.UpdateInterfFieldAsFloat(AIDInterfRel: Integer; AValue: Double; AFieldName: String); begin case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update interface_relation set '+AFieldName+' = :NewValue where id = '''+IntTostr(AIDInterfRel)+''''); scsQOperat.SetParamAsFloat('NewValue', AValue); scsQOperat.ExecQuery; scsQOperat.Close; end; bkProjectManager: if FMemBaseActive then begin {if SetFilterToSQLMemTable(tSQL_InterfaceRelation, 'id = '''+IntTostr(AIDInterfRel)+'''') then begin tSQL_InterfaceRelation.Edit; tSQL_InterfaceRelation.FieldByName(AFieldName).AsFloat := AValue; tSQL_InterfaceRelation.Post; end;} end; end; end; function TDM.GetInterfaceNewNumPairFromMT(AmtInterfaces: TkbmMemTable): Integer; var //Bookmark: TBookmarkStr; Bookmark: TBookmark; CurrNumPair: Integer; MaxNumPair: Integer; begin Result := 0; MaxNumPair := 0; if AmtInterfaces.Active then begin //Bookmark := AmtInterfaces.Bookmark; Bookmark := AmtInterfaces.GetBookmark; AmtInterfaces.DisableControls; try AmtInterfaces.First; while Not AmtInterfaces.Eof do begin CurrNumPair := AmtInterfaces.FieldByName(fnNumPair).AsInteger; if CurrNumPair > MaxNumPair then begin MaxNumPair := CurrNumPair; Result := CurrNumPair + (AmtInterfaces.FieldByName(fnKolvo).AsInteger - 1); end; AmtInterfaces.Next; end; finally AmtInterfaces.EnableControls; // AmtInterfaces.Bookmark := Bookmark; AmtInterfaces.GotoBookmark(Bookmark); AmtInterfaces.FreeBookmark(Bookmark); end; end; Inc(Result); end; function TDM.GetInterfFldValueAsInteger(AIDInterfRel: Integer; AFldName: String): Integer; begin Result := 0; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select '+AFldName+' from interface_relation where id = '''+IntToStr(AIDInterfRel)+''''); Result := scsQSelect.GetFNAsInteger(AFldName); end; bkProjectManager: begin tSQL_InterfaceRelation.Filtered := false; tSQL_InterfaceRelation.Filter := 'id = '''+IntToStr(AIDInterfRel)+''''; tSQL_InterfaceRelation.Filtered := true; Result := tSQL_InterfaceRelation.FieldByName(AFldName).AsInteger; end; end; end; function TDM.GetInterfCountByFilter(AFilter: String; ANoMoreOne: Boolean): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select count(id) from interface_relation '+ ' where '+ AFilter); Result := scsQSelect.GetFNAsInteger(fnCount); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, AFilter) then // Result := GetRecCountFromSQLMemTable(tSQL_InterfaceRelation, ANoMoreOne); end; end; end; function TDM.GetInterfMaxFldValueByFilter(AFieldName, AFilter: String): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select Max('+AFieldName+') from interface_relation '+ ' where '+ AFilter); Result := scsQSelect.GetFNAsInteger(fnMax); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, AFilter) then // Result := GetMaxFieldValueFromSQLMemTable(tSQL_InterfaceRelation, AFieldName); end; end; end; function TDM.GetInterfToListByIDCompon(AIDComponent, AIDCompRel: Integer): TIntList; var SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; i, j: Integer; CurrInterfsTo: TIntList; begin Result := nil; Result := TIntList.Create; case TF_MAIN(GForm).GDBMode of bkNormBase: begin //SetSQLToQuery(scsQSelect, ' select id_interf_to from interfofinterf_relation '+ // ' where (id_interf_rel in (select id from interface_relation '+ // ' where id_component = '''+IntTostr(AIDComponent)+''' )) and '+ // ' (id_comp_rel in (select id from component_relation '+ // ' where connect_type = '''+IntTostr(cntComplect)+''' )) '); //SetSQLToQuery(scsQSelect, 'select id_interf_to from interfofinterf_relation, interface_relation '+ // 'where (id_component = '''+IntToStr(AIDComponent)+''') and (typei = '''+IntToStr(itConstructive)+''') and '+ // '(id_interf_rel = interface_relation.id)'); //IntFieldToIntList(Result, scsQSelect, fnIDInterfTo); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnInterfOfInterfRelation, fnIDCompRel+' = '''+IntToStr(AIDCompRel)+'''', nil, fnIDInterfTo)); IntFIBFieldToIntList(Result, Query_Select, fnIDInterfTo); end; bkProjectManager: begin SCSComponent := TF_MAIN(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if SCSComponent <> nil then for i := 0 to SCSComponent.Interfaces.Count - 1 do begin SCSInterface := SCSComponent.Interfaces[i]; if SCSInterface.TypeI = itConstructive then begin CurrInterfsTo := SCSInterface.GetInterfToIDs; Result.Assign(CurrInterfsTo, laOr); FreeAndNil(CurrInterfsTo); end; end; {tSQL_InterfaceRelation.Filtered := false; tSQL_InterfaceRelation.Filter := 'id_component = '''+IntTostr(AIDComponent)+''''; tSQL_InterfaceRelation.Filtered := true; tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin tSQL_InterfOfInterfRelation.Filtered := false; tSQL_InterfOfInterfRelation.Filter := 'id_interf_rel = '''+IntToStr(tSQL_InterfaceRelation.FieldByName('ID').AsInteger)+''''; tSQL_InterfOfInterfRelation.Filtered := true; tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin tSQL_ComponentRelation.Filtered := false; tSQL_ComponentRelation.Filter := '(id = '''+IntToStr(tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger)+''') and (connect_type = '''+IntTostr(cntComplect)+''')'; tSQL_ComponentRelation.Filtered := true; if Not tSQL_ComponentRelation.Eof then begin Result.Add(tSQL_InterfOfInterfRelation.FieldByName('id_interf_to').AsInteger); end; tSQL_InterfOfInterfRelation.Next; end; tSQL_InterfaceRelation.Next; end;} end; end; end; function TDM.GetInterfToListByIDInterfRel(AIDInterfRel: Integer): TList; var PtrID: ^Integer; begin Result := nil; Result := TList.Create; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select interfofinterf_relation.id_interf_to from interfofinterf_relation, component_relation '+ ' where (id_interf_rel = '''+ IntToStr(AIDInterfRel) +''') and '+ ' (id_comp_rel = component_relation.id) and '+ ' (connect_type = '''+ IntToStr(cntComplect) +''') ' ); IntFieldToList(Result, scsQSelect, 'id_interf_to'); end; bkProjectManager: begin tSQL_InterfOfInterfRelation.Filtered := false; tSQL_InterfOfInterfRelation.Filter := 'id_interf_rel = '''+IntToStr(AIDInterfRel)+''''; tSQL_InterfOfInterfRelation.Filtered := true; tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin tSQL_ComponentRelation.Filtered := false; tSQL_ComponentRelation.Filter := '(id = '''+IntToStr(tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger)+''') and (connect_type = '''+IntTostr(cntComplect)+''')'; tSQL_ComponentRelation.Filtered := true; if Not tSQL_ComponentRelation.Eof then begin //New(ptrID); GetMem(ptrID, SizeOf(Integer)); ptrID^ := tSQL_InterfOfInterfRelation.FieldByName('id_interf_to').AsInteger; Result.Add(PtrID); end; tSQL_InterfOfInterfRelation.Next; end; end; end; end; function TDM.GetInterfIDListByIDCompon(AIDCompon: Integer): TList; var strFilter: String; begin Result := nil; Result := TList.Create; strFilter := 'id_component = '''+IntToStr(AIDCompon)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select id from interface_relation where '+strFilter); IntFieldToList(Result, scsQSelect, fnID); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, strFilter) then // IntFieldToListFromSQLMemTable(Result, tSQL_InterfaceRelation, fnID); end; end; end; function TDM.GetInterfFieldListByFilter(AFieldName, AFilter: String): TList; begin Result := nil; Result := TList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select '+AFieldName+' from interface_relation where '+AFilter); IntFieldToList(Result, scsQSelect, AFieldName); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfaceRelation, AFilter) then // IntFieldToListFromSQLMemTable(Result, tSQL_InterfaceRelation, AFieldName); end; end; end; function TDM.GetInterfacesThatInConnection(AIDCompRel: Integer; aIOfIRelList: TList): TSCSInterfaces; var IOfIRelList: TList; i: Integer; IOfIRel: TSCSIOfIRel; Interfac: TSCSInterface; begin Result := nil; case TF_MAIN(GForm).GDBMode of bkNormBase: begin Result := TSCSInterfaces.Create(true); SetSQLToQuery(scsQSelect, ' select id from interface_relation ' + ' where (isbusy = '''+IntToStr(biTrue)+''') and '+ ' ((id in (select id_interf_rel from interfofinterf_relation '+ ' where id_comp_rel = '''+IntTostr(AIDCompRel)+''') ) or '+ ' (id in (select id_interf_to from interfofinterf_relation '+ ' where id_comp_rel = '''+IntTostr(AIDCompRel)+''')))'); while Not scsQSelect.Eof do begin //GetMem(Interfac, SizeOf(TInterface)); Interfac := TSCSInterface.Create(GForm); Interfac.ID := scsQSelect.GetFNAsInteger(fnID); Result.Add(Interfac); scsQSelect.Next; end; scsQSelect.Close; end; bkProjectManager: begin Result := TSCSInterfaces.Create(false); IOfIRelList := aIOfIRelList; if IOfIRelList = nil then IOfIRelList := TF_Main(GForm).GSCSBase.CurrProject.GetIOfIRelsByIDCompRel(AIDCompRel); if Assigned(IOfIRelList) then begin try for i := 0 to IOfIRelList.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRelList[i]); if IOfIRel <> nil then if Assigned(IOfIRel.InterfaceOwner) then if IOfIRel.InterfaceOwner.IsBusy = biTrue then begin Result.Add(IOfIRel.InterfaceOwner); if Assigned(IOfIRel.InterfaceTo) then if IOfIRel.InterfaceTo.IsBusy = biTrue then Result.Add(IOfIRel.InterfaceTo); end; end; finally if aIOfIRelList = nil then IOfIRelList.Free; end; end; { if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, fnIDCompRel+' = '+IntTostr(AIDCompRel)) then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin if SetFilterToSQLMemTable(tSQL_InterfaceRelation, '(id = '''+IntTostr(tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger)+''') or'+ ' (id = '''+IntTostr(tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger)+''')') then begin while Not tSQL_InterfaceRelation.Eof do begin if tSQL_InterfaceRelation.FieldByName(fnIsBusy).AsInteger = biTrue then begin //GetMem(Interfac, SizeOf(TInterface)); //Interfac := TSCSInterface.Create(GForm); //Interfac.ID := tSQL_InterfaceRelation.FieldByName(fnID).AsInteger; //Interfac.ID_Component := tSQL_InterfaceRelation.FieldByName(fnIDComponent).AsInteger; //Interfac.IDConnected := tSQL_InterfaceRelation.FieldByName(fnIDConnected).AsInteger; Interfac := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger); if Assigned(Interfac) then Result.Add(Interfac); end; tSQL_InterfaceRelation.Next; end; end; tSQL_InterfOfInterfRelation.Next; end; end;} end; end; end; function TDM.GetInterfacesThatMayBeNoBusy: TSCSInterfaces; var Interfac: TSCSInterface; ProjInterfaces: TSCSInterfaces; ProjIOfIRels: TList; i, j: Integer; Interf: TSCSInterface; //ptrIOfIRel: PIOfIRel; //CanInterfToNoBusy: Boolean; begin Result := nil; case TF_MAIN(GForm).GDBMode of bkNormBase: begin Result := TSCSInterfaces.Create(true); SetSQlToQuery(scsQSelect, ' select id from interface_relation '+ ' where (isbusy = ''1'') and '+ ' Not( id in (select id_interf_rel from interfofinterf_relation)) and '+ ' Not( id in (select id_interf_to from interfofinterf_relation)) '); //SetSQlToQuery(scsQSelect, ' select id 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)) '); while Not scsQSelect.Eof do begin //GetMem(Interfac, SizeOf(TInterface)); Interfac := TSCSInterface.Create(GForm); Interfac.ID := scsQSelect.GetFNAsInteger(fnID); Result.Add(Interfac); scsQSelect.Next; end; scsQSelect.Close; end; bkProjectManager: begin Result := TSCSInterfaces.Create(false); ProjInterfaces := TF_Main(GForm).GSCSBase.CurrProject.GetAllInterfaces; try for i := 0 to ProjInterfaces.Count - 1 do begin Interf := ProjInterfaces[i]; if (Interf.IsBusy = biTrue) and (Interf.ConnectedInterfaces.Count = 0) then begin Result.Add(Interf); end; end; finally ProjInterfaces.Free; //ProjIOfIRels.Free; end; {Result := TSCSInterfaces.Create(false); //ProjIOfIRels := TF_Main(GForm).GSCSBase.CurrProject.GetAllIOfIRel; ProjInterfaces := TF_Main(GForm).GSCSBase.CurrProject.GetAllInterfaces; ProjIOfIRels := ProjInterfaces.GetIOfIRels; try for i := 0 to ProjInterfaces.Count - 1 do begin Interf := ProjInterfaces[i]; if (Interf.IsBusy = biTrue) and (Interf.TypeI = itFunctional) then begin CanInterfToNoBusy := false; if Interf.IOfIRelOut.Count = 0 then begin CanInterfToNoBusy := true; //*** Проверить на соединение интерфейса for j := 0 to ProjIOfIRels.Count - 1 do begin ptrIOfIRel := ProjIOfIRels[j]; if ptrIOfIRel.IDInterfTo = Interf.ID then begin CanInterfToNoBusy := false; Break; ///// BREAK ///// end; end; end; if CanInterfToNoBusy then Result.Add(Interf); end; end; finally ProjInterfaces.Free; ProjIOfIRels.Free; end; } {if SetFilterToSQLMemTable(tSQL_InterfaceRelation, '(isbusy = ''1'') and (TypeI = '''+IntToStr(itFunctional)+''')') then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin if Not SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, '(id_interf_rel = '''+IntTostr(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger)+''') or'+ ' (id_Interf_to = '''+IntTostr(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger)+''')') then begin //GetMem(Interfac, SizeOf(TInterface)); //Interfac := TSCSInterface.Create(GForm); //Interfac.ID := tSQL_InterfaceRelation.FieldByName(fnID).AsInteger; //Interfac.ID_Component := tSQL_InterfaceRelation.FieldByName(fnIDComponent).AsInteger; //Interfac.IDConnected := tSQL_InterfaceRelation.FieldByName(fnIDConnected).AsInteger; Interfac := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger); if Assigned(Interfac) then Result.Add(Interfac); end; tSQL_InterfaceRelation.Next; end; end;} {if SetFilterToSQLMemTable(tSQL_InterfaceRelation, '(isbusy = ''1'') and (TypeI = '''+IntToStr(itFunctional)+''')') then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, '(id_interf_rel = '''+IntTostr(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger)+''') or'+ ' (id_Interf_to = '''+IntTostr(tSQL_InterfaceRelation.FieldByName(fnID).AsInteger)+''')') then begin tSQL_InterfOfInterfRelation.First; if tSQL_InterfOfInterfRelation.Eof then begin //GetMem(Interfac, SizeOf(TInterface)); Interfac := TSCSInterface.Create(GForm); Interfac.ID := tSQL_InterfaceRelation.FieldByName(fnID).AsInteger; Interfac.ID_Component := tSQL_InterfaceRelation.FieldByName(fnIDComponent).AsInteger; Interfac.IDConnected := tSQL_InterfaceRelation.FieldByName(fnIDConnected).AsInteger; Result.Add(Interfac); end; end; tSQL_InterfaceRelation.Next; end; end; } end; end; end; // ##### Корретирует связб противоположных интерфейсов по индексу жил ##### procedure TDM.CorrectInterfaceAdverseRelation(AIDComponent: Integer); var Interfaces: TSCSInterfaces; Interfac: TSCSInterface; ptrAdverse: TSCSInterface; i, j: Integer; begin Interfaces := GetComponInterfaces(AIDComponent, true, biFalse); if Assigned(Interfaces) then begin for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces[i]; if Interfac.Npp > 0 then for j := 0 to Interfaces.Count - 1 do if i <> j then begin ptrAdverse := Interfaces[j]; if Interfac.Npp = ptrAdverse.Npp then begin if Interfac.ID <> ptrAdverse.IDAdverse then begin UpdateInterfFieldAsInteger(ptrAdverse.ID, Interfac.ID, fnIDAdverse); ptrAdverse.IDAdverse := Interfac.ID; end; if Interfac.IDAdverse <> ptrAdverse.ID then begin UpdateInterfFieldAsInteger(Interfac.ID, ptrAdverse.ID, fnIDAdverse); Interfac.IDAdverse := ptrAdverse.ID; end; end; end; end; if TF_Main(GForm).GDBMode = bkNormBase then FreeAndNil(Interfaces); //FreeList(Interfaces); end; end; function TDM.GetInterfaceIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; //var ModRes: TModalResult; // InterfGuideForm: TF_CaseForm; var GUID: String; begin Result := GetTableIDFromGuide(vkInterface, ACurrID, AFormMode, GUID); {Result := -1; try InterfGuideForm := TF_CaseForm.Create(F_NormBase, F_NormBase); try with TF_Main(GForm).FNormBase do begin InterfGuideForm.Tree_InterfType.Selected := InterfGuideForm.Tree_InterfType.TopItem; if Not SearchRecord(DM.DataSet_INTERFACE, 'ID', ACurrID) then DM.DataSet_INTERFACE.First; InterfGuideForm.GFormMode := AFormMode; InterfGuideForm.GViewKind := vkInterface; ModRes := InterfGuideForm.ShowModal; if ModRes = mrOk then Result := DM.DataSet_INTERFACE.FN('ID').AsInteger; end; finally InterfGuideForm.Free; end; except on E: Exception do AddExceptionToLog('TDM.GetInterfaceIDFromForm', E.Message); end;} end; function TDM.GetIDInterfaceByIDInterfRelFromMemTable(AIDInterfRel: Integer; AMemTable: TkbmMemTable; AInterfKolvo: PInteger): Integer; //var //RecNo: Integer; begin Result := 0; if AInterfKolvo <> nil then AInterfKolvo^ := 0; //RecNo := AMemTable.RecNo; //try AMemTable.First; while Not AMemTable.Eof do begin if AMemTable.FieldByName(fnID).AsInteger = AIDInterfRel then begin Result := AMemTable.FieldByName(fnIDInterface).AsInteger; if AInterfKolvo <> nil then AInterfKolvo^ := AMemTable.FieldByName(fnKolvo).AsInteger; Break; ///// BREAK ///// end; AMemTable.Next; end; //finally // AMemTable.RecNo := RecNo; //end; end; function TDM.GetIDInterfRelByIDInterfaceFromMTThatNoInList(AIDInterface, AKolvo: Integer; AMemTable: TkbmMemTable; AIDList: TIntList): Integer; begin Result := 0; AMemTable.First; while Not AMemTable.Eof do begin if AMemTable.FieldByName(fnIDInterface).AsInteger = AIDInterface then if AIDList.IndexOf(AMemTable.FieldByName(fnID).AsInteger) = -1 then if (AKolvo = -1) or (AMemTable.FieldByName(fnKolvo).AsInteger = AKolvo) then begin Result := AMemTable.FieldByName(fnID).AsInteger; Break; ///// BREAK ///// end; AMemTable.Next; end; end; function TDM.GetNameComponFromObject(AIdComponent: Integer): String; var HaveParent: Boolean; IDCurrCompon: Integer; IDUppCompon: Integer; PathList: TStringList; i: Integer; ResName: String; Catalog: TCatalog; SCSObj: TSCSCatalog; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; begin try Result := ''; SCSComponent := nil; IDCurrCompon := AIdComponent; HaveParent := True; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIdComponent); if Assigned(SCSComponent) then begin SCSCatalog := SCSComponent.GetFirstParentCatalog; if Assigned(SCSCatalog) then begin ResName := SCSCatalog.GetNameForVisible(false)+ ' \ '; //GetNameAndIndexByTCatalog(Catalog) + ' \ '; ResName := ResName + SCSComponent.NameMark; //GetComponFldValueAsString(AIdComponent, fnNameMark); end; end; { Catalog := GetCatalogByCompon(IDCurrCompon); ResName := GetNameAndIndexByTCatalog(Catalog) + ' \ '; //ResName := ResName + TF_Main(GForm).GetComponNameForVisible(GetComponFldValueAsString(AIdComponent, fnNameShort), GetComponFldValueAsString(AIdComponent, fnNameMark)); ResName := ResName + GetComponFldValueAsString(AIdComponent, fnNameMark); //SetSQLToQuery(scsQSelect, ' select Name_Short, Name_Mark from component where id = '''+IntToStr(IDCurrCompon)+''' '); //ResName := ResName + TF_Main(GForm).GetComponNameForVisible(scsQSelect.GetFNAsString('NAME_Short'), scsQSelect.GetFNAsString('NAME_MARK')); } Result := ResName; except on E: Exception do AddExceptionToLog('TDM.GetNameComponFromObject: '+E.Message); end; end; function TDM.GetNamePortByIDPort(AIDPort: Integer): String; begin try Result := ''; if AIDPort <> 0 then begin case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select Npp_port from interface_relation where id = '''+IntToStr(AIDPort)+''' '); Result := IntToStr(scsQSelect.GetFNAsInteger('Npp_Port')); end; bkProjectManager: Result := IntTostr(GetInterfFldValueAsInteger(AIDPort, fnNppPort)); end; end; except on E: Exception do AddExceptionToLog('TDM.GetNamePortByIDPort: '+E.Message); end; end; { procedure TDM.DefineNppInterfaces(AComponent: TSCSComponent); var LastNpps: TList; Interfac: TSCSInterface; TopComponent: TSCSComponent; ComponsToEdit: TSCSComponents; SCSCompon: TSCSComponent; i, j: Integer; function GetNewInterfNpp(AInterface: TSCSInterface): Integer; var i: Integer; ptrLastInterface: TSCSInterface; LastNpp: Integer; FindedLast: Boolean; begin Result := AInterface.Npp; LastNpp := 0; if AInterface.Npp = 0 then begin FindedLast := false; for i := 0 to LastNpps.Count - 1 do begin ptrLastInterface := LastNpps[i]; if (AInterface.ID_Interface = ptrLastInterface.ID_Interface) and (AInterface.IsPort = ptrLastInterface.IsPort) then begin Inc(ptrLastInterface.Npp); Result := ptrLastInterface.Npp; FindedLast := true; end; end; if Not FindedLast then begin LastNpp := TopComponent.GetLastNppInterface(AInterface.ID_Interface, AInterface.IsPort, AComponent); //GetMem(ptrLastInterface, SizeOf(TInterface)); ptrLastInterface := TSCSInterface.Create(GForm); ptrLastInterface.Npp := LastNpp + 1; ptrLastInterface.ID_Interface := AInterface.ID_Interface; ptrLastInterface.IsPort := AInterface.IsPort; LastNpps.Add(ptrLastInterface); Result := ptrLastInterface.Npp; end; end; end; begin if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Assigned(AComponent) then begin TopComponent := AComponent.GetTopComponent; if Assigned(TopComponent) then begin LastNpps := TList.Create; ComponsToEdit := TSCSComponents.Create(false); ComponsToEdit.Add(AComponent); ComponsToEdit.Assign(AComponent.ChildReferences, laOr); //*** Установить номера интерфейсо в ноль for i := 0 to ComponsToEdit.Count - 1 do begin SCSCompon := ComponsToEdit[i]; if Assigned(SCSCompon) then for j := 0 to SCSCompon.Interfaces.Count - 1 do begin Interfac := SCSCompon.Interfaces[j]; Interfac.Npp := 0; end; end; //*** Установить новые порядковые номера интерфейсов for i := 0 to ComponsToEdit.Count - 1 do begin SCSCompon := ComponsToEdit[i]; if Assigned(SCSCompon) then for j := 0 to SCSCompon.Interfaces.Count - 1 do begin Interfac := SCSCompon.Interfaces[j]; if Interfac.Npp = 0 then begin Interfac.Npp := GetNewInterfNpp(Interfac); //UpdateInterfFieldAsInteger(Interfac.ID, Interfac.Npp, fnNpp); if (Interfac.IDAdverse > 0) and (Interfac.ParallelInterface <> nil) then begin Interfac.ParallelInterface.Npp := Interfac.Npp; //UpdateInterfFieldAsInteger(Interfac.ParallelInterface.ID, Interfac.Npp, fnNpp); end; end; end; end; FreeAndNil(ComponsToEdit); FreeList(LastNpps); end; end; end; } procedure TDM.LoadFromMemTableToInterface(ADestInterface: TSCSInterface; ASrcMemTable: TkbmMemTable); begin //ASrcMemTable.CopyRecords ADestInterface.ID := ASrcMemTable.FieldByName(fnID).AsInteger; ADestInterface.Npp := ASrcMemTable.FieldByName(fnNpp).AsInteger; ADestInterface.ID_Component := ASrcMemTable.FieldByName(fnIDComponent).AsInteger; ADestInterface.ID_Interface := ASrcMemTable.FieldByName(fnIDInterface).AsInteger; ADestInterface.GUIDInterface := ASrcMemTable.FieldByName(fnGUIDInterface).AsString; ADestInterface.TypeI := ASrcMemTable.FieldByName(fnTypeI).AsInteger; ADestInterface.IsPort := ASrcMemTable.FieldByName(fnIsPort).AsInteger; ADestInterface.Kind := ASrcMemTable.FieldByName(fnKind).AsInteger; ADestInterface.Gender := ASrcMemTable.FieldByName(fnGender).AsInteger; ADestInterface.Multiple := ASrcMemTable.FieldByName(fnMultiple).AsInteger; ADestInterface.IsBusy := ASrcMemTable.FieldByName(fnIsBusy).AsInteger; ADestInterface.SortID := ASrcMemTable.FieldByName(fnSortID).AsInteger; ADestInterface.Notice := ASrcMemTable.FieldByName(fnNotice).AsString; ADestInterface.Kolvo := ASrcMemTable.FieldByName(fnKolvo).AsInteger; ADestInterface.SignType := ASrcMemTable.FieldByName(fnSignType).AsInteger; ADestInterface.ConnToAnyGender := ASrcMemTable.FieldByName(fnConnToAnyGender).AsInteger; ADestInterface.SideSection := ASrcMemTable.FieldByName(fnSideSection).AsString; if ADestInterface.IsPort = biFalse then begin ADestInterface.ValueI := ASrcMemTable.FieldByName(fnValueI).AsFloat; ADestInterface.NumPair := ASrcMemTable.FieldByName(fnNumPair).AsInteger; ADestInterface.IDAdverse := ASrcMemTable.FieldByName(fnIDAdverse).AsInteger; ADestInterface.Side := ASrcMemTable.FieldByName(fnSide).AsInteger; end; if ADestInterface.IsPort = biTrue then begin ADestInterface.IsUserPort := ASrcMemTable.FieldByName(fnIsUserPort).AsInteger; ADestInterface.NppPort := ASrcMemTable.FieldByName(fnNppPort).AsInteger; if TF_Main(GForm).GDBMode = bkProjectManager then ADestInterface.IDConnected := ASrcMemTable.FieldByName(fnIDConnected).AsInteger; end; //*** Подгрузить Объем с вычитанием объемов комплектующих if ADestInterface.TypeI = itConstructive then ADestInterface.ValueI := ASrcMemTable.FieldByName(fnValueI).AsFloat; ADestInterface.Color := ASrcMemTable.FieldByName(fnColor).AsInteger; if TF_Main(GForm).GDBMode = bkProjectManager then ADestInterface.CoordZ := ASrcMemTable.FieldByName(fnCoordZ).AsFloat; ADestInterface.IsModified := ASrcMemTable.FieldByName(fnIsModified).AsBoolean; ADestInterface.IsNew := ASrcMemTable.FieldByName(fnIsNew).AsBoolean; end; procedure TDM.LoadInterfaceToMemTable(AInterface: TSCSInterface; ADestMemTable, APortInterfRelMT, AInterfInternalConn: TkbmMemTable; AMakeEdit: TMakeEdit; AIsLine: Integer; AIsNative, AInterfInConnecting: Boolean); var InterfConnected: TSCSInterface; InterfFromPort: TSCSInterface; SCSComponent: TSCSComponent; ptrPortInterfRel: PPortInterfRel; ChildSumValueI: Double; i: Integer; CreatedInterfFromPort: Boolean; mtPortInterfRel: TkbmMemTable; // Tolik 02/03/2018 -- Function GetConnectedCableName(aInterf: TSCSInterface): String; var i, j: Integer; ComponNameList: tStringList; s: String; InterfPos: TSCSInterfPosition; ConnectedCompon: TSCSComponent; CurrInterface: TSCSInterface; begin Result := ''; ComponNameList := TStringList.Create; if aInterf.IsPort = biFalse then begin for i := 0 to aInterf.BusyPositions.Count - 1 do begin s := ''; InterfPos := TSCSInterfPosition(aInterf.BusyPositions[i]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then if InterfPos.InterfOwner <> nil then if InterfPos.InterfOwner.ComponentOwner <> nil then begin ConnectedCompon := InterfPos.InterfOwner.ComponentOwner; if isCableComponent(ConnectedCompon) then s := ConnectedCompon.GetNameForVisible(false); end; if s <> '' then if ComponNameList.IndexOf(s) = -1 then ComponNameList.Add(s); end; end else begin for i := 0 to aInterf.PortInterfaces.Count - 1 do begin CurrInterface := TSCSInterface(aInterf.PortInterfaces[i]); for j := 0 to CurrInterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(CurrInterface.BusyPositions[j]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then if InterfPos.InterfOwner <> nil then if InterfPos.InterfOwner.ComponentOwner <> nil then if InterfPos.InterfOwner.ComponentOwner <> nil then begin ConnectedCompon := InterfPos.InterfOwner.ComponentOwner; if isCableComponent(ConnectedCompon) then s := ConnectedCompon.GetNameForVisible(false); end; if s <> '' then if ComponNameList.IndexOf(s) = -1 then ComponNameList.Add(s); end; end; end; if ComponNameList.Count > 0 then begin Result := ComponNameList[0]; for i := 1 to ComponNameList.Count - 1 do begin Result := Result + '; ' + ComponNameList[i]; end; end; ComponNameList.Free; end; // begin case AMakeEdit of meMake: ADestMemTable.Append; meEdit: ADestMemTable.Edit; end; if ADestMemTable.State = dsBrowse then Exit; ///// EXIT ///// if AInterface.Name <> '' then ADestMemTable.FieldByName(fnName).AsString := AInterface.Name; ADestMemTable.FieldByName('ID').AsInteger := AInterface.ID; ADestMemTable.FieldByName(fnNpp).AsInteger := AInterface.Npp; ADestMemTable.FieldByName('ID_COMPONENT').AsInteger := AInterface.ID_Component; ADestMemTable.FieldByName('ID_INTERFACE').AsInteger := AInterface.ID_Interface; ADestMemTable.FieldByName(fnGuidInterface).AsString := AInterface.GUIDInterface; ADestMemTable.FieldByName('TYPEI').AsInteger := AInterface.TypeI; ADestMemTable.FieldByName('IsPort').AsInteger := AInterface.IsPort; ADestMemTable.FieldByName('Kind').AsInteger := AInterface.Kind; ADestMemTable.FieldByName('GENDER').AsInteger := AInterface.Gender; ADestMemTable.FieldByName('Multiple').AsInteger := AInterface.Multiple; if Not AInterfInConnecting then begin if (AInterface.IsBusy = biFalse) and (AInterface.IOfIRelOut.Count > 0) then ADestMemTable.FieldByName(fnIsBusy).AsInteger := biTrue else ADestMemTable.FieldByName(fnIsBusy).AsInteger := AInterface.IsBusy; end else ADestMemTable.FieldByName(fnIsBusy).AsInteger := biNone; ADestMemTable.FieldByName('SORT_ID').AsInteger := AInterface.SortID; ADestMemTable.FieldByName(fnNotice).AsString := AInterface.Notice; ADestMemTable.FieldByName('isNative').AsBoolean := AIsNative; //*** Количества ADestMemTable.FieldByName(fnKolvo).AsInteger := AInterface.Kolvo; ADestMemTable.FieldByName(fnKolvoBusy).AsInteger := AInterface.KolvoBusy; ADestMemTable.FieldByName(fnSignType).AsInteger := AInterface.SignType; ADestMemTable.FieldByName(fnConnToAnyGender).AsInteger := AInterface.ConnToAnyGender; ADestMemTable.FieldByName(fnSideSection).AsString := AInterface.SideSection; if AInterface.IsPort = biFalse then begin ADestMemTable.FieldByName('ValueI').AsFloat := Round3(AInterface.ValueI); ADestMemTable.FieldByName(fnNumPair).AsInteger := AInterface.NumPair; DefineInterfaceNumPairsStr(ADestMemTable, AInterface.NumPair, AInterface.Kolvo); ADestMemTable.FieldByName('id_adverse').AsInteger := AInterface.IDAdverse; ADestMemTable.FieldByName('Side').AsInteger := AInterface.Side; end; if AInterface.IsPort = biTrue then begin ADestMemTable.FieldByName('IsUser_Port').AsInteger := AInterface.IsUserPort; ADestMemTable.FieldByName(fnNppPort).AsInteger := AInterface.NppPort; if TF_Main(GForm).GDBMode = bkProjectManager then begin //if AInterface.Kolvo > 0 then ADestMemTable.FieldByName(fnIDConnected).AsInteger := AInterface.IDConnected; if AInterface.IDConnected > 0 then begin InterfConnected := TF_Main(GForm).GSCSBase.CurrProject.GetInterfaceByID(AInterface.IDConnected); if Assigned(InterfConnected) then begin ADestMemTable.FieldByName('name_connected').AsString := GetNameComponFromObject(InterfConnected.ID_Component) +' \ '+cDM_Msg13+' '+ IntToStr(InterfConnected.NppPort); //MemTable_InterfOrPort.FieldByName('name_connected').AsString := GetNameComponFromObject(GetIDComponByInterfID(Interfac.IDConnected)); //TF_Main(GForm).GetComponNameForVisible(scsQSelect.FN('NAME_SHORT').AsString, scsQSelect.FN('NAME_MARK').AsString); //MemTable_InterfOrPort.FieldByName('name_connected').AsString := MemTable_InterfOrPort.FieldByName('name_connected').AsString +' \ Порт '+ GetNamePortByIDPort(Interfac.IDConnected); end; end; // Tolik 02/03/2018 -- данная конструкция применима только для наборных модульных панелей, потому // тут немножко перепишем, а то на ненаборных -- один и тот же кабель показывает, а не подключенные по факту //*** Загрузить подсоединенный кабель, если он есть { SCSComponent := TSCSComponent(AInterface.ComponentOwner); if Assigned(SCSComponent) then if SCSComponent.JoinedComponents.Count > 0 then for i := 0 to SCSComponent.JoinedComponents.Count - 1 do if Assigned(SCSComponent.JoinedComponents[i]) then if SCSComponent.JoinedComponents[i].IsLine = biTrue then begin ADestMemTable.FieldByName(fnNameConnectCable).AsString := SCSComponent.JoinedComponents[i].GetNameForVisible(false); //GetComponNameForVisible(SCSComponent.JoinedComponents[k].Name, SCSComponent.JoinedComponents[k].NameMark); Break; ///// BREAK ///// end;} ADestMemTable.FieldByName(fnNameConnectCable).AsString := GetConnectedCableName(AInterface); // end; end; //*** Подгрузить Объем с вычитанием объемов комплектующих if AIsLine = biTrue then if (AInterface.TypeI = itConstructive) and (AInterface.Multiple = biTrue) then begin ChildSumValueI := GetConnectedInterfacesValues(scsQSelect, AInterface.ID); ADestMemTable.FieldByName('ValueI').AsFloat := Round3(AInterface.ValueI - ChildSumValueI); end; ADestMemTable.FieldByName('Color').AsInteger := AInterface.Color; if TF_Main(GForm).GDBMode = bkProjectManager then ADestMemTable.FieldByName('CoordZ').AsFloat := AInterface.CoordZ; ADestMemTable.FieldByName(fnIsNew).AsBoolean := AInterface.IsNew; ADestMemTable.FieldByName(fnIsModified).AsBoolean := AInterface.IsModified; ADestMemTable.Post; if Not AInterfInternalConn.Active then begin AInterfInternalConn.MasterSource := nil; AInterfInternalConn.MasterFields := ''; AInterfInternalConn.DetailFields := ''; AInterfInternalConn.Active := true; end; //*** Связь портов с интерфейсами if {(AInterface.IsPort = biTrue) and} (AIsNative) then //##ISPORT begin //if TF_Main(GForm).GDBMode = bkNormBase then // Interfac.LoadPortInterfRels; for i := 0 to AInterface.PortInterfRels.Count - 1 do begin ptrPortInterfRel := AInterface.PortInterfRels[i]; InterfFromPort := nil; if AInterface.ComponentOwner <> nil then InterfFromPort := AInterface.ComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); CreatedInterfFromPort := false; if InterfFromPort = nil then case TF_Main(GForm).GDBMode of bkNormBase: begin InterfFromPort := TSCSInterface.Create(GForm); InterfFromPort.LoadByID(ptrPortInterfRel.IDInterfRel); CreatedInterfFromPort := true; end; bkProjectManager: InterfFromPort := TF_Main(GForm).GSCSBase.CurrProject.CurrList.GetInterfaceByIDAndIDComponent(ptrPortInterfRel.IDInterfRel, AInterface.ID_Component); end; mtPortInterfRel := nil; case ptrPortInterfRel.RelType of rtPortInterfRel: if AInterface.IsPort = biTrue then mtPortInterfRel := APortInterfRelMT; rtInterfInternalConn: mtPortInterfRel := AInterfInternalConn; end; if mtPortInterfRel <> nil then begin mtPortInterfRel.Append; mtPortInterfRel.FieldByName(fnID).AsInteger := ptrPortInterfRel.ID; mtPortInterfRel.FieldByName(fnRelType).AsInteger := ptrPortInterfRel.RelType; mtPortInterfRel.FieldByName(fnIDPort).AsInteger := ptrPortInterfRel.IDPort; //MemTable_PortInterfRel.FieldByName(fnIDPort).AsInteger := ptrPortInterfRel.IDPort; mtPortInterfRel.FieldByName(fnIDInterfRel).AsInteger := ptrPortInterfRel.IDInterfRel; if ptrPortInterfRel.RelType = rtPortInterfRel then mtPortInterfRel.FieldByName(fnUnitInterfKolvo).AsInteger := ptrPortInterfRel.UnitInterfKolvo else if ptrPortInterfRel.RelType = rtInterfInternalConn then if InterfFromPort <> nil then mtPortInterfRel.FieldByName(fnUnitInterfKolvo).AsInteger := InterfFromPort.Kolvo; if InterfFromPort <> nil then begin mtPortInterfRel.FieldByName(fnGender).AsInteger := InterfFromPort.Gender; mtPortInterfRel.FieldByName(fnName).AsString := InterfFromPort.LoadName; mtPortInterfRel.FieldByName(fnIsNew).AsBoolean := InterfFromPort.IsNew; mtPortInterfRel.FieldByName(fnIsModified).AsBoolean := InterfFromPort.IsModified; end; mtPortInterfRel.Post; end; if CreatedInterfFromPort then if InterfFromPort <> nil then FreeAndNil(InterfFromPort); end; end; end; procedure TDM.LoadInterfRelNamesToMemTable(AMemTable: TkbmMemtable); var i: Integer; ID_Interf: Integer; GUIDInterf: String; ptrInterfaceInfo: PInterfaceInfo; InterfaceInfoList: TList; Spravochnik: TSpravochnik; SprInterface: TNBInterface; begin if Not AMemTable.Active then Exit; ///// EXIT ///// InterfaceInfoList := TList.Create; AMemTable.Last; //with F_NormBase.DM do //ChangeSQLQuery(scsQ, ' select name from interface where id = :id '); while Not AMemTable.Bof do begin ID_Interf := AMemTable.FieldByName(fnIDInterface).AsInteger; GUIDInterf := AMemTable.FieldByName(fnGuidInterface).AsString; ptrInterfaceInfo := nil; //*** Найти наименование интерфейса for i := 0 to InterfaceInfoList.Count - 1 do begin if TInterfaceInfo(InterfaceInfoList[i]^).ID = ID_Interf then begin ptrInterfaceInfo := InterfaceInfoList[i]; Break; ///// BREAK ///// end; end; if ptrInterfaceInfo = nil then begin //scsQ.Close; //scsQ.SetParamAsInteger('id', ID_Interf); //scsQ.ExecQuery; Spravochnik := nil; case TF_Main(GForm).GDBMode of bkNormBase: Spravochnik := TF_Main(GForm).GSCSBase.NBSpravochnik; bkProjectManager: Spravochnik := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik; end; if Spravochnik <> nil then begin SprInterface := nil; if GUIDInterf <> '' then SprInterface := Spravochnik.GetInterfaceWithAssign(GUIDInterf, F_NormBase.GSCSBase.NBSpravochnik, false, false) else SprInterface := Spravochnik.GetInterfaceByID(ID_Interf); if SprInterface <> nil then begin GetMem(ptrInterfaceInfo, SizeOf(TInterfaceInfo)); ptrInterfaceInfo.ID := ID_Interf; ptrInterfaceInfo.Name := SprInterface.Name; if ptrInterfaceInfo.Name = '' then ptrInterfaceInfo.Name := Spravochnik.GetInterfaceNameByID(ID_Interf); //scsQ.GetFNAsString('Name'); InterfaceInfoList.Add(ptrInterfaceInfo); end; end; end; if ptrInterfaceInfo <> nil then begin AMemTable.Edit; AMemTable.FieldByName('Name').AsString := ptrInterfaceInfo.Name; AMemTable.Post; end; AMemTable.Prior; end; scsQ.Close; FreeList(InterfaceInfoList); end; procedure TDM.RemoveNoNativeInterfacesFromMemTable(AMemTable: TkbmMemtable); var i: Integer; FieldIndex: Integer; begin if AMemTable.Active then begin FieldIndex := AMemTable.FieldDefs.IndexOf(fnIsNative); if FieldIndex <> -1 then begin AMemTable.DisableControls; try AMemTable.First; while Not AMemTable.Eof do begin if AMemTable.Fields[FieldIndex].AsBoolean = false then AMemTable.Delete else AMemTable.Next; end; finally AMemTable.EnableControls; end; end; end; end; procedure TDM.UpdateInterfacesFromMemTable(AMemTable: TkbmMemTable; ADataSource: TDataSource); var RecNo: Integer; CurrMakeEdit: TMakeEdit; meInterfaceRel: TmeInterfaceRel; begin RecNo := AMemTable.RecNo; AMemTable.DisableControls; try AMemTable.First; while Not AMemTable.Eof do begin CurrMakeEdit := meNone; if AMemTable.FieldByName(fnIsModified).AsBoolean = true then CurrMakeEdit := meEdit else if AMemTable.FieldByName(fnIsNew).AsBoolean = true then CurrMakeEdit := meMake; if CurrMakeEdit <> meNone then begin meInterfaceRel := GetInterfaceRel(ADataSource, nil); MakeEditInterfRel(meInterfaceRel, CurrMakeEdit); AMemTable.Edit; AMemTable.FieldByName(fnIsNew).AsBoolean := false; AMemTable.FieldByName(fnIsModified).AsBoolean := false; AMemTable.Post; end; AMemTable.Next; end; finally AMemTable.EnableControls; if RecNo > -1 then // Tolik 28/12/2019 -- AMemTable.RecNo := RecNo; end; end; procedure TDM.DeleteIOfIRelByFilter(AFilter: String); begin case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQlToQuery(scsQOperat, ' DELETE FROM INTERFOFINTERF_RELATION ' + ' WHERE '+ AFilter); scsQOperat.Close; end; bkProjectManager: begin //SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, AFilter); //while tSQL_InterfOfInterfRelation.RecordCount > 0 do // tSQL_InterfOfInterfRelation.Delete; //tSQL_InterfOfInterfRelation.Last; //while Not tSQL_InterfOfInterfRelation.Bof do // tSQL_InterfOfInterfRelation.Delete; end; end; end; procedure TDM.DeleteIOfIRelByInterfIDs(AIDInterfRel, AIDInterfTo: Integer; AParamExch: Boolean); var strFilter: String; begin strFilter := '('+fnIDInterfRel+' = '''+IntToStr(AIDInterfRel)+''') and '+ '('+fnIDInterfTo+' = '''+IntToStr(AIDInterfTo)+''')'; DeleteIOfIRelByFilter(strFilter); if AParamExch then begin strFilter := '('+fnIDInterfRel+' = '''+IntToStr(AIDInterfTo)+''') and '+ '('+fnIDInterfTo+' = '''+IntToStr(AIDInterfRel)+''')'; DeleteIOfIRelByFilter(strFilter); end; end; procedure TDM.DeleteIOfIRelByInterfID(AIDInterfRel: Integer); var i: Integer; Interf: TSCSInterface; IOfIRels: TSCSObjectList; IOfIRel: TSCSIOfIRel; begin case TF_Main(GForm).GDBMode of bkNormBase: DeleteIOfIRelByFilter('('+fnIDInterfRel+' = '''+IntToStr(AIDInterfRel)+''') or '+ '('+fnIDInterfTo+' = '''+IntToStr(AIDInterfRel)+''')'); bkProjectManager: begin IOfIRels := TF_Main(GForm).GSCSBase.CurrProject.GetAllIOfIRel; try for i := 0 to IOfIRels.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRels[i]); if (IOfIRel.IDInterfRel = AIDInterfRel) or (IOfIRel.IDInterfTo = AIDInterfRel) then if Assigned(IOfIRel.InterfaceOwner) then begin //DeleteRecordFromTableByID(tnInterfOfInterfRelation, ptrIOfIRel.ID, qmMemory); Interf := IOfIRel.InterfaceOwner; Interf.FreeIOfIRel(IOfIRel); end; end; finally IOfIRels.Free; end; end; end; end; procedure TDM.DeleteIOfIRelByIDCompRel(AIDCompRel: Integer; aIOfIRelList: TList); var IOfIRelList: TList; i: Integer; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; begin case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'delete from '+tnInterfOfInterfRelation+' '+ 'where '+fnIDCompRel+' = '''+IntToStr(AIDCompRel)+''''); end; bkProjectManager: begin IOfIRelList := aIOfIRelList; if IOfIRelList = nil then IOfIRelList := TF_Main(GForm).GSCSBase.CurrProject.GetIOfIRelsByIDCompRel(AIDCompRel); try for i := 0 to IOfIRelList.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRelList[i]); if IOfIRel <> nil then begin {<#MemTableClear#> if tSQL_InterfOfInterfRelation.Locate(fnID, ptrIOfIRel.ID, []) then tSQL_InterfOfInterfRelation.Delete;} Interf := IOfIRel.InterfaceOwner; if Assigned(Interf) then Interf.FreeIOfIRel(IOfIRel); end; end; finally if aIOfIRelList = nil then IOfIRelList.Free; end; end; end; end; procedure TDM.UpdateIOfIRelFieldAsInteger(AIDIOfIRel, AValue: Integer; AFieldName: String); var strWhere: String; begin strWhere := 'id = '''+IntTostr(AIDIOfIRel)+''''; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' update interfofinterf_relation set '+AFieldName+' = '''+IntTostr(AValue)+''' where '+strWhere); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, strWhere) then //begin // tSQL_InterfOfInterfRelation.Edit; // tSQL_InterfOfInterfRelation.FieldByName(AFieldName).AsInteger := AValue; // tSQL_InterfOfInterfRelation.Post; //end; end; end; end; function TDM.InsertToIOfIRel(AIDInterfRel, AIDInterfTo, AIDCompRel: Integer): Integer; var NewID: Integer; begin Result := 0; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Operat, 'Insert into interfofinterf_relation(id_interf_rel, id_interf_to, id_comp_rel) '+ 'values(:id_interf_rel, :id_interf_to, :id_comp_rel)', false); Query_Operat.ParamByName(fnIDInterfRel).AsInteger := AIDInterfRel; Query_Operat.ParamByName(fnIDInterfTo).AsInteger := AIDInterfTo; Query_Operat.ParamByName(fnIDCompRel).AsInteger := AIDCompRel; Query_Operat.ExecQuery; Query_Operat.Close; Result := GenIDFromTable(Query_Select, gnInterfOfInterfRelationID, 0); end; bkProjectManager: begin tSQL_InterfOfInterfRelation.Append; tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger := AIDInterfRel; tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger := AIDInterfTo; tSQL_InterfOfInterfRelation.FieldByName(fnIDCompRel).AsInteger := AIDCompRel; tSQL_InterfOfInterfRelation.Post; Result := tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger; end; end; end; function TDM.GetIOfIRelFieldValueAsInteger(AID: Integer; AFieldName: String): Integer; var strWhere: String; begin Result := 0; strWhere := 'id = '''+IntTostr(AID)+''''; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select '+AFieldName+' from interfofinterf_relation set where '+strWhere); Result := scsQSelect.GetFNAsInteger(AFieldName); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, strWhere) then // if Not tSQL_InterfOfInterfRelation.Eof then // Result := tSQL_InterfOfInterfRelation.FieldByName(AFieldName).AsInteger; end; end; end; function TDM.GetIOfIRelFieldValueAsIntByFilter(AFieldName, AFilter: String): Integer; begin Result := 0; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select '+AFieldName+' from interfofinterf_relation set where '+AFilter); Result := scsQSelect.GetFNAsInteger(AFieldName); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, AFilter) then // if Not tSQL_InterfOfInterfRelation.Eof then // Result := tSQL_InterfOfInterfRelation.FieldByName(AFieldName).AsInteger; end; end; end; function TDM.GetIOfIRelFieldValueAsIntListByFilter(AFieldName, AFilter: String): TList; begin Result := nil; Result := TList.Create; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select '+AFieldName+' from '+tnInterfOfInterfRelation+' where '+AFilter); IntFieldToList(Result, scsQSelect, AFieldName); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, AFilter) then // IntFieldToListFromSQLMemTable(Result, tSQL_InterfOfInterfRelation, AFieldName); end; end; end; function TDM.GetIOfIRelIDCompRelListByInterfIDs(AIDInterfRel, AIDInterfTo: Integer): TIntList; var StrWhere: String; IOfIRels: TList; i: Integer; IOfIRel: TSCSIOfIRel; begin Result := nil; Result := TIntList.Create; StrWhere := '(id_interf_rel = '''+IntToStr(AIDInterfRel)+''') or '+ ' (id_interf_to = '''+IntToStr(AIDInterfTo)+''')'; case TF_MAIN(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select id_comp_rel from '+tnInterfOfInterfRelation+ ' where '+strWhere); IntFieldToIntList(Result, scsQSelect, 'id_comp_Rel'); scsQSelect.Close; end; bkProjectManager: begin IOfIRels := TF_Main(GForm).GSCSBase.CurrProject.GetIOfIRelsByIDIntercface(AIDInterfRel); if Assigned(IOfIRels) then begin for i := 0 to IOfIRels.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRels[i]); Result.Add(IOfIRel.IDCompRel); end; IOfIRels.Free; end; //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, strWhere) then // if Not tSQL_InterfOfInterfRelation.Eof then // IntFieldToListFromSQLMemTable(Result, tSQL_InterfOfInterfRelation, fnIDCompRel); end; end; end; function TDM.GetIOfIRelByFieldValue(AFieldName: String; AValue: Integer): Tlist; var strFilter: String; IOfIRel: TSCSIOfIRel; begin Result := nil; Result := TList.Create; strFilter := AFieldName + ' = '''+IntToStr(AValue)+''''; case TF_MAin(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select * from '+tnInterfOfInterfRelation+' where '+strFilter); while Not scsQSelect.Eof do begin IOfIRel := TSCSIOfIRel.Create(nil); IOfIRel.ID := scsQSelect.GetFNAsInteger(fnID); IOfIRel.IDCompRel := scsQSelect.GetFNAsInteger(fnIDCompRel); IOfIRel.IDInterfRel := scsQSelect.GetFNAsInteger(fnIDInterfRel); IOfIRel.IDInterfTo := scsQSelect.GetFNAsInteger(fnIDInterfTo); Result.Add(IOfIRel); scsQSelect.Next; end; scsQSelect.Close; end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, strFilter) then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin GetZeroMem(ptrIOfIRel, SizeOf(TIOfIRel)); ptrIOfIRel.ID := tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger; ptrIOfIRel.IDCompRel := tSQL_InterfOfInterfRelation.FieldByName(fnIDCompRel).AsInteger; ptrIOfIRel.IDInterfRel := tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger; ptrIOfIRel.IDInterfTo := tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger; Result.Add(ptrIOfIRel); tSQL_InterfOfInterfRelation.Next; end; end;} end; end; end; function TDM.GetIOfIRelCountByFulter(AFilter: String; ANoMoreOne: Boolean): Integer; begin Result := 0; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, ' select count(id) from interfofInterf_relation '+ ' where '+ AFilter); Result := scsQSelect.GetFNAsInteger(fnCount); scsQSelect.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, AFilter) then // Result := GetRecCountFromSQLMemTable(tSQL_InterfOfInterfRelation, ANoMoreOne); end; end; end; function TDM.GetIOfIRelFromMemTable: TSCSIOfIRel; begin Result := TSCSIOfIRel.Create(nil); try Result.ID := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_ID].AsInteger; Result.IDInterfRel := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDInterfRel].AsInteger; Result.IDInterfTo := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDInterfTo].AsInteger; Result.IDCompRel := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDCompRel].AsInteger; if fiIOfIRel_IDIOfIRelMain <> -1 then Result.IDIOfIRelMain := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDIOfIRelMain].AsInteger; //18.01.2014 Result.PosConnectionsCount := -1; if fiIOfIRel_PosConnectionsCount <> -1 then //18.01.2014 Result.PosConnectionsCount := tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_PosConnectionsCount].AsInteger; //18.01.2014 Result.InterfaceOwner := nil; Result.InterfaceTo := nil; Result.NewID := 0; Result.NewIDInterfRel := 0; Result.NewIDInterfTo := 0; { Result.ID := tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger; Result.IDInterfRel := tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger; Result.IDInterfTo := tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger; Result.IDCompRel := tSQL_InterfOfInterfRelation.FieldByName(fnIDCompRel).AsInteger; Result.InterfaceOwner := nil; Result.InterfaceTo := nil; Result.NewID := 0; Result.NewIDInterfRel := 0; Result.NewIDInterfTo := 0; //if tSQL_InterfOfInterfRelation.FieldDefs.IndexOf(fnIDList) <> -1 then // Result.IDList := tSQL_InterfOfInterfRelation.FieldByName(fnIDList).AsInteger; //if tSQL_InterfOfInterfRelation.FieldDefs.IndexOf(fnIDCatalog) <> -1 then // Result.IDObject := tSQL_InterfOfInterfRelation.FieldByName(fnIDCatalog).AsInteger; //if tSQL_InterfOfInterfRelation.FieldDefs.IndexOf(fnIDComponent) <> -1 then // Result.IDComponent := tSQL_InterfOfInterfRelation.FieldByName(fnIDComponent).AsInteger; } except on E: Exception do AddExceptionToLog('TDM.GetIOfIRelFromMemTable: '+E.Message); end; end; procedure TDM.SaveIOfIRelToMemTable(AMakeEdit: TMakeEdit; AIOfIRel: TSCSIOfIRel); begin try case AMakeEdit of meMake: begin tSQL_InterfOfInterfRelation.Append; tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_ID].AsInteger := AIOfIRel.ID; end; meEdit: begin tSQL_InterfOfInterfRelation.Filtered := false; if tSQL_InterfOfInterfRelation.Locate(fnID, AIOfIRel.ID, []) then tSQL_InterfOfInterfRelation.Edit; end; end; if tSQL_InterfOfInterfRelation.State <> dsBrowse then begin tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDInterfRel].AsInteger := AIOfIRel.IDInterfRel; tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDInterfTo].AsInteger := AIOfIRel.IDInterfTo; tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDCompRel].AsInteger := AIOfIRel.IDCompRel; tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_IDIOfIRelMain].AsInteger := AIOfIRel.IDIOfIRelMain; tSQL_InterfOfInterfRelation.Fields[fiIOfIRel_PosConnectionsCount].AsInteger := AIOfIRel.PosConnections.Count; //18.01.2014 tSQL_InterfOfInterfRelation.Post; end; { case AMakeEdit of meMake: begin tSQL_InterfOfInterfRelation.Append; tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger := AIOfIRel.ID; end; meEdit: begin tSQL_InterfOfInterfRelation.Filtered := false; if tSQL_InterfOfInterfRelation.Locate(fnID, AIOfIRel.ID, []) then tSQL_InterfOfInterfRelation.Edit; end; end; if tSQL_InterfOfInterfRelation.State <> dsBrowse then begin tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfRel).AsInteger := AIOfIRel.IDInterfRel; tSQL_InterfOfInterfRelation.FieldByName(fnIDInterfTo).AsInteger := AIOfIRel.IDInterfTo; tSQL_InterfOfInterfRelation.FieldByName(fnIDCompRel).AsInteger := AIOfIRel.IDCompRel; //tSQL_InterfOfInterfRelation.FieldByName(fnIDList).AsInteger := AIOfIRelExt.IDList; //tSQL_InterfOfInterfRelation.FieldByName(fnIDCatalog).AsInteger := AIOfIRelExt.IDList; //tSQL_InterfOfInterfRelation.FieldByName(fnIDComponent).AsInteger := AIOfIRelExt.IDComponent; tSQL_InterfOfInterfRelation.Post; end; } except on E: Exception do AddExceptionToLog('TDM.SaveIOfIRelToMemTable: '+E.Message); end; end; function TDM.GetPortInterfRelFromMemTable: PPortInterfRel; begin GetZeroMem(Result, SizeOf(TPortInterfRel)); try Result.ID := tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_ID].AsInteger; Result.IDPort := tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_IDPort].AsInteger; Result.IDInterfRel := tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_IDInterfRel].AsInteger; if fiPortInterfRel_UnitInterfKolvo <> -1 then Result.UnitInterfKolvo := tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_UnitInterfKolvo].AsInteger else Result.UnitInterfKolvo := 1; if fiPortInterfRel_RelType <> -1 then Result.RelType := tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_RelType].AsInteger else Result.RelType := rtPortInterfRel; { Result.ID := tSQL_PortInterfaceRelation.FieldByName(fnID).AsInteger; Result.IDPort := tSQL_PortInterfaceRelation.FieldByName(fnIDPort).AsInteger; Result.IDInterfRel := tSQL_PortInterfaceRelation.FieldByName(fnIDInterfRel).AsInteger; } except on E: Exception do AddExceptionToLog('TDM.GetPortInterfRelFromMemTable: '+E.Message); end; end; procedure TDM.LoadFromMemTableToPortInterfRel(ADestPortInterfRel: PPortInterfRel; ASrcMemTable: TkbmMemTable); begin try ADestPortInterfRel.ID := ASrcMemTable.FieldByName(fnID).AsInteger; ADestPortInterfRel.RelType := ASrcMemTable.FieldByName(fnRelType).AsInteger; ADestPortInterfRel.IDPort := ASrcMemTable.FieldByName(fnIDPort).AsInteger; ADestPortInterfRel.IDInterfRel := ASrcMemTable.FieldByName(fnIDInterfRel).AsInteger; ADestPortInterfRel.UnitInterfKolvo := ASrcMemTable.FieldByName(fnUnitInterfKolvo).AsInteger; ADestPortInterfRel.IsModified := ASrcMemTable.FieldByName(fnIsModified).AsBoolean; ADestPortInterfRel.IsNew := ASrcMemTable.FieldByName(fnIsNew).AsBoolean; except on E: Exception do AddExceptionToLog('TDM.LoadFromMemTableToPortInterfRel: '+E.Message); end; end; procedure TDM.LoadPortInterfRelsToInterfaceFromMT(ADestInterface: TSCSInterface; ASrcMemTable, AmtInterfInternalConn: TkbmMemTable; AMTSetAsNoChanged: Boolean = false); var ptrPortInterfRel: PPortInterfRel; procedure SendToInterface(AMemTable: TkbmMemTable); begin AMemTable.First; while Not AMemTable.Eof do begin if AMemTable.FieldByName(fnIDPort).AsInteger = ADestInterface.ID then begin GetZeroMem(ptrPortInterfRel, SizeOf(TPortInterfRel)); TF_Main(GForm).DM.LoadFromMemTableToPortInterfRel(ptrPortInterfRel, AMemTable); ADestInterface.PortInterfRels.Add(ptrPortInterfRel); if (AMemTable.FieldByName(fnIsNew).AsBoolean or AMemTable.FieldByName(fnIsModified).AsBoolean) and AMTSetAsNoChanged then begin AMemTable.Edit; AMemTable.FieldByName(fnIsNew).AsBoolean := false; AMemTable.FieldByName(fnIsModified).AsBoolean := false; AMemTable.Post; end; end; AMemTable.Next; end; end; begin try if ADestInterface.IsPort = biTrue then SendToInterface(ASrcMemTable); SendToInterface(AmtInterfInternalConn); except on E: Exception do AddExceptionToLog('TDM.LoadPortInterfRelsToInterfaceFromMT: '+E.Message); end; end; procedure TDM.SavePortInterfRelToMemTable(AMakeEdit: TMakeEdit; APortInterfRel: PPortInterfRel); begin try case AMakeEdit of meMake: begin tSQL_PortInterfaceRelation.Append; tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_ID].AsInteger := APortInterfRel.ID; end; meEdit: begin tSQL_PortInterfaceRelation.Filtered := false; if tSQL_PortInterfaceRelation.Locate(fnID, APortInterfRel.ID, []) then tSQL_PortInterfaceRelation.Edit; end; end; if tSQL_PortInterfaceRelation.State <> dsBrowse then begin tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_RelType].AsInteger := APortInterfRel.RelType; tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_IDPort].AsInteger := APortInterfRel.IDPort; tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_IDInterfRel].AsInteger := APortInterfRel.IDInterfRel; tSQL_PortInterfaceRelation.Fields[fiPortInterfRel_UnitInterfKolvo].AsInteger := APortInterfRel.UnitInterfKolvo; tSQL_PortInterfaceRelation.Post; end; { case AMakeEdit of meMake: begin tSQL_PortInterfaceRelation.Append; tSQL_PortInterfaceRelation.FieldByName(fnID).AsInteger := APortInterfRel.ID; end; meEdit: begin tSQL_PortInterfaceRelation.Filtered := false; if tSQL_PortInterfaceRelation.Locate(fnID, APortInterfRel.ID, []) then tSQL_PortInterfaceRelation.Edit; end; end; if tSQL_PortInterfaceRelation.State <> dsBrowse then begin tSQL_PortInterfaceRelation.FieldByName(fnIDPort).AsInteger := APortInterfRel.IDPort; tSQL_PortInterfaceRelation.FieldByName(fnIDInterfRel).AsInteger := APortInterfRel.IDInterfRel; tSQL_PortInterfaceRelation.Post; end; } except on E: Exception do AddExceptionToLog('TDM.SavePortInterfRelToMemTable: '+E.Message); end; end; function TDM.GetInterfPosConnectionFromMemTable: TSCSInterfPosConnection; begin Result := TSCSInterfPosConnection.Create(nil, true); try Result.ID := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ID].AsInteger; Result.IDIOIRel := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_IDIOfIRel].AsInteger; Result.SelfInterfPosition.FromPos := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_SelfFromPos].AsInteger; Result.SelfInterfPosition.ToPos := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_SelfToPos].AsInteger; Result.ConnInterfPosition.FromPos := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ConnFromPos].AsInteger; Result.ConnInterfPosition.ToPos := tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ConnToPos].AsInteger; except on E: Exception do AddExceptionToLogEx('TDM.GetInterfPosConnectionFromMemTable', E.Message); end; end; procedure TDM.SaveInterfPosConnectionToMemTable(AMakeEdit: TMakeEdit; AInterfPosConnection: TSCSInterfPosConnection); begin try case AMakeEdit of meMake: begin tSQL_InterfPosConnection.Append; tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ID].AsInteger := AInterfPosConnection.ID; end; meEdit: begin tSQL_InterfPosConnection.Filtered := false; if tSQL_InterfPosConnection.Locate(fnID, AInterfPosConnection.ID, []) then tSQL_InterfPosConnection.Edit; end; end; if tSQL_InterfPosConnection.State <> dsBrowse then begin tSQL_InterfPosConnection.Fields[fiInterfPosConnection_IDIOfIRel].AsInteger := AInterfPosConnection.IDIOIRel; tSQL_InterfPosConnection.Fields[fiInterfPosConnection_SelfFromPos].AsInteger := AInterfPosConnection.SelfInterfPosition.FromPos; tSQL_InterfPosConnection.Fields[fiInterfPosConnection_SelfToPos].AsInteger := AInterfPosConnection.SelfInterfPosition.ToPos; tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ConnFromPos].AsInteger := AInterfPosConnection.ConnInterfPosition.FromPos; tSQL_InterfPosConnection.Fields[fiInterfPosConnection_ConnToPos].AsInteger := AInterfPosConnection.ConnInterfPosition.ToPos; tSQL_InterfPosConnection.Post; end; except on E: Exception do AddExceptionToLogEx('TDM.SaveInterfPosConnectionToMemTable', E.Message); end; end; function TDM.GetIDObjectIconFromGuide(AIDCurrInterf: Integer): Integer; var GUID: String; begin Result := GetTableIDFromGuide(vkObjectIcons, AIDCurrInterf, fmEdit, GUID); {DataSetLocateByID(DataSet_OBJECT_ICONS, AIDCurrInterf); with TF_Main(GForm) do begin F_NormBase.F_CaseForm.GIDNotDel := AIDCurrInterf; F_NormBase.F_CaseForm.GViewKind := vkObjectIcons; F_NormBase.F_CaseForm.GFormMode := fmEdit; if F_NormBase.F_CaseForm.ShowModal = mrOK then Result := DataSet_OBJECT_ICONS.FN('ID').AsInteger; end;} end; procedure TDM.SaveObjectIcon(AMakeEdit: TMakeEdit; AObjectIconInfo: PObjectIconInfo); var FieldNames: TStringList; begin if AObjectIconInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnProjBlk); FieldNames.Add(fnProjBmp); FieldNames.Add(fnActiveBlk); FieldNames.Add(fnActiveBmp); case AMakeEdit of meMake: begin if AObjectIconInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnObjectIcons, '', FieldNames, ''), false); if AObjectIconInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AObjectIconInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnObjectIcons, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AObjectIconInfo.ID; end; end; Query_Operat.ParamByName(fnName).AsString := AObjectIconInfo.Name; if AObjectIconInfo.ProjBlk <> nil then LoadFromStreamToQr(Query_Operat, AObjectIconInfo.ProjBlk, fnProjBlk, false); if AObjectIconInfo.ProjBmp <> nil then LoadFromStreamToQr(Query_Operat, AObjectIconInfo.ProjBmp, fnProjBmp, false); if AObjectIconInfo.ProjBlk <> nil then LoadFromStreamToQr(Query_Operat, AObjectIconInfo.ActiveBlk, fnActiveBlk, false); if AObjectIconInfo.ProjBmp <> nil then LoadFromStreamToQr(Query_Operat, AObjectIconInfo.ActiveBmp, fnActiveBmp, false); Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AObjectIconInfo.ID := GenIDFromTable(Query_Select, gnObjectIconsID, 0); FreeAndNil(FieldNames); end; end; function TDM.GetCableCanalConnectors(AIDCableCanal: Integer): Tlist; var strFilter: String; ptrCableCanalConnector: PCableCanalConnector; SCSComponent: TSCSComponent; begin Result := nil; Result := TList.Create; strFilter := fnIDComponent+' = '''+IntToStr(AIDCableCanal)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQSelect, 'select * from '+tnCableCanalConnectors+ ' where '+strFilter); while Not scsQSelect.Eof do begin GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); ptrCableCanalConnector.ID := scsQSelect.GetFNAsInteger(fnID); ptrCableCanalConnector.IDCableCanal := scsQSelect.GetFNAsInteger(fnIDComponent); ptrCableCanalConnector.IDNBConnector := scsQSelect.GetFNAsInteger(fnIDNBConnector); ptrCableCanalConnector.ConnectorType := scsQSelect.GetFNAsInteger(fnConnectorType); ptrCableCanalConnector.IsNew := false; ptrCableCanalConnector.IsModified := false; Result.Add(ptrCableCanalConnector); scsQSelect.Next; end; scsQSelect.Close; end; bkProjectManager: begin SCSComponent := nil; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDCableCanal); if Assigned(SCSComponent) then Result.Assign(SCSComponent.CableCanalConnectors); end; end; end; function TDM.GetCableCanalConnectorFromMemTable(AStringsMan: TStringsMan): PCableCanalConnector; begin GetMem(Result, SizeOf(TCableCanalConnector)); try if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin Result.GuidNBConnector := tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_GuidNBConnector].AsString; end else begin Result.GuidNBConnector := AStringsMan.GetStrByID(tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_GuidNBConnector].AsInteger, AStringsMan.NBConnectorGuidStrings); end; Result.ID := tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_ID].AsInteger; Result.IDCableCanal := tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_IDComponent].AsInteger; Result.IDNBConnector := tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_IDNBConnector].AsInteger; Result.ConnectorType := tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_ConnectorType].AsInteger; Result.NewID := -1; Result.IsNew := false; Result.IsModified := false; { Result.ID := tSQL_CableCanalConnectors.FieldByName(fnID).AsInteger; Result.IDCableCanal := tSQL_CableCanalConnectors.FieldByName(fnIDComponent).AsInteger; Result.IDNBConnector := tSQL_CableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger; Result.ConnectorType := tSQL_CableCanalConnectors.FieldByName(fnConnectorType).AsInteger; Result.GuidNBConnector := tSQL_CableCanalConnectors.FieldByName(fnGuidNBConnector).AsString; Result.NewID := -1; Result.IsNew := false; Result.IsModified := false; } except on E: Exception do AddExceptionToLog('TDM.GetCableCanalConnectorFromMemTable: '+E.Message); end; end; procedure TDM.SaveCableCanalConnectorToMemTable(AMakeEdit: TMakeEdit; ACableCanalConnector: PCableCanalConnector; AStringsMan: TStringsMan); begin try case AMakeEdit of meMake: begin tSQL_CableCanalConnectors.Append; tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_ID].AsInteger := ACableCanalConnector.ID; end; meEdit: begin tSQL_CableCanalConnectors.Filtered := false; if tSQL_CableCanalConnectors.Locate(fnID, ACableCanalConnector.ID, []) then tSQL_CableCanalConnectors.Edit; end; end; if tSQL_CableCanalConnectors.State <> dsBrowse then begin tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_IDComponent].AsInteger := ACableCanalConnector.IDCableCanal; tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_IDNBConnector].AsInteger := ACableCanalConnector.IDNBConnector; tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_ConnectorType].AsInteger := ACableCanalConnector.ConnectorType; tSQL_CableCanalConnectors.Fields[fiCablCanalConnr_GuidNBConnector].AsInteger := AStringsMan.GenStrID(ACableCanalConnector.GuidNBConnector, AStringsMan.NBConnectorGuidStrings); tSQL_CableCanalConnectors.Post; end; { case AMakeEdit of meMake: begin tSQL_CableCanalConnectors.Append; tSQL_CableCanalConnectors.FieldByName(fnID).AsInteger := ACableCanalConnector.ID; end; meEdit: begin tSQL_CableCanalConnectors.Filtered := false; if tSQL_CableCanalConnectors.Locate(fnID, ACableCanalConnector.ID, []) then tSQL_CableCanalConnectors.Edit; end; end; if tSQL_CableCanalConnectors.State <> dsBrowse then begin tSQL_CableCanalConnectors.FieldByName(fnIDComponent).AsInteger :=ACableCanalConnector.IDCableCanal; tSQL_CableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger :=ACableCanalConnector.IDNBConnector; tSQL_CableCanalConnectors.FieldByName(fnConnectorType).AsInteger := ACableCanalConnector.ConnectorType; tSQL_CableCanalConnectors.FieldByName(fnGuidNBConnector).AsString := ACableCanalConnector.GuidNBConnector; tSQL_CableCanalConnectors.Post; end; } except on E: Exception do AddExceptionToLog('TDM.SaveCableCanalConnectorToMemTable: '+E.Message); end; end; procedure TDM.SetCableCanalConnectorTokbmMemTable(AMemTable: TkbmMemTable; ACableCanalConnector: PCableCanalConnector); var ConnectorName: String; ConnectorCompon: TSCSComponent; begin ConnectorName := ''; //*** Загрузить наименования if ACableCanalConnector.GuidNBConnector <> '' then ConnectorName := TF_Main(GForm).FNormBase.DM.GetStringFromTableByGUID(tnComponent, fnName, ACableCanalConnector.GuidNBConnector, qmPhisical) else ConnectorName := TF_Main(GForm).FNormBase.DM.GetComponFldValueAsString(ACableCanalConnector.IDNBConnector, fnName); if (ConnectorName = '') and (TF_Main(GForm).GDBMode = bkProjectManager) then begin ConnectorCompon := TF_Main(GForm).GSCSBase.CurrProject.GetSprComponentByGUID(ACableCanalConnector.GuidNBConnector); if ConnectorCompon <> nil then ConnectorName := ConnectorCompon.Name; end; if ConnectorName = '' then ConnectorName := cDM_Msg9; AMemTable.FieldByName(fnID).AsInteger := ACableCanalConnector.ID; AMemTable.FieldByName(fnIDComponent).AsInteger := ACableCanalConnector.IDCableCanal; AMemTable.FieldByName(fnIDNBConnector).AsInteger := ACableCanalConnector.IDNBConnector; AMemTable.FieldByName(fnGUIDNBConnector).AsString := ACableCanalConnector.GuidNBConnector; //TF_Main(GForm).FNormBase.DM.GetStringFromTableByID(tnComponent, fnGuid, ptrCableCanalConnector.IDNBConnector, qmPhisical); AMemTable.FieldByName(fnConnectorType).AsInteger := ACableCanalConnector.ConnectorType; AMemTable.FieldByName(fnName).AsString := ConnectorName; if AMemTable.FieldDefs.IndexOf(fnIsModified) <> -1 then AMemTable.FieldByName(fnIsModified).AsBoolean := ACableCanalConnector.IsModified; if AMemTable.FieldDefs.IndexOf(fnIsNew) <> -1 then AMemTable.FieldByName(fnIsNew).AsBoolean := ACableCanalConnector.IsNew; end; function TDM.AddEditNormWithMemTable(AMakeEdit: TMakeEdit; AIDMaster: Integer; AMemTable: TkbmMemTable; AOldCurrency, ANewCurrency: TCurrency; ASaveObjectAddressIfMake: Boolean): TSCSNorm; var ID_Norm: Integer; IDCompPropRel: Integer; //ID_ResourceRel: Integer; //ModRes: TModalResult; //NewNpp: Integer; GUIDNorm: String; FormMode: TFormMode; FProjSpravochnik: TSpravochnik; ObjectToSaveAddress: TObject; begin Result := nil; try FormMode := fmNone; IDCompPropRel := 0; case AMakeEdit of meMake: FormMode := fmMake; meEdit: begin FormMode := fmEdit; IDCompPropRel := AMemTable.FieldByName(fnIDCompPropRel).AsInteger; end; end; GUIDNorm := AMemTable.FieldByName(fnGuidNB).AsString; Result := GetNormFromSpravochnik(FormMode, GUIDNorm, AIDMaster, AOldCurrency, ANewCurrency); if Result <> nil then begin Result.IDCompPropRel := IDCompPropRel; if AMakeEdit = meMake then Result.IsOn := biTrue; ObjectToSaveAddress := nil; if ASaveObjectAddressIfMake and (AMakeEdit = meMake) then ObjectToSaveAddress := Result else if AMakeEdit = meEdit then ObjectToSaveAddress := TObject(AMemTable.FieldByName(fnObjectAddress).AsInteger); LoadFromNormToMT(Result, AMemTable, AMakeEdit, 1, 0, ObjectToSaveAddress); end; { Result := nil; FormMode := fmNone; case AMakeEdit of meMake: FormMode := fmMake; meEdit: FormMode := fmEdit; end; //case AMakeEdit of // meMake: // begin // FormMode := fmMake; // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value := 1; // end; // meEdit: // begin // FormMode := fmEdit; // //if GLength = 0 then // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value := TF_Main(GForm).DM.MemTable_NormsEd.FieldByName('Kolvo').AsFloat // end; //end; //if GLength > 0 then // begin // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value := GLength; // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Properties.ReadOnly := true; // //F_NormBase.F_CaseForm.Label_CaptLength.Visible := true; // end //else begin F_NormBase.F_CaseForm.SpinEdit_Kolvo.Properties.ReadOnly := false; //F_NormBase.F_CaseForm.Label_CaptLength.Visible := false; end; //F_NormBase.F_CaseForm.GViewKind := vkNorm; //ModRes := F_NormBase.F_CaseForm.ShowModal; GUIDNorm := AMemTable.FieldByName(fnGuidNB).AsString; if TF_Main(GForm).GDBMode = bkNormBase then begin with TF_Main(GForm) do begin //if ModRes = mrOk then F_NormBase.F_CaseForm.GGUIDToLocate := GUIDNorm; if F_NormBase.F_CaseForm.Execute(vkNorm, FormMode) then begin ID_Norm := F_NormBase.DM.DataSet_NB_NORMS.FN('ID').AsInteger; Result := TSCSNorm.Create(TF_Main(GForm).FNormBase, ntNB); Result.LoadNorm(ID_Norm, true); end; end; end else if TF_Main(GForm).GDBMode = bkProjectManager then begin FProjSpravochnik := TF_Main(GForm).GSCSBase.SCSComponent.ProjectOwner.Spravochnik; if ShowCurrProjectProperties(vkNorm, GUIDNorm) then if FProjSpravochnik.LastNorm <> nil then begin Result := TSCSNorm.Create(GForm, ntNB); Result.ID := FProjSpravochnik.LastNorm.ID; Result.GuidNB := FProjSpravochnik.LastNorm.GUID; Result.Cypher := FProjSpravochnik.LastNorm.Cypher; Result.Name := FProjSpravochnik.LastNorm.Name; Result.Izm := FProjSpravochnik.LastNorm.Izm; //SCSNorm.GUIDESmeta := FProjSpravochnik.LastNorm.GUIDESmeta end; end; if Result <> nil then begin Result.IDMaster := AIDMaster; // FIDMaster; Result.NormType := ntProj; if AMakeEdit = meMake then Result.IsOn := biTrue; //*** Преобразование валют Result.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, false); Result.IsFromInterface := biFalse; ObjectToSaveAddress := nil; if ASaveObjectAddressIfMake and (AMakeEdit = meMake) then ObjectToSaveAddress := Result else if AMakeEdit = meEdit then ObjectToSaveAddress := TObject(AMemTable.FieldByName(fnObjectAddress).AsInteger); LoadFromNormToMT(Result, AMemTable, AMakeEdit, 1, ObjectToSaveAddress); end; } except on E: Exception do AddExceptionToLogExt(ClassName, 'AddEditNormWithMemTable', E.Message); end; end; function TDM.AddEditResourceWithMemTable(AMakeEdit: TMakeEdit; AIDMaster, AIDCatalog: Integer; AMemTable: TkbmMemTable; AMemoryTableKind: TTableKind; AOldCurrency, ANewCurrency: TCurrency; AMakeFromCompon, ASaveObjectAddressIfMake: Boolean): TSCSResourceRel; var //ID_ResourceRel: Integer; //ModRes: TModalResult; //ResourceRel: TSCSResourceRel; IsFromComponent: Boolean; FormMode: TFormMode; ResourceMemTable: TkbmMemTable; GUIDNB: String; GUIDNBComponent: string; IDNBComponent: Integer; NBComponent: TSCSComponent; ptrSrcComponCurrency: PObjectCurrencyRel; ptrComponCurrencySameAsSrc: PObjectCurrencyRel; SprCurrency: TNBCurrency; OldCurrency: TCurrency; ID: Integer; IDResource: Integer; IDCompPropRel: Integer; FProjSpravochnik: TSpravochnik; ObjectToSaveAddress: TObject; begin Result := nil; FormMode := fmNone; ResourceMemTable := AMemTable; ID := 0; IDResource := 0; IDCompPropRel := 0; GUIDNB := ''; GUIDNBComponent := ''; IsFromComponent := false; case AMakeEdit of meMake: begin FormMode := fmMake; IsFromComponent := AMakeFromCompon; end; meEdit: begin FormMode := fmEdit; ID := ResourceMemTable.FieldByName(fnID).AsInteger; IDResource := ResourceMemTable.FieldByName(fnIDResource).AsInteger; IDCompPropRel := ResourceMemTable.FieldByName(fnIDCompPropRel).AsInteger; GUIDNB := ResourceMemTable.FieldByName(fnGuidNB).AsString; GUIDNBComponent := ResourceMemTable.FieldByName(fnGuidNBComponent).AsString; IsFromComponent := (GUIDNBComponent <> ''); end; end; //F_NormBase.F_CaseForm.GViewKind := vkResource; //ModRes := F_NormBase.F_CaseForm.ShowModal; if IsFromComponent then begin CheckExistsSpravComponInNBWithCopy(GForm, GUIDNBComponent, cMain_Msg167); IDNBComponent := F_NormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, GUIDNBComponent, qmPhisical); NBComponent := F_NormBase.CreateFConnectComplWith.GetComponentFromNB(IDNBComponent, ''); if NBComponent <> nil then begin Result := TSCSResourceRel.Create(GForm, ntNB); Result.IDResource := 0; Result.GuidNB := NBComponent.GuidNB; Result.Cypher := NBComponent.Cypher; Result.Name := NBComponent.Name; Result.Izm := NBComponent.Izm; Result.Price := NBComponent.Price; Result.AdditionalPrice := 0; Result.RType := rtPrice; Result.GUIDNBComponent := NBComponent.GuidNB; Result.IDNBComponent := NBComponent.ID; // changed by Tolik // Result.Kolvo := 1; Result.Kolvo := GetExpenceFromIzm(NBComponent.Izm); // пересчитать цену в новой валюте ptrSrcComponCurrency := F_NormBase.DM.GetComponCurrencyByMainFld(NBComponent.ID, ctMain); if ptrSrcComponCurrency <> nil then begin ZeroMemory(@OldCurrency, SizeOf(OldCurrency)); if TF_Main(GForm).GDBMode = bkNormBase then begin ptrComponCurrencySameAsSrc := nil; if AIDMaster <> 0 then ptrComponCurrencySameAsSrc := GetComponCurrencyByCurrencyID(AIDMaster, ptrSrcComponCurrency.IDCurrency) else if AIDCatalog <> 0 then ptrComponCurrencySameAsSrc := GetCatalogCurrencyByCurrencyID(AIDCatalog, ptrSrcComponCurrency.IDCurrency); if ptrComponCurrencySameAsSrc <> nil then begin OldCurrency := ptrComponCurrencySameAsSrc.Data; FreeMem(ptrComponCurrencySameAsSrc); end; end else begin SprCurrency := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.GetCurrencyByGUID(ptrSrcComponCurrency.Data.GUID); if SprCurrency <> nil then OldCurrency := SprCurrency.Data; end; if OldCurrency.GUID <> '' then Result.RefreshPricesAfterChangeCurrency(OldCurrency, ANewCurrency, false); FreeMem(ptrSrcComponCurrency); end; Result.Cost := Result.Price * Result.Kolvo; FreeAndNil(NBComponent); end; end else begin if TF_Main(GForm).GDBMode = bkNormBase then begin if AMakeEdit = meEdit then F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value := Round3(ResourceMemTable.FieldByName(fnKolvo).AsFloat); //if GLength > 0 then // begin // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value := GLength; // F_NormBase.F_CaseForm.SpinEdit_Kolvo.Properties.ReadOnly := true; // //F_NormBase.F_CaseForm.Label_CaptLength.Visible := true; // end //else begin F_NormBase.F_CaseForm.SpinEdit_Kolvo.Properties.ReadOnly := false; //F_NormBase.F_CaseForm.Label_CaptLength.Visible := false; end; with TF_Main(GForm) do begin //if ModRes = mrOk then F_NormBase.F_CaseForm.GGUIDToLocate := GUIDNB; if F_NormBase.F_CaseForm.Execute(vkResource, FormMode) then begin Result := TSCSResourceRel.Create(GForm, ntNB); //Resource.ID := F_NormBase.DM.DataSet_NB_RESOURCES.FN('ID').AsInteger; //ResourceRel.IDMaster := DM.MemTable_NormsEd.FieldByName('Id').AsInteger; //Result.IDResource := F_NormBase.DM.DataSet_NB_RESOURCES.FN('ID').AsInteger; Result.IDNB := F_NormBase.DM.DataSet_NB_RESOURCES.FN('ID').AsInteger; Result.GuidNB := F_NormBase.DM.DataSet_NB_RESOURCES.FN(fnGUID).AsString; Result.Cypher := F_NormBase.DM.DataSet_NB_RESOURCES.FN('Cypher').AsString; Result.Name := F_NormBase.DM.DataSet_NB_RESOURCES.FN('Name').AsString; Result.Izm := F_NormBase.DM.DataSet_NB_RESOURCES.FN('Izm').AsString; Result.Price := F_NormBase.DM.DataSet_NB_RESOURCES.FN('Price').AsFloat; Result.AdditionalPrice := F_NormBase.DM.DataSet_NB_RESOURCES.FN(fnAdditionalPrice).AsFloat; Result.RType := F_NormBase.DM.DataSet_NB_RESOURCES.FN('RType').AsInteger; Result.Kolvo := F_NormBase.F_CaseForm.SpinEdit_Kolvo.Value; Result.Cost := Result.Price * Result.Kolvo; //F_NormBase.DM.DataSet_NB_RESOURCES.FN('Cost').AsFloat; Result.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, false); end; end; end else if TF_Main(GForm).GDBMode = bkProjectManager then begin FProjSpravochnik := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik; if ShowCurrProjectProperties(vkResource, GUIDNB) then if FProjSpravochnik.LastResource <> nil then begin Result := TSCSResourceRel.Create(GForm, ntNB); //Result.IDResource := FProjSpravochnik.LastResource.ID; Result.GuidNB := FProjSpravochnik.LastResource.GUID; Result.Cypher := FProjSpravochnik.LastResource.Cypher; Result.Name := FProjSpravochnik.LastResource.Name; Result.Izm := FProjSpravochnik.LastResource.Izm; Result.Price := FProjSpravochnik.LastResource.Price; Result.AdditionalPrice := 0; Result.RType := FProjSpravochnik.LastResource.RType; Result.Kolvo := GetExpenceFromIzm(FProjSpravochnik.LastResource.Izm);//1; Result.Cost := Result.Price * Result.Kolvo; end; end; end; if Result <> nil then begin Result.ID := ID; Result.IDResource := IDResource; Result.IDCompPropRel := IDCompPropRel; //*** Определить таблицу владельца ресурса case AMemoryTableKind of tkNormEd: Result.MasterTableKind := ctkComponent; //GMasterTableKind; tkResourceRelEd: Result.MasterTableKind := ctkNorm; end; Result.NormType := ntProj; Result.IDMaster := AIDMaster; Result.TableKindNB := ctkNBResources; Result.IsOn := biTrue; ObjectToSaveAddress := nil; if ASaveObjectAddressIfMake and (AMakeEdit = meMake) then ObjectToSaveAddress := Result else if AMakeEdit = meEdit then ObjectToSaveAddress := TObject(AMemTable.FieldByName(fnObjectAddress).AsInteger); LoadFromResourceToMT(Result, ResourceMemTable, AMakeEdit, AMemoryTableKind, 0, ObjectToSaveAddress); //LoadFromResourceToMT(ResourceRel, AMakeEdit, AMemoryTableKind); end; end; procedure TDM.CalcNormCostTime(AMemTable: TkbmMemTable; const aFieldEdited: String; var aIsCalcNormTotal: Boolean); var LaborTimeHr: Double; IsCalcPricePerTime: Boolean; IsCalcLaborTime: Boolean; begin aIsCalcNormTotal := false; IsCalcPricePerTime := false; IsCalcLaborTime := false; LaborTimeHr := RoundX(AMemTable.FieldByName(fnLaborTime).AsInteger / 60, 5); AMemTable.Edit; if aFieldEdited = fnLaborTime then begin if AMemTable.FieldByName(fnPricePerTime).AsFloat <> 0 then aIsCalcNormTotal := true else if AMemTable.FieldByName(fnCost).AsFloat <> 0 then IsCalcPricePerTime := true; end else if aFieldEdited = fnPricePerTime then begin if LaborTimeHr <> 0 then aIsCalcNormTotal := true else if AMemTable.FieldByName(fnCost).AsFloat <> 0 then IsCalcLaborTime := true; end else if aFieldEdited = fnCost then begin if LaborTimeHr <> 0 then IsCalcPricePerTime := true else if AMemTable.FieldByName(fnPricePerTime).AsFloat <> 0 then IsCalcLaborTime := true; end; if IsCalcPricePerTime and (LaborTimeHr <> 0) then AMemTable.FieldByName(fnPricePerTime).AsFloat := Round2(AMemTable.FieldByName(fnCost).AsFloat / LaborTimeHr); if IsCalcLaborTime and (AMemTable.FieldByName(fnPricePerTime).AsFloat <> 0) then AMemTable.FieldByName(fnLaborTime).AsFloat := Round((AMemTable.FieldByName(fnCost).AsFloat / AMemTable.FieldByName(fnPricePerTime).AsFloat) * 60); if aIsCalcNormTotal then AMemTable.FieldByName(fnCost).AsFloat := AMemTable.FieldByName(fnPricePerTime).AsFloat * LaborTimeHr; AMemTable.Post; end; procedure TDM.CalcNormTatalCostInMT(AMemTable: TkbmMemTable; ALength: Double); var Kolvo: Double; TotalKolvo: Double; begin //AMemTable.Edit; //AMemTable.FieldByName(fnTotalCost).AsFloat := RoundCP(ACost * AKolvo); //AMemTable.FieldByName(fnCost).AsFloat := ACost; //AMemTable.FieldByName(fnKolvo).AsFloat := AKolvo; //AMemTable.Post; TotalKolvo := 0; Kolvo := AMemTable.FieldByName(fnKolvo).AsFloat; // Если норма пришла с интерфейса if Not AMemTable.FieldByName(fnIsResource).AsBoolean and (AMemTable.FieldByName(fnIsFromInterface).AsInteger = biTrue) then begin TotalKolvo := Kolvo; end else TotalKolvo := CalcNormResourceCount( Kolvo, ALength, AMemTable.FieldByName(fnExpenseForLength).AsFloat, AMemTable.FieldByName(fnCountForPoint).AsFloat, AMemTable.FieldByName(fnStepOfPoint).AsFloat, AMemTable.FieldByName(fnGuidNBComponent).AsString <> ''); AMemTable.Edit; //Tolik AMemTable.FieldByName(fnTotalKolvo).AsFloat := RoundCP(TotalKolvo);//TotalKolvo; // AMemTable.FieldByName(fnTotalCost).AsFloat := RoundCP(AMemTable.FieldByName(fnCost).AsFloat * TotalKolvo); AMemTable.Post; end; function TDM.GetNewNPPFromMemTable(AMemTable: TkbmMemTable): Integer; var RecordNo: Integer; MaxNPP: Integer; begin Result := 1; // Tolik 28/12/2019 -- if AMemTable.RecordCount > 0 then begin // with AMemTable do begin RecordNo := RecNo; First; MaxNPP := FieldByName('NPP').AsInteger; while Not Eof do begin if FieldByName('NPP').AsInteger >MaxNPP then MaxNPP := FieldByName('NPP').AsInteger; Next; end; RecNo := RecordNo; end; Result := MaxNPP + 1; end; end; procedure TDM.LoadFromResourceToMT(AResource: TSCSResourceRel; AMemTable: TkbmMemTable; AMakeEdit: TMakeEdit; AMemoryTableKind: TTableKind; AObjectLength: Double; AObject: TObject); var TrgMemTable: TkbmMemTable; NewNpp: Integer; begin try TrgMemTable := AMemTable; case AMakeEdit of meMake: begin NewNpp := GetNewNPPFromMemTable(TrgMemTable); TrgMemTable.Append; TrgMemTable.FieldByName('Npp').AsInteger := NewNpp; if AMemoryTableKind in [tkNorm, tkNormEd] then TrgMemTable.FieldByName(fnIsResource).AsBoolean := true; end; meEdit: TrgMemTable.Edit; meNone: begin TrgMemTable.Append; TrgMemTable.FieldByName('id').AsInteger := AResource.ID; TrgMemTable.FieldByName('id_master').AsInteger := AResource.IDMaster; TrgMemTable.FieldByName('Npp').AsInteger := AResource.Npp; if AMemoryTableKind in [tkNorm, tkNormEd] then TrgMemTable.FieldByName(fnIsResource).AsBoolean := true; end; end; TrgMemTable.FieldByName('Table_Kind').AsInteger := AResource.MasterTableKind; if AMakeEdit <> meEdit then TrgMemTable.FieldByName('id_resource').AsInteger := AResource.IDResource; TrgMemTable.FieldByName('id_nb').AsInteger := AResource.IDNB; TrgMemTable.FieldByName(fnGuidNB).AsString := AResource.GuidNB; TrgMemTable.FieldByName('table_kind_nb').AsInteger := AResource.TableKindNB; TrgMemTable.FieldByName(fnIDCompPropRel).AsInteger := AResource.IDCompPropRel; TrgMemTable.FieldByName('kolvo').AsFloat := RoundCP(AResource.Kolvo); TrgMemTable.FieldByName('ison').AsInteger := AResource.IsOn; TrgMemTable.FieldByName('Cypher').AsString := AResource.Cypher; TrgMemTable.FieldByName('Name').AsString := AResource.Name; TrgMemTable.FieldByName('Izm').AsString := AResource.Izm; case AMemoryTableKind of tkResourceRel, tkResourceRelEd: begin TrgMemTable.FieldByName('Price').AsFloat := RoundCP(AResource.Price); TrgMemTable.FieldByName(fnAdditionalPrice).AsFloat := RoundCP(AResource.AdditionalPrice); TrgMemTable.FieldByName('Cost').AsFloat := RoundCP(AResource.Cost); end; tkNorm, tkNormEd: begin TrgMemTable.FieldByName('Cost').AsFloat := RoundCP(AResource.Price); TrgMemTable.FieldByName('Total_Cost').AsFloat := RoundCP(AResource.Cost); end; end; TrgMemTable.FieldByName(fnExpenseForLength).AsFloat := RoundCP(AResource.ExpenseForLength); TrgMemTable.FieldByName(fnGuidNBComponent).AsString := AResource.GUIDNBComponent; TrgMemTable.FieldByName(fnIDNBComponent).AsInteger := AResource.IDNBComponent; TrgMemTable.FieldByName(fnCountForPoint).AsFloat := RoundCP(AResource.CountForPoint); TrgMemTable.FieldByName(fnStepOfPoint).AsFloat := RoundCP(AResource.StepOfPoint); TrgMemTable.FieldByName('RType').AsInteger := AResource.RType; //*** Адресс объекта TrgMemTable.FieldByName(fnObjectAddress).AsInteger := Integer(AObject); case AMakeEdit of meNone: begin TrgMemTable.FieldByName('isModified').AsBoolean := false; TrgMemTable.FieldByName('isNew').AsBoolean := false; end; meMake: TrgMemTable.FieldByName('isNew').AsBoolean := true; meEdit: TrgMemTable.FieldByName('isModified').AsBoolean := true; end; TrgMemTable.Post; CalcNormTatalCostInMT(TrgMemTable, AObjectLength); except on E: Exception do AddExceptionToLog('TDM.LoadResourceToMT: '+E.Message); end; end; procedure TDM.LoadFromNormToMT(ASCSNorm: TSCSNorm; AMemTableNorms: TkbmMemTable; AMakeEdit: TMakeEdit; AKolvo: Double; AObjectLength: Double; AObject: TObject); var i: Integer; ResourceRel: TSCSResourceRel; NewNpp: Integer; begin NewNpp := 0; case AMakeEdit of meMake: begin NewNpp := GetNewNPPFromMemTable(AMemTableNorms); AMemTableNorms.Append; end; meEdit: AMemTableNorms.Edit; meNone: AMemTableNorms.Append; end; AMemTableNorms.FieldByName('ID_Master').AsInteger := ASCSNorm.IDMaster; //FIDMaster; AMemTableNorms.FieldByName(fnIDNB).AsInteger := ASCSNorm.IDNB; AMemTableNorms.FieldByName(fnGuidNB).AsString := ASCSNorm.GuidNB; AMemTableNorms.FieldByName('TABLE_KIND').AsInteger := ASCSNorm.MasterTableKind; //09.11.2013 ctkComponent; //GMasterTableKind; AMemTableNorms.FieldByName(fnIDCompPropRel).AsInteger := ASCSNorm.IDCompPropRel; AMemTableNorms.FieldByName('Cypher').AsString := ASCSNorm.Cypher; AMemTableNorms.FieldByName('Name').AsString := ASCSNorm.Name; AMemTableNorms.FieldByName('Work_Kind').AsString := ASCSNorm.WorkKind; AMemTableNorms.FieldByName('Izm').AsString := ASCSNorm.Izm_; AMemTableNorms.FieldByName(fnLaborTime).AsInteger := ASCSNorm.LaborTime; AMemTableNorms.FieldByName(fnPricePerTime).AsFloat := RoundCP(ASCSNorm.PricePerTime); AMemTableNorms.FieldByName(fnPrice).AsFloat := RoundCP(ASCSNorm.Price); AMemTableNorms.FieldByName('Cost').AsFloat := RoundCP(ASCSNorm.Price); //23.09.2010 RoundCP(ASCSNorm.Cost); AMemTableNorms.FieldByName('Total_Cost').AsFloat := RoundCP(ASCSNorm.TotalCost); //ASCSNorm.Cost * ASCSNorm.Kolvo; AMemTableNorms.FieldByName(fnExpenseForLength).AsFloat := RoundCP(ASCSNorm.ExpenseForLength); AMemTableNorms.FieldByName(fnCountForPoint).AsFloat := RoundCP(ASCSNorm.CountForPoint); AMemTableNorms.FieldByName(fnStepOfPoint).AsFloat := RoundCP(ASCSNorm.StepOfPoint); //MemTable_NormRel.FieldByName('Zarplat').AsFloat := F_NormBase.DM.Query.FN('Zarplat').AsFloat; AMemTableNorms.FieldByName(fnIsFromInterface).AsInteger := ASCSNorm.IsFromInterface; //Tolik --22/06/2016 -- if Assigned(AMemTableNorms.FindField('GuidInterface')) then AMemTableNorms.FieldByName('GuidInterface').AsString := ASCSNorm.GuidInterface; // case AMakeEdit of meNone: begin AMemTableNorms.FieldByName('ID').AsInteger := ASCSNorm.ID; AMemTableNorms.FieldByName('NPP').AsInteger := ASCSNorm.NPP; AMemTableNorms.FieldByName('ISON').AsInteger := ASCSNorm.IsOn; // Tolik // если норма просто извлекается без изменений, то пересчитывать ее не нужно // AMemTableNorms.FieldByName('Kolvo').AsFloat := ASCSNorm.Kolvo*GetExpenceFromIzm(ASCSNorm.Izm_);//RoundX(ASCSNorm.Kolvo*GetExpenceFromIzm(ASCSNorm.Izm_), PrecisionNormKolvo); AMemTableNorms.FieldByName('Kolvo').AsFloat := ASCSNorm.Kolvo; //*GetExpenceFromIzm(ASCSNorm.Izm_); AMemTableNorms.FieldByName(fnIsResource).AsBoolean := false; AMemTableNorms.FieldByName('isModified').AsBoolean := false; AMemTableNorms.FieldByName('isNew').AsBoolean := false; end; meMake: begin AMemTableNorms.FieldByName('NPP').AsInteger := NewNpp; AMemTableNorms.FieldByName('ISON').AsInteger := 1; AMemTableNorms.FieldByName('Kolvo').AsFloat := GetExpenceFromIzm(ASCSNorm.Izm_);//RoundCP(AKolvo); AMemTableNorms.FieldByName(fnIsResource).AsBoolean := false; AMemTableNorms.FieldByName('isNew').AsBoolean := true; end; meEdit: begin AMemTableNorms.FieldByName('Kolvo').AsFloat := ASCSNorm.Kolvo*GetExpenceFromIzm(ASCSNorm.Izm_);//RoundCP(AKolvo); AMemTableNorms.FieldByName('isModified').AsBoolean := true; end; end; //*** Адресс объекта AMemTableNorms.FieldByName(fnObjectAddress).AsInteger := Integer(AObject); AMemTableNorms.Post; CalcNormTatalCostInMT(AMemTableNorms, AObjectLength); //for i := 0 to ASCSNorm.Resources.Count - 1 do //begin // ResourceRel := ASCSNorm.Resources.Items[i]; // LoadFromResourceToMT(ResourceRel, AMakeEdit, tkResourceRelEd); //end; end; procedure TDM.LoadFromMTToResource(AMemTable: TkbmMemTable; AResourceRel: TSCSResourceRel; AMemoryTableKind: TTableKind); var TrgMemTable: TkbmMemTable; begin try if AResourceRel = nil then Exit; /// EXIT /// TrgMemTable := AMemTable; AResourceRel.ID := TrgMemTable.FieldByName('id').AsInteger; AResourceRel.IDMaster := TrgMemTable.FieldByName('id_master').AsInteger; AResourceRel.MasterTableKind := TrgMemTable.FieldByName('Table_Kind').AsInteger; AResourceRel.Npp := TrgMemTable.FieldByName('Npp').AsInteger; AResourceRel.IsOn := TrgMemTable.FieldByName('ison').AsInteger; AResourceRel.IDResource := TrgMemTable.FieldByName('id_resource').AsInteger; AResourceRel.IDNB := TrgMemTable.FieldByName('id_nb').AsInteger; AResourceRel.GuidNB := TrgMemTable.FieldByName(fnGuidNB).AsString; AResourceRel.TableKindNB := TrgMemTable.FieldByName('table_kind_nb').AsInteger; AResourceRel.IDCompPropRel := TrgMemTable.FieldByName(fnIDCompPropRel).AsInteger; AResourceRel.Kolvo := RoundCP(TrgMemTable.FieldByName('kolvo').AsFloat); AResourceRel.Cypher := TrgMemTable.FieldByName('Cypher').AsString; AResourceRel.Name := TrgMemTable.FieldByName('Name').AsString; AResourceRel.Izm := TrgMemTable.FieldByName('Izm').AsString; case AMemoryTableKind of tkResourceRel, tkResourceRelEd: begin AResourceRel.Price := RoundCP(TrgMemTable.FieldByName('Price').AsFloat); AResourceRel.AdditionalPrice := RoundCP(TrgMemTable.FieldByName(fnAdditionalPrice).AsFloat); AResourceRel.Cost := RoundCP(TrgMemTable.FieldByName('Cost').AsFloat); end; tkNorm, tkNormEd: begin AResourceRel.Price := RoundCP(TrgMemTable.FieldByName('Cost').AsFloat); AResourceRel.Cost := RoundCP(TrgMemTable.FieldByName('Total_Cost').AsFloat); end; end; AResourceRel.ExpenseForLength := RoundCP(TrgMemTable.FieldByName(fnExpenseForLength).AsFloat); AResourceRel.GUIDNBComponent := TrgMemTable.FieldByName(fnGuidNBComponent).AsString; AResourceRel.IDNBComponent := TrgMemTable.FieldByName(fnIDNBComponent).AsInteger; AResourceRel.CountForPoint := RoundCP(TrgMemTable.FieldByName(fnCountForPoint).AsFloat); AResourceRel.StepOfPoint := RoundCP(TrgMemTable.FieldByName(fnStepOfPoint).AsFloat); AResourceRel.RType := TrgMemTable.FieldByName('RType').AsInteger; AResourceRel.IsModified := TrgMemTable.FieldByName('isModified').AsBoolean; AResourceRel.IsNew := TrgMemTable.FieldByName('isNew').AsBoolean; except on E: Exception do AddExceptionToLog('TDM.LoadFromMTToResource: '+E.Message); end; end; procedure TDM.LoadFromMTToNorm(AMemTable: TkbmMemTable; ASCSNorm: TSCSNorm); begin ASCSNorm.ID := AMemTable.FieldByName('ID').AsInteger; ASCSNorm.IDMaster := AMemTable.FieldByName('ID_Master').AsInteger; ASCSNorm.IDNB := AMemTable.FieldByName(fnIDNB).AsInteger; ASCSNorm.GuidNB := AMemTable.FieldByName(fnGuidNB).AsString; ASCSNorm.MasterTableKind := AMemTable.FieldByName('TABLE_KIND').AsInteger; ASCSNorm.IDCompPropRel := AMemTable.FieldByName(fnIDCompPropRel).AsInteger; ASCSNorm.NPP := AMemTable.FieldByName('NPP').AsInteger; ASCSNorm.IsOn := AMemTable.FieldByName('ISON').AsInteger; ASCSNorm.Kolvo := RoundX(AMemTable.FieldByName('Kolvo').AsFloat, PrecisionNormKolvo); ASCSNorm.Cypher := AMemTable.FieldByName('Cypher').AsString; ASCSNorm.Name := AMemTable.FieldByName('Name').AsString; ASCSNorm.WorkKind := AMemTable.FieldByName('Work_Kind').AsString; ASCSNorm.Izm_ := AMemTable.FieldByName('Izm').AsString; ASCSNorm.LaborTime := AMemTable.FieldByName(fnLaborTime).AsInteger; ASCSNorm.PricePerTime := AMemTable.FieldByName(fnPricePerTime).AsFloat; //ASCSNorm.Price := RoundCP(AMemTable.FieldByName(fnPrice).AsFloat); //23.09.2010 ASCSNorm.Price := RoundCP(AMemTable.FieldByName(fnCost).AsFloat); //23.09.2010 ASCSNorm.Cost := RoundCP(AMemTable.FieldByName(fnCost).AsFloat); ASCSNorm.TotalCost := RoundCP(AMemTable.FieldByName('Total_Cost').AsFloat); ASCSNorm.ExpenseForLength := RoundCP(AMemTable.FieldByName(fnExpenseForLength).AsFloat); ASCSNorm.CountForPoint := RoundCP(AMemTable.FieldByName(fnCountForPoint).AsFloat); ASCSNorm.StepOfPoint := RoundCP(AMemTable.FieldByName(fnStepOfPoint).AsFloat); //MemTable_NormRel.FieldByName('Zarplat').AsFloat := F_NormBase.DM.Query.FN('Zarplat').AsFloat; ASCSNorm.IsFromInterface := AMemTable.FieldByName(fnIsFromInterface).AsInteger; ASCSNorm.IsModified := AMemTable.FieldByName('isModified').AsBoolean; ASCSNorm.IsNew := AMemTable.FieldByName('isNew').AsBoolean; end; // ##### Здвигает порядковые номера после ANPPAfter на -1 ##### procedure TDM.SdvigNPPInMemTable(ANPPAfter: Integer; AMemTable: TkbmMemTable); var RecordNo: Integer; NewNPP: Integer; begin try // Tolik 28/12/2019 -- //if (AMemTable = nil) or (AMemTable.Active = false) then if (AMemTable = nil) or (AMemTable.Active = false) or (aMemTable.RecordCount = 0) then // Exit; ///// EXIT ///// RecordNo := AMemTable.RecNo; AMemTable.First; while not AMemTable.Eof do begin if AMemTable.FieldByName(fnNpp).AsInteger > ANPPAfter then begin NewNPP := AMemTable.FieldByName(fnNpp).AsInteger - 1; AMemTable.Edit; AMemTable.FieldByName(fnNpp).AsInteger := NewNPP; AMemTable.FieldByName(fnisModified).AsBoolean := true; AMemTable.Post; end; AMemTable.Next; end; AMemTable.RecNo := RecordNo; except on E: Exception do AddExceptionToLogEx('TDM.SdvigNPPInMemTable', E.Message); end; end; function TDM.GetNBNormIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; var GUID: String; begin Result := GetTableIDFromGuide(vkNorm, ACurrID, AFormMode, GUID); end; function TDM.GetComponIconByIconType(AIDIcon, AIconType, AIconExt: Integer; AGUIDIcon: String = ''): TMemoryStream; var FName: String; strFilter: String; begin Result := nil; try if TF_Main(GForm).GDBMode = bkNormBase then begin FName := ''; case AIconType of oitProjectible: case AIconExt of ieBLK: FName := fnProjBlk; ieBMP: FName := fnProjBmp; end; oitActive: case AIconExt of ieBLK: FName := fnActiveBlk; ieBMP: FName := fnActiveBmp; end; end; if (FName <> '') and ((AIDIcon > 0) or (AGUIDIcon <> '')) then begin strFilter := ''; if AGUIDIcon <> '' then strFilter := fnGUID+' = '''+AGUIDIcon+'''' else if AIDIcon > 0 then strFilter := fnID+' = '''+IntTOStr(AIDIcon)+''''; if strFilter <> '' then begin SetSQLToQuery(scsQSelect, ' select id, guid, '+FName+' from object_icons where '+strFilter); if (scsQSelect.GetFNAsInteger(fnID) = AIDIcon) or (scsQSelect.GetFNAsString(fnGUID) = AGUIDIcon) then begin Result := TMemoryStream.Create; Result.Position := 0; scsQSelect.FNSaveToStream(FName, Result); Result.Position := 0; end; end; {bkProjectManager: begin SetFilterToSQLMemTable(tSQL_Component, strFilter); if Not tSQL_Component.Eof then begin Result := TMemoryStream.Create; Result.Position := 0; TBlobField(tSQL_Component.FieldByName(FName)).SaveToStream(Result); Result.Position := 0; end; end;} end; end; except on E: Exception do AddExceptionToLog('TDM.GetComponIconByIconType: '+E.Message); end; end; function TDM.GetNormFromSpravochnik(AFormMode: TFormMode; AGUIDNorm: string; AIDMaster: Integer; AOldCurrency, ANewCurrency: TCurrency): TSCSNorm; var IDNorm: Integer; FProjSpravochnik: TSpravochnik; begin Result := nil; FProjSpravochnik := nil; F_NormBase.F_CaseForm.SpinEdit_Kolvo.Properties.ReadOnly := false; if TF_Main(GForm).GDBMode = bkNormBase then begin with TF_Main(GForm) do begin //if ModRes = mrOk then F_NormBase.F_CaseForm.GGUIDToLocate := AGUIDNorm; if F_NormBase.F_CaseForm.Execute(vkNorm, AFormMode) then begin IDNorm := F_NormBase.DM.DataSet_NB_NORMS.FN(fnID).AsInteger; Result := TSCSNorm.Create(TF_Main(GForm).FNormBase, ntNB); Result.LoadNorm(IDNorm, true); end; end; end else if TF_Main(GForm).GDBMode = bkProjectManager then begin FProjSpravochnik := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik; //06.11.2013 TF_Main(GForm).GSCSBase.SCSComponent.ProjectOwner.Spravochnik; if ShowCurrProjectProperties(vkNorm, AGUIDNorm) then if FProjSpravochnik.LastNorm <> nil then begin Result := TSCSNorm.Create(GForm, ntNB); Result.ID := FProjSpravochnik.LastNorm.ID; Result.GuidNB := FProjSpravochnik.LastNorm.GUID; Result.Cypher := FProjSpravochnik.LastNorm.Cypher; Result.Name := FProjSpravochnik.LastNorm.Name; Result.Izm_ := FProjSpravochnik.LastNorm.Izm; Result.LaborTime := FProjSpravochnik.LastNorm.LaborTime; Result.PricePerTime := FProjSpravochnik.LastNorm.PricePerTime; Result.Price := FProjSpravochnik.LastNorm.Price; //SCSNorm.GUIDESmeta := FProjSpravochnik.LastNorm.GUIDESmeta end; end; if Result <> nil then begin Result.IDMaster := AIDMaster; // FIDMaster; Result.NormType := ntProj; if AFormMode = fmMake then Result.IsOn := biTrue; //*** Преобразование валют Result.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, false); Result.IsFromInterface := biFalse; end; end; procedure TDM.DelCatRelByIDCompon(AIDComponent: Integer); var strWhere: String; begin strWhere := 'id_component = '''+IntToStr(AIDComponent)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, ' delete from catalog_relation where '+strWhere); scsQOperat.Close; DeleteComponFromLists(AIDComponent); end; bkProjectManager: begin {if SetFilterToSQLMemTable(tSQL_CatalogRelation, strWhere) then begin tSQL_CatalogRelation.Last; while Not tSQL_CatalogRelation.Bof do tSQL_CatalogRelation.Delete; end;} end; end; end; procedure TDM.DelNormsByMasterID(AIDMaster: Integer; ATableKind: Integer); var StrTableKind: String; begin StrTableKind := IntToStr(ATableKind); case TF_Main(GForm).GDBMode of bkNormBase: begin //*** Удалить ресурсы удаляемой нормы SetSQLToQuery(scsQOperat, ' delete from resources '+ ' where id in (select id_resource from norm_resource_rel '+ ' where (table_kind = '''+IntToStr(ctkNorm)+''') and '+ ' (id_master in (select id from norms '+ ' where (table_kind = '''+StrTableKind+''') and '+ ' (id_master = '''+IntToStr(AIDMaster)+''') ) ) ) '); SetSQLToQuery(scsQOperat, ' delete from norm_resource_rel '+ ' where (table_kind = '''+IntToStr(ctkNorm)+''') and '+ ' (id_master in (select id from norms '+ ' where (table_kind = '''+StrTableKind+''') and '+ ' (id = '''+IntToStr(AIDMaster)+''') ) ) '); //*** Удалить Нормы SetSQLToQuery(scsQOperat, ' delete from norms '+ ' where (table_kind = '''+StrTableKind+''') and '+ ' (id = '''+IntToStr(AIDMaster)+''') '); end; bkProjectManager: begin (*if SetFilterToSQLMemTable(tSQL_Norms, '(id = '''+IntToStr(AIDMaster)+''') and (table_kind = '''+StrTableKind+''')') then begin tSQL_Norms.Last; while Not tSQL_Norms.Bof do begin {SetFilterToSQLMemTable(tSQL_NormResourceRel, '(id_master = '''+IntToStr(tSQL_Norms.FieldByName(fnID).AsInteger)+''') and '+ '(table_kind = '''+IntTostr(ctkNorm)+''')'); tSQL_NormResourceRel.Last; while Not tSQL_NormResourceRel.Bof do begin SetFilterToSQLMemTable(tSQL_Resources, 'id = '''+IntToStr(tSQL_NormResourceRel.FieldByName(fnIDResource).AsInteger)+''''); tSQL_Resources.Last; while Not tSQL_Resources.Bof do tSQL_Resources.Delete; tSQL_NormResourceRel.Delete; end;} tSQL_Norms.Delete; end; end; *) end; end; end; procedure TDM.DelNormByID(AIDNorm: Integer); var strFilter: String; begin strFilter := 'id = '''+IntToStr(AIDNorm)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'delete from norms where '+strFilter); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Norms, strFilter) then // if Not tSQL_Norms.Eof then // tSQL_Norms.Delete; end; end; end; procedure TDM.SaveNorm(AMakeEdit: TMakeEdit; ANormInfo: PNormInfo); var FieldNames: TStringList; begin if ANormInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnCypher); FieldNames.Add(fnName); FieldNames.Add(fnIzm); FieldNames.Add(fnPrice); FieldNames.Add(fnLaborTime); FieldNames.Add(fnPricePerTime); //FieldNames.Add(fnTimeUOM); FieldNames.Add(fnGuidESmeta); case AMakeEdit of meMake: begin if ANormInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnNBNorms, '', FieldNames, ''), false); if ANormInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := ANormInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnNBNorms, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := ANormInfo.ID; end; end; Query_Operat.ParamByName(fnCypher).AsString := ANormInfo.Cypher; Query_Operat.ParamByName(fnName).AsString := ANormInfo.Name; Query_Operat.ParamByName(fnIzm).AsString := ANormInfo.Izm; Query_Operat.ParamByName(fnPrice).AsFloat := ANormInfo.Price; Query_Operat.ParamByName(fnGuidESmeta).AsString := ANormInfo.GUIDESmeta; Query_Operat.ParamByName(fnLaborTime).AsInteger := ANormInfo.LaborTime; Query_Operat.ParamByName(fnPricePerTime).AsFloat := ANormInfo.PricePerTime; //Query_Operat.ParamByName(fnTimeUOM).AsInteger := ANormInfo.TimeUOM; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then ANormInfo.ID := GenIDFromTable(Query_Select, gnNBNormsID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.DelResourcesByMasterID(AIDMaster: Integer; ATableKind: Integer); var StrTableKind: String; begin StrTableKind := IntToStr(ATableKind); case TF_Main(GForm).GDBMode of bkNormBase: begin //SetSQLToQuery(scsQOperat, ' delete from resources '+ // ' where id in (select id_resource from norm_resource_rel '+ // ' where (table_kind = '''+StrTableKind+''') and '+ // ' (id_master = '''+IntToStr(AIDMaster)+''' ) )' ); SetSQLToQuery(scsQOperat, ' delete from norm_resource_rel '+ ' where (table_kind = '''+StrTableKind+''') and '+ ' (id_master = '''+IntToStr(AIDMaster)+''' ) ' ); scsQOperat.Close; end; bkProjectManager: begin (*if SetFilterToSQLMemTable(tSQL_NormResourceRel, '(id_master = '''+IntToStr(AIDMaster)+''') and '+ '(table_kind = '''+IntTostr(ATableKind)+''')') then begin tSQL_NormResourceRel.Last; while tSQL_NormResourceRel.RecordCount > 0 do begin {SetFilterToSQLMemTable(tSQL_Resources, 'id = '''+IntToStr(tSQL_NormResourceRel.FieldByName(fnIDResource).AsInteger)+''''); tSQL_Resources.Last; while Not tSQL_Resources.Bof do tSQL_Resources.Delete; } tSQL_NormResourceRel.Delete; end; end;*) end; end; end; procedure TDM.DelResourceRelByID(AIDResourceRel: Integer); //var strFilter: String; begin //strFilter := 'id = '''+IntTostr(AIDResourceRel)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin //SetSQLToQuery(scsQOperat, 'delete from '+tnNormResourceRel+' where '+ strFilter); //scsQOperat.Close; SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtDelete, tnNormResourceRel, fnID+' = '''+IntToStr(AIDResourceRel)+'''', nil, '')); end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_NormResourceRel, strFilter) then // if Not tSQL_NormResourceRel.Eof then // tSQL_NormResourceRel.Delete; end; end; end; procedure TDM.DelResourceByID(AIDResource: Integer); var strFilter: String; begin strFilter := 'id = '''+IntTostr(AIDResource)+''''; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToQuery(scsQOperat, 'delete from resources where '+ strFilter); scsQOperat.Close; end; bkProjectManager: begin //if SetFilterToSQLMemTable(tSQL_Resources, strFilter) then // if Not tSQL_Resources.Eof then // tSQL_Resources.Delete; end; end; end; procedure TDM.SaveResource(AMakeEdit: TMakeEdit; AResourceInfo: PResourceInfo); var FieldNames: TStringList; begin if AResourceInfo <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnCypher); FieldNames.Add(fnName); FieldNames.Add(fnIzm); FieldNames.Add(fnPrice); FieldNames.Add(fnRType); case AMakeEdit of meMake: begin if AResourceInfo.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnNBResources, '', FieldNames, ''), false); if AResourceInfo.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AResourceInfo.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnNBResources, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AResourceInfo.ID; end; end; Query_Operat.ParamByName(fnCypher).AsString := AResourceInfo.Cypher; Query_Operat.ParamByName(fnName).AsString := AResourceInfo.Name; Query_Operat.ParamByName(fnIzm).AsString := AResourceInfo.Izm; Query_Operat.ParamByName(fnPrice).AsFloat := AResourceInfo.Price; Query_Operat.ParamByName(fnRType).AsInteger := AResourceInfo.RType; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AResourceInfo.ID := GenIDFromTable(Query_Select, gnNBResourcesID, 0); FreeAndNil(FieldNames); end; end; function TDM.GetCurrencyIDFromGuide(ACurrID: Integer; AFormMode: TFormMode): Integer; var GUID: String; begin Result := GetTableIDFromGuide(vkCurrency, ACurrID, AFormMode, GUID); end; procedure TDM.CopyCurrenciesFromOtherObject(AIDSrcCatalog, AIDTrgCatalog: Integer); var IDSrcLevelCatalog: Integer; SrcCatalogCurrencies: TList; begin //*** если целевая папка на нужном уровне if GetParentCatalogIDByLevel(AIDTrgCatalog, dirCurrencyLevel) = AIDTrgCatalog then begin IDSrcLevelCatalog := GetParentCatalogIDByLevel(AIDSrcCatalog, dirCurrencyLevel); if IDSrcLevelCatalog <> 0 then begin SrcCatalogCurrencies := GetObjectCurrencies(IDSrcLevelCatalog, Query_Select); if SrcCatalogCurrencies <> nil then begin if SrcCatalogCurrencies.Count > 0 then begin //*** Очистить валюты целевой папки DeleteObjectCurrencies(AIDTrgCatalog); U_BaseCommon.CreateDefCurrenciesForObject(AIDTrgCatalog, Query_Select, Query_Operat, SrcCatalogCurrencies); end; FreeList(SrcCatalogCurrencies); end; end; end; end; procedure TDM.CreateDefCurrenciesForObject(AIDCatalog: Integer); begin U_BaseCommon.CreateDefCurrenciesForObject(AIDCatalog, Query_Select, Query_Operat); end; procedure TDM.CreateDefCurrenciesForObjectsByLevel; begin U_BaseCommon.CreateDefCurrenciesForObjectsByLevel(Query_Select, Query_Operat); end; procedure TDM.DeleteObjectCurrencies(AIDCatalog: Integer); begin U_BaseCommon.DeleteObjectCurrencies(AIDCatalog, Query_Operat); end; function TDM.GetDefObjectCurrencyByIDCurrency(AIDCurrency: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetDefObjectCurrencyByIDCurrency(AIDCurrency, Query_Select); end; function TDM.GetDefObjectCurrencyByMainFld(AMainValue: Integer): PObjectCurrencyRel; begin Result := U_BaseCommon.GetDefObjectCurrencyByMainFld(AMainValue, Query_Select); end; function TDM.GetObjectCurrencyFromMemTable(AMemTable: TkbmMemTable): PObjectCurrencyRel; begin Result := nil; GetZeroMem(Result, SizeOf(TObjectCurrencyRel)); Result.ID := mtObjectCurrency.FieldByName(fnID).AsInteger; Result.GUID := mtObjectCurrency.FieldByName(fnGUID).AsString; Result.IDCatalog := mtObjectCurrency.FieldByName(fnIDCatalog).AsInteger; Result.IDCurrency := mtObjectCurrency.FieldByName(fnIDCurrency).AsInteger; Result.Data.Name := mtObjectCurrency.FieldByName(fnName).AsString; Result.Data.NameBrief := mtObjectCurrency.FieldByName(fnNameBrief).AsString; Result.Data.Kolvo := mtObjectCurrency.FieldByName(fnKolvo).AsInteger; Result.Data.Ratio := mtObjectCurrency.FieldByName(fnRatio).AsFloat; Result.Data.Main := mtObjectCurrency.FieldByName(fnMain).AsInteger; end; function TDM.GetObjectCurrencyByMainFld(ACatalogID, AMainValue: Integer): PObjectCurrencyRel; begin Result := GetObjectCurrencyByIntFld(ACatalogID, AMainValue, fnMain, Query_Select); end; function TDM.GetObjectCurrencyByIDCurrency(ACatalogID, AIDCurrency: Integer): PObjectCurrencyRel; begin Result := GetObjectCurrencyByIntFld(ACatalogID, AIDCurrency, fnIDCurrency, Query_Select); end; procedure TDM.SetObjectCurrencyToMemTable(AObjectCurrency: PObjectCurrencyRel; AMemTable: TkbmMemTable); begin AMemTable.FieldByName(fnID).AsInteger := AObjectCurrency.ID; AMemTable.FieldByName(fnGUID).AsString := AObjectCurrency.GUID; AMemTable.FieldByName(fnIDCatalog).AsInteger := AObjectCurrency.IDCatalog; AMemTable.FieldByName(fnIDCurrency).AsInteger := AObjectCurrency.IDCurrency; AMemTable.FieldByName(fnName).AsString := AObjectCurrency.Data.Name; AMemTable.FieldByName(fnNameBrief).AsString := AObjectCurrency.Data.NameBrief; AMemTable.FieldByName(fnKolvo).AsInteger := AObjectCurrency.Data.Kolvo; AMemTable.FieldByName(fnRatio).AsFloat := AObjectCurrency.Data.Ratio; AMemTable.FieldByName(fnMain).AsInteger := AObjectCurrency.Data.Main; end; procedure TDM.SetObjectCurrencyAsMain(AObjectID, ANBCurrencyID: Integer); var ptrOldMainCurrency: PObjectCurrencyRel; ptrNewMainCurrency: PObjectCurrencyRel; ptrNewSecondCurrency: PObjectCurrencyRel; begin if AObjectID <> 0 then begin ptrOldMainCurrency := GetObjectCurrencyByMainFld(AObjectID, ctMain); if ptrOldMainCurrency <> nil then begin if ptrOldMainCurrency.IDCurrency <> ANBCurrencyID then begin ptrNewMainCurrency := GetCatalogCurrencyByCurrencyID(AObjectID, ANBCurrencyID); if ptrNewMainCurrency <> nil then begin // Для ptrOldMainCurrency ставим значение, которое было в ptrNewMainCurrency UpdateIntTableFieldByID(tnObjectCurrencyRel, fnMain, ptrOldMainCurrency.ID, ptrNewMainCurrency.Data.Main, qmPhisical); // ptrNewMainCurrency ставим признак что главная UpdateIntTableFieldByID(tnObjectCurrencyRel, fnMain, ptrNewMainCurrency.ID, ctMain, qmPhisical); ptrNewSecondCurrency := GetObjectCurrencyByMainFld(AObjectID, ctSecond); //*** Обновить цены ChangeObjectCurrencyRatiosWithPrices(AObjectID, ptrOldMainCurrency, ptrNewMainCurrency, ptrNewSecondCurrency, Query_Select, Query_Operat); if ptrNewSecondCurrency <> nil then FreeMem(ptrNewSecondCurrency); FreeMem(ptrNewMainCurrency); end; end; FreeMem(ptrOldMainCurrency); end; end; end; procedure TDM.SaveObjectCurrency(AMakeEdit: TMakeEdit; AObjectCurrency: PObjectCurrencyRel); begin U_BaseCommon.SaveObjectCurrency(AMakeEdit, AObjectCurrency, Query_Select, Query_Operat); end; function TDM.GetAllSuppliesKinds: TList; var ptrSuppliesKind: PSuppliesKind; begin Result := TList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnSuppliesKinds, '', nil, fnAll)); while Not Query_Select.Eof do begin GetZeroMem(ptrSuppliesKind, SizeOf(TSuppliesKind)); Result.Add(ptrSuppliesKind); ptrSuppliesKind.ID := Query_Select.FN(fnID).AsInteger; ptrSuppliesKind.Name := Query_Select.FN(fnName).AsString; ptrSuppliesKind.NameTradUOM := Query_Select.FN(fnNameTradUOM).AsString; ptrSuppliesKind.Izm := Query_Select.FN(fnIzm).AsString; ptrSuppliesKind.IzmTradUOM := Query_Select.FN(fnIzmTradUOM).AsString; ptrSuppliesKind.UnitKolvo := Query_Select.FN(fnUnitKolvo).AsFloat; ptrSuppliesKind.UnitKolvoTradUOM := Query_Select.FN(fnUnitKolvoTradUOM).AsFloat; Query_Select.Next; end; end; function TDM.GetSuppliesKindByID(AID: Integer; AGUID: string): TSuppliesKind; var Spravoshnik: TSpravochnik; SprSuppliesKind: TNBSuppliesKind; begin ZeroMemory(@Result, SizeOf(TSuppliesKind)); if (AID <> 0) or (AGUID <> '') then begin Spravoshnik := TF_Main(GForm).GetSpravochnik; SprSuppliesKind := nil; if Spravoshnik <> nil then begin if AGUID <> '' then SprSuppliesKind := Spravoshnik.GetSuppliesKindByGUID(AGUID) else SprSuppliesKind := Spravoshnik.GetSuppliesKindByID(AID); if SprSuppliesKind <> nil then Result := SprSuppliesKind.Data; end; {SetSQLToQuery(scsQSelect, GetSQLByParams(qtSelect, tnSuppliesKinds, 'id = '''+IntToStr(AID)+'''', nil, fnAll)); if scsQSelect.GetFNAsInteger(fnID) = AID then begin Result.ID := scsQSelect.GetFNAsInteger(fnID); Result.Name := scsQSelect.GetFNAsString(fnName); Result.Izm := scsQSelect.GetFNAsString(fnIzm); Result.UnitKolvo := scsQSelect.GetFNAsFloat(fnUnitKolvo); end;} end; end; procedure TDM.InsertSuppliesKindToTopDirType(ASuppliesKind: PSuppliesKind); begin SaveSuppliesKind(meMake, ASuppliesKind); //*** внести в справочник if ASuppliesKind.ID <> 0 then InsertToTopDirTypeItem(ditSuppliesKinds, ASuppliesKind.ID); end; procedure TDM.SaveSuppliesKind(AMakeEdit: TMakeEdit; ASuppliesKind: PSuppliesKind); var FieldNames: TStringList; //IDTopDirectoryType: integer; begin if (TF_Main(GForm).GDBMode <> bkNormBase) or (ASuppliesKind = nil) then Exit; ///// EXIT ///// FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnNameTradUOM); FieldNames.Add(fnIzm); FieldNames.Add(fnIzmTradUOM); FieldNames.Add(fnUnitKolvo); FieldNames.Add(fnUnitKolvoTradUOM); case AMakeEdit of meMake: begin if ASuppliesKind.GUID <> '' then FieldNames.Add(fnGUID); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnSuppliesKinds, '', FieldNames, ''), false); if ASuppliesKind.GUID <> '' then Query_Operat.ParamByName(fnGuid).AsString := ASuppliesKind.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnSuppliesKinds, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := ASuppliesKind.ID; end; end; Query_Operat.ParamByName(fnName).AsString := ASuppliesKind.Name; Query_Operat.ParamByName(fnNameTradUOM).AsString := ASuppliesKind.NameTradUOM; Query_Operat.ParamByName(fnIzm).AsString := ASuppliesKind.Izm; Query_Operat.ParamByName(fnIzmTradUOM).AsString := ASuppliesKind.IzmTradUOM; Query_Operat.ParamByName(fnUnitKolvo).AsFloat := ASuppliesKind.UnitKolvo; Query_Operat.ParamByName(fnUnitKolvoTradUOM).AsFloat := ASuppliesKind.UnitKolvoTradUOM; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then ASuppliesKind.ID := GenIDFromTable(Query_Select, gnSuppliesKindsID, 0); //*** Найти ID верхней папки {IDTopDirectoryType := -1; SetSQLToFIBQuery(Query_Select, 'select id from '+tnDirectoryType+' '+ 'where ('+fnDirItemType+' = '''+IntTostr(ditSuppliesKinds)+''') and (parent_id is null)'); if Query_Select.RecordCount > 0 then IDTopDirectoryType := Query_Select.FN(fnID).AsInteger; if IDTopDirectoryType > 0 then InsertToDirecoryTypeRel(IDTopDirectoryType, ASuppliesKind.ID, GetMasterFNameByDirItemType(ditSuppliesKinds)); } FieldNames.Free; end; function TDM.GetContensCountFromDir(AIDDirType: Integer; ADirTypeInfo: TDirTypeInfo; AWhereStr: string): Integer; var StrWhere: string; begin Result := 0; try StrWhere := 'WHERE ('+fnIDDirectoryType+' = '''+IntTostr(AIDDirType)+''') AND '+ '('+ADirTypeInfo.TableName+'.ID = '+tnDirectoryTypeRel+'.'+ADirTypeInfo.MasterFieldName+')'; if AWhereStr <> '' then StrWhere := StrWhere +' AND '+ AWhereStr; SetSQLToFIBQuery(Query_Select, 'SELECT COUNT('+ADirTypeInfo.TableName+'.ID) FROM '+ADirTypeInfo.TableName+', '+tnDirectoryTypeRel+ ' '+ StrWhere); Result := Query_Select.FN(fnCount).AsInteger; except on E: Exception do AddExceptionToLogEx('TDM.GetContensCountFromDir', E.Message); end; end; function TDM.GetIDDirTypeByName(ADirItemType: Integer; AName: String): Integer; begin Result := 0; SetSQLToFIBQuery(Query_Select, 'select id from '+tnDirectoryType+' '+ 'where ('+fnDirItemType+' = '''+IntTostr(ADirItemType)+''') and ('+fnName+' = '''+AName+''')'); if Query_Select.RecordCount > 0 then Result := Query_Select.FN(fnID).AsInteger; end; function TDM.GetTopIDDirType(ADirItemType: Integer): Integer; begin Result := 0; SetSQLToFIBQuery(Query_Select, 'select id from '+tnDirectoryType+' '+ 'where ('+fnDirItemType+' = '''+IntTostr(ADirItemType)+''') and (parent_id is null)'); if Query_Select.RecordCount > 0 then Result := Query_Select.FN(fnID).AsInteger; end; function TDM.InsertDirTypeFolder(AName: String; ADirItemType, AParentID: Integer): Integer; var FieldNames: TStringList; NewSortID: Integer; begin Result := 0; FieldNames := TStringList.Create; try FieldNames.Add(fnName); FieldNames.Add(fnParentID); FieldNames.Add(fnDirItemType); FieldNames.Add(fnSortID); //*** Определить SortID NewSortID := GetMaxSortIDFromTable(tnDirectoryType, fnParentID, fnSortID, AParentID) + 1; SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnDirectoryType, '', FieldNames, ''), false); Query_Operat.ParamByName(fnName).AsString := AName; SetParamAsInteger0AsNullToQuery(Query_Operat, fnParentID, AparentID); Query_Operat.ParamByName(fnDirItemType).AsInteger := ADirItemType; Query_Operat.ParamByName(fnSortID).AsInteger := NewSortID; Query_Operat.ExecQuery; Result := GenIDFromTable(Query_Select, gnDirectoryTypeID, 0); finally FieldNames.Free; end; end; function TDM.InsertToTopDirTypeItem(ADirItemType, AIDItem: Integer): Integer; var IDTopDirectoryType: Integer; begin Result := 0; if AIDItem > 0 then begin IDTopDirectoryType := GetTopIDDirType(ADirItemType); if IDTopDirectoryType > 0 then Result := InsertToDirecoryTypeRel(IDTopDirectoryType, AIDItem, GetMasterFNameByDirItemType(ADirItemType)); end; end; function TDM.InsertToDirecoryTypeRel(AIDDirectoryType, AIDPointer: Integer; const APointerFieldName: String): Integer; var FieldNames: TStringList; begin Result := -1; FieldNames := TStringList.Create; try FieldNames.Add(fnIDDirectoryType); FieldNames.Add(APointerFieldName); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnDirectoryTypeRel, '', FieldNames, ''), false); Query_Operat.ParamByName(fnIDDirectoryType).AsInteger := AIDDirectoryType; Query_Operat.ParamByName(APointerFieldName).AsInteger := AIDPointer; Query_Operat.ExecQuery; {SQLBuilder(scsQOperat, qtInsert, tnDirectoryTypeRel, '', FieldNames, false); scsQOperat.SetParamAsInteger(fnIDDirectoryType, AIDDirectoryType); scsQOperat.SetParamAsInteger(APointerFieldName, AIDPointer); scsQOperat.ExecQuery;} Result := GenIDFromTable(Query_Select, gnDirectoryTypeRelID, 0); finally FieldNames.Free; end; end; function TDM.InsertToDirTypeItemByDirTypeName(ADirItemType: Integer; ADirTypeName: string; AIDItem: Integer; AOutIDDestDirType: PInteger = nil): Integer; var IDDestDirType: Integer; IDTopDirType: Integer; begin Result := 0; IDDestDirType := GetIDDirTypeByName(ADirItemType, ADirTypeName); if IDDestDirType = 0 then begin IDTopDirType := GetTopIDDirType(ADirItemType); if IDTopDirType <> 0 then IDDestDirType := InsertDirTypeFolder(ADirTypeName, ADirItemType, IDTopDirType); end; if IDDestDirType <> 0 then Result := InsertToDirecoryTypeRel(IDDestDirType, AIDItem, GetMasterFNameByDirItemType(ADirItemType)); if AOutIDDestDirType <> nil then AOutIDDestDirType^ := IDDestDirType; end; function TDM.GetDirectoryTypeByContentItem(AIDItemPointer: Integer; AItemFieldName: String): TDirectoryType; var IDDirType: Integer; begin ZeroMemory(@Result, SizeOf(TDirectoryType)); SetSQlToQuery(scsQSelect, 'select id, '+fnIDDirectoryType+' from '+tnDirectoryTypeRel+' '+ 'where ('+AItemFieldName+' = '''+ IntToStr(AIDItemPointer) +''') '); IDDirType := scsQSelect.GetFNAsInteger(fnIDDirectoryType); if IDDirType > 0 then Result := GetDirectoryTypeByID(IDDirType); end; function TDM.GetDirectoryTypeByID(AID: Integer): TDirectoryType; begin ZeroMemory(@Result, SizeOf(TDirectoryType)); SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnDirectoryType, fnID+' = '''+IntToStr(AID)+'''', nil, fnAll)); Result.ID := Query_Select.FN(fnID).AsInteger; Result.ParentID := Query_Select.FN(fnParentID).AsInteger; Result.Name := Query_Select.FN(fnName).AsString; Result.ContentKolvo := Query_Select.FN(fnContentKolvo).AsInteger; Result.ItemsCount := Query_Select.FN(fnItemsCount).AsInteger; Result.SortID := Query_Select.FN(fnSortID).AsInteger; end; function TDM.GetIDDirTypeRelByIDPointer(AIDPointer: Integer; APointerFieldName: String): Integer; begin Result := 0; SetSQlToQuery(scsQSelect, 'select id from '+tnDirectoryTypeRel+' '+ 'where ('+APointerFieldName+' = '''+ IntToStr(AIDPointer) +''') '); Result := scsQSelect.GetFNAsInteger(fnID); end; function TDM.GetIDDirTypeRelByParams(AIDDirType, AIDPointer: Integer; APointerFieldName: String): Integer; begin Result := 0; //ADirTypeName := ''; SetSQlToQuery(scsQSelect, 'select id from '+tnDirectoryTypeRel+' '+ 'where ('+fnIDDirectoryType+' = '''+ IntToStr(AIDDirType) +''') and '+ '('+APointerFieldName+' = '''+ IntToStr(AIDPointer) +''') '); Result := scsQSelect.GetFNAsInteger(fnID); {SetSQlToQuery(scsQSelect, 'select id, '+fnIDDirectoryType+' from '+tnDirectoryTypeRel+' '+ 'where ('+APointerFieldName+' = '''+ IntToStr(AIDPointer) +''') '); Result := scsQSelect.GetFNAsInteger(fnID); if scsQSelect.GetFNAsInteger(fnID).AsInteger > 0 then ADirTypeName := GetStringFromTableByID(tnDirectoryType, fnName, scsQSelect.GetFNAsInteger(fnIDDirectoryType).AsInteger, qmPhisical);} end; function TDM.GetAllProducers: TList; var ptrProducer: PProducer; begin Result := nil; if TF_Main(GForm).GDBMode = bkNormBase then begin Result := Tlist.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnProducers, '', nil, fnAll)); while Not Query_Select.Eof do begin GetMem(ptrProducer, SizeOf(TProducer)); ptrProducer.ID := Query_Select.FN(fnID).AsInteger; ptrProducer.GUID := Query_Select.FN(fnGuid).AsString; ptrProducer.Name := Query_Select.FN(fnName).AsString; Result.Add(ptrProducer); Query_Select.Next; end; end; end; procedure TDM.SaveProducer(AMakeEdit: TMakeEdit; AProducer: PProducer); var FieldNames: TStringList; begin if AProducer <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnDescription); case AMakeEdit of meMake: begin if AProducer.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnProducers, '', FieldNames, ''), false); if AProducer.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AProducer.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnProducers, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AProducer.ID; end; end; Query_Operat.ParamByName(fnName).AsString := AProducer.Name; Query_Operat.ParamByName(fnDescription).AsString := AProducer.Description; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AProducer.ID := GenIDFromTable(Query_Select, gnProducersID, 0); FreeAndNil(FieldNames); end; end; procedure TDM.RemoveIDComponTemplateFromComponTypes(AIDComponent: Integer); var NBComponentType: TNBComponentType; i: Integer; begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnComponentTypes, fnIDComponTemplate+' = :'+fnParamField, nil, fnIDComponTemplate), false); Query_Operat.ParamByName(fnParamField).AsInteger := AIDComponent; Query_Operat.ParamByName(fnIDComponTemplate).Value := null; Query_Operat.ExecQuery; Query_Operat.Close; for i := 0 to TF_Main(GForm).GSCSBase.NBSpravochnik.ComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(TF_Main(GForm).GSCSBase.NBSpravochnik.ComponentTypes[i]); if NBComponentType.ComponentType.IDComponTemplate = AIDComponent then NBComponentType.ComponentType.IDComponTemplate := 0; end; end; procedure TDM.SaveComponentType(AMakeEdit: TMakeEdit; AComponentType: PComponentType); var FieldNames: TStringList; begin if AComponentType <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnNamePlural); FieldNames.Add(fnSysName); FieldNames.Add(fnPortKind); FieldNames.Add(fnActiveState); FieldNames.Add(fnIsLine); FieldNames.Add(fnisStandart); FieldNames.Add(fnMarkMask); FieldNames.Add(fnCoordZ); FieldNames.Add(fnIDComponTemplate); FieldNames.Add(fnIDDesignIcon); FieldNames.Add(fnCanUseAsPoint); case AMakeEdit of meMake: begin if AComponentType.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnComponentTypes, '', FieldNames, ''), false); if AComponentType.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := AComponentType.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnComponentTypes, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AComponentType.ID; end; end; Query_Operat.ParamByName(fnName).AsString := AComponentType.Name; Query_Operat.ParamByName(fnNamePlural).AsString := AComponentType.NamePlural; Query_Operat.ParamByName(fnSysName).AsString := AComponentType.SysName; Query_Operat.ParamByName(fnPortKind).AsInteger := AComponentType.PortKind; Query_Operat.ParamByName(fnActiveState).AsInteger := AComponentType.ActiveState; Query_Operat.ParamByName(fnIsLine).AsInteger := AComponentType.IsLine; Query_Operat.ParamByName(fnisStandart).AsInteger := AComponentType.IsStandart; Query_Operat.ParamByName(fnMarkMask).AsString := AComponentType.MarkMask; Query_Operat.ParamByName(fnCoordZ).AsFloat := AComponentType.CoordZ; SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDComponTemplate, AComponentType.IDComponTemplate); SetParamAsInteger0AsNullToQuery(Query_Operat, fnIDDesignIcon, AComponentType.IDDesignIcon); Query_Operat.ParamByName(fnCanUseAsPoint).AsInteger := AComponentType.CanUseAsPoint; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then AComponentType.ID := GenIDFromTable(Query_Select, gnComponentTypesID, 0); FreeAndNil(FieldNames); end; end; function TDM.GetComponentTypesFieldValuesAsInteger(const AFieldName: String; const StrWhere: String): TIntList; begin Result := TIntList.Create; case TF_Main(GForm).GDBMode of bkNormBase: begin SetSQLToFIBQuery(Query_Select, ' select '+AFieldName+' from '+tnComponentTypes +' where '+ StrWhere); while not Query_Select.Eof do begin //Result.Add(Query_Select.FN(AFieldName).AsInteger); Result.Add(Query_Select.Fields[0].AsInteger); Query_Select.Next; end; Query_Select.Close; end; bkProjectManager: begin end; end; end; procedure TDM.SaveNetType(AMakeEdit: TMakeEdit; ANetType: PNetType); var FieldNames: TStringList; begin if ANetType <> nil then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); case AMakeEdit of meMake: begin if ANetType.GUID <> '' then FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnNetType, '', FieldNames, ''), false); if ANetType.GUID <> '' then Query_Operat.ParamByName(fnGUID).AsString := ANetType.GUID; end; meEdit: begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnNetType, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := ANetType.ID; end; end; Query_Operat.ParamByName(fnName).AsString := ANetType.Name; Query_Operat.ExecQuery; Query_Operat.Close; if AMakeEdit = meMake then ANetType.ID := GenIDFromTable(Query_Select, gnNetTypeID, 0); FreeAndNil(FieldNames); end; end; function TDM.CheckExistsInputString(AString: String; ATypeS: Integer; AMessageIfExists: Boolean): Boolean; var MessgStr: String; begin Result := false; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnInputStrings, '('+fnTypeS +' = :'+fnTypeS+') and ('+fnName+' = :'+fnName+')', nil, fnID), false); Query_Select.ParamByName(fnTypeS).AsInteger := ATypeS; Query_Select.ParamByName(fnName).AsString := AString; Query_Select.ExecQuery; if Query_Select.RecordCount > 0 then if Query_Select.Fields[0].AsInteger > 0 then begin Result := true; if AMessageIfExists then begin MessgStr := ''; case ATypeS of stUnitsOfMeasure: MessgStr := cDM_Msg10_1; stDimensions: MessgStr := cDM_Msg10_2; end; MessageModal(MessgStr + ' "'+AString+'" '+cDM_Msg10_3, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; end; procedure TDM.LoadInputStringsToTStrings(ATrgStrings: TStrings; ATypeS: Integer); begin ATrgStrings.Clear; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnInputStrings, fnTypeS+' = :'+fnTypeS, nil, fnName), false); Query_Select.SQL.Add(' order by '+fnName); Query_Select.ParamByName(fnTypeS).AsInteger := ATypeS; Query_Select.ExecQuery; ATrgStrings.Clear; while Not Query_Select.Eof do begin ATrgStrings.Add(Query_Select.Fields[0].AsString); //}ATrgStrings.Add(Query_Select.FN(fnName).AsString); Query_Select.Next; end; end; function TDM.SendTextToInputStrings(AText: String; ATypeS: Integer; AMessageIfExists: Boolean): Boolean; var FieldNames: TStringList; NewID: Integer; DirItemType: Integer; begin Result := false; if Not CheckExistsInputString(AText, ATypeS, AMessageIfExists) then begin FieldNames := TStringList.Create; FieldNames.Add(fnName); FieldNames.Add(fnTypeS); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnInputStrings, '', FieldNames, ''), false); Query_Operat.ParamByName(fnName).AsString := AText; Query_Operat.ParamByName(fnTypeS).AsInteger := ATypeS; Query_Operat.ExecQuery; NewID := genIDFromTable(Query_Select, gnInputStringsID, 0); DirItemType := ditNone; case ATypeS of stUnitsOfMeasure: DirItemType := ditUnitsOfMeasure; stDimensions: DirItemType := ditDimensions; end; InsertToTopDirTypeItem(DirItemType, NewID); FreeAndNil(FieldNames); Result := true; end; end; function TDM.SendTextToInputStringsWithAddToTStrings(AText: String; ATypeS: Integer; AMessageIfExists: Boolean; ATrgStrings: TStrings): Boolean; begin Result := SendTextToInputStrings(AText, ATypeS, AMessageIfExists); if Result then if ATrgStrings.IndexOf(AText) = -1 then ATrgStrings.Insert(0, AText); end; function TDM.SaveGuideFile(AID, AFType: Integer; const AName, Aext: String; ADescription: TStrings; AContent: TStream; AContentPacked: Boolean=true): Integer; var FieldNames: TStringList; begin Result := AID; FieldNames := TStringList.Create; FieldNames.Add(fnFileName); FieldNames.Add(fnFileExt); FieldNames.Add(fnFType); if ADescription <> nil then FieldNames.Add(fnDescription); FieldNames.Add(fnContent); if AID = 0 then begin FieldNames.Add(fnGuid); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnFiles, '', FieldNames, ''), false); Query_Operat.ParamByName(fnGUID).AsString := CreateGUID; end else begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnFiles, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := AID; end; Query_Operat.ParamByName(fnFType).AsInteger := AFType; Query_Operat.ParamByName(fnFileName).AsString := AName; Query_Operat.ParamByName(fnFileExt).AsString := AExt; if ADescription <> nil then SetParamAsStringListToQuery(Query_Operat, fnDescription, ADescription, false); SetParamAsStreamToQuery(Query_Operat, fnContent, AContent, Not AContentPacked); Query_Operat.ExecQuery; Query_Operat.Close; if AID = 0 then Result := GenIDFromTable(Query_Select, gnFilesID, 0); FreeAndNil(FieldNames); end; function TDM.GetCADNormStructFromMemTable(AStringsMan: TStringsMan): TCADNormStruct; begin Result := TCADNormStruct.Create; try if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then Result.Izm := tSQL_CADNormStruct.Fields[fiCADNormStruct_Izm].AsString else Result.Izm := AStringsMan.GetStrByID(tSQL_CADNormStruct.Fields[fiCADNormStruct_Izm].AsInteger, AStringsMan.IzmStrings); Result.ID := tSQL_CADNormStruct.Fields[fiCADNormStruct_ID].AsInteger; Result.IDCatalog := tSQL_CADNormStruct.Fields[fiCADNormStruct_IDCatalog].AsInteger; Result.CatalogItemType := tSQL_CADNormStruct.Fields[fiCADNormStruct_IDItemType].AsInteger; Result.Number := tSQL_CADNormStruct.Fields[fiCADNormStruct_Npp].AsString; Result.Name := tSQL_CADNormStruct.Fields[fiCADNormStruct_Name].AsString; Result.Count := tSQL_CADNormStruct.Fields[fiCADNormStruct_Kolvo].AsString; except on E: Exception do AddExceptionToLogEx('TDM.GetCADNormStructFromMemTable', E.Message); end; end; function TDM.GetCADNormColumnFromMemTable(AStringsMan: TStringsMan): TCADNormColumn; var Stream: TStream; begin Result := TCADNormColumn.Create; try Result.ID := tSQL_CADNormColumn.Fields[fiCADNormColumn_ID].AsInteger; Result.IDCADNormStruct := tSQL_CADNormColumn.Fields[fiCADNormColumn_IDCADNormStruct].AsInteger; Result.CableName := tSQL_CADNormColumn.Fields[fiCADNormColumn_Name].AsString; Stream := TMemoryStream.Create; try TBlobField(tSQL_CADNormColumn.Fields[fiCADNormColumn_ChildColumns]).SaveToStream(Stream); Stream.Position := 0; Result.Columns.LoadFromStream(Stream); finally FreeAndNil(Stream); end; except on E: Exception do AddExceptionToLogEx('TDM.GetCADNormColumnFromMemTable', E.Message); end; end; procedure TDM.SaveCADNormStructToMemTable(AMakeEdit: TMakeEdit; ACADNormStruct: TCADNormStruct; AStringsMan: TStringsMan); begin try case AMakeEdit of meMake: begin tSQL_CADNormStruct.Append; tSQL_CADNormStruct.Fields[fiCADNormStruct_ID].AsInteger := ACADNormStruct.ID; end; meEdit: begin tSQL_CADNormStruct.Filtered := false; if tSQL_CADNormStruct.Locate(fnID, ACADNormStruct.ID, []) then tSQL_CADNormStruct.Edit; end; end; if tSQL_CADNormStruct.State <> dsBrowse then begin tSQL_CADNormStruct.Fields[fiCADNormStruct_IDCatalog].AsInteger := ACADNormStruct.IDCatalog; tSQL_CADNormStruct.Fields[fiCADNormStruct_IDItemType].AsInteger := ACADNormStruct.CatalogItemType; tSQL_CADNormStruct.Fields[fiCADNormStruct_Npp].AsString := ACADNormStruct.Number; tSQL_CADNormStruct.Fields[fiCADNormStruct_Name].AsString := ACADNormStruct.Name; tSQL_CADNormStruct.Fields[fiCADNormStruct_Izm].AsInteger := AStringsMan.GenStrID(ACADNormStruct.Izm, AStringsMan.IzmStrings); tSQL_CADNormStruct.Fields[fiCADNormStruct_Kolvo].AsString := ACADNormStruct.Count; tSQL_CADNormStruct.Post; end; except on E: Exception do AddExceptionToLogEx('TDM.SaveCADNormStructToMemTable', E.Message); end; end; procedure TDM.SaveCADNormColumnToMemTable(AMakeEdit: TMakeEdit; ACADNormColumn: TCADNormColumn; AStringsMan: TStringsMan); var Stream: TStream; begin try case AMakeEdit of meMake: begin tSQL_CADNormColumn.Append; tSQL_CADNormColumn.Fields[fiCADNormColumn_ID].AsInteger := ACADNormColumn.ID; end; meEdit: begin tSQL_CADNormColumn.Filtered := false; if tSQL_CADNormColumn.Locate(fnID, ACADNormColumn.ID, []) then tSQL_CADNormColumn.Edit; end; end; if tSQL_CADNormColumn.State <> dsBrowse then begin tSQL_CADNormColumn.Fields[fiCADNormColumn_ID].AsInteger := ACADNormColumn.ID; tSQL_CADNormColumn.Fields[fiCADNormColumn_IDCADNormStruct].AsInteger := ACADNormColumn.IDCADNormStruct; tSQL_CADNormColumn.Fields[fiCADNormColumn_Name].AsString := ACADNormColumn.CableName; Stream := TMemoryStream.Create; try ACADNormColumn.Columns.SaveToStream(Stream); Stream.Position := 0; TBlobField(tSQL_CADNormColumn.Fields[fiCADNormColumn_ChildColumns]).LoadFromStream(Stream); finally FreeAndNil(Stream); end; tSQL_CADNormColumn.Post; end; except on E: Exception do AddExceptionToLogEx('TDM.SaveCADNormColumnToMemTable', E.Message); end; end; function TDM.GetCADCrossObjectFromMemTable(AStringsMan: TStringsMan): TCADCrossObject; begin Result := TCADCrossObject.Create; try if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin Result.ComponTypeSysName := tSQL_CADCrossObject.FieldByName(fnComponTypeSysName).AsString; if tSQL_CADCrossObject.FieldDefs.IndexOf(fnNameShort) <> -1 then Result.ComponNameShort := tSQL_CADCrossObject.FieldByName(fnNameShort).AsString; end else begin Result.ComponTypeSysName := AStringsMan.GetStrByID(tSQL_CADCrossObject.FieldByName(fnComponTypeSysName).AsInteger, AStringsMan.CompTypeSysNameStrings); if tSQL_CADCrossObject.FieldDefs.IndexOf(fnNameShort) <> -1 then Result.ComponNameShort := AStringsMan.GetStrByID(tSQL_CADCrossObject.FieldByName(fnNameShort).AsInteger, AStringsMan.ComponNameShortStrings); end; Result.ID := tSQL_CADCrossObject.FieldByName(fnID).AsInteger; Result.ObjectID := tSQL_CADCrossObject.FieldByName(fnObjectID).AsInteger; Result.ListID := tSQL_CADCrossObject.FieldByName(fnListID).AsInteger; Result.ComponNameMark := tSQL_CADCrossObject.FieldByName(fnComponNameMark).AsString; except on E: Exception do AddExceptionToLogEx('TDM.GetCADCrossObjectFromMemTable', E.Message); end; end; function TDM.GetCADCrossObjectElementFromMemTable(AStringsMan: TStringsMan): TCADCrossObjectElement; begin try Result := TCADCrossObjectElement.Create; if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin Result.CableNameMark := tSQL_CADCrossObjectElement.FieldByName(fnCableNameMark).AsString; end else begin Result.CableNameMark := AStringsMan.GetStrByID(tSQL_CADCrossObjectElement.FieldByName(fnCableNameMark).AsInteger, AStringsMan.ComponNameShortStrings); end; Result.ID := tSQL_CADCrossObjectElement.FieldByName(fnID).AsInteger; Result.IDCADCrossObject := tSQL_CADCrossObjectElement.FieldByName(fnIDCADCrossObject).AsInteger; Result.IDComponent := tSQL_CADCrossObjectElement.FieldByName(fnIDInterface).AsInteger; Result.Npp := tSQL_CADCrossObjectElement.FieldByName(fnNpp).AsString; Result.CableCapacity := tSQL_CADCrossObjectElement.FieldByName(fnCableCapacity).AsInteger; Result.CableDiameter := tSQL_CADCrossObjectElement.FieldByName(fnCableDiameter).AsFloat; if tSQL_CADCrossObjectElement.FieldDefs.IndexOf(fnSignType) <> -1 then Result.SignType := tSQL_CADCrossObjectElement.FieldByName(fnSignType).AsInteger; if tSQL_CADCrossObjectElement.FieldDefs.IndexOf(fnConnectingTraceID) <> -1 then Result.ConnectingTraceID := tSQL_CADCrossObjectElement.FieldByName(fnConnectingTraceID).AsInteger; if tSQL_CADCrossObjectElement.FieldDefs.IndexOf(fnAngle) <> -1 then begin Result.Angle := tSQL_CADCrossObjectElement.FieldByName(fnAngle).AsFloat; Result.InPointX := tSQL_CADCrossObjectElement.FieldByName(fnInPointX).AsFloat; Result.InPointY := tSQL_CADCrossObjectElement.FieldByName(fnInPointY).AsFloat; end; except on E: Exception do AddExceptionToLogEx('TDM.GetCADCrossObjectElementFromMemTable', E.Message); end; end; procedure TDM.SaveCADCrossObjectToMemTable(AMakeEdit: TMakeEdit; ACADCrossObject: TCADCrossObject; AStringsMan: TStringsMan); begin try case AMakeEdit of meMake: begin tSQL_CADCrossObject.Append; tSQL_CADCrossObject.FieldByName(fnID).AsInteger := ACADCrossObject.ID; end; meEdit: begin tSQL_CADCrossObject.Filtered := false; if tSQL_CADCrossObject.Locate(fnID, ACADCrossObject.ID, []) then tSQL_CADCrossObject.Edit; end; end; if tSQL_CADCrossObject.State <> dsBrowse then begin tSQL_CADCrossObject.FieldByName(fnObjectID).AsInteger := ACADCrossObject.ObjectID; tSQL_CADCrossObject.FieldByName(fnListID).AsInteger := ACADCrossObject.ListID; tSQL_CADCrossObject.FieldByName(fnComponTypeSysName).AsInteger := AStringsMan.GenStrID(ACADCrossObject.ComponTypeSysName, AStringsMan.CompTypeSysNameStrings); tSQL_CADCrossObject.FieldByName(fnComponNameMark).AsString := ACADCrossObject.ComponNameMark; tSQL_CADCrossObject.FieldByName(fnNameShort).AsInteger := AStringsMan.GenStrID(ACADCrossObject.ComponNameShort, AStringsMan.ComponNameShortStrings); tSQL_CADCrossObject.Post; end; except on E: Exception do AddExceptionToLogEx('TDM.SaveCADCrossObjectToMemTable', E.Message); end; end; procedure TDM.SaveCADCrossObjectElementToMemTable(AMakeEdit: TMakeEdit; ACADCrossObjectElement: TCADCrossObjectElement; AStringsMan: TStringsMan); begin try case AMakeEdit of meMake: begin tSQL_CADCrossObjectElement.Append; tSQL_CADCrossObjectElement.FieldByName(fnID).AsInteger := ACADCrossObjectElement.ID; end; meEdit: begin tSQL_CADCrossObjectElement.Filtered := false; if tSQL_CADCrossObjectElement.Locate(fnID, ACADCrossObjectElement.ID, []) then tSQL_CADCrossObjectElement.Edit; end; end; if tSQL_CADCrossObjectElement.State <> dsBrowse then begin tSQL_CADCrossObjectElement.FieldByName(fnIDCADCrossObject).AsInteger := ACADCrossObjectElement.IDCADCrossObject; tSQL_CADCrossObjectElement.FieldByName(fnIDInterface).AsInteger := ACADCrossObjectElement.IDComponent; tSQL_CADCrossObjectElement.FieldByName(fnNpp).AsString := ACADCrossObjectElement.Npp; tSQL_CADCrossObjectElement.FieldByName(fnCableCapacity).AsInteger := ACADCrossObjectElement.CableCapacity; tSQL_CADCrossObjectElement.FieldByName(fnCableNameMark).AsInteger := AStringsMan.GenStrID(ACADCrossObjectElement.CableNameMark, AStringsMan.ComponNameShortStrings); tSQL_CADCrossObjectElement.FieldByName(fnCableDiameter).AsFloat := ACADCrossObjectElement.CableDiameter; tSQL_CADCrossObjectElement.FieldByName(fnSignType).AsInteger := ACADCrossObjectElement.SignType; tSQL_CADCrossObjectElement.FieldByName(fnConnectingTraceID).AsInteger := ACADCrossObjectElement.ConnectingTraceID; tSQL_CADCrossObjectElement.FieldByName(fnAngle).AsFloat := ACADCrossObjectElement.Angle; tSQL_CADCrossObjectElement.FieldByName(fnInPointX).AsFloat := ACADCrossObjectElement.InPointX; tSQL_CADCrossObjectElement.FieldByName(fnInPointY).AsFloat := ACADCrossObjectElement.InPointY; tSQL_CADCrossObjectElement.Post; end; except on E: Exception do AddExceptionToLogEx('TDM.SaveCADCrossObjectElementToMemTable', E.Message); end; end; function TDM.GetReportSortInfoList: TObjectList; var ReportSortInfo: TReportSortInfo; StringIndex: Integer; begin Result := TObjectList.Create(false); try SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnReportSortInfo, '', nil, fnAll)); while Not Query_Select.Eof do begin ReportSortInfo := TReportSortInfo.Create(nil); ReportSortInfo.ID := Query_Select.FN(fnID).AsInteger; ReportSortInfo.RepKind := Query_Select.FN(fnRepKind).AsInteger; ReportSortInfo.CaseSensitive := Query_Select.FN(fnCaseSensitive).AsInteger; ReportSortInfo.Descending := Query_Select.FN(fnDescend).AsInteger; SaveToStringListFromQr(Query_Select, ReportSortInfo.UsedFieldNames, fnFieldList, false); Result.Add(ReportSortInfo); // меняем имя поля для ГОСТ каб журнала if ReportSortInfo.RepKind = rtGOSTCableJournal then begin StringIndex := ReportSortInfo.UsedFieldNames.IndexOf(fnMarkID); if StringIndex <> -1 then ReportSortInfo.UsedFieldNames[StringIndex] := fnNameMark; end; Query_Select.Next; end; except on E: Exception do AddExceptionToLogEx('TDM.GetReportSortInfoList: TObjectList', E.Message); end; end; procedure TDM.SaveReportSortInfo(AReportSortInfo: TObject); var FieldNames: TStringList; ReportSortInfo: TReportSortInfo; begin if AReportSortInfo is TReportSortInfo then begin ReportSortInfo := TReportSortInfo(AReportSortInfo); FieldNames := TStringList.Create; FieldNames.Add(fnRepKind); FieldNames.Add(fnCaseSensitive); FieldNames.Add(fnDescend); FieldNames.Add(fnFieldList); if ReportSortInfo.ID = 0 then begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnReportSortInfo, '', FieldNames, ''), false); end else begin SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtUpdate, tnReportSortInfo, fnID+' = :'+fnID, FieldNames, ''), false); Query_Operat.ParamByName(fnID).AsInteger := ReportSortInfo.ID; end; Query_Operat.ParamByName(fnRepKind).AsInteger := ReportSortInfo.RepKind; Query_Operat.ParamByName(fnCaseSensitive).AsInteger := ReportSortInfo.CaseSensitive; Query_Operat.ParamByName(fnDescend).AsInteger := ReportSortInfo.Descending; SetParamAsStringListToQuery(Query_Operat, fnFieldList, ReportSortInfo.UsedFieldNames, false); Query_Operat.ExecQuery; if ReportSortInfo.ID = 0 then ReportSortInfo.ID := GenIDFromTable(Query_Select, gnReportSortInfoID, 0); FreeAndNil(FieldNames); end; end; function TDM.GetUserReportsInfo: TList; var ptrUserReportInfo: PUserReportInfo; begin Result := TList.Create; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnUserReports, '', nil, fnAll), false); Query_Select.SQL.Text := Query_Select.SQL.Text +' order by '+fnName; Query_Select.ExecQuery; while Not Query_Select.Eof do begin GetZeroMem(ptrUserReportInfo, SizeOf(TUserReportInfo)); ptrUserReportInfo.ID := Query_Select.FN(fnID).AsInteger; ptrUserReportInfo.RepKind := Query_Select.FN(fnRepKind).AsInteger; ptrUserReportInfo.Name := Query_Select.FN(fnName).AsString; ptrUserReportInfo.TemplateType := Query_Select.FN(fnTemplateType).AsInteger; ptrUserReportInfo.UseAsShablon := Query_Select.FN(fnUseAsShablon).AsInteger; Result.Add(ptrUserReportInfo); Query_Select.Next; end; end; function TDM.InsertUserReportToBase(AUserReportInfo: TUserReportInfo): Integer; var FieldNames: TStringList; begin Result := 0; FieldNames := TStringList.Create; FieldNames.Add(fnRepKind); FieldNames.Add(fnName); FieldNames.Add(fnTemplateType); FieldNames.Add(fnUseAsShablon); FieldNames.Add(fnRepBlob); SetSQLToFIBQuery(Query_Operat, GetSQLByParams(qtInsert, tnUserReports, '', FieldNames, ''), false); Query_Operat.ParamByName(fnRepKind).AsInteger := AUserReportInfo.RepKind; Query_Operat.ParamByName(fnName).AsString := AUserReportInfo.Name; Query_Operat.ParamByName(fnTemplateType).AsInteger := AUserReportInfo.TemplateType; Query_Operat.ParamByName(fnUseAsShablon).AsInteger := AUserReportInfo.UseAsShablon; if FileExists(AUserReportInfo.RepFileName) then Query_Operat.ParamByName(fnRepBlob).LoadFromFile(AUserReportInfo.RepFileName); Query_Operat.ExecQuery; Result := GenIDFromTable(Query_Select, gnUserReportsID, 0); FreeAndNil(FieldNames); end; function TDM.SaveUserReportByIDToFile(AIDUserReport: Integer; ATrgFile: String): Boolean; begin Result := false; SetSQLToFIBQuery(Query_Select, GetSQLByParams(qtSelect, tnUserReports, fnID+' = '''+IntToStr(AIDUserReport)+'''', nil, fnRepBlob)); if Query_Select.RecordCount > 0 then begin Query_Select.Fields[0].SaveToFile(ATrgFile); if FileExists(ATrgFile) then Result := true; end; end; procedure TDM.OnTimerStoreGuidToReserv(Sender: TObject); var OldCW: Word; begin TimerStoreGuidToReserv.OnTimer := nil; OldCW := Get8087CW; Set8087CW(4978); StoreGuidsInReservGuidTable; //Set8087CW(OldCW); TimerStoreGuidToReserv.OnTimer := OnTimerStoreGuidToReserv; end; procedure TDM.RemoveSystemColorsFromRepository(ARepository: TcxEditRepositoryColorComboBox); var i, j: Integer; CurrColor: TColor; //Indexes: TList; begin if Assigned(ARepository) then begin for i := 0 to ARepository.Properties.Items.Count - 1 do for j := 0 to ARepository.Properties.Items.Count - 1 do begin CurrColor := ARepository.Properties.Items[j].Color; if (CurrColor = clScrollBar) or (CurrColor = clBackground) or (CurrColor = clActiveCaption) or (CurrColor = clInactiveCaption) or (CurrColor = clMenu) or (CurrColor = clWindow) or (CurrColor = clWindowFrame) or (CurrColor = clMenuText) or (CurrColor = clWindowText) or (CurrColor = clCaptionText) or (CurrColor = clActiveBorder) or (CurrColor = clInactiveBorder) or (CurrColor = clAppWorkSpace) or (CurrColor = clHighlight) or (CurrColor = clHighlightText) or (CurrColor = clBtnFace) or (CurrColor = clBtnShadow) or (CurrColor = clGrayText) or (CurrColor = clBtnText) or (CurrColor = clInactiveCaptionText) or (CurrColor = clBtnHighlight) or (CurrColor = cl3DDkShadow) or (CurrColor = cl3DLight) or (CurrColor = clInfoText) or (CurrColor = clInfoBk) or (CurrColor = clHotLight) or (CurrColor = clGradientActiveCaption) or (CurrColor = clGradientInactiveCaption) or (CurrColor = clMenuHighlight) or (CurrColor = clMenuBar) or (CurrColor = clNone) or (CurrColor = clDefault) then begin ARepository.Properties.Items.Delete(j); Break; ///// BREAK ///// end; end; end; end; procedure TDM.MemTable_PropertyAfterEdit(DataSet: TDataSet); begin //MemTable_Property.AfterPost := MemTable_PropertyAfterPost; end; procedure TDM.MemTable_PropertyAfterPost(DataSet: TDataSet); var EditState: TDataSetState; begin //MemTable_Property.AfterPost := nil; //TF_Main(GForm).AfterPostProperty; end; procedure TDM.tSQL_KatalogBeforeInsert(DataSet: TDataSet); begin try TSQLMemTable(DataSet).Filtered := false; except on E: Exception do AddExceptionToLogExt(ClassName, 'tSQL_KatalogBeforeInsert', E.Message); end; end; procedure TDM.tSQL_CableCanalConnectorsBeforeInsert(DataSet: TDataSet); begin try TSQLMemTable(DataSet).Filtered := false; except on E: Exception do AddExceptionToLogExt(ClassName, 'tSQL_CableCanalConnectorsBeforeInsert', E.Message); end; end; procedure TDM.DataSet_INTERFACE_AfterOpen(DataSet: TDataSet); begin {if TF_Main(GForm).GDBMode = bkNormBase then begin if Not DataSet_Interface_Norms.Active then DataSet_Interface_Norms.Open; if Not DataSet_InterfAccordance.Active then DataSet_InterfAccordance.Open; end;} end; procedure TDM.DataSet_INTERFACE_BeforeClose(DataSet: TDataSet); begin {if TF_Main(GForm).GDBMode = bkNormBase then begin if DataSet_Interface_Norms.Active then DataSet_Interface_Norms.Close; if DataSet_InterfAccordance.Active then DataSet_InterfAccordance.Open; end; } end; // ##### Удаление Папки ##### procedure TDM.DataSet_INTERFACE_BeforeScroll(DataSet: TDataSet); begin Exit; end; procedure TDM.MemTable_PropertyEdAfterEdit(DataSet: TDataSet); begin Exit; try if MemTable_PropertyEd.State = dsEdit then MemTable_PropertyEd.FieldByName(fnIsModified).AsBoolean := True; except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PropertyEdAfterEdit', E.Message); end; end; procedure TDM.EditRepositioryCommonPropertiesEditValueChanged( Sender: TObject); var GridSite: TcxGridSite; CustomGridView: TcxCustomGridView; GridView: TcxGridDBTableView; EditRecIndex: Integer; DataSet: TDataSet; begin GridSite := TcxGridSite(TcxCustomEdit(Sender).Parent); CustomGridView := GridSite.GridView; GridView := TcxGridDBTableView(CustomGridView); DataSet := GridView.DataController.DataModeController.DataController.DataSet; EditRecIndex := GridView.DataController.EditingRecordIndex; FDataSetRepository := DataSet; FCurrEditRepositoryItem := TcxEditRepositoryItem(Sender); Timer_RepositoryEditChanged.Enabled := true; end; procedure TDM.Timer_RepositoryEditChangedTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; if TpFIBDataSet(FDataSetRepository).State = dsEdit then TpFIBDataSet(FDataSetRepository).Post; end; procedure TDM.DataSet_nb_norm_resource_relBeforePost(DataSet: TDataSet); begin try if DataSet.State = dsEdit then with TpFIBDataSet(DataSet) do begin FN(fnCost).AsFloat := (FN(fnPrice).AsFloat + FN(fnAdditionalPrice).AsFloat) * FN(fnKolvo).AsFloat; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'DataSet_nb_norm_resource_relBeforePost', E.Message); end; end; procedure TDM.MemTable_PortAfterOpen(DataSet: TDataSet); begin try MemTable_PortInterfRel.Open; except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortAfterOpen', E.Message); end; end; procedure TDM.MemTable_PortBeforeClose(DataSet: TDataSet); begin try MemTable_PortInterfRel.Close; except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortBeforeClose', E.Message); end; end; procedure TDM.MemTable_PortEdAfterOpen(DataSet: TDataSet); begin try if DataSet.Active then MemTable_PortInterfRelEd.Open; except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortEdAfterOpen', E.Message); end; end; procedure TDM.MemTable_PortEdBeforeClose(DataSet: TDataSet); begin try if Not DataSet.Active then MemTable_PortInterfRelEd.Close; except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortEdBeforeClose', E.Message); end; end; procedure TDM.MemTable_PortAfterScroll(DataSet: TDataSet); var CurrPortID: Integer; Port: TSCSInterface; Interf: TSCSInterface; i: Integer; ptrPortInterfRel: PPortInterfRel; begin { if MemTable_PortInterfRel.Active then if MemTable_PortInterfRel.RecordCount = 0 then if DataSet.RecordCount > 0 then begin Port := nil; CurrPortID := DataSet.FieldByName(fnID).AsInteger; if CurrPortID > 0 then begin case TF_Main(GForm).GDBMode of bkNormBase: begin Port := TSCSInterface.Create(GForm); LoadFromMemTableToInterface(Port, TkbmMemTable(DataSet)); Port.LoadPortInterfRels; end; bkProjectManager: Port := TF_Main(GForm).GSCSBase.SCSComponent.GetInterfaceByID(CurrPortID); end; if Assigned(Port) then begin for i := 0 to Port.PortInterfRels.Count - 1 do begin ptrPortInterfRel := Port.PortInterfRels[i]; Interf := nil; case TF_Main(GForm).GDBMode of bkNormBase: begin Interf := TSCSInterface.Create(GForm); Interf.LoadByID(ptrPortInterfRel.IDInterfRel); end; bkProjectManager: Interf := TF_Main(GForm).GSCSBase.SCSComponent.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); end; MemTable_PortInterfRel.Append; MemTable_PortInterfRel.FieldByName(fnID).AsInteger := ptrPortInterfRel.ID; //MemTable_PortInterfRel.FieldByName(fnIDPort).AsInteger := ptrPortInterfRel.IDPort; MemTable_PortInterfRel.FieldByName(fnIDInterfRel).AsInteger := ptrPortInterfRel.IDInterfRel; if Assigned(Interf) then MemTable_PortInterfRel.FieldByName(fnName).AsString := F_NormBase.DM.GetInterfaceNameByID(Interf.ID_Interface); MemTable_PortInterfRel.Post; end; end; if TF_Main(GForm).GDBMode = bkNormBase then Port.Free; end; end; } end; procedure TDM.MemTable_PortBeforeDelete(DataSet: TDataSet); begin try DeleteRecords(TDataSet(MemTable_PortInterfRel)); except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortBeforeDelete', E.Message); end; end; procedure TDM.MemTable_PortEdBeforeDelete(DataSet: TDataSet); begin try DeleteRecords(TDataSet(MemTable_PortInterfRelEd)); except on E: Exception do AddExceptionToLogExt(ClassName, 'MemTable_PortEdBeforeDelete', E.Message); end; end; procedure TDM.MemTable_PortInterfRelAfterOpen(DataSet: TDataSet); begin // end; procedure TDM.FFibErrorHandlerFIBErrorEvent(Sender: TObject; ErrorValue: EFIBError; KindIBError: TKindIBError; var DoRaise: Boolean); begin if KindIBError = keLostConnect then begin DoRaise := false end; end; procedure TDM.Database_SCSLostConnect(Database: TFIBDatabase; E: EFIBError; var Actions: TOnLostConnectActions); var strMessg: String; MesgRes: integer; begin GIsLostConnect := true; try strMessg := cDM_Msg6 + ' '; case TF_Main(GForm).GDBMode of bkNormBase: strMessg := strMessg + cOfNormBase; bkProjectManager: strMessg := strMessg + cOfProjMan; end; strMessg := strMessg +'. '+cDM_Msg7; //*** Если есть открытый проект - сохранить его в файл if CheckIsOpenProject(false) then begin if MessageModal(strMessg + ' '+cDM_Msg8, ApplicationName, MB_ICONEXCLAMATION or MB_YESNO) = IDYES then SaveProjectToFile; end else MessageModal(strMessg, ApplicationName, MB_ICONEXCLAMATION or MB_OK); except on E: Exception do AddExceptionToLogEx('TDM.Database_SCSLostConnect', E.Message); end; Actions := laTerminateApp; //ExitProcess(0); end; procedure TDM.Database_SCSAfterRestoreConnect; begin // end; procedure TDM.MemTable_NormsEdAfterPost(DataSet: TDataSet); begin // end; procedure TDM.MemTable_NormsEdAfterEdit(DataSet: TDataSet); begin // end; procedure TDM.Database_SCSAfterConnect(Sender: TObject); begin FModifiedsCount := 0; end; procedure TDM.FIBQueryAfterExecute(Sender: TObject); var FIBQuery: TpFIBQuery; begin try FIBQuery := TpFIBQuery(Sender); //FIBQuery.SQLType if FIBQuery.RowsAffected > 0 then FModifiedsCount := FModifiedsCount + FIBQuery.RowsAffected; except end; end; end.