Unit U_SCSComponent; interface Uses {Unit_DM_SCS Classes,}Windows, SysUtils, Controls, Variants, Contnrs, FIBDatabase, pFIBDatabase, FIBDataSet, pFIBDataSet, FIBQuery, pFIBQuery, pFIBProps, SQLMemMain, Forms, StdCtrls, Classes, ComCtrls, Dialogs, DrawObjects, PCDrawBox, PCDrawing, PowerCad, Graphics, PCTypesUtils,{ bz2,} idGlobal, IdGlobalProtocols, Math, FMTBcd, DateUtils, XMLIntf, XMLDom, XMLDoc, DB, DBTables, SQLMemExcept, U_SCSLists, U_SCSClasses, U_SCSInterfPath, U_Common_Classes, U_BaseCommon, U_BaseConstants, U_Constants, U_BaseSettings, U_ProtectionCommon, U_TrunkSCS, U_FilterConfigurator{, MSXML2_TLB} {Tolik 27/10/2017 -- }, U_Progress; const cnTSCSComponent = 'TSCSComponent'; cnTSCSInterface = 'TSCSInterface'; cnTSCSList = 'TSCSList'; type TItemType = integer; //TBasicSCSClass = class; TSCSComponent = class; TSCSComponents = class; TSCSCatalog = class; TSCSCatalogs = class; TSCSCrossConnection = class; TSCSInterface = class; TSCSIOfIRel = class; TSCSInterfPosConnection = class; TSCSInterfPositions = class; TSCSInterfPosition = class; TSCSList = class; TSCSNorm = class; TSCSNormsResources = class; TSCSResourceRel = class; TSCSProject = class; TNBCurrency = class; TNBComponentType = class; TNBCompTypeProperty = class; TNBInterface = class; TNBInterfaceAccordance = class; TNBInterfaceNorm = class; TNBNetType = class; TNBNorm = class; TNBObjectIcon = class; TNBProducer = class; TNBProperty = class; TNBPropValRel = class; TNBPropValNormRes = class; TNBResource = class; TNBSuppliesKind = class; TSpravochnik = class; TMemBase = class; TStringsMan = class; TDefectAct = class; TJoinedComponents = record JoinedLines: TSCSComponents; Length: Double; First: TSCSComponent; Last: TSCSComponent; FirstConnCompons: TSCSComponents; LastConnCompons: TSCSComponents; end; PJoinedComponents = ^TJoinedComponents; TConnectorWithLines = record ConnectorObject: TSCSCatalog; ConnectedLines: TSCSCatalogs; TraceSCSIDList: TIntList; end; PConnectorWithLines = ^TConnectorWithLines; TComponentDesignParams = class(TMyObject) private FBottomBound: Double; FDescription: String; FGraphicalImage: TStream; FHeight: Double; FHeightInUnits: Integer; FUnitPos: Integer; FLeftBound: Double; FName: String; FNameShort: String; FNameMark: String; FRightBound: Double; FTopBound: Double; FWidth: Double; public property BottomBound: Double read FBottomBound write FBottomBound; property Description: String read FDescription write FDescription; property GraphicalImage: TStream read FGraphicalImage write FGraphicalImage; property Height: Double read FHeight write FHeight; property HeightInUnits: Integer read FHeightInUnits write FHeightInUnits; property UnitPos: Integer read FUnitPos write FUnitPos; property LeftBound: Double read FLeftBound write FLeftBound; property Name: String read FName write FName; property NameShort: String read FNameShort write FNameShort; property NameMark: String read FNameMark write FNameMark; property RightBound: Double read FRightBound write FRightBound; property TopBound: Double read FTopBound write FTopBound; property Width: Double read FWidth write FWidth; constructor Create; destructor Destroy; override; end; TSCSComponents = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSComponent; procedure SetItem(Index: Integer; ASCSComponent: TSCSComponent); public function Add(ASCSComponent: TSCSComponent): Integer; function Remove(ASCSComponent: TSCSComponent): Integer; function GetComponenByID(AID: Integer): TSCSComponent; function GetComponByIsLine(AIsLine: Integer): TSCSComponent; function GetComponentByType(const ACompTypeSysName: String): TSCSComponent; function GetMaxWholeID: Integer; procedure Insert(Index: Integer; ASCSComponent: TSCSComponent); property Items[index: integer]: TSCSComponent read GetItem write SetItem; default; end; TSCSCatalogs = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSCatalog; procedure SetItem(Index: Integer; ASCSCatalog: TSCSCatalog); public function Add(ASCSCatalog: TSCSCatalog): Integer; function GetByID(AID: Integer): TSCSCatalog; function GetMaxSortID: integer; function Remove(ASCSCatalog: TSCSCatalog): Integer; procedure Insert(Index: Integer; ASCSCatalog: TSCSCatalog); property Items[index: integer]: TSCSCatalog read GetItem write SetItem; default; end; TSCSInterfaces = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSInterface; procedure SetItem(Index: Integer; ASCSInterface: TSCSInterface); public function Add(ASCSInterface: TSCSInterface): Integer; function AddAsSortedByID(ASCSInterface: TSCSInterface): Integer; function GetInterfaceByID(AID: Integer): TSCSInterface; function GetIOfIRels: TSCSObjectList; function GetAsStr: String; function Remove(ASCSInterface: TSCSInterface): Integer; procedure Insert(Index: Integer; ASCSInterface: TSCSInterface); procedure SortByID; property Items[index: integer]: TSCSInterface read GetItem write SetItem; default; end; TSCSLists = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSList; procedure SetItem(Index: Integer; ASCSList: TSCSList); public function Add(ASCSList: TSCSList): Integer; function Remove(ASCSList: TSCSList): Integer; procedure Insert(Index: Integer; ASCSList: TSCSList); property Items[index: integer]: TSCSList read GetItem write SetItem; default; end; TSCSNorms = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSNorm; procedure SetItem(Index: Integer; ASCSNorm: TSCSNorm); public function Add(ASCSNorm: TSCSNorm): Integer; function GetNormByID(AID: Integer): TSCSNorm; function GetNormByGuidNB(AGUID: String; ATakeNormFromUser: Boolean): TSCSNorm; function Remove(ASCSNorm: TSCSNorm): Integer; procedure Insert(Index: Integer; ASCSNorm: TSCSNorm); property Items[index: integer]: TSCSNorm read GetItem write SetItem; default; end; TSCSResources = class(TSCSObjectList) protected function GetItem(Index: Integer): TSCSResourceRel; procedure SetItem(Index: Integer; ASCSResourceRel: TSCSResourceRel); public function Add(ASCSResourceRel: TSCSResourceRel): Integer; function GetResourceByID(AID: Integer): TSCSResourceRel; function GetResourceByIDResource(AIDREsource: Integer): TSCSResourceRel; function Remove(ASCSResourceRel: TSCSResourceRel): Integer; procedure Insert(Index: Integer; ASCSResourceRel: TSCSResourceRel); property Items[index: integer]: TSCSResourceRel read GetItem write SetItem; default; end; TCatalogInfo = class(TMyObject) private FID: Integer; FParentID: Integer; public ComponIDs: array of Integer; property ID: Integer read FID write FID; property ParentID: Integer read FParentID write FParentID; function AddComponID(AID: Integer): Integer; procedure DelComponID(AIndex: Integer); function ComponCount: Integer; Constructor Create; destructor Destroy; override; function IndexOfComponID(AID: Integer): Integer; function RemoveComponID(AID: Integer): Integer; end; TPortInterfRel = record ID: Integer; RelType: Integer; IDPort: Integer; IDInterfRel: Integer; IDInterface: Integer; PortLastKolvo: Integer; UnitInterfKolvo: Integer; PortOwner: TSCSInterface; Interf: TSCSInterface; NewID: Integer; NewIDInterfRel: Integer; IsModified: Boolean; IsNew: Boolean; end; PPortInterfRel = ^TPortInterfRel; TSCSTreeElementType = (teCatalog, teComponent); TSCSComponCatalogClass = class(TBasicSCSClass) private FID: Integer; FIsDeleting: Boolean; FGeneratorIndex: Integer; FPropertyTableName: String; FPropertyMemTable: TSQLMemTable; FMasterFieldName: String; FTreeElementType: TSCSTreeElementType; FProjectOwner: TSCSProject; function AddProperty(AMasterID, AIDProperty: Integer; const AGUIDProperty: String; AIDDataType, ATakeIntoConnect, ATakeIntoJoin, AIsDefault: Integer; const AValue, AName, ASysName: String): PProperty; procedure DefineParams; function GetPropertyAsNew: PProperty; procedure SetActiveForm(Value: TForm); protected FProperties: TList; FNormsResources: TSCSNormsResources; procedure SetFID(Value: Integer); public PropsCount: Integer; NormsCount: Integer; ResourcesCount: Integer; ListID: Integer; property ID : Integer read FID write SetFID default 0; property ProjectOwner: TSCSProject read FProjectOwner write FProjectOwner; property Properties: TList read FProperties write FProperties; property NormsResources: TSCSNormsResources read FNormsResources write FNormsResources; property TreeElementType: TSCSTreeElementType read FTreeElementType; procedure AddPropertyValueAsFloat(const ASysName: String; AValue: Double; aAllowDefine: Boolean=false); // К свойству добавляет значение function AddSimpleProperty(const ASysName, AName, AValue: String; AIDDataType: Integer): PProperty; procedure AssignProperties(AProperties: TList; AFromNew: Boolean = false); function AssignedPropertyBySysName(const ASysName: String): Boolean; procedure Clear; procedure ClearElements; constructor Create(AForm: TForm; ASCSTreeElementType: TSCSTreeElementType); destructor Destroy; override; function GetListOwner: TSCSList; virtual; abstract; function GetPropertyByID(AIDPropRel: Integer): PProperty; function GetPropertyByGUIDProperty(const AGUIDProperty: String): PProperty; function GetPropertyByIDProperty(AIDProperty: Integer): PProperty; function GetPropertyBySysName(const ASysName: String): PProperty; function GetPropertyValueBySysName(const ASysName: String): String; function GetPropertyValueAsBooleanDef(const ASysName: String; ADef: Boolean): Boolean; function GetPropertyValueAsInteger(const ASysName: String): Integer; function GetPropertyValueAsFloat(const ASysName: String): Double; procedure LoadProperties(AIDMaster: Integer); procedure MulPropertyValueAsFloat(const ASysName: String; AValue: Double); // Свойство умножит на значение function PropStrToFloat(const AVal: string): Double; function RemoveProperty(AIDPropRel: Integer): Boolean; overload; function RemoveProperty(AProp: PProperty): Boolean; overload; function RemovePropertyByID(AIDPropRel: Integer): Integer; function RemovePropertyBySysName(const ASysName: String): Boolean; procedure SaveProperties(AIDMaster: Integer); procedure SavePropertiesByServFields(AIDMaster: Integer); procedure SaveProperty(AMakeEdit: TMakeEdit; AProperty: PProperty); procedure SetPropertyValueAsBoolean(const ASysName: String; AValue: Boolean); procedure SetPropertyValueAsFloat(const ASysName: String; AValue: Double; AUpdateInBase: Boolean=false); procedure SetPropertyValueAsString(const ASysName, AValue: String; AUpdateInBase: Boolean=false); overload; procedure SetPropertyValueAsString(AProperty: PProperty; const AValue: String); overload; //procedure SetPropertyValueBySysName(ASysName, AValue: String); end; TSCSComponentType = class(TBasicSCSClass) public ID: Integer; GUID: String; Name: String; NamePlural: String; SysName: String; MarkMask: String; PortKind: Integer; ActiveState: Integer; IDDesignIcon: Integer; GUIDDesignIcon: String; IsLine: Integer; IsStandart: Integer; CoordZ: Double; IDComponTemplate: Integer; ComponentIndex: Integer; end; //*** TSCSComponent TSCSComponent = Class(TSCSComponCatalogClass) private // Properties //18.07.2011 FID: Integer; FLength: Double; //Полная длина (в т.ч. запас) // Get Props function GetIsTop: Boolean; // Set Properties procedure SetActiveForm(Value: TForm); procedure SetFParent(Value: TBasicSCSClass); procedure SetFTreeViewNode(Value: TTreeNode); // Methods procedure AddChildToReferences(ASCSComponent: TSCSComponent); procedure DefineCrossConnectionParamsBeforeSaveAsNew(ACrossConnection: TSCSCrossConnection); procedure RemoveChildFromReferences(ASCSComponent: TSCSComponent); function CheckIOfIInConnectRel(AID_ConCompl: Integer): Boolean; //procedure ApplyLengthKoef(var ALength: Double; ALengthKoef: Double); procedure ApplyLengthData(var ALength, AReserv: Double; AFirstJoinConCompon, ALastJoinConCompon: TSCSComponent; ATakeIntoDiffLists: Boolean = true); procedure ClearFNet; procedure ClearJoinedComponents; function GetImageFromObjectIcons(AIDIcon, AIconExt: Integer; AGUIDIcon: String): TMemoryStream; function GetLengthByComponent(AComponent: TSCSComponent): Double; procedure FreeInterface(AInterface: TSCSInterface); function SaveData(AMakeEdit: TMakeEdit; ACopiing: Boolean): Integer; procedure SaveCableCanalConnector(AMakeEdit: TMakeEdit; ACableCanalConnector: PCableCanalConnector); procedure SaveCompRels(AID_Component: Integer; ACompRelType: Integer); protected FChildReferences: TSCSComponents; FChildComplects: TSCSComponents; //22.08.2007 FAllSCSComplects: TSCSComponents; FJoinedComponents: TSCSComponents; FInterfaces : TSCSInterfaces; FCableCanalConnector: TList; FComplects : TList; FConnections: TList; FCrossConnections: TSCSObjectList; FNet: TList; //*** PJoinedComponents //07.11.2013 FNormsResources: TSCSNormsResources; //FProperties: TList; FTreeViewNode: TTreeNode; FWholeComponent: TIntList; //*** Цельный линейный компонент (ID-ки) Public //*** Поля с таблици ISComplect: SmallInt; IsLine: SmallInt; IsTemplate: ShortInt; IsMarkInCaptions: ShortInt; ServAllLoaded: Boolean; ServCanConnect: Boolean; ServChangedLength: SmallInt; ServChangedMarkID: Boolean; ServChangedNameFromTo: Boolean; ServChangedWholeID: Boolean; ServIsSetToLite: Boolean; ServNoDefinePriceCalcInChild: Boolean; ServNoDelNodeInDiscomplect: Boolean; ServToDelete: Boolean; ServToMark: Boolean; //15.01.2011 - Признак что не ставили маркировку ServPriceisLoaded: Boolean; // 04/07/2017 -- признак того, что цены загружены для текущего проекта NewID: Integer; OldID: Integer; IDNormBase: Integer; GuidNB: String; ObjectID: Integer; //ListID: Integer; IDRelatedCompon: Integer; Name: String; NameShort: String; NameMark: String; MarkID: Integer; MarkStr: String; Cypher: String; IsUserMark: Integer; Izm: String; Notice: String; Description: TMemoryStream; ComponentType: TComponentType; Color: Integer; Picture: TMemoryStream; HasNDS: Integer; ArticulDistributor: String; ArticulProducer: String; ID_ComponentType: Integer; IDSymbol: Integer; IDObjectIcon: Integer; ID_Producer: Integer; ID_CURRENCY : Integer; IDSuppliesKind: Integer; ID_Supplier : Integer; IDNetType: Integer; IDCompSpecification: Integer; //SortID : integer; Whole_ID: Integer; UseKindInProj: Integer; IsDismount: Integer; IsUseDismounted: Integer; ComunicationComponID: Integer; ComunicationPortNum: Integer; ComeFrom: Integer; KolComplect: Integer; CableCanalConnectorsCnt: Integer; InterfCount: Integer; JoinsCount: Integer; GUIDComponentType: String; GUIDSymbol: String; GUIDObjectIcon: String; GUIDProducer: String; GUIDSuppliesKind: String; GUIDSupplier: String; GUIDNetType: String; //20.08.2007 CoordZ: Double; //*** Служебные данные IDCompRel: Integer; IDTopComponent: Integer; CompRelSortID: Integer; Count: Integer; ServDisabledLoadDataElements: TCompDataFlags; ServInterfCntToConnect: Integer; ServCopyIndex: Integer; LinkToComlectRec: PComplect; FirstIDCompon: Integer; //*** конечный компонент 1 FirstCompon: TSCSComponent; LastIDCompon: Integer; //*** конечный компонент 2 LastCompon: TSCSComponent; FirstIDConnectedConnCompon: Integer; LastIDConnectedConnCompon: Integer; OwnerCatalog: TObject; FirstConnectedConnCompon: TSCSComponent; LastConnectedConnCompon: TSCSComponent; PriceSupply: Double; Price: Double; Price_Calc: Double; UserLength: Double; MaxLength: Double; ObjectIconStep: Double; LengthReserv: Double; //Размер запаса // Properties property ActiveForm: TForm read FActiveForm write SetActiveForm default nil; property ChildComplects: TSCSComponents read FChildComplects write FChildComplects; property ChildReferences: TSCSComponents read FChildReferences; property IsTop: Boolean read GetIsTop; property JoinedComponents: TSCSComponents read FJoinedComponents; property Net: TList read FNet; property Length: Double read FLength write FLength; //Полная длина (в т.ч. запас) property Parent: TBasicSCSClass read FParent write SetFParent; property Interfaces: TSCSInterfaces read FInterfaces write FInterfaces; property CableCanalConnectors: TList read FCableCanalConnector write FCableCanalConnector; property Complects : TList read FComplects write FComplects; property Connections: TList read FConnections write FConnections; property CrossConnections: TSCSObjectList read FCrossConnections write FCrossConnections; //property Properties : TList read FProperties write FProperties; property TreeViewNode: TTreeNode read FTreeViewNode write SetFTreeViewNode; property WholeComponent: TIntList read FWholeComponent write FWholeComponent; // Methods Constructor Create(AForm: TForm); overload; Destructor Destroy; override; procedure ClearChilds; Procedure Clear; procedure ClearElements; procedure AddChildComponent(AComponent: TSCSComponent); function AddProperty(AIDProperty: Integer; AGUIDProperty: String; AIDDataType, ATakeIntoConnect, ATakeIntoJoin, AIsDefault: Integer; AValue, AName, ASysName: String): PProperty; procedure AddToChild(AComponent: TSCSComponent); procedure AddToJoined(AJoinedComponent: TSCSComponent); procedure Assign(ASCSCompon: TSCSComponent; ANoSkipLineJoin: Boolean; AWithConnections: Boolean{ = true}; AFromNew: Boolean = false); procedure AssignCrossConnections(ACrossConnections: TSCSObjectList; AFromNew: Boolean = false); procedure AssignDescription(ADescriptionStream: TMemoryStream); procedure AssignOnlyComponent(ASCSCompon: TSCSComponent; AFromNew: Boolean = false); procedure AssignOnlyComponentCommonData(ASrcComponent: TSCSComponent; AIncludingMark: Boolean); procedure AssignCableCanalConnectors(ACableCanalConnectors: TList; AFromNew: Boolean = false); procedure AssignChildComponents(AChildComponents: TSCSComponents; ANoSkipLineJoin: Boolean; AWithConnections: Boolean = true); procedure AssignComplects(AComplects: TList; AFromNew: Boolean = false); procedure AssignCompRels(ASrcCompRels: TList; AConnectType: Integer; AFromNew: Boolean = false); procedure AssignConnections(AConnections: TList; AFromNew: Boolean = false); procedure AssignInterfaces(AInterfaces: TSCSInterfaces; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); procedure AssignNormsResources(ANormsResources: TSCSNormsResources; AFromNew: Boolean = false); procedure AssignPicture(APictureStream: TMemoryStream); procedure CopyFrom(ASourceCompon: TSCSComponent); function CanReplaceWithNBCompon(ANBComponent: TSCSComponent; ALeaveComplects: Boolean): TCheckReplaceComponResults; function CheckCanalHaveCable(ACable: TSCSComponent; var AChannelFemaleInterface, ACableMaleInterface: TSCSInterface): TCanFemaleHaveMaleRes; function CheckCmpByInterfaces(ACMPComponent: TSCSComponent): Boolean; function CheckComplectWith(AChildComponent: TSCSComponent; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; function CheckConnectedByHalfEqualInterfaces(AConnectedCompon: TSCSComponent; AByIDCompRel: Integer; AConnectType: Integer; AEmulate: Boolean): Boolean; function CheckConnectedToInterface(AInterface: TSCSInterface): Boolean; function CheckEqualInterfaces(AByTypeI: Integer): Boolean; function CheckForRotate(ARelatedToRotate: TSCSComponents): Boolean; function CheckIntrfacesVariousBusyEmpty(AInterfaces1, AInterfaces2: TList; ACheckIsBusy: Boolean = false): Boolean; function CheckJoinTo(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer; ACanConnBusyMultiple: Boolean = false; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; ACanJoinWithNoInterfaces: Boolean = false; ACanJoinWithNoParams: Boolean = false): TConnectInterfRes; function CheckJoinToListCompons(AListCompons: TSCSComponents; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; function CheckJoinToSeveralCompons(ACompon1, ACompon2: TSCSComponent; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; function CheckJoinToComponOrChilds(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer): TConnectInterfRes; function CheckJoinToSame: Boolean; function CheckJoinedByAllPosibleInterfaces(AJoinedComponent: TSCSComponent; AsideCompon1, AsideCompon2: Integer): Boolean; function ConnectWith(AComponent: TSCSComponent; ASideCompon1, ASideCompon2, AIDCompRel, AMaxInterfCountToConnect: Integer; AConnectType: TConnectType; ASimulation, ACanConnBusyMultiple, ACanWithNoInterfaces, ACanWithNoParams: Boolean; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; AIsFinalConnection: Boolean = true): TConnectInterfRes; function ComplectWith(AChildComponent: TSCSComponent; AIDCompRel: Integer = -1; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): PComplect; function ConnectWithOnlyObject(AComponent: TSCSComponent; AConnectType: TConnectType): PComplect; function ComplectWithOnlyObject(AChildComponent: TSCSComponent): PComplect; procedure DefineComplectsLinks; function DefinedComponByPortMultiport: TSCSComponent; procedure DefineFirstLastInNet; procedure DefineIDComRelChildCompons; procedure DefineIDsBeforeSaveAsNew{(AParentComponent: TSCSComponent; ALastTablesIDs: PTablesID; var ALastNppPort, AStepIndex: Integer)}; procedure DefineInterfaceNorms(ACanHaveActiveComponents: Boolean); procedure DefineLengthsOfNetThreads; procedure DefineNameMarks; procedure DefineNppInterfaces; procedure DefineNppPorts(aComponLocation: TSCSComponent); function DelConnected(AComponent: TSCSComponent; AIDTopComponent, AIDCompRel, AConnectType: TConnectType): Boolean; function DelConnectedAsNoFinal(AComponent: TSCSComponent; AConnectType: TConnectType): Boolean; procedure DisComplectChildComponent(AChildComponent: TSCSComponent); procedure DisConnectFromParent; function DisJoinFrom(AComponent: TSCSComponent): Boolean; function DisJoinFromAll(AAccountChildCompon: Boolean; AAccountInternalJoin: Boolean = false): TSCSComponents; function JoinWithOnlyObject(AComponent: TSCSComponent): PComplect; function ExistsCrossComponInChilds: Boolean; function FreeInterfaceByID(AIDInterRel: Integer): Boolean; procedure FreeInterfacesByNumPair(ANumPair: Integer); function GenCompRelSortID: Integer; function GetCableCanalConnectorByID(AID: Integer): PCableCanalConnector; function GetCCEByIDConnector(AIDConnector: Integer): PCableCanalConnector; function GetCableCanalIDNBConnectorByType(AConnectorType: Integer; AWithStoreInNB: Boolean; AFindedIDs: TIDStringList): TIntList; function GetCablesVolume(AWithOutCable: TSCSComponent = nil): Double; function GetComplectByID(AID: Integer): PComplect; function GetComplectByIDChild(AIDChild: Integer): PComplect; function GetComponentFromReferences(AIDComponent: Integer): TSCSComponent; function GetCompRelByConnectedCompon(AConnectedComponent: TSCSComponent; AConnectType: Integer): PComplect; function GetCompRelByIDFromList(AID: Integer; AList: TList): PComplect; function GetConnectedInterfacesToCompon(AConnectedComponent: TSCSComponent): TInterfLists; function GetConnectedInterfacesToNoCompon(AConnectedNoComponent: TSCSComponent; ASelfSide: Integer): TInterfLists; function GetConnectionByConnected(AConnectedCompon: TSCSComponent): PComplect; function GetConnectionByID(AID: Integer): PComplect; function GetCrossConnectionByID(AID: Integer): TSCSCrossConnection; function GetFilling(AByIsPort, AByInterfType: Integer; AByWholeComponent, ARecursive: Boolean; aLoadWholeCompon: Boolean=true): TFillConnectConObj; function GetFirstParentCatalog: TSCSCatalog; function GetFullnessPercentCableCanal: Double; function GetGraphicalImageBlk: TMemoryStream; function GetIOfIRelByInterfaceOwnerOrTo(AInterface: TSCSInterface; ARecursive: Boolean): TSCSIOfIRel; function GetInterfaceAsNew: TSCSInterface; function GetInterfaceByID(AIDInterfRel: Integer; ARecursive: Boolean = false): TSCSInterface; function GetInterfaceByIDConnected(AIDConnected: Integer): TSCSInterface; function GetInterfacesConnectedToInterface(AInterface: TSCSInterface): TSCSInterfaces; function GetInterfacesConnectedToInterfaceOtherCompon(AInterface: TSCSInterface): TSCSInterfaces; function GetInterfacesConnectedToConnCompon(AInterface: TSCSInterface; AResConnComponPath: TSCSComponents; AJoinedInterfacesToResult: TSCSInterfaces): TSCSInterfaces; function GetInterfacesConnectedToEndLineCompon(AInterface: TSCSInterface; AStepIndex: Integer = 0): TSCSInterfaces; function GetInterfaceConnectedWithCompon(ASelfInterface: TSCSInterface; AConnectCompon: TSCSComponent): TSCSInterface; function GetInterfcesCountByType(AInterfType: Integer): Integer; function GetInterfcesCountByTypeIsBusySide(AType, AIsBusy, ASide: Integer): Integer; function GetInterfaceCountToConnect(ASide: Integer): Integer; function GetInterfaceCountToConnectBySide(ASide: Integer): Integer; function GetInterfacesByIsBusyAndType(AIsBusy, AType: Integer; AAccountChildCompons: Boolean): TList; function GetInterfacesByIsPort(AIsPort: Integer; ARecursive: Boolean; aIsBusy: Integer=-1; aDest: TSCSInterfaces=nil): TSCSInterfaces; function GetInterfacesBySide(ASide: Integer): TList; function GetInterfacesBySides: TInterfLists; function GetInterfacesThatConnectComponent(AConnectedComponent: TSCSComponent): TInterfLists; function GetItemType: TItemType; function GetJoinedPointComponent: TSCSComponent; function GetLastNppInterface(const AGUIDInterface: string; AIsPort: Integer; ANoInCompon: TSCSComponent): Integer; //20.08.2012 function GetLastNppPort: Integer; //20.08.2012 - Вернет максимальный номер порта компонента function GetListOwner: TSCSList; override; function GetNewNumPair: Integer; //Tolik //function GetMaxNppPort: Integer; function GetMaxNppPort(aInterfaceGuid: string = ''): Integer; // function GetNameForVisible(AWithComponCount: Boolean = false): String; function GetObjectIconBlk: TMemoryStream; function GetParentComponent: TSCSComponent; function GetPartLength: Double; function GetPort: TSCSInterface; function GetPortInterfRelByIDInterfRel(AIDInterfRel: Integer): PPortInterfRel; function GetPortJoinedToLine(ALineComponent: TSCSComponent): TSCSInterface; function GetPortKind: TPortKind; function GetPortMultiPortNameMarks: TStringList; function GetPropertyAsNew: PProperty; function GetTopComponent: TSCSComponent; function GetTopParentCatalog: TSCSCatalog; function GetTopPortMultiportCompon: TSCSComponent; function HaveInterfaceByGUIDInterface(AGUIDInterface: string): Boolean; function HaveJoinWithOtherObject: Boolean; function IsCrossComponent: Boolean; function JoinTo(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer; ACanConnBusyMultiple: Boolean = false; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; AMaxInterfCount: Integer = -1; AIsFinalConnection: Boolean = true; ACanWithNoInterfaces: Boolean = false; ACanJoinWithNoParams: Boolean = false): TConnectInterfRes; function JoinToAsNoFinal(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer): TConnectInterfRes; procedure LoadNet(const AGUIDJoinedNetType: String = ''); procedure LoadPropertyesFromComponentType; procedure NotifyChange; procedure ApplyChanges; //29.06.2013 - применяет изменения на КАД function Ping(AComponent: TSCSComponent; aBreakCompon: TObject = nil): Boolean; procedure ReloadChildReferences; procedure RefreshComponentType; procedure RefreshInterfacesJoining; procedure RefreshPriceAfterChangeNDS(AOldNDS, ANewNDS: Double; ASave: Boolean); procedure RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean; ARecursive: Boolean = true); procedure RefreshWholeLengthIfNecessary; procedure RefreshWholeLengthInFuture(aWholeComponObj: TSCSComponents=nil); procedure RemoveChildComponent(AComponent: TSCSComponent); procedure RemoveJoinedComponent(AComponent: TSCSComponent); function Rotate(ACheckToRotate: Boolean; ARelatedToRotate: TSCSComponents): Boolean; procedure SaveCableCanalConnectorsByServFields; procedure SaveCrossConnectionsByServFields; procedure SetInterfacesJoining(AJoinedComponent: TSCSComponent); procedure SetInterfacesParallel; procedure SetInterfacesComplect; procedure SetPortInterfRelInterfaces; procedure SortComplects; //20.08.2007 procedure UpdateChangedFields; procedure LoadOwnerCatalog(AByFinding: Boolean); procedure LoadComponentByID(AID_Component: Integer; ALoadCompData: Boolean = true; ALoadSQL: Boolean = true; AClearBeforeLoad: Boolean = true); procedure LoadComponentByFi(AFieldIndexses: TIntSet); // Fi - FieldIndexes procedure LoadComponentData(ADataFlags: TCompDataFlags); function SaveComponentAsNew(ASaveCompl, ACopiing: Boolean): Integer; procedure SaveComponent; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean); procedure LoadFromDataStream(ADataStream: TDataStream; AStringsMan: TStringsMan); procedure SaveToDataStream(ADataStream: TDataStream; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean); procedure LoadComponentType; //22.08.2007 procedure LoadAllSCSComplects(ALoadCompData: TCompDataFlags); procedure LoadWholeComponent(ARecursive: Boolean; AWholeObj: Pointer=nil); function GetWholeLength(ATakeIntoThroghObjects: Boolean=true; AWholeComponObj: TSCSComponents=nil): Double; procedure LoadWholeLength(ATakeIntoThroghObjects: Boolean=true; AWholeComponObj: TSCSComponents=nil); procedure RefreshWholeLength(ATakeIntoThroghObjects: Boolean = true); //procedure RefreshWholeLengthAfterChangeObjectLength(AOldObjLength, ANewObjLength: Double); procedure LoadCurrLength; function AddCCEToList(AIDConnector, AConnectorType: Integer): PCableCanalConnector; procedure LoadCableCanalConnectors; procedure LoadChildComplects(ARecursive, ADevideComplects, ACompData: Boolean; AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0; AIndexOfLoading: Integer = 0); procedure LoadChildComplectsQuick(ARecursive, ARegroup, ACompData: Boolean; AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0{; AIndexOfLoading: Integer = 0}); procedure LoadComplects(AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0; ALoadSQL: Boolean = true); procedure LoadCompRel(AConnectType: TConnectType; var ACompRelList: TList; AIDTopComponent, AIDParentCompRel: Integer; ALoadSQL: Boolean = true); procedure LoadConections; procedure LoadCrossConnections; procedure LoadProperties; procedure LoadInterfaces(AIDInterface: Integer = -1; ALoadIOfIRel: Boolean = true; ALoadSQL: Boolean = true); procedure LoadInterfacesByFi(AFieldIndexses: TIntSet); // Fi - FieldIndexes procedure SaveComplects(AID_Component: Integer); procedure SaveConnections(AID_Component: Integer); procedure SaveCableCanalConnectors(AID_Component: Integer); procedure SaveCrossConnectionsAsNew; procedure SaveInterfaces(AID_Component: Integer; AAutoIDComplRel: Boolean = true); procedure SaveInterfacesByServFields; procedure SaveProperties(AID_Component: Integer); function GetNotBusyInterfCount: Integer; procedure EmSetNoBusyInterf; procedure RepairKolComplect; procedure DivideComplects; procedure DefineFirstLast(AWithOrderInList: Boolean = false); function DefineInterfCountToConnect: Integer; function GetIDListWithAllSCSComplects(AAddCurrIDComponToList: Boolean): TList; function GetAllInterfIDCompon: TList; function GetInterfIDLineCompon(AID_Component: Integer = -1): TInterfLists; function GetVolume(AGenderInterface: Integer; AGUIDInterface: String = ''; AWithMaxVolume: Boolean = false): Double; function GetInterfaceByTypeAndGender(ATypes, AGenders: TIntSet; AIsMultiple: Integer; AGUIDInterface: String = ''; AWithMaxVolume: Boolean = false; ACanLoad: Boolean=true): TSCSInterface; function HaveInterfaceByType(AInterfType: TInterfType): Boolean; function HaveMultipleInterface(CheckFunctional: Boolean = false): Boolean; function GetProducerName: String; end; // Свойство TSCSProperty = class(TMyObject) //(TBasicSCSClass) private FPropNormResRels: TList; public Guid: String; ID: Integer; ID_Property: Integer; GUIDProperty: String; IDMaster: Integer; IDDataType: Integer; IDCrossProperty: Integer; GUIDCrossProperty: String; Name: String; SysName: String; Value: String; TakeIntoConnect: ShortInt; TakeIntoJoin: ShortInt; IsTakeJoinforPoint: ShortInt; IsCrossControl: ShortInt; IsDefault: ShortInt; IsForWholeComponent: ShortInt; NewID: Integer; IsNew: Boolean; IsModified: Boolean; constructor Create(AActiveForm: TForm); destructor Destroy; override; end; // ИНТЕРФЕЙС TInterfaceElement = (iePortInterface, ieIOfIRel); TInterfaceElements = set of TInterfaceElement; TSCSInterface = class(TBasicSCSClass) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure LoadFromQuery(AQuery: TpFIBQuery); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); protected FComponentOwner: TSCSComponent; FIOfIRelOut: TSCSObjectList; FInternalConnected: TSCSInterfaces; FConnectedInterfaces: TSCSInterfaces; //*** PInterfaces FParallelInterface: TSCSInterface; FPortInterfaces: TSCSInterfaces; FPortInterfRels: TList; FPortOwner: TSCSInterface; FBusyPositions: TList; public ID: Integer; NewID: Integer; NewIDAdverse: Integer; Npp: Integer; Name: String; ID_Interface: Integer; ID_Component: Integer; ID_NewComponent: Integer; IsLineCompon: Integer; TypeI : Integer; Kind: Integer; IsPort: Integer; IsUserPort: Integer; NppPort: Integer; IDConnected: integer; Gender: Integer; Multiple: Integer; IsBusy: Integer; NumPair: Integer; Color: Integer; IDAdverse: Integer; Side: Integer; Notice: String; SortID: Integer; Kolvo: Integer; KolvoBusy: Integer; //*** Количество занятых интерфейсов - может превышать реальное количество при многократном подключении SignType: Integer; ConnToAnyGender: ShortInt; SideSection: String; GUIDInterface: string; IOfIRelCount: Integer; PortInterfRelCount: Integer; ValueI: Double; CoordZ: Double; IsModified: Boolean; IsNew: Boolean; ServCanConnect: Boolean; ServIsBusy: Integer; ServDisabled: Boolean; ServSimulateKolvoBusy: Integer; property ComponentOwner: TSCSComponent read FComponentOwner write FComponentOwner; property IOfIRelOut: TSCSObjectList read FIOfIRelOut write FIOfIRelOut; property InternalConnected: TSCSInterfaces read FInternalConnected write FInternalConnected; property ConnectedInterfaces: TSCSInterfaces read FConnectedInterfaces write FConnectedInterfaces; property ParallelInterface: TSCSInterface read FParallelInterface write FParallelInterface; property PortInterfaces: TSCSInterfaces read FPortInterfaces write FPortInterfaces; property PortInterfRels: TList read FPortInterfRels write FPortInterfRels; property PortOwner: TSCSInterface read FPortOwner write FPortOwner; property BusyPositions: TList read FBusyPositions write FBusyPositions; function AddInterfaceToPort(AInterface: TSCSInterface): Integer; function AddToConnectedInterfaces(AInterface: TSCSInterface): Integer; procedure Assign(AInterface: TSCSInterface; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); procedure AssignIOfIRelOut(AIOFIRel: TSCSObjectList; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); procedure AssignPortInterfRel(APortInterfRels: TList; AFromNew: Boolean = false); procedure AssignOnlyInterface(AInterface: TSCSInterface); procedure AssignFromSpr(ASprInterf: TNBInterface); procedure DefineIsBusy; function CheckJoinToComponent(AComponent: TSCSComponent): Boolean; procedure Clear; procedure ClearIOfIRels; procedure ClearPortInterfaces; constructor Create(AFormOwner: TForm); overload; destructor Destroy; override; procedure DefineInternalRelations; procedure FreeIOfIRel(AIOfIRel: TSCSIOfIRel; ADefineIsBusy: Boolean = true); function GetColJoinedWithNoMultiple: Integer; function GetEmptyPositions(AMaxPosCount: Integer=-1): TSCSInterfPositions; function GetIOfIByIDInterfTo(AIDInterfTo: Integer): TSCSIOfIRel; function GetIOfIRelsByRange(aFromPos, aToPos: Integer): TSCSObjectList; function GetInterfToIDs: TIntList; function GetInterfToValues: Double; // Вернет путь прохождения функционального интерфейса function GetInterfPath(AFromPos: Integer=0; AToPos: Integer=0; AWithSide: Boolean=true): TInterfPath; function GetIsMultiple: Boolean; function GetNameForVisible: String; function GetPortInterfRelByInterfID(AIDInterRel: Integer): PPortInterfRel; procedure LoadByID(AID: Integer); function LoadName: String; procedure LoadIOfIRels(ALoadSQL: Boolean = true); procedure LoadPortInterfaces(ALoadSQL: Boolean = true); procedure LoadPortInterfRels(ALoadSQL: Boolean = true); procedure RefreshPortInterfaces; procedure RemoveFromAllReferences(AConnectedInterfaces: TSCSinterfaces=nil); function RemoveInterfaceFromPort(AInterface: TSCSInterface): Integer; function RemovePortInterfRelByID(AIDPortInterfRel: Integer): Boolean; function RemovePortInterfRelByIDInterfRel(AIDInterfRel: Integer): Boolean; procedure Save; procedure SaveAsNew; procedure SaveData(AMakeEdit: TMakeEdit); procedure SaveIOfIRel(AMakeEdit: TMakeEdit; AIOfIRel: TSCSIOfIRel); procedure SaveIOfIRels(AMakeEdit: TMakeEdit); procedure SavePortInterfRel(AMakeEdit: TMakeEdit; APortInterfRel: PPortInterfRel); procedure SavePortInterfRels(AMakeEdit: TMakeEdit); procedure SavePortInterfRelsByServFields; end; TSCSIOfIRel = class(TMyObject) protected FCompRel: PComplect; FInterfaceOwner: TSCSInterface; FInterfaceTo: TSCSInterface; //PInterface; FPosConnections: TObjectList; public ID: Integer; NewID: Integer; IDInterfRel: Integer; IDInterfTo: Integer; IDCompRel: Integer; IDIOfIRelMain: Integer; // ID Главного такого же объекта, если это часть соединения по совместимости интерфейсов PosConnectionsCount: Integer; //18.01.2014 //*** Service fileds NewIDInterfRel: Integer; NewIDInterfTo: Integer; //*** Служебные данные для IDCompRel NewIDCompon: Integer; NewIDChild: Integer; property CompRel: PComplect read FCompRel write FCompRel; property InterfaceOwner: TSCSInterface read FInterfaceOwner write FInterfaceOwner; property InterfaceTo: TSCSInterface read FInterfaceTo write FInterfaceTo; property PosConnections: TObjectList read FPosConnections write FPosConnections; procedure Assign(AIOfIRel: TSCSIOfIRel); procedure AssignOnlyIOfIRel(AIOfIRel: TSCSIOfIRel); procedure AssignPosConnections(APosConnections: TObjectList); procedure Clear; constructor Create(AInterfaceOwner: TSCSInterface); destructor Destroy; override; end; TSCSInterfPosConnection = class(TMyObject) private function GetNewInterfPosition: TSCSInterfPosition; protected FOwner: TSCSIOfIRel; FSelfInterfPosition: TSCSInterfPosition; FConnInterfPosition: TSCSInterfPosition; public ID: Integer; IDIOIRel: Integer; property Owner: TSCSIOfIRel read FOwner; property SelfInterfPosition: TSCSInterfPosition read FSelfInterfPosition write FSelfInterfPosition; property ConnInterfPosition: TSCSInterfPosition read FConnInterfPosition write FConnInterfPosition; procedure Assign(AInterfPosConnection: TSCSInterfPosConnection); constructor Create(AOwner: TSCSIOfIRel; ACreatePositions: Boolean); destructor Destroy; override; end; TSCSInterfPositions = class(TMyObject) private FKolvo: Integer; protected FPositions: TObjectList; public property Kolvo: Integer read FKolvo write FKolvo; property Positions: TObjectList read FPositions write FPositions; procedure Assign(ASrc: TSCSInterfPositions; AWithInterOwner: Boolean); procedure Clear; constructor Create; procedure DefineKolvo; destructor Destroy; override; procedure ZeroPositions; end; TSCSInterfPosition = class(TMyObject) protected FFromPos: Integer; FToPos: Integer; FInterfOwner: TSCSInterface; FInterfPosConnectionOwner: TSCSInterfPosConnection; public property FromPos: Integer read FFromPos write FFromPos; property ToPos: Integer read FToPos write FToPos; property InterfOwner: TSCSInterface read FInterfOwner write FInterfOwner; property InterfPosConnectionOwner: TSCSInterfPosConnection read FInterfPosConnectionOwner write FInterfPosConnectionOwner; constructor Create(AInterfOwner: TSCSInterface); function GetConnectedPos: TSCSInterfPosition; // вернет подключенную позицию с подключенного интерфейса destructor destroy; override; // Tolik 12/12/2019 -- end; TSCSCrossConnection = class(TBasicSCSClass) protected FCompRelFromPath: TIntList; FCompRelToPath: TIntList; FCompRelWithPath: TIntList; public ID: Integer; IDComponent: Integer; IDComponFrom: Integer; IDComponTo: Integer; IDComponWith: Integer; IDCompRelFrom: Integer; IDCompRelTo: Integer; IDCompRelWith: Integer; OldIDCompRelFrom: Integer; OldIDCompRelTo: Integer; OldIDCompRelWith: Integer; NameFrom: string; NameTo: string; NameWith: string; NppFrom: Integer; NppTo: Integer; NppWith: Integer; IsNew: Boolean; IsModified: Boolean; property CompRelFromPath: TIntList read FCompRelFromPath write FCompRelFromPath; property CompRelToPath: TIntList read FCompRelToPath write FCompRelToPath; property CompRelWithPath: TIntList read FCompRelWithPath write FCompRelWithPath; procedure Assign(ACrossConnection: TSCSCrossConnection); constructor Create(AActiveForm: TForm); destructor Destroy; override; procedure LoadFromQuery(AQuery: TpFIBQuery); procedure Save(AMakeEdit: TMakeEdit; ASavePaths: Boolean); procedure SavePaths; end; // ######################################################################### //*** TSCSCatalog TSCSCatalog = class(TSCSComponCatalogClass) private //07.11.2013 FID: Integer; FComponTypeSysName: String; FGUIDComponentType: String; FGUIDDesignIcon: String; FGUIDJoinedNetType: String; FDesignIconType: Integer; FLength: Double; FNotes: TStringList; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); //virtual; // GetProperties function GetFIsLine: Integer; procedure SetFIsDeleting(Value: Boolean); procedure SetFLength(Value: Double); procedure SetFParent(Value: TBasicSCSClass); virtual; procedure SetFTreeViewNode(Value: TTreeNode); // Methods procedure AddChildToReferences(ASCSCatalog: TSCSCatalog; ACanDefineProjectOwner: Boolean = true); procedure RemoveChildFromReferences(ASCSCatalog: TSCSCatalog); procedure AddComponentToReferences(ASCSComponent: TSCSComponent; ACanDefineProjectOwner: Boolean = true); procedure RemoveComponentFromReferences(ASCSComponent: TSCSComponent); procedure SaveData(AMakeEdit: TMakeEdit); protected FRoomSetting: PRoomSettingRecord; FChildCatalogs: TSCSCatalogs; FChildCatalogReferences: TSCSCatalogs; FComponentReferences: TSCSComponents; //FProperties: TList; FSCSComponents: TSCSComponents; FTreeViewNode: TTreeNode; //22.08.2007 FUpperComponents: TSCSComponents; public ParentID: Integer; ProjectID: Integer; //ListID: Integer; Name: String; NameShort: String; NameMark: String; IsUserName: Integer; KolCompon: Integer; ItemType: Integer; ItemsCount: Integer; SCSID: Integer; //SortID: Integer; MarkID: Integer; IndexPointObj: integer; IndexConnector: integer; IndexLine: integer; IsIndexWithName: Integer; Level: Integer; ResourcesCost: Double; NewID: Integer; //07.11.2013 NormsResources: TSCSNormsResources; IDLastAddedComponent: Integer; LastAddedComponent: TSCSComponent; ServCanConnect: Boolean; ServDeleting: Boolean; ServDeleteInCAD: Boolean; ServToDefineParamsInCAD: Boolean; ServToDefineObjParams: TDefineObjectParams; //Лист, в котором хранятся кабеля, которые будут кидаться на С-П NewComponList: TList; //07.11.2013 property ID: Integer read FID write SetFID default 0; property ChildCatalogs: TSCSCatalogs read FChildCatalogs write FChildCatalogs; property ChildCatalogReferences: TSCSCatalogs read FChildCatalogReferences; property ComponentReferences: TSCSComponents read FComponentReferences; property IsDeleting: Boolean read FIsDeleting write SetFIsDeleting; property IsLine: Integer read GetFIsLine; property Length: Double read FLength write SetFLength; property Notes: TStringList read FNotes; //property Parent: TBasicSCSClass write SetFParent; property Parent write SetFParent; property RoomSetting: PRoomSettingRecord read FRoomSetting write FRoomSetting; //property Properties: TList read FProperties write FProperties; property SCSComponents: TSCSComponents read FSCSComponents write FSCSComponents; property TreeViewNode: TTreeNode read FTreeViewNode write SetFTreeViewNode; //22.08.2007 property UpperComponents: TSCSComponents read FUpperComponents write FUpperComponents; property ComponTypeSysName: String read FComponTypeSysName; property GUIDComponentType: String read FGUIDComponentType; constructor Create(AFormOwner: TForm); overload; destructor Destroy; override; procedure Assign(ASCSCatalog: TSCSCatalog); procedure AssignChildCatalogs(ASCSCatalogs: TSCSCatalogs); procedure AssignComponents(ASCSComponents: TSCSComponents); procedure AssignOnlyCatalog(ASCSCatalog: TSCSCatalog); procedure AddChildCatalog(ASCSCatalog: TSCSCatalog); procedure AddChildCatalogToList(ASCSCatalog: TSCSCatalog); procedure AddComponentToList(ASCSComponent: TSCSComponent); procedure AddComponentToCatRel(ASCSComponent: TSCSComponent); procedure AddProperty(AIDProperty: Integer; AGUIDProperty: String; AIDDataType, AIsDefault: Integer; const AValue, AName, ASysName: String); function CheckInterfaceInUse(AIDInterface: Integer): Boolean; procedure ClearComponents; procedure ClearChildCatalogs; procedure Clear; virtual; procedure CreateRoomSetting; procedure DefineComponsNameMarks; procedure Delete(ACallFrom: TCallFrom = cfBase); procedure DisableEnableInterfaces(ADisable: Boolean; ANoDisabling: TSCSInterface); function GenCatalogSortID: Integer; function GetAllInterfaces: TSCSInterfaces; function GetAllIOfIRel(ATypeI: Integer = -1): TSCSObjectList; function GetAllNormsResources(ANormResources: TNormResourcesKinds; AForIBD, ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice: Boolean; ACanOffNorms: Boolean = false; AGroupPreyscurants: Boolean = true; AGroupComponsBySuppliesKind: Boolean = false; aAllowNormPriceForGroup: Boolean=false; aGroupByKolvo: Boolean = false): TSCSNormsResources; function GetAsTCatalog: TCatalog; function GetComponentFromReferences(AIDComponent: Integer): TSCSComponent; virtual; function GetComponentFromReferencesList(AListID, AIDComponent: Integer): TSCSComponent; virtual; function GetComponentsByWholeID(AWholeID: Integer): TSCSComponents; function GetComponentsIDList: TIntList; function GetCatalogFromReferences(AIDCatalog: Integer): TSCSCatalog; virtual; function GetCatalogFromReferencesBySCSID(ASCSID: Integer): TSCSCatalog; virtual; function CheckCatalogFromReferencesBySCSID(ASCSID: Integer; aNeedListID: integer; var aDuplicate: boolean): TSCSCatalog; function GetCatalogFromReferencesBySCSIDUseSortCache(ASCSID: Integer; aSortCache: TRapObjectList): TSCSCatalog; function GetComponentCountByType(AComponentType: Integer; AOnlyFromRoot: Boolean): Integer; function GetComponentsByType(AGUIDType: String; AOnlyTopComponents: Boolean): TSCSComponents; function GetComponRelsByIDChild(AIDChild: Integer; AConnectType: TConnectType): TList; function GetFirstComponent: TSCSComponent; // найдет первый компонент с условным обозначением function GetFirstComponentWithObjectIcon: TSCSComponent; function GetSideHeight(ANumSide: Integer): Double; function GetInterfaceByID(AIDInterfRel: Integer): TSCSInterface; function GetInterfaceByIDAndIDComponent(AIDInterfRel, AIDComponent: Integer): TSCSInterface; function GetInterfaceByIDConnected(AIDConnected: Integer): TSCSInterface; function GetInterfaceCount(AInterfTypes: TIntSet; AIsBusy: Integer = biNone): Integer; function GetIOfIRelsByIDCompRel(AIDCompRel: Integer): TList; function GetIOfIRelsByIDIntercface(AIDInterface: Integer): TList; function GetMaxMarkIDFromChildReferences(AItemType: Integer): Integer; function GetListOwner: TSCSList; override; function GetNameForVisible(AWithComponCount: Boolean = false): String; //function GetNormInfoList: TList; function GetObjectIcon(AIconExt: Integer): TMemoryStream; function GetObjectParams: TObjectParams; function GetParentCatalogByItemType(AItemType: Integer): TSCSCatalog; function GetProject: TSCSProject; function GetPropertyAsNew: PProperty; function GetTheirComponentJoinedTo(AJoinedComponent: TSCSComponent): TSCSComponent; function GetTopParentCatalog: TSCSCatalog; function InsertCatalogByID(AIDCatalog: Integer): TSCSCatalog; procedure LoadProperties; procedure RefreshComponsPriceAfterChangeNDS(AOldNDS, ANewNDS: Double; ASave: Boolean); procedure RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); procedure ReloadComponentReferences; procedure RemoveChildCatalog(ACatalog: TSCSCatalog); procedure RemoveChildCatalogFromList(AChildCatalog: TSCSCatalog); procedure RemoveComponentFromList(AComponent: TSCSComponent); procedure RemoveComponentFromCatRel(AComponent: TSCSComponent); procedure SaveNormsToAlPlan(AFileName: String); procedure SetComponentsNewWholeID(AOldWholeID, ANewWholeID: Integer; AComponentsWithOldWholeID: TSCSComponents); procedure SetComponentsJoining(AComponsSorted: TRapObjectList=nil); procedure SetComponInterfacesForComlects; procedure SetParentWithNoReferences(AParent: TSCSCatalog); procedure UpdateComponsChangedFields; procedure LoadChildCatalogs(ARecursive, ADevideComplects, ALoadComponData: Boolean; AFieldBy: String = ''); procedure LoadCatalogByID(AIDCatalog: Integer; ALoadCompons: Boolean=true; ALoadCompData: Boolean=true; ALoadSQL: Boolean=true); procedure LoadLength; procedure Save; virtual; procedure SaveAsNew; function UpdateObjectName: String; function GetOobjectName(AShowKolCompon: Boolean): String; procedure LoadComponents(AIDCatalog: Integer; ALoadCompData: Boolean = true); procedure LoadAllComponents(AIDCatalog: Integer; ALoadCompData: Boolean = true); //22.08.2007 procedure LoadAllComponentsByObjectID(AIDObject: Integer; AFieldIndexses: TIntSet); function CalcResourcesCost(ACalcComponWorkCost, ACalcNormTotalCost, ACalcNormCost: Boolean): Double; //22.08.2007 function GetAllInterfID: TList; function RemoveChildCatalogByID(AID: Integer): Boolean; end; TSCSCatalogExtended = class(TSCSCatalog) private // Properties FActive: Boolean; FCurrID: Integer; FBuildID: Integer; FNBBuildID: Integer; FIDFromOpened: Integer; FIsClousing: Boolean; FIsOpening: Boolean; FLoadComponData: Boolean; FMarkMasrksStream: TStream; // Events FOnAfterNew: TNotifyEvent; FOnAfterOpen: TNotifyEvent; FOnAfterClose: TNotifyEvent; FOnBeforeNew: TNotifyEvent; FOnBeforeOpen: TNotifyEvent; FOnBeforeClose: TNotifyEvent; // Set Properties procedure SetActive(Value: Boolean); procedure SetCurrID(Value: Integer); procedure CleanComponIDList(AComponIDList: TIntList); procedure OpenWithParams(AID: Integer; AAsLoaded: Boolean); procedure SaveMarkMaskAsNew(var ACatalogMarkMask: TCatalogMarkMask); procedure CorrectAfterFullOpen; procedure CorrectConnectedComponsInfo; // Определяет отсутствующие свойства для компонентов, которые необходимы для нормальной работы // Изначально предназначена для вызова на переходах на новую версию проектов (не на открытии) procedure DefineLackComponProps; //07.10.2010 // переопределяет справочные элементы кабельных каналов и др. справочные компоненты procedure DefineSpravComponents; procedure LoadNormsResourcesFromClasses(ANormsResources: TSCSNormsResources; AIDMaster: Integer; AStringsMan: TStringsMan); procedure LoadPropertyNames; procedure LoadSimpleCatalogsFromClasses(AStringsMan: TStringsMan; ASaveCAD: Boolean; AOutListInPlacing: TSCSCatalogs); procedure LoadSimpleComponentsFromClasses(ACatalogOwner: TSCSCatalog; AComponents: TSCSComponents; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean; AOutListInPlacing: TSCSComponents); procedure SendFromCADObjectsToMemTables(AStringsMan: TStringsMan); procedure SendFromClassesToMemTables(AConnectedComponsInfoList: TConnectedComponsList; AObjectsBlobs: TObjectsBlobs; AIsLightSaving: Boolean); procedure SendFromFiltesToMemTables; procedure SendFromSpravochnikClassesToMemTables(AStringsMan: TStringsMan); procedure SendFromStringsManToMemTables; procedure SendFromMemTablesToCADObjects; procedure SendFromMemTablesToClasses(ASetComponsJoining: Boolean=true; AIsLightSaving: Boolean=false); procedure SendFromMemTablesToFilters; procedure SendFromMemTablesToSpravochnik; procedure SendFromMemTablesToStringsMan; procedure UpdateMarkMask(var ACatalogMarkMask: TCatalogMarkMask); procedure UpdateCADObjIconsFromUpdatedSpav; procedure UpdateSpravObjIconsFromNB; procedure UpdateValuesAfterLoadFromMemTablesToClasses; protected FCADCrossObjects: TObjectList; FCADNorms: TObjectList; FConnectedComponsList: TConnectedComponsList; FMemBase: TMemBase; FMarkMasks: TList; FFilters: TObjectList; FSpravochnik: TSpravochnik; //*** Справочники //*** справочные элементы кабельных каналов FSpravComponents: TSCSComponents; FStringsMan: TStringsMan; FObjectsBlobs: TObjectsBlobs; FUpdatedSprObjIcons: TStringList; FCanGenMarkID: Boolean; //15.01.2011 public // Properties property Active: Boolean read FActive write SetActive default false; property CADCrossObjects: TObjectList read FCADCrossObjects write FCADCrossObjects; property CADNorms: TObjectList read FCADNorms write FCADNorms; property CanGenMarkID: Boolean read FCanGenMarkID write FCanGenMarkID; //15.01.2011 property ConnectedComponsList: TConnectedComponsList read FConnectedComponsList write FConnectedComponsList; property CurrBuildID: Integer read FBuildID; property CurrID: Integer read FCurrID {write SetCurrID} default -1; property Filters: TObjectList read FFilters write FFilters; property IsClousing: Boolean read FIsClousing; property IsOpening: Boolean read FIsOpening; property LoadComponData: Boolean read FLoadComponData write FLoadComponData; property MarkMasks: TList read FMarkMasks write FMarkMasks; property MemBase: TMemBase read FMemBase; property NBBuildID: Integer read FNBBuildID; property ObjectsBlobs: TObjectsBlobs read FObjectsBlobs write FObjectsBlobs; property Spravochnik: TSpravochnik read FSpravochnik write FSpravochnik; property SpravComponents: TSCSComponents read FSpravComponents write FSpravComponents; property StringsMan: TStringsMan read FStringsMan; // Events property OnAfterNew: TNotifyEvent read FOnAfterNew write FOnAfterNew; property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen; property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose; property OnBeforeNew: TNotifyEvent read FOnBeforeNew write FOnBeforeNew; property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen; property OnBeforeClose: TNotifyEvent read FOnBeforeClose write FOnBeforeClose; // Methods procedure Clear; overload; constructor Create(AFormOwner: TForm); overload; destructor Destroy; override; procedure AssignCADCrossObjects(ACADCrossObjects: TObjectList); procedure AssignCADNorms(ACADNorms: TObjectList); procedure AssignMarkMasks(AMarkMasks: TList; AsNew: Boolean); procedure AssignSprComponents(AComponents: TSCSComponents); procedure AddComponToSprComponents(AComponent: TSCSComponent); // применяет справочные данные, в которых включена опция "Применить свойства для всех однотипных на проекте" для всех объектов procedure ApplySpavDataForObjects; function CheckUseCompRelAtInterfaces(AIDCompRel: Integer): Boolean; procedure CopyCADNormsToList(ASrcList, ADestList: TObjectList); function CreateObjFromObjectsBlob(AObjectClass: TComponentClass; ATableKind, ADataKind, AObjectID: Integer): TComponent; procedure DefineObjectsParamsInCADByServFld; function GenComponentMarkIDByMode(AComponent: TSCSComponent; APointComonIndexingMode: TPointComonIndexingMode; APointComplIndexingMode: TPointComplIndexingMode): Integer; function GenComponentMarkIDByType(const AComponentTypeGUID: String; isLine : boolean; AByEnumeration: Boolean = false): Integer; function GetAllStrings: TObject; function GetCADCrossObjectByObjectID(AObjectID: Integer): TCADCrossObject; function GetCatalogFromSortedRefByID(AID: Integer): TSCSCatalog; function GetCatalogFromSortedRefBySCSID(ASCSID: Integer): TSCSCatalog; function GetComponDefectAct(AComponent: TSCSComponent): TDefectAct; function GetComponSortedRefByID(AID: Integer): TSCSComponent; function GetCompRelByID(AIDCompRel: Integer): PComplect; function GetCompRelsByConnectType(AConnectType: Integer): TList; function GetComponentsForReindexOrderType(AReindexOrderType: TReindexOrderType): TSCSComponents; function GetInterfacesWithIDConnected: TSCSInterfaces; function GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID: Integer): TObjectsBlob; function GetSprComponentByGUID(AGUID: String): TSCSComponent; // Переиндексирует компоненты по типу. перед вызовом этой ф-ции, необх-мо определить начальные индексы procedure ReindexComponentsByTypes(AGUIDComponTypeList: TStringList; AComponOwnersWithReindexed: TSCSCatalogs{; AReindexOrderType: TReindexOrderType}; AResetMarkIdTo: Integer=0; aOnlySelected: boolean = False); function RemoveSprComponentByGUID(AGUID: String): TSCSComponent; function SetObjToObjectsBlob(AObj: TComponent; ATableKind, ADataKind, AObjectID: Integer): TObjectsBlob; procedure Open(AID: Integer); procedure OpenAsLoaded; procedure Close; procedure SaveAsNew; overload; procedure SetItemsFTreeNodeToNil; procedure Load; virtual; abstract; procedure Save; override; //virtual; abstract; procedure LoadMarkMasks; function SaveMarkMasks: Boolean; procedure SynchonizeSpravochikElements(ANBSpravochnik: TSpravochnik; AElements: TSprElements); procedure SynchonizeSpravochikWithMarkMasks(ANBSpravochnik: TSpravochnik); function GetMarkMaskByComponType(AComponType: Integer): PCatalogMarkMask; end; TSCSList = class(TSCSCatalogExtended) private OldSetting: TListSettingRecord; FIsNormalType: Boolean; FOpenedInCAD: Boolean; function GetCADFileName(const APrefix: String=''): String; function GetConnectedComponsInfoForLocalList: TConnectedComponsList; function GetObjectsBlobsForLocalList: TObjectsBlobs; procedure LoadFromMemTable(AStringsMan: TStringsMan); overload; procedure LoadSettingsFromStream; procedure SaveSettingsToStream; procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan; ACanSaveCAD: Boolean); //override; //function GetFParent: TSCSCatalog; function GetFParent: TBasicSCSClass; //procedure SetFParent(Value: TSCSCatalog); override; procedure SetFParent(Value: TBasicSCSClass); override; protected FListCADFile: String; FFile3D: String; FCADStream: TStream; FSettingStream: TStream; public FCreatedObjCountOnClick: Integer; // Количество компонент, добавленных по ф-ции ложить на Лист после усановки этого флажка FObjIDsBeforeCopy: TIntList; //03.07.2013 - исоходные ID объектов на исходном листе перед копированием FObjIDsAfterCopy: TIntList; //03.07.2013 - соответствующие новые id исходніх обїектов Setting: TListSettingRecord; //MarkMasks: Tlist; FNewComponNameMark: String; FNewComponNameMarkSaved: String; FNewComponNameMarkAsk: Boolean; procedure Clear; overload; constructor Create(AFormOwner: TForm); destructor Destroy; override; property IsNormalType: Boolean read FIsNormalType write FIsNormalType; property ListCADFile: String read FListCADFile; property File3D: String read FFile3D; property OpenedInCAD: Boolean read FOpenedInCAD write FOpenedInCAD; property Parent: TBasicSCSClass{TSCSCatalog} read GetFParent write SetFParent; procedure Assign(ASCSList: TSCSList; aAllObjects: Boolean=true); procedure AssignSettings(ASetting: TListSettingRecord); function ComplexLoadFromDir(ADirName: string; ASetComponsJoining: Boolean=true): TOpenCatalogFromFileResult; function ComplexSaveToDir(const ADirName: string; AAllowMsg: Boolean=true): Boolean; // Создаст ЭКК для шаблонов КК function CreateCCEForCCTemplates(ACableChannels: TSCSComponents; AConnOwner: TSCSCatalog; AConnectorType: Integer): TSCSComponent; procedure DefineCADNorms(ACanHaveActiveNorms, AShowNormContentsResources: Boolean); // Переопределить цены по валютам проекта procedure DefinePricesByProjectCurrencies(AProject: TSCSProject); procedure DeleteCADFile; procedure Delete3DFile; function GetCADStream: TMemoryStream; function GetParams: TListParams; function HotSave(ASaveCAD: Boolean): Boolean; procedure Load; override; function LoadFromStreamOrFile(AProject: TSCSProject; AStream: TStream; AFileName: String): TOpenCatalogFromFileResult; procedure Save; override; procedure SaveAsNew; overload; function SaveCAD: Boolean; procedure SetCADStream(ACADStream: TMemoryStream); function SaveToStreamOrFile(AStream: TStream; AFileName: String): Boolean; end; TCatalogGroupConnection = class(TMyObject) private FProjectOwner: TSCSProject; FBeginCatalogGroup: TSCSCatalog; FEndCatalogGroup: TSCSCatalog; FLines: TSCSCatalogs; FComponExemplars: TSCSComponents; FLinesNote: TStringList; procedure DefineLinesNote; public property BeginCatalogGroup: TSCSCatalog read FBeginCatalogGroup write FBeginCatalogGroup; property EndCatalogGroup: TSCSCatalog read FEndCatalogGroup write FEndCatalogGroup; property Lines: TSCSCatalogs read FLines write FLines; property LinesNote: TStringList read FLinesNote write FLinesNote; function CheckEqualNet(ANetElement: PJoinedComponents): Boolean; procedure Clear; constructor Create(AProjectOwner: TSCSProject); overload; destructor Destroy; override; end; //TStrArray = array of string; TMemTableInfo = class(TMyObject) FMemTable: TSQLMemTable; FPackFields: array of string; //TStrArray; FPackDicts: array of TStringList; constructor create; // Tolik 12/12/2019 -- destructor Destroy; override; end; TMemTableInfoList = class(TStringList) destructor Destroy; override; procedure AddToMemTablesInfo(var aTable: TSQLMemTable; const aTName: String; aTIdx: Integer; const aPackFields: array of string; const aPackDicts: array of TStringList); end; TSCSProject = class(TSCSCatalogExtended) private OldSetting: TProjectSettingRecord; FCanAutoSave: Boolean; FCanOpenFromBeatenBlock: Boolean; FIsAutoTracing: Boolean; //FLoaded: Boolean; FOpenProjectMode: TOpenProjectMode; FReadOnly: Boolean; FCurrList: TSCSList; FIDLastList: Integer; FNBDirID: Integer; FNBDirNode: TTreeNode; FFilterBlock: TFilterBlock; //*** DataFields // Write To Properties procedure SetFCurrList(Value: TSCSList); procedure SetFIsAutoTracing(Value: Boolean); // Methods procedure LoadProject; procedure ClearClasses; function GetProjectGenerators(AID: Integer): TProjectGenerators; procedure LoadCatalogsFromMemTable; procedure LoadComponentsFromMemTable; procedure LoadNormsResourcesFromMemTable; function SendFromClassesToDatFile(aSaveToBase: Boolean): Boolean; procedure SendFromClassesToMemTables(AIsLightSaving: Boolean=false); //procedure SendFromSpavochnikClassesToMemTables; procedure SendFromMemTablesToClasses(AIsLightSaving: Boolean=false); //procedure SendFromMemTablesToSpravochnik; procedure SendFromDatFileToClasses; procedure SaveListsToFileFromNoSaved; procedure DefineIDPointer(ATableName: String; APointerFields, AGuidFields: TStringList); function GetScriptForCreatePortInterfaceRelation: String; function GetScriptForCreateSpravochniks: String; procedure UpdateAfterOpenFromFileStream; procedure UpdateStructure; procedure UpdateStructureAfterUpdateValue; procedure UpdateValues; //procedure UpdateValuesAfterLoadFromMemTablesToClasses; protected FGenerators: TProjectGenerators; FCanJoinComponsInfo: TJoinComponsInfoList; //FConnectedComponsList: TConnectedComponsList; FNoSaveListsToFiles: TIDStringList; FNotJoinComponsInfo: TJoinComponsInfoList; FProjectLists: TSCSLists; FUsedInterfaces: TIntList; //11.03.2009 TSCSInterfaces; FBadSavedListIDs: TIntList; FIDsNearFloorFigures: TIntList; FIDsOppositeNearFloorFigures: TIntList; FIDsSrcObjects: TIntList; FIDsNewObjects: TIntList; FMTNormsComplete: TSQLMemTable; FMemTablesInfo: TMemTableInfoList; procedure LoadMemTablesFromMemBase; procedure SaveMemTablesToMemBase; public DefListSettings: TListSettingRecord; Setting: TProjectSettingRecord; property CanAutoSave: Boolean read FCanAutoSave write FCanAutoSave; property CanOpenFromBeatenBlock: Boolean read FCanOpenFromBeatenBlock; property CurrList: TSCSList read FCurrList write SetFCurrList; property IsAutoTracing: Boolean read FIsAutoTracing write SetFIsAutoTracing; property NBDirID: Integer read FNBDirID; property NoSaveListsToFiles: TIDStringList read FNoSaveListsToFiles write FNoSaveListsToFiles; property ProjectLists: TSCSLists read FProjectLists write FProjectLists; property ReadOnly: Boolean read FReadOnly write FReadOnly; property IDsNearFloorFigures: TIntList read FIDsNearFloorFigures write FIDsNearFloorFigures; property IDsOppositeNearFloorFigures: TIntList read FIDsOppositeNearFloorFigures write FIDsOppositeNearFloorFigures; property IDsSrcObjects: TIntList read FIDsSrcObjects Write FIDsSrcObjects; property IDsNewObjects: TIntList read FIDsNewObjects Write FIDsNewObjects; property FilterBlock: TFilterBlock read FFilterBlock write FFilterBlock; property MTNormsComplete: TSQLMemTable read FMTNormsComplete write FMTNormsComplete; constructor Create(AFormOwner: TForm); overload; destructor Destroy; override; procedure AddChildCatalogToList(ASCSCatalog: TSCSCatalog); procedure AddList(ASCSList: TSCSList); function AddListFromFile(const AFileName: String; AOldIdxToName: Boolean=true; ATargetObject: TSCSCatalog = nil): TSCSList; procedure AssignSettings(ASetting: TProjectSettingRecord); function CheckSCSObjectsInSameIndexingArea(AObject1, AObject2: TSCSCatalog): Boolean; function CheckProjectInUse(AIDProject: Integer; var AUserName: String; var AUserDateTime: TDateTime): Boolean; procedure Clear; overload; procedure ClearNearFloorFiguresIDs; procedure ClearNBDirInfo; procedure ClearOpenedListsCADStream; procedure CloseAllLists; function CopyList(ASrcList: TSCSList; ANewCopyName: String; ATargetObject: TSCSCatalog = nil; aCopyCompons: Boolean=true): TSCSList; function DefineNBDir: Boolean; // определяет отсутствующие УГО в справочнике из КАД объекта procedure DefineSpravObjectIconFromCAD(AGUIDIcon: String; ASrcSCSObject: TSCSCatalog); procedure DefineSpravDataFromOtherSpravByNewGUIDs(ASpravochnik: Tspravochnik); procedure DeleteObjectsBlobByParams(ATableKind, ADataKind, AObjectID: Integer; AObjectIDs: TIntList); procedure FinishMarkingCompons; //15.01.2011 function GenIDByGeneratorIndex(AGeneratorIndex: Integer; AIncrement: Integer = 1): Integer; function GetCurrency(ACurrencyType: Integer): TCurrency; function GetDefListSettings(AID: Integer): TListSettingRecord; function GetFilterInfoByType(AFilterType: Integer): TFilterInfo; function GetInterfaceByListObjCompIDs(AIDList, AIDObject, AIDCOmponent, AIDInterfRel: Integer): TSCSInterface; function GetListsFilteredByComponentTypes(AComponentTypes: TObjectList; ADevideByJoinedNetType, AExtendedNotes: Boolean): TSCSLists; function GetParams: TProjectParams; function GetPlanJoining(AFilteredLists: TSCSLists): TObjectList; //Список TSCSCatalogs function GetProjectSettings(AID: Integer): TProjectSettingRecord; function GetUsingComponentTypes: TObjectList;overload; function GetUsingComponentTypes(ACatalog : TSCSCatalog): TObjectList; overload; procedure LoadParams(AProjectParams: TProjectParams); procedure NotifyBeforeReport; procedure RefreshWholeLengthThroughFloorComponsInFuture; procedure ReindexPointComponent(AComponent: TSCSComponent); procedure ReindexPointComponentAfterChangeCatalogOwner(AComponent: TSCSComponent; AOldParent: TSCSComponCatalogClass; AOldCatalog: TSCSCatalog); procedure ReindexPointComponentsAfterChangeCatalogOwner(ACatalog: TSCSCatalog; AOldOwner: TSCSCatalog); procedure RemarkComponents(AComponOwnersWithReindexed: TSCSCatalogs); // Установит генератор индекса компненты в минимальное значение procedure SetComponMarkIDGeneratorToMin(ASprComponType: TNBComponentType); procedure SetFilterParamsToForm; procedure SetPriceParamsToForm; procedure StartStopAutoSaveDateTime(AStart: Boolean); procedure StartStopAutoSaveProject(AStart: Boolean); procedure WriteUserDateTime(ADateTime: TDateTime; AUserName: String); procedure WriteUserNowDateTime; procedure WriteUserNowDateTimeWithCheckName; procedure UpdateDesignListsNamesByOwnerList(AOwnerList: TSCSList); procedure UpdatePrices; function Open(AID: Integer; AOpenProjectMode: TOpenProjectMode = opmStandart): TOpenProjectResult; procedure Load; override; procedure LoadComponFilter; procedure Save; override; procedure SaveComponFilter; function SaveLists(ASaveCAD: Boolean): Boolean; procedure SaveMainFields; function SaveProject(AAllowMsg: Boolean=true): Boolean; procedure SaveSettings(ASettings: TProjectSettingRecord); function InsertListByID(AIDList: Integer): TSCSList; function RemoveListByID(AIDList: Integer): Boolean; //function InsertProjectByID(AIDProj: Integer): TSCSProject; function GetDesignListByComponent(AComponent: TSCSComponent): TSCSList; function GetDesignListByIDFigure(AIDFigure: integer): TSCSList; function GetDesignListsFromList(ASCSList: TSCSList): TSCSLists; function GetListByID(ASCSIDList: Integer): TSCSList; function GetListBySCSID(ASCSIDList: Integer): TSCSList; function SetCurrListByID(AIDList: Integer): TSCSList; function ComplexLoadFromDir(const ADirName: string): TOpenCatalogFromFileResult; function ComplexSaveToDir(const ADirName: string; AAllowMsg: Boolean=true): Boolean; function SaveToStreamOrFile(AStream: TStream; const AFileName: String; AIsLightSaving: Boolean=false; aOnlyFromBlob: Boolean=false): Boolean; function LoadFromStreamOrFile(AStream: TStream; const AFileName: String; AAsNew: Boolean): TOpenCatalogFromFileResult; // Handlers of CurrProject Events procedure AfterNew(Sender: TObject); procedure AfterOpen(Sender: TObject); procedure AfterClose(Sender: TObject); procedure BeforeNew(Sender: TObject); procedure BeforeOpen(Sender: TObject); procedure BeforeClose(Sender: TObject); end; {type} TNormType = (ntNB, ntProj); // ######################################################################### TSCSNormResBasicClass = class(TBasicSCSClass) private FMasterField: String; //используется для NormBase, в МП юз-с IDMaster FMasterTableKind: Integer; //*** SetFields procedure SetActiveForm(Value: TForm); procedure SetMasterTableKind(Value: Integer); //*** Methods function GetMasterFieldName(AMasterTableKind: Integer): String; protected FOwner: TBasicSCSClass; public //*** Служебные поля IsNew: Boolean; IsModified: Boolean; property ActiveForm: TForm read FActiveForm write SetActiveForm default nil; property MasterTableKind: Integer read FMasterTableKind write SetMasterTableKind; property Owner: TBasicSCSClass read FOwner write FOwner default nil; end; TSCSNormsResources = class(TSCSNormResBasicClass) private // SetProperties procedure SetActiveForm(Value: TForm); // Methods procedure SaveNorms(AMakeEdit: TMakeEdit; AIDNewMaster: Integer); procedure SaveResources(AMakeEdit: TMakeEdit; AIDNewMaster: Integer); protected FNorms: TSCSNorms; FResources: TSCSResources; public IDMaster: Integer; ResourcesCost: Double; //*** Стоимость ресурсов ResourcesCostPerOneNorm: Double; //*** стоимость ресурсов за количество норм = 1 TotalCost: Double; Length: Double; // Properties property ActiveForm: TForm read FActiveForm write SetActiveForm default nil; property Norms: TSCSNorms read FNorms write FNorms; property Resources: TSCSResources read FResources write FResources; // Methods constructor Create(AFormOwner: TForm; AMasterTableKind: Integer); destructor Destroy; override; procedure Assign(ASCSNormsResources: TSCSNormsResources; AFromNew: Boolean = false); procedure AssignOnlyNormsResources(ANormsResources: TSCSNormsResources); procedure AssignNorms(ASCSNorms: TSCSNorms; AFromNew: Boolean = false); procedure AssignResources(ASCSResources: TSCSResources; AFromNew: Boolean = false); procedure Clear; procedure LoadNorms(ALoadNormResources, AComponResourcePriceCalc: Boolean); procedure Refesh; procedure RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); procedure SaveNormsAsNew(AIDNewMaster: Integer); procedure UpdateNorms; procedure LoadResources(ACalcCost: Boolean); procedure SaveResourcesAsNew(AIDNewMaster: Integer); procedure UpdateResources; procedure SaveResourcesByServiceFields(ANewMasterID: Integer); procedure SaveByServiceFields(ANewMasterID: Integer); function CalcResourcesCost(ACalcNormTotalCost, ACalcNormCost: Boolean): Double; end; TSCSResourceRel = class(TSCSNormResBasicClass) //(TBasicSCSClass) private FNormType: TNormType; procedure LoadResourceFromMemTable(AStringsMan: TStringsMan); procedure LoadResourceRelFromMemTable(AStringsMan: TStringsMan); procedure SaveResourceToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); procedure SaveResourceRelToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); procedure LoadResourceByFld(AFldName: String; AFldValue: Variant); procedure SaveData(AMakeEdit: TMakeEdit; ANewMasterID: Integer); public ID: Integer; IDMaster: Integer; //TableKind: Integer; Npp: Integer; IDResource: Integer; IDNB: Integer; GuidNB: String; TableKindNB: Integer; IDCompPropRel: Integer; Cypher: String; Name: String; ArtProducer: String; ArtDistributor: String; GUIDProducer: String; GUIDSuppliesKind: string; Izm: String; Price: Double; AdditionalPrice: Double; RType: TResourceType; GUIDNBComponent: String; IDNBComponent: Integer; Kolvo: Double; IsOn: Integer; Cost: Double; RValue: Double; ExpenseForLength: Double; //ExpenseForSection: Double; CountForPoint: Double; //Количество на точку StepOfPoint: Double; //шаг использования количества на точку //*** Служебные поля NewID: Integer; NewIDResource: Integer; ServIsResource: Boolean; property NormType: TNormType read FNormType write FNormType; constructor Create(AFormOwner: TForm; ANormType: TNormType); overload; destructor Destroy; override; procedure Assign(AResourceRel: TSCSResourceRel; AFromNew: Boolean = false); procedure Clear; procedure CalcCost; procedure LoadResourceByID(AIDResourceRel: integer); procedure RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); procedure SaveResourceAsNew(ANewMasterID: Integer); procedure UpdateResource; procedure SaveByServiceFields(ANewMasterID: Integer); end; TSCSResourceGroup = class(TSCSResourceRel) protected FObjectList: TSCSObjectList; public property ObjectList: TSCSObjectList read FObjectList write FObjectList; constructor Create(AFormOwner: TForm); overload; destructor Destroy; override; end; TSCSNormPreyscurant = class(TMyObject) public Name: String; Kolvo: Double; PairKolvo: Integer; InterfaceType: Integer; SCSComponentGUID: String; RelationComponentGUID: String; SCSComponent: TSCSComponent; RelationComponent: TSCSComponent; ResourceRel: TSCSResourceRel; procedure Assign(ANormPreyscurant: TSCSNormPreyscurant); constructor Create; destructor Destroy; override; end; //*** TSCSNorm class TSCSNorm = class(TSCSNormResBasicClass) //(TBasicSCSClass) private FNormType: TNormType; // Set Properties procedure SetActiveForm(Value: TForm); procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); // Methods procedure LoadNormByField(AFldByName: String; AFldValue: Variant; ALoadResources: Boolean); procedure LoadResourcesByNormType(AID_Master: Integer); procedure SaveData(AMakeEdit: TMakeEdit; ANewMasterID: Integer); protected FResources: TSCSResources; FPreyscurants: TSCSObjectList; public //*** Fields ID: Integer; NewID: Integer; IDNB: Integer; GuidNB: String; GuidInterface: string; //Tolik -- 22/06/2016 -- IDMaster: Integer; IDCompPropRel: Integer; //TableKind: Integer; NPP: Integer; IsOn: Integer; Kolvo: Double; TotalCost: Double; IsFromInterface: Integer; Cypher: String; Name: String; WorkKind: String; Izm_: String; LaborTime: Integer; PricePerTime: Double; Price: Double; // Стоимость нормы/работы Cost: Double; // Стоимость ресурсов ExpenseForLength: Double; //ExpenseForSection: Double; CountForPoint: Double; StepOfPoint: Double; ////*** Служебные поля //IsNew: Boolean; //IsModified: Boolean; // Properties property ActiveForm: TForm read FActiveForm write SetActiveForm default nil; property NormType: TNormType read FNormType write FNormType; property Preyscurants: TSCSObjectList read FPreyscurants write FPreyscurants; property Resources: TSCSResources read FResources write FResources; // Methods constructor Create(AFormOwner: TForm; ANormType: TNormType); overload; destructor Destroy; override; procedure Assign(ASCSNorm: TSCSNorm; AFromNew: Boolean = false); procedure AssignOnlyNorm(ASCSNorm: TSCSNorm; AFromNew: Boolean = false); procedure AssignResources(AResources: TSCSResources; AFromNew: Boolean = false); procedure Clear; procedure LoadNorm(AID_Norm: Integer; ALoadResources: Boolean); procedure LoadNormByGUID(AGUIDNorm: String; ALoadResources: Boolean); procedure LoadNormFromSprNorm(ASprNorm: TNBNorm); procedure LoadResources(AID_Norm: Integer); procedure RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); procedure SaveNormAsNew(AID_NewMaster: Integer); procedure UpdateNorm; procedure SaveByServiceFields(AID_NewMaster: Integer); //*** Методы для вычислений function CalcCost: Double; function CalcTotalCost(ACalcCost: Boolean): Double; end; TSCSNormGroup = class(TSCSNorm) protected FObjectList: TSCSObjectList; FGrpKolvo: Double; public property GrpKolvo: Double read FGrpKolvo write FGrpKolvo; property ObjectList: TSCSObjectList read FObjectList write FObjectList; constructor Create(AFormOwner: TForm; ANormType: TNormType); overload; destructor Destroy; override; end; // ############################################################################ TSCSBase = Class(TBasicSCSClass) private FActive: Boolean; FBusyType: Integer; function CheckBaseInBusyMode(ABusyDate: TDate; ABusyTime: TTime): Boolean; procedure SetActive(Value: Boolean); protected FNBSpravochnik: TSpravochnik; public DBMode: TDBKind; DBName: String; OpenErrorMessage: String; //CurrList: TSCSList; CurrProject: TSCSProject; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; property Active: Boolean read FActive write SetActive; property BusyType: Integer read FBusyType; property NBSpravochnik: TSpravochnik read FNBSpravochnik; constructor Create(AFormOwner: TForm); procedure DefineActiveFromBase; destructor Destroy; override; function Open(ADBPath: String = ''; AReconnect: Boolean = true; ANoCheckConnect: Boolean = true; ACheckBusy: Boolean = true): TOpenBaseResult; procedure Close(ADisconnect: Boolean = true); procedure SimpleClose(ADeactivate: Boolean); procedure SimpleOpen(AActivate: Boolean); procedure ShowConnPosForPM(ACapt: String); function GetComponByIsLine(AIsLine: Integer): TSCSComponent; function GetComponByType(const ACompTypeSN: String): TSCSComponent; end; TSpravochnik = class(TBasicSCSClass) protected FOwnerObject: TBasicSCSClass; FNBCurrencies: TSCSObjectList; FNBComponentTypes: TSCSObjectList; FNBInterfaces: TSCSObjectList; FNBNetTypes: TSCSObjectList; FNBNorms: TSCSObjectList; FNBObjectIcons: TSCSObjectList; FNBProducers: TSCSObjectList; FNBProperties: TSCSObjectList; FNBResources: TSCSObjectList; FNBSuppliesKinds: TSCSObjectList; FCurrencyGUIDs: TStringList; FComponentTypeGUIDs: TStringList; FInterfaceGUIDs: TStringList; FInterfaceIDs: TRapObjectList; FPropertyGUIDS: TStringList; FLastCurrency: TNBCurrency; FLastComponentType: TNBComponentType; FLastInterface: TNBInterface; FLastNetType: TNBNetType; FLastNorm: TNBNorm; FLastObjectIcon: TNBObjectIcon; FLastProducer: TNBProducer; FLastProperty: TNBProperty; FLastResource: TNBResource; FLastSuppliesKind: TNBSuppliesKind; FNewGUIDsComponentType: TStringList; FNewGUIDsInterface: TStringList; FNewGUIDsNetType: TStringList; FNewGUIDsNorms: TStringList; FNewGUIDsObjectIcons: TStringList; FNewGUIDsProducers: TStringList; FNewGUIDsProperties: TStringList; FNewGUIDsResources: TStringList; FNewGUIDsSuppliesKinds: TStringList; public property OwnerObject: TBasicSCSClass read FOwnerObject write FOwnerObject; property ComponentTypes: TSCSObjectList read FNBComponentTypes write FNBComponentTypes; property Currencies: TSCSObjectList read FNBCurrencies write FNBCurrencies; property Interfaces: TSCSObjectList read FNBInterfaces write FNBInterfaces; property NetTypes: TSCSObjectList read FNBNetTypes write FNBNetTypes; property Norms: TSCSObjectList read FNBNorms write FNBNorms; property ObjectIcons: TSCSObjectList read FNBObjectIcons write FNBObjectIcons; property Producers: TSCSObjectList read FNBProducers write FNBProducers; property Properties: TSCSObjectList read FNBProperties write FNBProperties; property Resources: TSCSObjectList read FNBResources write FNBResources; property SuppliesKinds: TSCSObjectList read FNBSuppliesKinds write FNBSuppliesKinds; property LastCurrency: TNBCurrency read FLastCurrency write FLastCurrency; property LastComponentType: TNBComponentType read FLastComponentType write FLastComponentType; property LastInterface: TNBInterface read FLastInterface write FLastInterface; property LastNetType: TNBNetType read FLastNetType write FLastNetType; property LastNorm: TNBNorm read FLastNorm write FLastNorm; property LastObjectIcon: TNBObjectIcon read FLastObjectIcon write FLastObjectIcon; property LastProducer: TNBProducer read FLastProducer write FLastProducer; property LastProperty: TNBProperty read FLastProperty write FLastProperty; property LastResource: TNBResource read FLastResource write FLastResource; property LastSuppliesKind: TNBSuppliesKind read FLastSuppliesKind write FLastSuppliesKind; property NewGUIDsComponentType: TStringList read FNewGUIDsComponentType write FNewGUIDsComponentType; property NewGUIDsInterface: TStringList read FNewGUIDsInterface write FNewGUIDsInterface; property NewGUIDsNetType: TStringList read FNewGUIDsNetType write FNewGUIDsNetType; property NewGUIDsNorms: TStringList read FNewGUIDsNorms write FNewGUIDsNorms; property NewGUIDsObjectIcons: TStringList read FNewGUIDsObjectIcons write FNewGUIDsObjectIcons; property NewGUIDsProducers: TStringList read FNewGUIDsProducers write FNewGUIDsProducers; property NewGUIDsProperties: TStringList read FNewGUIDsProperties write FNewGUIDsProperties; property NewGUIDsResources: TStringList read FNewGUIDsResources write FNewGUIDsResources; property NewGUIDsSuppliesKinds: TStringList read FNewGUIDsSuppliesKinds write FNewGUIDsSuppliesKinds; function AddCurrency(ACurrency: TNBCurrency): Integer; function AddComponentType(AComponentType: TNBComponentType): Integer; function AddInterface(AInterface: TNBInterface): Integer; function AddNetType(ANetType: TNBNetType): Integer; function AddNorm(ANorm: TNBNorm): Integer; function AddObjectIcon(AObjectIcon: TNBObjectIcon): Integer; function AddProducer(AProducer: TNBProducer): Integer; function AddProperty(AProperty: TNBProperty): Integer; function AddResource(AResource: TNBResource): Integer; function AddSuppliesKind(ASuppliesKind: TNBSuppliesKind): Integer; procedure Assign(ASpravochnik: TSpravochnik); procedure AssignNoListData(ASpravochnik: TSpravochnik); procedure AssignCurrencies(ACurrencies: TSCSObjectList); procedure AssignComponentTypes(AComponentTypes: TSCSObjectList; AGUIDAsNew: Boolean=true); procedure AssignInterfaces(AInterfaces: TSCSObjectList); procedure AssignNetTypes(ANetTypes: TSCSObjectList); procedure AssignNorms(ANorms: TSCSObjectList); procedure AssignObjectIcons(AObjectIcons: TSCSObjectList); procedure AssignProducers(AProducers: TSCSObjectList); procedure AssignProperties(AProperties: TSCSObjectList); procedure AssignResources(AResources: TSCSObjectList); procedure AssignSuppliesKinds(ASuppliesKinds: TSCSObjectList); function CreateCompTypeByStandartGUID(const ASysName, AGUID: string): TNBComponentType; function CreatePropertyByStandartGUID(const ASysName, AGUID: string; ACheckGUID: Boolean): TNBProperty; function CreateInterfaceByStandartGUID(const AGUID: string): TNBInterface; procedure Clear; procedure ClearNoListData; procedure ClearCurrencies; procedure ClearComponentTypes; procedure ClearInterfaces; procedure ClearProperties; constructor Create(AFormOwner: TForm; AOwnerObject: TBasicSCSClass); overload; destructor Destroy; override; procedure DefineDataFromOtherSpravByNewGUIDs(ASpravoshnick: TSpravochnik); procedure DefineNewGUIDsFromOtherSprav(ASpravoshnick: TSpravochnik); function GetComponentTypeByID(AID: Integer): TComponentType; function GetComponentTypeBySysName(const ASysName: String): TComponentType; function GetComponentTypeByGUID(const AGUID: String): TNBComponentType; function GetComponentTypeByName(const AName: String): TNBComponentType; function GetComponentTypeObjByID(const AID: Integer): TNBComponentType; function GetComponentTypeObjBySysName(const ASysName: String): TNBComponentType; function GetComponentTypeWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik): TNBComponentType; function GetCurrencyByID(const AID: Integer): TNBCurrency; function GetCurrencyCountry: TNBCurrency; function GetCurrencyByGUID(const AGUID: string): TNBCurrency; function GetCurrencyBySavedType(const AType: Integer): TNBCurrency; function GetCurrencyByType(const AType: Integer): TNBCurrency; function GetCurrencyDataByGUID(const AGUID: string): TCurrency; function GetCurrencyWithAssign(ANBCurrency: TNBCurrency; ANBSpavochnik: TSpravochnik): TNBCurrency; function GetInterfaceByID(AID: Integer): TNBInterface; function GetInterfaceByGUID(const AGUID: String): TNBInterface; function GetInterfaceByName(const AName: String): TNBInterface; function GetInterfaceNameByID(AID: Integer): String; function GetInterfaceWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik; AAssignInterfAccordance, AAssignInterfNorms: Boolean): TNBInterface; // Вернет интерфейсы в которых есть AInterf как соответствующий function GetInterfacesForAccordance(AInterf: TNBInterface): TSCSObjectList; function GetNBComponentTypeByID(AID: Integer): TNBComponentType; function GetNetTypeByGUID(const AGUID: String): TNBNetType; function GetNetTypeByID(const AID: Integer): TNBNetType; function GetNormByGUID(const AGUID: String): TNBNorm; function GetNormByGUIDFromList(const AGUID: String): TNBNorm; function GetObjectIconByGUID(const AGUID: String): TNBObjectIcon; function GetObjectIconByGUIDFromList(const AGUID: String): TNBObjectIcon; function GetObjectIconByNameFromList(const AName: String): TNBObjectIcon; function GetObjectIconByIconType(const AGUID: String; AIconType, AIconExt: Integer): TMemoryStream; function GetObjectIconByObject(AObjectIcon: TNBObjectIcon; AIconType, AIconExt: Integer): TMemoryStream; function GetProducerByGUID(const AGUID: STring): TNBProducer; function GetProducerByID(AID: Integer): TNBProducer; function GetPropertyByGUID(const AGUID: STring): TNBProperty; function GetPropertyByID(AID: Integer): TNBProperty; function GetPropertyByName(const AName: String): TNBProperty; function GetPropertyBySysName(const ASysName: String): TNBProperty; function GetPropertyDataByID(AID: Integer): TPropertyData; function GetPropertyDataBySysName(const ASysName: String): TPropertyData; function GetPropertyWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik): TNBProperty; function GetResourceByGUID(const AGUID: String): TNBResource; function GetResourceByGUIDFromList(const AGUID: String): TNBResource; function GetSuppliesKindByGUID(const AGUID: String): TNBSuppliesKind; function GetSuppliesKindByID(AID: Integer): TNBSuppliesKind; procedure LoadFromNB; procedure LoadCurrencies; procedure LoadCurrenciesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); procedure LoadComponentTypes; procedure LoadComponentTypesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); procedure LoadInterfaces; procedure LoadInterfacesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); procedure LoadNetTypes; procedure LoadNetTypesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); procedure LoadProducers; procedure LoadProducersToStrings(AStrings: TStrings; AFirstEmpty: Boolean); procedure LoadProperties; procedure LoadPropertiesToStrings(AStrings: TStrings; AFirstEmpty: Boolean; ASort: Boolean=true); procedure LoadSuppliesKinds; procedure LoadSuppliesKindsToStrings(AStrings: TStrings; AFirstEmpty: Boolean); end; TNBSpravochnickElement = class(TBasicSCSClass) private FOwner: TSpravochnik; public IDCatalog: Integer; CatalogItemType: Integer; procedure Clear; constructor Create(AFormOwner: TForm); end; // NBCurrency TNBCurrency = class(TNBSpravochnickElement) private //FOwner: TSpravochnik; procedure LoadFromMemTable; procedure SaveToMemTable(AMakeEdit: TMakeEdit); public Data: TCurrency; SavedMain: Integer; IsModified: Boolean; procedure Assign(ACurrency: TNBCurrency); function CheckEqualRatio(ACurrency: TNBCurrency): Boolean; constructor Create(AFormOwner: TForm); end; // NB ComponentType TNBComponentType = class(TNBSpravochnickElement) private //FOwner: TSpravochnik; FProperties: TSCSObjectList; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ComponentType: TComponentType; PropsCount: Integer; IsModified: Boolean; IsSelected: Boolean; MarkTemplateObjects: TObjectList; property Properties: TSCSObjectList read FProperties write FProperties; function AddProperty(ACompTypeProperty: TNBCompTypeProperty): Integer; procedure Assign(AComponentType: TNBComponentType); procedure AssignCompTypeProperties(AProperties: TSCSObjectList); procedure AssignCompTypeNewProperties(AProperties: TSCSObjectList; ANBSprav: TSpravochnik); procedure AssignOnlyComponentType(AComponentType: TNBComponentType); procedure Clear; procedure ClearMarkTemplateObjects; function DefineMarkTemplateObjects: TObjectList; constructor Create(AFormOwner: TForm); destructor Destroy; override; function GetPropertyBySN(const ASN: String): TNBCompTypeProperty; procedure Save(AMakeEdit: TMakeEdit); end; TNBCompTypeProperty = class(TBasicSCSClass) private FOwner: TNBComponentType; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public GuidComponentType: String[40]; IsModified: Boolean; PropertyData: TProperty; procedure Assign(ACompTypeProperty: TNBCompTypeProperty); procedure AssignFromNBProperty(AProperty: TNBProperty); procedure AssignToPProperty(AProperty: PProperty); constructor Create(AFormOwner: TForm); end; // NB Interface TNBInterface = class(TNBSpravochnickElement) private //FOwner: TSpravochnik; protected FInterfaceNorms: TSCSObjectList; FInterfaceAccordance: TSCSObjectList; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; Name: String; GuidNetType: String; IDNetType: Integer; SortID: Integer; ConstructiveWidth: Double; Description: String; IsVisible: ShortInt; IsUniversal: ShortInt; InterfAccordanceCount: Integer; InterfNormsCount: Integer; IsModified: Boolean; property InterfaceNorms: TSCSObjectList read FInterfaceNorms write FInterfaceNorms; property InterfaceAccordance: TSCSObjectList read FInterfaceAccordance write FInterfaceAccordance; function AddInterfaceAccordance(AInterfaceAccordance: TNBInterfaceAccordance): Integer; function AddInterfaceNorm(AInterfaceNorm: TNBInterfaceNorm): Integer; procedure Assign(AInterface: TNBInterface); procedure AssignInterfaceAccordance(AInterfaceAccordance: TSCSObjectList); procedure AssignInterfaceNorms(AInterfaceNorms: TSCSObjectList); procedure AssignOnlyInterface(AInterface: TNBInterface); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; function GetInterfAccordanceByGUIDAccordance(const AGUID: String): TNBInterfaceAccordance; function GetInterfAccordanceByIDAccordance(AID: Integer): TNBInterfaceAccordance; function GetInterfNormByGUIDNB(const AGUID: String): TNBInterfaceNorm; procedure Save(AMakeEdit: TMakeEdit); end; TNBInterfaceNorm = class(TBasicSCSClass) private FOwner: TNBInterface; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String[cnstGUIDLength]; GuidInterface: String[cnstGUIDLength]; IDInterface: Integer; GuidNBNorm: String[cnstGUIDLength]; IDNBNorm: Integer; GUIDComponentType: String[cnstGUIDLength]; IDComponentType: Integer; Expense: Double; InterfaceIsBusy: Integer; KoefLengthForCompl: Double; IsModified: Boolean; procedure Assign(AInterfaceNorm: TNBInterfaceNorm); constructor Create(AFormOwner: TForm); procedure Save(AMakeEDit: TMakeEdit); end; TNBInterfaceACcordance = class(TBasicSCSClass) private FOwner: TNBInterface; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; GuidInterface: String[cnstGUIDLength]; IDInterface: Integer; InterfComponIsLine: Integer; GUIDAccordance: string[cnstGUIDLength]; IDAccordance: Integer; AccordComponIsLine: Integer; Kolvo: integer; IsModified: Boolean; procedure Assign(AInterfaceACcordance: TNBInterfaceACcordance); constructor Create(AFormOwner: TForm); procedure Save(AMakeEdit: TMakeEdit); end; TNBNetType = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; Name: String; IsModified: Boolean; procedure Assign(ANetType: TNBNetType); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBNorm = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; Cypher: String; Name: String; Izm: String; LaborTime: Integer; PricePerTime: Double; TimeUOM: Integer; Price: Double; GUIDESmeta: String; IsModified: Boolean; IsApplyDataForAllSame: Boolean; procedure Assign(ANorm: TNBNorm); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBObjectIcon = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); protected FProjBlk: TMemoryStream; FProjBmp: TMemoryStream; FActiveBlk: TMemoryStream; FActiveBmp: TMemoryStream; public ID: Integer; GUID: String[cnstGUIDLength]; Name: String; IsModified: Boolean; property ProjBlk: TMemoryStream read FProjBlk write FProjBlk; property ProjBmp: TMemoryStream read FProjBmp write FProjBmp; property ActiveBlk: TMemoryStream read FActiveBlk write FActiveBlk; property ActiveBmp: TMemoryStream read FActiveBmp write FActiveBmp; procedure Assign(ANBObjectIcon: TNBObjectIcon); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBProducer = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; Name: string; Description: String; IsModified: Boolean; procedure Assign(AProducer: TNBProducer); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; // NB Property TNBProperty = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); protected FPropValRelList: TSCSObjectList; public PropertyData: TPropertyData; PropValRelCount: Integer; IsModified: Boolean; property PropValRelList: TSCSObjectList read FPropValRelList write FPropValRelList; function AddPropValRel(APropValRel: TNBPropValRel): Integer; procedure Assign(AProperty: TNBProperty); procedure AssignOnlyProperty(AProperty: TNBProperty); procedure AssignPropValRel(APropValRelList: TSCSObjectList); procedure AssignToPProperty(AProperty: PProperty); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBPropValRel = class(TNBSpravochnickElement) private FOwner: TNBProperty; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); protected FPropValNormResList: TSCSObjectList; public ID: Integer; GUID: String; IDProperty: Integer; GuidProperty: String; PValue: String; MinValue: String; MaxValue: String; PropValNormResCount: Integer; IsModified: Boolean; property PropValNormResList: TSCSObjectList read FPropValNormResList write FPropValNormResList; function AddPropValNormRes(APropValNormRes: TNBPropValNormRes): Integer; procedure Assign(APropValRel: TNBPropValRel); procedure AssignOnlyPropValRel(APropValRel: TNBPropValRel); procedure AssignPropValNormRes(APropValNormResList: TSCSObjectList); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBPropValNormRes = class(TNBSpravochnickElement) private FOwner: TNBPropValRel; procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; IDPropValRel: Integer; GuidPropValRel: String; IDNBComponent: Integer; GuidNBComponent: String; IDNBRes: Integer; GuidNBRes: String; IDNBNorm: Integer; GuidNBNorm: String; Kolvo: Double; ExpenseForLength: Double; CountForPoint: Double; StepOfPoint: Double; IsModified: Boolean; procedure Assign(APropValNormRes: TNBPropValNormRes); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBResource = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public ID: Integer; GUID: String; Cypher: String; Name: String; Izm: String; Price: Double; RType: Integer; IsModified: Boolean; IsApplyDataForAllSame: Boolean; procedure Assign(AResource: TNBResource); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TNBSuppliesKind = class(TNBSpravochnickElement) private procedure LoadFromMemTable(AStringsMan: TStringsMan); procedure SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); public Data: TSuppliesKind; IsModified: Boolean; procedure Assign(ASuppliesKind: TNBSuppliesKind); procedure Clear; constructor Create(AFormOwner: TForm); destructor Destroy; override; procedure Save(AMakeEdit: TMakeEdit); end; TPointFigureRelation = class(TMyObject) protected FFirstPointObject: TSCSCatalog; FLastPointObject: TSCSCatalog; FTraces: TIntList; FTracesObjects: TSCSCatalogs; public FirstPointFigure: Integer; //ID точечного объекта LastPointFigure: Integer; //ID точечного объекта property FirstPointObject: TSCSCatalog read FFirstPointObject write FFirstPointObject; property LastPointObject: TSCSCatalog read FLastPointObject write FLastPointObject; property Traces: TIntList read FTraces write FTraces; // ID-ки трасс, соединяющие эти точечные объекты на КАДе property TracesObjects: TSCSCatalogs read FTracesObjects write FTracesObjects; constructor Create; overload; destructor Destroy; override; end; TTableBufferInfo = class FBuffer: Pointer; //Буффер MaxRecCount: Integer; //Размер буфера в записях RecCount: Integer; //Тек. количество записей RecSize: Integer; //Размер одной записи FName: string; //Путь к файлу FNameStreams: string; //Путь к файлу со стримами FFileStream: TFileStream; FStreamList: TStreamList; FStreamListLastID: Integer; BuffCount: Integer; //Количество буферов, после открытия из файла RemainsRecCount: integer; //остаток записей после буферов end; TMemBase = class(TMyObject) private FCatalog: TSCSCatalogExtended; FMemBaseMode: TMemBaseMode; FDirName: string; FOwnedStreams: TObjectList; FCatalogBuff: TTableBufferInfo; FCatBuff: TTableBufferInfo; FCatRelBuff: TTableBufferInfo; FCatalogPropsBuff: TTableBufferInfo; FComponBuff: TTableBufferInfo; FComponPropsBuff: TTableBufferInfo; FCompRelBuff: TTableBufferInfo; FConnectedComponsBuff: TTableBufferInfo; FCableCanalConnectorBuff: TTableBufferInfo; FInterfRelBuff: TTableBufferInfo; FIOfIRelBuff: TTableBufferInfo; FInterfPosConnectionData: TTableBufferInfo; FNormBuff: TTableBufferInfo; FObjectsBlobsBuff: TTableBufferInfo; FPortInterfRelBuff: TTableBufferInfo; FResourceRelBuff: TTableBufferInfo; FSprCurrencyBuff: TTableBufferInfo; FSprCompTypeBuff: TTableBufferInfo; FSprCompTypePropBuff: TTableBufferInfo; FSprInterfaceBuff: TTableBufferInfo; FSprInterfAccordanceBuff: TTableBufferInfo; FSprInterfNormBuff: TTableBufferInfo; FSprNetTypeBuff: TTableBufferInfo; FSprNormBuff: TTableBufferInfo; FSprObjectIconBuff: TTableBufferInfo; FSprProducerBuff: TTableBufferInfo; FSprPropertyBuff: TTableBufferInfo; FSprPropValRelBuff: TTableBufferInfo; FSprPropValNormResBuff: TTableBufferInfo; FSprResourceBuff: TTableBufferInfo; FSprSuppliesKindBuff: TTableBufferInfo; FStringsManBuff: TTableBufferInfo; FFileAccesFailCount: Integer; function AppendStreamToBuff(ABuff: TTableBufferInfo; AStream: TStream; AOwnedStream: Boolean): Integer; function CreateBuffer(AMaxRecCount, ARecSize: Integer; AFName: String; AFNameStreams: String=''): TTableBufferInfo; procedure CloseBuffer(ABuff: TTableBufferInfo); procedure CloseBuffers; procedure GetStreamFromBuff(ABuff: TTableBufferInfo; AStreamCode: Integer; AStream: TStream); procedure LoadBuffFromFile(ABuff: TTableBufferInfo); procedure LoadCatalogs(ACatalogs: TSCSCatalogs); procedure LoadCatRels(ACatRels: TList); procedure LoadCatalogProps(AProps: TList); procedure LoadCompons(ACompons: TSCSComponents); procedure LoadComponProps(AProps: TList); procedure LoadCompRels(AComplects, AConnections: TList); procedure LoadConnectedComponsInfo(AConnectedComponsList: TConnectedComponsList); procedure LoadCableCanalConnectors(ACableCanalConnectors: TList); procedure LoadInterfRels(AInterfRels: TSCSInterfaces); procedure LoadIOfIRels(AIOfIRels: TSCSObjectList); procedure LoadInterfPosConnections(AInterfPosConnections: TSCSObjectList); procedure LoadNorms(ANorms: TSCSNorms); procedure LoadObjectsBlobs(AObjectsBlobs: TObjectsBlobs); procedure LoadPortInterfRels(APortInterfRels: TList); procedure LoadResourceRels(AResoureRels: TSCSResources); procedure LoadSprCompTypes(ASprCompTypes: TSCSObjectList); procedure LoadSprCompTypeProps(ASprCompTypeProps: TSCSObjectList); procedure LoadSprCurrencies(ASprCurrencies: TSCSObjectList); procedure LoadSprInterfaces(ASprInterfaces: TSCSObjectList); procedure LoadSprInterfAccordances(ASprInterfAccordances: TSCSObjectList); procedure LoadSprInterfNorms(ASprInterfNorms: TSCSObjectList); procedure LoadSprNetTypes(ASprNetTypes: TSCSObjectList); procedure LoadSprNorms(ASprNorms: TSCSObjectList); procedure LoadSprObjectIcons(ASprObjectIcons: TSCSObjectList); procedure LoadSprProducers(ASprProducers: TSCSObjectList); procedure LoadSprProperties(ASprProperties: TSCSObjectList); procedure LoadSprPropValRels(ASprPropValRels: TSCSObjectList); procedure LoadSprPropValNormRes(ASprPropValNormRes: TSCSObjectList); procedure LoadSprResources(ASprResources: TSCSObjectList); procedure LoadSprSuppliesKinds(ASprSuppliesKinds: TSCSObjectList); procedure LoadStringsManInfos(AStringsManInfos: TList); function OpenBuffer(ABuff: TTableBufferInfo; AMode: Word): Boolean; procedure OpenBuffers(AMode: Word); procedure SaveBuffToFile(ABuff: TTableBufferInfo); procedure SaveBuffsToFiles; procedure SaveCatalogToBuff(ACatalog: TSCSCatalog); procedure SaveCatRelToBuff(AIDCatalog, AIDComponent: Integer); procedure SaveCatalogPropToBuff(AProp: PProperty); procedure SaveComponToBuff(ACompon: TSCSComponent); procedure SaveComponPropToBuff(AProp: PProperty); procedure SaveCompRelToBuff(ACompRel: PComplect); procedure SaveConnectedComponsToBuff(AConnectedComponsInfo: TConnectedComponsInfo); procedure SaveCableCanalConnectorToBuff(ACableCanalConnector: PCableCanalConnector); procedure SaveInterfRelToBuff(AInterf: TSCSInterface); procedure SaveIOfIRelToBuff(AIOfIRel: TSCSIOfIRel); procedure SaveInterfPosConnectionToBuff(AInterfPosConnection: TSCSInterfPosConnection); procedure SaveNormToBuff(ANorm: TSCSNorm); procedure SaveObjectsBlobsToBuff(AObjectsBlob: TObjectsBlob); procedure SavePortInterfRelToBuff(APortInterfRel: PPortInterfRel); procedure SaveResourceRelToBuff(AResoureRel: TSCSResourceRel); procedure SaveSprCompTypeToBuff(ASprCompType: TNBComponentType); procedure SaveSprCompTypePropToBuff(ASprCompTypeProp: TNBCompTypeProperty); procedure SaveSprCurrencyToBuff(ASprCurrency: TNBCurrency); procedure SaveSprInterfaceToBuff(ASprInterface: TNBInterface); procedure SaveSprInterfAccordanceToBuff(ASprInterfAccordance: TNBInterfaceAccordance); procedure SaveSprInterfNormToBuff(ASprInterfNorm: TNBInterfaceNorm); procedure SaveSprNetTypeToBuff(ASprNetType: TNBNetType); procedure SaveSprNormToBuff(ASprNorm: TNBNorm); procedure SaveSprObjectIconToBuff(ASprObjectIcon: TNBObjectIcon); procedure SaveSprProducerToBuff(ASprProducer: TNBProducer); procedure SaveSprPropertyToBuff(ASprProperty: TNBProperty); procedure SaveSprPropValRelToBuff(ASprPropValRel: TNBPropValRel); procedure SaveSprPropValNormResToBuff(ASprPropValNormRes: TNBPropValNormRes); procedure SaveSprResourceToBuff(ASprResource: TNBResource); procedure SaveSprSuppliesKindToBuff(ASprSuppliesKind: TNBSuppliesKind); procedure SaveStringsManInfoBuff(AStringsManInfo: PStringsManInfo); function GetMTKatalog: TSQLMemTable; function GetScriptForCreateCADObjects: String; function GetScriptForCreateFilters: String; function GetScriptForCreateInterfPosConnection: String; function GetScriptForCreateObjectsBlobs: String; function GetScriptForCreatePortInterfaceRelation: String; function GetScriptForCreateSpravochniks: String; function GetScriptForCreateStringsMan: string; procedure UpdateStructure; protected FBuffList: TObjectList; public procedure CloseAllTables; constructor Create(ACatalogOwner: TSCSCatalogExtended); procedure CreateAllTables; procedure DeleteAllIndexes; procedure DeleteAllTables; destructor Destroy; override; procedure EmptyAllTables; procedure OpenAllTables; procedure LoadAllTables; procedure LoadAllTablesFromDir(ADirName: string); procedure LoadAllTablesFromFile(AFileName: string); procedure LoadAllTablesFromStream(AStream: TStream); function SaveAllTables: Boolean; function SaveAllTablesToDir(ADirName: string): Boolean; function SaveAllTablesToFile(const AFileName: String; ATogether: Boolean=false): Boolean; procedure UnSortingTables; procedure BeginWrite; procedure EndWrite; end; TStringsMan = class(TMyObject) private FCatalog: TSCSCatalogExtended; FProject: TSCSproject; FCataogNameStrings: TStringList; FCataogNameShortStrings: TStringList; FComponGuidNBStrings: TStringList; FComponNameStrings: TStringList; FComponNameShortStrings: TStringList; FComponCypherStrings: TStringList; FComponNoticeStrings: TStringList; FComponArticulStrings: TStringList; FComponentTypeGUIDStrings: TStringList; FObjectIconGUIDStrings: TStringList; FProducerGUIDStrings: TStringList; FSuppliesKindGUIDStrings: TStringList; FSupplierGUIDStrings: TStringList; FNetTypeGUIDStrings: TStringList; FIzmStrings: TStringList; FInterfaceGUIDStrings: TStringList; FInterfaceNoticeStrings: TStringList; FInterfaceSideSectionStrings: TStringList; FPropertyGUIDStrings: TStringList; FPropertyValueStrings: TStringList; FPropValRelGUIDStrings: TStringList; FNBConnectorGuidStrings: TStringList; FNormGuidNBStrings: TStringList; FNormCypherStrings: TStringList; FNormNameStrings: TStringList; FNormWorkKindStrings: TStringList; FResourceRelGuidNBStrings: TStringList; FResourceRelCypherStrings: TStringList; FResourceRelNameStrings: TStringList; FCompTypeSysNameStrings: TStringList; function CreateStringList: TStringList; public property Catalog: TSCSCatalogExtended read FCatalog; property CataogNameStrings: TStringList read FCataogNameStrings write FCataogNameStrings; property CataogNameShortStrings: TStringList read FCataogNameShortStrings write FCataogNameShortStrings; property ComponGuidNBStrings: TStringList read FComponGuidNBStrings write FComponGuidNBStrings; property ComponNameStrings: TStringList read FComponNameStrings write FComponNameStrings; property ComponNameShortStrings: TStringList read FComponNameShortStrings write FComponNameShortStrings; property ComponCypherStrings: TStringList read FComponCypherStrings write FComponCypherStrings; property ComponNoticeStrings: TStringList read FComponNoticeStrings write FComponNoticeStrings; property ComponArticulStrings: TStringList read FComponArticulStrings write FComponArticulStrings; property ComponentTypeGUIDStrings: TStringList read FComponentTypeGUIDStrings write FComponentTypeGUIDStrings; property ObjectIconGUIDStrings: TStringList read FObjectIconGUIDStrings write FObjectIconGUIDStrings; property ProducerGUIDStrings: TStringList read FProducerGUIDStrings write FProducerGUIDStrings; property SuppliesKindGUIDStrings: TStringList read FSuppliesKindGUIDStrings write FSuppliesKindGUIDStrings; property SupplierGUIDStrings: TStringList read FSupplierGUIDStrings write FSupplierGUIDStrings; property NetTypeGUIDStrings: TStringList read FNetTypeGUIDStrings write FNetTypeGUIDStrings; property IzmStrings: TStringList read FIzmStrings write FIzmStrings; property InterfaceGUIDStrings: TStringList read FInterfaceGUIDStrings write FInterfaceGUIDStrings; property InterfaceNoticeStrings: TStringList read FInterfaceNoticeStrings write FInterfaceNoticeStrings; property InterfaceSideSectionStrings: TStringList read FInterfaceSideSectionStrings write FInterfaceSideSectionStrings; property PropertyGUIDStrings: TStringList read FPropertyGUIDStrings write FPropertyGUIDStrings; property PropertyValueStrings: TStringList read FPropertyValueStrings write FPropertyValueStrings; property PropValRelGUIDStrings: TStringList read FPropValRelGUIDStrings write FPropValRelGUIDStrings; property NBConnectorGuidStrings: TStringList read FNBConnectorGuidStrings write FNBConnectorGuidStrings; property NormGuidNBStrings: TStringList read FNormGuidNBStrings write FNormGuidNBStrings; property NormCypherStrings: TStringList read FNormCypherStrings write FNormCypherStrings; property NormNameStrings: TStringList read FNormNameStrings write FNormNameStrings; property NormWorkKindStrings: TStringList read FNormWorkKindStrings write FNormWorkKindStrings; property ResourceRelGuidNBStrings: TStringList read FResourceRelGuidNBStrings write FResourceRelGuidNBStrings; property ResourceRelCypherStrings: TStringList read FResourceRelCypherStrings write FResourceRelCypherStrings; property ResourceRelNameStrings: TStringList read FResourceRelNameStrings write FResourceRelNameStrings; property CompTypeSysNameStrings: TStringList read FCompTypeSysNameStrings write FCompTypeSysNameStrings; procedure AddStrToList(AStr: string; AID: Integer; AList: TStringList); procedure Clear; constructor Create(ACatalogOwner: TSCSCatalogExtended); destructor Destroy; override; function GenStrID(const AStr: string; AStringList: TStringList): Integer; function GetStrByID(AID: Integer; AStringList: TStringList): string; procedure OnBeforeLoad; end; TCADNormColumn = class(TMyObject) private FID: Integer; FIDCADNormStruct: Integer; FCableName: string; protected FColumns: TStringList; public property ID: Integer read FID write FID; property IDCADNormStruct: Integer read FIDCADNormStruct write FIDCADNormStruct; property CableName: string read FCableName write FCableName; property Columns: TStringList read FColumns write FColumns; procedure Assign(ACADNormColumn: TCADNormColumn); constructor Create; destructor Destroy; override; end; TCADNormStruct = class(TMyObject) private FID: Integer; FNumber: string; FName: string; FIzm: string; FCount: string; FIDCatalog: Integer; FCatalogItemType: Integer; protected FNormColumns: TObjectList; public property ID: Integer read FID write FID; property IDCatalog: Integer read FIDCatalog write FIDCatalog; property CatalogItemType: Integer read FCatalogItemType write FCatalogItemType; property Number: string read FNumber write FNumber; property Name: string read FName write FName; property Izm: string read FIzm write FIzm; property Count: string read FCount write FCount; property NormColumns: TObjectList read FNormColumns write FNormColumns; procedure Assing(ACADNormStruct: TCADNormStruct); procedure AssignOnlyCADNorm(ACADNormStruct: TCADNormStruct); procedure AssignNormColumns(ANormColumns: TObjectList); constructor Create; destructor Destroy; override; end; TMarkTemplateObj = class(TMyObject) public FBeforeText: String; // Текст перед номером объекта FObjPrefix: Char; // идентификатор объекта FMinIndexLength: Integer; // минимальная длина номера объекта FLetter: Integer; // Буквенное ли обозначение FRadix: Integer; FAfterText: String; // Текст после номера объекта FTagPropName: String; constructor Create; overload; destructor Destroy; override; // Tolik 12/12/2019 -- function IndexToStr(AVal: Integer): String; end; TCheckCollectComponJoinToComponsRes = class(TMyObject) public FComponsFromCollect: TSCSComponents; FListOfListProperCompons: TObjectList; FCanJoin: Boolean; constructor Create; destructor Destroy; override; end; TDefectAct = class(TComponent) private FFindDefectChecked: Boolean; FFindDefectAdress: String; FFindDefectDescription: String; FLinkTransportChecked: Boolean; FLinkTransportPointA: String; FLinkTransportPointB: String; FLinkTransportCable: Double; FLinkTransportMaterials: String; FSetEquipmentChecked: Boolean; FSetEquipmentAddress: String; FSetEquipmentEqipm: String; FSetEquipmentMaterial: String; FMoveEquipmentChecked: Boolean; FMoveEquipmentPointA: String; FMoveEquipmentPointB: String; FMoveEquipmentEqipm: String; FMoveEquipmentMaterial: String; FContractor: String; FDateGetting: TDateTime; FDateExecution: TDateTime; public procedure SaveToStream(AStream: TStream); procedure LoadFromStream(AStream: TStream); published Property FindDefectChecked: Boolean read FFindDefectChecked write FFindDefectChecked; Property FindDefectAdress: String read FFindDefectAdress write FFindDefectAdress; Property FindDefectDescription: String read FFindDefectDescription write FFindDefectDescription; Property LinkTransportChecked: Boolean read FLinkTransportChecked write FLinkTransportChecked; Property LinkTransportPointA: String read FLinkTransportPointA write FLinkTransportPointA; Property LinkTransportPointB: String read FLinkTransportPointB write FLinkTransportPointB; Property LinkTransportCable: Double read FLinkTransportCable write FLinkTransportCable; Property LinkTransportMaterials: String read FLinkTransportMaterials write FLinkTransportMaterials; Property SetEquipmentChecked: Boolean read FSetEquipmentChecked write FSetEquipmentChecked; Property SetEquipmentAddress: String read FSetEquipmentAddress write FSetEquipmentAddress; Property SetEquipmentEqipm: String read FSetEquipmentEqipm write FSetEquipmentEqipm; Property SetEquipmentMaterial: String read FSetEquipmentMaterial write FSetEquipmentMaterial; Property MoveEquipmentChecked: Boolean read FMoveEquipmentChecked write FMoveEquipmentChecked; Property MoveEquipmentPointA: String read FMoveEquipmentPointA write FMoveEquipmentPointA; Property MoveEquipmentPointB: String read FMoveEquipmentPointB write FMoveEquipmentPointB; Property MoveEquipmentEqipm: String read FMoveEquipmentEqipm write FMoveEquipmentEqipm; Property MoveEquipmentMaterial: String read FMoveEquipmentMaterial write FMoveEquipmentMaterial; Property Contractor: String read FContractor write FContractor; Property DateGetting: TDateTime read FDateGetting write FDateGetting; Property DateExecution: TDateTime read FDateExecution write FDateExecution; end; procedure AddNewSprGUIDsToProjectFromComponent(AComponent: TSCSComponent; ASpravochnik: TSpravochnik); function AddPreyscurantToNorm(ANorm: TSCSNorm; APreyscurant: TSCSComponent; AInterfaceType: Integer): TSCSNormPreyscurant; // Добавляет свойство в компонент из справочника по системному имени function AddPropertyToComponFromSprBySysName(ACompon: TSCSComponent; ASpravochnik: TSpravochnik; const APropSysName, AValue: String): PProperty; procedure AddPropsToComponFromSprBySN(ACompon: TSCSComponent; const APropSN: String; AValue: String=''); procedure AddPropsToComponFromSprBySysNames(ACompon: TSCSComponent; APropSysNames: TStringList; const AValue: String); procedure AfterLoadListSetting(var aSetting: TListSettingRecord); // применить изменения индекса компонента procedure ApplyChangeComponMarkID(AComponent: TSCSComponent; ADefToCAD, ADefToCADNameMark: Boolean; ANoDefineCompons: TSCSComponents); procedure ChangeCADCrossObject(AList: TSCSList; AObjectID: Integer; ANewCADCrossObject: TCADCrossObject); procedure ChangeChldComponPropFloat(ACompon: TSCSComponent; AChldType: Integer; const APropSN: string; AVal: Double; AKoeff: PDouble); function CheckCanLoadInterfIOfIRelsFromBase(AInterface: TSCSInterface): Boolean; function CheckCanLoadInterfInternalConnectionsFromBase(AInterface: TSCSInterface): Boolean; function CheckCanLookComponInReportCable(AComponent: TSCSComponent; ACanHaveDismountAccount: Boolean): Boolean; function CheckCanLookComponInReportRsrc(AComponent: TSCSComponent; ACanHaveActiveComponents, ACanHaveDismountAccount: Boolean): Boolean; function CheckCanUsePropInCompon(const APropSysName: string; ACompon: TSCSComponent): Boolean; function CheckEqualInterfaces(AInterfaces1, AInterfaces2: TSCSInterfaces; APortOwner1, APortOwner2: TSCSInterface; ASameCountForBoth, AByIsBusy: Boolean; AptrCount: PInteger = nil): Boolean; // Проверяет, есть ли в НБ справочный компонент function CheckExistsSpravComponInNBWithCopy(ASrcForm: TForm; AGuidNBComponent, AMessg: String): Boolean; // Прверяет, есть ли внутреннее подкючение компонентов function CheckComponHaveInternalConnection(AComponent: TSCSComponent): Boolean; function CheckConnectedComponObjectsInCAD(AComponent1, AComponent2: TSCSComponent): Boolean; function CheckConnectedObjectsInCAD(AObject1, AObject2: TSCSCatalog): Boolean; // есть ли в компоненте внутренее подключение интерфейсами function CheckHaveComponentInternalInterfConnection(AComponent: TSCSComponent): Boolean; // Есть ли среди кусков кабеля демонтированный function CheckHaveComponentDismountedInList(AComponents: TSCSComponents): Boolean; // проверяет есть ли в линейном компоненте только не парные интерфейсы function CheckHaveLineComponOnlyNoPairInterfaces(AComponent: TSCSComponent): Boolean; function CheckHaveWholeComponentDismounted(ACatalog: TSCSCatalog; AWholeIDs: TIntList): Boolean; function CheckInterfReadyToConnect(AInterface: TSCSInterface; ASide, AConnectType: Integer; ACanConnBusyMultiple: Boolean): Boolean; function CheckIsLineObjectInList(AObjects: TSCSCatalogs; AWithCompons: Boolean): Boolean; function CheckJoinedComponToIsLine(AComponent: TSCSComponent; AToIsLine: Integer; ARecursive: Boolean): Boolean; function checkJoinedComponents(AComponent1, AComponent2: TSCSComponent; AOnlyInSides: Boolean): Boolean; function CheckJoinedComponToComponFromObject(ACompon: TSCSComponent; AObject: TSCSCatalog): Boolean; function CheckJoinedComponToComponWithChilds(ASCSComponentWithChilds, ACheckCompon: TSCSComponent): Boolean; function CheckJoinedToSameByWholeID(AComponent: TSCSComponent): Boolean; function CheckJoinCollectComponWithComponList(ACollectCompon: TSCSComponent; AComponList: TSCSComponents): TCheckCollectComponJoinToComponsRes; function CheckJoinComponsByObjects(ACompon1, ACompon2: TSCSComponent): Boolean; //19.05.2011 function CheckJoinComponsWithoutInterf(ACompon1, ACompon2: TSCSComponent): Boolean; //19.05.2011 function CheckJoinComponsWithoutObjSides(ACompon1, ACompon2: TSCSComponent): Boolean; function CheckJoinComponentToWithComplects(AComponent, AComponentWithComplects: TSCSComponent; ASide1, ASide2: Integer): Boolean; // подключен ли AJoinedComponent к входящим интерфейсам компоненты AComponent function CheckJoinedComponToIncomingInterface(AJoinedComponent, AComponent: TSCSComponent): Boolean; function CheckJoinedInterfByPos(AInterf1, AInterf2: TSCSInterface; APosFrom1, APosTo1, APosFrom2, APosTo2: Integer; APtrPosKolvo: PInteger=nil): Boolean; //function ConnectComponsByParams(AConnectComponParams: PConnectComponParams): TConnectInterfRes; // ASideCompon1, ASideCompon2, AIDCompRel: Integer; // AConnectType: TConnectType; // ASimulation, ACanConnBusyMultiple, ACanWithNoInterfaces, ACanWithNoParams: Boolean; // ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil): TConnectInterfRes; function CheckHaveObjectIconOtherType(AObject: TSCSCatalog; ACurrIconType: Integer; var AObjectIconOtherType: TMemoryStream; var AGUIDObjectIconOtherType: string): Boolean; // подключен ли интерфейс к интерфейсу из списка внутрикомпонентным подключением function CheckInterfJoinedToInterfFromListAsInterfnal(AInterface: TSCSInterface; AInterfList, AInterfConnectList: TSCSInterfaces; AComponConnectToInterf: TSCSComponent; ACheckInterfacesConnectToSameCompon: Boolean): Boolean; // Проверка, если в списке интерфейсы, такие как в другом списке по GUIDInterface function CheckInterfacesInListByGUIDInterface(AInterfList, AList: TSCSInterfaces): Boolean; function CheckNumInPositionList(ANum: Integer; APositions: TList): Boolean; // Копирует компонент из МП в НБ function CopyComponentFromPMToNB(ASrcForm, ATrgForm: TForm; AComponent: TSCSComponent; AIDDestDir: Integer): Integer; // Копирует компонент в СКС объект function CopyComponentToPMSCSObject(ASrcComponent: TSCSComponent; AObject: TSCSCatalog; AWithComplects: Boolean): TSCSComponent; function CheckPortNoHaveBusyInterfaces(APort: TSCSInterface): Boolean; function CheckPosIntersectRange(InterfPosition: TSCSInterfPosition; ARFrom, ARTo: integer): Boolean; // Проверяет может ли универсальный интерфейс подключится к типу комопненты function CheckUInterfConnectToCompType(AUInterfIdx: Integer; const ACompTypeSN: String): Boolean; procedure ClearComponIOfIRels(AComponent: TSCSComponent); procedure ClearTVNodeFieldInChildObjects(AObject: TSCSComponCatalogClass; AClearInObject: Boolean); function CmpPropValues(AProp1, AProp2: PProperty): Boolean; function CompareCCEsByID(Item1, Item2: Pointer): Integer; function CompareCompRelsByID(Item1, Item2: Pointer): Integer; function CompareCompRelsBySortID(Item1, Item2: Pointer): Integer; function CompareIOfIRelsByID(Item1, Item2: Pointer): Integer; function CompareInterfPosConnectionsByID(Item1, Item2: Pointer): Integer; function CompareNormsByID(Item1, Item2: Pointer): Integer; function ComparePortInterfRelsByID(Item1, Item2: Pointer): Integer; function ComparePropsByID(Item1, Item2: Pointer): Integer; function CompareResourcessByID(Item1, Item2: Pointer): Integer; // Соединяет два инетрфейса заданными позициями //function ConnectInterfaces(AInterfRel1, AInterfRel2: TSCSInterface; AIDCompRel: Integer; AConnectType: TConnectType; // AInterfPositions1, AInterfPositions2: TSCSInterfPositions; AIsFinalConnection: Boolean): Boolean; function CorrectComponLinksBeforeSaveToNB(AComponent: TSCSComponent; ASrcForm, ATrgForm: TForm; ATrgDir: TSCSCatalog): Boolean; procedure CreateInterfacesInComponToConnect(ATrgCompon, AComponToConnect: TSCSComponent; ATrgSide, ASrcSide, AConnectType: Integer); procedure DecInterfPositionsKolvo(ANewKolvo: Integer; AInterfPositions: TSCSInterfPositions); function DefineChildCatalogFromPath(ARoot: TSCSCatalog; APath: TStringList): TSCSCatalog; procedure DefineChildObjectsFullness(AObject: TSCSCatalog; AItemType: Integer); // Определяет поля IsBusy для конструктивных интерфейсов procedure DefineComponConstructiveInterfacesIsBusy(AComponent: TSCSComponent); procedure DefineComponNormResByProperty(AComponent: TSCSComponent; AProperty: PProperty; ASave: Boolean = true; ADeletedNormIDs: TIntList = nil; ADeletedResIDs: TIntList = nil); procedure DefineComponPriceOnCopyToOtherBase(ACompon: TSCSComponent; ASrcObject, ATrgObject: TSCSCatalog; ASrcForm, ATrgForm: TForm); procedure DefineCurrenciesBetweenObjects(AComponID, ASrcObjectID, ATrgObjectID: Integer; ASrcForm, ATrgForm: TForm; var AOldCurrency, ANewCurrency: TCurrency); procedure DefinePriceCalcInChildComponInNB(AComponent: TSCSComponent; ANBForm: TForm); // Определяет компонент маму и компнент папу function DefineFemaleMaleCompons(ACompon1, ACompon2: TSCSComponent; var AFemaleCompon, AMaleCompon: TSCSComponent; var AFemaleInterf, AMaleInterf: TSCSInterface): Boolean; // Создать связь поциций в связкеинтерфейсов, если она отсутсвует (связь поциций) procedure DefineNoExistsInterfPosConnection(AIOfIRel: TSCSIOfIRel); procedure DefineJoiningComponentsByTrunk(var ACompon1, ACompon2: TSCSComponent; ASideCompon1, ASideCompon2: Integer); procedure DefineObjectsForPointFigureRelations(APointFigureRelations: TObjectList; ASCSList: TSCSList); procedure DefinePointObjectsForLineCompon(ALineComponent: TSCSComponent; var APointFrom, APointTo: TSCSCatalog); procedure DeleteComponNormResByIDCompPropRel(AComponent: TSCSComponent; AIDCompPropRel: Integer); // Удалит нрмы пришедшие из интерфейса в компоненте procedure DeleteComponObjectsForNB(AComponent: TSCSComponent; ARecursive: Boolean); function ExtendTemplateInterface(AInterf: TSCSInterface; AAddCount: Integer; ANewValue: PDouble): Boolean; function HaveComponentSameInterfaces(ACheckingComponent, AComponentWithInterfaces: TSCSComponent; AInterfType: Integer): Boolean; // Вернет новый индекс компоненты в пределах объекта function GenComponMarkIDByAreaObject(AComponent: TSCSComponent; AAreaObject: TSCSCatalog; AChildReferencesInArea: Boolean; APointComplIndexingMode: TPointComplIndexingMode): Integer; function GetCableCanalFullnessKoef(ACableChannel: TSCSComponent; ACable: TSCSComponent = nil): Double; function GetCatalogAreaObject(ACatalog: TSCSCatalog): TSCSCatalog; function GetCatalogItemsNames(ACatalog: TSCSCatalog; AItemTypes: TintSet): String; function GetCatalogTopComponCountByWithoutType(ACatalog: TSCSCatalog; ACompTypeSysName: String): Integer; function GetCatalogComponCountWithoutDisabledTypes(ACatalog: TSCSCatalog; ADisabledTypes: TStringList; AEnoughOne: Boolean): Integer; function GetCatalogComponentsJoinedToNoPoint(ACatalog: TSCSCatalog): TSCSComponents; function GetCatalogPortByAnalogInterfaces(ACatalog: TSCSCatalog; AAnalogPort: TSCSInterface; AAnalogInterfaces: TSCSInterfaces; AConnectOrder: TAutoTraceConnectOrderType; AWithEmptyInterfaces: Boolean): TSCSInterface; function GetCatalogListBySCSIDList(ACatalog: TSCSCatalog; ASCSIDList: TIntList): TSCSCatalogs; function GetCatalogsEqualPortsByAnalogInterfaces(ACatalog1, ACatalog2: TSCSCatalog; AAnalogInterfaces: TSCSInterfaces; var APort1, APort2: TSCSInterface): Boolean; // Вернет список подпапок в порядке их расположения function GetCatalogsInOrderFromParent(AParentCatalog: TSCSCatalog; AItemType: Integer): TSCSCatalogs; // Вернет количество сторон элемента каб канала function GetCCESideCount(ACCE: TSCSComponent): Integer; // Вернет подкаталог по имени function GetChildCatalogByName(ACatalog: TSCSCatalog; const AName: String; ACaseSensitive: Boolean): TSCScatalog; // Вернет список дочерних объектов в порядке рахмещения function GetChildCatalogsInPlacingOrder(AParentCatalog: TSCSCatalog; AItemTypeFilter: TIntSet): TSCSCatalogs; function GetChildComponByIsLine(ACompon: TSCSComponent; AIsLine: Integer): TSCSComponent; function GetComplexIdentificatorByConnectedTrace(AComplexCompon: TSCSComponent; AComplexComponObject, ATraceObject: TSCSCatalog): Integer; function GetComponChildByIDCompRel(AComponent: TSCSComponent; AIDCompRel: Integer): TSCSComponent; // Вернет высоту всех комплектующих в юнитах function GetComponChildsTotalHeihhtU(AComponent: TSCSComponent; AIDCompRelToSkip: Integer): Integer; function GetComponConnectionByID(AComponent: TSCSComponent; AID: Integer): PComplect; // Вернет количество компонентов из списка интерфейсов function GetComponCountFromInterfList(AInterfList: TSCSInterfaces): Integer; function GetComponByGUIDFromList(AGUID: String; AList: TSCSComponents): TSCSComponent; function GetComponentByOldIDFromCompon(ASCSCompon: TSCSComponent; AOldID: Integer): TSCSComponent; function GetComponentByOldIDFromObject(ASCSObject: TSCSCatalog; AOldID: Integer): TSCSComponent; function GetComponFromComplexObjByLine(AConnComponent, ALineComponent: TSCSComponent): TSCSComponent; //function GetComponentFromConnObjectByTrunkPos(AList: TSCSList; // AObject: TSCSCatalog; AComponForJoin: TSCSComponent; // APos, ASidePosCompon, ASideComponForJoin: Integer; var AConnectInterfRes: TConnectInterfRes): TSCSComponent; function GetComponIdentificatorInComplex(AComponent: TSCSComponent): Integer; function GetComponIOfIRelsByIDCompRel(ASCSComponent: TSCSComponent; AIDCompRel: Integer): TList; function GetComponInterfaceByTypeAndGender(ACompon: TSCSComponent; AType, AGender, AIsMultiple: Integer; AGUIDInterface: String): TSCSInterface; function GetComponInterfacesByParams(AComponent: TSCSComponent; const AGUIDInterface: string; AIsPort: Integer=-1): TSCSInterface; function GetComponInterfacesBySide(AComponent: TSCSComponent; ASideNum, AIsBusy: Integer): TSCSInterfaces; function GetComponInterfacesThatPortNoHaveBusyInterfaces(AComponent: TSCSComponent): TSCSInterfaces; function GetComponInterfaceCount(AComponent: TSCSComponent; AInterfTypes: TIntSet; AIsBusy: Integer = biNone): Integer; function GetComponInterfBySprGUID(ACompon: TSCSComponent; const ASprGUID: String): TSCSInterface; function GetComponLastNumPair(AComponent: TSCSComponent): Integer; function GetComponNormResourcesCountByCompPropRelID(ACompon: TSCSComponent; AIDCompPropRel: Integer): Integer; function GetComponMaxNumPair(AComponent: TSCSComponent): Integer; function GetComponObjectOwnerByItemType(AComponent: TSCSComponent; AItemType: Integer): TSCSCatalog; function GetComponOutDiametrInMetr(AComponent: TSCSComponent): Double; function GetComponPairCount(ALineCompon: TSCSComponent): Integer; function GetComponPartLengthWithReserv(AComponent: TSCSComponent; var AReserv: Double; ATakeIntoPortReserv, ATakeIntoThroghObjects: Boolean): Double; // Вернет количество компонента, учитывая параметры как демонтаж, расход длины function GetComponQuantityByParams(ACompon: TSCSComponent; AUseDismountAccount: Boolean): Double; // Вернет цену и кол-во компонента в ед. изм procedure GetComponQtPriceInUOM(ACompon: TSCSComponent; AUOM: Integer; APrice, AQT: PDouble); // вернет резерв/2 для линейной компоненты, если та проходит function GetComponReservLengthFromThroughPointComponent(ALineCompon: TSCSComponent): Double; // Вернет сторону, которой компонент подключен к другому function GetComponSideJoinedToCompon(AComponent, AJoinedComponent: TSCScomponent): Integer; function GetComponSideJoinedToComponByInterf(AComponent, AJoinedComponent: TSCScomponent): Integer; // вернет сквозной список всех комплектующих по размещению function GetComponStructuredChilds(AComponent: TSCSComponent; AIncludingTop: Boolean): TSCSComponents; // Вернет верхний компонент с нужным системным именет типа компоненты function GetComponTopByCTSysNames(AComponent: TSCSComponent; ACTSysNames: TStringList; ACanRetParamCompon: Boolean): TSCSComponent; // Вернет объекты компоненты procedure GetComponObjectsMark(AComponent: TSCSComponent; var ARoom, AList: TSCSCatalog; var ARoomMark, AListMark: String; ARoomNameShortSrcType: TRoomNameShortSrcType; ARoomNameShortDefault, ARoomNameShortIfNoRoom: string); function GetComponentTrunk(ASCSComponent: TSCSComponent): TCadCrossObject; function GetComponentsByIDList(AIDList: TIntList; ASrcCompons: TSCSComponents): TSCSComponents; // Вернет список компонент в которые есть заданная норма function GetComponentsFromCatalogByNorm(ACatalog: TSCSCatalog; ANorm: TSCSNorm; ACanDuplicates: Boolean; aObjNorms: Boolean=true): TSCSObjectList; // Вернет список компонент из списка прейскурантов норм function GetComonentsFromPrescurants(APreyscurants: TSCSObjectList; ACanDuplicates: Boolean): TSCSComponents; function GetComponUOM(ACompnent: TSCSComponent): String; function GetConnectedInterfacesByConnectOrder(AInterface: TSCSInterface): TSCSInterfaces; function GetConnectKindByConnectionCompons(ACompon1, ACompon2: TSCSComponent; AConnectType: Integer): TConnectKind; // Найдет самое глубокое внутрикомпоненнтное подключение в точ. компоненте function GetDepthJoinedConnComponByConnCompon(AConnComponent: TSCSComponent; AComponPath: TSCSComponents; AComponPathNameMarks: TStrings; AResComponJoinInterfaces, APrevComponJoinInterfaces: TSCSInterfaces; aPort: TSCSInterface=nil; aPortFromPos: Integer=0; aPortToPos: Integer=0; aFindToPort: Boolean=false): TSCSComponent; function GetEmptyInterfCountFromPort(APort: TSCSInterface): Integer; function GetEndComponSideAtEnding(ALineComponent: TSCSComponent): Integer; //function GetInterfaceFromConnObjectByTrunkPos(AList: TSCSList; AObject: TSCSCatalog; APos: Integer): TSCSInterface; //function GetInternalJoinedInterfaces(AInterface: TSCSinterface): TSCSInterfaces; function GetIOfIRelFromInterfByID(AInterface: TSCSInterface; AIDIOfIRel: Integer): TSCSIOfIRel; function GetInterfKolvoFromList(AList: TSCSInterfaces; APortOwner: TSCSInterface; ABusyKolvo: PInteger): Integer; function GetInterfPositionByNum(ANum: Integer; APositions: TList): TObjectList; function GetInterfPositionsByRange(APositions: TList; aFrom, aTo: Integer): TSCSObjectList; function GetIOfIRelPosCount(AIOfIRel: TSCSIOfIRel): Integer; function GetIOfIRelThatConnectInterfaces(AInterf1, AInterf2: TSCSInterface; AFrom1, ATo1, AFrom2, ATo2: Integer): TSCSIOfIRel; //function GetItemTypeByIsLine(AIsLine: Integer): Integer; function GetJoinedComponentsInternalObject(AComponent: TSCSComponent; ASrcToResult: Boolean): TSCSComponents; function GetJoinedComponentsThroughPoint(AComponent: TSCSComponent): TSCSComponents; function GetJoinedComponWithType(ACompon: TSCSComponent; ACompTypeSysName: String): TSCSComponent; // Вернет количество подключенных компонентов к компоненте с чилдами function GetJoinedCountToComponWithChilds(ACompon: TSCSComponent): Integer; // Вернет количетсво подключенных линейных компонентов function GetJoinedLineComponCount(AComponent: TSCSComponent): Integer; // Вернет подключенный мульпорт/порт, высший приоритет имеет мультипорт function GetJoinedMultiPortPortToComponentBySide(AComponent: TSCSComponent; ASide: Integer): TSCSComponent; // Вернет подключенный магистральный компонент function GetJoinedTrunkComponent(AComponent: TSCSComponent): TSCSComponent; function GetNearComponentFromListIDs(AProject: TSCSProject; AListIDs: TIntList; AComponent: TSCSComponent; ALookingStep: Integer): TSCSComponent; // Вернет номер порта, через который связанный интерфейс подключен к другому интерфейсу function GetNppPortByConnected(APort, ARelatedInterface, AConnectedInterface: TSCSInterface; AMaxNppPortFromPosition: Integer = -1; aPortFromPos: PInteger=nil; aPortToPos: PInteger=nil): Integer; function GetNppPortByRelatedInterfPos(APort: TSCSInterface; AInterfKolvoInPortRel, AInterfPos: Integer): Integer; function GetNppPortsByConnected(APort, ARelatedInterface, AConnectedInterface: TSCSInterface): TIntList; // Вернет номер порта, к которому подключен кабель интерфейсами function GetNppPortByJoinedCompon(APort: TSCSInterface; AJoinedCompon: TSCSComponent): Integer; function GetPortsCount(aCompon: TSCSComponent; aSide: Integer; aRecursive: Boolean=false): Integer; function GetPortsCountReadyToConnectByInterf(aCompon: TSCSComponent; aSide: Integer; aRecursive: Boolean=false): Integer; function GetSCSObjectIcons(AObjectComponent: TSCSComponent): TObjectList; function GetParentComponByCompTypeSysName(AComponent: TSCSComponent; const ACompTypeSysName: string): TSCSComponent; function GetParentComponByIsLine(AComponent: TSCSComponent; AIsLine: Integer): TSCSComponent; function GetParentComponByOneCompTypeSysName(AComponent: TSCSComponent; const ACompTypeSysNames: TStringlist): TSCSComponent; function GetParentComunicationCompon(ACompon: TSCSComponent): TSCSComponent; function GetPropValueAsBoolGrayedDef(AProperties: TList; const ASysName: string; ADef: Integer): Integer; function GetPointFigureRelationByPointObjects(APointFigureRelations: TObjectList; AFromPointComponent, AToPointComponent: TSCSComponent): TPointFigureRelation; function GetPointObjectsByConnectedFropmPointRelations(APointFigureRelations: TObjectList; AConnectedPoint: TSCSCatalog): TSCSCatalogs; function GetPortCaption(APort: TSCSInterface; APortNum: integer = -1): String; function GetPortPosRangeByInterfRange(AInterf: TSCSInterface; APosFrom, APosTo: Integer; var AOutPosFrom, AOutPosTo: Integer): Boolean; // Вернет диапазон с позиции который общий для другой позиции - тоесть диапазон пересечения позиций procedure GetPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer; var AOutPosFrom, AOutPosTo: Integer); function GetPosOfTopComplect(AComplect: TSCSComponent): Integer; function GetPosOfTopTrunkComplect(AComplect: TSCSComponent): Integer; function GetPreyscurantFromNormByCompon(ANorm: TSCSNorm; APreyscurant: TSCSComponent): TSCSNormPreyscurant; // Вернет позиции по которым интерфейс поключен к другому function GetInterfPositionsByConnectedInterface(AInterface, AConnectedInterf: TSCSInterface): TList; //03.02.2013 - Определить инфу о порте (номер, позиции), к которому подключен комонент function GetPortInfoByJoinedCompons(aComponWithPort, AJoinedCompon: TSCSComponent; var aNppFrom, aNppTo: Integer): Boolean; function GetRegroupedNBComponentByInternalConnections(AComponent: TSCSComponent; ANBConections: TSCSObjectList; AIDComponNewOwner: Integer; ANewCompRelPath: TIntList): TSCSComponents; function GetRoomNameShort(ARoom: TSCSCatalog; ARoomNameShortSrcType: TRoomNameShortSrcType; ARoomNameShortDefault, ARoomNameShortIfNoRoom: string): String; function GetTableKindBySCSTreeElType(aTreeElType: TSCSTreeElementType): Integer; // Вернет общее сечение кабелей трассы, кот-е вне каб каналов function GetTotalSectionFromTopCables(ATrace: TSCSCatalog): Double; // Вернет список ID-в разных листов, на которых находяться компоненты function GetVariousListsIDsByCompons(AComponents: TSCSComponents): TIntList; function GetVariousListsIDsByComponsWithWhole(ACatalog: TSCSCatalog; AComponents: TSCSComponents): TIntList; function GetVariousListsIDsByComponWithWhole(ACatalog: TSCSCatalog; AComponent: TSCSComponent): TIntList; function GetVariousListsIDsByWholeID(AProject: TSCSProject; AWholeID: integer; ANoLookLists: TIntList): TIntList; function GetVariousListsIDsByObjects(AObjects: TSCSCatalogs; ATakeInRelatedLists: Boolean): TIntList; function GroupComponsByProps(ACompons: TSCSComponents; APropSN: TStringList): TObjectList; procedure GroupSamePreyscurantsByVariousPrice(AResources: TSCSResources; const APrecision: Integer); procedure FreeInterfLists(var aInterfLists: TInterfLists); procedure LoadAllPortsFromComponToList(ACompon: TSCSComponent; ATrgList: TSCSInterfaces; AWithComplects: Boolean); procedure LoadChildComponObjectIconToList(ACompon: TSCSComponent; AIconList: TObjectList; AGUIDObjectIconTypeToSkip: string); procedure IncBusyEmptyInterface(AInterface: TSCSInterface; var AEmptyCount, ABusyCount: Integer); function IsCableComponent(AComponent: TSCSComponent): Boolean; function IsComunicationCompon(AComponent: TSCSComponent): Boolean; function IsComunicationComponEx(AComponent: TSCSComponent): Boolean; function IsPatchPanelSysName(const ASysName: String): Boolean; function IsReadOnlyProp(AItemType: Integer; AProperty: PProperty): Boolean; // Пересикаются ли диапазоны позиций APosFrom-APosTo с ACheckPosFrom-ACheckPosTo function IsPosRangesIntersect(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer): Boolean; function IsSelectedComponFigure(aCompon: TSCSComponent): Boolean; function IsTrunkComponent(AComponent: TSCSComponent): Boolean; function IsVisibleInterfaceByFilter(AInterface: TSCSInterface; AFilterBlock: TFilterBlock): Boolean; procedure LoadMarkTemplateObjectsToList(const ASrcTemplate: String; ATrgList: TList); procedure LoadPartIOfIRelsToList(AInterface: TSCSInterface; AMainIOfIRel: TSCSIOfIRel; AList: TRapList); //function LoadVariousListsIDsByWholeIDs(AObjects: TSCSCatalogs; ATakeInRelatedLists: Boolean): TIntList; function MakeEditPropertyForWholeComponent(AMakeEdit: TMakeEdit; AComponent: TSCSComponent; AProperty: PProperty): Boolean; // function MakeMarkMaskForComponent(AProj, AList, ARoom, AObj, ATopCompon, ACompon, APort: Integer; // const AComponNameShort, AMask: String): String; function MakeMarkMaskForComponByBlocks(AProj, AList, ARoom, AObj, ATopCompon, AParentCompon, ACompon, APort: Integer; const AComponNameShort, ARoomSign: String; aComponObj: TSCSComponent; ABlocks: TObjectList): String; function MakeNameMarkForComponByPortNum(AObject, AList: TSCSCatalog; ACompon: TSCSComponent; APortNum: Integer; const AMarkMask: String; ATemplateObjects: TObjectList): String; function MakeNameMarkThroughCableTIAEIA606A(ACable, AJoinedPoint: TSCSComponent): String; procedure MoveSCSTreeObject(ASrcObject, ATrgObject: TSCSComponCatalogClass); // Оставляет интерфейсы с общим кол-вом в на чале списка, а не попавшие в конец procedure MoveInterfWithCommonKolvoToBegin(ADestInterfaces, AInterfacesWithCommonKolvo: TSCSInterfaces); procedure PrepareInterfPositionsByRegion(APositions: TSCSInterfPositions; AFrom, ATo: Integer); procedure RefreshCatalogComponsLengthInFuture(ALineObject: TSCSCatalog); procedure RefreshLengthInFutureJoinedToPointComponent(APointComponent: TSCSComponent); procedure RefreshLengthInFutureNearPointObject(APointObject: TSCSCatalog); procedure RegroupComponInterfaces(AComponent: TSCSComponent); procedure RegroupInterfPositionsToConnect(AEmptyPositions1, AEmptyPositions2: TSCSInterfPositions); procedure RelateParallelInterfaces(AInterf1, AInterf2: TSCSInterface); procedure RemarkComponent(ACOmponent: TSCSComponent); procedure RemarkComponentByID(AIDCOmponent: Integer); procedure RemarkComponAfterChangePort(ACompon: TSCSComponent); procedure RemarkComponChild(ACompon, AChild: TSCSComponent); procedure RemarkComponsRelatedToLineCompon(ACompon: TSCSComponent; AProjectOwner: TSCSProject); procedure RemarkComponsRelatedToPointCompon(ACompon: TSCSComponent; AProjectOwner: TSCSProject); procedure RemarkComponsRelatedToPointComponWithChilds(ACompon: TSCSComponent; AProjectOwner: TSCSProject); procedure RemarkObjectComponsAfterChangeRoom(ASCSObject: TSCSCatalog); function RemovePreyscurantFromNorm(ANorm: TSCSNorm; APreyscurant: TSCSComponent): Integer; // Tolik 08/04/2020 -- //function ReplacePMComponFromNB(APMComponent, ANBComponent: TSCSComponent; ALeaveComplects: Boolean): TSCSComponent; function ReplacePMComponFromNB(APMComponent, ANBComponent: TSCSComponent; ALeaveComplects: Boolean; aReplacePortNumbers: Boolean = False): TSCSComponent; // procedure SaveComponAllIOfIRelsToFile(AComponent: TSCSComponent; AFileName: string = 'c:\iofirel.txt'); procedure SelectSCSObjectsInCAD(AObjects: TSCSCatalogs); // Устанавливает ссылкуна связь соединения FCompRel в соединении интерфейсов IOfIRel внутри компоненты AComponent procedure SetLinksToComplectInIOfIRel(AComponent: TSCSComponent; ARecursive: Boolean); procedure SetLinkToInterfPosConnection(AInterfPosConnection: TSCSInterfPosConnection; AOwnerInterf, AConnInterf: TSCSInterface); procedure SendFirstLastIDsToPartComponent(ALineComponent, APartComponent: TSCSComponent); procedure SetChildComponInterfacesToNoBusy(AComponent, AChildComponent: TSCSComponent; AIDCompRel: Integer); procedure SetComponAndChildsFieldComeFrom(AComponent: TSCSComponent; AComeFrom: Integer); procedure SetComponAsLite(ACompon: TSCSComponent; AIncludingTemplate: Boolean=false); procedure SortCatalogListInItemType(ACatalogs: TSCSCatalogs; AItemType: Integer; AIsBackSorting: Boolean); procedure SortComponentsByID(ASCSComponents: TSCSComponents); procedure SortComponentsByOutDiametr(ASCSComponents: TSCSComponents; ADescending: Boolean); procedure SortSCSObjectsByPMOrder(AObjectList: TSCSCatalogs); procedure TestGetInterfPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer; AResFrom, AResTo: Integer); function ReplacePMComponResFromNB(aCompon, NBCompon: TSCSComponent; aLeaveComplects: Boolean): TSCSComponent; var GTempFilesInfo: TTempFilesInfo; implementation Uses Unit_DM_SCS, U_Main, U_Common, USCS_Main, U_CAD, fib, U_EsCADClasess, U_HouseClasses, U_ArchCommon, U_ProtectionBase, U_LoginUser, U_ResourceReport, {Tolik 25/01/2022 --}U_Layers; {TComponentDesignParams} // ####################### Класс TComponentDesignParams ######################## constructor TComponentDesignParams.Create; begin inherited; FBottomBound := 0; FDescription := ''; FGraphicalImage := nil; FHeight := 0; FHeightInUnits := 0; FUnitPos := 0; FLeftBound := 0; FName := ''; FNameShort := ''; FNameMark := ''; FRightBound := 0; FTopBound := 0; FWidth := 0; end; destructor TComponentDesignParams.Destroy; begin if Assigned(FGraphicalImage) then FGraphicalImage.Free; inherited; end; {TSCSObjectList} {TSCSComponents} function TSCSComponents.Add(ASCSComponent: TSCSComponent): Integer; begin Result := FItems.Add(TObject(ASCSComponent)); end; function TSCSComponents.Remove(ASCSComponent: TSCSComponent): Integer; begin Result := FItems.Remove(TObject(ASCSComponent)); end; function TSCSComponents.GetComponenByID(AID: Integer): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSComponent := TSCSComponent(FItems.List^[i]); if SCSComponent.ID = AID then begin Result := SCSComponent; Break; ///// BREAK ///// end; end; end; function TSCSComponents.GetComponByIsLine(AIsLine: Integer): TSCSComponent; var i: Integer; begin Result := nil; for i := 0 to FItems.Count - 1 do if TSCSComponent(FItems.List^[i]).IsLine = AIsLine then begin Result := TSCSComponent(FItems[i]); Break; //// BREAK //// end; end; function TSCSComponents.GetComponentByType(const ACompTypeSysName: String): TSCSComponent; var i: Integer; begin Result := nil; for i := 0 to FItems.Count - 1 do if TSCSComponent(FItems.List^[i]).ComponentType.SysName = ACompTypeSysName then begin Result := TSCSComponent(FItems[i]); Break; //// BREAK //// end; end; function TSCSComponents.GetMaxWholeID: Integer; var i: Integer; SCSCompon: TSCSComponent; begin Result := 0; if FItems.Count > 0 then Result := TSCSComponent(FItems[0]).Whole_ID; for i := 0 to FItems.Count - 1 do begin SCSCompon := TSCSComponent(FItems[i]); if SCSCompon.Whole_ID > Result then Result := SCSCompon.Whole_ID; end; end; procedure TSCSComponents.Insert(Index: Integer; ASCSComponent: TSCSComponent); begin FItems.Insert(Index, TObject(ASCSComponent)); end; function TSCSComponents.GetItem(Index: Integer): TSCSComponent; begin Result := TSCSComponent(FItems.Items[index]); end; procedure TSCSComponents.SetItem(Index: Integer; ASCSComponent: TSCSComponent); begin FItems.Items[index] := TObject(ASCSComponent); end; {TSCSCatalogs} function TSCSCatalogs.Add(ASCSCatalog: TSCSCatalog): Integer; begin Result := FItems.Add(TObject(ASCSCatalog)); end; function TSCSCatalogs.GetByID(AID: Integer): TSCSCatalog; var i: integer; SCSCatalog: TSCSCatalog; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSCatalog := TSCSCatalog(FItems[i]); if SCSCatalog.ID = AID then begin Result := SCSCatalog; Break; //// BREAK //// end; end; end; function TSCSCatalogs.GetMaxSortID: integer; var i: integer; SCSCatalog: TSCSCatalog; begin Result := 0; for i := 0 to FItems.Count - 1 do begin SCSCatalog := TSCSCatalog(FItems[i]); if SCSCatalog.SortID > Result then Result := SCSCatalog.SortID; end; end; function TSCSCatalogs.Remove(ASCSCatalog: TSCSCatalog): Integer; begin Result := FItems.Remove(TObject(ASCSCatalog)); end; {function TSCSCatalogs.IndexOf(ASCSCatalog: TSCSCatalog): Integer; begin Result := FItems.IndexOf(TObject(ASCSCatalog)); end;} procedure TSCSCatalogs.Insert(Index: Integer; ASCSCatalog: TSCSCatalog); begin FItems.Insert(Index, TObject(ASCSCatalog)); end; function TSCSCatalogs.GetItem(Index: Integer): TSCSCatalog; begin Result := TSCSCatalog(FItems.Items[index]); end; procedure TSCSCatalogs.SetItem(Index: Integer; ASCSCatalog: TSCSCatalog); begin FItems.Items[index] := TObject(ASCSCatalog); end; {TSCSInterfaces} function TSCSInterfaces.Add(ASCSInterface: TSCSInterface): Integer; begin Result := FItems.Add(TObject(ASCSInterface)); end; function TSCSInterfaces.AddAsSortedByID(ASCSInterface: TSCSInterface): Integer; var NewIndex: Integer; InterfBoud: TSCSInterface; function FindIndex(AMinIndex, AMaxIndex: Integer): Integer; var IndexMiddle, IndexLeft, IndexRight: Integer; InterfOnMidle, InterfLeft, InterfRight: TSCSInterface; begin Result := -1; IndexMiddle := AMinIndex + ((AMaxIndex - AMinIndex) div 2); if (IndexMiddle >= AMinIndex) and (IndexMiddle <= AMaxIndex) then begin InterfOnMidle := TSCSInterface(FItems[IndexMiddle]); if InterfOnMidle <> nil then begin if ASCSInterface.ID = InterfOnMidle.ID then Result := IndexMiddle else begin InterfLeft := nil; InterfRight := nil; IndexLeft := -1; IndexRight := -1; if IndexMiddle - 1 >= AMinIndex then begin IndexLeft := IndexMiddle - 1; InterfLeft := TSCSInterface(FItems[IndexLeft]); if InterfLeft <> nil then if (ASCSInterface.ID >= InterfLeft.ID) and (ASCSInterface.ID <= InterfOnMidle.ID) then Result := IndexLeft + 1; end; if Result = -1 then if IndexMiddle + 1 <= AMaxIndex then begin IndexRight := IndexMiddle + 1; InterfRight := TSCSInterface(FItems[IndexRight]); if InterfRight <> nil then if (ASCSInterface.ID >= InterfOnMidle.ID) and (ASCSInterface.ID <= InterfRight.ID) then Result := IndexRight; end; { else begin if IndexMiddle = AMinIndex then begin IndexLeft := IndexMiddle; InterfLeft := TSCSInterface(FItems[IndexLeft]); if InterfLeft <> nil then if ASCSInterface.ID < InterfLeft.ID then Result := IndexLeft else if ASCSInterface.ID > InterfLeft.ID then Result := IndexLeft + 1; end; if Result = -1 then if IndexMiddle = AMaxIndex then begin IndexRight := IndexMiddle; InterfRight := TSCSInterface(FItems[IndexRight]); if InterfRight <> nil then if ASCSInterface.ID < InterfRight.ID then Result := IndexRight else if ASCSInterface.ID > InterfRight.ID then Result := IndexRight + 1; end; end; } if Result = -1 then if ASCSInterface.ID < InterfOnMidle.ID then // Ищем индекс в левой части Result := FindIndex(AMinIndex, IndexMiddle) else if ASCSInterface.ID > InterfOnMidle.ID then // Ищем индекс в правой части Result := FindIndex(IndexMiddle, AMaxIndex); end; end; end; end; begin Result := -1; NewIndex := -1; if FItems.Count = 0 then NewIndex := 0 else begin InterfBoud := TSCSInterface(FItems[FItems.Count - 1]); if InterfBoud <> nil then if ASCSInterface.ID >= InterfBoud.ID then NewIndex := FItems.Count; if NewIndex = -1 then begin InterfBoud := TSCSInterface(FItems[0]); if InterfBoud <> nil then if ASCSInterface.ID <= InterfBoud.ID then NewIndex := 0; end; if NewIndex = -1 then NewIndex := FindIndex(0, FItems.Count - 1); end; if NewIndex <> -1 then FItems.Insert(NewIndex, TObject(ASCSInterface)) else raise Exception.Create('Index not found'); Result := NewIndex; end; function TSCSInterfaces.GetInterfaceByID(AID: Integer): TSCSInterface; var i: Integer; Interf: TSCSInterface; begin Result := nil; for i := 0 to FItems.Count - 1 do begin Interf := TSCSInterface(FItems[i]); if Interf.ID = AID then begin Result := Interf; Break; ///// BREAK ///// end; end; end; function TSCSInterfaces.GetAsStr: String; var i: Integer; SCSInterface: TSCSInterface; begin Result := ''; for i := 0 to FItems.Count - 1 do begin SCSInterface := TSCSInterface(FItems[i]); if Result <> '' then Result := Result + ' '; Result := Result + IntToStr(SCSInterface.ID); end; end; function TSCSInterfaces.GetIOfIRels: TSCSObjectList; var Interf: TSCSInterface; i: Integer; begin Result := TSCSObjectList.Create(false); for i := 0 to FItems.Count - 1 do begin Interf := TSCSInterface(FItems[i]); Result.Assign(Interf.FIOfIRelOut, laOr); end; end; function TSCSInterfaces.Remove(ASCSInterface: TSCSInterface): Integer; begin Result := FItems.Remove(TObject(ASCSInterface)); end; procedure TSCSInterfaces.Insert(Index: Integer; ASCSInterface: TSCSInterface); begin FItems.Insert(Index, TObject(ASCSInterface)); end; procedure TSCSInterfaces.SortByID; function CompareItems(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TSCSInterface(Item1).ID, TSCSInterface(Item2).ID); end; begin if (FItems.Count > 0) then QuickSortPointerList(FItems.List, 0, FItems.Count - 1, @CompareItems); end; function TSCSInterfaces.GetItem(Index: Integer): TSCSInterface; begin Result := TSCSInterface(FItems.Items[index]); end; procedure TSCSInterfaces.SetItem(Index: Integer; ASCSInterface: TSCSInterface); begin FItems.Items[index] := TObject(ASCSInterface); end; {TSCSLists} function TSCSLists.Add(ASCSList: TSCSList): Integer; begin Result := FItems.Add(TObject(ASCSList)); end; function TSCSLists.Remove(ASCSList: TSCSList): Integer; begin Result := FItems.Remove(TObject(ASCSList)); end; procedure TSCSLists.Insert(Index: Integer; ASCSList: TSCSList); begin FItems.Insert(Index, TObject(ASCSList)); end; function TSCSLists.GetItem(Index: Integer): TSCSList; begin Result := TSCSList(FItems.Items[index]); end; procedure TSCSLists.SetItem(Index: Integer; ASCSList: TSCSList); begin FItems.Items[index] := TObject(ASCSList); end; {TSCSNorms} function TSCSNorms.Add(ASCSNorm: TSCSNorm): Integer; begin Result := FItems.Add(TObject(ASCSNorm)); end; function TSCSNorms.GetNormByID(AID: Integer): TSCSNorm; var i: Integer; SCSNorm: TSCSNorm; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSNorm := TSCSNorm(FItems[i]); if SCSNorm.ID = AID then begin Result := SCSNorm; Break; ///// BREAK ///// end; end; end; function TSCSNorms.GetNormByGuidNB(AGUID: String; ATakeNormFromUser: Boolean): TSCSNorm; var i: Integer; SCSNorm: TSCSNorm; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSNorm := TSCSNorm(FItems[i]); if (SCSNorm.GuidNB = AGUID) and ((SCSNorm.IsFromInterface = biTrue) or (ATakeNormFromUser = True)) then begin Result := SCSNorm; Break; ///// BREAK ///// end; end; end; function TSCSNorms.Remove(ASCSNorm: TSCSNorm): Integer; begin Result := FItems.Remove(TObject(ASCSNorm)); end; procedure TSCSNorms.Insert(Index: Integer; ASCSNorm: TSCSNorm); begin FItems.Insert(Index, TObject(ASCSNorm)); end; function TSCSNorms.GetItem(Index: Integer): TSCSNorm; begin Result := TSCSNorm(FItems.Items[index]); end; procedure TSCSNorms.SetItem(Index: Integer; ASCSNorm: TSCSNorm); begin FItems.Items[index] := TObject(ASCSNorm); end; {TSCSResources} function TSCSResources.Add(ASCSResourceRel: TSCSResourceRel): Integer; begin Result := FItems.Add(TObject(ASCSResourceRel)); end; function TSCSResources.GetResourceByID(AID: Integer): TSCSResourceRel; var i: Integer; SCSResourceRel: TSCSResourceRel; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSResourceRel := TSCSResourceRel(FItems[i]); if SCSResourceRel.ID = AID then begin Result := SCSResourceRel; Break; ///// BREAK ///// end; end; end; function TSCSResources.GetResourceByIDResource(AIDREsource: Integer): TSCSResourceRel; var i: Integer; SCSResourceRel: TSCSResourceRel; begin Result := nil; for i := 0 to FItems.Count - 1 do begin SCSResourceRel := TSCSResourceRel(FItems[i]); if SCSResourceRel.IDResource = AIDREsource then begin Result := SCSResourceRel; Break; ///// BREAK ///// end; end; end; function TSCSResources.Remove(ASCSResourceRel: TSCSResourceRel): Integer; begin Result := FItems.Remove(TObject(ASCSResourceRel)); end; procedure TSCSResources.Insert(Index: Integer; ASCSResourceRel: TSCSResourceRel); begin FItems.Insert(Index, TObject(ASCSResourceRel)); end; function TSCSResources.GetItem(Index: Integer): TSCSResourceRel; begin Result := TSCSResourceRel(FItems.Items[index]); end; procedure TSCSResources.SetItem(Index: Integer; ASCSResourceRel: TSCSResourceRel); begin FItems.Items[index] := TObject(ASCSResourceRel); end; {TCatalogInfo} function TCatalogInfo.AddComponID(AID: Integer): Integer; begin Result := -1; SetLength(ComponIDs, Length(ComponIDs)+1); ComponIDs[Length(ComponIDs)-1] := AID; Result := High(ComponIDs); end; procedure TCatalogInfo.DelComponID(AIndex: Integer); var HighIndex: Integer; begin HighIndex := High(ComponIDs); if AIndex <= HighIndex then begin if AIndex < HighIndex then Move(ComponIDs[AIndex+1], ComponIDs[AIndex], (HighIndex - AIndex)*SizeOf(ComponIDs[AIndex])); SetLength(ComponIDs, HighIndex); // или Length(ComponIDs) - 1 end; end; function TCatalogInfo.ComponCount: Integer; begin Result := Length(ComponIDs); end; constructor TCatalogInfo.Create; begin inherited; SetLength(ComponIDs, 0); //Tolik FID := 0; FParentID := 0; end; destructor TCatalogInfo.Destroy; begin SetLength(ComponIDs, 0); inherited; //Tolik end; function TCatalogInfo.IndexOfComponID(AID: Integer): Integer; var I: integer; begin Result := -1; for i := 0 to ComponCount - 1 do if ComponIDs[i] = AID then begin Result := i; Break; //// BREAK //// end; end; function TCatalogInfo.RemoveComponID(AID: Integer): Integer; var ComponIndex: Integer; begin Result := -1; ComponIndex := IndexOfComponID(AID); if ComponIndex <> -1 then begin DelComponID(ComponIndex); Result := ComponIndex; end; end; {TBasicSCSClass} procedure TSCSNormResBasicClass.SetActiveForm(Value: TForm); begin inherited ; MasterTableKind := FMasterTableKind; end; procedure TSCSNormResBasicClass.SetMasterTableKind(Value: Integer); begin FMasterTableKind := Value; FMasterField := GetMasterFieldName(FMasterTableKind); end; function TSCSNormResBasicClass.GetMasterFieldName(AMasterTableKind: Integer): String; begin Result := fnIDMaster; if TF_Main(FActiveForm).GDBMode = bkNormBase then case AMasterTableKind of ctkComponent: Result := fnIDComponent; ctkNorm: Result := fnIDNorm; end; end; constructor TSCSNormsResources.Create(AFormOwner: TForm; AMasterTableKind: Integer); begin inherited Create(AFormOwner); MasterTableKind := AMasterTableKind; FNorms := TSCSNorms.Create(true); FResources := TSCSResources.Create(true); Clear; end; destructor TSCSNormsResources.Destroy; begin Clear; FreeAndNil(FNorms); FreeAndNil(FResources); inherited end; procedure TSCSNormsResources.Assign(ASCSNormsResources: TSCSNormsResources; AFromNew: Boolean = false); begin if Not Assigned(ASCSNormsResources) then Exit; ///// EXIT ///// AssignOnlyNormsResources(ASCSNormsResources); AssignNorms(ASCSNormsResources.Norms, AFromNew); AssignResources(ASCSNormsResources.Resources, AFromNew); end; procedure TSCSNormsResources.AssignOnlyNormsResources(ANormsResources: TSCSNormsResources); begin if Not Assigned(ANormsResources) then Exit; ///// EXIT ///// ResourcesCost := ANormsResources.ResourcesCost; ResourcesCostPerOneNorm := ANormsResources.ResourcesCostPerOneNorm; TotalCost := ANormsResources.TotalCost; Length := ANormsResources.Length; end; procedure TSCSNormsResources.AssignNorms(ASCSNorms: TSCSNorms; AFromNew: Boolean = false); var i: Integer; NewNorm: TSCSNorm; begin if Not Assigned(ASCSNorms) then Exit; ///// EXIT ///// FNorms.Clear; for i := 0 to ASCSNorms.Count - 1 do begin NewNorm := TSCSNorm.Create(ActiveForm, ntProj); NewNorm.MasterTableKind := MasterTableKind; NewNorm.IDMaster := IDMaster; NewNorm.Assign(ASCSNorms[i], AFromNew); FNorms.Add(NewNorm); end; end; procedure TSCSNormsResources.AssignResources(ASCSResources: TSCSResources; AFromNew: Boolean = false); var i: Integer; ResourceRel: TSCSResourceRel; begin if Not Assigned(ASCSResources) then Exit; ///// EXIT ///// FResources.Clear; for i := 0 to ASCSResources.Count - 1 do begin ResourceRel := TSCSResourceRel.Create(ActiveForm, ntProj); ResourceRel.IDMaster := IDMaster; ResourceRel.MasterTableKind := FMasterTableKind; ResourceRel.Assign(ASCSResources[i], AFromNew); FResources.Add(ResourceRel); end; end; procedure TSCSNormsResources.Clear; begin FNorms.Clear; FResources.Clear; end; procedure TSCSNormsResources.SetActiveForm(Value: TForm); var i: Integer; begin inherited; //TBasicSCSClass(Self).ActiveForm := Value; if Assigned(Norms) then for i := 0 to Norms.Count - 1 do TSCSNorm(Norms[i]).ActiveForm := Value; if Assigned(Resources) then for i := 0 to Resources.Count - 1 do TSCSResourceRel(Resources[i]).ActiveForm := Value; end; procedure TSCSNormsResources.LoadNorms(ALoadNormResources, AComponResourcePriceCalc: Boolean); var i, IDNorm: Integer; Norm: TSCSNorm; IDNormList: TIntList; strLength, strFilter: String; begin IDNormList := TIntList.Create; try try //DefineQuery; //ClearListWithObjects(Norms); FNorms.Clear; //strFilter := '(id_master = '''+IntToStr(IDMaster)+''') and (table_kind = '''+IntToStr(FMasterTableKind)+''')'; strFilter := '('+FMasterField+' = '''+IntToStr(IDMaster)+''') and (table_kind = '''+IntToStr(FMasterTableKind)+''')'; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, ' select id from Norms where '+strFilter+' order by npp ASC '); IntFIBFieldToIntList(IDNormList, FQSelect, fnID); //TF_Main(ActiveForm).DM.IntFIBFieldToList(IDNormList, FQSelect, fnID); FQSelect.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin {SetFilterToSQLMemTable(tSQL_Norms, strFilter); tSQL_Norms.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Norms, fnNpp); TF_Main(ActiveForm).DM.IntFieldToListFromSQLMemTable(IDNormList, tSQL_Norms, fnID); tSQL_Norms.IndexName := '';} end; end; for i := 0 to IDNormList.Count - 1 do begin IDNorm := IDNormList[i]; Norm := TSCSNorm.Create(ActiveForm, ntProj); Norm.LoadNorm(IDNorm, ALoadNormResources); Norms.Add(Norm); end; except on E: Exception do AddExceptionToLog('TSCSNormsResources.LoadNorms: '+E.Message); end; finally FreeAndNil(IDNormList); end; end; procedure TSCSNormsResources.Refesh; begin LoadNorms(true, true); end; procedure TSCSNormsResources.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); var i: Integer; SCSNorm: TSCSNorm; ResourceRel: TSCSResourceRel; begin for i := 0 to FResources.Count - 1 do begin ResourceRel := FResources[i]; if Assigned(ResourceRel) then ResourceRel.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; for i := 0 to FNorms.Count - 1 do begin SCSNorm := FNorms[i]; if Assigned(SCSNorm) then SCSNorm.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; end; procedure TSCSNormsResources.SaveNorms(AMakeEdit: TMakeEdit; AIDNewMaster: Integer); var i: integer; Norm: TSCSNorm; begin try for i := 0 to Norms.Count - 1 do begin Norm := Norms[i]; Norm.ActiveForm := ActiveForm; case AMakeEdit of meMake: Norm.SaveNormAsNew(AIDNewMaster); meEdit: Norm.UpdateNorm; end; end; except on E: Exception do AddExceptionToLog('TSCSNormsResources.SaveNorm: '+E.Message); end; end; procedure TSCSNormsResources.SaveResources(AMakeEdit: TMakeEdit; AIDNewMaster: Integer); var i: integer; ResourceRel: TSCSResourceRel; begin try for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; ResourceRel.ActiveForm := ActiveForm; case AMakeEdit of meMake: ResourceRel.SaveResourceAsNew(AIDNewMaster); meEdit: ResourceRel.UpdateResource; end; end; except on E: Exception do AddExceptionToLog('TSCSNormsResources.SaveResources: '+E.Message); end; end; procedure TSCSNormsResources.SaveNormsAsNew(AIDNewMaster: Integer); begin SaveNorms(meMake, AIDNewMaster); end; procedure TSCSNormsResources.UpdateNorms; begin SaveNorms(meEdit, -1); end; procedure TSCSNormsResources.SaveResourcesAsNew(AIDNewMaster: Integer); begin SaveResources(meMake, AIDNewMaster); end; procedure TSCSNormsResources.UpdateResources; begin SaveResources(meEdit, -1); end; procedure TSCSNormsResources.LoadResources(ACalcCost: Boolean); var ResourceRel: TSCSResourceRel; i: Integer; IDList: TIntList; strFilter: String; begin try //DefineQuery; //ClearListWithObjects(Resources); FResources.Clear; //strFilter := '(id_master = '''+IntToStr(IDMaster)+''') and (table_kind = '''+IntTostr(FMasterTableKind)+''')'; strFilter := '('+FMasterField+' = '''+IntToStr(IDMaster)+''') and (table_kind = '''+IntTostr(FMasterTableKind)+''')'; IDList := TIntList.Create; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, ' select id from norm_resource_rel where '+strFilter+ ' order by norm_resource_rel.npp '); IntFIBFieldToIntList(IDList, FQSelect, fnID); FQSelect.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin {SetFilterToSQLMemTable(tSQL_NormResourceRel, strFilter); tSQL_NormResourceRel.IndexName := GetIndexByFldFomSQLMemTable(tSQL_NormResourceRel, fnNpp); TF_Main(ActiveForm).DM.IntFieldToListFromSQLMemTable(IDList, tSQL_NormResourceRel, fnID); tSQL_NormResourceRel.IndexName := '';} end; end; for i := 0 to IDList.Count - 1 do begin ResourceRel := TSCSResourceRel.Create(ActiveForm, ntProj); ResourceRel.ID := IDList[i]; Resources.Add(ResourceRel); ResourceRel.MasterTableKind := FMasterTableKind; ResourceRel.LoadResourceByID(ResourceRel.ID); //if i = 0 then // if Length > 0 then // ResourceRel.Kolvo := Length; if ACalcCost then ResourceRel.CalcCost; end; FreeAndNil(IDList); except on E: Exception do AddExceptionToLog('TSCSNormsResources.LoadResources;: '+E.Message); end; end; procedure TSCSNormsResources.SaveResourcesByServiceFields(ANewMasterID: Integer); var ResourceRel: TSCSResourceRel; i: Integer; begin try for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; ResourceRel.SaveByServiceFields(ANewMasterID); end; except on E: Exception do AddExceptionToLog('TSCSNormsResources.SaveResourcesByServiceFields: '+E.Message); end; end; procedure TSCSNormsResources.SaveByServiceFields(ANewMasterID: Integer); var SCSNorm: TSCSNorm; ResourceRel: TSCSResourceRel; i: Integer; begin try //*** Сохранение норм for i := 0 to Norms.Count - 1 do begin SCSNorm := Norms[i]; SCSNorm.SaveByServiceFields(ANewMasterID); end; //*** Сохранение ресурсов for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; ResourceRel.SaveByServiceFields(ANewMasterID); end; except on E: Exception do AddExceptionToLog('TSCSNormsResources.SaveByServiceFields: '+E.Message); end; end; function TSCSNormsResources.CalcResourcesCost(ACalcNormTotalCost, ACalcNormCost: Boolean): Double; var CurrResourceCost: Double; i: Integer; SCSNorm: TSCSNorm; ResourceRel: TSCSResourceRel; begin Result := 0; try CurrResourceCost := 0; ResourcesCostPerOneNorm := 0; //GetPriceComponWithComplects; //CurrWorkCost := CurrWorkCost + PriceComponWithComplects; if FQueryMode = qmPhisical then begin if Norms.Count = 0 then LoadNorms(true, true); if Resources.Count = 0 then LoadResources(true); end; for i := 0 to Norms.Count - 1 do begin SCSNorm := Norms.Items[i]; //if Length > 0 then // SCSNorm.Kolvo := Length; if SCSNorm.IsOn = biTrue then begin {if (ACalcNormTotalCost) then if i = 0 then SCSNorm.CalcTotalCost(false) else SCSNorm.CalcTotalCost(ACalcNormCost); } if (ACalcNormTotalCost) then SCSNorm.CalcTotalCost(ACalcNormCost); ResourcesCostPerOneNorm := ResourcesCostPerOneNorm + SCSNorm.Cost; CurrResourceCost := CurrResourceCost + SCSNorm.TotalCost; end; end; for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; //if i = 0 then // if Length > 0 then // ResourceRel.Kolvo := Length; if ACalcNormTotalCost then ResourceRel.CalcCost; ResourcesCostPerOneNorm := ResourcesCostPerOneNorm + ResourceRel.Price; CurrResourceCost := CurrResourceCost + ResourceRel.Cost; end; ResourcesCost := CurrResourceCost; TotalCost := CurrResourceCost {+ PriceComponWithComplects}; Result := CurrResourceCost; except on E: Exception do AddExceptionToLog('TSCSNormsResources.CalcWorkCost: '+E.Message); end; end; { TSCSComponCatalogClass } procedure TSCSComponCatalogClass.AddPropertyValueAsFloat(const ASysName: String; AValue: Double; aAllowDefine: Boolean=false); var Prop: PProperty; begin Prop := Self.GetPropertyBySysName(ASysName); if (Prop = nil) then begin if aAllowDefine then Prop := Self.AddProperty(FID, 0, '', dtFloat, biFalse, biFalse, biFalse, FloatToStrU(AValue), '', ASysName); end else SetPropertyValueAsString(Prop, FloatToStrU(Self.PropStrToFloat(Prop.Value) + AValue)); end; function TSCSComponCatalogClass.AddSimpleProperty(const ASysName, AName, AValue: String; AIDDataType: Integer): PProperty; begin Result := Self.GetPropertyBySysName(ASysName); if (Result = nil) then begin Result := Self.AddProperty(FID, 0, '', AIDDataType, biFalse, biFalse, biFalse, AValue, AName, ASysName); end else SetPropertyValueAsString(Result, AValue); end; procedure TSCSComponCatalogClass.AssignProperties(AProperties: TList; AFromNew: Boolean = false); var ptrProperty: PProperty; i: integer; begin if Not Assigned(AProperties) then Exit; ///// EXIT ///// ClearAndDisposeList(FProperties); //16.10.2007 ClearList(FProperties); for i := 0 to AProperties.Count - 1 do begin //16.10.2007 GetMem(ptrProperty, SizeOf(TProperty)); New(ptrProperty); ZeroMemory(ptrProperty, SizeOf(TProperty)); ptrProperty^ := TProperty(AProperties[i]^); if AFromNew then ptrProperty.ID := ptrProperty.NewID; FProperties.Add(ptrProperty); end; end; function TSCSComponCatalogClass.AssignedPropertyBySysName(const ASysName: String): Boolean; var i: Integer; ptrProperty: PProperty; begin Result := false; for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if ptrProperty.SysName = ASysName then begin Result := true; Break; ///// BREAK ///// end; end; end; procedure TSCSComponCatalogClass.Clear; begin //31.01.2011 ClearAndDisposeList(FProperties); //16.10.2007 ClearList(FProperties); ClearElements; PropsCount := -1; NormsCount := -1; ResourcesCount := -1; FProjectOwner := nil; end; procedure TSCSComponCatalogClass.ClearElements; begin ClearAndDisposeList(FProperties); //16.10.2007 ClearList(FProperties); NormsResources.Clear; end; constructor TSCSComponCatalogClass.Create(AForm: TForm; ASCSTreeElementType: TSCSTreeElementType); begin inherited Create(AForm); FProjectOwner := nil; FTreeElementType := ASCSTreeElementType; DefineParams; FProperties := TList.Create; FNormsResources := TSCSNormsResources.Create(ActiveForm, GetTableKindBySCSTreeElType(ASCSTreeElementType)); //07.11.2013 FNormsResources.FOwner := Self; Clear; end; procedure TSCSComponCatalogClass.SetFID(Value: Integer); begin FID := Value; FNormsResources.IDMaster := FID; end; function TSCSComponCatalogClass.AddProperty(AMasterID, AIDProperty: Integer; const AGUIDProperty: String; AIDDataType, ATakeIntoConnect, ATakeIntoJoin, AIsDefault: Integer; const AValue, AName, ASysName: String): PProperty; var ptrProperty: PProperty; begin New(ptrProperty); //16.10.2007 GetZeroMem(ptrProperty, SizeOf(TProperty)); ZeroMemory(ptrProperty, SizeOf(TProperty)); ptrProperty.IDMaster := AMasterID; ptrProperty.ID_Property := AIDProperty; ptrProperty.GUIDProperty := AGUIDProperty; ptrProperty.TakeIntoConnect := ATakeIntoConnect; ptrProperty.TakeIntoJoin := ATakeIntoJoin; ptrProperty.IsDefault := AIsDefault; ptrProperty.Value := AValue; ptrProperty.Name_ := AName; ptrProperty.SysName := ASysName; ptrProperty.IDDataType := AIDDataType; FProperties.Add(ptrProperty); SaveProperty(meMake, ptrProperty); Result := ptrProperty; end; procedure TSCSComponCatalogClass.DefineParams; begin FGeneratorIndex := 0; FPropertyTableName := ''; FPropertyMemTable := nil; FMasterFieldName := ''; if Assigned(FActiveForm) then case FTreeElementType of teCatalog: begin FGeneratorIndex := giCatalogPropRelationID; FPropertyTableName := tnCatalogPropRelation; if Assigned(TF_Main(FActiveForm).DM) then FPropertyMemTable := TF_Main(FActiveForm).DM.tSQL_CatalogPropRelation; FMasterFieldName := fnIDCatalog; end; teComponent: begin FGeneratorIndex := giCompPropRelationID; FPropertyTableName := tnCompPropRelation; if Assigned(TF_Main(FActiveForm).DM) then FPropertyMemTable := TF_Main(FActiveForm).DM.tSQL_CompPropRelation; FMasterFieldName := fnIDComponent; end; end; end; procedure TSCSComponCatalogClass.SaveProperty(AMakeEdit: TMakeEdit; AProperty: PProperty); var i: Integer; //Propert: PProperty; FieldNames: TStringList; begin try if AProperty <> nil then case FQueryMode of qmPhisical: begin FieldNames := TStringList.Create; try FieldNames.Add(FMasterFieldName); FieldNames.Add(fnIDProperty); FieldNames.Add(fnPValue); FieldNames.Add(fnIsDefault); if FTreeElementType = teComponent then begin FieldNames.Add(fnTakeIntoConnect); FieldNames.Add(fnTakeIntoJoin); FieldNames.Add(fnIsTakeJoinForPoints); FieldNames.Add(fnIsCrossControl); FieldNames.Add(fnIDCrossProperty); end; case AMakeEdit of meMake: SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, FPropertyTableName, '', FieldNames, ''), false); //SQLBuilder(FQuery_Operat, qtInsert, FPropertyTableName, '', FieldNames, false); meEdit: begin //SQLBuilder(FQuery_Operat, qtUpdate, FPropertyTableName, 'id = :id', FieldNames, false); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, FPropertyTableName, 'id = :id', FieldNames, ''), false); FQOperat.ParamByName(fnID).AsInteger := AProperty.ID; end; end; FQOperat.ParamByName(FMasterFieldName).AsInteger := AProperty.IDMaster; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDProperty, AProperty.ID_Property); FQOperat.ParamByName(fnPValue).AsString := AProperty.Value; FQOperat.ParamByName(fnIsDefault).AsInteger := AProperty.IsDefault; if FTreeElementType = teComponent then begin FQOperat.ParamByName(fnTakeIntoConnect).AsInteger := AProperty.TakeIntoConnect; FQOperat.ParamByName(fnTakeIntoJoin).AsInteger := AProperty.TakeIntoJoin; FQOperat.ParamByName(fnIsTakeJoinForPoints).AsInteger := AProperty.IsTakeJoinforPoint; FQOperat.ParamByName(fnIsCrossControl).AsInteger := AProperty.IsCrossControl; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCrossProperty, AProperty.IDCrossProperty); end; FQOperat.ExecQuery; if AMakeEdit = meMake then begin AProperty.NewID := 0; case FTreeElementType of teComponent: AProperty.NewID := GenIDFromTable(TF_Main(FActiveForm).DM.Query_Operat, gnCompPropRelationID, 0); teCatalog: AProperty.NewID := GenIDFromTable(TF_Main(FActiveForm).DM.Query_Operat, gnCatalogPropRelationID, 0); end; AProperty.ID := AProperty.NewID; end; //FQuery_Select.Close; //FQuery_Select.ExecQuery; //Propert.NewID := FQuery_Select.GetFNAsInteger(fnMax); //Propert.ID := Propert.NewID; //FQuery_Operat.Close; finally FieldNames.Free; end; end; qmMemory: with TF_Main(ActiveForm).DM do begin if AMakeEdit = meMake then begin AProperty.NewID := GenCurrProjTableID(FGeneratorIndex); //FPropertyMemTable.FieldByName(fnID).AsInteger; AProperty.ID := AProperty.NewID; end; {<#MemTableClear#> case AMakeEdit of meMake: FPropertyMemTable.Append; meEdit: begin FPropertyMemTable.Filtered := false; if FPropertyMemTable.Locate(fnID, AProperty.ID, []) then FPropertyMemTable.Edit; end; end; if FPropertyMemTable.State <> dsBrowse then begin FPropertyMemTable.FieldByName(FMasterFieldName).AsInteger := AProperty.IDMaster; FPropertyMemTable.FieldByName(fnIDProperty).AsInteger := AProperty.ID_Property; //if (Propert.SysName = pnHeight) and (CoordZ > 0) then // tSQL_CompPropRelation.FieldByName('PValue').AsString := FloatToStr(CoordZ) //else FPropertyMemTable.FieldByName(fnPValue).AsString := AProperty.Value; FPropertyMemTable.FieldByName(fnIsDefault).AsInteger := AProperty.IsDefault; FPropertyMemTable.FieldByName(fnGUIDProperty).AsString := AProperty.GUIDProperty; if FTreeElementType = teComponent then begin FPropertyMemTable.FieldByName(fnTakeIntoConnect).AsInteger := AProperty.TakeIntoConnect; FPropertyMemTable.FieldByName(fnTakeIntoJoin).AsInteger := AProperty.TakeIntoJoin; end; FPropertyMemTable.Post; if AMakeEdit = meMake then begin AProperty.NewID := FPropertyMemTable.FieldByName(fnID).AsInteger; AProperty.ID := AProperty.NewID; end; end;} end; end; except on E: Exception do AddExceptionToLog('TSCSComponCatalogClass.SaveProperty: '+E.Message); end; end; destructor TSCSComponCatalogClass.Destroy; begin Clear; FreeAndNil(FProperties); FreeAndNil(FNormsResources); inherited; end; function TSCSComponCatalogClass.GetPropertyAsNew: PProperty; var ptrProperty: PProperty; begin Result := nil; New(ptrProperty); //16.10.2007 GetZeroMem(ptrProperty, SizeOf(TProperty)); ZeroMemory(ptrProperty, SizeOf(TProperty)); if FQueryMode = qmMemory then ptrProperty.ID := GenCurrProjTableID(FGeneratorIndex); ptrProperty.IsNew := false; ptrProperty.IsModified := false; Properties.Add(ptrProperty); Result := ptrProperty; end; function TSCSComponCatalogClass.GetPropertyByID(AIDPropRel: Integer): PProperty; var i: Integer; begin Result := nil; for i := 0 to Properties.Count - 1 do if Properties[i] <> nil then if PProperty(Properties[i]).ID = AIDPropRel then Result := PProperty(Properties[i]); end; function TSCSComponCatalogClass.GetPropertyByGUIDProperty(const AGUIDProperty: String): PProperty; var i: Integer; ptrProperty: PProperty; begin Result := nil; for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if ptrProperty.GUIDProperty = AGUIDProperty then begin Result := ptrProperty; Break; ///// BREAK ///// end; end; end; function TSCSComponCatalogClass.GetPropertyByIDProperty(AIDProperty: Integer): PProperty; var i: Integer; ptrProperty: PProperty; begin Result := nil; for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if ptrProperty.ID_Property = AIDProperty then begin Result := ptrProperty; Break; ///// BREAK ///// end; end; end; function TSCSComponCatalogClass.GetPropertyBySysName(const ASysName: String): PProperty; var i: Integer; ptrProperty: PProperty; SysNameUpper: String; begin Result := nil; SysNameUpper := UpperCase(ASysName); for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if UpperCase(ptrProperty.SysName) = SysNameUpper then begin Result := ptrProperty; Break; ///// BREAK ///// end; end; end; function TSCSComponCatalogClass.GetPropertyValueBySysName(const ASysName: String): String; var ptrProperty: PProperty; i: Integer; SysNameUpper: String; begin try Result := ''; //if Properties.Count = 0 then // LoadProperties; SysNameUpper := UpperCase(ASysName); for i := 0 to Properties.Count - 1 do begin ptrProperty := Properties.Items[i]; if UpperCase(ptrProperty.SysName) = SysNameUpper then begin Result := ptrProperty.Value; Break; ///// BREAK ///// end; end; //*** Тип условного обозначения не найден, то значит компонент проектируемый if Result = '' then begin if ASysName = pnSignType then Result := IntToStr(oitDefault); {$IF Defined(TUBE)} if ASysName = pnAngle then Result := '90'; {$IFEND} end; except on E: Exception do AddExceptionToLog('TSCSComponent.GetPropertyValueBySysName: '+E.Message); end; end; function TSCSComponCatalogClass.GetPropertyValueAsBooleanDef(const ASysName: String; ADef: Boolean): Boolean; var ResStr: String; begin Result := ADef; ResStr := GetPropertyValueBySysName(ASysName); if ResStr <> '' then if ResStr = bssTrue then Result := true else if ResStr = bssFalse then Result := false; end; function TSCSComponCatalogClass.GetPropertyValueAsInteger(const ASysName: String): Integer; var ResStr: String; begin Result := 0; ResStr := GetPropertyValueBySysName(ASysName); if ResStr <> '' then Result := StrToInt(ResStr); end; function TSCSComponCatalogClass.GetPropertyValueAsFloat(const ASysName: String): Double; //var ResStr: String; begin //Result := 0; //ResStr := GetPropertyValueBySysName(ASysName); //if ResStr <> '' then // Result := StrToFloatU(CorrectStrToFloat(ResStr)); Result := Self.PropStrToFloat(GetPropertyValueBySysName(ASysName)); end; procedure TSCSComponCatalogClass.LoadProperties(AIDMaster: Integer); var Propert : PProperty; i: Integer; strFilter: String; PropertyData: TPropertyData; Spravochnik: TSpravochnik; NBProperty: TPropertyData; begin ClearAndDisposeList(Properties); //16.10.2007 ClearList(Properties); strFilter := FMasterFieldName+' = '''+IntToStr(AIDMaster)+''''; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, ' SELECT * FROM '+FPropertyTableName+' '+' WHERE '+ strFilter); with FQSelect do begin While Not Eof do begin New(Propert); //16.10.2007 GetZeroMem(Propert, SizeOf(TProperty)); TF_Main(ActiveForm).DM.LoadPropertyFromQuery(Propert, FQSelect, FTreeElementType); //08.04.2011 //ZeroMemory(Propert, SizeOf(TProperty)); //Propert.ID := FN(fnID).AsInteger; //Propert.IDMaster := FN(FMasterFieldName).AsInteger; //Propert.ID_Property := FN(fnIDProperty).AsInteger; //Propert.Value := FN(fnPValue).AsString; //Propert.IsDefault := FN(fnIsDefault).AsInteger; NBProperty := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetPropertyDataByID(Propert.ID_Property); if NBProperty.GUID <> '' then begin Propert.GUIDProperty := NBProperty.GUID; //22.09.2010 Propert.IDDataType = NBProperty.IDDataType; //22.09.2010 Propert.IsForWholeComponent := NBProperty.IsForWholeComponent; end; if Propert.GUIDProperty = '' then Propert.GUIDProperty := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, Propert.ID_Property, qmPhisical); if FTreeElementType = teComponent then begin //08.04.2011 //Propert.TakeIntoConnect := FN(fnTakeIntoConnect).AsInteger; //Propert.TakeIntoJoin := FN(fnTakeIntoJoin).AsInteger; //Propert.IsTakeJoinforPoint := FN(fnIsTakeJoinForPoints).AsInteger; //Propert.IsCrossControl := FN(fnIsCrossControl).AsInteger; //Propert.IDCrossProperty := FN(fnIDCrossProperty).AsInteger; if Propert.IDCrossProperty <> 0 then begin NBProperty := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetPropertyDataByID(Propert.IDCrossProperty); if NBProperty.GUID <> '' then Propert.GUIDCrossProperty := NBProperty.GUID; if Propert.GUIDCrossProperty = '' then Propert.GUIDCrossProperty := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, Propert.IDCrossProperty, qmPhisical); end; end; Propert.IsNew := false; Propert.IsModified := false; Properties.Add(Propert); Next; end; Close; if F_NormBase.DM.Transac_TSCSSelect.Active = false then F_NormBase.DM.Transac_TSCSSelect.Active := true; end; end; qmMemory: with TF_Main(ActiveForm).DM do begin (* if SetFilterToSQLMemTable(FPropertyMemTable, strFilter) then begin FPropertyMemTable.First; while Not FPropertyMemTable.Eof do begin { GetMem(Propert, SizeOf(TProperty)); Propert.ID := tSQL_CompPropRelation.FieldByName('ID').AsInteger; Propert.IDComponent := tSQL_CompPropRelation.FieldByName(fnIDComponent).AsInteger; Propert.ID_Property := tSQL_CompPropRelation.FieldByName('ID_Property').AsInteger; Propert.TakeIntoConnect := tSQL_CompPropRelation.FieldByName('TAKE_INTO_CONNECT').AsInteger; Propert.TakeIntoJoin := tSQL_CompPropRelation.FieldByName('TAKE_INTO_JOIN').AsInteger; Propert.Value := tSQL_CompPropRelation.FieldByName('PValue').AsString; Propert.IsDefault := tSQL_CompPropRelation.FieldByName(fnIsDefault).AsInteger; } Propert := nil; case FTreeElementType of teComponent: Propert := GetComponPropertyFromMemTable(true); teCatalog: Propert := GetCatalogPropertyFromMemTable(true); end; if Propert <> nil then Properties.Add(Propert); FPropertyMemTable.Next; end; end; *) end; end; Spravochnik := nil; if FProjectOwner <> nil then Spravochnik := FProjectOwner.Spravochnik; for i := 0 to Properties.Count - 1 do begin Propert := Properties.Items[i]; //PropertyData := TF_Main(FActiveForm).FNormBase.GSCSBase.NBSpravochnik.GetPropertyDataByID(Propert.ID_Property); PropertyData := TF_Main(FActiveForm).DM.GetPropertyData(Propert.ID_Property, Propert.GUIDProperty, Spravochnik); Propert.Name_ := PropertyData.Name; Propert.SysName := PropertyData.SysName; Propert.IDDataType := PropertyData.IDDataType; //22.09.2010 end; end; procedure TSCSComponCatalogClass.MulPropertyValueAsFloat(const ASysName: String; AValue: Double); begin Self.SetPropertyValueAsFloat(ASysName, GetPropertyValueAsFloat(ASysName) * AValue); end; function TSCSComponCatalogClass.PropStrToFloat(const AVal: string): Double; begin Result := 0; if AVal <> '' then Result := StrToFloatU(CorrectStrToFloat(AVal)); end; function TSCSComponCatalogClass.RemoveProperty(AIDPropRel: Integer): Boolean; var i: Integer; ptrProperty: PProperty; begin Result := false; for i := 0 to FProperties.Count - 1 do if PProperty(FProperties[i]).ID = AIDPropRel then begin //FreeMem(FProperties[i]); Dispose(FProperties[i]); FProperties.Delete(i); Result := true; Break; ///// BREAK //// end; end; function TSCSComponCatalogClass.RemoveProperty(AProp: PProperty): Boolean; begin Result := false; if FProperties.Remove(AProp) <> -1 then begin Dispose(AProp); Result := true; end; end; function TSCSComponCatalogClass.RemovePropertyByID(AIDPropRel: Integer): Integer; var ptrProperty: PProperty; begin Result := -1; ptrProperty := GetPropertyByID(AIDPropRel); if ptrProperty <> nil then Result := FProperties.Remove(ptrProperty); end; function TSCSComponCatalogClass.RemovePropertyBySysName(const ASysName: String): Boolean; var Prop: PProperty; begin Result := false; Prop := GetPropertyBySysName(ASysName); if Prop <> nil then Result := RemoveProperty(Prop); //RemoveProperty(Prop.ID); end; procedure TSCSComponCatalogClass.SaveProperties(AIDMaster: Integer); var i: Integer; Propert: PProperty; begin try for i:= 0 to Properties.Count - 1 do begin Propert := Properties.Items[i]; Propert.IDMaster := AIDMaster; SaveProperty(meMake, Propert); end; except on E: Exception do AddExceptionToLog('TSCSComponCatalogClass.SaveProperties: '+E.Message); end; end; procedure TSCSComponCatalogClass.SavePropertiesByServFields(AIDMaster: Integer); var i: Integer; ptrProperty: PProperty; begin for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if ptrProperty.IsNew then begin ptrProperty.IDMaster := AIDMaster; SaveProperty(meMake, ptrProperty); end else if ptrProperty.IsModified then begin ptrProperty.IDMaster := AIDMaster; SaveProperty(meEdit, ptrProperty); end; end; end; procedure TSCSComponCatalogClass.SetActiveForm(Value: TForm); begin inherited SetActiveForm(Value); DefineParams; FNormsResources.ActiveForm := Value; //03.12.2013 end; procedure TSCSComponCatalogClass.SetPropertyValueAsBoolean(const ASysName: String; AValue: Boolean); var strValue: String; begin strValue := ''; if AValue then strValue := bssTrue else strValue := bssFalse; SetPropertyValueAsString(ASysName, strValue, true); end; procedure TSCSComponCatalogClass.SetPropertyValueAsFloat(const ASysName: String; AValue: Double; AUpdateInBase: Boolean=false); var strValue: String; begin strValue := FloatToStrU(AValue); SetPropertyValueAsString(ASysName, strValue, AUpdateInBase); end; procedure TSCSComponCatalogClass.SetPropertyValueAsString(const ASysName, AValue: String; AUpdateInBase: Boolean=false); var i: Integer; ptrProperty: PProperty; //IsNewValue: Boolean; begin for i := 0 to FProperties.Count - 1 do begin ptrProperty := FProperties[i]; if ptrProperty <> nil then if ptrProperty.SysName = ASysName then begin SetPropertyValueAsString(ptrProperty, AValue); if AUpdateInBase then if TF_Main(FActiveForm).GDBMode = bkNormBase then TF_Main(FActiveForm).DM.UpdateStrTableFieldByID(FPropertyTableName, fnPValue, PProperty(Properties[i]).ID, AValue, FQueryMode); { IsNewValue := (ptrProperty.Value <> AValue); ptrProperty.Value := AValue; //if AUpdateInBase then // TF_Main(FActiveForm).DM.UpdateStrTableFieldByID(FPropertyTableName, fnPValue, PProperty(Properties[i]).ID, AValue, FQueryMode); // Подгрузка аксессуаров, норм, .. if IsNewValue then if TF_Main(FActiveForm).GDBMode = bkProjectManager then if FTreeElementType = teComponent then if TSCSComponent(Self).UseKindInProj = ukUsual then begin DefineComponNormResByProperty(TSCSComponent(Self), ptrProperty); end; } end; end; end; procedure TSCSComponCatalogClass.SetPropertyValueAsString(AProperty: PProperty; const AValue: String); var IsNewValue: Boolean; begin IsNewValue := (AProperty.Value <> AValue); AProperty.Value := AValue; //if AUpdateInBase then // TF_Main(FActiveForm).DM.UpdateStrTableFieldByID(FPropertyTableName, fnPValue, PProperty(Properties[i]).ID, AValue, FQueryMode); // Подгрузка аксессуаров, норм, .. if IsNewValue then if TF_Main(FActiveForm).GDBMode = bkProjectManager then if FTreeElementType = teComponent then if TSCSComponent(Self).UseKindInProj = ukUsual then begin DefineComponNormResByProperty(TSCSComponent(Self), AProperty); end; end; // ####################### Класс TSCSComponent #################################### // ############################################################################# // ##### Конструктор ##### Constructor TSCSComponent.Create(AForm: TForm); Begin //FTableName := tnComponent; //FTableIndex := tiComponent; //Inc(GComponCounter); -- для посмотреть ... inherited Create(AForm, teComponent); //FTableName := tnComponent; //FTableIndex := tiComponent; //ActiveForm := AForm; FChildReferences := TSCSComponents.Create(false); FInterfaces := TSCSInterfaces.Create(true); FCableCanalConnector := TList.Create; FComplects := TList.Create; FChildComplects := TSCSComponents.Create(true); //22.08.2007 FAllSCSComplects := TSCSComponents.Create(false); FJoinedComponents := TSCSComponents.Create(false); //FProperties := TList.Create; //ComponIcons := TList.Create; FConnections := TList.Create; FCrossConnections := TSCSObjectlist.Create(true); //Norms := TList.Create; //07.11.2013 FNormsResources := TSCSNormsResources.Create(ActiveForm, ctkComponent); FTreeViewNode := nil; FNet := TList.Create; FWholeComponent := TIntList.Create; //Picture := TMemoryStream.Create; Description := TMemoryStream.Create; Picture := TMemoryStream.Create; //DefineQuery; Clear; //ActivateTransaction; //FQuery := (ActiveForm as TF_Main).DM.Query_TSCSCompon; //QueryOptionToSelect; end; destructor TSCSComponent.Destroy; var IndexInParent, i: Integer; currInterface: TSCSInterface; //f: TextFile; begin //Dec(GComponCounter); // Для пробы чтобы посмотреть try // Tolik -- 02/12/2020 -- for Test { AssignFile(f,'c:\Sompon_del_Ids.txt'); if FileExists('c:\Sompon_del_Ids.txt') then begin Append(f); end else rewrite(f); writeln(f, 'ID = ' + inttostr(Id) + ' List ID = '+ inttostr(ListID)); CloseFile(f); } // // Tolik -- 28/04/2017 -- { Self.DisJoinFromAll(true); for i := 0 to Self.Interfaces.count - 1 do begin currInterface := TSCsInterface(Self.Interfaces[i]); if currInterface.TypeI = itConstructive then begin Self.DisConnectFromParent; end; end; for i := 0 to ChildComplects.Count - 1 do } // // //if FProjectOwner.FSpravComponents.IndexOf(Self) <> -1 then //begin // EmptyProcedure; //end; if Assigned(FParent) then begin IndexInParent := -1; if FParent is TSCSCatalog then begin IndexInParent := TSCSCatalog(FParent).SCSComponents.IndexOf(Self); if IndexInParent <> -1 then TSCSCatalog(FParent).FSCSComponents.Remove(Self); //TSCSCatalog(FParent).SCSComponents[IndexInParent] := nil; end; if FParent is TSCSComponent then begin IndexInParent := TSCSComponent(FParent).ChildComplects.IndexOf(Self); if IndexInParent <> -1 then TSCSComponent(FParent).FChildComplects.Remove(Self); //TSCSComponent(FParent).ChildComplects[IndexInParent] := nil; end; end; Self.DisJoinFromAll(true).Free; // Tolik --19/02/2018 Parent := nil; Clear; FreeAndNil(Description); FreeAndNil(Picture); FreeAndNil(FChildReferences); // Tolik -- 20/02/2018 -- так херня... //FreeAndNil(FInterfaces); // делать нужно так, чтобы правильно освободить связи портов с интерфейсами for i := FInterfaces.Count - 1 downto 0 do begin currInterface := FInterfaces[i]; if currInterface.IsPort = biFalse then if currInterface.FPortOwner <> nil then begin FInterfaces.Remove(currInterface); currInterface.Free; end; end; FreeAndNil(FInterfaces); // FreeAndNil(FCableCanalConnector); FreeAndNil(FComplects); FreeAndNil(FCrossConnections); FreeAndNil(FChildComplects); //22.08.2007 FreeAndNil(FAllSCSComplects); FreeAndNil(FJoinedComponents); //FreeAndNil(FProperties); //if Assigned(Picture) then // FreeAndNil(Picture); //ComponIcons.Free; FreeAndNil(FConnections); //Norms.Free; //07.11.2013 FreeAndNil(FNormsResources); FreeAndNil(FNet); FreeAndNil(FWholeComponent); // Tolik 20/02/2018 -- //FInterfaces.Clear; // except end; inherited; //Destroy; end; function TSCSComponent.GetIsTop: Boolean; begin Result := false; if Assigned(FParent) then if FParent is TSCSCatalog then Result := true; end; procedure TSCSComponent.SetActiveForm(Value: TForm); var i: Integer; SCSComplect: TSCSComponent; Interf: TSCSInterface; begin //TBasicSCSClass(Self).ActiveForm := Value; inherited SetActiveForm(Value); //07.11.2013 if Assigned(NormsResources) then //07.11.2013 NormsResources.ActiveForm := Value; if Assigned(ChildComplects) then for i := 0 to ChildComplects.Count - 1 do begin SCSComplect := ChildComplects[i]; if Assigned(SCSComplect) then SCSComplect.ActiveForm := Value; end; if Assigned(FInterfaces) then for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; Interf.ActiveForm := Value; end; end; procedure TSCSComponent.SetFParent(Value: TBasicSCSClass); var i: Integer; ChildComponent: TSCSComponent; begin if Assigned(FParent) then begin if FParent is TSCSCatalog then begin for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; if Assigned(ChildComponent) then TSCSCatalog(FParent).RemoveComponentFromReferences(ChildComponent); end; TSCSCatalog(FParent).RemoveComponentFromReferences(Self); end; if FParent is TSCSComponent then begin for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; if Assigned(ChildComponent) then TSCSComponent(FParent).RemoveChildFromReferences(ChildComponent); end; TSCSComponent(FParent).RemoveChildFromReferences(Self); end; end; FParent := Value; if Assigned(FParent) then begin if FParent is TSCSCatalog then begin TSCSCatalog(FParent).AddComponentToReferences(Self); for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; if Assigned(ChildComponent) then TSCSCatalog(FParent).AddComponentToReferences(ChildComponent); end; end; if FParent is TSCSComponent then begin TSCSComponent(FParent).AddChildToReferences(Self); for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; if Assigned(ChildComponent) then TSCSComponent(FParent).AddChildToReferences(ChildComponent); end; end; end; end; procedure TSCSComponent.SetFTreeViewNode(Value: TTreeNode); begin if Assigned(Value) then begin if Value.Data <> nil then //if ((PObjectData(Value.Data).ItemType = itComponLine) and (isLine = biTrue)) or // ((PObjectData(Value.Data).ItemType = itComponCon) and (isLine = biFalse)) then if PObjectData(Value.Data).ObjectID = ID then if IsProperItemTypeToIsLine(PObjectData(Value.Data).ItemType, isLine) then FTreeViewNode := Value; end else FTreeViewNode := nil; end; procedure TSCSComponent.ClearChilds; var i: Integer; begin for i := 0 to ChildComplects.Count - 1 do begin TSCSComponent(ChildComplects[i]).Parent := nil; TSCSComponent(ChildComplects[i]).Free; ChildComplects[i] := nil; end; ChildComplects.Clear; end; // ##### Очистка Компоненты в List-ах ##### procedure TSCSComponent.Clear; begin inherited; //ClearList(Interfaces); //FreeAllSCSComplects; //FreeInterfaces; //31.01.2011 FInterfaces.Clear; //FreeNorms; //31.01.2011 NormsResources.Clear; //31.01.2011 ClearList(FComplects); //31.01.2011 ClearList(FCableCanalConnector); //ClearList(FProperties); //ClearList(ComponIcons); ClearElements; //31.01.2011 ClearList(FConnections); //31.01.2011 FCrossConnections.Clear; //ClearList(FCrossConnections); ClearFNet; FWholeComponent.Clear; //ClearList(FWholeComponent); //22.08.2007 FAllSCSComplects.Clear; //ClearListWithObjects(AllSCSComplects); //ClearChilds; FChildComplects.Clear; //ClearListWithObjects(ChildComplects); ClearJoinedComponents; //FJoinedComponents.Clear; //FreeAndNil(Picture); Description.Clear; Picture.Clear; ID := 0; NewID := 0; OldID := 0; IDNormBase := 0; ObjectID := 0; ListID := 0; IDRelatedCompon := 0; NAME := ''; NameShort := ''; NameMark := ''; MarkID := 0; MarkStr := ''; Cypher := ''; IsUserMark := 0; IsMarkInCaptions := biFalse; Izm := ''; Notice := ''; //Picture := nil; //Picture.Free; //Picure := Tmem.cre IsLine := 1; ISComplect := 1; PriceSupply := 0; PRICE := 0; HASNDS := 1; ArticulDistributor := ''; ArticulProducer := ''; ID_ComponentType := 0; IDSymbol := 0; IDObjectIcon := 0; ObjectIconStep := 0; ID_Producer := 0; ID_CURRENCY := 0; IDSuppliesKind := 0; ID_SUPPLIER := 0; IDNetType :=0; IDCompSpecification := 0; SortID := 0; Whole_ID := 0; IsDismount := biFalse; IsUseDismounted := biFalse; UseKindInProj := ukUsual; IsTemplate := biFalse; Length := 0; LengthReserv := 0; Count := 0; GuidNB := ''; GUIDComponentType := ''; GUIDSymbol := ''; GUIDObjectIcon := ''; GUIDProducer := ''; GUIDSupplier := ''; GUIDNetType := ''; GUIDSuppliesKind := ''; GUIDSupplier := ''; CableCanalConnectorsCnt := -1; InterfCount := -1; JoinsCount := -1; IDTopComponent := 0; IDCompRel := 0; ServAllLoaded := false; ServCanConnect := false; ServChangedLength := biNone; ServChangedMarkID := false; ServChangedNameFromTo := false; ServChangedWholeID := false; ServCopyIndex := 0; ServDisabledLoadDataElements := []; ServIsSetToLite := false; ServNoDefinePriceCalcInChild := false; ServNoDelNodeInDiscomplect := false; ServToDelete := false; ServToMark := false; ServPriceisLoaded := False; CompRelSortID := 0; ComeFrom := cftUser; FirstIDConnectedConnCompon := 0; LastIDConnectedConnCompon := 0; FirstConnectedConnCompon := nil; LastConnectedConnCompon := nil; LinkToComlectRec := nil; if OwnerCatalog <> nil then begin FreeAndNil(OwnerCatalog); OwnerCatalog := nil; end; end; procedure TSCSComponent.ClearElements; begin //07.11.2013 inherited; //07.11.2013 в inherited попадает через Clear->inherited->ClearElements // Tolik -- 20/02/2018 -- //FInterfaces.Clear; // //07.11.2013 NormsResources.Clear; ClearList(FComplects); ClearList(FCableCanalConnector); FCrossConnections.Clear; end; procedure TSCSComponent.AddChildComponent(AComponent: TSCSComponent); begin if Assigned(AComponent) then begin FChildComplects.Add(AComponent); AComponent.Parent := Self; end; end; function TSCSComponent.AddProperty(AIDProperty: Integer; AGUIDProperty: String; AIDDataType, ATakeIntoConnect, ATakeIntoJoin, AIsDefault: Integer; AValue, AName, ASysName: String): PProperty; begin Result := inherited AddProperty(ID, AIDProperty, AGUIDProperty, AIDDataType, ATakeIntoConnect, ATakeIntoJoin, AIsDefault, AValue, AName, ASysName); end; procedure TSCSComponent.AddToChild(AComponent: TSCSComponent); begin if FChildComplects.IndexOf(AComponent) = -1 then FChildComplects.Add(AComponent); AComponent.Parent := Self; end; procedure TSCSComponent.AddToJoined(AJoinedComponent: TSCSComponent); begin if Assigned(AJoinedComponent) then begin if (FJoinedComponents.IndexOf(AJoinedComponent) = -1) or IsCrossComponent or AJoinedComponent.IsCrossComponent then FJoinedComponents.Add(AJoinedComponent); if (AJoinedComponent.JoinedComponents.IndexOf(Self) = -1) or IsCrossComponent or AJoinedComponent.IsCrossComponent then AJoinedComponent.FJoinedComponents.Add(Self); end; end; procedure TSCSComponent.Assign(ASCSCompon: TSCSComponent; ANoSkipLineJoin: Boolean; AWithConnections: Boolean {= true}; AFromNew: Boolean = false); begin if Not Assigned(ASCSCompon) then Exit; ///// EXIT //// AssignOnlyComponent(ASCSCompon, AFromNew); AssignCableCanalConnectors(ASCSCompon.CableCanalConnectors, AFromNew); AssignComplects(ASCSCompon.Complects, AFromNew); if AWithConnections then AssignConnections(ASCSCompon.Connections, AFromNew); AssignInterfaces(ASCSCompon.Interfaces, ANoSkipLineJoin, AFromNew); AssignNormsResources(ASCSCompon.NormsResources, AFromNew); AssignProperties(ASCSCompon.Properties, AFromNew); AssignCrossConnections(ASCSCompon.CrossConnections, AFromNew); end; procedure TSCSComponent.AssignCrossConnections(ACrossConnections: TSCSObjectList; AFromNew: Boolean = false); var ptrCrossConnection, ptrNewCrossConnection: TSCSCrossConnection; i: Integer; begin FCrossConnections.Clear; //ClearList(FCrossConnections); for i := 0 to ACrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(ACrossConnections[i]); ptrNewCrossConnection := TSCSCrossConnection.Create(FActiveForm); //GetZeroMem(ptrNewCrossConnection, SizeOf(TCrossConnection)); //ptrNewCrossConnection^ := ptrCrossConnection^; ptrNewCrossConnection.Assign(ptrCrossConnection); ptrNewCrossConnection.IDComponent := ID; if AFromNew then begin end; FCrossConnections.Add(ptrNewCrossConnection); end; end; procedure TSCSComponent.AssignDescription(ADescriptionStream: TMemoryStream); begin if Description = nil then Description := TMemoryStream.Create; CopyStream(Description, ADescriptionStream); end; procedure TSCSComponent.AssignOnlyComponent(ASCSCompon: TSCSComponent; AFromNew: Boolean = false); var Stream: TMemoryStream; begin if Not Assigned(ASCSCompon) then Exit; ///// EXIT //// //ActiveForm := ASCSCompon.ActiveForm; with TF_MAIN(ASCSCompon.ActiveForm) do case GDBMode of bkNormBase: ActiveForm := TForm(FNormBase); bkProjectManager: ActiveForm := TForm(FProjectMan); end; ID := ASCSCompon.ID; NewID := ASCSCompon.NewID; IDNormBase := ASCSCompon.IDNormBase; ObjectID := ASCSCompon.ObjectID; ListID := ASCSCompon.ListID; ProjectOwner := ASCSCompon.ProjectOwner; //From Dimon ;) Name := ASCSCompon.Name; NameShort := ASCSCompon.NameShort; NameMark := ASCSCompon.NameMark; MarkID := ASCSCompon.MarkID; MarkStr := ASCSCompon.MarkStr; Cypher := ASCSCompon.Cypher; IsUserMark := ASCSCompon.IsUserMark; IsMarkInCaptions := ASCSCompon.IsMarkInCaptions; Izm := ASCSCompon.Izm; Notice := ASCSCompon.Notice; ComponentType := ASCSCompon.ComponentType; Color := ASCSCompon.Color; if ASCSCompon.Picture <> nil then begin AssignPicture(ASCSCompon.Picture); //ASCSCompon.Picture.Position := 0; //if Picture = nil then // Picture := TMemoryStream.Create; //CopyStream(Picture, ASCSCompon.Picture); end; if ASCSCompon.Description <> nil then begin AssignDescription(ASCSCompon.Description); //ASCSCompon.Description.Position := 0; //if Description = nil then // Description := TMemoryStream.Create; //CopyStream(Description, ASCSCompon.Description); end; IsLine := ASCSCompon.IsLine; ISComplect := ASCSCompon.ISComplect; PriceSupply := ASCSCompon.PriceSupply; PRICE := ASCSCompon.PRICE; PRICE_CALC := ASCSCompon.PRICE_CALC; UserLength := ASCSCompon.UserLength; MaxLength := ASCSCompon.MaxLength; HASNDS := ASCSCompon.HASNDS; ArticulDistributor := ASCSCompon.ArticulDistributor; ArticulProducer := ASCSCompon.ArticulProducer; ID_ComponentType := ASCSCompon.ID_ComponentType; IDSymbol := ASCSCompon.IDSymbol; IDObjectIcon := ASCSCompon.IDObjectIcon; ObjectIconStep := ASCSCompon.ObjectIconStep; ID_Producer := ASCSCompon.ID_Producer; ID_CURRENCY := ASCSCompon.ID_CURRENCY; IDSuppliesKind := ASCSCompon.IDSuppliesKind; ID_SUPPLIER := ASCSCompon.ID_SUPPLIER; IDNetType := ASCSCompon.IDNetType; IDCompSpecification := ASCSCompon.IDCompSpecification; SortID := ASCSCompon.SortID; Whole_ID := ASCSCompon.Whole_ID; KolComplect := ASCSCompon.KolComplect; IsDismount := ASCSCompon.IsDismount; IsUseDismounted := ASCSCompon.IsUseDismounted; UseKindInProj := ASCSCompon.UseKindInProj; ComeFrom := ASCSCompon.ComeFrom; IsTemplate := ASCSCompon.IsTemplate; GuidNB := ASCSCompon.GuidNB; GUIDComponentType := ASCSCompon.GUIDComponentType; GUIDSymbol := ASCSCompon.GUIDSymbol; GUIDObjectIcon := ASCSCompon.GUIDObjectIcon; GUIDProducer := ASCSCompon.GUIDProducer; GUIDSupplier := ASCSCompon.GUIDSupplier; GUIDNetType := ASCSCompon.GUIDNetType; GUIDSuppliesKind := ASCSCompon.GUIDSuppliesKind; //20.08.2007 CoordZ := ASCSCompon.CoordZ; //*** Служебные данные IDTopComponent := ASCSCompon.IDTopComponent; IDCompRel := ASCSCompon.IDCompRel; Count := ASCSCompon.Count; Length := ASCSCompon.Length; //Полная длина (в т.ч. запас) LengthReserv := ASCSCompon.LengthReserv; //Размер запаса //20.08.2007 PriceComponWithComplects := ASCSCompon.PriceComponWithComplects; if AFromNew then ID := ASCSCompon.NewID; end; procedure TSCSComponent.AssignOnlyComponentCommonData(ASrcComponent: TSCSComponent; AIncludingMark: Boolean); var SavedID, SavedProjectID, SavedIsDismount, SavedIsUseDismounted: Integer; SavedNameMark: String; SavedIsUserMark, SavedKolComplect, SavedSortID, SavedObjectID, SavedListID: Integer; //SavedParent: TBasicSCSClass; SavedUserLength: Double; begin if Assigned(ASrcComponent) then begin SavedID := Self.ID; SavedNameMark := Self.NameMark; SavedIsUserMark := Self.IsUserMark; SavedKolComplect := Self.KolComplect; SavedSortID := Self.SortID; SavedObjectID := Self.ObjectID; SavedListID := Self.ListID; //SavedParent := Self.FParent; //SavedProjectID := Self.ProjectID; SavedUserLength := Self.UserLength; SavedIsDismount := Self.IsDismount; SavedIsUseDismounted := Self.IsUseDismounted; Self.AssignOnlyComponent(ASrcComponent); Self.ID := SavedID; Self.NameMark := SavedNameMark; Self.IsUserMark := SavedIsUserMark; Self.KolComplect := SavedKolComplect; Self.SortID := SavedSortID; Self.ObjectID := SavedObjectID; Self.ListID := SavedListID; //Self.FParent := SavedParent; //Self.ProjectID := SavedProjectID; Self.UserLength := SavedUserLength; Self.IsDismount := SavedIsDismount; Self.IsUseDismounted := SavedIsUseDismounted; if AIncludingMark then begin Self.NameMark := ASrcComponent.NameMark; Self.IsUserMark := ASrcComponent.IsUserMark; end; end; end; procedure TSCSComponent.AssignCableCanalConnectors(ACableCanalConnectors: TList; AFromNew: Boolean = false); var i: Integer; ptrCableCanalConnector: PCableCanalConnector; begin if Not Assigned(ACableCanalConnectors) then Exit; //// EXIT ///// if ComponentType.SysName <> ctsnCableChannel then if ComponentType.SysName <> ctsnTube then // Tolik 16/11/2021 - - Exit; //// EXIT ///// ClearList(FCableCanalConnector); for i := 0 to ACableCanalConnectors.Count - 1 do begin GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); ptrCableCanalConnector^ := TCableCanalConnector(ACableCanalConnectors[i]^); ptrCableCanalConnector.IDCableCanal := FID; if AFromNew then ptrCableCanalConnector.ID := ptrCableCanalConnector.NewID; FCableCanalConnector.Add(ptrCableCanalConnector); end; end; procedure TSCSComponent.AssignChildComponents(AChildComponents: TSCSComponents; ANoSkipLineJoin: Boolean; AWithConnections: Boolean = true); var i: Integer; SrcChildComlect, ChildComponent: TSCSComponent; begin if Assigned(AChildComponents) then for i := 0 to AChildComponents.Count - 1 do begin SrcChildComlect := AChildComponents[i]; ChildComponent := TSCSComponent.Create(ActiveForm); ChildComponent.Parent := Self; FChildComplects.Add(ChildComponent); ChildComponent.Assign(SrcChildComlect, ANoSkipLineJoin, AWithConnections); ChildComponent.AssignChildComponents(SrcChildComlect.ChildComplects, ANoSkipLineJoin, AWithConnections); end; end; procedure TSCSComponent.AssignComplects(AComplects: TList; AFromNew: Boolean = false); begin AssignCompRels(AComplects, cntComplect, AFromNew); end; procedure TSCSComponent.AssignCompRels(ASrcCompRels: TList; AConnectType: Integer; AFromNew: Boolean = false); var CompRelList: TList; i: Integer; ptrComplect: PComplect; begin if Not Assigned(ASrcCompRels) then Exit; ///// EXIT //// CompRelList := nil; case AConnectType of cntComplect: CompRelList := FComplects; cntUnion: CompRelList := FConnections; end; if CompRelList <> nil then begin ClearList(CompRelList); for i := 0 to ASrcCompRels.Count - 1 do begin GetMem(ptrComplect, SizeOf(TComplect)); ptrComplect^ := TComplect(ASrcCompRels[i]^); ptrComplect.ID_Component := FID; if AFromNew then begin if ptrComplect.NewID <> 0 then ptrComplect.ID := ptrComplect.NewID; if ptrComplect.ID_NewComponent <> 0 then ptrComplect.ID_Component := ptrComplect.ID_NewComponent; end; CompRelList.Add(ptrComplect); end; end; end; procedure TSCSComponent.AssignConnections(AConnections: TList; AFromNew: Boolean = false); begin AssignCompRels(AConnections, cntUnion, AFromNew); end; procedure TSCSComponent.AssignInterfaces(AInterfaces: TSCSInterfaces; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); var ptrInterf: TSCSInterface; //IOfIRel: TSCSIOfIRel; i, j: integer; begin if Not Assigned(AInterfaces) then Exit; ///// EXIT ///// FInterfaces.Clear; //ClearList(FInterfaces); for i := 0 to AInterfaces.Count - 1 do begin //ptrInterf := GetInterfaceAsNew; //GetMem(ptrInterf, SizeOf(TInterface)); ptrInterf := TSCSInterface.Create(FActiveForm); ptrInterf.ComponentOwner := Self; ptrInterf.Assign(AInterfaces[i], ANoSkipLineJoin, AFromNew); //ptrInterf^ := TInterface(AInterfaces[i]^); ptrInterf.ID_Component := ID; ptrInterf.ComponentOwner := Self; //ptrInterf.IOfIRelOut := TList.Create; //ptrInterf.ConnectedInterfaces := TList.Create; //ptrInterf.ParallelInterface := nil; FInterfaces.Add(ptrInterf); if AFromNew then ptrInterf.ID := ptrInterf.NewID; { if Assigned(TSCSInterface(AInterfaces[i]).IOfIRelOut) then for j := 0 to TSCSInterface(AInterfaces[i]).IOfIRelOut.Count - 1 do begin GetMem(ptrIOfIRel, SizeOf(TIOfIRel)); ptrIOfIRel^ := TIOfIRel(TSCSInterface(AInterfaces[i]).IOfIRelOut[j]^); ptrIOfIRel.IDInterfRel := ptrInterf.ID; if AFromNew then ptrIOfIRel.ID := ptrIOfIRel.NewID; ptrInterf.IOfIRelOut.Add(ptrIOfIRel); end; } end; SetInterfacesParallel; SetPortInterfRelInterfaces; end; procedure TSCSComponent.AssignNormsResources(ANormsResources: TSCSNormsResources; AFromNew: Boolean = false); begin if Not Assigned(ANormsResources) then Exit; ///// EXIT ///// FNormsResources.MasterTableKind := ctkComponent; FNormsResources.IDMaster := ID; FNormsResources.Assign(ANormsResources); FNormsResources.MasterTableKind := ctkComponent; FNormsResources.IDMaster := ID; end; procedure TSCSComponent.AssignPicture(APictureStream: TMemoryStream); begin if Picture = nil then Picture := TMemoryStream.Create; CopyStream(Picture, APictureStream); end; procedure TSCSComponent.CopyFrom(ASourceCompon: TSCSComponent); begin if Assigned(ASourceCompon) then begin Name := ASourceCompon.Name; NameShort := ASourceCompon.NameShort; if IsUserMark = biFalse then begin NameMark := ASourceCompon.NameMark; IsUserMark := ASourceCompon.IsUserMark; end; IsMarkInCaptions := ASourceCompon.IsMarkInCaptions; MarkID := ASourceCompon.MarkID; MarkStr := ASourceCompon.MarkStr; Cypher := ASourceCompon.Cypher; Izm := ASourceCompon.Izm; Notice := ASourceCompon.Notice; ComponentType := ASourceCompon.ComponentType; Color := ASourceCompon.Color; if ASourceCompon.Picture <> nil then begin ASourceCompon.Picture.Position := 0; if Picture = nil then Picture := TMemoryStream.Create; Picture.Position := 0; Picture.CopyFrom(ASourceCompon.Picture, ASourceCompon.Picture.Size); Picture.Position := 0; ASourceCompon.Picture.Position := 0; end; IsLine := ASourceCompon.IsLine; ISComplect := ASourceCompon.ISComplect; PRICE := ASourceCompon.PRICE; //PRICE_CALC := ASCSCompon.PRICE_CALC; //UserLength := ASCSCompon.UserLength; MaxLength := ASourceCompon.MaxLength; HASNDS := ASourceCompon.HASNDS; ArticulDistributor := ASourceCompon.ArticulDistributor; ArticulProducer := ASourceCompon.ArticulProducer; ID_ComponentType := ASourceCompon.ID_ComponentType; IDSymbol := ASourceCompon.IDSymbol; IDObjectIcon := ASourceCompon.IDObjectIcon; ObjectIconStep := ASourceCompon.ObjectIconStep; ID_Producer := ASourceCompon.ID_Producer; ID_CURRENCY := ASourceCompon.ID_CURRENCY; ID_SUPPLIER := ASourceCompon.ID_SUPPLIER; IDNetType := ASourceCompon.IDNetType; IDCompSpecification := ASourceCompon.IDCompSpecification; //SortID := ASCSCompon.SortID; Whole_ID := ASourceCompon.Whole_ID; //KolComplect := ASCSCompon.KolComplect; //CoordZ := ASCSCompon.CoordZ; Length := ASourceCompon.Length; //Полная длина (в т.ч. запас) end; end; {22.08.2007 procedure TSCSComponent.SetQuerySQL(AQuery: TpFIBQuery; ASQL: String); begin AQuery.Close; AQuery.SQL.Clear; AQuery.SQL.Add(ASQL); end;} function TSCSComponent.CanReplaceWithNBCompon(ANBComponent: TSCSComponent; ALeaveComplects: Boolean): TCheckReplaceComponResults; var BusyInterfaces, EmtyNBInterfaces: TList; NBComponVolume: Double; List: TSCSList; TopCatalog: TSCSCatalog; ParentComponent, ChildComponent: TSCSComponent; InterfLists: TInterfLists; i: Integer; Interf: TSCSInterface; begin Result := []; // Tolik -- 13/03/2017 -- BusyInterfaces := nil; EmtyNBInterfaces := nil; // List := nil; ParentComponent := GetParentComponent; if Assigned(ANBComponent) then begin if Self.IsLine <> ANBComponent.IsLine then Exit; //// EXIT //// case IsLine of biFalse: begin // Tolik -- 13/03/2017 -- //BusyInterfaces := nil; //EmtyNBInterfaces := nil; //*** Проверить функциональные интерфейсы BusyInterfaces := GetInterfacesByIsBusyAndType(biTrue, itFunctional, Not ALeaveComplects); //*** Если Заменяется шкаф, то не учитываать интерфейсы кроссов if ComponentType.SysName = ctsnCupBoard then begin for i := 0 to BusyInterfaces.Count - 1 do begin Interf := BusyInterfaces[i]; if Interf.ComponentOwner.ComponentType.SysName = ctsnPatchCord then BusyInterfaces[i] := nil; end; BusyInterfaces.Pack; end; EmtyNBInterfaces := ANBComponent.GetInterfacesByIsBusyAndType(biFalse, itFunctional, Not ALeaveComplects); if Not CheckIntrfacesVariousBusyEmpty(BusyInterfaces, EmtyNBInterfaces) then Result := Result + [crcrBadFunctionalInterfaces]; if Assigned(BusyInterfaces) then FreeAndNil(BusyInterfaces); if Assigned(EmtyNBInterfaces) then FreeAndNil(EmtyNBInterfaces); //*** Проверить конструктивные интерфейсы, если комплектующая if (ParentComponent <> nil) and (ParentComponent <> Self) then begin InterfLists := ParentComponent.GetInterfacesThatConnectComponent(Self); EmtyNBInterfaces := ANBComponent.GetInterfacesByIsBusyAndType(biFalse, itConstructive, false); // InterfLists.InterfList2 - интерфейсы парента // InterfLists.InterfList2 - Свои интерфейсы if Not CheckIntrfacesVariousBusyEmpty(InterfLists.InterfList2, EmtyNBInterfaces) then Result := Result + [crcrBadContructiveInterfaces]; EmtyNBInterfaces.Free; InterfLists.InterfList1.Free; InterfLists.InterfList2.Free; if Not TF_Main(FActiveForm).CanConnCompon(ParentComponent, ANBComponent, cntComplect, smtNone) then Result := Result + [crcrCannotComplectToParentByParams]; end; //*** Проверить конструктивные интерфейсы, если Не нужно заменять комплектующие if ALeaveComplects and (FChildComplects.Count > 0) then if Not (crcrBadContructiveInterfaces in Result) then begin BusyInterfaces := GetInterfacesByIsBusyAndType(biTrue, itConstructive, false); EmtyNBInterfaces := ANBComponent.GetInterfacesByIsBusyAndType(biNone, itConstructive, false); if Not CheckIntrfacesVariousBusyEmpty(BusyInterfaces, EmtyNBInterfaces, false) then Result := Result + [crcrBadContructiveInterfaces]; FreeAndNil(BusyInterfaces); FreeAndNil(EmtyNBInterfaces); for i := 0 to FChildComplects.Count - 1 do begin ChildComponent := FChildComplects[i]; if Not TF_Main(FActiveForm).CanConnCompon(ANBComponent, ChildComponent, cntComplect, smtNone) then begin Result := Result + [crcrCannotComplectChildrenByParams]; Break; //// BREAK //// end; end; end; end; biTrue: if ComponentType.SysName = ctsnCableChannel then begin //if CheckCanalHaveCable(ANBComponent) then // Result := Result + [crcrSmallCanal]; end else begin //if Not HaveComponentSameInterfaces(Self, ANBComponent, itFunctional) then // Result := Result + [crcrBadFunctionalInterfaces]; BusyInterfaces := GetInterfacesByIsBusyAndType(biTrue, itFunctional, false); EmtyNBInterfaces := ANBComponent.GetInterfacesByIsBusyAndType(biFalse, itFunctional, false); if Not CheckIntrfacesVariousBusyEmpty(BusyInterfaces, EmtyNBInterfaces) then Result := Result + [crcrBadFunctionalInterfaces]; if Assigned(BusyInterfaces) then FreeAndNil(BusyInterfaces); if Assigned(EmtyNBInterfaces) then FreeAndNil(EmtyNBInterfaces); end; end; end; if Result = [] then Result := [crcrSuccessful]; end; function TSCSComponent.CheckCanalHaveCable(ACable: TSCSComponent; var AChannelFemaleInterface, ACableMaleInterface: TSCSInterface): TCanFemaleHaveMaleRes; var //List: TSCSList; SelfVolume, ZapasSize: Double; ChannelFemaleInterface, CableMaleInterface: TSCSInterface; CableMaleInterfaceGuid: String; CanFemaleHaveMaleRes: TCanFemaleHaveMaleRes; CablesVolume, CableChannelFullness, MaleTotalValue, MinValueForMales: Double; begin ZeroMemory(@Result, SizeOf(TCanFemaleHaveMaleRes)); AChannelFemaleInterface := nil; ACableMaleInterface := nil; SelfVolume := 0; CableMaleInterfaceGuid := ''; CableMaleInterface := ACable.GetInterfaceByTypeAndGender([itConstructive], [gtMale], biTrue); if CableMaleInterface <> nil then CableMaleInterfaceGuid := CableMaleInterface.GUIDInterface; //*** Искать объем для папы ChannelFemaleInterface := GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, CableMaleInterfaceGuid); //SelfVolume := GetVolume(gtFemale, CableMaleInterfaceGuid); //*** Если объем для папы не найден, найти что есть if (ChannelFemaleInterface = nil) and (CableMaleInterfaceGuid <> '') then ChannelFemaleInterface := GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, '', true); //SelfVolume := GetVolume(gtFemale, '', true); if (ChannelFemaleInterface <> nil) and (CableMaleInterface <> nil) then begin //List := GetListOwner; SelfVolume := ChannelFemaleInterface.ValueI; CablesVolume := GetCablesVolume(ACable); ZapasSize := 0; MaleTotalValue := CablesVolume + CableMaleInterface.ValueI; //CanFemaleHaveMaleRes := TF_Main(FActiveForm).CanFemaleHaveMale(ChannelFemaleInterface, CableMaleInterface, List.Setting.CableCanalFullnessKoef); //Result := CanFemaleHaveMaleRes.CanHave; MinValueForMales := ChannelFemaleInterface.ValueI; Result.MaxFemaleFullValue := ChannelFemaleInterface.ValueI; //if Assigned(List) then CableChannelFullness := GetCableCanalFullnessKoef(Self, ACable); if CableChannelFullness > 0 then begin ZapasSize := SelfVolume - SelfVolume * (CableChannelFullness/100); MinValueForMales := RoundCP(MaleTotalValue * (100 / CableChannelFullness)); if ChannelFemaleInterface.ValueI <> 0 then Result.MaxFemaleFullValue := (ChannelFemaleInterface.ValueI / 100) * CableChannelFullness; end; Result.MinValueForMales := MinValueForMales; Result.CurrMaleValue := MaleTotalValue; Result.CurrFemaleEmptyValue := Result.MaxFemaleFullValue - CablesVolume; //if ((SelfVolume - (ZapasSize + GetCablesVolume + ACable.GetVolume(gtMale))) > 0) then if ((SelfVolume - (ZapasSize + MaleTotalValue)) >= 0) then begin Result.CanHave := true; end else begin if ExtendTemplateInterface(ChannelFemaleInterface, 0, @MinValueForMales) then Result.CanHave := true; end; end; AChannelFemaleInterface := ChannelFemaleInterface; ACableMaleInterface := CableMaleInterface; end; function TSCSComponent.CheckCmpByInterfaces(ACMPComponent: TSCSComponent): Boolean; var i, j: Integer; LookedInterf: Tlist; ptrInterf, ptrCmpInterf: TSCSInterface; Finded: Boolean; begin Result := false; if Assigned(ACMPComponent) then begin if FInterfaces.Count <> ACMPComponent.FInterfaces.Count then Result := false else begin LookedInterf := TList.Create; Finded := false; for i := 0 to FInterfaces.Count - 1 do begin ptrInterf := FInterfaces[i]; Finded := false; for j := 0 to ACMPComponent.FInterfaces.Count - 1 do begin ptrCmpInterf := ACMPComponent.FInterfaces[j]; if LookedInterf.IndexOf(ptrCmpInterf) = -1 then if (ptrInterf.ID_Interface = ptrCmpInterf.ID_Interface) and (ptrInterf.TypeI = ptrCmpInterf.TypeI) and (ptrInterf.Kind = ptrCmpInterf.Kind) and (ptrInterf.Side = ptrCmpInterf.Side) then begin Finded := true; LookedInterf.Add(ptrCmpInterf); Break; ///// BREAK //// end; end; if Not Finded then Break; //// BREAK //// end; FreeAndNil(LookedInterf); if Finded then Result := true; end; end; end; function TSCSComponent.CheckComplectWith(AChildComponent: TSCSComponent; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; begin Result := ConnectWith(AChildComponent, -1, -1, -1, -1, cntComplect, true, true, ACanWithNoInterfaces, ACanWithNoParams); end; //*** Проверяет, присоединен ли к компоненту тек. объект половиной интерфесами function TSCSComponent.CheckConnectedByHalfEqualInterfaces(AConnectedCompon: TSCSComponent; AByIDCompRel: Integer; AConnectType: Integer; AEmulate: Boolean): Boolean; var InterfTypeToCheckEqual: Integer; CurrSelfInterf, ConnectedInterf: TSCSInterface; HalfInterfCount, CurrCount, i: Integer; IOfIRel: TSCSIOfIRel; IDCompRelList: TIntList; // Список ID-в соединений с компонентой AConnectedCompon InterfCountInCompRel: TIntList; // Количество интерфейсов на соединении IDCompRelListIndex: Integer; // Индекс ID-ка в списке IDCompRelList begin Result := false; if AByIDCompRel < 1 then Exit; ///// EXIT ///// InterfTypeToCheckEqual := itNone; case AConnectType of cntComplect: InterfTypeToCheckEqual := itConstructive; cntUnion: InterfTypeToCheckEqual := itFunctional; end; //*** Проверить, все ли интерфейсы однотипные в SELF объекта if CheckEqualInterfaces(InterfTypeToCheckEqual) then if FInterfaces.Count mod 2 = 0 then // порное количество интерфейсов begin HalfInterfCount := Trunc(FInterfaces.Count / 2); IDCompRelList := TIntList.Create; InterfCountInCompRel := TIntList.Create; try for i := 0 to FInterfaces.Count - 1 do begin CurrSelfInterf := FInterfaces[i]; //CurrSelfInterf.BusyPositions //*** Проверить, соединен ли интерфейс CurrSelfInterf с компонентом AConnectedCompon // за одну привязку компонент Self с AConnectedCompon if (CurrSelfInterf.IsBusy = biTrue) or ((CurrSelfInterf.ServIsBusy = biTrue) and AEmulate) then begin ConnectedInterf := GetInterfaceConnectedWithCompon(CurrSelfInterf, AConnectedCompon); if ConnectedInterf <> nil then begin //*** Найти интерфейсную связь между CurrSelfInterf и ConnectedInterf IOfIRel := CurrSelfInterf.GetIOfIByIDInterfTo(ConnectedInterf.ID); if IOfIRel = nil then IOfIRel := ConnectedInterf.GetIOfIByIDInterfTo(CurrSelfInterf.ID); if (IOfIRel <> nil) and (IOfIRel.FPosConnections.Count = 1) then begin //*** Найти в списке это соединение IDCompRelListIndex := IDCompRelList.IndexOf(IOfIRel.IDCompRel); CurrCount := 0; //*** Если не найден, то добавить if IDCompRelListIndex = -1 then begin IDCompRelListIndex := IDCompRelList.Add(IOfIRel.IDCompRel); CurrCount := 1; InterfCountInCompRel.Add(CurrCount); end else begin CurrCount := InterfCountInCompRel[IDCompRelListIndex]; Inc(CurrCount); InterfCountInCompRel[IDCompRelListIndex] := CurrCount; end; //*** Если интерфейсов на одном соединении if (CurrCount >= HalfInterfCount) and (AByIDCompRel = IOfIRel.IDCompRel) then begin Result := true; Break; ///// BREAK ///// end; end; end; end; end; finally FreeAndNil(IDCompRelList); FreeAndNil(InterfCountInCompRel); end; end; end; function TSCSComponent.CheckConnectedToInterface(AInterface: TSCSInterface): Boolean; var Interf: TSCSInterface; ConnectedInterf: TSCSInterface; i, j: Integer; begin Result := false; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; for j := 0 to Interf.ConnectedInterfaces.Count - 1 do begin ConnectedInterf := Interf.ConnectedInterfaces[j]; if ConnectedInterf = AInterface then begin Result := true; Break; ///// BREAK ///// end; end; end; end; function TSCSComponent.CheckEqualInterfaces(AByTypeI: Integer): Boolean; var i: Integer; Interf, PrevInterf: TSCSInterface; begin Result := true; Interf := nil; PrevInterf := nil; for i := 0 to FInterfaces.Count - 1 do begin if Assigned(Interf) then if Interf.TypeI = AByTypeI then PrevInterf := Interf; Interf := FInterfaces[i]; if PrevInterf <> nil then if (Interf.TypeI = AByTypeI) and (Interf.TypeI = AByTypeI) then if Interf.ID_Interface <> PrevInterf.ID_Interface then begin Result := false; Break; ///// BREAK ///// end; end; end; function TSCSComponent.CheckForRotate(ARelatedToRotate: TSCSComponents): Boolean; var LookedComponents: TRapObjectList; ComponForCheck, NextComponForCheck, JoinedComponent: TSCSComponent; i: Integer; begin Result := false; if ARelatedToRotate <> nil then ARelatedToRotate.Clear; if IsLine = biTrue then if FJoinedComponents.Count = 0 then Result := true else // если подключенные линейные куски не подключены к точ. компоненте if FJoinedComponents.Count <= 1 then begin {LookedComponents := TRapObjectList.Create; Result := true; ComponForCheck := Self; while ComponForCheck <> nil do begin NextComponForCheck := nil; // Ищем следующий подкл-й линейный компонент for i := 0 to ComponForCheck.FJoinedComponents.Count - 1 do begin JoinedComponent := TSCSComponent(ComponForCheck.FJoinedComponents.FItems.List^[i]); if JoinedComponent.IsLine = biFalse then begin Result := false; Break; //// BREAK //// end else if ComponForCheck.FJoinedComponents.Count <= 2 then if LookedComponents.GetObject(ComponForCheck.ID) = nil then begin NextComponForCheck := JoinedComponent; Break; //// BREAK //// end; end; LookedComponents.Insert(ComponForCheck, @ComponForCheck.ID); if ARelatedToRotate <> nil then if ComponForCheck <> Self then ARelatedToRotate.Add(ComponForCheck); ComponForCheck := NextComponForCheck; end; FreeAndNil(LookedComponents); } end; end; function TSCSComponent.CheckIntrfacesVariousBusyEmpty(AInterfaces1, AInterfaces2: TList; ACheckIsBusy: Boolean = false): Boolean; var {//03.06.2009 i, j: Integer; Interfac: TSCSInterface; NBInterface: TSCSInterface; NBInterfaceSprav: TSpravochnik; NBGuidInterface: string; NBSpravInterface: TNBInterface; LookedNBInterfaces: TSCSInterfaces; Finded: Boolean;} i, j: Integer; InterfGroup1: TStringList; // группа интерфейсов - содержит GUID и количество позиций InterfGroup1Specimen: TSCSInterfaces; // Представителт группы (для каждой группы по одному интерфейсу представителю) InterfGroup2: TStringList; InterfGroup2Specimen: TSCSInterfaces; // Представителт группы (для каждой группы по одному интерфейсу представителю) InterfBusy, InterfEmpty: TSCSInterface; IndexOfEmptyGroup, InterfBusyCount, InterfBusyAccordCount, InterfEmptyCount, InterfEmptyAccordCount: Integer; Finded: Boolean; function GetGroupedInterfaces(AInterfaces: TList; AInterfGroupSpecimen: TSCSInterfaces; AIsKolvoBusy: Boolean): TStringList; var i, j, IndexOfGroup, InterfKolvo, GroupInterfKolvo: Integer; Interf, InterfFromGroup: TSCSInterface; begin // IGOR 01/07/2019 -- Result := TStringList.Create; //CreateStringListSorted; // for i := 0 to AInterfaces.Count - 1 do begin Interf := AInterfaces[i]; // Ищем такой же интерфейс в группе IndexOfGroup := -1; j := Result.IndexOf(Interf.GUIDInterface); if j <> -1 then for j := j to Result.Count - 1 do begin InterfFromGroup := AInterfGroupSpecimen[j]; if (j = IndexOfGroup) or (Result[j] = Interf.GUIDInterface) then if (InterfFromGroup.TypeI = Interf.TypeI) and (InterfFromGroup.Gender = Interf.Gender) then begin IndexOfGroup := j; Break; //// BREAK //// end; end; if IndexOfGroup = -1 then begin IndexOfGroup := Result.AddObject(Interf.GUIDInterface, TObject(0)); AInterfGroupSpecimen.Insert(IndexOfGroup, Interf); end; // Добавляем количество свободных/занятых позиций InterfKolvo := 0; // Количество занятых if AIsKolvoBusy then begin InterfKolvo := Interf.KolvoBusy; if Interf.KolvoBusy > Interf.Kolvo then InterfKolvo := Interf.Kolvo; end else // Количество свободных begin InterfKolvo := Interf.Kolvo - Interf.KolvoBusy; if InterfKolvo < 0 then InterfKolvo := 0; end; GroupInterfKolvo := Integer(Result.Objects[IndexOfGroup]); Result.Objects[IndexOfGroup] := TObject(GroupInterfKolvo + InterfKolvo); end; end; begin // Tolik Result := True; // InterfGroup1Specimen := TSCSInterfaces.Create(false); InterfGroup2Specimen := TSCSInterfaces.Create(false); // занятое количество однотипных интерфейсов InterfGroup1 := GetGroupedInterfaces(AInterfaces1, InterfGroup1Specimen, true); // свободное количество однотипных интерфейсов InterfGroup2 := GetGroupedInterfaces(AInterfaces2, InterfGroup2Specimen, false); // Для всех занятых ищем свободные for i := 0 to InterfGroup1.Count - 1 do begin InterfBusy := InterfGroup1Specimen[i]; InterfBusyCount := Integer(InterfGroup1.Objects[i]); Finded := false; //IndexOfEmptyGroup := InterfGroup2.IndexOf(InterfGroup1[i]); //if IndexOfEmptyGroup <> -1 then //for j := IndexOfEmptyGroup to InterfGroup2.Count - 1 do for j := 0 to InterfGroup2.Count - 1 do begin InterfEmpty := InterfGroup2Specimen[j]; InterfEmptyCount := Integer(InterfGroup2.Objects[j]); if (InterfBusy.TypeI = InterfEmpty.TypeI) and (InterfBusy.Gender = InterfEmpty.Gender) then begin if TF_Main(InterfBusy.FActiveForm).CheckInterf(InterfBusy, InterfEmpty, cntNone, @InterfBusyAccordCount, @InterfEmptyAccordCount) then begin if (InterfEmptyCount / InterfEmptyAccordCount) >= (InterfBusyCount / InterfBusyAccordCount) then begin Finded := true; InterfGroup2.Delete(j); InterfGroup2Specimen.Delete(j); //IGOR 01/07/2019 -- Break; //// BREAK //// end; end; end; end; if Not Finded then begin Result := false; Break; ////// BREAK ///// end; end; FreeAndNil(InterfGroup1Specimen); FreeAndNil(InterfGroup2Specimen); FreeAndNil(InterfGroup1); FreeAndNil(InterfGroup2); end; // аналогично используется определение портов свободных в GetFigureComponNames function IsExistsFreePorts(aCheckCompon: TSCSComponent; aPortReserv: integer = 0): Boolean; var i, jj, kk, JackCount, BusyCount, EmptyCount: Integer; Compon1: TSCSComponent; Interf, PortInterf: TSCSInterface; busyexist: boolean; BusyKoef: double; ComponList: TSCSComponents; ComponIdx: Integer; Compon: TSCSComponent; j,k,l: Integer; SCSCatalog : TSCSCatalog; begin Result := True; try Compon1 := aCheckCompon; ComponList := TSCSComponents.create(false); ComponList.Assign(Compon1.ChildReferences); ComponList.Insert(0, Compon1); if Compon1.isLine = 0 then begin JackCount := 0; BusyCount := 0; EmptyCount := 0; for i := 0 to ComponList.Count - 1 do begin Compon1 := ComponList[i]; for jj := 0 to Compon1.Interfaces.Count - 1 do begin Interf := Compon1.Interfaces[jj]; if (Interf.IsPort = biTrue) then begin if (Interf.TypeI = itFunctional) then begin if Interf.ID_Component = Compon1.ID then begin if Interf.PortInterfaces.Count > 0 then begin busyexist := False; for kk := 0 to Interf.PortInterfaces.Count - 1 do begin PortInterf := Interf.PortInterfaces[kk]; if (PortInterf.IsBusy = biTrue) or (PortInterf.KolvoBusy > 0) then begin busyexist := True; break; end; end; if busyexist then begin JackCount := JackCount + Interf.Kolvo; if PortInterf.Kolvo <> 0 then BusyKoef := PortInterf.KolvoBusy / PortInterf.Kolvo else BusyKoef := 1; BusyCount := BusyCount + Round(Interf.Kolvo * BusyKoef); EmptyCount := EmptyCount + (Interf.Kolvo - Round(Interf.Kolvo * BusyKoef)); end else begin JackCount := JackCount + Interf.Kolvo; EmptyCount := EmptyCount + Interf.Kolvo; end; end; end; end; end; end; end; end; if JackCount > 0 then begin if (BusyCount + aPortReserv) >= JackCount then Result := False; end; except on E: Exception do AddExceptionToLog('IsExistsFreePorts: '+E.Message); end; FreeAndNil(ComponList); end; function TSCSComponent.CheckJoinTo(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer; ACanConnBusyMultiple: Boolean = false; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; ACanJoinWithNoInterfaces: Boolean = false; ACanJoinWithNoParams: Boolean = false): TConnectInterfRes; var ParallelSide, PropValue, ReservCount: integer; CanJoinWithNoInterfaces, CanJoinWithNoParams: Boolean; SelfComponent, JoinComponent, ParentCompon, CheckCompon: TSCSComponent; aProp: PProperty; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); CanJoinWithNoInterfaces := ACanJoinWithNoInterfaces; CanJoinWithNoParams := ACanJoinWithNoParams; SelfComponent := Self; JoinComponent := AJoinComponent; // Для учета подключений и патч-кордов внутри шкафа можно будет юзать так: //if (SelfComponent.IsLine = 0) or (JoinComponent.IsLine = 0) then if ((SelfComponent.IsLine = 0) and (JoinComponent.IsLine = 1)) or ((JoinComponent.IsLine = 0) and (SelfComponent.IsLine = 1)) then begin reservCount := 0; propvalue := 0; if SelfComponent.IsLine = 0 then begin CheckCompon := SelfComponent; aProp := nil; aProp := CheckCompon.GetPropertyBySysName('PORT_RESERV_COUNT'); if aProp <> nil then begin PropValue := StrToIntDef(aProp.Value, 0); end else begin if (CheckCompon.Parent <> nil) and (CheckCompon.Parent is TSCSComponent) then begin ParentCompon := TSCSComponent(CheckCompon.Parent); while (ParentCompon <> nil) do begin aProp := ParentCompon.GetPropertyBySysName('PORT_RESERV_COUNT'); if aProp <> nil then begin PropValue := StrToIntDef(aProp.Value, 0); CheckCompon := ParentCompon; break; end; if not (ParentCompon.Parent is TSCSComponent) then break; ParentCompon := TSCSComponent(ParentCompon.Parent); end; end; end; if PropValue <> 0 then begin if Not IsExistsFreePorts(CheckCompon, PropValue) then begin Result.CanConnect := false; exit; end; end; end; if JoinComponent.IsLine = 0 then begin CheckCompon := JoinComponent; aProp := nil; aProp := CheckCompon.GetPropertyBySysName('PORT_RESERV_COUNT'); if aProp <> nil then begin PropValue := StrToIntDef(aProp.Value, 0); end else begin if (CheckCompon.Parent <> nil) and (CheckCompon.Parent is TSCSComponent) then begin ParentCompon := TSCSComponent(CheckCompon.Parent); while (ParentCompon <> nil) do begin aProp := ParentCompon.GetPropertyBySysName('PORT_RESERV_COUNT'); if aProp <> nil then begin PropValue := StrToIntDef(aProp.Value, 0); CheckCompon := ParentCompon; break; end; if not (ParentCompon.Parent is TSCSComponent) then break; ParentCompon := TSCSComponent(ParentCompon.Parent); end; end; end; if PropValue <> 0 then begin if Not IsExistsFreePorts(CheckCompon, PropValue) then begin Result.CanConnect := false; exit; end; end; end; end; DefineJoiningComponentsByTrunk(SelfComponent, JoinComponent, ASelfSide, AJoinSide); if (SelfComponent <> nil) and (JoinComponent <> nil) then begin Result := SelfComponent.ConnectWith(JoinComponent, ASelfSide, AJoinSide, -1, -1, cntUnion, true, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces); if Result.CanConnect = false then begin if (SelfComponent.CheckForRotate(nil)) and (ASelfSide > 0) then begin ParallelSide := GetParallelSide(ASelfSide); if ParallelSide <> stNoneSide then Result := SelfComponent.ConnectWith(JoinComponent, ParallelSide, AJoinSide, -1, -1, cntUnion, true, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces); end; if Result.CanConnect = false then begin if (JoinComponent.CheckForRotate(nil)) and (AJoinSide > 0) then begin ParallelSide := GetParallelSide(AJoinSide); if ParallelSide <> stNoneSide then Result := SelfComponent.ConnectWith(JoinComponent, ASelfSide, ParallelSide, -1, -1, cntUnion, true, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces); end; end; end; end; end; function TSCSComponent.CheckJoinToListCompons(AListCompons: TSCSComponents; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; var SCSComponent: TSCSComponent; i, InterfIndexToAdd: Integer; CanConnBusyMultiple, CanJoinWithoutInterfaces: Boolean; ComponsInterfaces: TSCSInterfaces; UniqueCompons: TRapList; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); // Tolik 20/12/2019 -- CanConnBusyMultiple := false; //*** Может ли подключится без интерфейсов CanJoinWithoutInterfaces := true; for i := 0 to AListCompons.Count - 1 do begin SCSComponent := AListCompons[i]; if Not CheckJoinTo(SCSComponent, -1, -1, CanConnBusyMultiple, nil, nil, ACanWithNoInterfaces, ACanWithNoParams).CanConnect then begin CanJoinWithoutInterfaces := false; Break; //// BREAK //// end; end; if CanJoinWithoutInterfaces and (AListCompons.Count > 0) then begin ComponsInterfaces := TSCSInterfaces.Create(false); UniqueCompons := TRapList.Create; for i := 0 to AListCompons.Count - 1 do begin SCSComponent := AListCompons[i]; //ComponsInterfaces.Assign(AListCompons[i].FInterfaces, laOr); ComponsInterfaces.AddItems(SCSComponent.FInterfaces); if UniqueCompons.IndexOf(SCSComponent) = -1 then UniqueCompons.Add(SCSComponent); end; //*** Может ли подключится только интерфейсов Result := CheckJoinTo(AListCompons[0], -1, -1, CanConnBusyMultiple, nil, ComponsInterfaces, ACanWithNoInterfaces, ACanWithNoParams); //проверяем количество компонент, которое может подключиться if Result.CanConnect then if Result.Compon2Count < UniqueCompons.Count then //01.06.2009 if Result.Compon2Count < AListCompons.Count then Result.CanConnect := false; FreeAndNil(UniqueCompons); ComponsInterfaces.Free; end; end; function TSCSComponent.CheckJoinToSeveralCompons(ACompon1, ACompon2: TSCSComponent; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): TConnectInterfRes; var ComponsToJoin: TSCSComponents; begin ComponsToJoin := TSCSComponents.Create(false); if ACompon1 <> nil then ComponsToJoin.Add(ACompon1); if ACompon2 <> nil then ComponsToJoin.Add(ACompon2); Result := CheckJoinToListCompons(ComponsToJoin, ACanWithNoInterfaces, ACanWithNoParams); ComponsToJoin.Free; end; function TSCSComponent.CheckJoinToComponOrChilds(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer): TConnectInterfRes; var ComponList: TSCSComponents; i: Integer; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); // Tolik 31/08/2021 -- ComponList := TSCSComponents.Create(false); try ComponList.Add(Self); ComponList.Assign(Self.ChildReferences, laOr); for i := 0 to ComponList.Count - 1 do begin Result := ComponList[i].CheckJoinTo(AJoinComponent, ASelfSide, AJoinSide); if Result.CanConnect then Break; ///// BREAK ///// end; finally ComponList.Free; end; end; function TSCSComponent.CheckJoinToSame: Boolean; var SameCompon: TSCSComponent; JoinRes: TConnectInterfRes; begin Result := true; SameCompon := TSCSComponent.Create(FActiveForm); SameCompon.Assign(Self, true, true); SameCompon.ID := 0; SameCompon.ObjectID := 0; SameCompon.Cypher := ''; JoinRes := SameCompon.CheckJoinTo(Self, -1, -1); Result := JoinRes.CanConnect; FreeAndNil(SameCompon); end; function TSCSComponent.CheckJoinedByAllPosibleInterfaces(AJoinedComponent: TSCSComponent; AsideCompon1, AsideCompon2: Integer): Boolean; var Interfaces1, Interfaces2, BufInterfaces: TList; i, j, k, l: Integer; Interfac, JoinedInterf: TSCSInterface; IOfIRel: TSCSIOfIRel; InterfCountInConnnection, AllInterfInConnection, AllInterfPositions, KolvoInPosition: Integer; InterfPosition: TSCSInterfPosition; PosConnection: TSCSInterfPosConnection; PosInCurrConnection: Boolean; begin Result := true; // Tolik 08/02/2017 -- Interfaces1 := nil; Interfaces2 := Nil; // Interfaces1 := Self.GetInterfacesBySide(AsideCompon1); Interfaces2 := AJoinedComponent.GetInterfacesBySide(AsideCompon2); //*** Оставить только функциональные интерфейсы for i := 0 to Interfaces1.Count - 1 do if TSCSInterface(Interfaces1[i]).TypeI <> itFunctional then Interfaces1[i] := nil; Interfaces1.Pack; for i := 0 to Interfaces2.Count - 1 do if TSCSInterface(Interfaces2[i]).TypeI <> itFunctional then Interfaces2[i] := nil; Interfaces2.Pack; if Interfaces2.Count < Interfaces1.Count then begin BufInterfaces := Interfaces1; Interfaces1 := Interfaces2; Interfaces2 := BufInterfaces; end; InterfCountInConnnection := 0; AllInterfInConnection := 0; AllInterfPositions := 0; for i := 0 to Interfaces1.Count - 1 do begin Interfac := Interfaces1[i]; AllInterfPositions := AllInterfPositions + Interfac.Kolvo; for j := 0 to Interfac.FBusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(Interfac.FBusyPositions[j]); KolvoInPosition := InterfPosition.ToPos - (InterfPosition.FromPos - 1); PosInCurrConnection := false; if InterfPosition.InterfPosConnectionOwner <> nil then if InterfPosition.InterfPosConnectionOwner.FOwner <> nil then begin IOfIRel := InterfPosition.InterfPosConnectionOwner.FOwner; //*** Найти интерфейс компоненты AJoinedComponent для этого соединения for k := 0 to Interfaces2.Count - 1 do begin JoinedInterf := Interfaces2[k]; if (JoinedInterf.ID = IOfIRel.IDInterfTo) or (JoinedInterf.ID = IOfIRel.IDInterfRel) then begin InterfCountInConnnection := InterfCountInConnnection + KolvoInPosition; Break; ///// BREAK ////// end; end; end; AllInterfInConnection := AllInterfInConnection + KolvoInPosition; end; //if (Interfac.KolvoBusy = 0) and (Interfac.IsBusy = biFalse) then //begin // AllInterfInConnection := AllInterfInConnection + Interfac.Kolvo; //end; end; if (InterfCountInConnnection < AllInterfPositions) or (AllInterfInConnection > AllInterfPositions) then Result := false; {InterfCountInConnnection := 0; AllInterfInConnection := 0; for i := 0 to Interfaces1.Count - 1 do begin Interfac := Interfaces1[i]; if Assigned(Interfac.IOfIRelOut) then for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); for k := 0 to Interfaces2.Count - 1 do if Interfaces2[k].ID = IOfIRel.IDInterfTo then begin Inc(InterfCountInConnnection); Break; ///// BREAK ////// end; Inc(AllInterfInConnection); if IOfIRel.InterfaceTo <> nil then if Assigned(IOfIRel.InterfaceTo.IOfIRelOut) then Inc(AllInterfInConnection, IOfIRel.InterfaceTo.IOfIRelOut.Count); end; end; } //if (InterfCountInConnnection < Interfaces1.Count) or // (AllInterfInConnection > Interfaces1.Count) then // Result := false; // Tolik // 08/02/2017 - - if Interfaces1 <> nil then FreeAndNil(Interfaces1); if Interfaces2 <> nil then FreeAndNil(Interfaces2); // end; function TSCSComponent.ConnectWith(AComponent: TSCSComponent; ASideCompon1, ASideCompon2, AIDCompRel, AMaxInterfCountToConnect: Integer; AConnectType: TConnectType; ASimulation, ACanConnBusyMultiple, ACanWithNoInterfaces, ACanWithNoParams: Boolean; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; AIsFinalConnection: Boolean = true): TConnectInterfRes; var i, j, MoveCount, ComponCountInInterfList1, ComponCountInInterfList2, InterfCount1, InterfCount2, IntrfPosCountToConnect: Integer; InterfList1, InterfList2, TmpInterfaces, UsedInterfaces1, ConnectToUsed1, UsedInterfaces2, ConnectToUsed2: TSCSInterfaces; InterfDat1, InterfDat2, PrevInterfDat2: TSCSInterface; EmptyPositions1, EmptyPositions2: TSCSInterfPositions; ConnectKind: TConnectKind; CanCheckToConnect, CanConnBusyMultiple, CanWhile, CanConn, CanConnByInterf, UseJoinInfoLists, SelfIsCross, ComponIsCross: Boolean; ConnectInterfCount, IDComponRel, ConnComponSide, LineComponSide: Integer; ptrCompRel: PComplect; ChannelInterface, CableInterface: TSCSInterface; CheckInterfRes: TCheckInterfForUnionResult; NoInterfAccordanceList: TList; ptrNoInterfAccord: PInterfaceAccordance; InterfComponents1, InterfComponents2: TRapList; FormWithSettings: TForm; ConnCompon, LineCompon: TSCSComponent; CActionName, CaptNoPropertInterf: string; function AddInterfaceToUsedInProject(AInterface: TSCSInterface): Boolean; var ComponOwner: TSCSComponent; CatalogOwner: TSCSCatalog; InterfInEndPoint: Boolean; begin Result := false; InterfInEndPoint := false; if Not ASimulation then if (FProjectOwner <> nil) and FProjectOwner.IsAutoTracing and AIsFinalConnection then begin ComponOwner := AInterface.ComponentOwner; CatalogOwner := nil; if ComponOwner <> nil then CatalogOwner := ComponOwner.GetFirstParentCatalog; if (CatalogOwner <> nil) and (GEndPoint <> nil) then if CatalogOwner.SCSID = GEndPoint.ID then InterfInEndPoint := true; if Not InterfInEndPoint then InsertValueToSortetIntList(AInterface.ID, FProjectOwner.FUsedInterfaces); //11.03.2009 FProjectOwner.FUsedInterfaces.Add(AInterface); end; end; function AddInterfaceToUsed(AInterface, AConnectedInterf: TSCSInterface; AUsedInterfList, AConnectedList: TSCSInterfaces): Integer; begin Result := -1; if AUsedInterfList.IndexOf(AInterface) = -1 then begin AUsedInterfList.Add(AInterface); AConnectedList.Add(AConnectedInterf); end; end; procedure AddInterfComponentToList(AIntefRel: TSCSInterface; AComponList: TRapList); begin if AIntefRel.FComponentOwner <> nil then if AComponList.IndexOf(AIntefRel.FComponentOwner) = -1 then AComponList.Add(AIntefRel.FComponentOwner); end; procedure RemoveParallelInterfaceFromList(AInterface: TSCSInterface; AList: TSCSInterfaces); begin if AInterface.FComponentOwner <> nil then if AInterface.FComponentOwner.IsLine = biTrue then if AInterface.ParallelInterface <> nil then AList.Remove(AInterface.ParallelInterface); end; function CheckInterfReadyToConnect(AInterface: TSCSInterface; ASide: Integer): Boolean; var //DBMode: TDBKind; InterfIsBusy: Integer; begin Result := false; //DBMode := TF_Main(AInterface.FActiveForm).GDBMode; if Not AInterface.ServDisabled then if ((AConnectType = cntUnion) and (AInterface.TypeI = itFunctional) ) or ((AConnectType = cntComplect) and (AInterface.TypeI = itConstructive)) then if ((ASide > -1) and ((AInterface.Side = ASide) or (AInterface.Side = 0))) or (ASide = -1) then //if (AInterface.IsBusy = biFalse) or ((AInterface.Multiple = biTrue) and CanConnBusyMultiple) then //if (AInterface.IsBusy <> biTrue) or //(AInterface.Kolvo > AInterface.KolvoBusy) or // ((AInterface.Multiple = biTrue) and CanConnBusyMultiple) then begin InterfIsBusy := AInterface.IsBusy; //*** Если конструктив в НБ имеет соединение, то считать его занятым if (AInterface.IsBusy = biFalse) and (TF_Main(AInterface.FActiveForm).GDBMode = bkNormBase) then begin if (AInterface.TypeI = itConstructive) and (AInterface.FIOfIRelOut.Count > 0) then InterfIsBusy := biTrue; end else if ((AInterface.IsBusy = biFalse)or(AInterface.Multiple = BiTrue)){ and (TF_Main(AInterface.FActiveForm).GDBMode = bkNormBase)} then begin InterfIsBusy := biFalse; end; if (InterfIsBusy <> biTrue) or (AInterface.ComponentOwner.IsTemplate = biTrue) or //(AInterface.Kolvo > AInterface.KolvoBusy) or ((AInterface.Multiple = biTrue) and CanConnBusyMultiple) then begin Result := true; //*** Интерфейс в списке используемых if Assigned(FProjectOwner) then if GetValueIndexFromSortedIntList(AInterface.ID, FProjectOwner.FUsedInterfaces) <> -1 then //11.03.2009 if FProjectOwner.FUsedInterfaces.IndexOf(AInterface) <> -1 then Result := false; end; end; end; function CheckInterfReadyByMultiple(AInterf: TSCSInterface): Boolean; begin Result := true; //*** Не использовать конструктивный инткрфейс для емкости в линейных компонентах при компоновки if (AConnectType = cntComplect) and (AInterf.Multiple = biTrue) and (AInterf.TypeI = itConstructive) and (AInterf.IsLineCompon = biTrue) then Result := false; end; procedure AssignProperInterfaces(ATrgList, ASrcList: TSCSInterfaces; ASide: Integer; AComponToConn: TSCSComponent; AComponIsCross, AComponToConnIsCross: Boolean); var i: Integer; Interf: TSCSInterface; CanAdd: Boolean; begin for i := 0 to ASrcList.Count - 1 do begin Interf := TSCSInterface(ASrcList.FItems.List^[i]); //ASrcList[i]; if CheckInterfReadyToConnect(Interf, ASide) then begin // Не подключать порт к линейному интерфейсу //29.06.2013 CanAdd := Not((Interf.IsPort = biTrue) and (AComponToConn.IsLine = biTrue)); //30.06.2013 к порту запрещено подключение интерфейса лин.компонента, кроме кабеля CanAdd := Not((Interf.IsPort = biTrue) and (AComponToConn.IsLine = biTrue) and Not CheckSysNameIsCable(AComponToConn.ComponentType.SysName) ); if CanAdd then //12.12.2011 не даем подключить интерфейс не кросса к кроссу, только порты if (Interf.IsPort = biFalse) and Not AComponIsCross and AComponToConnIsCross then CanAdd := false; if CanAdd then begin Interf.ServSimulateKolvoBusy := Interf.KolvoBusy; ATrgList.Add(Interf); end; end; end; end; procedure DefineIDComponRel; var TopCatalog: TSCSCatalog; begin if IDComponRel = -1 then begin case FQueryMode of qmPhisical: if AIsFinalConnection then IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, Self.IDTopComponent, Self.IDCompRel, AComponent.FComplects.Count, AConnectType) else IDComponRel := GenIDFromTable(FQSelect, gnComponentRelationID, 1); qmMemory: begin TopCatalog := GetTopParentCatalog; if TopCatalog <> nil then if TopCatalog is TSCSProject then IDComponRel := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1); end; end; end; //if IDComponRel = -1 then //IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); end; procedure RemoveMultipleInterfaces(AInterfaceList: TSCSInterfaces); var i: Integer; SCSInterface: TSCSInterface; begin i := 0; while i <= AInterfaceList.Count - 1 do begin SCSInterface := AInterfaceList[i]; if SCSInterface.Multiple = biTrue then AInterfaceList.Delete(i) else Inc(i); end; end; procedure SetComponAsLiteIfCan(ACompon, AConnectCompon: TSCSComponent; AComponInterfaces: TSCSInterfaces); begin // Установить компонент в лайт, если он в НБ + если // или комплектация линейных компонентов + не используются интерфейсы из параметра // + подключение к проекту if ASimulation then if AComponInterfaces = nil then if TF_Main(Acompon.FActiveForm).GDBMode = bkNormBase then if TF_Main(Acompon.FActiveForm).GDBMode <> TF_Main(AConnectCompon.FActiveForm).GDBMode then if (AConnectType = cntUnion) or (ACompon.IsLine = biTrue) then SetComponAsLite(ACompon); end; procedure ExtendInterfPositions(AInterf: TSCSInterface; var APositions: TSCSInterfPositions; AAddCount: Integer); var AddCount: Integer; begin AddCount := AAddCount; if AddCount = 0 then AddCount := 1; if ExtendTemplateInterface(AInterf, AddCount, nil) then begin APositions.Free; APositions := AInterf.GetEmptyPositions; end; end; // Tolik --01/03/*2018 -- //сортануть список портов по порядку //сортануть интерфейсы точечного компонента в порядке // расположения портов Procedure SortPointComponentInterfacesListByPorts(aList1, aList2: TSCSInterfaces); Procedure SortPortList (var aList: TSCSInterfaces); var i: Integer; CanSort: Boolean; begin if aList.Count = 1 then exit; if aList.Count = 2 then begin if aList[0].NppPort > aList[1].NppPort then aList.Exchange(0,1); end; if aList.Count > 2 then begin CanSort:= True; While CanSort do begin CanSort := False; for i := 0 to aList.Count - 2 do begin if aList[i].NppPort > aList[i + 1].NppPort then begin CanSort := True; aList.Exchange(i, i + 1); end; end; end; end; end; Procedure SortListInterfacesByPortOrder(aList: TSCSInterfaces); var i, j, PortInterfCount: Integer; TempList, interfList: TSCSInterfaces; InterfPort, PortInterf: TSCSInterface; begin TempList := TSCSInterfaces.Create(False); for i := 0 to aList.Count - 1 do begin if aList[i].IsPort = biTrue then TempList.Add(aList[i]); end; if TempList.Count > 1 then SortPortList(TempList); InterfList := TSCSInterfaces.Create(False); // вкидаем сначала полностью свободные порты, если есть for i := 0 to TempList.Count - 1 do begin PortInterfCount := 0; InterfPort := TempList[i]; // порт for j := 0 to InterfPort.PortInterfaces.Count - 1 do begin PortInterf := InterfPort.PortInterfaces[j]; // интерфейс порта if aList.IndexOf(PortInterf) <> -1 then Inc(PortInterfCount); end; if PortInterfCount = InterfPort.PortInterfaces.Count then begin for j := 0 to InterfPort.PortInterfaces.Count - 1 do begin if InterfList.IndexOf(InterfPort.PortInterfaces[j]) = -1 then InterfList.Add(InterfPort.PortInterfaces[j]); end; end; end; // остальные интерфейсы портов for i := 0 to TempList.Count - 1 do begin InterfPort := TempList[i]; // порт for j := 0 to InterfPort.PortInterfaces.Count - 1 do begin PortInterf := InterfPort.PortInterfaces[j]; // интерфейс порта if aList.IndexOf(PortInterf) <> -1 then if InterfList.IndexOf(PortInterf) = -1 then InterfList.Add(PortInterf); end; end; // остальные интерфейсы for i := 0 to aList.Count - 1 do begin PortInterf := aList[i]; aList[i] := nil; if InterfList.IndexOf(PortInterf) = -1 then InterfList.Add(PortInterf); end; aList.Pack; for i := 0 to TempList.Count - 1 do begin aList.Add(TempList[i]); end; for i := 0 to InterfList.Count - 1 do begin //aList.Add(InterfList[i]); aList.Insert(i, InterfList[i]); end; TempList.Pack; InterfList.Pack; TempList.Free; InterfList.Free; end; begin if (aList1 <> nil) and (aList2 <> nil) then begin if aList1.Count > 0 then if aList1[0].ComponentOwner.IsLine = biFalse then begin SortListInterfacesByPortOrder(aList1); end else if aList2.Count > 0 then if aList2[0].ComponentOwner.isLine = biFalse then begin SortListInterfacesByPortOrder(aList2); end; end; end; // begin //Tolik 20/12/2019 -- ZeroMemory(@Result, SizeOf(TConnectInterfRes)); // if Not Assigned(AComponent) then // Tolik -- 15/05/2018 -- Exit; ////// EXIT ///// IDComponRel := AIDCompRel; Result.CanConnect := false; Result.ConnectInterfCount := 0; Result.NewIDCompRel := 0; Result.CompRel := nil; UsedInterfaces1 := nil; UsedInterfaces2 := nil; ConnectToUsed1 := nil; ConnectToUsed2 := nil; InterfComponents1 := nil; InterfComponents2 := nil; //if Not Assigned(AComponent) then // Tolik -- 15/05/2018 -- // Exit; ////// EXIT ///// try InterfComponents1 := TRapList.Create; InterfComponents2 := TRapList.Create; SelfIsCross := Self.IsCrossComponent; ComponIsCross := AComponent.IsCrossComponent; CanWhile := true; CanCheckToConnect := true; UseJoinInfoLists := false; CanConn := false; ConnectInterfCount := 0; CanConnBusyMultiple := ACanConnBusyMultiple; if CanConnBusyMultiple = false then if (Self.IsLine = biFalse) or (AComponent.IsLine = biFalse) then if AConnectType = cntUnion then CanConnBusyMultiple := true; ConnCompon := nil; ConnComponSide := -1; LineCompon := nil; LineComponSide := -1; if Self.IsLine = biTrue then begin LineCompon := Self; LineComponSide := ASideCompon1; if AComponent.IsLine = biFalse then begin ConnCompon := AComponent; ConnComponSide := ASideCompon2; end; end else begin ConnCompon := Self; ConnComponSide := ASideCompon1; if AComponent.IsLine = biTrue then begin LineCompon := AComponent; LineComponSide := ASideCompon2; end; end; // К подъезду и дому подключать любой линейный компонент if AConnectType = cntUnion then if (ConnCompon <> nil) and (LineCompon <> nil) then if (ConnCompon.ComponentType.SysName = ctsnHouse) or (ConnCompon.ComponentType.SysName = ctsnApproach) then begin ACanWithNoInterfaces := true; ACanWithNoParams := true; if Not ASimulation then begin if ConnCompon.FJoinedComponents.IndexOf(LineCompon) = -1 then CreateInterfacesInComponToConnect(ConnCompon, LineCompon, ConnComponSide, LineComponSide, AConnectType); end else // Определяем количество интерфейсов как 1 для результата begin TmpInterfaces := TSCSInterfaces.Create(false); AssignProperInterfaces(TmpInterfaces, LineCompon.Interfaces, LineComponSide, ConnCompon, LineCompon.IsCrossComponent, ConnCompon.IsCrossComponent); if TmpInterfaces.Count > 0 then begin InterfComponents1.Add(nil); InterfComponents2.Add(nil); ConnectInterfCount := ConnectInterfCount + 1; end; FreeAndNil(TmpInterfaces); end; end; //*** Проверка на возможность соединения компонентов по // параметрам, (тип сети, цвет...) if (AConnectType = cntUnion) and (FProjectOwner <> nil) and (FProjectOwner.IsAutoTracing) and (IsLine <> AComponent.IsLine) then UseJoinInfoLists := true; if UseJoinInfoLists then begin if FProjectOwner.FCanJoinComponsInfo.FindJoinComponsInfo(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)) then begin if FJoinedComponents.IndexOf(AComponent) = -1 then CanCheckToConnect := false else begin FreeAndNil(InterfComponents1); // Tolik 15/05/2018 -- FreeAndNil(InterfComponents2); // Tolik 15/05/2018 -- Exit; ///// EXIT ///// end; end else if FProjectOwner.FNotJoinComponsInfo.FindJoinComponsInfo(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)) then begin FreeAndNil(InterfComponents1); // Tolik 15/05/2018 -- FreeAndNil(InterfComponents2); // Tolik 15/05/2018 -- Exit; ///// EXIT ///// end; end; if CanCheckToConnect then begin FormWithSettings := Self.FActiveForm; // при подключении одного компонента из НБ второго из МП, настройки брать по МП if AConnectType = cntUnion then if Self.FActiveForm <> AComponent.FActiveForm then if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then FormWithSettings := AComponent.FActiveForm; if Not ACanWithNoParams and Not TF_Main(FormWithSettings).CanConnCompon(Self, AComponent, AConnectType, smtNone) then begin if UseJoinInfoLists then FProjectOwner.FNotJoinComponsInfo.AddRecord(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)); begin FreeAndNil(InterfComponents1); // Tolik 15/05/2018 -- FreeAndNil(InterfComponents2); // Tolik 15/05/2018 -- Exit; //// EXIT //// end; end else if UseJoinInfoLists then FProjectOwner.FCanJoinComponsInfo.AddRecord(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)); end; //CanConn := false; // ConnectInterfCount := 0; // CanConnBusyMultiple := ACanConnBusyMultiple; // if CanConnBusyMultiple = false then // if (Self.IsLine = biFalse) or (AComponent.IsLine = biFalse) then // if AConnectType = cntUnion then // CanConnBusyMultiple := true; {ConnectKind := cnkVarious; case AConnectType of cntComplect: ConnectKind := cnkVarious; cntUnion: begin ConnectKind := cnkVarious or cnkMaleMale; if (Self.IsLine = biFalse) and (AComponent.IsLine = biFalse) then ConnectKind := ConnectKind or cnkFemaleFemale; end; end;} //ConnectKind := GetConnectKindByConnectionCompons(Self, AComponent, AConnectType); //ConnComponent := nil; //ConnComponentSide := -1; //ConnComponentInterfList := nil; //ConnComponentObjectOwner := nil; //ConnComponentListOwner := nil; //LineComponent := nil; //LineComponentSide := -1; //LineComponentInterfList := nil; //LineComponentObjectOwner := nil; //LineComponentListOwner := nil; InterfList1 := TSCSInterfaces.Create(false); InterfList2 := TSCSInterfaces.Create(false); ComponCountInInterfList1 := 1; ComponCountInInterfList2 := 1; UsedInterfaces1 := TSCSInterfaces.Create(false); UsedInterfaces2 := TSCSInterfaces.Create(false); ConnectToUsed1 := TSCSInterfaces.Create(false); ConnectToUsed2 := TSCSInterfaces.Create(false); SetComponAsLiteIfCan(Self, AComponent, ASelfInterfaces); SetComponAsLiteIfCan(AComponent, Self, AComponInterfaces); try if ASelfInterfaces = nil then AssignProperInterfaces(InterfList1, Self.Interfaces, ASideCompon1, AComponent, SelfIsCross, ComponIsCross) //InterfList1.Assign(Self.Interfaces, laCopy) else begin AssignProperInterfaces(InterfList1, ASelfInterfaces, ASideCompon1, AComponent, SelfIsCross, ComponIsCross); //InterfList1.Assign(ASelfInterfaces, laCopy); ComponCountInInterfList1 := GetComponCountFromInterfList(ASelfInterfaces); end; if AComponInterfaces = nil then AssignProperInterfaces(InterfList2, AComponent.Interfaces, ASideCompon2, Self, ComponIsCross, SelfIsCross) //InterfList2.Assign(AComponent.Interfaces, laCopy) else begin AssignProperInterfaces(InterfList2, AComponInterfaces, ASideCompon2, Self, ComponIsCross, SelfIsCross); //InterfList2.Assign(AComponInterfaces, laCopy); ComponCountInInterfList2 := GetComponCountFromInterfList(AComponInterfaces); end; { //*** Определить точ-й и линейный компоненты для магистралей if (IsLine = biFalse) and (AComponent.IsLine = biTrue) then begin ConnComponent := Self; LineComponent := AComponent; ConnComponentSide := ASideCompon1; LineComponentSide := ASideCompon2; end else if (IsLine = biTrue) and (AComponent.IsLine = biFalse) then begin ConnComponent := AComponent; LineComponent := Self; ConnComponentSide := ASideCompon2; LineComponentSide := ASideCompon1; end; if (ConnComponent <> nil) and (LineComponent <> nil) then if IsTrunkComponent(ConnComponent) then if (TF_Main(ConnComponent.FActiveForm).GDBMode = bkProjectManager) and (TF_Main(LineComponent.FActiveForm).GDBMode = bkProjectManager) then begin ConnComponentObjectOwner := ConnComponent.GetFirstParentCatalog; LineComponentObjectOwner := LineComponent.GetFirstParentCatalog; if Not(ConnComponent.Parent is TSCSComponent) and (ConnComponentObjectOwner <> nil) and (LineComponentObjectOwner <> nil) then begin ConnComponentListOwner := ConnComponentObjectOwner.GetListOwner; LineComponentListOwner := LineComponentObjectOwner.GetListOwner; if (ConnComponentListOwner <> nil) and (LineComponentListOwner <> nil) then begin PosOfConnectingTrace := GetPosOfConnectingTrace(LineComponentObjectOwner.ListID, LineComponentObjectOwner.SCSID); if PosOfConnectingTrace <> -1 then PosComponent := GetComponentFromConnObjectByTrunkPos(ConnComponentObjectOwner.GetListOwner, ConnComponentObjectOwner, LineComponent, PosOfConnectingTrace, ConnComponentSide, LineComponentSide, CheckJoinRes); if PosComponent <> nil then begin if ASimulation then Result := CheckJoinRes else Result := PosComponent.JoinTo(LineComponent, ConnComponentSide, LineComponentSide); Exit; ///// EXIT ///// end; end; //*** Не подключать к какой попало позиции кросса if Not ASimulation then Exit; ///// EXIT ///// end; end;} //*** Продолжить обычное соединение без емкостных интерфейсов begin NoInterfAccordanceList := TList.Create; CanConnByInterf := true; //*** Отсортировать по количеству, таким образом, чтобы вначале были интерфейсы с // такими количеством, которые есть в списке InterfList1 // Tolik -- 01/03/2018 -*- {if Not ASimulation then MoveInterfWithCommonKolvoToBegin(InterfList1, InterfList2);} if Not ASimulation then begin MoveInterfWithCommonKolvoToBegin(InterfList1, InterfList2); SortPointComponentInterfacesListByPorts(InterfList1, InterfList2); end; // while CanWhile do begin CanWhile := false; for i := 0 to InterfList1.Count - 1 do begin InterfDat1 := TSCSInterface(InterfList1.FItems.List^[i]); //InterfList1.Items[i]; if Not CheckInterfReadyByMultiple(InterfDat1) or Not CheckInterfReadyToConnect(InterfDat1, ASideCompon1) then Continue; ///// CONTINUE ///// EmptyPositions1 := nil; //if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin EmptyPositions1 := InterfDat1.GetEmptyPositions(AMaxInterfCountToConnect); if (EmptyPositions1.Kolvo = 0) and (InterfDat1.ComponentOwner.IsTemplate = biFalse) then begin FreeAndNil(EmptyPositions1); Continue; ///// CONTINUE ///// end; end; //*** Найти свободный интерфейс с таким же количеством - поставить их первыми if (Not ASimulation) and (InterfDat1.KolvoBusy = 0) then begin MoveCount := 0; for j := 0 to InterfList2.Count - 1 do begin InterfDat2 := TSCSInterface(InterfList2.FItems.List^[j]); //InterfList2.Items[j]; if Not CheckInterfReadyByMultiple(InterfDat1) or Not CheckInterfReadyToConnect(InterfDat2, ASideCompon2) then Continue; ///// CONTINUE ///// if (InterfDat2.KolvoBusy = 0) and (InterfDat2.Kolvo = InterfDat1.Kolvo) then //*** Не менять позициями одинаковые интерфейсы if (j > MoveCount) then begin PrevInterfDat2 := InterfList2[MoveCount]; if InterfDat2.Kolvo <> PrevInterfDat2.Kolvo then begin InterfList2.Remove(InterfDat2); InterfList2.Insert(MoveCount, InterfDat2); MoveCount := MoveCount + 1; end; end; end; end; for j := 0 to InterfList2.Count - 1 do begin InterfDat2 := TSCSInterface(InterfList2.FItems.List^[j]); //InterfList2.Items[j]; if Not CheckInterfReadyByMultiple(InterfDat1) or Not CheckInterfReadyToConnect(InterfDat2, ASideCompon2) then Continue; ///// CONTINUE ///// EmptyPositions2 := nil; //if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then begin EmptyPositions2 := InterfDat2.GetEmptyPositions(AMaxInterfCountToConnect); if (EmptyPositions2.Kolvo = 0) and (InterfDat2.ComponentOwner.IsTemplate = biFalse) then begin FreeAndNil(EmptyPositions2); Continue; //// CONTINUE //// end; end; // Расширение инетрфейса шаблона if (EmptyPositions1.Kolvo = 0) then ExtendInterfPositions(InterfDat1, EmptyPositions1, EmptyPositions2.Kolvo); if (EmptyPositions2.Kolvo = 0) then ExtendInterfPositions(InterfDat2, EmptyPositions2, EmptyPositions1.Kolvo); //11.03.2009 if Not CheckInterfAccordInList(NoInterfAccordanceList, InterfDat1.ID_Interface, InterfDat2.ID_Interface, InterfDat1.IsLineCompon, InterfDat2.IsLineCompon) then begin CheckInterfRes := CheckInterfForUnion(InterfDat1, InterfDat2, FActiveForm, AComponent.ActiveForm, {ConnectKind, }AConnectType, @InterfCount1, @InterfCount2); if CheckInterfRes = chrSuccess then begin IntrfPosCountToConnect := EmptyPositions1.Kolvo; if EmptyPositions2.Kolvo < EmptyPositions1.Kolvo then IntrfPosCountToConnect := EmptyPositions2.Kolvo; //*** Если патч-корд, то проверить не подключен ли интерфейс, внутри компоненты, к // интерфейсу, что был использован при текущем сеансе if AConnectType = cntUnion then begin // Если в списках интерфейсов больше 2-х компонент, то проверям не подкл-ся ли патч-корд // всеми интерфейсами к одному компоненту if SelfIsCross and CheckInterfJoinedToInterfFromListAsInterfnal(InterfDat1, UsedInterfaces1, ConnectToUsed1, InterfDat2.ComponentOwner, ComponCountInInterfList2 > 1) then CheckInterfRes := chrFail else if ComponIsCross and CheckInterfJoinedToInterfFromListAsInterfnal(InterfDat2, UsedInterfaces2, ConnectToUsed2, InterfDat1.ComponentOwner, ComponCountInInterfList1 > 1) then CheckInterfRes := chrFail; end; if ASimulation = false then begin DefineIDComponRel; if CheckInterfRes = chrSuccess then begin TF_Main(ActiveForm).ConnectInterfacesWithAccordance(InterfDat1, InterfDat2, InterfCount1, InterfCount2, IDComponRel, AConnectType, EmptyPositions1, EmptyPositions2, AIsFinalConnection, InterfList1, InterfList2); //RegroupInterfPositionsToConnect(EmptyPositions1, EmptyPositions2); //TF_Main(ActiveForm).ConnectInterfaces(InterfDat1, InterfDat2, IDComponRel, // AConnectType, EmptyPositions1, EmptyPositions2, AIsFinalConnection); end; end; if CheckInterfRes = chrSuccess then begin //*** внести инфу о используемых инттерфейса в этом этапе(сеансе) подключений if Self.IsCrossComponent then AddInterfaceToUsed(InterfDat1, InterfDat2, UsedInterfaces1, ConnectToUsed1); if AComponent.IsCrossComponent then AddInterfaceToUsed(InterfDat2, InterfDat1, UsedInterfaces2, ConnectToUsed2); AddInterfComponentToList(InterfDat1, InterfComponents1); AddInterfComponentToList(InterfDat2, InterfComponents2); if ASimulation then begin InterfDat1.ServSimulateKolvoBusy := InterfDat1.ServSimulateKolvoBusy + (InterfCount1*IntrfPosCountToConnect); InterfDat2.ServSimulateKolvoBusy := InterfDat2.ServSimulateKolvoBusy + (InterfCount2*IntrfPosCountToConnect); //убираем паралельный интерфейс с другой стороны, если сторона не определена if ASideCompon1 = -1 then RemoveParallelInterfaceFromList(InterfDat1, InterfList1); if ASideCompon2 = -1 then RemoveParallelInterfaceFromList(InterfDat2, InterfList2); end; //*** Удалять интерфейс со списка, если в него не осталось свободных позиций if (ASimulation and (InterfDat1.Kolvo <= InterfDat1.ServSimulateKolvoBusy)) or (InterfDat1.Kolvo <= InterfDat1.KolvoBusy) or (TF_Main(InterfDat1.FComponentOwner.FActiveForm).GDBMode = bkNormBase) then begin InterfList1.Delete(i); AddInterfaceToUsedInProject(InterfDat1); end; if (ASimulation and (InterfDat2.Kolvo <= InterfDat2.ServSimulateKolvoBusy)) or (InterfDat2.Kolvo <= InterfDat2.KolvoBusy) or (TF_Main(InterfDat2.FComponentOwner.FActiveForm).GDBMode = bkNormBase) then begin InterfList2.Delete(j); AddInterfaceToUsedInProject(InterfDat2); end; CanWhile := true; CanConn := true; //ConnectInterfCount := ConnectInterfCount + 1; ConnectInterfCount := ConnectInterfCount + IntrfPosCountToConnect; if (AMaxInterfCountToConnect > 0) and (ConnectInterfCount >= AMaxInterfCountToConnect) then CanConnByInterf := false; if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); Break; //// BREAK //// end; end else if CheckInterfRes = chrFailInterfaces then begin {//11.03.2009 GetMem(ptrNoInterfAccord, SizeOf(TInterfaceAccordance)); ptrNoInterfAccord.IDInterface1 := InterfDat1.ID_Interface; ptrNoInterfAccord.IDInterface2 := InterfDat2.ID_Interface; ptrNoInterfAccord.IsLine1 := InterfDat1.IsLineCompon; ptrNoInterfAccord.IsLine2 := InterfDat2.IsLineCompon; NoInterfAccordanceList.Add(ptrNoInterfAccord); } end; end; if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); end; if EmptyPositions1 <> nil then FreeAndNil(EmptyPositions1); if Not CanConnByInterf then Break; //// BREAK //// if CanWhile then Break; end; if Not CanConnByInterf then Break; //// BREAK //// end; FreeList(NoInterfAccordanceList); end; //*** соединение емкостных интерфейсов if (AConnectType = cntComplect) and (Self.IsLine = biTrue) and (AComponent.IsLine = biTrue) then begin //*** для аксессуара кабельного канала должно быть подключение не емкостными интерфейсами if (ConnectInterfCount > 0) or ((Self.ComponentType.SysName <> ctsnCableChannelAccessory) and (AComponent.ComponentType.SysName <> ctsnCableChannelAccessory)) then if CheckCanalHaveCable(AComponent, ChannelInterface, CableInterface).CanHave then begin if ASimulation = false then begin {GUIDMaleInterface := ''; //*** Интерфейс Папа (комплектующей) CableInterface := AComponent.GetInterfaceByTypeAndGender([itConstructive], [gtMale], biTrue); if CableInterface <> nil then GUIDMaleInterface := CableInterface.GUIDInterface; //*** Интерфейс Мама (собственный) CanalInterface := Self.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, GUIDMaleInterface); if (CanalInterface = nil) and (GUIDMaleInterface <> '') then CanalInterface := Self.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, '', true); } if (ChannelInterface <> nil) and (CableInterface <> nil) then begin DefineIDComponRel; EmptyPositions1 := nil; EmptyPositions2 := nil; //29.10.2007 //if TF_Main(FActiveForm).GDBMode = bkProjectManager then // EmptyPositions1 := ChannelInterface.GetEmptyPositions; //if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then // EmptyPositions2 := CableInterface.GetEmptyPositions; TF_Main(ActiveForm).ConnectInterfaces(ChannelInterface, CableInterface, IDComponRel, AConnectType, EmptyPositions1, EmptyPositions2, AIsFinalConnection); if EmptyPositions1 <> nil then FreeAndNil(EmptyPositions1); if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); end; end; Inc(ConnectInterfCount); CanConn := true; end; //*** Выкинуть из списков интерфейсы, которые предназначены для сечения RemoveMultipleInterfaces(InterfList1); RemoveMultipleInterfaces(InterfList2); end; if Not CanConn then begin CanConn := ACanWithNoInterfaces; if Not ACanWithNoInterfaces and (ConnectInterfCount = 0) then begin CActionName := ''; case AConnectType of cntComplect: CActionName := cSCSComponent_Msg3_1; cntUnion: CActionName := cSCSComponent_Msg3_2; end; CaptNoPropertInterf := cSCSComponent_Msg4_3; if Not GUseVisibleInterfaces then CaptNoPropertInterf := cSCSComponent_Msg4_3_1; ShowMessageByType(0, smtNone, cSCSComponent_Msg4_1+' "'+AComponent.GetNameForVisible+'" '+cSCSComponent_Msg4_2+' '+CActionName+ ' "'+GetNameForVisible+'" '+CaptNoPropertInterf, ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; if ASimulation = false then begin if CanConn or ((AComponent.ComponentType.SysName = ctsnPatchCord) and (AConnectType = cntComplect)) then with TF_Main(ActiveForm) do begin CanConn := true; if AIDCompRel = -1 then begin DefineIDComponRel; Result.NewIDCompRel := IDComponRel; //AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := Result.NewIDCompRel; ptrCompRel.ID_Component := Self.ID; ptrCompRel.ID_Child := AComponent.ID; ptrCompRel.Kolvo := 1; ptrCompRel.ConnectType := AConnectType; ptrCompRel.SortID := 0; ptrCompRel.RelType := crtDirect; ptrCompRel.Fixed := biFalse; case AConnectType of cntComplect: begin FComplects.Add(ptrCompRel); AComponent.LinkToComlectRec := ptrCompRel; end; cntUnion: begin FConnections.Add(ptrCompRel); AddToJoined(AComponent); end; end; if AIsFinalConnection then case AConnectType of cntComplect: begin if FTreeViewNode <> nil then TF_Main(FActiveForm).DefineChildNodes(FTreeViewNode); //ptrComplect := GetComplectByIDChild(AComponent.ID); //if ptrComplect = nil then //begin ptrCompRel.SortID := GenNewCompRelSortID(FActiveForm, Self.ID); //end; //if FChildComplects.IndexOf(AComponent) = -1 then // FChildComplects.Add(AComponent); //AComponent.Parent := Self; AddToChild(AComponent); AComponent.IDCompRel := ptrCompRel.ID; //AComponent.SortID := ptrCompRel.SortID; //*** укомплектовать подкомплектующие if TF_Main(FActiveForm).GDBMode = bkNormBase then TF_Main(FActiveForm).SaveComplects(AComponent, Self.IDTopComponent); //Result.CompRel := ptrCompRel; if Assigned(Self.TreeViewNode) and Assigned(AComponent.TreeViewNode) then begin //TF_Main(ActiveForm).OnAddDeleteNode(AComponent.TreeViewNode, AComponent, false); try TF_Main(FActiveForm).MoveNodeTo(AComponent.TreeViewNode, Self.TreeViewNode, naAddChild); PObjectData(AComponent.TreeViewNode.Data).ComponKind := ckCompl; PObjectData(AComponent.TreeViewNode.Data).ID_CompRel := AComponent.IDCompRel; finally TF_Main(FActiveForm).OnAddDeleteNode(AComponent.TreeViewNode, AComponent, nil, true); end; end; if Assigned(AComponent.TreeViewNode) then begin PObjectData(AComponent.TreeViewNode.Data).ID_CompRel := ptrCompRel.ID; PObjectData(AComponent.TreeViewNode.Data).ComponKind := ckCompl; SetSortID(AComponent.TreeViewNode, AComponent); end; F_ChoiceConnectSide.OnAfterConnectCompons(Self, AComponent); end; cntUnion: begin //AddToJoined(AComponent); F_ChoiceConnectSide.OnAfterJoinCompons(Self, AComponent, ASideCompon1, ASideCompon2); end; end; Result.CompRel := ptrCompRel; end else begin ptrCompRel := GetComplectByID(AIDCompRel); if ptrCompRel <> nil then if AConnectType = cntComplect then begin Result.CompRel := ptrCompRel; Inc(ptrCompRel.Kolvo); if (TF_Main(FActiveForm).GDBMode = bkNormBase) and AIsFinalConnection then TF_Main(FActiveForm).DM.UpdateCompRelFieldAsInteger(ptrCompRel.ID, ptrCompRel.Kolvo, fnKolvo); end; end; {if AConnectType = cntComplect then if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(AComponent.FActiveForm).GDBMode = bkNormBase) then SetChildComponInterfacesToNoBusy(Self, AComponent, IDComponRel);} NotifyChange; end else if (AIDCompRel = -1) and (IDComponRel <> -1) then if FQueryMode = qmPhisical then TF_Main(FActiveForm).DM.DeleteCompRelByID(IDComponRel); end; Result.CanConnect := CanConn; Result.ConnectInterfCount := ConnectInterfCount; Result.Compon1Count := InterfComponents1.Count; Result.Compon2Count := InterfComponents2.Count; Result.ComponObj1 := Self; Result.ComponObj2 := AComponent; finally if InterfComponents1 <> nil then FreeAndNil(InterfComponents1); if InterfComponents2 <> nil then FreeAndNil(InterfComponents2); FreeAndNil(InterfList1); FreeAndNil(InterfList2); FreeAndNil(UsedInterfaces1); FreeAndNil(UsedInterfaces2); FreeAndNil(ConnectToUsed1); FreeAndNil(ConnectToUsed2); end; except on E: Exception do AddExceptionToLog('TSCSComponent.ConnectWith: '+E.Message); end; end; function TSCSComponent.ComplectWith(AChildComponent: TSCSComponent; AIDCompRel: Integer = -1; ACanWithNoInterfaces: Boolean = false; ACanWithNoParams: Boolean = false): PComplect; var ConnectInterfRes: TConnectInterfRes; begin Result := nil; //if TF_Main(AChildComponent.FActiveForm).GDBMode = bkNormBase then // SetComponInterfacesToNoBusy ConnectInterfRes := ConnectWith(AChildComponent, -1, -1, AIDCompRel, -1, cntComplect, false, true, ACanWithNoInterfaces, ACanWithNoParams); Result := ConnectInterfRes.CompRel; end; function TSCSComponent.ConnectWithOnlyObject(AComponent: TSCSComponent; AConnectType: TConnectType): PComplect; var ComponList: TList; ptrComplect: PComplect; begin Result := nil; ComponList := nil; case AConnectType of cntComplect: ComponList := Complects; cntUnion: begin ComponList := Connections; AddToJoined(AComponent); end; end; if Assigned(ComponList) then begin GetMem(ptrComplect, SizeOf(TComplect)); ptrComplect.ID_Component := ID; ptrComplect.ID_Child := AComponent.ID; ptrComplect.Kolvo := 1; ptrComplect.ConnectType := AConnectType; ComponList.Add(ptrComplect); Result := ptrComplect; end; end; function TSCSComponent.ComplectWithOnlyObject(AChildComponent: TSCSComponent): PComplect; begin Result := nil; Result := ConnectWithOnlyObject(AChildComponent, cntComplect); end; procedure TSCSComponent.DefineComplectsLinks; var ptrComplect: PComplect; ComplectCompon: TSCSComponent; LookedComplects: TList; i, j: Integer; begin LookedComplects := TList.Create; for i := 0 to FChildComplects.Count - 1 do begin ComplectCompon := FChildComplects[i]; for j := 0 to FComplects.Count - 1 do begin ptrComplect := FComplects[j]; if LookedComplects.IndexOf(ptrComplect) = -1 then if ptrComplect.ID_Child = ComplectCompon.ID then begin ComplectCompon.ServCopyIndex := ptrComplect.ServCopyIndex; ComplectCompon.IDCompRel := ptrComplect.ID; ComplectCompon.Count := ptrComplect.Kolvo; ComplectCompon.LinkToComlectRec := ptrComplect; LookedComplects.Add(ptrComplect); Break; ///// BREAK ///// end; end; end; LookedComplects.Free; end; function TSCSComponent.DefinedComponByPortMultiport: TSCSComponent; var ParentCompon: TSCSComponent; begin Result := Self; ParentCompon := Self; while ParentCompon <> nil do begin //ParentCompon.LoadComponentType; if ParentCompon.ComponentType.PortKind = pkMultiport then begin Result := ParentCompon; Break; ///// BREAK ///// end; ParentCompon := ParentCompon.GetParentComponent; end; end; procedure TSCSComponent.DefineFirstLastInNet; var i: Integer; ptrJoinedComponents: PJoinedComponents; FirstObject, LastObject: TSCSCatalog; FirstInterfCount, LastInterfCount: Integer; begin {for i := 0 to FNet.Count - 1 do begin ptrJoinedComponents := FNet[i]; if ptrJoinedComponents.f FirstObject := LsastObject end;} end; procedure TSCSComponent.DefineIDComRelChildCompons; var i: Integer; ChildCompon: TSCSComponent; ptrComplect: PComplect; begin for i := 0 to FChildComplects.Count - 1 do if Assigned(FChildComplects[i]) then begin ChildCompon := FChildComplects[i]; ptrComplect := ChildCompon.LinkToComlectRec; //GetComplectByIDChild(ChildCompon.ID); if ptrComplect <> nil then ChildCompon.IDCompRel := ptrComplect.ID; end; end; procedure TSCSComponent.DefineIDsBeforeSaveAsNew{(AParentComponent: TSCSComponent; ALastTablesIDs: PTablesID; var ALastNppPort, AStepIndex: Integer)}; var LastTablesIDs: TTablesID; TopComponent: TSCSComponent; DBMode: TDBKind; LastNppPort, StepIndex, ValueIndex: Integer; CompPropRelOldIDs, CompPropRelNewIDs: TIntList; procedure DefineCompRelsForNB(AChildComponent: TSCSComponent); var i: Integer; CompRel: PComplect; begin if AChildComponent.LinkToComlectRec = nil then if AChildComponent.FParent is TSCSComponent then TSCSComponent(AChildComponent.FParent).DefineComplectsLinks; for i := 0 to AChildComponent.Complects.Count - 1 do begin CompRel := AChildComponent.Complects[i]; CompRel.IDTopComponent := Self.NewID; Inc(LastTablesIDs.IDCompRel); CompRel.NewID := LastTablesIDs.IDCompRel; end; for i := 0 to AChildComponent.ChildComplects.Count - 1 do DefineCompRelsForNB(AChildComponent.ChildComplects[i]); end; procedure StepDefine(AComponent: TSCSComponent; var ALastNppPort, AStepIndex: Integer); var i, j, k: integer; ptrComplect, ptrConnection: PComplect; Interfac, Port, ptrParentInterface, ptrParallelInterface, JoinedInterface: TSCSInterface; IOfIRel: TSCSIOfIRel; ptrPortInterfRel: PPortInterfRel; ParentIOfIRel: TSCSIOfIRel; ptrProperty: PProperty; ParentComponent, SCSComplect, JoinedComponent: TSCSComponent; CurrNppPort, IDJoined, OldIOfIRelCount: Integer; WasBreak: Boolean; ptrCrossConnection: TSCSCrossConnection; IsJoinedFromSelf, WasFreeIOfIRel: Boolean; begin ParentComponent := nil; ParentComponent := AComponent.GetParentComponent; if ParentComponent = AComponent then ParentComponent := nil; CurrNppPort := 0; //*** Определить стартовый номер порта if AComponent.IsLine = biFalse then if AComponent.ComponentType.PortKind = pkPort then CurrNppPort := ALastNppPort; //*** определить ID для component_Relation в первую очередь for i := 0 to AComponent.FComplects.Count - 1 do begin ptrComplect := AComponent.FComplects[i]; if ptrComplect <> nil then begin Inc(LastTablesIDs.IDCompRel); ptrComplect.NewID := LastTablesIDs.IDCompRel; ptrComplect.ID_NewComponent := AComponent.NewID; if TF_Main(FActiveForm).GDBMode = bkNormBase then ptrComplect.ID_NewChild := ptrComplect.ID_Child; end; end; { //*** Обработка комплектующих - ТЕЛО РЕКУРСИИ for i := 0 to FChildComplects.Count - 1 do begin SCSComplect := FChildComplects[i]; ptrComplect := SCSComplect.LinkToComlectRec; if ptrComplect = nil then ptrComplect := GetComplectByIDChild(SCSComplect.ID); if ptrComplect <> nil then begin Inc(LastTablesIDs.IDComponent); SCSComplect.NewID := LastTablesIDs.IDComponent; ptrComplect.ID_NewChild := LastTablesIDs.IDComponent; ptrComplect.ID_NewComponent := Self.NewID; Inc(AStepIndex); SCSComplect.DefineIDsBeforeSaveAsNew(Self, LastTablesIDs, CurrNppPort, AStepIndex); Dec(AStepIndex); Inc(LastTablesIDs.IDCompRel); ptrComplect.NewID := LastTablesIDs.IDCompRel; end; end; KolComplect := FChildComplects.Count; } // Определяем ID свойств for i := 0 to AComponent.FProperties.Count - 1 do begin ptrProperty := PProperty(AComponent.FProperties.List^[i]); if ptrProperty.SysName = pnDesignUnitPos then ptrProperty.Value := '0'; LastTablesIDs.IDCompPropRel := LastTablesIDs.IDCompPropRel + 1; ValueIndex := InsertValueToSortetIntList(ptrProperty.ID, CompPropRelOldIDs); CompPropRelNewIDs.Insert(ValueIndex, LastTablesIDs.IDCompPropRel); end; // ***** Т Е Л О //*** Обработка комплектующих - ТЕЛО РЕКУРСИИ if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin for i := 0 to AComponent.FChildComplects.Count - 1 do begin SCSComplect := AComponent.FChildComplects[i]; if SCSComplect.LinkToComlectRec = nil then AComponent.DefineComplectsLinks; ptrComplect := SCSComplect.LinkToComlectRec; if ptrComplect = nil then ptrComplect := AComponent.GetComplectByIDChild(SCSComplect.ID); if ptrComplect <> nil then begin Inc(LastTablesIDs.IDComponent); SCSComplect.NewID := LastTablesIDs.IDComponent; ptrComplect.ID_NewChild := LastTablesIDs.IDComponent; ptrComplect.ID_NewComponent := AComponent.NewID; Inc(AStepIndex); StepDefine(SCSComplect, CurrNppPort, AStepIndex); //SCSComplect.DefineIDsBeforeSaveAsNew(Self, LastTablesIDs, CurrNppPort, AStepIndex); Dec(AStepIndex); //Inc(LastTablesIDs.IDCompRel); //ptrComplect.NewID := LastTablesIDs.IDCompRel; end; end; end else //*** Для НБ определить ID подкомплектующих if TF_Main(FActiveForm).GDBMode = bkNormBase then begin for i := 0 to AComponent.FChildComplects.Count - 1 do DefineCompRelsForNB(AComponent.FChildComplects[i]); //*** Новый GUID Для НБ AComponent.GuidNB := CreateGUID; end; ////*** определить IВ для component_Relation // for i := 0 to AComponent.FComplects.Count - 1 do // begin // ptrComplect := AComponent.FComplects[i]; // if ptrComplect <> nil then // begin // Inc(LastTablesIDs.IDCompRel); // ptrComplect.NewID := LastTablesIDs.IDCompRel; // ptrComplect.ID_NewComponent := AComponent.NewID; // if TF_Main(FActiveForm).GDBMode = bkNormBase then // ptrComplect.ID_NewChild := ptrComplect.ID_Child; // end; // end; //*** Оставить только внутренние соединения for i := 0 to AComponent.FConnections.Count - 1 do begin ptrConnection := AComponent.FConnections[i]; IDJoined := 0; JoinedComponent := nil; IsJoinedFromSelf := false; if ptrConnection.ID_Child = AComponent.ID then begin IDJoined := ptrConnection.ID_Component; IsJoinedFromSelf := false; end else if ptrConnection.ID_Component = AComponent.ID then begin IDJoined := ptrConnection.ID_Child; IsJoinedFromSelf := true; end; if IDJoined > 0 then begin /// найти подкюченный компонент по старому ID JoinedComponent := TopComponent.GetComponentFromReferences(IDJoined); //*** Если внутренние соединение if JoinedComponent <> nil then begin Inc(LastTablesIDs.IDCompRel); ptrConnection.NewID := LastTablesIDs.IDCompRel; end; {//*** Если внутренние соединение if JoinedComponent <> nil then begin Inc(LastTablesIDs.IDCompRel); ptrConnection.NewID := LastTablesIDs.IDCompRel; if IsJoinedFromSelf then begin ptrConnection.ID_NewComponent := AComponent.NewID; ptrConnection.ID_NewChild := JoinedComponent.NewID; end else begin ptrConnection.ID_NewComponent := JoinedComponent.NewID; ptrConnection.ID_NewChild := AComponent.NewID; end; AComponent.AddToJoined(JoinedComponent); end;} end; if (IDJoined = 0) or (JoinedComponent = nil) then begin FreeMem(ptrConnection); AComponent.FConnections[i] := nil; end; end; AComponent.FConnections.Pack; if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then AComponent.KolComplect := AComponent.FChildComplects.Count; //*** Обработка интерфейсов for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces[i]; Inc(LastTablesIDs.IDInterfRel); Interfac.NewID := LastTablesIDs.IDInterfRel; if Assigned(Interfac.IOfIRelOut) then begin j := 0; while j <= Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); IOfIRel.NewIDInterfRel := Interfac.NewID; WasFreeIOfIRel := false; // Поля : // ptrIOfIRel.NewIDInterfTo; ptrIOfIRel.NewIDCompon; ptrIOfIRel.NewIDChild // должны определиться сохраненной выше комплектующей //*** Определить поле ptrIOfIRel.IDCompRel if Interfac.TypeI = itConstructive then for k := 0 to AComponent.FComplects.Count - 1 do begin ptrComplect := AComponent.FComplects[k]; if ((ptrComplect.ID_NewChild = IOfIRel.NewIDChild) and (DBMode = bkProjectManager)) or ((ptrComplect.ID = IOfIRel.IDCompRel) and (DBMode = bkNormBase)) then begin IOfIRel.IDCompRel := ptrComplect.NewID; Break; ///// BREAK ///// end; end; //*** Выкинуть подключение интерфейсов, если это не внутрикомпонентное if Interfac.TypeI = itFunctional then begin ptrConnection := GetComponConnectionByID(AComponent, IOfIRel.IDCompRel); {ptrConnection := nil; for k := 0 to AComponent.FConnections.Count - 1 do if PComplect(AComponent.FConnections[k]).ID = IOfIRel.IDCompRel then begin ptrConnection := AComponent.FConnections[k]; Break; //// BREAK //// end;} if ptrConnection = nil then begin Interfac.FreeIOfIRel(IOfIRel); WasFreeIOfIRel := true; end; end; if Not WasFreeIOfIRel then begin Inc(LastTablesIDs.IDInterfOfInterfRel); IOfIRel.NewID := LastTablesIDs.IDInterfOfInterfRel; Inc(j); end; end; Interfac.IOfIRelOut.Pack; end; if Interfac.KolvoBusy > 0 then begin IOfIRel := TopComponent.GetIOfIRelByInterfaceOwnerOrTo(Interfac, true); //*** Есть внутрикомпонентное подключение if IOfIRel = nil then begin Interfac.IsBusy := biFalse; Interfac.KolvoBusy := 0; end; end; //*** Если интерфейс связян с интерфейсом компоненты на уровень выше, то // установить связь интерфейса высшей компоненты на текущий интерфейс if Interfac.TypeI = itConstructive then begin if Assigned(ParentComponent) then for j := 0 to ParentComponent.Interfaces.Count - 1 do begin ptrParentInterface := ParentComponent.Interfaces[j]; WasBreak := false; if ptrParentInterface.TypeI = itConstructive then if Assigned(ptrParentInterface.IOfIRelOut) then for k := 0 to ptrParentInterface.IOfIRelOut.Count - 1 do begin ParentIOfIRel := TSCSIOfIRel(ptrParentInterface.IOfIRelOut[k]); if ParentIOfIRel.NewIDInterfTo = 0 then if ParentIOfIRel.IDInterfTo = Interfac.ID then begin ParentIOfIRel.NewIDInterfTo := Interfac.NewID; ParentIOfIRel.NewIDCompon := ParentComponent.NewID; ParentIOfIRel.NewIDChild := AComponent.NewID; ParentIOfIRel.InterfaceTo := Interfac; if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin Interfac.IsBusy := biTrue; Interfac.AddToConnectedInterfaces(ptrParentInterface); ptrParentInterface.AddToConnectedInterfaces(Interfac); ptrParentInterface.IsBusy := biTrue; if ptrParentInterface.KolvoBusy = 0 then Inc(ptrParentInterface.KolvoBusy); end; WasBreak := true; Break; ///// BREAK ///// end; if WasBreak then Break; ///// BREAK ///// end; if WasBreak then Break; ///// BREAK ///// end; end; //*** Если в интерфейса нет связянных интерфейсов, то он не м.б занят if AStepIndex = 0 then if Interfac.TypeI = itConstructive then if Interfac.IsBusy = biTrue then if (Not Assigned(Interfac.IOfIRelOut)) or (Assigned(Interfac.IOfIRelOut) and (Interfac.IOfIRelOut.Count = 0)) then Interfac.IsBusy := biFalse; //*** Увеличение значения порта if AComponent.IsLine = biFalse then if (Interfac.IsPort = biTrue) and (Interfac.IsUserPort = biFalse) then begin Inc(CurrNppPort); Interfac.NppPort := CurrNppPort; CurrNppPort := CurrNppPort + Interfac.Kolvo - 1; end; end; if AComponent.IsLine = biTrue then //*** противоположные интерфейсы for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces[i]; //*** противоположный интерфейс if AComponent.IsLine = biTrue then for j := 0 to AComponent.FInterfaces.Count - 1 do begin ptrParallelInterface := AComponent.FInterfaces[j]; if (Interfac.IDAdverse = ptrParallelInterface.ID) and (ptrParallelInterface.IDAdverse = Interfac.ID) then begin Interfac.NewIDAdverse := ptrParallelInterface.NewID; ptrParallelInterface.NewIDAdverse := Interfac.NewID; Interfac.ParallelInterface := ptrParallelInterface; ptrParallelInterface.ParallelInterface := Interfac; end; end; end; //*** Связи портов с интерфейсами for i := 0 to AComponent.FInterfaces.Count - 1 do begin Port := AComponent.FInterfaces[i]; //if Port.IsPort = biTrue then ##ISPORT for j := 0 to Port.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Port.FPortInterfRels[j]; ptrPortInterfRel.IDPort := Port.NewID; Interfac := AComponent.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if Assigned(Interfac) then ptrPortInterfRel.IDInterfRel := Interfac.NewID; end; end; //*** Информация о кросс-соединениях for i := 0 to AComponent.FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(AComponent.FCrossConnections[i]); ptrCrossConnection.IDComponent := AComponent.NewID; //if TF_Main(FActiveForm).GDBMode = bkProjectManager then AComponent.DefineCrossConnectionParamsBeforeSaveAsNew(ptrCrossConnection); end; //*** Передать стартовый номер порта дальше if AComponent.IsLine = biFalse then if AComponent.ComponentType.PortKind = pkPort then ALastNppPort := CurrNppPort; end; //*** связывает подключения и интерфейсы которые касаются внутрикомпонентного подключения procedure SetIDsToInternalConnections(AComponent: TSCSComponent); var i, j, k: Integer; ChildComponent, JoinedComponent: TSCSComponent; ptrConnection: PComplect; IDJoined: Integer; IsJoinedFromSelf: Boolean; Interfac, JoinedInterface: TSCSInterface; IOfIRel: TSCSIOfIRel; begin //*** Обработка комплектующих - ТЕЛО РЕКУРСИИ if TF_Main(FActiveForm).GDBMode = bkProjectManager then for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildComponent := AComponent.ChildComplects[i]; SetIDsToInternalConnections(ChildComponent); end; //*** Обработать внутри компонентные соединения for i := 0 to AComponent.FConnections.Count - 1 do begin ptrConnection := AComponent.FConnections[i]; IDJoined := 0; JoinedComponent := nil; IsJoinedFromSelf := false; if ptrConnection.ID_Child = AComponent.ID then begin IDJoined := ptrConnection.ID_Component; IsJoinedFromSelf := false; end else if ptrConnection.ID_Component = AComponent.ID then begin IDJoined := ptrConnection.ID_Child; IsJoinedFromSelf := true; end; if IDJoined > 0 then begin JoinedComponent := TopComponent.GetComponentFromReferences(IDJoined); //*** Если внутренние соединение if JoinedComponent <> nil then begin if IsJoinedFromSelf then begin ptrConnection.ID_NewComponent := AComponent.NewID; ptrConnection.ID_NewChild := JoinedComponent.NewID; end else begin ptrConnection.ID_NewComponent := JoinedComponent.NewID; ptrConnection.ID_NewChild := AComponent.NewID; end; AComponent.AddToJoined(JoinedComponent); end; end; end; //*** связка функциональных интерфейсов for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces[i]; for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); IOfIRel.NewIDInterfRel := Interfac.NewID; if Interfac.TypeI = itFunctional then begin //*** Найти подключение? связанное с интерфейсами IOfIRel ptrConnection := GetComponConnectionByID(AComponent, IOfIRel.IDCompRel); {for k := 0 to AComponent.FConnections.Count - 1 do if PComplect(AComponent.FConnections[k]).ID = IOfIRel.IDCompRel then begin ptrConnection := AComponent.FConnections[k]; Break; //// BREAK //// end; } if ptrConnection <> nil then begin IOfIRel.IDCompRel := ptrConnection.NewID; JoinedInterface := TopComponent.GetInterfaceByID(IOfIRel.IDInterfTo, true); if JoinedInterface <> nil then begin IOfIRel.NewIDInterfTo := JoinedInterface.NewID; IOfIRel.InterfaceTo := JoinedInterface; Interfac.AddToConnectedInterfaces(JoinedInterface); JoinedInterface.AddToConnectedInterfaces(Interfac); for k := 0 to IOfIRel.FPosConnections.Count - 1 do SetLinkToInterfPosConnection(TSCSInterfPosConnection(IOfIRel.FPosConnections[k]), Interfac, JoinedInterface); end; end; end; end; end; end; procedure SetNewIDsToCompRels(AComponent: TSCSComponent; ACompRels: TList); var ptrCompRel: PComplect; i: Integer; begin for i := 0 to ACompRels.Count - 1 do begin ptrCompRel := ACompRels[i]; if ptrCompRel.NewID > 0 then ptrCompRel.ID := ptrCompRel.NewID; if ptrCompRel.ID_NewChild > 0 then ptrCompRel.ID_Child := ptrCompRel.ID_NewChild; if ptrCompRel.ID_NewComponent > 0 then ptrCompRel.ID_Component := ptrCompRel.ID_NewComponent; ptrCompRel.IDParentCompRel := 0; if TF_Main(FActiveForm).GDBMode = bkNormBase then begin ptrCompRel.IDTopComponent := NewID; if AComponent.LinkToComlectRec <> nil then ptrCompRel.IDParentCompRel := AComponent.LinkToComlectRec.NewID; end; end; end; procedure SetNewIDs(AComponent: TSCSComponent; AStepIndex: Integer); var i, j: Integer; ChildComponent: TSCSComponent; ptrProperty: PProperty; ResourceRel: TSCSResourceRel; NormRel: TSCSNorm; Interfac: TSCSInterface; IOfIRel: TSCSIOfIRel; NewObjectID: Integer; begin //*** Обработка комплектующих - ТЕЛО РЕКУРСИИ if TF_Main(FActiveForm).GDBMode = bkProjectManager then for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildComponent := AComponent.ChildComplects[i]; SetNewIDs(ChildComponent, AStepIndex+1); end; //*** Переброс ID-в **** //************************ //*** Свойства for i := 0 to AComponent.FProperties.Count - 1 do begin ptrProperty := AComponent.FProperties[i]; ptrProperty.IDMaster := AComponent.NewID; end; // Ресурсы for i := 0 to AComponent.FNormsResources.FResources.Count - 1 do begin ResourceRel := TSCSResourceRel(AComponent.FNormsResources.FResources.List.List^[i]); if ResourceRel.IDCompPropRel <> 0 then begin NewObjectID := 0; ValueIndex := GetValueIndexFromSortedIntList(ResourceRel.IDCompPropRel, CompPropRelOldIDs); if ValueIndex <> -1 then NewObjectID := CompPropRelNewIDs[ValueIndex]; ResourceRel.IDCompPropRel := NewObjectID; end; end; // Нормы for i := 0 to AComponent.FNormsResources.FNorms.Count - 1 do begin NormRel := TSCSNorm(AComponent.FNormsResources.FNorms.List.List^[i]); if NormRel.IDCompPropRel <> 0 then begin NewObjectID := 0; ValueIndex := GetValueIndexFromSortedIntList(NormRel.IDCompPropRel, CompPropRelOldIDs); if ValueIndex <> -1 then NewObjectID := CompPropRelNewIDs[ValueIndex]; NormRel.IDCompPropRel := NewObjectID; end; end; //*** Интерфейсы for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces[i]; Interfac.ID := Interfac.NewID; Interfac.ID_Component := AComponent.NewID; if Interfac.IDAdverse > 0 then Interfac.IDAdverse := Interfac.NewIDAdverse; if Assigned(Interfac.IOfIRelOut) then for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); IOfIRel.ID := IOfIRel.NewID; //if IOfIRel.NewIDInterfRel <= 0 then // IOfIRel.NewIDInterfRel := IOfIRel.IDInterfRel; if IOfIRel.IDInterfRel <> IOfIRel.NewIDInterfRel then IOfIRel.IDInterfRel := IOfIRel.NewIDInterfRel else if IOfIRel.InterfaceOwner <> nil then IOfIRel.IDInterfRel := IOfIRel.InterfaceOwner.NewID; if IOfIRel.NewIDInterfTo <> 0 then if IOfIRel.IDInterfTo <> IOfIRel.NewIDInterfTo then IOfIRel.IDInterfTo := IOfIRel.NewIDInterfTo else if IOfIRel.InterfaceTo <> nil then IOfIRel.IDInterfTo := IOfIRel.InterfaceTo.NewID; //*** Определить не определенные связи позициями DefineNoExistsInterfPosConnection(IOfIRel); end; end; //*** Комлектующие SetNewIDsToCompRels(AComponent, AComponent.FComplects); AComponent.DefineIDComRelChildCompons; //*** Соединения SetNewIDsToCompRels(AComponent, AComponent.FConnections); end; begin TopComponent := Self; DBMode := TF_Main(FActiveForm).GDBMode; //*** Определение полследних сгенерированных ID-в ZeroMemory(@LastTablesIDs, SizeOf(LastTablesIDs)); LastTablesIDs.IDComponent := GetLastComponentID(DBMode); LastTablesIDs.IDCompRel := GetLastCompRelID(DBMode); LastTablesIDs.IDInterfRel := GetLastInterfRelID(DBMode); LastTablesIDs.IDInterfOfInterfRel := GetLastInterfOfInterfRelID(DBMode); LastTablesIDs.IDCompPropRel := GetLastCompPropRelID(DBMode); CompPropRelOldIDs := TIntList.Create; CompPropRelNewIDs := TIntList.Create; Inc(LastTablesIDs.IDComponent); Self.NewID := LastTablesIDs.IDComponent; LastNppPort := 0; StepIndex := 0; //*** Определит новые ID StepDefine(Self, LastNppPort, StepIndex); //*** Связать новымие на внутрикомпонентных подключениях SetIDsToInternalConnections(Self); //*** Перекинуть поля NewID в ID SetNewIDs(Self, 0); DefineNppInterfaces; FreeAndNil(CompPropRelOldIDs); FreeAndNil(CompPropRelNewIDs); end; procedure TSCSComponent.DefineInterfaceNorms(ACanHaveActiveComponents: Boolean); var i, j, k, l, m : Integer; Norm: TSCSNorm; MaxNpp, UserNormCount: Integer; UseNormsFromInterfaces, CanUseComponBySignType: Boolean; //*** Добвать нормы из интерфейсов LookedInterfaces: TSCSInterfaces; //InterfaceNormList: TList; CurrInterfaceNormList, TempList, TempList1: TList; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; TraceLength: Double; Interfac, JoinedInterf, ComplectInterf, ResultInterface, ResulationInterface: TSCSInterface; IOfIRel: TSCSIOfIRel; SprNorm: TNBNorm; ptrInterfaceNormInfo, ptrInterfaceNormInfoI, ptrInterfaceNormInfoJ: PInterfaceNormInfo; NormPreyscurant: TSCSNormPreyscurant; InterfNormList: TList; SelfSignType, InterFaceId: Integer; // Tolik -- 14/06/2016 -- FirstCableTracing, CanSaveNorm: Boolean; TempptrInterfaceNormInfo: PInterfaceNormInfo; CanTakeFirstCableNorm, CanTakeNextCableNorm, CanDeleteNorm, CanAddNorm, FirstCableNormAdded, CanUseFirstCableNorm: Boolean; // begin if TF_Main(FActiveForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// // Tolik -- 14/06/2016 -- FirstCableTracing := True; CanTakeFirstCableNorm := False; CanTakeNextCableNorm := True;// False; FirstCableNormAdded := False; CanUseFirstCableNorm := False; InterFaceId := -1; //Tolik 08/02/2017 -- CurrInterfaceNormList := nil; // SelfSignType := GetPropertyValueAsInteger(pnSignType); CanUseComponBySignType := (SelfSignType = oitProjectible) or ACanHaveActiveComponents; UseNormsFromInterfaces := true; if FProjectOwner <> nil then UseNormsFromInterfaces := FProjectOwner.Setting.UseNormsFromInterfaces; //*** Определить длину трассы SCSComponent := Self; TraceLength := 0; if SCSComponent.IsLine = biTrue then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.Length := SCSComponent.GetPropertyValueAsFloat(pnLength); TraceLength := SCSComponent.GetPartLength; end; //*** Удалить активные нормы пришедшие с интерфейсов MaxNpp := 0; UserNormCount := 0; for i := 0 to FNormsResources.FNorms.Count - 1 do begin Norm := FNormsResources.FNorms[i]; //*** Очитить ранее использованные прейскуранты Norm.FPreyscurants.Clear; if (Norm.IsFromInterface = biTrue) and ((Norm.IsOn = biTrue) and (Norm.ExpenseForLength = 0) {and (Norm.ExpenseForSection = 0)}) then begin FreeAndNil(Norm); FNormsResources.FNorms[i] := nil; end else begin if Norm.NPP > MaxNpp then MaxNpp := Norm.NPP; //*** Подсчет пользовательских норм if Norm.IsFromInterface = biFalse then Inc(UserNormCount); end; end; FNormsResources.FNorms.Pack; //*** Отключить оставшие нормы, пришедшие из интерфейсов, если присутствуют пользовательские и // установлен флаг UseNormsFromInterfaces - "Использовать нормы интерфейсов для компонент с пользовательскими нормами" if Not UseNormsFromInterfaces and (UserNormCount > 0) then for i := 0 to FNormsResources.FNorms.Count - 1 do begin Norm := FNormsResources.FNorms[i]; if Norm.IsFromInterface = biTrue then Norm.IsOn := biFalse; end; LookedInterfaces := TSCSInterfaces.Create(false); InterfNormList := TList.Create; try SCSComponent.NormsResources.CalcResourcesCost(true, true); if Assigned(SCSComponent) and (UseNormsFromInterfaces or (UserNormCount = 0)) then if GUseVisibleInterfaces then begin for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[j]; if LookedInterfaces.IndexOf(Interfac) = -1 then begin // Tolik -- 08/02/2017 -- // CurrInterfaceNormList := nil; if CurrInterfaceNormList <> nil then FreeAndNil(CurrInterfaceNormList); // //*** Получить список норм касающих интерфейса case Interfac.TypeI of itFunctional: begin if CanUseComponBySignType and Assigned(Interfac.ConnectedInterfaces) then for k := 0 to Interfac.ConnectedInterfaces.Count - 1 do begin JoinedInterf := Interfac.ConnectedInterfaces[k]; ResultInterface := nil; ResulationInterface := nil; if JoinedInterf <> nil then begin //*** соединение лин.-точ. if {((Interfac.IsLineCompon = biFalse) and (ptrJoinedInterf.IsLineCompon = biTrue)) or} ((Interfac.IsLineCompon = biTrue) and (JoinedInterf.IsLineCompon = biFalse)) then begin if Interfac.Gender = gtMale then ResultInterface := Interfac; if JoinedInterf.Gender = gtMale then ResultInterface := JoinedInterf; //*** Если интерфейс не занят, то его не берем if ResultInterface <> nil then if ResultInterface.IsBusy = biFalse then ResultInterface := nil; end; //*** соединение лин.-лин. if (Interfac.IsLineCompon = biTrue) and (JoinedInterf.IsLineCompon = biTrue) then begin //*** Если не цельный кабель if SCSComponent.Whole_ID <> TSCSComponent(JoinedInterf.ComponentOwner).Whole_ID then begin if Interfac.Gender = gtMale then ResultInterface := Interfac; if JoinedInterf.Gender = gtMale then ResultInterface := JoinedInterf; //*** Если интерфейс не занят, то его не берем if ResultInterface <> nil then if ResultInterface.IsBusy = biFalse then ResultInterface := nil; end; end; if ResultInterface <> nil then begin if ResultInterface = JoinedInterf then ResulationInterface := Interfac else if ResultInterface = Interfac then ResulationInterface := JoinedInterf; CurrInterfaceNormList := GetInterfaceNormInfo(ResultInterface); //*** Найдены нормы if CurrInterfaceNormList.Count > 0 then begin //*** Указать компоненты, к которым применяются данные норме // В первом поле приоритет на линейный компонент for l := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[l]; ptrInterfaceNormInfo.SCSComponent := ResultInterface.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := ResulationInterface.ComponentOwner; ptrInterfaceNormInfo.Guid_Interface := ResultInterface.GUIDInterface; if (TSCSComponent(ptrInterfaceNormInfo.SCSComponent).IsLine = biFalse) and (TSCSComponent(ptrInterfaceNormInfo.RelationComponent).IsLine = biTrue) then ExchangeObjects(ptrInterfaceNormInfo.SCSComponent, ptrInterfaceNormInfo.RelationComponent); end; LookedInterfaces.Assign(Interfac.ConnectedInterfaces, laOr); Break; ///// BREAK ///// end; end; end; end; end; itConstructive: case SCSComponent.IsLine of biTrue: //*** Для лин. компоненты begin // Мама - занят, берем иннтерфейсы мамы для каждой комплект-й папы if Interfac.Gender = gtFemale then begin //02.04.2013 if (Interfac.IsBusy = biFalse) and (Interfac.IOfIRelOut.Count > 0) then Interfac.DefineIsBusy; if Interfac.IsBusy = biTrue then // Tolik //if Assigned(Interfac.IOfIRelOut) then if (Assigned(Interfac.IOfIRelOut) and (Interfac.IOfIRelOut.Count > 0)) then // begin CanDeleteNorm := True; CanTakeFirstCableNorm := False; for k := 0 to Interfac.IOfIRelOut.Count - 1 do // нормы на кабелях begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[k]); ComplectInterf := IOfIRel.InterfaceTo; //*** интерфейс комплектующей папа (кабель) if (ComplectInterf <> nil) and (ComplectInterf.Gender = gtMale) then begin if (ComplectInterf.ComponentOwner.GetPropertyValueAsInteger(pnSignType) = oitProjectible) or ACanHaveActiveComponents then TempList1 := GetInterfaceNormInfo(ComplectInterf, True); // нормы на кабеле if TempList1.Count > 0 then begin for l := 0 to TempList1.Count - 1 do begin if PInterfaceNormInfo(TempList1[l]).InterfaceIsBusy = 2 then begin CanTakeFirstCableNorm := True; {if CurrInterfaceNormList = nil then CurrInterfaceNormList := TList.Create; CurrInterfaceNormList.Add(TempList1[l]); PInterfaceNormInfo(CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]).Expense := PInterfaceNormInfo(CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]).Expense * TraceLength; ptrInterfaceNormInfo := CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]; ptrInterfaceNormInfo.SCSComponent := ComplectInterf.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := Interfac.ComponentOwner;} if InterfaceId = -1 then InterFaceId := ComplectInterf.ID; Break; //// BREAK ////; end; end; end else // если есть кабель бех норм, то можно будет юзать норму с ложемента CanUseFirstCableNorm := True; end; // нашли норму на первую протяжку кабеля в кабелях {if CanTakeFirstCableNorm then Break; //// BREAK ////} end; if ((not CanTakeFirstCableNorm) and CanUseFirstCableNorm) then // ищем норму на первую протяжку кабеля на коробе или гофре begin TempList := GetInterfaceNormInfo(InterFac, True); // нормы короба или гофры if TempList.Count > 0 then begin for l := 0 to TempList.Count - 1 do begin if PInterfaceNormInfo(TempList[l]).InterfaceIsBusy = 2 then begin CanTakeFirstCableNorm := True; { if CurrInterfaceNormList = nil then CurrInterfaceNormList := TList.Create; CurrInterfaceNormList.Add(TempList[l]); PInterfaceNormInfo(CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]).Expense := PInterfaceNormInfo(CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]).Expense * TraceLength; {ptrInterfaceNormInfo := CurrInterfaceNormList[CurrInterfaceNormList.Count - 1]; ptrInterfaceNormInfo.SCSComponent := ComplectInterf.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := Interfac.ComponentOwner;} //InterFaceId := ComplectInterf.ID; Break; //// BREAK ////; end; end; end; end else TempList := GetInterfaceNormInfo(InterFac, False); //если норма на первую протяжку кабеля встречается в кабелях - отсеять ее в ложементе for k := 0 to TempList.Count - 1 do begin PInterfaceNormInfo(TempList[k]).Expense := PInterfaceNormInfo(TempList[k]).Expense * TraceLength; PInterfaceNormInfo(TempList[k]).Guid_Interface := Interfac.GUIDInterface; end; if not CanTakeFirstCableNorm then // если не попалась норма на первую протяжку кабеля - удалить норму на последующую протяжку кабеля с ложемента begin CanTakeNextCableNorm := False; // выставить флажок, чтобы не брать норму на повторную протяжку кабеля, если нет первой if TempList.Count > 0 then begin for k := (TempList.Count -1) downto 0 do begin if PInterfaceNormInfo(TempList[k]).InterfaceIsBusy = 3 then begin TempList.Delete(k); end; end; end; end; for k := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[k]); ComplectInterf := IOfIRel.InterfaceTo; //*** интерфейс комплектующей папа (кабель) if (ComplectInterf <> nil) and (ComplectInterf.Gender = gtMale) then begin if (ComplectInterf.ComponentOwner.GetPropertyValueAsInteger(pnSignType) = oitProjectible) or ACanHaveActiveComponents then begin TempList1 := GetInterfaceNormInfo(ComplectInterf, True); if TempList1.Count > 0 then // есть нормы на кабеле - берем с него begin for l := 0 to TempList1.Count - 1 do begin ptrInterfaceNormInfo := TempList1[l]; ptrInterfaceNormInfo.Expense := ptrInterfaceNormInfo.Expense * TraceLength; ptrInterfaceNormInfo.IDInterface := ComplectInterf.ID; ptrInterfaceNormInfo.Guid_Interface := ComplectInterf.GUIDInterface; end; if Not Assigned(CurrInterfaceNormList) then CurrInterfaceNormList := TList.Create; // отсеять ненужные нормы for l := (TempList1.Count - 1) downto 0 do begin CanAddNorm := True; if ((PInterfaceNormInfo(TempList1[l]).InterfaceIsBusy = 2) and (not CanTakeFirstCableNorm)) then CanAddNorm := False else if (PInterfaceNormInfo(TempList1[l]).InterfaceIsBusy = 3) then begin if not CanTakeNextCableNorm then CanAddNorm := False else begin for m := 0 to TempList1.Count - 1 do begin if ((PInterfaceNormInfo(TempList1[m]).InterfaceIsBusy = 2) and CanTakeFirstCableNorm) then begin CanAddNorm := False; Break; //// BREAK ////; end; end; end; // если норма на первую протяжку кабеля - на этом интерфейсе, то последующую не берем if ComplectInterf.ID = InterFaceId then CanAddNorm := False; end; if CanAddNorm then begin CurrInterfaceNormList.Add(TempList1[l]); if (PInterfaceNormInfo(TempList1[l]).InterfaceIsBusy = 2) then CanTakeFirstCableNorm := False; end; end; //*** Указать компоненты, к которым применяются данные норме for l := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[l]; ptrInterfaceNormInfo.SCSComponent := ComplectInterf.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := Interfac.ComponentOwner; end; end else // нет норм на кабеле - берем с ложемента begin if TempList.Count > 0 then begin FirstCableNormAdded := False; if Not Assigned(CurrInterfaceNormList) then CurrInterfaceNormList := TList.Create; for l := 0 to TempList.Count - 1 do begin CanAddNorm := True; if ((PInterfaceNormInfo(TempList[l]).InterfaceIsBusy = 2) and (not CanTakeFirstCableNorm)) then begin CanAddNorm := False; end; if ((PInterfaceNormInfo(TempList[l]).InterfaceIsBusy = 2) and CanTakeFirstCableNorm) then FirstCableNormAdded := True; if (PInterfaceNormInfo(TempList[l]).InterfaceIsBusy = 3) then begin if ((not CanTakeNextCableNorm) or FirstCableNormAdded) then CanAddNorm := False; if CanAddNorm then begin for m := 0 to TempList.Count - 1 do begin if ((PInterfaceNormInfo(TempList[m]).InterfaceIsBusy = 2) and CanTakeFirstCableNorm) then begin CanAddNorm := False; Break; //// BREAK ////; end; end; end; end; if CanAddNorm then begin CurrInterfaceNormList.Add(TempList[l]); if (PInterfaceNormInfo(TempList[l]).InterfaceIsBusy = 2) then CanTakeFirstCableNorm := False; ptrInterfaceNormInfo := CurrInterfaceNormList[CurrInterfaceNormList.count - 1]; ptrInterfaceNormInfo.SCSComponent := ComplectInterf.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := Interfac.ComponentOwner; end; end; end; end; end; end; LookedInterfaces.Add(ComplectInterf); end; end; end; // Папа - свободен if CanUseComponBySignType then if Interfac.Gender = gtMale then if Interfac.IsBusy = biFalse then begin // Tolik -- 08/02/2017 -- if CurrInterfaceNormList <> nil then FreeAndNil(CurrInterfaceNormList); // CurrInterfaceNormList := GetInterfaceNormInfo(Interfac); if CurrInterfaceNormList.Count > 0 then for k := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[k]; ptrInterfaceNormInfo.SCSComponent := Interfac.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := nil; //Tolik ptrInterfaceNormInfo.Expense := ptrInterfaceNormInfo.Expense * TraceLength; ptrInterfaceNormInfo.Guid_Interface := Interfac.GUIDInterface; end; end; //*** Умножить расход нормы на длину компоненты {if Assigned(CurrInterfaceNormList) then for k := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[k]; ptrInterfaceNormInfo.Expense := ptrInterfaceNormInfo.Expense * TraceLength; end;} end; biFalse: //*** Для точ. компоненты if CanUseComponBySignType then if Interfac.Gender = gtMale then // можно замнить на gtFemale begin // Tolik -- 08/02/2017 -- if CurrInterfaceNormList <> nil then FreeAndNil(CurrInterfaceNormList); // CurrInterfaceNormList := GetInterfaceNormInfo(Interfac); if CurrInterfaceNormList.Count > 0 then for k := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[k]; ptrInterfaceNormInfo.SCSComponent := Interfac.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := nil; ptrInterfaceNormInfo.Guid_Interface := Interfac.GUIDInterface; end; end; end; end; LookedInterfaces.Add(Interfac); if Assigned(CurrInterfaceNormList) then begin //*** Указать компоненты, к которым применяются данные нормы for l := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[l]; {PptrInterfaceNormInfo.SCSComponent := ComplectInterf.ComponentOwner; ptrInterfaceNormInfo.RelationComponent := Interfac.ComponentOwner;} // if ptrInterfaceNormInfo.Expense = 1 then // ptrInterfaceNormInfo.Expense := ptrInterfaceNormInfo.Expense * TraceLength; end; if CurrInterfaceNormList.Count > 0 then AssignListItems(CurrInterfaceNormList, InterfNormList); FreeAndNil(CurrInterfaceNormList); end; end; end; end; //*** Для пользовательских норм добавить тек-й компонент как прейскурант if CanUseComponBySignType then for i := 0 to FNormsResources.FNorms.Count - 1 do begin Norm := FNormsResources.FNorms[i]; if Norm.IsFromInterface = biFalse then begin { NormPreyscurant := TSCSNormPreyscurant.Create; NormPreyscurant.Name := Self.Name; NormPreyscurant.InterfaceType := itConstructive; NormPreyscurant.SCSComponentGUID := Self.GuidNB; NormPreyscurant.SCSComponent := Self; NormPreyscurant.Kolvo := Norm.Kolvo; //1; NormPreyscurant.PairKolvo := 0; if NormPreyscurant.SCSComponent.IsLine = biTrue then begin //NormPreyscurant.Kolvo := TraceLength; //NormPreyscurant.SCSComponent.Length; NormPreyscurant.PairKolvo := GetComponPairCount(NormPreyscurant.SCSComponent); end; Norm.FPreyscurants.Add(NormPreyscurant);} NormPreyscurant := AddPreyscurantToNorm(Norm, Self, itConstructive); end; end; //*** Обнулить расход норм из интерфейсов, которые еще остались (напр. выключенные) // + которые есть в списке InterfNormList for i := 0 to FNormsResources.FNorms.Count - 1 do begin Norm := FNormsResources.FNorms[i]; if Norm.IsFromInterface = biTrue then for j := 0 to InterfNormList.Count - 1 do begin ptrInterfaceNormInfo := InterfNormList[j]; if ptrInterfaceNormInfo.GUIDNBNorm = Norm.GuidNB then begin Norm.Kolvo := 0; Break; //// BREAK //// end; end; end; //*** Добавить нормы в компонент for i := 0 to InterfNormList.Count - 1 do begin ptrInterfaceNormInfo := InterfNormList[i]; //Norm := FNormsResources.FNorms.GetNormByGuidNB(ptrInterfaceNormInfo.GUIDNBNorm, False); Norm := FNormsResources.FNorms.GetNormByGuidNB(ptrInterfaceNormInfo.GUIDNBNorm, true); if Norm = nil then begin Norm := nil; //Norm.LoadNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm, true); if TF_MAin(FActiveForm).GDBMode = bkNormBase then begin Norm := TSCSNorm.Create(FActiveForm, ntNB); Norm.LoadNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm, false); end else if TF_MAin(FActiveForm).GDBMode = bkProjectManager then if FProjectOwner <> nil then begin SprNorm := FProjectOwner.FSpravochnik.GetNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm); if SprNorm <> nil then begin Norm := TSCSNorm.Create(FActiveForm, ntNB); Norm.LoadNormFromSprNorm(SprNorm); end; end; if Norm <> nil then begin Norm.CalcCost; //*** Оставить норму в компоненте Inc(MaxNpp); Norm.NPP := MaxNpp; Norm.IsOn := biTrue; Norm.MasterTableKind := ctkComponent; Norm.IDMaster := ID; Norm.ActiveForm := FActiveForm; Norm.FNormType := ntProj; Norm.IsFromInterface := biTrue; // Toilk Norm.GuidInterface := ptrInterfaceNormInfo.Guid_Interface; // FNormsResources.FNorms.Add(Norm); end; end; if (Norm <> nil) and (Norm.IsFromInterface = biTrue) then begin Norm.Kolvo := Norm.Kolvo + ptrInterfaceNormInfo.Expense; //GLog.Add(FloatToStr(Norm.Kolvo)); if ptrInterfaceNormInfo.SCSComponent <> nil then begin NormPreyscurant := TSCSNormPreyscurant.Create; NormPreyscurant.Name := TSCSComponent(ptrInterfaceNormInfo.SCSComponent).Name; NormPreyscurant.InterfaceType := ptrInterfaceNormInfo.InterfaceType; NormPreyscurant.SCSComponentGUID := TSCSComponent(ptrInterfaceNormInfo.SCSComponent).GuidNB; if ptrInterfaceNormInfo.RelationComponent <> nil then NormPreyscurant.RelationComponentGUID := TSCSComponent(ptrInterfaceNormInfo.RelationComponent).GuidNB; NormPreyscurant.SCSComponent := TSCSComponent(ptrInterfaceNormInfo.SCSComponent); NormPreyscurant.RelationComponent := TSCSComponent(ptrInterfaceNormInfo.RelationComponent); NormPreyscurant.Kolvo := Norm.Kolvo; //1; NormPreyscurant.PairKolvo := 0; if NormPreyscurant.SCSComponent.IsLine = biTrue then begin //NormPreyscurant.Kolvo := TraceLength; //NormPreyscurant.SCSComponent.Length; NormPreyscurant.PairKolvo := GetComponPairCount(NormPreyscurant.SCSComponent); end; Norm.FPreyscurants.Add(NormPreyscurant); end; end; end; { //*** Сгруппировать ссылки на нормы for i := 0 to InterfNormList.Count - 1 do if InterfNormList[i] <> nil then begin ptrInterfaceNormInfoI := InterfNormList[i]; for j := i to InterfNormList.Count - 1 do if i <> j then if InterfNormList[j] <> nil then begin ptrInterfaceNormInfoJ := InterfNormList[j]; if ptrInterfaceNormInfoI.GUIDNBNorm = ptrInterfaceNormInfoJ.GUIDNBNorm then begin ptrInterfaceNormInfoI.Expense := ptrInterfaceNormInfoI.Expense + ptrInterfaceNormInfoJ.Expense; FreeMem(ptrInterfaceNormInfoJ); InterfNormList[j] := nil; end; end; end; InterfNormList.Pack; //*** Добавить нормы в компонент for i := 0 to InterfNormList.Count - 1 do begin ptrInterfaceNormInfo := InterfNormList[i]; Norm := FNormsResources.FNorms.GetNormByGuidNB(ptrInterfaceNormInfo.GUIDNBNorm); if Norm = nil then begin Norm := TSCSNorm.Create(F_NormBase, ntNB); //Norm.LoadNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm, true); Norm.LoadNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm, false); Norm.CalcCost; //*** Оставить норму в компоненте Inc(MaxNpp); Norm.NPP := MaxNpp; Norm.IsOn := biTrue; Norm.MasterTableKind := ctkComponent; Norm.IDMaster := ID; Norm.ActiveForm := FActiveForm; Norm.FNormType := ntProj; Norm.IsFromInterface := biTrue; FNormsResources.FNorms.Add(Norm); end; if Norm <> nil then Norm.Kolvo := ptrInterfaceNormInfo.Expense; end; } //Tolik { for i := 0 to InterfNormList.Count - 1 do begin FreeMem(ptrInterfaceNormInfo(InterfNormList[i])); end; } InterfNormList.Free; // finally FreeAndNil(LookedInterfaces); // Tolik -- if CurrInterfaceNormList <> nil then FreeAndNil(CurrInterfaceNormList); // -- end; end; procedure TSCSComponent.DefineLengthsOfNetThreads; var i, j: Integer; ptrJoinedComponents: PJoinedComponents; CurrLength, CurrReserv: Double; FirstIDJoinedConn, LastIDJoinedConn: Integer; begin for i := 0 to FNet.Count - 1 do begin ptrJoinedComponents := FNet[i]; if Assigned(ptrJoinedComponents.JoinedLines) then begin CurrLength := 0; CurrReserv := 0; for j := 0 to ptrJoinedComponents.JoinedLines.Count - 1 do CurrLength := CurrLength + GetComponPartLengthWithReserv(ptrJoinedComponents.JoinedLines[j], CurrReserv, true, true); //GetLengthByComponent(ptrJoinedComponents.JoinedLines[j]); {FirstIDCompon := -1; LastIDCompon := -1; if Assigned(ptrJoinedComponents.FirstConnCompons) then for j := 0 to ptrJoinedComponents.FirstConnCompons.Count - 1 do begin FirstIDCompon := ptrJoinedComponents.FirstConnCompons[j].ID; if ptrJoinedComponents.FirstConnCompons[j].ComponentType.PortKind = pkMultiPort then Break; ////// BREAK ///// end; if Assigned(ptrJoinedComponents.LastConnCompons) then for j := 0 to ptrJoinedComponents.LastConnCompons.Count - 1 do begin LastIDCompon := ptrJoinedComponents.LastConnCompons[j].ID; if ptrJoinedComponents.LastConnCompons[j].ComponentType.PortKind = pkMultiPort then Break; ////// BREAK ///// end; ApplyLengthData(CurrLength, CurrReserv, FirstIDCompon, LastIDCompon); } ptrJoinedComponents.Length := CurrLength; end; end; end; procedure TSCSComponent.DefineNameMarks; var OwnerObject: TSCSCatalog; i: Integer; begin OwnerObject := GetFirstParentCatalog; if OwnerObject <> nil then NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(Self, OwnerObject, false); for i := 0 to FChildReferences.Count - 1 do FChildReferences[i].DefineNameMarks; end; procedure TSCSComponent.DefineNppInterfaces; var LastPortNpps, LastInterfNpps: TStringList; Interfac: TSCSInterface; TopComponent, SCSCompon: TSCSComponent; ComponsToEdit: TSCSComponents; i, j: Integer; function GetNewInterfNpp(AInterface: TSCSInterface): Integer; var i, LastNpp, IndexInList: Integer; ptrLastInterface: TSCSInterface; FindedLast: Boolean; LastNpps: TStringList; begin Result := AInterface.Npp; LastNpp := 0; if AInterface.Npp = 0 then begin FindedLast := false; LastNpps := nil; if AInterface.IsPort = biTrue then LastNpps := LastPortNpps else LastNpps := LastInterfNpps; IndexInList := LastNpps.IndexOf(AInterface.GUIDInterface); if IndexInList <> -1 then begin LastNpp := Integer(LastNpps.Objects[IndexInList]); LastNpp := LastNpp + 1; LastNpps.Objects[IndexInList] := TObject(LastNpp); end else begin if self.ComponentType.IsLine = 1 then LastNpp := 0 else LastNpp := TopComponent.GetLastNppInterface(AInterface.GUIDInterface, AInterface.IsPort, Self); LastNpp := LastNpp + 1; LastNpps.AddObject(AInterface.GUIDInterface, TObject(LastNpp)); end; Result := LastNpp; end; end; begin TopComponent := Self.GetTopComponent; begin if Assigned(TopComponent) then begin LastPortNpps := CreateStringListSorted; LastInterfNpps := CreateStringListSorted; ComponsToEdit := TSCSComponents.Create(false); ComponsToEdit.Assign(Self.ChildReferences); ComponsToEdit.Insert(0, Self); //*** Установить номера интерфейсов в ноль for i := 0 to ComponsToEdit.Count - 1 do begin SCSCompon := ComponsToEdit[i]; 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 SCSCompon.ComponentType.IsLine = 1 then LastInterfNpps.Clear; 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); LastPortNpps.Free; LastInterfNpps.Free; end; end; end; procedure TSCSComponent.DefineNppPorts(aComponLocation: TSCSComponent); var Interf: TSCSInterface; NewNppPort, i, j: Integer; Changed: Boolean; //Tolik GuidInterfList: TStringList; InterfLastNppList: TIntList; // begin //Tolik GuidInterfList := TstringList.Create; InterfLastNppList := TIntList.Create; // // Сбрасываем номера портов for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsPort = biTrue then if Interf.IsUserPort = biFalse then //Tolik // Interf.NppPort := 1; begin Interf.NppPort := 1; if GuidInterfList.IndexOf(Interf.GUIDInterface) = -1 then begin GuidInterfList.Add(Interf.GUIDInterface); InterfLastNppList.Add(GetMaxNppPort(Interf.GUIDInterface)); end; end; end; //Tolik //NewNppPort := GetMaxNppPort; //NewNppPort := aComponLocation.GetLastNppPort + 1; // Changed := false; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsPort = biTrue then if Interf.IsUserPort = biFalse then begin //Tolik //Interf.NppPort := NewNppPort; {Interf.NppPort := NewNppPort + 1; // Inc(NewNppPort, Interf.Kolvo);} j := GuidInterfList.IndexOf(Interf.GUIDInterFace); if j <> -1 then begin Interf.NppPort := InterfLastNppList[j] + 1; //Inc(Integer(InterfLastNppList[j]), Interf.Kolvo); InterfLastNppList[j] := InterfLastNppList[j] + Interf.Kolvo; Changed := true; end; // end; end; if Changed then RemarkComponAfterChangePort(Self); FreeAndNil(GuidInterfList); FreeAndNil(InterfLastNppList); end; function TSCSComponent.DelConnected(AComponent: TSCSComponent; AIDTopComponent, AIDCompRel, AConnectType: TConnectType): Boolean; var IDCompRel, i, j: Integer; //ptrConnection: PComplect; Interfac, ptrConnectedInterface: TSCSInterface; ptrCompRel: PComplect; IOfIRel: TSCSIOfIRel; CanPackIOfIRelOut: Boolean; begin Result := false; IDCompRel := 0; if Assigned(AComponent) then //if FChildComplects.IndexOf(AChildComponent) <> -1 then begin IDCompRel := 0; case FQueryMode of qmPhisical: begin IDCompRel := AIDCompRel; if IDCompRel = 0 then EmptyProcedure; //IDCompRel := TF_Main(ActiveForm).DM.GetIDCompRelByConnectCompons(Self.ID, AComponent.ID, AIDTopComponent, AIDParentCompRel, AConnectType); end; qmMemory: begin ptrCompRel := GetCompRelByConnectedCompon(AComponent, AConnectType); if ptrCompRel <> nil then IDCompRel := ptrCompRel.ID; end; end; if IDCompRel > 0 then begin TF_Main(ActiveForm).FreeCompRel(IDCompRel, Self, AComponent); //*** Освободить интерфейсные соединения for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); CanPackIOfIRelOut := false; if (IOfIRel <> nil) and (IOfIRel.InterfaceTo <> nil) then if (IOfIRel.InterfaceTo.ID_Component = AComponent.ID) and (IOfIRel.IDCompRel = IDCompRel) then begin ptrConnectedInterface := AComponent.GetInterfaceByID(IOfIRel.IDInterfTo); if Assigned(Interfac.ConnectedInterfaces) then if Interfac.ConnectedInterfaces.IndexOf(ptrConnectedInterface) <> -1 then Interfac.ConnectedInterfaces.Remove(ptrConnectedInterface); if Assigned(ptrConnectedInterface.ConnectedInterfaces) then if ptrConnectedInterface.ConnectedInterfaces.IndexOf(Interfac) <> -1 then ptrConnectedInterface.ConnectedInterfaces.Remove(Interfac); if ptrConnectedInterface <> nil then begin FreeAndNil(IOfIRel); Interfac.IOfIRelOut[j] := nil; CanPackIOfIRelOut := true; end; end; end; if CanPackIOfIRelOut then Interfac.IOfIRelOut.Pack; end; for i := 0 to AComponent.Interfaces.Count - 1 do begin Interfac := AComponent.Interfaces[i]; CanPackIOfIRelOut := false; for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); if (IOfIRel <> nil) and (IOfIRel.InterfaceTo <> nil) then if (IOfIRel.InterfaceTo.ID_Component = FID) and (IOfIRel.IDCompRel = IDCompRel) then begin ptrConnectedInterface := GetInterfaceByID(IOfIRel.IDInterfTo); if Assigned(Interfac.ConnectedInterfaces) then if Interfac.ConnectedInterfaces.IndexOf(ptrConnectedInterface) <> -1 then Interfac.ConnectedInterfaces.Remove(ptrConnectedInterface); if Assigned(ptrConnectedInterface.ConnectedInterfaces) then if ptrConnectedInterface.ConnectedInterfaces.IndexOf(Interfac) <> -1 then ptrConnectedInterface.ConnectedInterfaces.Remove(Interfac); if ptrConnectedInterface <> nil then begin FreeAndNil(IOfIRel); Interfac.IOfIRelOut[j] := nil; CanPackIOfIRelOut := true; end; end; end; if CanPackIOfIRelOut then Interfac.IOfIRelOut.Pack; end; case AConnectType of cntComplect: begin RemoveChildComponent(AComponent); TF_Main(ActiveForm).F_ChoiceConnectSide.OnAfterDisConnectCompons(Self, AComponent, IDCompRel); end; cntUnion: begin RemoveJoinedComponent(AComponent); AComponent.RemoveJoinedComponent(Self); TF_Main(ActiveForm).F_ChoiceConnectSide.OnAfterDisJoinCompons(Self, AComponent); end; end; Result := true; end; end; end; function TSCSComponent.DelConnectedAsNoFinal(AComponent: TSCSComponent; AConnectType: TConnectType): Boolean; var ptrCompRel: PComplect; i: Integer; CurrIOfIRels, IOfIRels: TList; IOfIRel: TSCSIOfIRel; function GetCompRelByLinkField(ACompRelList: TList; ACompon: TSCSComponent): PComplect; var i: Integer; ptrCompRel: PComplect; begin Result := nil; for i := 0 to ACompRelList.Count - 1 do begin ptrCompRel := ACompRelList[i]; if (ACompon.LinkToComlectRec = ptrCompRel) and (ACompon.ID = ptrCompRel.ID_Child) then begin Result := ptrCompRel; ACompRelList.Delete(i); Break; //// BREAK //// end; end; end; begin Result := false; ptrCompRel := nil; case AConnectType of cntComplect: begin ptrCompRel := GetCompRelByLinkField(FComplects, AComponent); if ptrCompRel = nil then ptrCompRel := GetCompRelByLinkField(AComponent.FComplects, Self); end; cntUnion: begin ptrCompRel := GetCompRelByLinkField(FConnections, AComponent); if ptrCompRel = nil then ptrCompRel := GetCompRelByLinkField(AComponent.FConnections, Self); end; end; if ptrCompRel <> nil then begin IOfIRels := TList.Create; CurrIOfIRels := GetComponIOfIRelsByIDCompRel(Self, ptrCompRel.ID); IOfIRels.Assign(CurrIOfIRels, laOr); CurrIOfIRels.Free; CurrIOfIRels := GetComponIOfIRelsByIDCompRel(Self, ptrCompRel.ID); IOfIRels.Assign(CurrIOfIRels, laOr); CurrIOfIRels.Free; for i := 0 to IOfIRels.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRels[i]); IOfIRel.InterfaceOwner.FreeIOfIRel(IOfIRel); end; IOfIRels.Free; FreeMem(ptrCompRel); Result := true; end; end; procedure TSCSComponent.DisComplectChildComponent(AChildComponent: TSCSComponent); var ObjectOwner: TSCSCatalog; begin ObjectOwner := nil; if Assigned(AChildComponent) then if FChildComplects.IndexOf(AChildComponent) <> -1 then begin TF_Main(FActiveForm).OnAddDeleteNode(AChildComponent.TreeViewNode, AChildComponent, nil, false); DelConnected(AChildComponent, IDTopComponent, AChildComponent.IDCompRel, cntComplect); ObjectOwner := GetFirstParentCatalog; TF_Main(ActiveForm).F_ChoiceConnectSide.DefineObjectParamsInFuture(ObjectOwner); NotifyChange; //FChildComplects.Remove(AChildComponent); //AChildComponent.Parent := nil; //if Assigned(AChildComponent.TreeViewNode) then // TF_Main(ActiveForm).OnAddDeleteNode(AChildComponent.TreeViewNode, AChildComponent, false); end; end; procedure TSCSComponent.DisConnectFromParent; begin if Assigned(FParent) then begin if FParent is TSCSComponent then TSCSComponent(FParent).DisComplectChildComponent(Self); if FParent is TSCSCatalog then TSCSCatalog(Fparent).RemoveComponentFromCatRel(Self); end; end; function TSCSComponent.DisJoinFrom(AComponent: TSCSComponent): Boolean; begin Result := false; Result := DelConnected(AComponent, -1, -1, cntUnion); end; function TSCSComponent.DisJoinFromAll(AAccountChildCompon: Boolean; AAccountInternalJoin: Boolean = false): TSCSComponents; var //JoinComponents: TSCSComponents; DisJoinedFromChild: TSCSComponents; IsInternalJoin, WasDisJoin: Boolean; i: Integer; begin Result := nil; Result := TSCSComponents.Create(false); if not GisOpenProjectDelFromPM then // Tolik 21/01/2021 -- если удаляется не проект begin i := 0; while i <= FJoinedComponents.Count - 1 do begin WasDisJoin := false; IsInternalJoin := false; //*** Проверка на внутреннее соединение if FJoinedComponents[i].GetTopComponent = GetTopComponent then IsInternalJoin := true; if Not (IsInternalJoin) or (AAccountInternalJoin) then begin Result.Add(FJoinedComponents[i]); WasDisJoin := DisJoinFrom(FJoinedComponents[i]); //WasDisJoin := true; end; if Not WasDisJoin then Inc(i); end; if AAccountChildCompon then for i := 0 to FChildComplects.Count - 1 do if Assigned(FChildComplects[i]) then begin DisJoinedFromChild := FChildComplects[i].DisJoinFromAll(AAccountChildCompon, AAccountInternalJoin); if Assigned(DisJoinedFromChild) then if DisJoinedFromChild.Count > 0 then // Tolik 21/01/2021 -- Result.Assign(DisJoinedFromChild, laOr); DisJoinedFromChild.free; // Tolik 21/01/2021 -- end; end // если удаляется проект else begin FJoinedComponents.Clear; for i := 0 to FChildComplects.Count - 1 do begin if Assigned(FChildComplects[i]) then FChildComplects[i].DisJoinFromAll(AAccountChildCompon, AAccountInternalJoin).Free; end; end; end; function TSCSComponent.JoinWithOnlyObject(AComponent: TSCSComponent): PComplect; begin Result := nil; Result := ConnectWithOnlyObject(AComponent, cntUnion); end; function TSCSComponent.ExistsCrossComponInChilds: Boolean; var i: Integer; ChildCompon: TSCSComponent; begin Result := false; for i := 0 to ChildReferences.Count - 1 do begin ChildCompon := ChildReferences[i]; if ChildCompon.IsCrossComponent then begin Result := true; Break; //// BREAK //// end; end; end; function TSCSComponent.FreeInterfaceByID(AIDInterRel: Integer): Boolean; var i: Integer; begin Result := false; for i := 0 to FInterfaces.Count - 1 do if TSCSInterface(FInterfaces[i]).ID = AIDInterRel then begin FreeInterface(TSCSInterface(FInterfaces[i])); //FreeMem(FInterfaces[i]); FInterfaces.Delete(i); Result := true; Break; ///// BREAK ///// end; end; procedure TSCSComponent.FreeInterfacesByNumPair(ANumPair: Integer); var i, j: Integer; Interf: TSCSInterface; InterfPortRel: PPortInterfRel; DelIDs: TintList; begin DelIDs := TintList.Create; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.NumPair = ANumPair then begin //FreeMem(FInterfaces[i]); DelIDs.Add(Interf.ID); FreeInterface(Interf); FInterfaces[i] := nil; end; end; FInterfaces.Pack; //*** Удалить связи с удаленными интерфейсами for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; for j := 0 to Interf.FPortInterfRels.Count - 1 do begin InterfPortRel := PPortInterfRel(Interf.FPortInterfRels[j]); if DelIDs.IndexOf(InterfPortRel.IDInterfRel) <> -1 then begin FreeMem(InterfPortRel); Interf.FPortInterfRels[j] := nil; end; end; Interf.FPortInterfRels.Pack; end; FreeAndNil(DelIDs); end; function TSCSComponent.GenCompRelSortID: Integer; var i: Integer; ptrCopmlect: PComplect; begin Result := 0; for i := 0 to FComplects.Count - 1 do begin ptrCopmlect := FComplects[i]; if ptrCopmlect.SortID > Result then Result := ptrCopmlect.SortID; end; Inc(Result); end; function TSCSComponent.GetCableCanalConnectorByID(AID: Integer): PCableCanalConnector; var i: Integer; ptrCableCanalConnector: PCableCanalConnector; begin Result := nil; for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; if ptrCableCanalConnector.ID = AID then begin Result := ptrCableCanalConnector; Break; ///// BREAK ///// end; end; end; function TSCSComponent.GetCCEByIDConnector(AIDConnector: Integer): PCableCanalConnector; var i: Integer; ptrCableCanalConnector: PCableCanalConnector; begin Result := nil; for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; if ptrCableCanalConnector.IDNBConnector = AIDConnector then begin Result := ptrCableCanalConnector; Break; ///// BREAK ///// end; end; end; function TSCSComponent.GetCableCanalIDNBConnectorByType(AConnectorType: Integer; AWithStoreInNB: Boolean; AFindedIDs: TIDStringList): TIntList; var ptrCableCanalConnector: PCableCanalConnector; i, IDNBConnector: Integer; ptrID: ^Integer; SprConnector: TSCSComponent; IsIDFromFindedList: Boolean; begin Result := nil; Result := TIntList.Create; IDNBConnector := 0; for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; if (ptrCableCanalConnector.ConnectorType = AConnectorType) or (AConnectorType = contAll) then begin IDNBConnector := 0; //IDNBConnector := GetComponFieldValueAsInteger(ptrCableCanalConnector.IDNBConnector, fnID); if ptrCableCanalConnector.GuidNBConnector <> '' then begin IsIDFromFindedList := false; if AFindedIDs <> nil then begin IDNBConnector := AFindedIDs.GetIDByString(ptrCableCanalConnector.GuidNBConnector); if IDNBConnector = -1 then IDNBConnector := 0 else IsIDFromFindedList := true; end; if IDNBConnector = 0 then IDNBConnector := TF_Main(FActiveForm).FNormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, ptrCableCanalConnector.GuidNBConnector, qmPhisical); //*** если не удалось найти, то закинуть из справочника в нормативку if IDNBConnector = 0 then if (TF_Main(FActiveForm).GDBMode = bkProjectManager) and AWithStoreInNB then if FProjectOwner <> nil then begin //*** найти в справочкике элемент каб. канала SprConnector := FProjectOwner.GetSprComponentByGUID(ptrCableCanalConnector.GuidNBConnector); if SprConnector <> nil then if FProjectOwner.DefineNBDir then IDNBConnector := CopyComponentFromPMToNB(FActiveForm, TF_Main(FActiveForm).FNormBase, SprConnector, FProjectOwner.FNBDirID); end; if IDNBConnector <> 0 then begin Result.Add(IDNBConnector); if (AFindedIDs <> nil) and Not IsIDFromFindedList then AFindedIDs.Add(IDNBConnector, ptrCableCanalConnector.GuidNBConnector); end; end; end; end; end; function TSCSComponent.GetCablesVolume(AWithOutCable: TSCSComponent = nil): Double; var i: Integer; TotalVolume: Double; ChildComponent: TSCSComponent; begin Result := -1; if ComponentType.SysName = ctsnCableChannel then begin TotalVolume := 0; for i := 0 to FChildComplects.Count - 1 do begin ChildComponent := FChildComplects[i]; if Assigned(ChildComponent) and (ChildComponent <> AWithOutCable) then TotalVolume := TotalVolume + FChildComplects[i].GetVolume(gtMale); end; Result := Round3(TotalVolume); end; end; function TSCSComponent.GetComplectByID(AID: Integer): PComplect; //var // i: Integer; begin Result := GetCompRelByIDFromList(AID, FComplects); //20.05.2011 //Result := nil; //for i := 0 to FComplects.Count - 1 do // if PComplect(FComplects[i]).ID = AID then // begin // Result := PComplect(FComplects[i]); // Break; //// BREAK ///// // end; end; function TSCSComponent.GetComplectByIDChild(AIDChild: Integer): PComplect; var i: Integer; ptrComplect: PComplect; begin Result := nil; for i := 0 to FComplects.Count - 1 do begin ptrComplect := PComplect(FComplects.List^[i]); if ptrComplect.ID_Component = FID then if ptrComplect.ID_Child = AIDChild then begin Result := ptrComplect; Break; //// BREAK ///// end; end; end; function TSCSComponent.GetComponentFromReferences(AIDComponent: Integer): TSCSComponent; var i: Integer; ChildComponent: TSCScomponent; begin Result := nil; for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; if Assigned(ChildComponent) then if ChildComponent.ID = AIDComponent then begin Result := ChildComponent; Break; ///// BREAK ///// end; end; end; function TSCSComponent.GetCompRelByConnectedCompon(AConnectedComponent: TSCSComponent; AConnectType: Integer): PComplect; var ptrCompRel: PComplect; begin Result := nil; if Assigned(AConnectedComponent) then begin ptrCompRel := nil; case AConnectType of cntComplect: begin ptrCompRel := GetComplectByIDChild(AConnectedComponent.ID); if ptrCompRel = nil then ptrCompRel := AConnectedComponent.GetComplectByIDChild(ID); end; cntUnion: ptrCompRel := GetConnectionByConnected(AConnectedComponent); end; Result := ptrCompRel; end; end; function TSCSComponent.GetCompRelByIDFromList(AID: Integer; AList: TList): PComplect; var i: Integer; begin Result := nil; for i := 0 to AList.Count - 1 do if PComplect(AList[i]).ID = AID then begin Result := PComplect(AList[i]); Break; //// BREAK ///// end; end; function TSCSComponent.GetConnectedInterfacesToCompon(AConnectedComponent: TSCSComponent): TInterfLists; begin Result := GetInterfacesThatConnectComponent(AConnectedComponent); end; function TSCSComponent.GetConnectedInterfacesToNoCompon(AConnectedNoComponent: TSCSComponent; ASelfSide: Integer): TInterfLists; var ConnectedInterfaces: TInterfLists; i, j, k, l: Integer; Interfac: TSCSInterface; IOfIRel: TSCSIOfIRel; begin Result.InterfList1 := nil; Result.InterfList2 := nil; if Not Assigned(AConnectedNoComponent) then Exit; ////// EXIT ////// Result.InterfList1 := TList.Create; Result.InterfList2 := TList.Create; //ConnectedInterfaces := GetConnectedInterfacesToCompon(AConnectedNoComponent); for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac.Side = ASelfSide then begin if Assigned(Interfac.IOfIRelOut) then for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); if IOfIRel.InterfaceTo <> nil then if IOfIRel.InterfaceTo.ID_Component <> AConnectedNoComponent.ID then begin Result.InterfList1.Add(Interfac); Result.InterfList2.Add(IOfIRel.InterfaceTo); end; end; //*** Найти указатель на этот интерфейс в подсоединенных компонентах for j := 0 to FJoinedComponents.Count - 1 do if Assigned(FJoinedComponents[j]) then if FJoinedComponents[j] <> AConnectedNoComponent then for k := 0 to FJoinedComponents[j].FInterfaces.Count - 1 do begin Interfac := FJoinedComponents[j].FInterfaces[k]; if Assigned(Interfac.IOfIRelOut) then for l := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[l]); if IOfIRel.InterfaceTo = FInterfaces[i] then begin Result.InterfList1.Add(IOfIRel.InterfaceTo); Result.InterfList2.Add(Interfac); end; end; end; end; end; end; function TSCSComponent.GetConnectionByConnected(AConnectedCompon: TSCSComponent): PComplect; function GetConnectionFromList(AList: TList): PComplect; var i: Integer; ptrConnection: PComplect; begin Result := nil; for i := 0 to AList.Count - 1 do begin ptrConnection := AList[i]; if ((ptrConnection.ID_Component = FID) and (ptrConnection.ID_Child = AConnectedCompon.ID)) or ((ptrConnection.ID_Component = AConnectedCompon.ID) and (ptrConnection.ID_Child = FID)) then begin Result := ptrConnection; Break; //// BREAK ///// end; end; end; begin Result := nil; if Assigned(AConnectedCompon) then begin Result := GetConnectionFromList(FConnections); if Result = nil then Result := GetConnectionFromList(AConnectedCompon.FConnections); end; end; function TSCSComponent.GetConnectionByID(AID: Integer): PComplect; begin Result := GetCompRelByIDFromList(AID, FConnections); end; function TSCSComponent.GetCrossConnectionByID(AID: Integer): TSCSCrossConnection; var i: Integer; ptrCrossConnection: TSCSCrossConnection; begin Result := nil; for i := 0 to FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(FCrossConnections[i]); if ptrCrossConnection.ID = AID then begin Result := ptrCrossConnection; Break; //// BREAK //// end; end; end; function TSCSComponent.GetFilling(AByIsPort, AByInterfType: Integer; AByWholeComponent, ARecursive: Boolean; aLoadWholeCompon: Boolean=true): TFillConnectConObj; var BusyCount, EmptyCount, i: Integer; Compon, FirstLineCompon, LastLineCompon: TSCSComponent; TopParent: TSCSCatalog; procedure LoadEmptyBusyInterfCount(AComponent: TSCSComponent; var AEmptyCount, ABusyCount: Integer); var i: Integer; Interf: TSCSInterface; JoinedComponToInterf: TSCSComponent; TakeIntoInterf: Boolean; begin if Assigned(AComponent) then for i := 0 to AComponent.Interfaces.Count - 1 do begin Interf := AComponent.Interfaces[i]; if (AByIsPort = biNone) or (Interf.IsPort = AByIsPort) then if (AByInterfType = itpNone) or (Interf.TypeI = AByInterfType) then begin //*** Учитывать цельные кабели TakeIntoInterf := true; if (AComponent.IsLine = biTrue) and AByWholeComponent then begin JoinedComponToInterf := nil; if Interf.ConnectedInterfaces.Count > 0 then JoinedComponToInterf := Interf.ConnectedInterfaces[0].ComponentOwner; if Assigned(JoinedComponToInterf) then if JoinedComponToInterf.IsLine = biTrue then if AComponent.Whole_ID = JoinedComponToInterf.Whole_ID then TakeIntoInterf := false; end; if TakeIntoInterf then IncBusyEmptyInterface(Interf, AEmptyCount, ABusyCount); end; end; end; begin Result := foEmpty; BusyCount := 0; EmptyCount := 0; case IsLine of biFalse: begin LoadEmptyBusyInterfCount(Self, EmptyCount, BusyCount); if ARecursive then for i := 0 to FChildReferences.Count - 1 do begin Compon := FChildReferences[i]; if Not (Compon.ComponentType.SysName = ctsnPatchCord) then LoadEmptyBusyInterfCount(Compon, EmptyCount, BusyCount); end; end; biTrue: case AByWholeComponent of true: begin FirstLineCompon := nil; LastLineCompon := nil; TopParent := GetTopParentCatalog; //*** найти конечности if Assigned(TopParent) then begin //21.03.2008 LoadWholeComponent(true); if aLoadWholeCompon then begin LoadWholeComponent(false); DefineFirstLast; end; FirstLineCompon := TopParent.GetComponentFromReferences(FirstIDCompon); LastLineCompon := TopParent.GetComponentFromReferences(LastIDCompon); if Assigned(FirstLineCompon) then LoadEmptyBusyInterfCount(FirstLineCompon, EmptyCount, BusyCount); if Assigned(LastLineCompon) then LoadEmptyBusyInterfCount(LastLineCompon, EmptyCount, BusyCount); if (FirstLineCompon = nil) and (LastLineCompon = nil) then LoadEmptyBusyInterfCount(Self, EmptyCount, BusyCount); end; end; false: LoadEmptyBusyInterfCount(Self, EmptyCount, BusyCount); end; end; Result := GetHowFillObjByEmptyBusy(EmptyCount, BusyCount); if Result = foNone then if (Self.ComponentType.SysName = ctsnHouse) or (Self.ComponentType.SysName = ctsnApproach) then Result := foEmpty; end; function TSCSComponent.GetFirstParentCatalog: TSCSCatalog; var CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := FParent; while CurrParent <> nil do begin if CurrParent is TSCSCatalog then begin Result := TSCSCatalog(CurrParent); Break; //// BREAK ///// end; if CurrParent is TSCSComponent then CurrParent := TSCSComponent(CurrParent).Parent; end; end; function TSCSComponent.GetFullnessPercentCableCanal: Double; var CurrVolume: Double; TotalCableVolume: Double; begin Result := 0; if ComponentType.SysName = ctsnCableChannel then begin CurrVolume := GetVolume(gtFemale); TotalCableVolume := GetCablesVolume; if ((TotalCableVolume) <> 0) and (CurrVolume <> 0) then Result := Round3((TotalCableVolume / CurrVolume) * 100); end; end; function TSCSComponent.GetGraphicalImageBlk: TMemoryStream; begin Result := GetImageFromObjectIcons(IDSymbol, ieBLK, GUIDSymbol); end; function TSCSComponent.GetIOfIRelByInterfaceOwnerOrTo(AInterface: TSCSInterface; ARecursive: Boolean): TSCSIOfIRel; var i, j: Integer; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; begin Result := nil; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; for j := 0 to Interf.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.FIOfIRelOut[j]); if (IOfIRel.IDInterfRel = AInterface.ID) or (IOfIRel.IDInterfTo = AInterface.ID) then begin Result := IOfIRel; Break; //// BREAK //// end; end; end; if ARecursive and (Result = nil) then for i := 0 to FChildReferences.Count - 1 do begin Result := FChildReferences[i].GetIOfIRelByInterfaceOwnerOrTo(AInterface, ARecursive); if Result <> nil then Break; //// BREAK //// end; end; function TSCSComponent.GetInterfaceAsNew: TSCSInterface; var Interfac: TSCSInterface; begin Result := nil; //GetMem(Interfac, SizeOf(TInterface)); Interfac := TSCSInterface.Create(FActiveForm); Interfac.ID := GenCurrProjTableID(giInterfaceRelationID); Interfac.ID_Component := ID; Interfac.IsLineCompon := IsLine; Interfac.ComponentOwner := Self; Interfaces.Add(Interfac); //Interfac^.IOfIRelOut := TList.Create; //Interfac^.ConnectedInterfaces := TList.Create; //Interfac.ParallelInterface := nil; Result := Interfac; end; function TSCSComponent.GetInterfaceByID(AIDInterfRel: Integer; ARecursive: Boolean = false): TSCSInterface; var i: Integer; Interf: TSCSInterface; ChildCompon: TSCSComponent; begin Result := nil; for i := 0 to Interfaces.Count - 1 do begin //Interf := Interfaces[i]; Interf := TSCSInterface(Interfaces.List.List^[i]); if Interf <> nil then if Interf.ID = AIDInterfRel then begin Result := Interf; Break; ///// BREAK ///// end; end; if ARecursive then for i := 0 to FChildComplects.Count - 1 do begin ChildCompon := FChildComplects[i]; Result := ChildCompon.GetInterfaceByID(AIDInterfRel, ARecursive); if Result <> nil then Break; //// BREAK //// end; end; function TSCSComponent.GetInterfaceByIDConnected(AIDConnected: Integer): TSCSInterface; var i: Integer; Interf: TSCSInterface; begin Result := nil; for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces[i]; if Interf <> nil then if Interf.IDConnected = AIDConnected then begin Result := Interf; Break; ///// BREAK ///// end; end; end; function TSCSComponent.GetinterfacesConnectedToInterface(AInterface: TSCSInterface): TSCSInterfaces; var i, j, k, l: Integer; Interfac: TSCSInterface; IOfIRel: TSCSIOfIRel; begin Result := nil; Result := TSCSInterfaces.Create(false); if Assigned(AInterface.IOfIRelOut) then for i := 0 to AInterface.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterface.IOfIRelOut[i]); if IOfIRel.InterfaceTo <> nil then Result.Add(IOfIRel.InterfaceTo); end; //*** Найти указатель на этот интерфейс в подсоединенных компонентах for i := 0 to FJoinedComponents.Count - 1 do if Assigned(FJoinedComponents[i]) then for j := 0 to FJoinedComponents[i].FInterfaces.Count - 1 do begin Interfac := FJoinedComponents[i].FInterfaces[j]; if Assigned(Interfac.IOfIRelOut) then for l := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[l]); if IOfIRel.InterfaceTo = AInterface then Result.Add(Interfac); end; end; end; function TSCSComponent.GetInterfacesConnectedToInterfaceOtherCompon(AInterface: TSCSInterface): TSCSInterfaces; var i: Integer; ConnectedInterfaces, ConnectedInterf: TSCSInterfaces; ptrConnectedInterface: TSCSInterface; LookedInterf: TRapList; begin Result := nil; Result := TSCSInterfaces.Create(false); if Assigned(AInterface) then begin ConnectedInterfaces := GetConnectedInterfacesByConnectOrder(AInterface); if ConnectedInterfaces.Count > 0 then begin LookedInterf := TRapList.Create; for i := 0 to ConnectedInterfaces.Count - 1 do //for i := 0 to AInterface.ConnectedInterfaces.Count - 1 do begin //ptrConnectedInterface := AInterface.ConnectedInterfaces[i]; ptrConnectedInterface := TSCSInterface(ConnectedInterfaces.List.List^[i]); if LookedInterf.IndexOf(ptrConnectedInterface) = -1 then //24.03.2009 begin LookedInterf.Add(ptrConnectedInterface); if (ptrConnectedInterface.IsLineCompon = biTrue) and (AInterface.IsLineCompon = biTrue) and (ptrConnectedInterface.ComponentOwner.Whole_ID = AInterface.ComponentOwner.Whole_ID) then begin //if LookedInterf.IndexOf(ptrConnectedInterface) = -1 then //24.03.2009 begin //LookedInterf.Add(ptrConnectedInterface); ConnectedInterf := GetInterfacesConnectedToInterfaceOtherCompon(ptrConnectedInterface.ParallelInterface); if Assigned(ConnectedInterf) then begin //20.03.2009 Result.Assign(ConnectedInterf, laOr); //for j := 0 to ConnectedInterf.Count - 1 do // Result.Add(ConnectedInterf[j]); Result.AddItems(ConnectedInterf); FreeAndNil(ConnectedInterf); end; end; end else Result.Add(ptrConnectedInterface); end; end; FreeAndNil(LookedInterf); end; FreeAndNil(ConnectedInterfaces); end; end; function TSCSComponent.GetInterfacesConnectedToConnCompon(AInterface: TSCSInterface; AResConnComponPath: TSCSComponents; AJoinedInterfacesToResult: TSCSInterfaces): TSCSInterfaces; var i, j: Integer; ConnectedInterface, Port: TSCSInterface; ConnectedInterfasesToInterf, JoinedInterfaces, DepthComponInternalJoinInterfaces: TSCSInterfaces; //ComponsInPath: TSCSComponents; IsConnectedInterfToOtherCompon: Integer; DepthJoinedConnCompon: TSCSComponent; LookedInterf: TRapList; //13.10.2013 PortFromPos, PortToPos: Integer; begin Result := nil; Result := TSCSInterfaces.Create(false); if Assigned(AInterface) then begin //ComponsInPath := AComponsInPath; //if AComponsInPath = nil then // ComponsInPath := TSCSComponents.Create(false); //if ComponsInPath.IndexOf(AInterface.FComponentOwner) = -1 then //begin // ComponsInPath.Add(AInterface.FComponentOwner); IsConnectedInterfToOtherCompon := biNone; JoinedInterfaces := GetConnectedInterfacesByConnectOrder(AInterface); if JoinedInterfaces.Count > 0 then begin LookedInterf := TRapList.Create; //for i := 0 to AInterface.FConnectedInterfaces.Count - 1 do for i := 0 to JoinedInterfaces.Count - 1 do begin //ConnectedInterface := AInterface.FConnectedInterfaces[i]; ConnectedInterface := TSCSInterface(JoinedInterfaces.List.List^[i]); if LookedInterf.IndexOf(ConnectedInterface) = -1 then //24.03.2009 begin LookedInterf.Add(ConnectedInterface); //24.03.2009 if (AInterface.IsLineCompon = biTrue) and (ConnectedInterface.IsLineCompon = biTrue) then begin //24.03.2009 if LookedInterf.IndexOf(ConnectedInterface) = -1 then begin //24.03.2009 LookedInterf.Add(ConnectedInterface); if ConnectedInterface.ParallelInterface = nil then ConnectedInterface.ComponentOwner.SetInterfacesParallel; ConnectedInterfasesToInterf := GetInterfacesConnectedToConnCompon(ConnectedInterface.ParallelInterface, AResConnComponPath, AJoinedInterfacesToResult); if Assigned(ConnectedInterfasesToInterf) then begin //23.03.2009 Result.Assign(ConnectedInterfasesToInterf, laCopy); //Result.Assign(ConnectedInterfs, laOr); Result.AddItems(ConnectedInterfasesToInterf); FreeAndNil(ConnectedInterfasesToInterf); end; end; end else if ConnectedInterface.IsLineCompon = biFalse then begin if IsConnectedInterfToOtherCompon = biNone then begin //13.10.2013 - Определяем подключенные позиции порта к которым подключен интерфейс линейного компонента Port := nil; PortFromPos := 0; PortToPos := 0; if AInterface.IsLineCompon = biTrue then begin if ConnectedInterface.IsPort = biTrue then Port := ConnectedInterface else Port := ConnectedInterface.PortOwner; if Port <> nil then GetNppPortByConnected(Port, ConnectedInterface, AInterface, -1, @PortFromPos, @PortToPos); end; DepthComponInternalJoinInterfaces := TSCSInterfaces.Create(false); DepthJoinedConnCompon := GetDepthJoinedConnComponByConnCompon(ConnectedInterface.FComponentOwner, AResConnComponPath, nil, DepthComponInternalJoinInterfaces, AJoinedInterfacesToResult, Port, PortFromPos, PortToPos, false //13.10.2013 учитываем подключение через позиции порта, но не до порта ); //*** Если есть внутри компоненты подключенная еще одна компонента, // тогда выходим из цикла, и не смотрим другие интерфейсы и возможность их подключения // к другим внутренним компонентам if DepthJoinedConnCompon <> ConnectedInterface.FComponentOwner then begin IsConnectedInterfToOtherCompon := biTrue; //23.03.2009 Result.Assign(DepthComponInternalJoinInterfaces); Result.AddItems(DepthComponInternalJoinInterfaces); Break; //// BREAK //// end else IsConnectedInterfToOtherCompon := biFalse; FreeAndNil(DepthComponInternalJoinInterfaces); end; if IsConnectedInterfToOtherCompon = biFalse then Result.Add(ConnectedInterface); end; end; end; FreeAndNil(LookedInterf); end; FreeAndNil(JoinedInterfaces); //ComponsInPath.Delete(ComponsInPath.Count-1); //end; //if AComponsInPath = nil then // FreeAndNil(ComponsInPath); end; end; function TSCSComponent.GetInterfacesConnectedToEndLineCompon(AInterface: TSCSInterface; AStepIndex: Integer = 0): TSCSInterfaces; var i: Integer; ptrConnectedInterface: TSCSInterface; //ConnectedInterf: TSCSInterfaces; ConnectedInterfacesByConnectOrder, LookedInterf: TSCSInterfaces; begin Result := nil; //Result := TSCSInterfaces.Create(false); if Assigned(AInterface) then if AInterface.ConnectedInterfaces.Count > 0 then begin LookedInterf := TSCSInterfaces.Create(false); ConnectedInterfacesByConnectOrder := GetConnectedInterfacesByConnectOrder(AInterface); for i := 0 to ConnectedInterfacesByConnectOrder.Count - 1 do //for i := 0 to AInterface.ConnectedInterfaces.Count - 1 do begin //ptrConnectedInterface := AInterface.ConnectedInterfaces[i]; ptrConnectedInterface := TSCSInterface(ConnectedInterfacesByConnectOrder.List.List^[i]); if LookedInterf.IndexOf(ptrConnectedInterface) =-1 then //24.03.2009 begin LookedInterf.Add(ptrConnectedInterface); //24.03.2009 if (ptrConnectedInterface.IsLineCompon = biTrue) and (AInterface.IsLineCompon = biTrue) and (ptrConnectedInterface.ComponentOwner.Whole_ID = AInterface.ComponentOwner.Whole_ID) then begin Result := GetInterfacesConnectedToEndLineCompon(ptrConnectedInterface.ParallelInterface, AStepIndex + 1); if Result <> nil then Break; //// BREAK //// end else begin Result := TSCSInterfaces.Create(false); Result.Add(AInterface); Break; //// BREAK //// end; end; end; FreeAndNil(ConnectedInterfacesByConnectOrder); FreeAndNil(LookedInterf); end; //*** Вернуть пустой лист if (Result = nil) and (AStepIndex = 0) then Result := TSCSInterfaces.Create(false); end; function TSCSComponent.GetInterfaceConnectedWithCompon(ASelfInterface: TSCSInterface; AConnectCompon: TSCSComponent): TSCSInterface; var i, j: Integer; IOfIRel: TSCSIOfIRel; ptrConnectedInterf: TSCSInterface; begin Result := nil; if (ASelfInterface = nil) or Not(Assigned(AConnectCompon)) then Exit; ///// EXIT ///// if Assigned(ASelfInterface.IOfIRelOut) then for i := 0 to ASelfInterface.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(ASelfInterface.IOfIRelOut[i]); if IOfIRel.InterfaceTo <> nil then if IOfIRel.InterfaceTo.ID_Component = AConnectCompon.ID then begin Result := IOfIRel.InterfaceTo; Exit; ///// EXIT ///// end; end; for i := 0 to AConnectCompon.Interfaces.Count - 1 do begin ptrConnectedInterf := AConnectCompon.Interfaces[i]; if Assigned(ptrConnectedInterf.IOfIRelOut) then for j := 0 to ptrConnectedInterf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(ptrConnectedInterf.IOfIRelOut[j]); if IOfIRel.InterfaceTo = ASelfInterface then begin Result := ptrConnectedInterf; Exit; ///// EXIT ///// end; end; end; end; function TSCSComponent.GetInterfcesCountByType(AInterfType: Integer): Integer; var i: Integer; Interfac: TSCSInterface; begin Result := 0; if FInterfaces.Count = 0 then LoadInterfaces(-1, false); for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac.TypeI = AInterfType then //Result := Interfac. Inc(Result); end; end; function TSCSComponent.GetInterfcesCountByTypeIsBusySide(AType, AIsBusy, ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; begin Result := 0; if FInterfaces.Count = 0 then LoadInterfaces(-1, false); for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if (Interfac.TypeI = AType) and (Interfac.IsBusy = AIsBusy) and ((Interfac.Side = ASide) or (ASide = biNone)) then Inc(Result); end; end; function TSCSComponent.GetInterfaceCountToConnect(ASide: Integer): Integer; var InterfToConnectCount: Integer; ParallelSide: Integer; begin Result := 0; InterfToConnectCount := 0; InterfToConnectCount := GetInterfaceCountToConnectBySide(ASide); if InterfToConnectCount = 0 then begin ParallelSide := GetParallelSide(ASide); if ParallelSide <> stNoneSide then InterfToConnectCount := GetInterfaceCountToConnectBySide(ParallelSide); end; Result := InterfToConnectCount; end; function TSCSComponent.GetInterfaceCountToConnectBySide(ASide: Integer): Integer; var i: Integer; Interfac: TSCSInterface; begin Result := 0; for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac.TypeI = itFunctional then if (Interfac.IsBusy <> biTrue) or (Interfac.Multiple = biTrue) then if ((Interfac.Side > 0) and (Interfac.Side = ASide)) or (Interfac.Side = 0) then begin if Interfac.Kolvo > Interfac.KolvoBusy then //Inc(Result); Result := Result + (Interfac.Kolvo - Interfac.KolvoBusy) else if Interfac.Multiple = biTrue then Result := Result + Interfac.Kolvo; end; end; end; function TSCSComponent.GetInterfacesByIsBusyAndType(AIsBusy, AType: Integer; AAccountChildCompons: Boolean): TList; var i: Integer; ChildComponInterfaces: TList; CurrInterface: TSCSInterface; begin Result := TList.Create; for i := 0 to FInterfaces.Count - 1 do begin CurrInterface := FInterfaces[i]; if (CurrInterface.IsBusy = AIsBusy) or (AIsBusy = biNone) then if CurrInterface.TypeI = AType then Result.Add(CurrInterface); end; if AAccountChildCompons then for i := 0 to FChildComplects.Count - 1 do if Assigned(FChildComplects[i]) then begin ChildComponInterfaces := FChildComplects[i].GetInterfacesByIsBusyAndType(AIsBusy, AType, AAccountChildCompons); if Assigned(ChildComponInterfaces) then begin Result.Assign(ChildComponInterfaces, laOr); FreeAndNil(ChildComponInterfaces); end; end; end; // ##### Вернет Порты/Интерфейсы из компоненты(+всех комплектующих) ##### function TSCSComponent.GetInterfacesByIsPort(AIsPort: Integer; ARecursive: Boolean; aIsBusy: Integer=-1; aDest: TSCSInterfaces=nil): TSCSInterfaces; var i: integer; Compon: TSCSComponent; procedure LoadInterfacesFromComponent(AComponent: TSCSComponent); var i: Integer; Interf: TSCSInterface; begin for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if (AIsPort = biNone) or (Interf.IsPort = AIsPort) then if (aIsBusy = biNone) or (Interf.IsBusy = aIsBusy) then Result.Add(Interf); end; end; begin Result := aDest; if Result = nil then Result := TSCSInterfaces.Create(false); LoadInterfacesFromComponent(Self); if ARecursive then for i := 0 to FChildReferences.Count - 1 do begin Compon := FChildReferences[i]; LoadInterfacesFromComponent(Compon); end; end; function TSCSComponent.GetInterfacesBySide(ASide: Integer): TList; var i: Integer; Interfac: TSCSInterface; begin Result := nil; Result := TList.Create; for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac.Side = ASide then Result.Add(Interfac); end; end; function TSCSComponent.GetInterfacesBySides: TInterfLists; var ptrInterf1, ptrInterf2: TSCSInterface; i, j: Integer; begin Result.InterfList1 := nil; Result.InterfList2 := nil; if IsLine = biFalse then Exit; //// EXIT //// Result.InterfList1 := TList.Create; Result.InterfList2 := TList.Create; for i := 0 to FInterfaces.Count - 1 do begin ptrInterf1 := FInterfaces[i]; if ptrInterf1.Side = 1 then if Result.InterfList1.IndexOf(ptrInterf1) = -1 then for j := 0 to FInterfaces.Count - 1 do begin ptrInterf2 := FInterfaces[j]; if ptrInterf2.Side = 2 then if (ptrInterf1.ID <> ptrInterf2.ID) and (ptrInterf1.ID = ptrInterf2.IDAdverse) and (ptrInterf1.IDAdverse = ptrInterf2.ID) then if Result.InterfList2.IndexOf(ptrInterf2) = -1 then if ptrInterf1.Npp = ptrInterf2.Npp then begin Result.InterfList1.Add(ptrInterf1); Result.InterfList2.Add(ptrInterf2); end; end; end; end; function TSCSComponent.GetInterfacesThatConnectComponent(AConnectedComponent: TSCSComponent): TInterfLists; procedure LoadConnectedInterfaces(AComponent1, AComponent2: TSCSComponent; AListForCompon1, AListForCompon2: TList); var i, j: Integer; ptrInterface1, ptrInterface2: TSCSInterface; IOfIRel: TSCSIOfIRel; begin for i := 0 to AComponent1.Interfaces.Count - 1 do begin ptrInterface1 := AComponent1.Interfaces[i]; if Assigned(ptrInterface1.IOfIRelOut) then for j := 0 to ptrInterface1.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(ptrInterface1.IOfIRelOut[j]); if IOfIRel.InterfaceTo <> nil then if IOfIRel.InterfaceTo.ID_Component = AComponent2.ID then begin AListForCompon1.Add(ptrInterface1); AListForCompon2.Add(IOfIRel.InterfaceTo); end; end; end; end; begin Result.InterfList1 := nil; Result.InterfList2 := nil; if Assigned(AConnectedComponent) then begin Result.InterfList1 := Tlist.Create; Result.InterfList2 := Tlist.Create; LoadConnectedInterfaces(Self, AConnectedComponent, Result.InterfList1, Result.InterfList2); LoadConnectedInterfaces(AConnectedComponent, Self, Result.InterfList2, Result.InterfList1); end; end; function TSCSComponent.GetItemType: TItemType; begin Result := GetItemTypeByIsLine(IsLine); end; function TSCSComponent.GetJoinedPointComponent: TSCSComponent; var ConnectedComponsInfo: TConnectedComponsInfo; ConnComponObject: TSCSCatalog; begin Result := nil; if (IsLine = biTrue) and (FProjectOwner <> nil) then begin //LoadWholeComponent(false); FirstIDCompon := 0; FirstCompon := nil; FirstIDConnectedConnCompon := 0; FirstConnectedConnCompon := nil; LastIDCompon := 0; LastCompon := nil; LastIDConnectedConnCompon := 0; LastConnectedConnCompon := nil; //*** Определить подключенные точечные компоненты ConnectedComponsInfo := FProjectOwner.FConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(Whole_ID, tcoFrom); if ConnectedComponsInfo.ComponWholeID > 0 then begin FirstIDCompon := ConnectedComponsInfo.IDSideCompon; FirstIDConnectedConnCompon := ConnectedComponsInfo.IDConnectCompon; ConnComponObject := FProjectOwner.GetCatalogFromReferences(ConnectedComponsInfo.IDConnectObject); if ConnComponObject <> nil then FirstConnectedConnCompon := ConnComponObject.GetComponentFromReferences(FirstIDConnectedConnCompon); end; ConnectedComponsInfo := FProjectOwner.FConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(Whole_ID, tcoTo); if ConnectedComponsInfo.ComponWholeID > 0 then begin LastIDCompon := ConnectedComponsInfo.IDSideCompon; LastIDConnectedConnCompon := ConnectedComponsInfo.IDConnectCompon; ConnComponObject := FProjectOwner.GetCatalogFromReferences(ConnectedComponsInfo.IDConnectObject); if ConnComponObject <> nil then LastConnectedConnCompon := ConnComponObject.GetComponentFromReferences(LastIDConnectedConnCompon); end; DefineFirstLast; if (FirstConnectedConnCompon <> nil) and (LastConnectedConnCompon = nil) then Result := FirstConnectedConnCompon else if (FirstConnectedConnCompon = nil) and (LastConnectedConnCompon <> nil) then Result := LastConnectedConnCompon; end; end; function TSCSComponent.GetLastNppInterface(const AGUIDInterface: string; AIsPort: Integer; ANoInCompon: TSCSComponent): Integer; var i, LastNpp, CurrLastNpp: Integer; Interfac: TSCSInterface; begin Result := 0; LastNpp := 0; if Self = ANoInCompon then Exit; //// EXIT //// for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if (Interfac.IsPort = AIsPort) and (Interfac.Npp > LastNpp) and (Interfac.GUIDInterface = AGUIDInterface) or (AGUIDInterface = '') then LastNpp := Interfac.Npp; end; //*** Посмотреть в комплектующих for i := 0 to FChildComplects.Count - 1 do if Assigned(FChildComplects[i]) then if FChildComplects[i] <> ANoInCompon then begin CurrLastNpp := FChildComplects[i].GetLastNppInterface(AGUIDInterface, AIsPort, ANoInCompon); if CurrLastNpp > LastNpp then LastNpp := CurrLastNpp; end; Result := LastNpp; end; {//20.08.2012 function TSCSComponent.GetLastNppPort: Integer; var i: Integer; Interfac: TSCSInterface; CurrLastNpp: Integer; begin Result := 0; for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if (Interfac.IsPort = biTrue) and (Interfac.NppPort > Result) then Result := Interfac.NppPort + Interfac.Kolvo - 1; end; //Посмотреть в комплектующих for i := 0 to FChildComplects.Count - 1 do begin CurrLastNpp := FChildComplects[i].GetLastNppPort; if CurrLastNpp > Result then Result := CurrLastNpp; end; end;} function TSCSComponent.GetListOwner: TSCSList; var //TopCatalog: TSCSCatalog; CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := FParent; while CurrParent <> nil do begin if CurrParent is TSCSComponent then CurrParent := TSCSComponent(CurrParent).FParent else if CurrParent is TSCSCatalog then begin if CurrParent is TSCSList then begin Result := TSCSList(CurrParent); CurrParent := nil; end else CurrParent := TSCSCatalog(CurrParent).FParent; end; end; //TopCatalog := GetTopParentCatalog; //if Assigned(TopCatalog) and (TopCatalog.ItemType = itProject) then // Result := TSCSList(TopCatalog.GetCatalogFromReferencesBySCSID(ListID)); end; function TSCSComponent.GetNewNumPair: Integer; var LastNumPair, CountInterfPair, i, j: Integer; SCSInterface: TSCSInterface; begin Result := 0; if IsLine = biTrue then begin //*** Найти последний номер пары LastNumPair := 0; for i := 0 to FInterfaces.Count - 1 do begin SCSInterface := FInterfaces[i]; if SCSInterface.TypeI = itFunctional then if SCSInterface.NumPair > LastNumPair then LastNumPair := SCSInterface.NumPair; end; if LastNumPair > 0 then begin for i := 0 to LastNumPair - 1 do begin //*** Найти количество пар текущег индекса i CountInterfPair := 0; for j := 0 to FInterfaces.Count - 1 do begin SCSInterface := FInterfaces[j]; if SCSInterface.TypeI = itFunctional then if SCSInterface.NumPair = i+1 then Inc(CountInterfPair); end; 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; end; // Tolik //function TSCSComponent.GetMaxNppPort: Integer; function TSCSComponent.GetMaxNppPort(aInterfaceGuid: string = ''): Integer; var MaxNpp, CurrNpp, i: Integer; ChildComponent, TopPortComponent: TSCSComponent; // function GetMaxNppPortFromCompon(ACompon: TSCSComponent): Integer; function GetMaxNppPortFromCompon(ACompon: TSCSComponent; InterfaceGuid: string = ''): Integer; var i: Integer; Interf: TSCSInterface; begin Result := 0; for i := 0 to ACompon.FInterfaces.Count - 1 do begin Interf := ACompon.FInterfaces[i]; if Interf.IsPort = biTrue then //Tolik { if Interf.NppPort > Result then Result := Interf.NppPort + Interf.Kolvo - 1; //Result := ACompon.FInterfaces[i].NppPort;} if InterfaceGuid = '' then begin if Interf.NppPort > Result then Result := Interf.NppPort + Interf.Kolvo - 1; end else begin if Interf.GUIDInterface = InterfaceGuid then begin if Interf.NppPort > Result then Result := Interf.NppPort + Interf.Kolvo - 1; end; end; // end; end; begin Result := 0; TopPortComponent := GetTopPortMultiportCompon; if Assigned(TopPortComponent) then begin Result := GetMaxNppPortFromCompon(TopPortComponent); for i := 0 to TopPortComponent.FChildReferences.Count - 1 do //20.08.2012 for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := TopPortComponent.FChildReferences[i]; //20.08.2012 FChildReferences[i]; if Assigned(ChildComponent) then begin // Tolik if ChildComponent <> Self then // begin //Tolik if aInterfaceGuid = '' then CurrNpp := GetMaxNppPortFromCompon(ChildComponent) else CurrNpp := GetMaxNppPortFromCompon(ChildComponent, aInterfaceGuid); // if CurrNpp > Result then Result := CurrNpp; end; end; end; end; end; function TSCSComponent.GetNameForVisible(AWithComponCount: Boolean = false): String; begin Result := ''; Result := GetComponNameForVisible(Name, NameMark); if AWithComponCount then Result := GetNameAndKol(Result, KolComplect); end; function TSCSComponent.GetObjectIconBlk: TMemoryStream; begin Result := GetImageFromObjectIcons(IDObjectIcon, ieBLK, GUIDObjectIcon); end; function TSCSComponent.GetParentComponent: TSCSComponent; begin Result := nil; if FParent is TSCSComponent then Result := TSCSComponent(FParent); end; function TSCSComponent.GetPartLength: Double; begin Result := 0; Result := GetLengthByComponent(Self); end; function TSCSComponent.GetPort: TSCSInterface; var ptrPort: TSCSInterface; i: Integer; begin Result := nil; for i := 0 to FInterfaces.Count - 1 do begin //ptrPort := FInterfaces[i]; ptrPort := TSCSInterface(FInterfaces.FItems.List^[i]); if ptrPort.IsPort = biTrue then begin Result := ptrPort; Break; ///// BREAK ///// end; end; end; function TSCSComponent.GetPortInterfRelByIDInterfRel(AIDInterfRel: Integer): PPortInterfRel; var i: Integer; Port: TSCSInterface; ptrPortInterfRel: PPortInterfRel; begin Result := nil; for i := 0 to FInterfaces.Count - 1 do begin Port := FInterfaces[i]; //if Port.isPort = biTrue then //##ISPORT begin ptrPortInterfRel := Port.GetPortInterfRelByInterfID(AIDInterfRel); if ptrPortInterfRel <> nil then begin Result := ptrPortInterfRel; Break; ///// BREAK ///// end; end; end; end; function TSCSComponent.GetPortJoinedToLine(ALineComponent: TSCSComponent): TSCSInterface; var InterfInConnection: TInterfLists; AllInterfaces: TList; CurrInterf, PortOwner: TSCSInterface; i: Integer; begin Result := nil; InterfInConnection := GetInterfacesThatConnectComponent(ALineComponent); AllInterfaces := TList.Create; try if Assigned(InterfInConnection.InterfList1) then AllInterfaces.Assign(InterfInConnection.InterfList1, laOr); if Assigned(InterfInConnection.InterfList2) then AllInterfaces.Assign(InterfInConnection.InterfList2, laOr); for i := 0 to AllInterfaces.Count - 1 do begin //CurrInterf := TSCSInterface(AllInterfaces[i]); CurrInterf := TSCSInterface(AllInterfaces.List^[i]); if CurrInterf.ID_Component = ID then begin if CurrInterf.IsPort = biTrue then begin Result := CurrInterf; Break; ///// BREAK ///// end else begin PortOwner := CurrInterf.PortOwner; if Assigned(PortOwner) then begin Result := PortOwner; Break; ///// BREAK ///// end; end; end; end; finally InterfInConnection.InterfList1.Free; InterfInConnection.InterfList2.Free; //Tolik FreeAndNil(AllInterfaces); // end; end; function TSCSComponent.GetPortKind: TPortKind; var ParentCompon: TSCSComponent; begin Result := pkPort; ParentCompon := Self; while ParentCompon <> nil do begin ParentCompon.LoadComponentType; if ParentCompon.ComponentType.PortKind = pkMultiport then begin Result := pkMultiport; Break; ///// BREAK ///// end; ParentCompon := ParentCompon.GetParentComponent; end; end; function TSCSComponent.GetPortMultiPortNameMarks: TStringList; var ChildComponent: TSCSComponent; ChildNameMarks: TStringList; i, j: Integer; Interf, Port, PortFromList: TSCSInterface; PortList: TRapList; JoinedCable: TSCSComponent; ResNameMark: String; ObjectOwner: TSCSCatalog; ListOwner: TSCSList; SprComponentType: TNBComponentType; begin Result := nil; if IsMarkInCaptions = biTrue then //21.08.2012 begin ChildNameMarks := nil; Result := TStringList.Create; //RefreshComponentType; //18.02.2009 if (NameShort <> '') and (NameMark <> '') and (GetPort <> nil) and (IsDismount = biFalse) then //18.02.2009 Result.Add(NameMark); //18.02.2009 ObjectOwner := nil; if (IsDismount = biFalse) and (NameMark <> '') then begin Port := nil; PortList := nil; for i := 0 to FInterfaces.Count - 1 do begin Interf := TSCSInterface(FInterfaces.FItems.List^[i]); if Interf.IsPort = biTrue then begin // Если это не первый порт в списке if Port <> nil then if PortList = nil then begin PortList := TRapList.Create; PortList.Add(Port); end; Port := Interf; if PortList <> nil then PortList.Add(Port); end; end; if (Port <> nil) and (PortList = nil) then if Port.Kolvo > 1 then begin PortList := TRapList.Create; PortList.Add(Port); end; //21.08.2012 // Если в списке только один порт, то в результат идет маркировка компонента //21.08.2012 if (Port <> nil) and (PortList = nil) then //21.08.2012 Если один порт или нету вобще, то в результат идет маркировка компонента if PortList = nil then begin Result.Add(NameMark); end else // Если в компоненте есть несколько портов if PortList <> nil then begin if FProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin //23.02.2009 Result.Add(NameMark); {for i := 0 to PortList.Count - 1 do begin PortFromList := TSCSInterface(PortList.List^[i]); for j := 0 to PortFromList.FPortInterfaces - 1 do begin PortInterface := PortFromList.PortInterface[j]; // Количество интерфейсов на порт InterfKolvoInPortRel := 1; ptrPortinterfRelation := PortFromList.GetPortInterfRelByInterfID(PortInterface.ID); if ptrPortinterfRelation <> nil then InterfKolvoInPortRel := ptrPortinterfRelation.UnitInterfKolvo; for k := 0 to PortFromList.Kolvo - 1 do begin PortNpp := k + 1; InterfToPos := PortNpp * InterfKolvoInPortRel; InterfFromPos := InterfToPos - (InterfKolvoInPortRel - 1); end; end; end;} for i := 0 to FJoinedComponents.Count - 1 do begin JoinedCable := TSCSComponent(FJoinedComponents.FItems.List^[i]); ResNameMark := MakeNameMarkThroughCableTIAEIA606A(JoinedCable, Self); if ResNameMark <> '' then Result.Add(ResNameMark); end; end else if FProjectOwner.Setting.MarkMode = mmTemplate then begin ListOwner := GetListOwner; if ListOwner <> nil then begin SprComponentType := ListOwner.FSpravochnik.GetComponentTypeByGUID(GUIDComponentType); if SprComponentType <> nil then begin // Если в шаблоне маркировки нету порта if Pos(mteComponPort, SprComponentType.ComponentType.MarkMask) = 0 then Result.Add(NameMark) else begin ObjectOwner := GetFirstParentCatalog; for i := 0 to PortList.Count - 1 do begin PortFromList := TSCSInterface(PortList.List^[i]); for j := 0 to PortFromList.Kolvo - 1 do begin Result.Add(MakeNameMarkForComponByPortNum(ObjectOwner, ListOwner, Self, PortFromList.NppPort + j, SprComponentType.ComponentType.MarkMask, SprComponentType.DefineMarkTemplateObjects)); end; end; end; end; end; end; end; end; end; if ComponentType.PortKind <> pkMultiPort then for i := 0 to FChildComplects.Count - 1 do begin //ChildComponent := FChildComplects[i]; ChildComponent := TSCSComponent(FChildComplects.FItems.List^[i]); if Assigned(ChildComponent) then begin ChildNameMarks := ChildComponent.GetPortMultiPortNameMarks; if Assigned(ChildNameMarks) then begin if Result = nil then Result := TStringList.Create; Result.Text := Result.Text + ChildNameMarks.Text; FreeAndNil(ChildNameMarks); end; end; end; end; function TSCSComponent.GetPropertyAsNew: PProperty; begin Result := inherited GetPropertyAsNew; if Result <> nil then Result.IDMaster := ID; end; function TSCSComponent.GetTopComponent: TSCSComponent; var ParentCompon: TSCSComponent; begin Result := Self; ParentCompon := Self; while Assigned(ParentCompon) do begin if ParentCompon.Parent is TSCSComponent then begin ParentCompon := TSCSComponent(ParentCompon.Parent); Result := ParentCompon; end else ParentCompon := nil; end; end; function TSCSComponent.GetTopParentCatalog: TSCSCatalog; var CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := FParent; while CurrParent <> nil do begin if CurrParent is TSCSCatalog then Result := TSCSCatalog(CurrParent); if CurrParent is TSCSComponent then CurrParent := TSCSComponent(CurrParent).Parent; if CurrParent is TSCSCatalog then CurrParent := TSCSCatalog(CurrParent).Parent; end; end; function TSCSComponent.GetTopPortMultiportCompon: TSCSComponent; var ParentCompon: TSCSComponent; begin Result := Self; ParentCompon := Self; while Assigned(ParentCompon) do begin if ParentCompon.Parent is TSCSComponent then begin ParentCompon := TSCSComponent(ParentCompon.Parent); Result := ParentCompon; if Result.ComponentType.PortKind = pkMultiPort then ParentCompon := nil; end else ParentCompon := nil; end; end; function TSCSComponent.HaveInterfaceByGUIDInterface(AGUIDInterface: string): Boolean; var i: Integer; begin Result := false; for i := 0 to FInterfaces.Count - 1 do if FInterfaces[i].GUIDInterface = AGUIDInterface then begin Result := true; Break; ///// BREAK ///// end; end; function TSCSComponent.HaveJoinWithOtherObject: Boolean; var i: Integer; SelfOwnerObject: TSCSCatalog; function HaveComponJoinWithOtherObject(AComponent: TSCSComponent): Boolean; var i: Integer; JoinOwnerObject: TSCSCatalog; begin Result := false; JoinOwnerObject := nil; for i := 0 to AComponent.FJoinedComponents.Count - 1 do if Assigned(AComponent.FJoinedComponents[i]) then begin JoinOwnerObject := AComponent.FJoinedComponents[i].GetFirstParentCatalog; if Assigned(JoinOwnerObject) then if SelfOwnerObject <> JoinOwnerObject then begin Result := true; Break; ///// BREAK ///// end; end; end; begin Result := false; SelfOwnerObject := nil; SelfOwnerObject := GetFirstParentCatalog; if Assigned(SelfOwnerObject) then begin if HaveComponJoinWithOtherObject(Self) then Result := true else for i := 0 to FChildReferences.Count - 1 do if Assigned(FChildReferences[i]) then if HaveComponJoinWithOtherObject(FChildReferences[i]) then begin Result := true; Break; ///// BREAK ///// end; end; end; function TSCSComponent.IsCrossComponent: Boolean; begin Result := false; if ComponentType.SysName = ctsnPatchCord then Result := true; end; function TSCSComponent.JoinTo(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer; ACanConnBusyMultiple: Boolean = false; ASelfInterfaces: TSCSInterfaces = nil; AComponInterfaces: TSCSInterfaces = nil; AMaxInterfCount: Integer = -1; AIsFinalConnection: Boolean = true; ACanWithNoInterfaces: Boolean = false; ACanJoinWithNoParams: Boolean = false): TConnectInterfRes; var ParallelSide: Integer; CheckConnectInterfRes: TConnectInterfRes; CanJoinWithNoInterfaces, CanJoinWithNoParams: Boolean; SelfComponent, JoinComponent: TSCSComponent; RelatedToRotate: TSCSComponents; begin ZeroMemory(@Result, SizeOf(TConnectInterfRes)); CanJoinWithNoInterfaces := ACanWithNoInterfaces; CanJoinWithNoParams := ACanJoinWithNoParams; SelfComponent := Self; JoinComponent := AJoinComponent; DefineJoiningComponentsByTrunk(SelfComponent, JoinComponent, ASelfSide, AJoinSide); if (SelfComponent <> nil) and (JoinComponent <> nil) then begin Result := SelfComponent.ConnectWith(JoinComponent, ASelfSide, AJoinSide, -1, AMaxInterfCount, cntUnion, false, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces, AIsFinalConnection); if Result.CanConnect = false then begin //RelatedToRotate := TSCSComponents.Create(false); RelatedToRotate := nil; if (SelfComponent.CheckForRotate(RelatedToRotate)) and (ASelfSide > 0) then begin ParallelSide := GetParallelSide(ASelfSide); if ParallelSide <> stNoneSide then begin CheckConnectInterfRes := SelfComponent.ConnectWith(JoinComponent, ParallelSide, AJoinSide, -1, AMaxInterfCount, cntUnion, true, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces, AIsFinalConnection); if CheckConnectInterfRes.CanConnect then begin Self.Rotate(false, RelatedToRotate); Result := SelfComponent.ConnectWith(JoinComponent, ASelfSide, AJoinSide, -1, AMaxInterfCount, cntUnion, false, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces, AIsFinalConnection); end; end; end; if Result.CanConnect = false then begin if (JoinComponent.CheckForRotate(RelatedToRotate)) and (AJoinSide > 0) then begin ParallelSide := GetParallelSide(AJoinSide); if ParallelSide <> stNoneSide then begin CheckConnectInterfRes := SelfComponent.ConnectWith(JoinComponent, ASelfSide, ParallelSide, -1, AMaxInterfCount, cntUnion, true, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces, AIsFinalConnection); if CheckConnectInterfRes.CanConnect then begin JoinComponent.Rotate(false, RelatedToRotate); Result := SelfComponent.ConnectWith(JoinComponent, ASelfSide, AJoinSide, -1, AMaxInterfCount, cntUnion, false, ACanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, ASelfInterfaces, AComponInterfaces, AIsFinalConnection); end; end; end; end; FreeAndNil(RelatedToRotate); end; if Result.CanConnect then begin SelfComponent.ServInterfCntToConnect := SelfComponent.ServInterfCntToConnect - Result.ConnectInterfCount; JoinComponent.ServInterfCntToConnect := JoinComponent.ServInterfCntToConnect - Result.ConnectInterfCount; if (SelfComponent.ServInterfCntToConnect <= 0) and Not(SelfComponent.HaveMultipleInterface(True)) then SelfComponent.ServCanConnect := false; if (JoinComponent.ServInterfCntToConnect <= 0) and Not(JoinComponent.HaveMultipleInterface(True)) then JoinComponent.ServCanConnect := false; end; end; end; function TSCSComponent.JoinToAsNoFinal(AJoinComponent: TSCSComponent; ASelfSide, AJoinSide: Integer): TConnectInterfRes; begin Result := JoinTo(AJoinComponent, ASelfSide, AJoinSide, false, nil, nil, -1, false); end; procedure TSCSComponent.LoadNet(const AGUIDJoinedNetType: String); var BufNet: TList; begin ClearFNet; BufNet := GetNetFromComponenet(Self, AGUIDJoinedNetType, false); if Assigned(BufNet) then begin FNet.Assign(BufNet); // Tolik 11/05/2019 -- //FreeAndNil(BufNet); //FreeList(BufNet); // end; end; procedure TSCSComponent.LoadPropertyesFromComponentType; var ptrProperty: PProperty; SprComponentType: TNBComponentType; SprCompTypeProperty: TNBCompTypeProperty; SprProperty: TNBProperty; i: Integer; CurrPropSysNames: TStringList; begin CurrPropSysNames := CreateStringListSorted; for i := 0 to FProperties.Count - 1 do CurrPropSysNames.Add(PProperty(FProperties[i])^.SysName); if TF_Main(FActiveForm).GDBMode = bkNormBase then begin ClearAndDisposeList(FProperties); //16.10.2007 ClearList(FProperties); SetSQLToFIBQuery(FQSelect, ' SELECT ID_PROPERTY, PVALUE, TAKE_INTO_CONNECT, TAKE_INTO_JOIN, '+ ' NAME, SYSNAME, IZM, DESCRIPTION, ID_DATA_TYPE '+ ' FROM COMP_TYPE_PROP_RELATION, PROPERTIES '+ ' WHERE (ID_COMPONENT_TYPE = '''+IntToStr(ID_ComponentType)+''') AND (PROPERTIES.ID = ID_PROPERTY) '); while Not FQSelect.Eof do begin if CurrPropSysNames.IndexOf(FQSelect.FN(fnSysName).AsString) = -1 then begin ptrProperty := GetPropertyAsNew; ptrProperty.ID_Property := FQSelect.FN(fnIDProperty).AsInteger; ptrProperty.Name_ := FQSelect.FN(fnName).AsString; ptrProperty.SysName := FQSelect.FN(fnSysName).AsString; ptrProperty.Value := FQSelect.FN(fnPValue).AsString; ptrProperty.IsDefault := biTrue; ptrProperty.GUIDProperty := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, ptrProperty.ID_Property, qmPhisical); ptrProperty.IDDataType := FQSelect.FN(fnIDDataType).AsInteger; ptrProperty.TakeIntoConnect := FQSelect.FN(fnTakeIntoConnect).AsInteger; ptrProperty.TakeIntoJoin := FQSelect.FN(fnTakeIntoJoin).AsInteger; //ptrProperty.IsTakeJoinforPoint := FQuery_Select.GetFNAsInteger(fnIsTakeJoinForPoints); ptrProperty.IsCrossControl := biFalse; //ptrProperty.IDCrossProperty := GetFNAsInteger(fnIDCrossProperty); //ptrProperty.GUIDCrossProperty := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, Propert.IDCrossProperty, qmPhisical); ptrProperty.IsNew := false; ptrProperty.IsModified := false; CurrPropSysNames.Add(ptrProperty.SysName); end; FQSelect.Next; end; end else begin ClearAndDisposeList(FProperties); if FProjectOwner <> nil then begin SprComponentType := FProjectOwner.FSpravochnik.GetComponentTypeByGUID(GUIDComponentType); if SprComponentType <> nil then for i := 0 to SprComponentType.FProperties.Count - 1 do begin SprCompTypeProperty := TNBCompTypeProperty(SprComponentType.FProperties[i]); if CurrPropSysNames.IndexOf(SprCompTypeProperty.PropertyData.SysName) = -1 then begin ptrProperty := GetPropertyAsNew; //ptrProperty.ID_Property := SprCompTypeProperty.PropertyData.ID_Property; //ptrProperty.Name_ := SprCompTypeProperty.PropertyData.Name_; //ptrProperty.SysName := SprCompTypeProperty.PropertyData.SysName; //ptrProperty.Value := SprCompTypeProperty.PropertyData.Value; //ptrProperty.IsDefault := biTrue; //ptrProperty.GUIDProperty := SprCompTypeProperty.PropertyData.GUIDProperty; //ptrProperty.TakeIntoConnect := SprCompTypeProperty.PropertyData.TakeIntoConnect; //ptrProperty.TakeIntoJoin := SprCompTypeProperty.PropertyData.TakeIntoJoin; SprCompTypeProperty.AssignToPProperty(ptrProperty); SprProperty := FProjectOwner.FSpravochnik.GetPropertyByGUID(SprCompTypeProperty.PropertyData.GUIDProperty); if SprProperty <> nil then begin ptrProperty.SysName := SprProperty.PropertyData.SysName; ptrProperty.Name_ := SprProperty.PropertyData.Name; ptrProperty.IDDataType := SprProperty.PropertyData.IDDataType; end; ptrProperty.IsCrossControl := biFalse; ptrProperty.IsNew := false; ptrProperty.IsModified := false; CurrPropSysNames.Add(ptrProperty.SysName); end; end; end; end; FreeAndNil(CurrPropSysNames); end; procedure TSCSComponent.NotifyChange; begin inherited; ServAllLoaded := false; // Tolik 03/07/2017 -- сброс для CashedCompon (чтобы не пришли значения с предидущего проекта) if Assigned(Self.ActiveForm) then if TF_Main(Self.ActiveForm).GDBMode = bkNormBase then begin if Assigned(F_ProjMan) then if TF_Main(F_ProjMan).CashedCompon <> nil then TF_Main(F_ProjMan).CashedCompon.Clear; if Assigned(F_NormBase) then if TF_Main(F_NormBase).CashedCompon <> nil then TF_Main(F_NormBase).CashedCompon.Clear; end; // end; procedure TSCSComponent.ApplyChanges; begin if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsInFuture(Self.GetFirstParentCatalog); if Self.ID = TF_Main(FActiveForm).GSCSBase.SCSComponent.ID then TF_Main(FActiveForm).RefreshNode(false); end; Self.NotifyChange; end; function TSCSComponent.Ping(AComponent: TSCSComponent; aBreakCompon: TObject): Boolean; var LineCount, PointCount: Integer; function Step(AStepCompon: TSCSComponent; AInOrder: TSCSComponents): Boolean; var CurrOrder: TSCSComponents; JoinedCompon: TSCSComponent; CanStep, InternalRes: Boolean; i, j: Integer; begin Result := false; if {(LineCount >= 2) and} (PointCount >= 2) then Exit; ///// EXIT ///// if AStepCompon.IsLine = biTrue then Inc(LineCount) else Inc(PointCount); if AStepCompon = AComponent then Result := true else begin CurrOrder := TSCSComponents.Create(false); CurrOrder.Add(AStepCompon); if Assigned(AInOrder) then CurrOrder.AddItems(AInOrder); CurrOrder.AddItems(AStepCompon.JoinedComponents); for i := 0 to AStepCompon.JoinedComponents.Count - 1 do begin JoinedCompon := AStepCompon.JoinedComponents[i]; CanStep := true; if Assigned(aBreakCompon) then begin if aBreakCompon is TSCSComponent then begin if JoinedCompon = aBreakCompon then CanStep := false; end; end; if Assigned(AInOrder) and (AInOrder.IndexOf(JoinedCompon) <> -1) then CanStep := false; if CanStep then begin InternalRes := false; InternalRes := Step(JoinedCompon, CurrOrder); if InternalRes then begin Result := true; Break; ///// BREAK ///// end; end; end; CurrOrder.DeleteLastCount(AStepCompon.JoinedComponents.Count); if Assigned(AInOrder) then CurrOrder.DeleteLastCount(AInOrder.Count); CurrOrder.Free; end; if AStepCompon.IsLine = biTrue then Dec(LineCount) else Dec(PointCount); end; begin Result := false; LineCount := 0; PointCount := 0; {if IsLine = biTrue then Inc(LineCount) else Inc(PointCount);} Result := Step(Self, nil); end; procedure TSCSComponent.ReloadChildReferences; procedure LoadChildsToReferences(AComponent: TSCSComponent); var i: Integer; ChildComponent: TSCSComponent; begin for i := 0 to AComponent.FChildComplects.Count - 1 do begin ChildComponent := AComponent.FChildComplects[i]; FChildReferences.Add(ChildComponent); LoadChildsToReferences(ChildComponent); end; end; begin FChildReferences.Clear; LoadChildsToReferences(Self); end; procedure TSCSComponent.RefreshComponentType; begin LoadComponentType; end; procedure TSCSComponent.RefreshInterfacesJoining; var i: Integer; begin for i := 0 to FJoinedComponents.Count - 1 do SetInterfacesJoining(FJoinedComponents[i]); end; procedure TSCSComponent.RefreshPriceAfterChangeNDS(AOldNDS, ANewNDS: Double; ASave: Boolean); begin Price := GetPriceAfterChangeNDS(Price, AOldNDS, ANewNDS); Price_Calc := GetPriceAfterChangeNDS(Price_Calc, AOldNDS, ANewNDS); if ASave then SaveComponent; end; procedure TSCSComponent.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean; ARecursive: Boolean = true); var i: Integer; ChildComponent: TSCSComponent; begin //CorrectCurrency(AOldCurrency); if AOldCurrency.Ratio <> 0 then begin PriceSupply := GetPriceAfterChangeCurrency(PriceSupply, AOldCurrency, ANewCurrency); Price := GetPriceAfterChangeCurrency(Price, AOldCurrency, ANewCurrency); Price_Calc := GetPriceAfterChangeCurrency(Price_Calc, AOldCurrency, ANewCurrency); with TF_Main(FActiveForm).DM do if ASave then begin //UpdateComponFieldAsFloat(FID, Price, fnPrice); //UpdateComponFieldAsFloat(FID, Price, fnPriceCalc); end; FNormsResources.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); if ARecursive then for i := 0 to FChildComplects.Count - 1 do begin ChildComponent := FChildComplects[i]; if Assigned(ChildComponent) then ChildComponent.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; end; end; procedure TSCSComponent.RefreshWholeLengthIfNecessary; begin if IsLine = biTrue then if ServChangedLength <> biFalse then RefreshWholeLength else Length := GetPropertyValueAsFloat(pnLength); end; procedure TSCSComponent.RefreshWholeLengthInFuture(aWholeComponObj: TSCSComponents=nil); var TopCatalog: TSCSCatalog; i, IDPart: Integer; WholeComponents: TSCSComponents; PartComponent: TSCSComponent; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin if IsLine = biTrue then begin WholeComponents := aWholeComponObj; if WholeComponents = nil then begin TopCatalog := GetTopParentCatalog; if Assigned(TopCatalog) then WholeComponents := TopCatalog.GetComponentsByWholeID(Whole_ID); end; if WholeComponents <> nil then begin try for i := 0 to WholeComponents.Count - 1 do begin PartComponent := WholeComponents[i]; if Assigned(PartComponent) then PartComponent.ServChangedLength := biTrue; end; finally if aWholeComponObj = nil then WholeComponents.Free; end; end; end; end; procedure TSCSComponent.RemoveChildComponent(AComponent: TSCSComponent); var ptrComplect: PComplect; begin if Assigned(AComponent) then if FChildComplects.Remove(AComponent) <> -1 then begin AComponent.Parent := nil; ptrComplect := GetComplectByIDChild(AComponent.ID); if ptrComplect <> nil then FComplects.Remove(ptrComplect); end; end; procedure TSCSComponent.RemoveJoinedComponent(AComponent: TSCSComponent); var ptrConnection: PComplect; begin if Assigned(AComponent) then if FJoinedComponents.Remove(AComponent) <> -1 then begin ptrConnection := GetConnectionByConnected(AComponent); if ptrConnection <> nil then FConnections.Remove(ptrConnection); end; end; function TSCSComponent.Rotate(ACheckToRotate: Boolean; ARelatedToRotate: TSCSComponents): Boolean; var RelatedToRotate: TSCSComponents; CreatedRelatedToRotate: Boolean; IsCanRotate: Boolean; i: Integer; procedure RotateOneCompon(AComponToRotate: TSCSComponent); var Interfac: TSCSInterface; i: integer; ParallelSide: Integer; begin for i := 0 to AComponToRotate.FInterfaces.Count - 1 do begin Interfac := TSCSInterface(AComponToRotate.FInterfaces.FItems.List^[i]); if Interfac.Side > 0 then begin ParallelSide := GetParallelSide(Interfac.Side); if ParallelSide > 0 then begin Interfac.Side := ParallelSide; //TF_Main(FActiveForm).DM.UpdateInterfFieldAsInteger(Interfac.ID, ParallelSide, fnSide); Result := true; end; end; end; end; begin Result := false; //06.11.2008 CreatedRelatedToRotate := false; RelatedToRotate := nil; {if (ARelatedToRotate = nil) or ACheckToRotate then begin RelatedToRotate := TSCSComponents.Create(false); CreatedRelatedToRotate := true; end else if Not ACheckToRotate then RelatedToRotate := ARelatedToRotate;} if Not ACheckToRotate or CheckForRotate(RelatedToRotate) then begin RotateOneCompon(Self); if RelatedToRotate <> nil then for i := 0 to RelatedToRotate.Count - 1 do RotateOneCompon(TSCSComponent(RelatedToRotate.FItems.List^[i])); Result := true; end; if CreatedRelatedToRotate then FreeAndNil(RelatedToRotate); end; procedure TSCSComponent.SaveCableCanalConnectorsByServFields; var i: integer; ptrCableCanalConnector: PCableCanalConnector; begin for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; if ptrCableCanalConnector.IsNew then begin ptrCableCanalConnector.IDCableCanal := ID; SaveCableCanalConnector(meMake, ptrCableCanalConnector); end else if ptrCableCanalConnector.IsModified then SaveCableCanalConnector(meEdit, ptrCableCanalConnector); end; end; procedure TSCSComponent.SaveCrossConnectionsByServFields; var ptrCrossConnection: TSCSCrossConnection; i: Integer; begin for i := 0 to FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(FCrossConnections[i]); if ptrCrossConnection.IsNew then ptrCrossConnection.Save(meMake, false) //TF_Main(FActiveForm).DM.InsertUpdateCrossConnection(meMake, ptrCrossConnection) else if ptrCrossConnection.IsModified then ptrCrossConnection.Save(meEdit, false); //TF_Main(FActiveForm).DM.InsertUpdateCrossConnection(meEdit, ptrCrossConnection); end; end; procedure TSCSComponent.SetInterfacesJoining(AJoinedComponent: TSCSComponent); var i, j, k: Integer; Interfac, ptrJoinedInterface: TSCSInterface; IOfIRel: TSCSIOfIRel; begin for i := 0 to FInterfaces.Count - 1 do begin //Interfac := FInterfaces[i]; Interfac := TSCSInterface(FInterfaces.FItems[i]); for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); ptrJoinedInterface := AJoinedComponent.GetInterfaceByID(IOfIRel.IDInterfTo); if ptrJoinedInterface <> nil then begin IOfIRel.InterfaceTo := ptrJoinedInterface; Interfac.AddToConnectedInterfaces(ptrJoinedInterface); //23.03.2009 }Interfac.ConnectedInterfaces.Add(ptrJoinedInterface); ptrJoinedInterface.AddToConnectedInterfaces(Interfac); //23.03.2009 }ptrJoinedInterface.ConnectedInterfaces.Add(Interfac); for k := 0 to IOfIRel.FPosConnections.Count - 1 do SetLinkToInterfPosConnection(TSCSInterfPosConnection(IOfIRel.FPosConnections[k]), Interfac, ptrJoinedInterface); end; end; end; for i := 0 to AJoinedComponent.Interfaces.Count - 1 do begin //Interfac := AJoinedComponent.Interfaces[i]; Interfac := TSCSInterface(AJoinedComponent.FInterfaces.FItems[i]); for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); ptrJoinedInterface := GetInterfaceByID(IOfIRel.IDInterfTo); if ptrJoinedInterface <> nil then begin IOfIRel.InterfaceTo := ptrJoinedInterface; Interfac.AddToConnectedInterfaces(ptrJoinedInterface); //23.03.2009 }Interfac.ConnectedInterfaces.Add(ptrJoinedInterface); ptrJoinedInterface.AddToConnectedInterfaces(Interfac); //23.03.2009 }ptrJoinedInterface.ConnectedInterfaces.Add(Interfac); for k := 0 to IOfIRel.FPosConnections.Count - 1 do SetLinkToInterfPosConnection(TSCSInterfPosConnection(IOfIRel.FPosConnections[k]), Interfac, ptrJoinedInterface); end; end; end; end; procedure TSCSComponent.SetInterfacesParallel; var i, j: Integer; Interfac, ptrParallel: TSCSInterface; begin if IsLine = biTrue then for i := 0 to FInterfaces.Count - 1 do begin //Interfac := FInterfaces[i]; Interfac := TSCSInterface(FInterfaces.FItems[i]); if (Interfac.IDAdverse > 0) and (Interfac.Side = 1) then for j := 0 to FInterfaces.Count - 1 do begin //ptrParallel := FInterfaces[j]; ptrParallel := TSCSInterface(FInterfaces.FItems[j]); if ptrParallel.Side = 2 then if Interfac.ID <> ptrParallel.ID then if (Interfac.IDAdverse = ptrParallel.ID) and (Interfac.ID = ptrParallel.IDAdverse) then begin Interfac.ParallelInterface := ptrParallel; ptrParallel.ParallelInterface := Interfac; Break; ////// BREAK ///// end; end; end; end; procedure TSCSComponent.SetInterfacesComplect; var i, j, k, l: Integer; Interfac, ptrComlectInterf: TSCSInterface; IOfIRel: TSCSIOfIRel; ComplectComponent: TSCSComponent; begin for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac.TypeI = itConstructive then if Assigned(Interfac.IOfIRelOut) then for j := 0 to Interfac.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.IOfIRelOut[j]); //if ptrIOfIRel.InterfaceTo = nil then for k := 0 to ChildComplects.Count - 1 do begin ComplectComponent := ChildComplects[k]; if Assigned(ComplectComponent) then begin ptrComlectInterf := nil; ptrComlectInterf := ComplectComponent.GetInterfaceByID(IOfIRel.IDInterfTo); if ptrComlectInterf <> nil then begin IOfIRel.InterfaceTo := ptrComlectInterf; Interfac.AddToConnectedInterfaces(ptrComlectInterf); ptrComlectInterf.AddToConnectedInterfaces(Interfac); for l := 0 to IOfIRel.FPosConnections.Count - 1 do begin SetLinkToInterfPosConnection(TSCSInterfPosConnection(IOfIRel.FPosConnections[l]), Interfac, ptrComlectInterf); end; Break; ///// BREAK ///// end; end; end; end; end; end; //*** Обновить связи портов с интерфейсами procedure TSCSComponent.SetPortInterfRelInterfaces; var i: integer; Interf: TSCSInterface; begin for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; //if Port.IsPort = biTrue then ##ISPORT Interf.DefineInternalRelations; end; end; // ##### Загрузить Папку, в которой находится компонент ##### procedure TSCSComponent.LoadOwnerCatalog(AByFinding: Boolean); var //Catalog: TCatalog; IDCatalog: Integer; begin if OwnerCatalog <> nil then FreeAndNil(OwnerCatalog); if AByFinding then IDCatalog := TF_Main(ActiveForm).DM.GetIDCatalogByIDNoUppCompon(ID) else IDCatalog := ObjectID; OwnerCatalog := TSCSCatalog.Create(ActiveForm); TSCSCatalog(OwnerCatalog).LoadCatalogByID(IDCatalog, false); end; procedure TSCSComponent.SortComplects; var i, j, LastMaxSortID: Integer; ChildComponent1, ChildComponent2: TSCSComponent; ptrComplect1, ptrComplect2, ptrTempCompl: PComplect; begin LastMaxSortID := -1; for i := 0 to FChildComplects.Count - 1 do begin ptrComplect1 := nil; //ChildComponent1 := FChildComplects[i]; ChildComponent1 := TSCSComponent(FChildComplects.List.List^[i]); if ChildComponent1 <> nil then ptrComplect1 := GetComplectByIDChild(ChildComponent1.ID); if ptrComplect1 <> nil then begin for j := i to FChildComplects.Count - 1 do begin ptrComplect2 := nil; //ChildComponent2 := FChildComplects[j]; ChildComponent2 := TSCSComponent(FChildComplects.List.List^[j]); if ChildComponent2 <> nil then ptrComplect2 := GetComplectByIDChild(ChildComponent2.ID); if ptrComplect2 <> nil then if ptrComplect2.SortID < ptrComplect1.SortID then begin FChildComplects.Exchange(i, j); ExchangeObjects(ChildComponent1, ChildComponent2); ptrTempCompl := ptrComplect1; ptrComplect1 := ptrComplect2; ptrComplect2 := ptrTempCompl; end; end; end; end; end; // ##### Загрузка по ID компоненты ##### procedure TSCSComponent.LoadComponentByID(AID_Component: Integer; ALoadCompData: Boolean = true; ALoadSQL: Boolean = true; AClearBeforeLoad: Boolean = true); var SprComponentType: TNBComponentType; SprObjectIcon: TNBObjectIcon; SprProducer: TNBProducer; SprSuppliesKind: TNBSuppliesKind; SprNetType: TNBNetType; begin if AClearBeforeLoad then Clear; case FQueryMode of qmPhisical: begin if ALoadSQL then SetSQLToFIBQuery(FQSelect, 'SELECT * FROM COMPONENT where ID = :'+fnID, false); FQSelect.Close; FQSelect.ParamByName(fnID).AsInteger := AID_Component; FQSelect.ExecQuery; ID := FQSelect.FN(fnID).AsInteger; GuidNB := FQSelect.FN(fnGUID).AsString; NAME := FQSelect.FN(fnName).AsString; NameShort := FQSelect.FN(fnNameShort).AsString; MarkStr := FQSelect.FN(fnMarkStr).AsString; Cypher := FQSelect.FN(fnCypher).AsString; Izm := FQSelect.FN(fnIzm).AsString; Notice := FQSelect.FN(fnNotice).AsString; if Description = nil then Description := TMemoryStream.Create; Description.Position := 0; FQSelect.FN(fnDescription).SaveToStream(Description); //FQuery_Select.FNSaveToStream(fnDescription, Description); Description.Position := 0; if picture = nil then Picture := TMemoryStream.Create; Picture.Position := 0; FQSelect.FN(fnPicture).SaveToStream(Picture); //FQuery_Select.FNSaveToStream(fnPicture, Picture); Picture.Position := 0; Color := FQSelect.FN(fnColor).AsInteger; IsLine := FQSelect.FN(fnIsLine).AsInteger; ISComplect := FQSelect.FN(fnISComplect).AsInteger; IsMarkInCaptions := FQSelect.FN(fnIsMarkInCaptions).AsInteger; PriceSupply := FQSelect.FN(fnPriceSupply).AsFloat; PRICE := FQSelect.FN(fnPrice).AsFloat; PRICE_CALC := FQSelect.FN(fnPriceCalc).AsFloat; UserLength := FQSelect.FN(fnUserLength).AsFloat; MaxLength := FQSelect.FN(fnMaxLength).AsFloat; HASNDS := FQSelect.FN(fnHasnds).AsInteger; ArticulDistributor := FQSelect.FN(fnArticulDistributor).AsString; ArticulProducer := FQSelect.FN(fnArticulProducer).AsString; ID_ComponentType := FQSelect.FN(fnIDComponentType).AsInteger; IDSymbol := FQSelect.FN(fnIDSymbol).AsInteger; IDObjectIcon := FQSelect.FN(fnIDObjectIcon).AsInteger; ObjectIconStep := FQSelect.FN(fnObjectIconStep).AsFloat; ID_Producer := FQSelect.FN(fnIDPRODUCER).AsInteger; ID_CURRENCY := FQSelect.FN(fnIDCURRENCY).AsInteger; ID_SUPPLIER := FQSelect.FN(fnIDSUPPLIER).AsInteger; IDSuppliesKind := FQSelect.FN(fnIDSuppliesKind).AsInteger; IDNetType := FQSelect.FN(fnIDNetType).AsInteger; IDCompSpecification := FQSelect.FN(fnIDCompSpecification).AsInteger; SortID := FQSelect.FN(fnSortID).AsInteger; KolComplect := FQSelect.FN(fnKolComplect).AsInteger; IsTemplate := FQSelect.FN(fnIsTemplate).AsInteger; case TF_Main(ActiveForm).GDBMode of bkNormBase: IDNormBase := ID; bkProjectManager: begin IDNormBase := FQSelect.FN(fnIDNormBase).AsInteger; ObjectID := FQSelect.FN(fnObjectID).AsInteger; ListID := FQSelect.FN(fnListID).AsInteger; //ProjectID := FQuery_Select.GetFNAsInteger('Project_ID'); Whole_ID := FQSelect.FN(fnWHOLEID).AsInteger; NameMark := FQSelect.FN(fnNameMark).AsString; MarkID := FQSelect.FN(fnMarkID).AsInteger; IsUserMark := FQSelect.FN(fnIsUserMark).AsInteger; end; end; ServCopyIndex := 0; end; qmMemory: begin //if SetFilterToSQLMemTable(FMemTable, fnID+' = '''+IntTOStr(AID_Component)+'''') then // LoadFromMemTable; end; end; with TF_Main(FActiveForm).DM do begin if ID_ComponentType <> 0 then begin SprComponentType := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetComponentTypeObjByID(ID_ComponentType); if SprComponentType <> nil then GUIDComponentType := SprComponentType.ComponentType.GUID; if GUIDComponentType = '' then GUIDComponentType := GetStringFromTableByID(tnComponentTypes, fnGuid, ID_ComponentType, qmPhisical); end; if IDSymbol <> 0 then begin //SprObjectIcon := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetObjectIconBy GUIDSymbol := GetStringFromTableByID(tnObjectIcons, fnGuid, IDSymbol, qmPhisical); end; if IDObjectIcon <> 0 then begin GUIDObjectIcon := GetStringFromTableByID(tnObjectIcons, fnGuid, IDObjectIcon, qmPhisical); end; if ID_Producer <> 0 then begin SprProducer := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetProducerByID(ID_Producer); if SprProducer <> nil then GUIDProducer := SprProducer.GUID; if GUIDProducer = '' then GUIDProducer := GetStringFromTableByID(tnProducers, fnGuid, ID_Producer, qmPhisical); end; if IDSuppliesKind <> 0 then begin SprSuppliesKind := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetSuppliesKindByID(IDSuppliesKind); if SprSuppliesKind <> nil then GUIDSuppliesKind := SprSuppliesKind.Data.GUID; if GUIDSuppliesKind = '' then GUIDSuppliesKind := GetStringFromTableByID(tnSuppliesKinds, fnGuid, IDSuppliesKind, qmPhisical); end; if ID_Supplier <> 0 then GUIDSupplier := GetStringFromTableByID(tnSupplier, fnGuid, ID_Supplier, qmPhisical); if IDNetType <> 0 then begin SprNetType := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetNetTypeByID(IDNetType); if SprNetType <> nil then GUIDNetType := SprNetType.GUID; if GUIDNetType = '' then GUIDNetType := GetStringFromTableByID(tnNetType, fnGuid, IDNetType, qmPhisical); end; end; if ALoadCompData then LoadComponentData([cdAll]); end; procedure TSCSComponent.LoadComponentByFi(AFieldIndexses: TIntSet); var FieldList: TStringList; begin try case FQueryMode of qmPhisical: begin FieldList := TStringList.Create; try //DefineQuery; if fiAll in AFieldIndexses then FieldList.Add(fnAll) else begin if fiID in AFieldIndexses then FieldList.Add(fnID); if fiName in AFieldIndexses then FieldList.Add(fnName); if fiNameShort in AFieldIndexses then FieldList.Add(fnNameShort); if fiIzm in AFieldIndexses then FieldList.Add(fnIzm); if fiPicture in AFieldIndexses then FieldList.Add(fnPicture); if fiColor in AFieldIndexses then FieldList.Add(fnColor); if fiIsLine in AFieldIndexses then FieldList.Add(fnIsLine); if fiIsComplect in AFieldIndexses then FieldList.Add(fnIsComplect); if fiPrice in AFieldIndexses then FieldList.Add(fnPrice); if fiPriceCalc in AFieldIndexses then FieldList.Add(fnPriceCalc); if fiUserLength in AFieldIndexses then FieldList.Add(fnUserLength); if fiMaxLength in AFieldIndexses then FieldList.Add(fnMaxLength); if fiHasnds in AFieldIndexses then FieldList.Add(fnHasnds); if fiIDComponentType in AFieldIndexses then FieldList.Add(fnIDComponentType); if fiIDCurrency in AFieldIndexses then FieldList.Add(fnIDCurrency); if fiArticulDistributor in AFieldIndexses then FieldList.Add(fnArticulDistributor); if fiArticulProducer in AFieldIndexses then FieldList.Add(fnArticulProducer); if fiIDProducer in AFieldIndexses then FieldList.Add(fnIDProducer); if fiIDSupplier in AFieldIndexses then FieldList.Add(fnIDSupplier); if fiIDNetType in AFieldIndexses then FieldList.Add(fnIDNetType); if fiSortID in AFieldIndexses then FieldList.Add(fnSortID); if fiKolComplect in AFieldIndexses then FieldList.Add(fnKolComplect); end; case TF_Main(ActiveForm).GDBMode of bkNormBase: ; bkProjectManager: begin if fiIDNormbase in AFieldIndexses then FieldList.Add(fnIDNormbase); if fiObjectID in AFieldIndexses then FieldList.Add(fnObjectID); if fiListID in AFieldIndexses then FieldList.Add(fnListID); //if fiProjectID in AFieldIndexses then // FieldList.Add(fnProjectID); if fiWholeID in AFieldIndexses then FieldList.Add(fnWholeID); if fiNameMark in AFieldIndexses then FieldList.Add(fnNameMark); if fiMarkID in AFieldIndexses then FieldList.Add(fnMarkID); if fiIsUserMark in AFieldIndexses then FieldList.Add(fnIsUserMark); end; end; //SQLBuilder(FQuery_Select, qtSelect, tnComponent, 'id = '''+IntTostr(ID)+'''', FieldList, true); SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnComponent, 'id = '''+IntTostr(ID)+'''', FieldList, ''), true); if (fiID in AFieldIndexses) or (fiAll in AFieldIndexses) then ID := FQSelect.FN(fnID).AsInteger; if (fiName in AFieldIndexses) or (fiAll in AFieldIndexses) then Name := FQSelect.FN(fnName).AsString; if (fiNameShort in AFieldIndexses) or (fiAll in AFieldIndexses) then NameShort := FQSelect.FN(fnNameShort).AsString; if (fiIzm in AFieldIndexses) or (fiAll in AFieldIndexses) then Izm := FQSelect.FN(fnIzm).AsString; if (fiPicture in AFieldIndexses) or (fiAll in AFieldIndexses) then begin Picture := TMemoryStream.Create; Picture.Position := 0; FQSelect.FN(fnPicture).SaveToStream(Picture); end; if (fiColor in AFieldIndexses) or (fiAll in AFieldIndexses) then Color := FQSelect.FN(fnColor).AsInteger; if (fiIsLine in AFieldIndexses) or (fiAll in AFieldIndexses) then IsLine := FQSelect.FN(fnIsLine).AsInteger; if (fiIsComplect in AFieldIndexses) or (fiAll in AFieldIndexses) then IsComplect := FQSelect.FN(fnIsComplect).AsInteger; if (fiPrice in AFieldIndexses) or (fiAll in AFieldIndexses) then Price := FQSelect.FN(fnPrice).AsDouble; if (fiPriceCalc in AFieldIndexses) or (fiAll in AFieldIndexses) then PRICE_CALC := FQSelect.FN(fnPriceCalc).AsDouble; if (fiUserLength in AFieldIndexses) or (fiAll in AFieldIndexses) then UserLength := FQSelect.FN(fnUserLength).AsDouble; if (fiMaxLength in AFieldIndexses) or (fiAll in AFieldIndexses) then MaxLength := FQSelect.FN(fnMaxLength).AsDouble; if (fiHasnds in AFieldIndexses) or (fiAll in AFieldIndexses) then Hasnds := FQSelect.FN(fnHasnds).AsInteger; if (fiIDComponentType in AFieldIndexses) or (fiAll in AFieldIndexses) then ID_ComponentType := FQSelect.FN(fnIDComponentType).AsInteger; if (fiIDCurrency in AFieldIndexses) or (fiAll in AFieldIndexses) then ID_Currency := FQSelect.FN(fnIDCurrency).AsInteger; if (fiArticulDistributor in AFieldIndexses) or (fiAll in AFieldIndexses) then ArticulDistributor := FQSelect.FN(fnArticulDistributor).AsString; if (fiArticulProducer in AFieldIndexses) or (fiAll in AFieldIndexses) then ArticulProducer := FQSelect.FN(fnArticulProducer).AsString; if (fiIDProducer in AFieldIndexses) or (fiAll in AFieldIndexses) then ID_Producer := FQSelect.FN(fnIDProducer).AsInteger; if (fiIDSupplier in AFieldIndexses) or (fiAll in AFieldIndexses) then ID_Supplier := FQSelect.FN(fnIDSupplier).AsInteger; if (fiIDNetType in AFieldIndexses) or (fiAll in AFieldIndexses) then IDNetType := FQSelect.FN(fnIDNetType).AsInteger; if (fiSortID in AFieldIndexses) or (fiAll in AFieldIndexses) then SortID := FQSelect.FN(fnSortID).AsInteger; if (fiKolComplect in AFieldIndexses) or (fiAll in AFieldIndexses) then KolComplect := FQSelect.FN(fnKolComplect).AsInteger; case TF_Main(ActiveForm).GDBMode of bkNormBase: IDNormBase := ID; bkProjectManager: begin if (fiIDNormbase in AFieldIndexses) or (fiAll in AFieldIndexses) then IDNormbase := FQSelect.FN(fnIDNormbase).AsInteger; if (fiObjectID in AFieldIndexses) or (fiAll in AFieldIndexses) then ObjectID := FQSelect.FN(fnObjectID).AsInteger; if (fiListID in AFieldIndexses) or (fiAll in AFieldIndexses) then ListID := FQSelect.FN(fnListID).AsInteger; //if (fiProjectID in AFieldIndexses) or (fiAll in AFieldIndexses) then // ProjectID := FQSelect.FN(fnProjectID).AsInteger; if (fiWholeID in AFieldIndexses) or (fiAll in AFieldIndexses) then Whole_ID := FQSelect.FN(fnWholeID).AsInteger; if (fiNameMark in AFieldIndexses) or (fiAll in AFieldIndexses) then NameMark := FQSelect.FN(fnNameMark).AsString; if (fiMarkID in AFieldIndexses) or (fiAll in AFieldIndexses) then MarkID := FQSelect.FN(fnMarkID).AsInteger; if (fiIsUserMark in AFieldIndexses) or (fiAll in AFieldIndexses) then IsUserMark := FQSelect.FN(fnIsUserMark).AsInteger; end; end; finally FreeAndNil(FieldList); end; end; qmMemory: LoadComponentByID(Id, false); end; except on E: Exception do AddExceptionToLog('TSCSComponent.LoadComponentByFi: '+E.Message); end; end; procedure TSCSComponent.LoadComponentData(ADataFlags: TCompDataFlags); begin if (cdComponentType in ADataFlags) or (cdAll in ADataFlags) then LoadComponentType; if (cdComplects in ADataFlags) or (cdAll in ADataFlags) then LoadComplects(IDTopComponent, IDCompRel); if (cdCableCanalConnectors in ADataFlags) or (cdAll in ADataFlags) then LoadCableCanalConnectors; if (cdConections in ADataFlags) or (cdAll in ADataFlags) then LoadConections; if (cdCrossConnections in ADataFlags) or (cdAll in ADataFlags) then LoadCrossConnections; if (cdProperties in ADataFlags) or (cdAll in ADataFlags) then LoadProperties; if (cdInterfaces in ADataFlags) or (cdAll in ADataFlags) then LoadInterfaces; if (cdNorms in ADataFlags) or (cdAll in ADataFlags) then NormsResources.LoadNorms(true, true); if (cdResources in ADataFlags) or (cdAll in ADataFlags) then NormsResources.LoadResources(true); end; // ##### Загружает комплектующие, или соединения ##### procedure TSCSComponent.LoadCompRel(AConnectType: TConnectType; var ACompRelList: TList; AIDTopComponent, AIDParentCompRel: Integer; ALoadSQL: Boolean = true); var CompRel: PComplect; SQLSelect, strWhere : String; begin ClearList(ACompRelList); strWhere := ''; SQLSelect := ''; if ALoadSQL then case AConnectType of cntComplect: //strWhere := '(ID_COMPONENT = :'+fnIDComponent+') and '+ // '(Connect_type = :'+fnConnectType+')'; strWhere := '('+fnIDParentCompRel+' = :'+fnIDParentCompRel+') and '+ '(ID_COMPONENT = :'+fnIDComponent+') and ('+fnIDTopCompon+' = :'+fnIDTopCompon+') and '+ '(Connect_type = :'+fnConnectType+')'; cntUnion: strWhere := '((ID_COMPONENT = :'+fnIDComponent+') or (ID_Child = :'+fnIDChild+')) and '+ '(Connect_type = :'+fnConnectType+')'; end; case FQueryMode of qmPhisical: begin if ALoadSQL then begin SQLSelect := ' SELECT * FROM COMPONENT_RELATION WHERE '; SetSQLToFIBQuery(FQSelect, SQLSelect + strWhere + ' order by sort_id ', false); end; FQSelect.Close; FQSelect.ParamByName(fnIDComponent).AsInteger := FID; FQSelect.ParamByName(fnConnectType).AsInteger := AConnectType; if AConnectType = cntComplect then begin FQSelect.ParamByName(fnIDTopCompon).AsInteger := AIDTopComponent; SetParamAsInteger0AsNullToQuery(FQSelect, fnIDParentCompRel, AIDParentCompRel); end else if AConnectType = cntUnion then FQSelect.ParamByName(fnIDChild).AsInteger := FID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin if FQSelect.FN(fnIDChild).AsInteger > 0 then begin GetZeroMem(CompRel, SizeOf(TComplect)); CompRel.ID := FQSelect.FN(fnID).AsInteger; CompRel.ID_Component := FQSelect.FN(fnIDComponent).AsInteger; CompRel.ID_Child := FQSelect.FN(fnIDChild).AsInteger; CompRel.IDTopComponent := AIDTopComponent; CompRel.IDParentCompRel := AIDParentCompRel; CompRel.KolSubComplect := FQSelect.FN(fnKolSubComplect).AsInteger; CompRel.Kolvo := FQSelect.FN(fnKolvo).AsInteger; CompRel.ConnectType := FQSelect.FN(fnConnectType).AsInteger; CompRel.SortID := FQSelect.FN(fnSortID).AsInteger; CompRel.ID_NewChild := 0; CompRel.ID_NewComponent := 0; ACompRelList.Add(CompRel); if AConnectType = cntUnion then if CompRel.ID_Child = FID then begin CompRel.ID_Child := CompRel.ID_Component; CompRel.ID_Component := FID; end; end; FQSelect.Next; end; FQSelect.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin (* SetFilterToSQLMemTable(tSQL_ComponentRelation, strWhere); try tSQL_ComponentRelation.IndexName := GetIndexByFldFomSQLMemTable(tSQL_ComponentRelation, fnSortID); except end; tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin { GetMem(CompRel, SizeOf(TComplect)); CompRel.ID := tSQL_ComponentRelation.FieldByName('ID').AsInteger; CompRel.ID_Component := tSQL_ComponentRelation.FieldByName('ID_Component').AsInteger; CompRel.ID_Child := tSQL_ComponentRelation.FieldByName('ID_Child').AsInteger; CompRel.Kolvo := tSQL_ComponentRelation.FieldByName('Kolvo').AsInteger; CompRel.ConnectType := tSQL_ComponentRelation.FieldByName('Connect_Type').AsInteger; CompRel.SortID := tSQL_ComponentRelation.FieldByName('Sort_ID').AsInteger; CompRel.ID_NewChild := 0; CompRel.ID_NewComponent := 0; } CompRel := GetCompRelFromMemTable; ACompRelList.Add(CompRel); if AConnectType = cntUnion then if CompRel.ID_Child = FID then begin CompRel.ID_Child := CompRel.ID_Component; CompRel.ID_Component := FID; end; tSQL_ComponentRelation.Next; end; tSQL_ComponentRelation.IndexName := ''; *) end; end; end; // ##### Загрузить комплектующие ##### procedure TSCSComponent.LoadComplects(AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0; ALoadSQL: Boolean = true); var Complect: PComplect; IDTopComponent: Integer; begin if Not (cdComplects in ServDisabledLoadDataElements) then begin IDTopComponent := AIDTopComponent; if IDTopComponent = 0 then IDTopComponent := ID; LoadCompRel(cntComplect, FComplects, IDTopComponent, AIDCompRel, ALoadSQL); end; end; procedure TSCSComponent.LoadChildComplects(ARecursive, ADevideComplects, ACompData: Boolean; AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0; AIndexOfLoading: Integer = 0); var ptrComplect: PComplect; NewChildCompl, ChildCompl, TopComponent, FindedCompon: TSCSComponent; i, j, IDTopCompon, ComplPositionCount: Integer; WasLoad: Boolean; Interf: TSCSInterface; begin TopComponent := nil; TopComponent := GetTopComponent; ClearList(Complects); ChildComplects.Clear; //ClearListWithObjects(ChildComplects); //DefineQuery; //*** Загрузка комлектующих 1-го уровня IDTopCompon := AIDTopComponent; if {(AIndexOfLoading = 0) and} (AIDTopComponent = 0) then IDTopCompon := ID; LoadComplects(IDTopCompon, AIDCompRel); if ADevideComplects then DivideComplects; for i := 0 to Complects.Count - 1 do begin ptrComplect := Complects.Items[i]; FindedCompon := nil; if Assigned(TopComponent) then FindedCompon := TopComponent.GetComponentFromReferences(ptrComplect.ID_Child); ComplPositionCount := 1; if ADevideComplects then ComplPositionCount := ptrComplect.Kolvo; for j := 0 to ComplPositionCount - 1 do begin NewChildCompl := TSCSComponent.Create(ActiveForm); if Assigned(FindedCompon) then begin NewChildCompl.Assign(FindedCompon, true, true); //NewChildCompl.AssignChildComponents(FindedCompon.ChildComplects, true, true); NewChildCompl.IDTopComponent := IDTopCompon; NewChildCompl.IDCompRel := ptrComplect.ID; //NewChildCompl.LoadComplects(NewChildCompl.IDTopComponent, NewChildCompl.IDCompRel); end else begin NewChildCompl.IDTopComponent := IDTopCompon; NewChildCompl.IDCompRel := ptrComplect.ID; //*** Не подгружать комплектующие, связи инетрфейсов NewChildCompl.ServDisabledLoadDataElements := [cdComplects, cdIOfIRels]; try NewChildCompl.LoadComponentByID(ptrComplect.ID_Child, ACompData, true, false); finally NewChildCompl.ServDisabledLoadDataElements := []; end; //NewChildCompl.KolComplect := ptrComplect.KolSubComplect; end; ////*** очистить связи интерфейсов, так, как они индивидуальны для каждой комплектующей //после "ServDisabledLoadDataElements := [cdComplects, cdIOfIRels]" "ClearComponIOfIRels(NewChildCompl);" не имеет смысла NewChildCompl.KolComplect := ptrComplect.KolSubComplect; //NewChildCompl.ServCopyIndex := j; NewChildCompl.ServCopyIndex := ptrComplect.ServCopyIndex; NewChildCompl.Parent := Self; ChildComplects.Add(NewChildCompl); NewChildCompl.IDCompRel := ptrComplect.ID; NewChildCompl.Count := ptrComplect.Kolvo; NewChildCompl.LinkToComlectRec := ptrComplect; end; end; //*** Загрузка комлектующих остальных уровней if ARecursive then for i := 0 to ChildComplects.Count - 1 do begin NewChildCompl := ChildComplects.Items[i]; if NewChildCompl.ChildComplects.Count = 0 then begin ptrComplect := NewChildCompl.LinkToComlectRec; NewChildCompl.LoadChildComplects(ARecursive, ADevideComplects, ACompData, IDTopCompon, ptrComplect.ID, AIndexOfLoading+1); end; end; //*** Подгрузить связи инетрфейсов для комплектующих if AIndexOfLoading = 0 then begin for i := 0 to FChildReferences.Count - 1 do begin ChildCompl := FChildReferences[i]; WasLoad := false; for j := 0 to ChildCompl.FInterfaces.Count - 1 do begin Interf := ChildCompl.FInterfaces[j]; if CheckCanLoadInterfIOfIRelsFromBase(Interf) then begin Interf.LoadIOfIRels(WasLoad=false); WasLoad := true; end; end; end; end; end; procedure TSCSComponent.LoadChildComplectsQuick(ARecursive, ARegroup, ACompData: Boolean; AIDTopComponent: Integer = 0; AIDCompRel: Integer = 0{; AIndexOfLoading: Integer = 0}); var i, j, IDTopComponent, KolComplect: Integer; ChildComponent, LookedComponent: TSCSComponent; SCSInterface, LookedInterface: TSCSInterface; LookedComponents: TSCSComponents; LookedInterfaces: TSCSInterfaces; WasLoad: Boolean; procedure LoadChildComplectsOnly(ASCSComponent: TSCSComponent; AIDParentCompRel, AStepIndex: Integer); var i: Integer; NewChildComponent: TSCSComponent; PtrComplect: PComplect; begin ClearList(ASCSComponent.Complects); ASCSComponent.ChildComplects.Clear; ASCSComponent.LoadComplects(IDTopComponent, AIDParentCompRel, AStepIndex = 0); if ARegroup then ASCSComponent.DivideComplects; for i := 0 to ASCSComponent.FComplects.Count - 1 do begin PtrComplect := ASCSComponent.FComplects[i]; NewChildComponent := TSCSComponent.Create(FActiveForm); NewChildComponent.ID := PtrComplect.ID_Child; NewChildComponent.Parent := ASCSComponent; ASCSComponent.FChildComplects.Add(NewChildComponent); NewChildComponent.IDCompRel := ptrComplect.ID; NewChildComponent.KolComplect := ptrComplect.KolSubComplect; NewChildComponent.Count := ptrComplect.Kolvo; NewChildComponent.ServCopyIndex := ptrComplect.ServCopyIndex; NewChildComponent.LinkToComlectRec := ptrComplect; LoadChildComplectsOnly(NewChildComponent, PtrComplect.ID, AStepIndex+1); end; end; begin IDTopComponent := AIDTopComponent; if IDTopComponent = 0 then IDTopComponent := ID; LoadChildComplectsOnly(Self, AIDCompRel, 0); LookedComponents := TSCSComponents.Create(false); LookedInterfaces := TSCSInterfaces.Create(false); //*** Загрузка данных компонент for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; KolComplect := ChildComponent.KolComplect; LookedComponent := LookedComponents.GetComponenByID(ChildComponent.ID); if LookedComponent <> nil then begin ChildComponent.AssignOnlyComponent(LookedComponent); ChildComponent.IDCompRel := ChildComponent.LinkToComlectRec.ID; ChildComponent.Count := ChildComponent.LinkToComlectRec.Kolvo; ChildComponent.KolComplect := ChildComponent.LinkToComlectRec.KolSubComplect; //*** Если загрузка идет с дубликата TF_Main, то он может прописаться в F_NormBase ChildComponent.ActiveForm := FActiveForm; end else begin ChildComponent.LoadComponentByID(ChildComponent.ID, false, i=0, false); ChildComponent.LoadComponentType; // из объекта справочника LookedComponents.Add(ChildComponent); end; ChildComponent.KolComplect := KolComplect; end; if ACompData then begin //*** Загрузка интерфейсов LookedComponents.Clear; for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; LookedComponent := LookedComponents.GetComponenByID(ChildComponent.ID); if LookedComponent <> nil then ChildComponent.AssignInterfaces(LookedComponent.FInterfaces, true, false) else begin ChildComponent.LoadInterfaces(-1, false, i=0); LookedComponents.Add(ChildComponent); end; end; // Связи между интерфейсами WasLoad := false; LookedInterfaces.Clear; for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; for j := 0 to ChildComponent.FInterfaces.Count - 1 do begin SCSInterface := ChildComponent.FInterfaces[j]; {LookedInterface := LookedInterfaces.GetInterfaceByID(SCSInterface.ID); if LookedInterface <> nil then SCSInterface.AssignIOfIRelOut(LookedInterface.FIOfIRelOut, true) else begin SCSInterface.LoadIOfIRels(WasLoad=false); LookedInterfaces.Add(SCSInterface); WasLoad := true; end;} if CheckCanLoadInterfIOfIRelsFromBase(SCSInterface) then begin SCSInterface.LoadIOfIRels(WasLoad=false); //LookedInterfaces.Add(SCSInterface); WasLoad := true; end; end; end; // Связи портов интерфейсами WasLoad := false; LookedInterfaces.Clear; for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; for j := 0 to ChildComponent.FInterfaces.Count - 1 do begin SCSInterface := ChildComponent.FInterfaces[j]; //if SCSInterface.IsPort = biTrue then ##ISPORT if CheckCanLoadInterfInternalConnectionsFromBase(SCSInterface) then begin LookedInterface := LookedInterfaces.GetInterfaceByID(SCSInterface.ID); if LookedInterface <> nil then SCSInterface.AssignPortInterfRel(LookedInterface.FPortInterfRels) else begin SCSInterface.LoadPortInterfRels(WasLoad=false); LookedInterfaces.Add(SCSInterface); WasLoad := true; end; end; end; end; for i := 0 to FChildReferences.Count - 1 do begin ChildComponent := FChildReferences[i]; ChildComponent.LoadProperties; ChildComponent.SetInterfacesParallel; ChildComponent.SetInterfacesComplect; ChildComponent.SetPortInterfRelInterfaces; end; end; SetInterfacesComplect; LookedInterfaces.Free; LookedComponents.Free; end; procedure TSCSComponent.LoadComponentType; var SprComponentType: TNBComponentType; ListOwner: TSCSList; Form: TForm; begin try ZeroMemory(@ComponentType, SizeOf(TComponentType)); case TF_Main(FActiveForm).GDBMode of bkNormBase: begin Form := F_NormBase; if Form = nil then Form := FActiveForm; ComponentType := TF_Main(Form).GSCSBase.NBSpravochnik.GetComponentTypeByID(ID_ComponentType); end; bkProjectManager: begin SprComponentType := nil; ListOwner := GetListOwner; if ListOwner = nil then if FProjectOwner <> nil then ListOwner := FProjectOwner.GetListBySCSID(ListID); if ListOwner <> nil then SprComponentType := ListOwner.FSpravochnik.GetComponentTypeWithAssign(GUIDComponentType, TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik) else if FProjectOwner <> nil then SprComponentType := FProjectOwner.FSpravochnik.GetComponentTypeWithAssign(GUIDComponentType, TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); if SprComponentType <> nil then ComponentType := SprComponentType.ComponentType; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.LoadComponentType: '+E.Message); end; end; procedure TSCSComponent.LoadWholeComponent(ARecursive: Boolean; AWholeObj: Pointer=nil); var NewWholeCompons: TIntList; WholeLineCompon: TWholeLineCompon; SideAtFirst, SideAtLast: Integer; begin try if AWholeObj <> nil then TObject(AWholeObj^) := nil; NewWholeCompons := nil; WholeComponent.Clear; //ClearList(WholeComponent); case ARecursive of true: WholeLineCompon := GetLineComponsInTrace(ID, Self); false: begin WholeLineCompon := GetLineComponsInTraceFromBase(Self, true); //24.10.2011 - Если из обеих сторон подключены к одному объекту, вызываем полное определение // из-за того что раньше был косяк в GetLineComponsInTrace где при расключке одной стороны кабеля, одно подключение определялось как начальное, а второе как конечное if (WholeLineCompon.FirstIDCompon = WholeLineCompon.LastIDCompon) and (WholeLineCompon.FirstIDCompon <> 0) then if (WholeLineCompon.FirstIDConnectedConnCompon <> 0) and (WholeLineCompon.LastIDConnectedConnCompon <> 0) then begin if WholeLineCompon.FirstConnectedConnCompon = nil then WholeLineCompon.FirstConnectedConnCompon := FProjectOwner.GetComponentFromReferences(WholeLineCompon.FirstIDConnectedConnCompon); if WholeLineCompon.LastConnectedConnCompon = nil then WholeLineCompon.LastConnectedConnCompon := FProjectOwner.GetComponentFromReferences(WholeLineCompon.LastIDConnectedConnCompon); if (WholeLineCompon.FirstConnectedConnCompon <> nil) and (WholeLineCompon.LastConnectedConnCompon <> nil) then if TSCSComponent(WholeLineCompon.FirstConnectedConnCompon).GetFirstParentCatalog = TSCSComponent(WholeLineCompon.LastConnectedConnCompon).GetFirstParentCatalog then begin if WholeLineCompon.FirstCompon = nil then WholeLineCompon.FirstCompon := FProjectOwner.GetComponentFromReferences(WholeLineCompon.FirstIDCompon); if WholeLineCompon.LastCompon = nil then WholeLineCompon.LastCompon := FProjectOwner.GetComponentFromReferences(WholeLineCompon.LastIDCompon); if (WholeLineCompon.FirstCompon <> nil) and (WholeLineCompon.LastCompon <> nil) then begin SideAtFirst := GetComponSideJoinedToComponByInterf(TSCSComponent(WholeLineCompon.LastCompon), TSCSComponent(WholeLineCompon.FirstConnectedConnCompon)); SideAtLast := GetComponSideJoinedToComponByInterf(TSCSComponent(WholeLineCompon.FirstCompon), TSCSComponent(WholeLineCompon.LastConnectedConnCompon)); // если подключены двумя сторонами, то подозрение на хреново ранее поереденные конечные точечные подключения if (SideAtFirst = SideAtLast) then WholeLineCompon := GetLineComponsInTrace(ID, Self); end; end; end; end; end; NewWholeCompons := WholeLineCompon.WholeCompon; if NewWholeCompons <> nil then begin WholeComponent.Clear; //ClearList(WholeComponent); WholeComponent.Assign(NewWholeCompons); FirstIDCompon := WholeLineCompon.FirstIDCompon; FirstCompon := TSCSComponent(WholeLineCompon.FirstCompon); FirstIDConnectedConnCompon := WholeLineCompon.FirstIDConnectedConnCompon; FirstConnectedConnCompon := TSCSComponent(WholeLineCompon.FirstConnectedConnCompon); LastIDCompon := WholeLineCompon.LastIDCompon; LastCompon := TSCSComponent(WholeLineCompon.LastCompon); LastIDConnectedConnCompon := WholeLineCompon.LastIDConnectedConnCompon; LastConnectedConnCompon := TSCSComponent(WholeLineCompon.LastConnectedConnCompon); FreeAndNil(NewWholeCompons); end; if WholeLineCompon.WholeComponObj <> nil then begin if AWholeObj <> nil then TObject(AWholeObj^) := WholeLineCompon.WholeComponObj else WholeLineCompon.WholeComponObj.Free; end; Length := 0; except on E: Exception do AddExceptionToLog('TSCSComponent.LoadWholeComponent: '+E.Message); end; end; procedure TSCSComponent.ApplyLengthData(var ALength, AReserv: Double; AFirstJoinConCompon, ALastJoinConCompon: TSCSComponent; ATakeIntoDiffLists: Boolean = true); var //OwnerObject: TCatalog; //IDOwnerList: Integer; TopCatalog: TSCSCatalog; OwnerList: TSCSList; ListSettingRecord: TListSettingRecord; LengthKoef, PortReserv, MultiportReserv, PrevLength: Double; function GetConnectedComponPortReserv(AConnectedCompon: TSCSComponent): Double; var Compon: TSCSComponent; StrReservAtPointCompon: string; ReservAtPointCompon: Double; ComponPortKind: TPortKind; begin Result := 0; Compon := AConnectedCompon; //TopCatalog.GetComponentFromReferences(AIDConnectedCompon); if Compon <> nil then if (Compon.ListID = Self.ListID) or ATakeIntoDiffLists then begin ReservAtPointCompon := -1; StrReservAtPointCompon := AConnectedCompon.GetPropertyValueBySysName(pnReservAtPointCompon); if StrReservAtPointCompon <> '' then begin ReservAtPointCompon := StrToFloatU(CorrectStrToFloat(StrReservAtPointCompon)); if ReservAtPointCompon >= 0 then Result := ReservAtPointCompon; end else begin ComponPortKind := Compon.GetPortKind; case ComponPortKind of pkPort: Result := PortReserv; pkMultiport: Result := MultiportReserv; end; end; end; //if AIDConnectedCompon > 0 then //Result := TF_Main(ActiveForm).DM.GetComponentPortKind(AIDConnectedCompon); end; begin try //IDOwnerList := TF_Main(ActiveForm).DM.GetListIDByIDComponent(ID); TopCatalog := GetTopParentCatalog; OwnerList := TF_Main(ActiveForm).GSCSBase.CurrProject.GetListBySCSID(ListID); PrevLength := ALength; if OwnerList = nil then OwnerList := TF_Main(ActiveForm).GSCSBase.CurrProject.CurrList; if OwnerList <> nil then begin ListSettingRecord := OwnerList.Setting; PortReserv := ListSettingRecord.PortReserv; MultiportReserv := ListSettingRecord.MultiportReserv; //PortReserv := TF_Main(ActiveForm).GetPropertyValueAsFloat(tkCatalog, OwnerList.ID, pnPortReserv); //MultiportReserv := TF_Main(ActiveForm).GetPropertyValueAsFloat(tkCatalog, OwnerList.ID, pnMultiPortReserv); //*** Применение коэфициента //ApplyLengthKoef(ALength, ListSettingRecord.LengthKoef); //*** Учет резерва со сторон порта/мультипорта if ComponentType.SysName <> ctsnCableChannel then begin ALength := ALength + GetConnectedComponPortReserv(AFirstJoinConCompon); ALength := ALength + GetConnectedComponPortReserv(ALastJoinConCompon); end; AReserv := ALength - PrevLength; end; except on E: Exception do AddExceptionToLog('TSCSComponent.ApplyLengthData: '+E.Message); end; end; procedure TSCSComponent.ClearFNet; var i: Integer; ptrJoinedComponents: PJoinedComponents; begin for i := 0 to FNet.Count - 1 do begin ptrJoinedComponents := FNet[i]; if Assigned(ptrJoinedComponents.JoinedLines) then FreeAndNil(ptrJoinedComponents.JoinedLines); if Assigned(ptrJoinedComponents.FirstConnCompons) then FreeAndNil(ptrJoinedComponents.FirstConnCompons); if Assigned(ptrJoinedComponents.LastConnCompons) then FreeAndNil(ptrJoinedComponents.LastConnCompons); FreeMem(ptrJoinedComponents); end; end; procedure TSCSComponent.ClearJoinedComponents; var i: Integer; JoinedComponent: TSCSComponent; begin for i := 0 to FJoinedComponents.Count - 1 do begin JoinedComponent := FJoinedComponents[i]; if JoinedComponent <> nil then JoinedComponent.FJoinedComponents.Remove(Self); end; FJoinedComponents.Clear; end; function TSCSComponent.GetImageFromObjectIcons(AIDIcon, AIconExt: Integer; AGUIDIcon: String): TMemoryStream; var IconType: Integer; begin Result := nil; IconType := GetPropertyValueAsInteger(pnSignType); if IconType = oitNone then IconType := oitProjectible; if TF_Main(FActiveForm).GDBMode = bkNormBase then Result := TF_Main(FActiveForm).FNormBase.DM.GetComponIconByIconType(AIDIcon, IconType, AIconExt, AGUIDIcon) else //Tolik -- 25/01/2022 -- здесь если идет дроп компонента первый раз и магнит стен, то при определении на драгдропе // фигуры отрисовки, можем ее не получить, т.к. справочник менеджера проектов еще пустой // ИМЕННО на первом дропе, поэтому, если нет фигуры отрисовки, то попробуем получить ее из НБ { if TF_Main(FActiveForm).GDBMode = bkProjectManager then if FProjectOwner <> nil then Result := FProjectOwner.FSpravochnik.GetObjectIconByIconType(AGUIDIcon, IconType, AIconExt); } if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin if FProjectOwner <> nil then begin Result := FProjectOwner.FSpravochnik.GetObjectIconByIconType(AGUIDIcon, IconType, AIconExt); if Result = nil then begin if GDropComponent <> nil then // чтобы понимать, что мы именно на дропе сидим -- Result := TF_Main(F_NormBase).FNormBase.DM.GetComponIconByIconType(AIDIcon, IconType, AIconExt, AGUIDIcon); end; end; end; // end; function TSCSComponent.GetLengthByComponent(AComponent: TSCSComponent): Double; var ResLength: Double; IDOwnerObject: Integer; OwnerObject: TCatalog; ObjectOwner: TSCSCatalog; begin Result := 0; ResLength := 0; try if Assigned(AComponent) then begin ResLength := AComponent.UserLength; //*** Если пользовательская длина не определина, то взять длину объэекта в котором // находится текущий участок компоненты if ResLength = 0 then begin ObjectOwner := AComponent.GetFirstParentCatalog; if Assigned(ObjectOwner) then ResLength := ObjectOwner.GetPropertyValueAsFloat(pnLength); //TF_Main(ActiveForm).DM.GetPropertyValueAsFloat(tkCatalog, ObjectOwner.ID, pnLength, FQueryMode, -1); end; end; Result := ResLength; //ResLength := TF_Main(ActiveForm).DM.GetComponFieldValueAsFloat(AIDComponent, fnUserLength); ////*** Если пользовательская длина не определина, то взять длину объэекта в котором //// находится текущий участок компоненты //if ResLength = 0 then //begin // IDOwnerObject := TF_Main(ActiveForm).DM.GetComponFieldValueAsInteger(AIDComponent, fnObjectID); // ResLength := TF_Main(ActiveForm).DM.GetPropertyValueAsFloat(tkCatalog, IDOwnerObject, pnLength, FQueryMode, -1); //end; //Result := ResLength; except on E: Exception do AddExceptionToLog('TSCSComponent.GetLengthByIDComponent: '+E.Message); end; end; procedure TSCSComponent.LoadFromMemTable(AStringsMan: TStringsMan); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := tSQL_Component; if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GuidNB := FMemTable.Fields[fiCompon_GuidNB].AsString; Self.NAME := FMemTable.Fields[fiCompon_Name].AsString; Self.NameShort := FMemTable.Fields[fiCompon_NameShort].AsString; Self.Cypher := FMemTable.Fields[fiCompon_Cypher].AsString; Self.Izm := FMemTable.Fields[fiCompon_Izm].AsString; Self.Notice := FMemTable.Fields[fiCompon_Notice].AsString; Self.ArticulDistributor := FMemTable.Fields[fiCompon_ArticulDistributor].AsString; Self.ArticulProducer := FMemTable.Fields[fiCompon_ArticulProducer].AsString; Self.GUIDComponentType := FMemTable.Fields[fiCompon_GuidComponentType].AsString; Self.GUIDSymbol := FMemTable.Fields[fiCompon_GuidSymbol].AsString; Self.GUIDObjectIcon := FMemTable.Fields[fiCompon_GuidObjectIcon].AsString; Self.GUIDProducer := FMemTable.Fields[fiCompon_GuidProducer].AsString; if fiCompon_GuidSuppliesKind <> -1 then Self.GUIDSuppliesKind := FMemTable.Fields[fiCompon_GuidSuppliesKind].AsString; Self.GUIDSupplier := FMemTable.Fields[fiCompon_GuidSupplier].AsString; Self.GUIDNetType := FMemTable.Fields[fiCompon_GuidNetType].AsString; end else begin Self.GuidNB := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidNB].AsInteger, AStringsMan.FComponGuidNBStrings); Self.NAME := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_Name].AsInteger, AStringsMan.FComponNameStrings); Self.NameShort := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_NameShort].AsInteger, AStringsMan.FComponNameShortStrings); Self.Cypher := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_Cypher].AsInteger, AStringsMan.FComponCypherStrings); Self.Izm := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_Izm].AsInteger, AStringsMan.FIzmStrings); Self.Notice := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_Notice].AsInteger, AStringsMan.FComponNoticeStrings); Self.ArticulDistributor := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_ArticulDistributor].AsInteger, AStringsMan.FComponArticulStrings); Self.ArticulProducer := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_ArticulProducer].AsInteger, AStringsMan.FComponArticulStrings); Self.GUIDComponentType := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidComponentType].AsInteger, AStringsMan.FComponentTypeGUIDStrings); Self.GUIDSymbol := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidSymbol].AsInteger, AStringsMan.FObjectIconGUIDStrings); Self.GUIDObjectIcon := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidObjectIcon].AsInteger, AStringsMan.FObjectIconGUIDStrings); Self.GUIDProducer := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidProducer].AsInteger, AStringsMan.FProducerGUIDStrings); if fiCompon_GuidSuppliesKind <> -1 then Self.GUIDSuppliesKind := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidSuppliesKind].AsInteger, AStringsMan.FSuppliesKindGUIDStrings); Self.GUIDSupplier := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidSupplier].AsInteger, AStringsMan.FSupplierGUIDStrings); Self.GUIDNetType := AStringsMan.GetStrByID(FMemTable.Fields[fiCompon_GuidNetType].AsInteger, AStringsMan.FNetTypeGUIDStrings); end; Self.ID := FMemTable.Fields[fiCompon_ID].AsInteger; //Self.MarkStr := FMemTable.Fields[fiCompon_MarkStr].AsString; if fiCompon_Description <> -1 then begin Self.Description.Position := 0; TBlobField(FMemTable.Fields[fiCompon_Description]).SaveToStream(Self.Description); end; if Self.picture = nil then Self.Picture := TMemoryStream.Create; Self.Picture.Position := 0; TBlobField(FMemTable.Fields[fiCompon_Picture]).SaveToStream(Self.Picture); Self.Picture.Position := 0; Self.Color := FMemTable.Fields[fiCompon_Color].AsInteger; Self.IsLine := FMemTable.Fields[fiCompon_IsLine].AsInteger; Self.ISComplect := FMemTable.Fields[fiCompon_ISComplect].AsInteger; if fiCompon_PriceSupply <> -1 then Self.PriceSupply := FMemTable.Fields[fiCompon_PriceSupply].AsFloat; Self.PRICE := FMemTable.Fields[fiCompon_PRICE].AsFloat; Self.PRICE_CALC := FMemTable.Fields[fiCompon_PriceCalc].AsFloat; Self.UserLength := FMemTable.Fields[fiCompon_UserLength].AsFloat; Self.MaxLength := FMemTable.Fields[fiCompon_MaxLength].AsFloat; Self.HASNDS := FMemTable.Fields[fiCompon_HASNDS].AsInteger; Self.ID_ComponentType := FMemTable.Fields[fiCompon_IDComponentType].AsInteger; Self.IDSymbol := FMemTable.Fields[fiCompon_IDSymbol].AsInteger; Self.IDObjectIcon := FMemTable.Fields[fiCompon_IDObjectIcon].AsInteger; Self.ObjectIconStep := FMemTable.Fields[fiCompon_ObjectIconStep].AsFloat; Self.ID_Producer := FMemTable.Fields[fiCompon_IDProducer].AsInteger; Self.ID_CURRENCY := FMemTable.Fields[fiCompon_IDCurrency].AsInteger; if fiCompon_IDSuppliesKind <> -1 then Self.IDSuppliesKind := FMemTable.Fields[fiCompon_IDSuppliesKind].AsInteger; Self.ID_SUPPLIER := FMemTable.Fields[fiCompon_IDSupplier].AsInteger; Self.IDNetType := FMemTable.Fields[fiCompon_IDNetType].AsInteger; Self.SortID := FMemTable.Fields[fiCompon_SortID].AsInteger; Self.KolComplect := FMemTable.Fields[fiCompon_KolComplect].AsInteger; if fiCompon_CableCanalConnectorsCnt <> -1 then Self.CableCanalConnectorsCnt := FMemTable.Fields[fiCompon_CableCanalConnectorsCnt].AsInteger; if fiCompon_InterfCount <> -1 then Self.InterfCount := FMemTable.Fields[fiCompon_InterfCount].AsInteger; if fiCompon_JoinsCount <> -1 then Self.JoinsCount := FMemTable.Fields[fiCompon_JoinsCount].AsInteger; if fiCompon_NormsCount <> -1 then Self.NormsCount := FMemTable.Fields[fiCompon_NormsCount].AsInteger; if fiCompon_PropsCount <> -1 then Self.PropsCount := FMemTable.Fields[fiCompon_PropsCount].AsInteger; if fiCompon_ResourcesCount <> -1 then Self.ResourcesCount := FMemTable.Fields[fiCompon_ResourcesCount].AsInteger; Self.IDNormBase := FMemTable.Fields[fiCompon_IDNormbase].AsInteger; Self.ObjectID := FMemTable.Fields[fiCompon_ObjectID].AsInteger; Self.ListID := FMemTable.Fields[fiCompon_ListID].AsInteger; Self.Whole_ID := FMemTable.Fields[fiCompon_WholeID].AsInteger; if fiCompon_IDRelatedCompon <> -1 then Self.IDRelatedCompon := FMemTable.Fields[fiCompon_IDRelatedCompon].AsInteger; if fiCompon_IsDismount <> -1 then Self.IsDismount := FMemTable.Fields[fiCompon_IsDismount].AsInteger; if fiCompon_IsUseDismounted <> -1 then Self.IsUseDismounted := FMemTable.Fields[fiCompon_IsUseDismounted].AsInteger else if Self.IsDismount = biTrue then Self.IsUseDismounted := biTrue; if fiCompon_UseKindInProj <> -1 then Self.UseKindInProj := FMemTable.Fields[fiCompon_UseKindInProj].AsInteger else Self.UseKindInProj := ukUsual; if fiCompon_ComeFrom <> -1 then Self.ComeFrom := FMemTable.Fields[fiCompon_ComeFrom].AsInteger else Self.ComeFrom := cftUser; if fiCompon_IsTemplate <> -1 then Self.IsTemplate := FMemTable.Fields[fiCompon_IsTemplate].AsInteger else Self.IsTemplate := biFalse; Self.NameMark := FMemTable.Fields[fiCompon_NameMark].AsString; Self.MarkID := FMemTable.Fields[fiCompon_MarkID].AsInteger; Self.IsUserMark := FMemTable.Fields[fiCompon_IsUserMark].AsInteger; if fiCompon_IsMarkInCaptions <> -1 then Self.IsMarkInCaptions := FMemTable.Fields[fiCompon_IsMarkInCaptions].AsInteger else Self.IsMarkInCaptions := biFalse; Self.ServCopyIndex := 0; end; except on E: Exception do AddExceptionToLog('TSCSComponent.LoadFromMemTable: '+E.Message); end; end; procedure TSCSComponent.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := tSQL_Component; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.Fields[fiCompon_ID].AsInteger := Self.ID; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, Self.ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.Fields[fiCompon_GuidNB].AsInteger := AStringsMan.GenStrID(Self.GuidNB, AStringsMan.FComponGuidNBStrings); FMemTable.Fields[fiCompon_Name].AsInteger := AStringsMan.GenStrID(Self.NAME, AStringsMan.FComponNameStrings); FMemTable.Fields[fiCompon_NameShort].AsInteger := AStringsMan.GenStrID(Self.NameShort, AStringsMan.FComponNameShortStrings); //FMemTable.Fields[fiCompon_MarkStr].AsString := Self.MarkStr; FMemTable.Fields[fiCompon_Cypher].AsInteger := AStringsMan.GenStrID(Self.Cypher, AStringsMan.FComponCypherStrings); FMemTable.Fields[fiCompon_Izm].AsInteger := AStringsMan.GenStrID(Self.Izm, AStringsMan.FIzmStrings); FMemTable.Fields[fiCompon_Notice].AsInteger := AStringsMan.GenStrID(Self.Notice, AStringsMan.ComponNoticeStrings); if ACanSaveBlobs then begin Self.Description.Position := 0; TBlobField(FMemTable.Fields[fiCompon_Description]).LoadFromStream(Self.Description); end; if ACanSaveBlobs then if Assigned(Self.Picture) then begin Self.Picture.Position := 0; TBlobField(FMemTable.Fields[fiCompon_Picture]).LoadFromStream(Self.Picture); Self.Picture.Position := 0; end; FMemTable.Fields[fiCompon_Color].AsInteger := Self.Color; FMemTable.Fields[fiCompon_IsLine].AsInteger := Self.IsLine; FMemTable.Fields[fiCompon_ISComplect].AsInteger := Self.ISComplect; FMemTable.Fields[fiCompon_PriceSupply].AsFloat := Self.PriceSupply; FMemTable.Fields[fiCompon_PRICE].AsFloat := Self.PRICE; FMemTable.Fields[fiCompon_PriceCalc].AsFloat := Self.PRICE_CALC; FMemTable.Fields[fiCompon_UserLength].AsFloat := Self.UserLength; FMemTable.Fields[fiCompon_MaxLength].AsFloat := Self.MaxLength; FMemTable.Fields[fiCompon_HASNDS].AsInteger := Self.HASNDS; FMemTable.Fields[fiCompon_ArticulDistributor].AsInteger := AStringsMan.GenStrID(Self.ArticulDistributor, AStringsMan.FComponArticulStrings); FMemTable.Fields[fiCompon_ArticulProducer].AsInteger := AStringsMan.GenStrID(Self.ArticulProducer, AStringsMan.FComponArticulStrings); FMemTable.Fields[fiCompon_IDComponentType].AsInteger := Self.ID_ComponentType; FMemTable.Fields[fiCompon_IDSymbol].AsInteger := Self.IDSymbol; FMemTable.Fields[fiCompon_IDObjectIcon].AsInteger := Self.IDObjectIcon; FMemTable.Fields[fiCompon_ObjectIconStep].AsFloat := Self.ObjectIconStep; FMemTable.Fields[fiCompon_IDProducer].AsInteger := Self.ID_Producer; FMemTable.Fields[fiCompon_IDCurrency].AsInteger := Self.ID_CURRENCY; FMemTable.Fields[fiCompon_IDSuppliesKind].AsInteger := Self.IDSuppliesKind; FMemTable.Fields[fiCompon_IDSupplier].AsInteger := Self.ID_SUPPLIER; FMemTable.Fields[fiCompon_IDNetType].AsInteger := Self.IDNetType; FMemTable.Fields[fiCompon_SortID].AsInteger := Self.SortID; FMemTable.Fields[fiCompon_KolComplect].AsInteger := Self.KolComplect; FMemTable.Fields[fiCompon_CableCanalConnectorsCnt].AsInteger := Self.CableCanalConnectorsCnt; FMemTable.Fields[fiCompon_InterfCount].AsInteger := Self.InterfCount; FMemTable.Fields[fiCompon_JoinsCount].AsInteger := Self.JoinsCount; FMemTable.Fields[fiCompon_NormsCount].AsInteger := Self.NormsCount; FMemTable.Fields[fiCompon_PropsCount].AsInteger := Self.PropsCount; FMemTable.Fields[fiCompon_ResourcesCount].AsInteger := Self.ResourcesCount; FMemTable.Fields[fiCompon_IDNormbase].AsInteger := Self.IDNormBase; FMemTable.Fields[fiCompon_ObjectID].AsInteger := Self.ObjectID; FMemTable.Fields[fiCompon_ListID].AsInteger := Self.ListID; FMemTable.Fields[fiCompon_IDRelatedCompon].AsInteger := Self.IDRelatedCompon; //FMemTable.Fields['Project_ID'].AsInteger := ProjectID; FMemTable.Fields[fiCompon_WholeID].AsInteger := Self.Whole_ID; FMemTable.Fields[fiCompon_IsDismount].AsInteger := Self.IsDismount; FMemTable.Fields[fiCompon_IsUseDismounted].AsInteger := Self.IsUseDismounted; FMemTable.Fields[fiCompon_UseKindInProj].AsInteger := Self.UseKindInProj; FMemTable.Fields[fiCompon_NameMark].AsString := Self.NameMark; FMemTable.Fields[fiCompon_MarkID].AsInteger := Self.MarkID; FMemTable.Fields[fiCompon_IsUserMark].AsInteger := Self.IsUserMark; FMemTable.Fields[fiCompon_IsMarkInCaptions].AsInteger := Self.IsMarkInCaptions; FMemTable.Fields[fiCompon_ComeFrom].AsInteger := Self.ComeFrom; FMemTable.Fields[fiCompon_IsTemplate].AsInteger := Self.IsTemplate; FMemTable.Fields[fiCompon_GuidComponentType].AsInteger := AStringsMan.GenStrID(Self.GUIDComponentType, AStringsMan.FComponentTypeGUIDStrings); FMemTable.Fields[fiCompon_GuidSymbol].AsInteger := AStringsMan.GenStrID(Self.GUIDSymbol, AStringsMan.FObjectIconGUIDStrings); FMemTable.Fields[fiCompon_GuidObjectIcon].AsInteger := AStringsMan.GenStrID(Self.GUIDObjectIcon, AStringsMan.FObjectIconGUIDStrings); FMemTable.Fields[fiCompon_GuidProducer].AsInteger := AStringsMan.GenStrID(Self.GUIDProducer, AStringsMan.FProducerGUIDStrings); FMemTable.Fields[fiCompon_GuidSuppliesKind].AsInteger := AStringsMan.GenStrID(Self.GUIDSuppliesKind, AStringsMan.FSuppliesKindGUIDStrings); FMemTable.Fields[fiCompon_GuidSupplier].AsInteger := AStringsMan.GenStrID(Self.GUIDSupplier, AStringsMan.FSupplierGUIDStrings); FMemTable.Fields[fiCompon_GuidNetType].AsInteger := AStringsMan.GenStrID(Self.GUIDNetType, AStringsMan.FNetTypeGUIDStrings); FMemTable.Post; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.SaveToMemTable: '+E.Message); end; end; procedure TSCSComponent.LoadFromDataStream(ADataStream: TDataStream; AStringsMan: TStringsMan); // Tolik -- не используется var i, w: Integer; begin try ADataStream.BeginReadRecord; with TF_Main(FActiveForm).DM do begin if Self.picture = nil then Self.Picture := TMemoryStream.Create; for i := 0 to ADataStream.FieldCount - 1 do begin ADataStream.ReadField; if (AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan) and (ADataStream.ReadFieldFieldType = dtString) then begin if ADataStream.ReadFieldIndex = fiCompon_GuidNB then Self.GuidNB := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_Name then Self.Name := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_NameShort then Self.NameShort := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_Cypher then Self.Cypher := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_Izm then Self.Izm := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_Notice then Self.Notice := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_ArticulDistributor then Self.ArticulDistributor := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_ArticulProducer then Self.ArticulProducer := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidComponentType then Self.GUIDComponentType := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidSymbol then Self.GUIDSymbol := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidObjectIcon then Self.GUIDObjectIcon := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidProducer then Self.GUIDProducer := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidSuppliesKind then begin if fiCompon_GuidSuppliesKind <> -1 then Self.GUIDSuppliesKind := ADataStream.ReadStr; end else if ADataStream.ReadFieldIndex = fiCompon_GuidSupplier then Self.GUIDSupplier := ADataStream.ReadStr else if ADataStream.ReadFieldIndex = fiCompon_GuidNetType then Self.GUIDNetType := ADataStream.ReadStr; end else if (ADataStream.ReadFieldFieldType = dtInteger) then begin if ADataStream.ReadFieldIndex = fiCompon_GuidNB then Self.GuidNB := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponGuidNBStrings) else if ADataStream.ReadFieldIndex = fiCompon_Name then Self.Name := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponNameStrings) else if ADataStream.ReadFieldIndex = fiCompon_NameShort then Self.NameShort := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponNameShortStrings) else if ADataStream.ReadFieldIndex = fiCompon_Cypher then Self.Cypher := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponCypherStrings) else if ADataStream.ReadFieldIndex = fiCompon_Izm then Self.Izm := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FIzmStrings) else if ADataStream.ReadFieldIndex = fiCompon_Notice then Self.Notice := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponNoticeStrings) else if ADataStream.ReadFieldIndex = fiCompon_ArticulDistributor then Self.ArticulDistributor := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponArticulStrings) else if ADataStream.ReadFieldIndex = fiCompon_ArticulProducer then Self.ArticulProducer := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponArticulStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidComponentType then Self.GUIDComponentType := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FComponentTypeGUIDStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidSymbol then Self.GUIDSymbol := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FObjectIconGUIDStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidObjectIcon then Self.GUIDObjectIcon := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FObjectIconGUIDStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidProducer then Self.GUIDProducer := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FProducerGUIDStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidSuppliesKind then begin if fiCompon_GuidSuppliesKind <> -1 then Self.GUIDSuppliesKind := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FSuppliesKindGUIDStrings); end else if ADataStream.ReadFieldIndex = fiCompon_GuidSupplier then Self.GUIDSupplier := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FSupplierGUIDStrings) else if ADataStream.ReadFieldIndex = fiCompon_GuidNetType then Self.GUIDNetType := AStringsMan.GetStrByID(ADataStream.ReadIntValue, AStringsMan.FNetTypeGUIDStrings); end; case ADataStream.ReadFieldFieldType of dtBlob: begin if ADataStream.ReadFieldIndex = fiCompon_Description then begin if fiCompon_Description <> -1 then ADataStream.ReadBlobField(Self.Description); end else if ADataStream.ReadFieldIndex = fiCompon_Picture then ADataStream.ReadBlobField(Self.Picture); end; dtFloat: begin if ADataStream.ReadFieldIndex = fiCompon_PRICE then Self.PRICE := ADataStream.ReadFloatValue else if ADataStream.ReadFieldIndex = fiCompon_PriceCalc then Self.PRICE_CALC := ADataStream.ReadFloatValue else if ADataStream.ReadFieldIndex = fiCompon_UserLength then Self.UserLength := ADataStream.ReadFloatValue else if ADataStream.ReadFieldIndex = fiCompon_MaxLength then Self.MaxLength := ADataStream.ReadFloatValue else if ADataStream.ReadFieldIndex = fiCompon_PriceSupply then begin if fiCompon_PriceSupply <> -1 then Self.PriceSupply := ADataStream.ReadFloatValue; end else if ADataStream.ReadFieldIndex = fiCompon_ObjectIconStep then Self.ObjectIconStep := ADataStream.ReadFloatValue; end; dtInteger: begin if ADataStream.ReadFieldIndex = fiCompon_ID then Self.ID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_Color then Self.Color := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IsLine then Self.IsLine := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_ISComplect then Self.ISComplect := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_HASNDS then Self.HASNDS := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDComponentType then Self.ID_ComponentType := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDSymbol then Self.IDSymbol := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDObjectIcon then Self.IDObjectIcon := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDProducer then Self.ID_Producer := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDCurrency then Self.ID_CURRENCY := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDSuppliesKind then begin if fiCompon_IDSuppliesKind <> -1 then Self.IDSuppliesKind := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_IDSupplier then Self.ID_SUPPLIER := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IDNetType then Self.IDNetType := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_SortID then Self.SortID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_KolComplect then Self.KolComplect := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_CableCanalConnectorsCnt then begin if fiCompon_CableCanalConnectorsCnt <> -1 then Self.CableCanalConnectorsCnt := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_InterfCount then begin if fiCompon_InterfCount <> -1 then Self.InterfCount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_JoinsCount then begin if fiCompon_JoinsCount <> -1 then Self.JoinsCount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_NormsCount then begin if fiCompon_NormsCount <> -1 then Self.NormsCount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_PropsCount then begin if fiCompon_PropsCount <> -1 then Self.PropsCount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_ResourcesCount then begin if fiCompon_ResourcesCount <> -1 then Self.ResourcesCount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_IDNormbase then Self.IDNormBase := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_ObjectID then Self.ObjectID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_ListID then Self.ListID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_WholeID then Self.Whole_ID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IsDismount then begin if fiCompon_IsDismount <> -1 then Self.IsDismount := ADataStream.ReadIntValue; end else if ADataStream.ReadFieldIndex = fiCompon_IsUseDismounted then begin if fiCompon_IsUseDismounted <> -1 then Self.IsUseDismounted := ADataStream.ReadIntValue else if Self.IsDismount = biTrue then Self.IsUseDismounted := biTrue; end else if ADataStream.ReadFieldIndex = fiCompon_UseKindInProj then begin if fiCompon_UseKindInProj <> -1 then Self.UseKindInProj := ADataStream.ReadIntValue else Self.UseKindInProj := ukUsual; end else if ADataStream.ReadFieldIndex = fiCompon_MarkID then Self.MarkID := ADataStream.ReadIntValue else if ADataStream.ReadFieldIndex = fiCompon_IsUserMark then Self.IsUserMark := ADataStream.ReadIntValue; end; dtString: begin if ADataStream.ReadFieldIndex = fiCompon_NameMark then Self.NameMark := ADataStream.ReadStr; end; end; end; Self.ServCopyIndex := 0; end; ADataStream.EndReadRecord; except on E: Exception do AddExceptionToLogEx('TSCSComponent.LoadFromDataStream', E.Message); end; end; procedure TSCSComponent.SaveToDataStream(ADataStream: TDataStream; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean); //var //StreamProvider: TDataStream; begin //StreamProvider := TDataStream.Create; ADataStream.BeginWriteRecord; with TF_Main(FActiveForm).DM do begin ADataStream.WriteIntField(fiCompon_GuidNB, AStringsMan.GenStrID(Self.GuidNB, AStringsMan.FComponGuidNBStrings)); ADataStream.WriteIntField(fiCompon_Name, AStringsMan.GenStrID(Self.NAME, AStringsMan.FComponNameStrings)); ADataStream.WriteIntField(fiCompon_Name, AStringsMan.GenStrID(Self.NAME, AStringsMan.FComponNameStrings)); ADataStream.WriteIntField(fiCompon_NameShort, AStringsMan.GenStrID(Self.NameShort, AStringsMan.FComponNameShortStrings)); //FMemTable.Fields[fiCompon_MarkStr].AsString := Self.MarkStr; ADataStream.WriteIntField(fiCompon_Cypher, AStringsMan.GenStrID(Self.Cypher, AStringsMan.FComponCypherStrings)); ADataStream.WriteIntField(fiCompon_Izm, AStringsMan.GenStrID(Self.Izm, AStringsMan.FIzmStrings)); ADataStream.WriteIntField(fiCompon_Notice, AStringsMan.GenStrID(Self.Notice, AStringsMan.ComponNoticeStrings)); if ACanSaveBlobs then begin //Self.Description.Position := 0; //TBlobField(FMemTable.Fields[fiCompon_Description]).LoadFromStream(Self.Description); ADataStream.WriteStreamField(fiCompon_Description, Self.Description); end; if ACanSaveBlobs then if Assigned(Self.Picture) then begin //Self.Picture.Position := 0; //TBlobField(FMemTable.Fields[fiCompon_Picture]).LoadFromStream(Self.Picture); //Self.Picture.Position := 0; ADataStream.WriteStreamField(fiCompon_Picture, Self.Picture); end; ADataStream.WriteIntField(fiCompon_Color, Self.Color); ADataStream.WriteIntField(fiCompon_IsLine, Self.IsLine); ADataStream.WriteIntField(fiCompon_ISComplect, Self.ISComplect); ADataStream.WriteFloatField(fiCompon_PriceSupply, Self.PriceSupply); ADataStream.WriteFloatField(fiCompon_PRICE, Self.PRICE); ADataStream.WriteFloatField(fiCompon_PriceCalc, Self.PRICE_CALC); ADataStream.WriteFloatField(fiCompon_UserLength, Self.UserLength); ADataStream.WriteFloatField(fiCompon_MaxLength, Self.MaxLength); ADataStream.WriteIntField(fiCompon_HASNDS, Self.HASNDS); ADataStream.WriteIntField(fiCompon_ArticulDistributor, AStringsMan.GenStrID(Self.ArticulDistributor, AStringsMan.FComponArticulStrings)); ADataStream.WriteIntField(fiCompon_ArticulProducer, AStringsMan.GenStrID(Self.ArticulProducer, AStringsMan.FComponArticulStrings)); ADataStream.WriteIntField(fiCompon_IDComponentType, Self.ID_ComponentType); ADataStream.WriteIntField(fiCompon_IDSymbol, Self.IDSymbol); ADataStream.WriteIntField(fiCompon_IDObjectIcon, Self.IDObjectIcon); ADataStream.WriteFloatField(fiCompon_ObjectIconStep, Self.ObjectIconStep); ADataStream.WriteIntField(fiCompon_IDProducer, Self.ID_Producer); ADataStream.WriteIntField(fiCompon_IDCurrency, Self.ID_CURRENCY); ADataStream.WriteIntField(fiCompon_IDSuppliesKind, Self.IDSuppliesKind); ADataStream.WriteIntField(fiCompon_IDSupplier, Self.ID_SUPPLIER); ADataStream.WriteIntField(fiCompon_IDNetType, Self.IDNetType); ADataStream.WriteIntField(fiCompon_SortID, Self.SortID); ADataStream.WriteIntField(fiCompon_KolComplect, Self.KolComplect); ADataStream.WriteIntField(fiCompon_CableCanalConnectorsCnt, Self.CableCanalConnectorsCnt); ADataStream.WriteIntField(fiCompon_InterfCount, Self.InterfCount); ADataStream.WriteIntField(fiCompon_JoinsCount, Self.JoinsCount); ADataStream.WriteIntField(fiCompon_NormsCount, Self.NormsCount); ADataStream.WriteIntField(fiCompon_PropsCount, Self.PropsCount); ADataStream.WriteIntField(fiCompon_ResourcesCount, Self.ResourcesCount); ADataStream.WriteIntField(fiCompon_IDNormbase, Self.IDNormBase); ADataStream.WriteIntField(fiCompon_ObjectID, Self.ObjectID); ADataStream.WriteIntField(fiCompon_ListID, Self.ListID); //FMemTable.Fields['Project_ID'].AsInteger := ProjectID; ADataStream.WriteIntField(fiCompon_WholeID, Self.Whole_ID); ADataStream.WriteIntField(fiCompon_IsDismount, Self.IsDismount); ADataStream.WriteIntField(fiCompon_IsUseDismounted, Self.IsUseDismounted); ADataStream.WriteIntField(fiCompon_UseKindInProj, Self.UseKindInProj); ADataStream.WriteStrField(fiCompon_NameMark, Self.NameMark); ADataStream.WriteIntField(fiCompon_MarkID, Self.MarkID); ADataStream.WriteIntField(fiCompon_IsUserMark, Self.IsUserMark); ADataStream.WriteIntField(fiCompon_IsMarkInCaptions, Self.IsMarkInCaptions); ADataStream.WriteIntField(fiCompon_GuidComponentType, AStringsMan.GenStrID(Self.GUIDComponentType, AStringsMan.FComponentTypeGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidSymbol, AStringsMan.GenStrID(Self.GUIDSymbol, AStringsMan.FObjectIconGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidObjectIcon, AStringsMan.GenStrID(Self.GUIDObjectIcon, AStringsMan.FObjectIconGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidProducer, AStringsMan.GenStrID(Self.GUIDProducer, AStringsMan.FProducerGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidSuppliesKind, AStringsMan.GenStrID(Self.GUIDSuppliesKind, AStringsMan.FSuppliesKindGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidSupplier, AStringsMan.GenStrID(Self.GUIDSupplier, AStringsMan.FSupplierGUIDStrings)); ADataStream.WriteIntField(fiCompon_GuidNetType, AStringsMan.GenStrID(Self.GUIDNetType, AStringsMan.FNetTypeGUIDStrings)); end; ADataStream.EndWriteRecord; end; function TSCSComponent.GetWholeLength(ATakeIntoThroghObjects: Boolean = true; AWholeComponObj: TSCSComponents=nil): Double; var ObjectOwner: TSCSCatalog; PartComponent: TSCSComponent; ListOwner: TSCSList; //IDOtherFloorFigure: Integer; //LookedFloorFigures: TIntList; //OtherFloorFigures: TIntList; //OtherFloorObject: TSCSCatalog; //OtherFloorComponent: TSCSComponent; CurrLengthReserv: Double; //IDOwnerList: Integer; OwnerList: TSCSList; SummLength, CurrLength: Double; //CurrIDCompon: Integer; i, j: Integer; WholeComponObj: TSCSComponents; IsCurrWholeComponObj: Boolean; //ListSettingRecord: TListSettingRecord; //LengthKoef: Double; //PortReserv: Double; //MultiportReserv: Double; //FirstPortKind: TPortKind; //LastPortKind: TPortKind; { procedure AddPortMultipotReserv(APortKind: TPortKind); begin case APortKind of pkPort: Length := Length + PortReserv; pkMultiport: Length := Length + MultiportReserv; end; end; } begin Result := 0; LengthReserv := 0; try //LookedFloorFigures := nil; //OtherFloorFigures := nil; SummLength := 0; WholeComponObj := AWholeComponObj; //17.01.2013 IsCurrWholeComponObj := false; //17.01.2013 if WholeComponent.Count = 0 then begin LoadWholeComponent(false, @WholeComponObj); //17.01.2013 LoadWholeComponent(false); IsCurrWholeComponObj := true; //17.01.2013 end; for i := 0 to WholeComponent.Count - 1 do begin //17.01.2013 PartComponent := FProjectOwner.GetComponentFromReferences(WholeComponent[i]); PartComponent := nil; if WholeComponObj <> nil then PartComponent := WholeComponObj[i] else PartComponent := FProjectOwner.GetComponentFromReferences(WholeComponent[i]); CurrLength := 0; if (PartComponent.ListID = Self.ListID) or ATakeIntoThroghObjects then begin CurrLength := GetComponPartLengthWithReserv(PartComponent, CurrLengthReserv, true, ATakeIntoThroghObjects); //GetLengthByComponent(PartComponent); LengthReserv := LengthReserv + CurrLengthReserv; end; //*** Учет м-э перекрытий {if ATakeIntoThroghObjects then begin ObjectOwner := PartComponent.GetFirstParentCatalog; if ObjectOwner <> nil then if ((LookedFloorFigures = nil) or (LookedFloorFigures.IndexOf(ObjectOwner.SCSID) = -1)) and ((OtherFloorFigures = nil) or (OtherFloorFigures.IndexOf(ObjectOwner.SCSID) = -1)) then if IsBetweenFloorObject(ObjectOwner.ListID, ObjectOwner.SCSID, IDOtherFloorFigure) then begin ListOwner := GetListOwner; CurrLength := CurrLength + FProjectOwner.Setting.HeightThroughFloor; //*** Процент запасса if ListOwner <> nil then CurrLength := CurrLength + (FProjectOwner.Setting.HeightThroughFloor*ListOwner.Setting.LengthKoef/100); if LookedFloorFigures = nil then LookedFloorFigures := TIntList.Create; if OtherFloorFigures = nil then OtherFloorFigures := TIntList.Create; LookedFloorFigures.Add(ObjectOwner.SCSID); OtherFloorFigures.Add(IDOtherFloorFigure); if FProjectOwner <> nil then begin if (FProjectOwner.FIDsNearFloorFigures.IndexOf(ObjectOwner.SCSID) = -1) and (FProjectOwner.FIDsNearFloorFigures.IndexOf(IDOtherFloorFigure) = -1) and (FProjectOwner.FIDsOppositeNearFloorFigures.IndexOf(ObjectOwner.SCSID) = -1) and (FProjectOwner.FIDsOppositeNearFloorFigures.IndexOf(IDOtherFloorFigure) = -1) then begin FProjectOwner.FIDsNearFloorFigures.Add(ObjectOwner.SCSID); FProjectOwner.FIDsOppositeNearFloorFigures.Add(IDOtherFloorFigure); end; end; end; end;} SummLength := SummLength + CurrLength; end; Result := SummLength; //17.01.2013 if IsCurrWholeComponObj and (WholeComponObj <> nil) then WholeComponObj.Free; {if OtherFloorFigures <> nil then begin //*** Указать компонтам второго конца м-э перехода (кот на другом этаже) // что обновлять длину не нужно for i := 0 to OtherFloorFigures.Count - 1 do begin IDOtherFloorFigure := OtherFloorFigures[i]; //*** трсса не была расмотрена if LookedFloorFigures.IndexOf(IDOtherFloorFigure) = -1 then begin OtherFloorObject := FProjectOwner.GetCatalogFromReferencesBySCSID(IDOtherFloorFigure); if OtherFloorObject <> nil then for j := 0 to OtherFloorObject.ComponentReferences.Count - 1 do begin OtherFloorComponent := OtherFloorObject.ComponentReferences[j]; if OtherFloorComponent.ID_ComponentType = ID_ComponentType then if WholeComponent.IndexOf(OtherFloorComponent.Whole_ID) = -1 then begin //OtherFloorComponent.RefreshWholeLength(false); OtherFloorComponent.ServChangedLength := biFalse; end; end; end; end; FreeAndNil(OtherFloorFigures); end; if LookedFloorFigures <> nil then FreeAndNil(LookedFloorFigures); } //if Self.ID_ComponentType <> ctCableCanal then //-------------------------------- //ApplyLengthData(Result, CurrLengthReserv, FirstIDConnectedConnCompon, LastIDConnectedConnCompon, ATakeIntoThroghObjects); //LengthReserv := LengthReserv + CurrLengthReserv; //----------------------------- {IDOwnerList := TF_Main(ActiveForm).DM.GetListIDByIDComponent(ID); OwnerList := TF_Main(ActiveForm).GSCSBase.CurrProject.GetListBySCSID(IDOwnerList); if OwnerList <> nil then begin ListSettingRecord := OwnerList.Setting; PortReserv := ListSettingRecord.PortReserv; MultiportReserv := ListSettingRecord.MultiportReserv; //PortReserv := TF_Main(ActiveForm).GetPropertyValueAsFloat(tkCatalog, OwnerList.ID, pnPortReserv); //MultiportReserv := TF_Main(ActiveForm).GetPropertyValueAsFloat(tkCatalog, OwnerList.ID, pnMultiPortReserv); FirstPortKind := GetConnectedComponPortKind(FirstIDConnectedConnCompon); LastPortKind := GetConnectedComponPortKind(LastIDConnectedConnCompon); SummLength := 0; for i := 0 to WholeComponent.Count - 1 do begin CurrIDCompon := Integer(WholeComponent.Items[i]^); CurrLength := 0; CurrLength := GetLengthByIDComponent(CurrIDCompon); SummLength := SummLength + CurrLength; end; Length := SummLength; //*** Учет запаса if AAccountReserveLength then ApplyLengthReserv(Length, ID); //*** Применение коэфициента ApplyLengthKoef(Length, ID); //*** Учет резерва со сторон порта/мультипорта AddPortMultipotReserv(FirstPortKind); AddPortMultipotReserv(LastPortKind); LengthReserv := Length - SummLength; end; } except on E: Exception do AddExceptionToLog('TSCSComponent.LoadWholeLenth: '+E.Message); end; end; procedure TSCSComponent.LoadWholeLength(ATakeIntoThroghObjects: Boolean=true; AWholeComponObj: TSCSComponents=nil); begin FLength := GetWholeLength(ATakeIntoThroghObjects, AWholeComponObj); end; procedure TSCSComponent.RefreshWholeLength(ATakeIntoThroghObjects: Boolean = true); var SCSPartCompon: TSCSComponent; TopParentCatalog: TSCSCatalog; i, j: Integer; WholeComponObj: TSCSComponents; begin try TopParentCatalog := GetTopParentCatalog; if TopParentCatalog = nil then Exit; //// EXIT //// LoadWholeComponent(false, @WholeComponObj); LoadWholeLength(ATakeIntoThroghObjects, WholeComponObj); if WholeComponObj <> nil then begin for i := 0 to WholeComponObj.Count - 1 do begin SCSPartCompon := WholeComponObj[i]; //17.01.2013 for i := 0 to WholeComponent.Count - 1 do //17.01.2013 begin //TF_Main(ActiveForm).DM.SetPropertyValueAsFloat(tkComponent, Integer(WholeComponent[i]^), pnLength, Length, qmUndef, -1); //17.01.2013 SCSPartCompon := TopParentCatalog.GetComponentFromReferences(WholeComponent[i]); //17.01.2013 if Assigned(SCSPartCompon) then begin SCSPartCompon.Length := Length; SCSPartCompon.SetPropertyValueAsFloat(pnLength, Length, true); SCSPartCompon.ServChangedLength := biFalse; end; end; WholeComponObj.Free; end; except on E: Exception do AddExceptionToLog('TSCSComponent.RefreshWholeLength: '+E.Message); end; end; procedure TSCSComponent.LoadCurrLength; var LengthWithoutReserv: Double; begin Length := GetComponPartLengthWithReserv(Self, LengthReserv, false, false); LengthWithoutReserv := Length - LengthReserv; end; // ##### Загрузить ID-ки соединений ###### procedure TSCSComponent.LoadConections; var ID_CompRelConn: ^Integer; begin LoadCompRel(cntUnion, FConnections, -1, -1); end; procedure TSCSComponent.LoadCrossConnections; var ptrCrossConnection: TSCSCrossConnection; i: Integer; procedure LoadIDNameFromFields(AIDCompRel: Integer; var AIDChild: Integer; var AName: String); var ptrComplect: PComplect; ChildComponent: TSCSComponent; begin AIDChild := 0; AName := ''; ptrComplect := GetComplectByID(AIDCompRel); if ptrComplect <> nil then begin AIDChild := ptrComplect.ID_Child; ChildComponent := GetComponentFromReferences(ptrComplect.ID_Child); if Assigned(ChildComponent) then AName := ChildComponent.Name; end; end; begin //if ComponentType.SysName = ctsnCupBoard then if TF_Main(FActiveForm).GDBMode = bkNormBase then begin FCrossConnections.Clear; //ClearList(FCrossConnections); SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnCrossConnection, fnIDComponent+' = '''+IntToStr(ID)+'''', nil, fnAll)); while Not FQSelect.Eof do begin //ptrCrossConnection := TF_Main(FActiveForm).DM.GetCrossConnectionFromQuery(FQSelect); ptrCrossConnection := TSCSCrossConnection.Create(FActiveForm); ptrCrossConnection.LoadFromQuery(FQSelect); FCrossConnections.Add(ptrCrossConnection); FQSelect.Next; end; //*** Загрузить пути к подключенным компонентам if FCrossConnections.Count > 0 then TF_Main(FActiveForm).DM.LoadCrossConnectionsPaths(FCrossConnections); {begin SetSQLToFIBQuery(FQSelect, 'select * from '+tnCrossConnectionPath+ ' where '+fnIDCrossConnection+' = :'+fnIDCrossConnection+ ' order by '+fnID, false); for i := 0 to FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(FCrossConnections[i]); FQSelect.Close; FQSelect.Params[0].AsInteger := ptrCrossConnection.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin case FQSelect.FN(fnPathType).AsInteger of ptFrom: ptrCrossConnection.FCompRelFromPath.Add(FQSelect.FN(fnIDCompRel).AsInteger); ptTo: ptrCrossConnection.FCompRelToPath.Add(FQSelect.FN(fnIDCompRel).AsInteger); ptWith: ptrCrossConnection.FCompRelWithPath.Add(FQSelect.FN(fnIDCompRel).AsInteger); end; FQSelect.Next; end; end; end;} if FChildComplects.Count <> 0 then for i := 0 to FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(FCrossConnections[i]); with ptrCrossConnection do begin LoadIDNameFromFields(IDCompRelFrom, IDComponFrom, NameFrom); LoadIDNameFromFields(IDCompRelTo, IDComponTo, NameTo); LoadIDNameFromFields(IDCompRelWith, IDComponWith, NameWith); end; end else begin TF_Main(FActiveForm).DM.LoadCrossConnectionsNames(FCrossConnections); end end; end; function TSCSComponent.AddCCEToList(AIDConnector, AConnectorType: Integer): PCableCanalConnector; var ConnectorType: Integer; begin ConnectorType := AConnectorType; if ConnectorType = -1 then begin ConnectorType := StrToIntDef(TF_Main(FActiveForm).DM.GetPropertyValue(tkComponent, AIDConnector, pnCableCanalElemetType, qmPhisical, -1), -1); end; GetMem(Result, SizeOf(TCableCanalConnector)); Result.ID := 0; Result.IDCableCanal := Self.ID; Result.IDNBConnector := AIDConnector; Result.ConnectorType := ConnectorType; Result.GuidNBConnector := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnComponent, fnGuid, Result.IDNBConnector, qmPhisical); Result.NewID := -1; Result.IsNew := false; Result.IsModified := false; FCableCanalConnector.Add(Result); end; procedure TSCSComponent.LoadCableCanalConnectors; var strFilter: String; ptrCableCanalConnector: PCableCanalConnector; i: Integer; begin if ComponentType.SysName <> ctsnCableChannel then if ComponentType.SysName <> ctsnTube then //Tolik 15/11/2021 -- добавим исключение и для труб Exit; ///// EXIT //// ClearList(FCableCanalConnector); strFilter := fnIDComponent+' = '''+IntToStr(FID)+''''; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, 'select * from '+tnCableCanalConnectors+ ' where '+strFilter); while Not FQSelect.Eof do begin //GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); //ptrCableCanalConnector.ID := FQSelect.FN(fnID).AsInteger; //ptrCableCanalConnector.IDCableCanal := FQSelect.FN(fnIDComponent).AsInteger; //ptrCableCanalConnector.IDNBConnector := FQSelect.FN(fnIDNBConnector).AsInteger; //ptrCableCanalConnector.ConnectorType := FQSelect.FN(fnConnectorType).AsInteger; //ptrCableCanalConnector.GuidNBConnector := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnComponent, fnGuid, ptrCableCanalConnector.IDNBConnector, qmPhisical); //ptrCableCanalConnector.NewID := -1; //ptrCableCanalConnector.IsNew := false; //ptrCableCanalConnector.IsModified := false; ptrCableCanalConnector := AddCCEToList(FQSelect.FN(fnIDNBConnector).AsInteger, FQSelect.FN(fnConnectorType).AsInteger); ptrCableCanalConnector.ID := FQSelect.FN(fnID).AsInteger; ptrCableCanalConnector.IDCableCanal := FQSelect.FN(fnIDComponent).AsInteger; //FCableCanalConnector.Add(ptrCableCanalConnector); FQSelect.Next; end; FQSelect.Close; end; qmMemory: with TF_Main(FActiveForm).DM do begin (* SetFilterToSQLMemTable(tSQL_CableCanalConnectors, strFilter); for i := 0 to tSQL_CableCanalConnectors.RecordCount - 1 do begin tSQL_CableCanalConnectors.RecNo := i+1; { GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); ptrCableCanalConnector.ID := tSQL_CableCanalConnectors.FieldByName(fnID).AsInteger; ptrCableCanalConnector.IDCableCanal := tSQL_CableCanalConnectors.FieldByName(fnIDComponent).AsInteger; ptrCableCanalConnector.IDNBConnector := tSQL_CableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger; ptrCableCanalConnector.ConnectorType := tSQL_CableCanalConnectors.FieldByName(fnConnectorType).AsInteger; ptrCableCanalConnector.NewID := -1; } ptrCableCanalConnector := GetCableCanalConnectorFromMemTable; FCableCanalConnector.Add(ptrCableCanalConnector); end; *) end; end; end; procedure TSCSComponent.AddChildToReferences(ASCSComponent: TSCSComponent); begin if ASCSComponent <> nil then begin FChildReferences.Add(ASCSComponent); if Assigned(FParent) then begin if FParent is TSCSCatalog then if UseKindInProj = ukUsual then TSCSCatalog(FParent).AddComponentToReferences(ASCSComponent); if FParent is TSCSComponent then TSCSComponent(FParent).AddChildToReferences(ASCSComponent); end; end; end; procedure TSCSComponent.DefineCrossConnectionParamsBeforeSaveAsNew(ACrossConnection: TSCSCrossConnection); function DefineIDCompRelXX(ACompon: TSCSComponent; var AIDCompRelXX, AIDComponXX: Integer; ANppXX: Integer; ACompRelPath: TIntList; ARecurseIndex: Integer): Boolean; var ptrComplect: PComplect; SCSComplect: TSCSComponent; FindedComplect: Boolean; i, j: Integer; begin Result := false; // Если подключение к верхнему компоненту if AIDCompRelXX = 0 then begin if ACompon.ID = AIDComponXX then begin AIDComponXX := ACompon.NewID; Result := true; end; end else begin for i := 0 to ACompon.FComplects.Count - 1 do begin ptrComplect := ACompon.FComplects[i]; FindedComplect := false; if ptrComplect.ID = AIDCompRelXX then begin //*** Найти компонент, с нужной позицией если МП SCSComplect := nil; if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin for j := 0 to ACompon.FChildComplects.Count - 1 do if (ACompon.FChildComplects[j].ID = ptrComplect.ID_Child) and (ACompon.FChildComplects[j].ServCopyIndex = ANppXX) then if ACompon.FChildComplects[j].LinkToComlectRec <> nil then if ACompon.FChildComplects[j].LinkToComlectRec.ID = ptrComplect.ID then begin SCSComplect := ACompon.FChildComplects[j]; FindedComplect := true; Break; ///// BREAK ///// end; end else FindedComplect := true; if FindedComplect then begin AIDCompRelXX := ptrComplect.NewID; if (AIDCompRelXX = 0) and (TF_Main(FActiveForm).GDBMode = bkNormBase) then AIDCompRelXX := ptrComplect.ID; if SCSComplect <> nil then AIDComponXX := SCSComplect.NewID; Result := true; Break; ///// BREAK ///// end; end; end; //*** заглянуть внутрь if Result = false then for i := 0 to ACompon.FChildComplects.Count - 1 do begin ptrComplect := ACompon.FChildComplects[i].LinkToComlectRec; //*** Учитывать путь к комплектующей if (ptrComplect <> nil) then //if (ACompRelPath.Count = 0) or // ((ACompRelPath.Count >= ARecurseIndex) and (ACompRelPath[ARecurseIndex] = ptrComplect.ID)) then if (ACompRelPath.Count = 0) or (( (ACompRelPath.Count-1) >= ARecurseIndex) and (ACompRelPath[(ACompRelPath.Count-1)-ARecurseIndex] = ptrComplect.ID)) then begin if (ptrComplect.NewID <> 0) and ((ACompRelPath.Count-1) >= ARecurseIndex) then ACompRelPath[(ACompRelPath.Count-1)-ARecurseIndex] := ptrComplect.NewID; if DefineIDCompRelXX(ACompon.FChildComplects[i], AIDCompRelXX, AIDComponXX, ANppXX, ACompRelPath, ARecurseIndex + 1) then begin Result := true; Break; //// BREAK //// end; end; end; end; end; begin try with ACrossConnection do begin DefineIDCompRelXX(Self, IDCompRelFrom, IDComponFrom, NppFrom, FCompRelFromPath, 0); DefineIDCompRelXX(Self, IDCompRelTo, IDComponTo, NppTo, FCompRelToPath, 0); DefineIDCompRelXX(Self, IDCompRelWith, IDComponWith, NppWith, FCompRelWithPath, 0); end; except on E: Exception do AddExceptionToLogEx('TSCSComponent.DefineCrossConnectionParamsBeforeSaveAsNew', E.Message); end; end; procedure TSCSComponent.RemoveChildFromReferences(ASCSComponent: TSCSComponent); begin if ASCSComponent <> nil then begin if Assigned(FParent) then begin if FParent is TSCSCatalog then TSCSCatalog(FParent).RemoveComponentFromReferences(ASCSComponent); if FParent is TSCSComponent then TSCSComponent(FParent).RemoveChildFromReferences(ASCSComponent); end; FChildReferences.Remove(ASCSComponent); end; end; // ##### Проверить участвует ли интерфейс в соед-х ##### function TSCSComponent.CheckIOfIInConnectRel( AID_ConCompl: Integer): Boolean; var i: Integer; begin Result := false; for i := 0 to Connections.Count - 1 do if PComplect(Connections.Items[i]).ID = AID_ConCompl then begin Result := true; Break; end; end; // ##### Загрузить интерфейсы ##### procedure TSCSComponent.LoadInterfaces(AIDInterface: Integer = -1; ALoadIOfIRel: Boolean = true; ALoadSQL: Boolean = true); var Interf: TSCSInterface; InterfFinding: TSCSInterface; //IOfIRel: TSCSIOfIRel; i, j: Integer; ICount: Integer; strWhere: String; PortNumber: Integer; WasLoad: Boolean; Spravochnik: TSpravochnik; SprInterf: TNBInterface; currInterface: TSCSInterface; // Tolik 21/02/2018 -- begin //ClearList(Interfaces); // Tolik 21/02/2018 -- так не есть гут... // FInterfaces.Clear; // делать нужно так, чтобы правильно освободить связи портов с интерфейсами for i := FInterfaces.Count - 1 downto 0 do begin currInterface := FInterfaces[i]; if currInterface.IsPort = biFalse then if currInterface.FPortOwner <> nil then begin FInterfaces.Remove(currInterface); currInterface.Free; end; end; FInterfaces.Clear; // case FQueryMode of qmPhisical: begin if ALoadSQL then begin if AIDInterface = -1 then strWhere := ' ID_COMPONENT = :'+fnIDCOmponent else strWhere := ' ID = :'+fnID; SetSQLToFIBQuery(FQSelect, ' SELECT * FROM INTERFACE_RELATION '+ ' WHERE '+strWhere +' order by id_interface '); end; FQSelect.Close; if AIDInterface = -1 then FQSelect.ParamByName(fnIDComponent).AsInteger := FID else FQSelect.ParamByName(fnID).AsInteger := AIDInterface; FQSelect.ExecQuery; while not FQSelect.Eof do begin //GetMem(Interf, SizeOf(TInterface)); Interf := TSCSInterface.Create(FActiveForm); Interf.ComponentOwner := Self; Interf.LoadFromQuery(FQSelect); Interf.IsLineCompon := IsLine; Interfaces.Add(Interf); FQSelect.Next; end; FQSelect.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin { if SetFilterToSQLMemTable(tSQL_InterfaceRelation, strWhere) then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin //Interf := GetInterfRelFromMemTable; Interf := TSCSInterface.Create(FActiveForm); Interf.LoadFromMemTable; Interf.ComponentOwner := Self; Interf.IsLineCompon := ISLine; Interfaces.Add(Interf); tSQL_InterfaceRelation.Next; end; end; } end; end; if ALoadIOfIRel then begin { case FQueryMode of qmPhisical: begin ChangeSQLQuery(FQuery_Select, ' SELECT * FROM INTERFOFINTERF_RELATION '+ ' WHERE ID_INTERF_REL = :interf_id'); for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; FQuery_Select.Close; FQuery_Select.SetParamAsInteger('interf_id', Interf.ID); FQuery_Select.ExecQuery; //Interf^.IOfIRelOut := TList.Create; //Interf^.ConnectedInterfaces := TList.Create; //Interf.IOfIRelIn := TList.Create; while Not FQuery_Select.Eof do begin //New(IOfIRel); GetMem(IOfIRel, SizeOf(TIOfIRel)); IOfIRel.ID := FQuery_Select.GetFNAsInteger('ID'); IOfIRel.IDInterfRel := FQuery_Select.GetFNAsInteger('ID_INTERF_REL'); IOfIRel.IDInterfTo := FQuery_Select.GetFNAsInteger('ID_INTERF_TO'); IOfIRel.IDCompRel := FQuery_Select.GetFNAsInteger('ID_COMP_REL'); IOfIRel.InterfaceTo := nil; IOfIRel.NewID := 0; IOfIRel.NewIDInterfRel := 0; IOfIRel.NewIDInterfTo := 0; //IOfIRel. //IOfIRel.Position := FQuery.FN('Position').AsInteger; //IOfIRel.ID_CON_COMPL := FQuery.FN('ID_CON_COMPL').AsInteger; //IOfIRel.ID_CON_COMPON := FQuery.FN('ID_CON_COMPON').AsInteger; //IOfIRel.ID_CON_IOFI := FQuery.FN('ID_CON_IOFI').AsInteger; //IOfIRel.Con_Position := FQuery.FN('Con_Position').AsInteger; //IOfIRel.IsBusy := FQuery.FN('IsBusy').AsInteger; Interf.IOfIRelOut.Add(IOfIRel); FQuery_Select.Next; end; end; end; qmMemory: with TF_Main(ActiveForm).DM do for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, 'id_interf_rel = '''+IntTostr(Interf.ID)+'''') then begin tSQL_InterfOfInterfRelation.First; //Interf^.IOfIRelOut := TList.Create; //Interf^.ConnectedInterfaces := TList.Create; //Interf.IOfIRelIn := TList.Create; while Not tSQL_InterfOfInterfRelation.Eof do begin //GetMem(IOfIRel, Sizeof(TIOfIRel)); //IOfIRel.ID := tSQL_InterfOfInterfRelation.FieldByName('ID').AsInteger; //IOfIRel.IDInterfRel := tSQL_InterfOfInterfRelation.FieldByName('ID_INTERF_REL').AsInteger; //IOfIRel.IDInterfTo := tSQL_InterfOfInterfRelation.FieldByName('ID_INTERF_TO').AsInteger; //IOfIRel.IDCompRel := tSQL_InterfOfInterfRelation.FieldByName('ID_COMP_REL').AsInteger; //IOfIRel.InterfaceTo := nil; //IOfIRel.NewID := 0; //IOfIRel.NewIDInterfRel := 0; //IOfIRel.NewIDInterfTo := 0; IOfIRel := GetIOfIRelFromMemTable; Interf.IOfIRelOut.Add(IOfIRel); tSQL_InterfOfInterfRelation.Next; end; end; end; end; } if Not (cdIOfIRels in ServDisabledLoadDataElements) then begin WasLoad := false; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if CheckCanLoadInterfIOfIRelsFromBase(Interf) then begin Interf.LoadIOfIRels(WasLoad=false); WasLoad := true; end; end; end; WasLoad := false; PortNumber := 0; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; //if Interf.IsPort = biTrue then // Inc(PortNumber); //Interf.LoadPortInterfaces(PortNumber=1); if Interf.ID = 560770 then EmptyProcedure; if CheckCanLoadInterfInternalConnectionsFromBase(Interf) then begin Interf.LoadPortInterfaces(WasLoad=false); WasLoad := true; end; end; SetPortInterfRelInterfaces; end; Spravochnik := TF_Main(FActiveForm).GetSpravochnik; if Spravochnik <> nil then begin for i := 0 to FInterfaces.Count - 1 do begin Interf := TSCSInterface(FInterfaces.List.List^[i]); SprInterf := Spravochnik.GetInterfaceByID(Interf.ID_Interface); if SprInterf <> nil then begin Interf.GUIDInterface := SprInterf.GUID; Interf.Name := SprInterf.Name; end; end; end; end; procedure TSCSComponent.LoadInterfacesByFi(AFieldIndexses: TIntSet); var Interf: TSCSInterface; FieldList: TStringList; begin { try case FQueryMode of qmPhisical: begin FieldList := TStringList.Create; try if fiAll in AFieldIndexses then FieldList.Add(fnAll) else begin if fiID in AFieldIndexses then FieldList.Add(fnID); //if fiIDComponent in AFieldIndexses then // FieldList.Add(fnIDComponent); if fiIDInterface in AFieldIndexses then FieldList.Add(fnIDInterface); if fiTypeI in AFieldIndexses then FieldList.Add(fnTypeI); if fiKind in AFieldIndexses then FieldList.Add(fnKind); if fiIsPort in AFieldIndexses then FieldList.Add(fnIsPort); if fiIsUserPort in AFieldIndexses then FieldList.Add(fnIsUserPort); if fiNppPort in AFieldIndexses then FieldList.Add(fnNppPort); if fiIDConnected in AFieldIndexses then FieldList.Add(fnIDConnected); if fiGender in AFieldIndexses then FieldList.Add(fnGender); if fiMultiple in AFieldIndexses then FieldList.Add(fnMultiple); if fiIsBusy in AFieldIndexses then FieldList.Add(fnIsBusy); if fiValueI in AFieldIndexses then FieldList.Add(fnValueI); if fiCoordZ in AFieldIndexses then FieldList.Add(fnCoordZ); if fiSortID in AFieldIndexses then FieldList.Add(fnSortID); if fiNumPair in AFieldIndexses then FieldList.Add(fnNumPair); if fiColor in AFieldIndexses then FieldList.Add(fnColor); if fiIDAdverse in AFieldIndexses then FieldList.Add(fnIDAdverse); if fiSide in AFieldIndexses then FieldList.Add(fnSide); end; SQLBuilder(FQuery_Select, qtSelect, tnInterfaceRelation, 'id_component = '''+IntTostr(ID)+'''', FieldList, true); with FQuery_Select do while not Eof do begin //New(Interf); //GetMem(Interf, SizeOf(TInterface)); Interf := TSCSInterface.Create(FActiveForm); if (fiID in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.ID := GetFNAsInteger('ID'); if (fiIDInterface in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.ID_Interface := GetFNAsInteger('ID_Interface'); //if (fiIDComponent in AFieldIndexses) or (fiAll in AFieldIndexses) then //Interf.ID_Component := FN('ID_Component').AsInteger; Interf.ID_Component := ID; Interf.IsLineCompon := IsLine; if (fiTypeI in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.TypeI := GetFNAsInteger('TypeI'); if (fiKind in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.Kind := GetFNAsInteger('Kind'); if (fiIsPort in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.IsPort := GetFNAsInteger('IsPort'); if (fiIsUserPort in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.IsUserPort := GetFNAsInteger('IsUser_Port'); if (fiNppPort in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.NppPort := GetFNAsInteger('Npp_Port'); if (fiIsBusy in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.IsBusy := GetFNAsInteger('isBusy'); if (fiGender in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.Gender := GetFNAsInteger('GENDER'); if (fiMultiple in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.Multiple := GetFNAsInteger('Multiple'); if (fiValueI in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.ValueI := GetFNAsFloat('ValueI'); if (fiNumPair in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.NumPair := GetFNAsInteger('Num_Pair'); if (fiColor in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.Color := GetFNAsInteger('Color'); if (fiIDAdverse in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.IDAdverse := GetFNAsInteger('ID_Adverse'); if (fiSide in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.Side := GetFNAsInteger('Side'); //Interf.IOfIRelOut := nil; //Interf.ParallelInterface := nil; //Interf.ConnectedInterfaces := nil; //*** Z- координата интерфейса if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLine = biFalse then if (fiIDConnected in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.IDConnected := GetFNAsInteger('id_Connected'); if (fiCoordZ in AFieldIndexses) or (fiAll in AFieldIndexses) then Interf.CoordZ := GetFNAsFloat('CoordZ'); end else begin Interf.IDConnected := 0; Interf.CoordZ := 0; end; Interfaces.Add(Interf); Next; end; finally FreeAndNil(FieldList); end; end; qmMemory: LoadInterfaces(-1, false); end; except on E: Exception do AddExceptionToLog('TSCSComponent.LoadInterfacesByFi: '+E.Message); end;} end; // ##### Загрузить Свойства ##### procedure TSCSComponent.LoadProperties; begin inherited LoadProperties(ID); end; function TSCSComponent.SaveData(AMakeEdit: TMakeEdit; ACopiing: Boolean): Integer; Var FieldList: TStringlist; ResourceRel: TSCSResourceRel; SCSNorms: TSCSNormsResources; begin Result := 0; try if (AMakeEdit = meMake) and ACopiing and (TF_Main(FActiveForm).GDBMode = bkNormBase) then Cypher := TF_Main(FActiveForm).FNormBase.DM.GenComponentNewCypher; //GenNewComponentCypher; case FQueryMode of qmPhisical: begin FieldList := TStringList.Create; try Result := 0; FieldList.Add('Name'); FieldList.Add('Name_Short'); FieldList.Add(fnMarkStr); FieldList.Add(fnCypher); FieldList.Add('Izm'); FieldList.Add(fnDescription); FieldList.Add(fnNotice); FieldList.Add('Picture'); FieldList.Add('Color'); FieldList.Add('IsLine'); FieldList.Add('ISComplect'); FieldList.Add(fnIsMarkInCaptions); FieldList.Add(fnPriceSupply); FieldList.Add(fnPrice); FieldList.Add('PRICE_CALC'); FieldList.Add('USER_LENGTH'); FieldList.Add('Max_Length'); FieldList.Add('HASNDS'); FieldList.Add('ARTICUL_DISTRIBUTOR'); FieldList.Add('ARTICUL_PRODUCER'); FieldList.Add('ID_COMPONENT_TYPE'); FieldList.Add(fnIDSymbol); FieldList.Add('ID_OBJECT_ICON'); FieldList.Add(fnObjectIconStep); FieldList.Add('ID_PRODUCER'); FieldList.Add('ID_CURRENCY'); FieldList.Add(fnIDSuppliesKind); FieldList.Add(fnIDSupplier); FieldList.Add(fnIDNetType); FieldList.Add(fnIDCompSpecification); FieldList.Add('SORT_ID'); FieldList.Add('KOL_COMPLECT'); FieldList.Add(fnIsTemplate); if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin FieldList.Add('ID_NormBase'); FieldList.Add('Object_ID'); FieldList.Add('List_ID'); //FieldList.Add('Project_ID'); FieldList.Add('Name_Mark'); FieldList.Add('Mark_ID'); FieldList.Add('IsUser_Mark'); if (IsLine = biTrue) and (AMakeEdit = meMake) then begin Whole_ID := GenNewComponentWholeID; FieldList.Add('Whole_ID'); end; //20.08.2007 CoordZ := 0; end; if GuidNB <> '' then FieldList.Add(fnGuid); case AMakeEdit of meMake: SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnComponent, '', FieldList, ''), false); meEdit: begin SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnComponent, 'id = :id', FieldList, ''), false); FQOperat.ParamByName(fnID).AsInteger := ID; end; end; FQOperat.ParamByName(fnName).AsString := NAME; FQOperat.ParamByName(fnNameShort).AsString := NameShort; FQOperat.ParamByName(fnMarkStr).AsString := MarkStr; FQOperat.ParamByName(fnCypher).AsString := Cypher; FQOperat.ParamByName(fnIzm).AsString := Izm; FQOperat.ParamByName(fnNotice).AsString := Notice; SetParamAsStreamToQuery(FQOperat, fnDescription, Description); SetParamAsStreamToQuery(FQOperat, fnPicture, Picture); FQOperat.ParamByName(fnColor).AsInteger := Color; FQOperat.ParamByName(fnIsLine).AsInteger := IsLine; FQOperat.ParamByName(fnISComplect).AsInteger := ISComplect; FQOperat.ParamByName(fnPriceSupply).AsFloat := PriceSupply; FQOperat.ParamByName(fnPrice).AsFloat := PRICE; FQOperat.ParamByName(fnPriceCalc).AsFloat := PRICE_CALC; FQOperat.ParamByName(fnUserLength).AsFloat := UserLength; FQOperat.ParamByName(fnMaxLength).AsFloat := MaxLength; FQOperat.ParamByName(fnHasNDS).AsInteger := HASNDS; FQOperat.ParamByName(fnArticulDistributor).AsString := ArticulDistributor; FQOperat.ParamByName(fnArticulProducer).AsString := ArticulProducer; FQOperat.ParamByName(fnIsMarkInCaptions).AsInteger := IsMarkInCaptions; FQOperat.ParamByName(fnObjectIconStep).AsFloat := ObjectIconStep; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDComponentType, ID_ComponentType); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDSymbol, IDSymbol); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDObjectIcon, IDObjectIcon); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDPRODUCER, ID_Producer); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCURRENCY, ID_CURRENCY); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDSuppliesKind, IDSuppliesKind); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDSupplier, ID_SUPPLIER); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDNetType, IDNetType); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCompSpecification, IDCompSpecification); FQOperat.ParamByName(fnSortID).AsInteger := SortID; FQOperat.ParamByName(fnKolComplect).AsInteger := KolComplect; FQOperat.ParamByName(fnIsTemplate).AsInteger := IsTemplate; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin FQOperat.ParamByName(fnIDNormBase).AsInteger := IDNormBase; FQOperat.ParamByName(fnObjectID).AsInteger := ObjectID; FQOperat.ParamByName(fnListID).AsInteger := ListID; //FQuery_Operat.SetParamAsInteger('Project_ID', ProjectID); FQOperat.ParamByName(fnNameMark).AsString := NameMark; FQOperat.ParamByName(fnMarkID).AsInteger := MarkID; FQOperat.ParamByName(fnIsUserMark).AsInteger := IsUserMark; if (IsLine = biTrue) and (AMakeEdit = meMake) then FQOperat.ParamByName(fnWholeID).AsInteger := Whole_ID; end; if GuidNB <> '' then FQOperat.ParamByName(fnGuid).AsString := GuidNB; //SetSQLToQuery(FQuery_Operat, ' insert into component (name) values(''111'') '); FQOperat.ExecQuery; FQOperat.Close; finally FreeAndNil(FieldList); end; end; qmMemory: begin if (IsLine = biTrue) and (AMakeEdit = meMake) then Whole_ID := GenCurrProjTableID(giComponentWholeID); //GenNewComponentWholeID; {case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnGuidNB).AsString := GuidNB; end; meEdit: begin if SetFilterToSQLMemTable(FMemTable, 'id = '''+IntToStr(ID)+'''') then FMemTable.Edit; end; end; if FMemTable.State = dsBrowse then Exit; ///// EXIT ///// FMemTable.FieldByName('Name').AsString := NAME; FMemTable.FieldByName('Name_Short').AsString := NameShort; FMemTable.FieldByName(fnMarkStr).AsString := MarkStr; FMemTable.FieldByName(fnCypher).AsString := Cypher; FMemTable.FieldByName('Izm').AsString := Izm; FMemTable.FieldByName(fnNotice).AsString := Notice; TBlobField(FMemTable.FieldByName('Picture')).LoadFromStream(Picture); FMemTable.FieldByName('color').AsInteger := Color; FMemTable.FieldByName('IsLine').AsInteger := IsLine; FMemTable.FieldByName('ISComplect').AsInteger := ISComplect; FMemTable.FieldByName('PRICE').AsFloat := PRICE; FMemTable.FieldByName('PRICE_CALC').AsFloat := PRICE_CALC; FMemTable.FieldByName('USER_LENGTH').AsFloat := UserLength; FMemTable.FieldByName('MAX_LENGTH').AsFloat := MaxLength; FMemTable.FieldByName('HASNDS').AsInteger := HASNDS; FMemTable.FieldByName('ARTICUL_DISTRIBUTOR').AsString := ArticulDistributor; FMemTable.FieldByName('ARTICUL_PRODUCER').AsString := ArticulProducer; FMemTable.FieldByName('ID_COMPONENT_TYPE').AsInteger := ID_ComponentType; FMemTable.FieldByName(fnIDSymbol).AsInteger := IDSymbol; FMemTable.FieldByName('ID_OBJECT_ICON').AsInteger := IDObjectIcon; FMemTable.FieldByName(fnObjectIconStep).AsFloat := ObjectIconStep; FMemTable.FieldByName('ID_PRODUCER').AsInteger := ID_Producer; FMemTable.FieldByName('ID_CURRENCY').AsInteger := ID_CURRENCY; FMemTable.FieldByName('ID_SUPPLIER').AsInteger := ID_SUPPLIER; FMemTable.FieldByName('ID_NET_TYPE').AsInteger := IDNetType; FMemTable.FieldByName('SORT_ID').AsInteger := SortID; FMemTable.FieldByName('KOL_COMPLECT').AsInteger := KolComplect; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin FMemTable.FieldByName('ID_NormBase').AsInteger := IDNormBase; FMemTable.FieldByName('Object_ID').AsInteger := ObjectID; FMemTable.FieldByName('List_ID').AsInteger := ListID; //FMemTable.FieldByName('Project_ID').AsInteger := ProjectID; FMemTable.FieldByName('Name_Mark').AsString := NameMark; FMemTable.FieldByName('Mark_ID').AsInteger := MarkID; FMemTable.FieldByName('IsUser_Mark').AsInteger := IsUserMark; if (IsLine = biTrue) and (AMakeEdit = meMake) then FMemTable.FieldByName('WHOLE_ID').AsInteger := Whole_ID; FMemTable.FieldByName(fnGuidComponentType).AsString := GUIDComponentType; FMemTable.FieldByName(fnGuidSymbol).AsString := GUIDSymbol; FMemTable.FieldByName(fnGuidObjectIcon).AsString := GUIDObjectIcon; FMemTable.FieldByName(fnGuidProducer).AsString := GUIDProducer; FMemTable.FieldByName(fnGuidSupplier).AsString := GUIDSupplier; FMemTable.FieldByName(fnGuidNetType).AsString := GUIDNetType; end; FMemTable.Post;} end; end; //QueryOptionToSelect; case AMakeEdit of meMake: begin case FQueryMode of qmPhisical: begin NewID := GenIDFromTable(FQSelect, gnComponentID, 0); //SetSQLToQuery(FQuery_Select, ' select MAX(ID) As max_id from component '); //NewID := FQuery_Select.GetFNAsInteger('max_id'); //FQuery_Select.Close; end; qmMemory: //NewID := FMemTable.FieldByName(fnID).AsInteger; NewID := GenCurrProjTableID(giComponentID); end; Result := NewID; { if Not ACopiing then begin //*** Создать норму для этой компоненты ResourceRel := TSCSResourceRel.Create(ActiveForm, ntProj); ResourceRel.TableKind := ctkComponent; if IDNormBase <> 0 then ResourceRel.IDNB := IDNormBase else ResourceRel.IDNB := NewID; ResourceRel.TableKindNB := ctkComponent; ResourceRel.NPP := 1; ResourceRel.IsOn := biTrue; ResourceRel.Name := Name; if IsLine = biTrue then ResourceRel.Izm := 'м'; ResourceRel.Price := Price; ResourceRel.Cost := Price; ResourceRel.Kolvo := 1; ResourceRel.SaveResourceAsNew(NewID); NormsResources.Resources.Add(ResourceRel); //FreeAndNil(ResourceRel); end else if NormsResources.Resources.Count > 0 then begin ResourceRel := NormsResources.Resources[0]; ResourceRel.Name := Name; ResourceRel.Price := PRICE; ResourceRel.CalcCost; //ResourceRel.UpdateResource; end; } end; meEdit: begin { if NormsResources.Resources.Count = 0 then NormsResources.LoadResources(false); if NormsResources.Resources.Count > 0 then begin ResourceRel := NormsResources.Resources[0]; ResourceRel.Name := Name; ResourceRel.Price := PRICE; ResourceRel.CalcCost; ResourceRel.UpdateResource; end; } {SCSNorms := TSCSNormsResources.Create(ActiveForm, ctkComponent); SCSNorms.IDMaster := ID; SCSNorms.LoadNorms(false, false); if SCSNorms.Norms.Count > 0 then begin SCSNorm := SCSNorms.Norms[0]; SCSNorm.Name := Name; SCSNorm.UpdateNorm; end; SCSNorms.Free; } Result := ID; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.SaveData: '+E.Message); end; end; procedure TSCSComponent.SaveCableCanalConnector(AMakeEdit: TMakeEdit; ACableCanalConnector: PCableCanalConnector); var i: Integer; //ptrCableCanalConnector: PCableCanalConnector; FieldList: TStringList; begin if ACableCanalConnector <> nil then case FQueryMode of qmPhisical: begin FieldList := TStringList.Create; FieldList.Add(fnIDComponent); FieldList.Add(fnIDNBConnector); FieldList.Add(fnConnectorType); case AMakeEdit of meMake: SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnCableCanalConnectors, '', FieldList, ''), false); meEdit: begin SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCableCanalConnectors, 'id = :id', FieldList, ''), false); FQOperat.ParamByName(fnID).AsInteger := ACableCanalConnector.ID; end; end; //ChangeSQLQuery(FQuery_Select, 'select max(ID) from '+tnCableCanalConnectors); FQOperat.ParamByName(fnIDComponent).AsInteger := ACableCanalConnector.IDCableCanal; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDNBConnector, ACableCanalConnector.IDNBConnector); FQOperat.ParamByName(fnConnectorType).AsInteger := ACableCanalConnector.ConnectorType; FQOperat.ExecQuery; //FQuery_Select.ExecQuery; if AMakeEdit = meMake then begin ACableCanalConnector.NewID := GenIDFromTable(FQSelect, gnCableCanalConnectorsID, 0); //FQuery_Select.GetFNAsInteger(fnMax); ACableCanalConnector.ID := ACableCanalConnector.NewID; end; FreeAndNil(FieldList); end; qmMemory: with TF_Main(FActiveForm).DM do begin {case AMakeEdit of meMake: tSQL_CableCanalConnectors.Append; 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.Post; end; if AMakeEdit = meMake then begin ACableCanalConnector.NewID := tSQL_CableCanalConnectors.FieldByName(fnID).AsInteger; ACableCanalConnector.ID := ACableCanalConnector.NewID; end; } if AMakeEdit = meMake then begin ACableCanalConnector.NewID := GenCurrProjTableID(giCableCanalConnectorsID); ACableCanalConnector.ID := ACableCanalConnector.NewID; end; end; end; end; procedure TSCSComponent.SaveCompRels(AID_Component: Integer; ACompRelType: Integer); var CompRels: TList; CompRel: PComplect; Interf: TSCSInterface; //IOfIRel: TSCSIOfIRel; i, j, k, NewSortID: Integer; Fields: TStringList; //FieldNames: TStringList; begin try CompRels := nil; case ACompRelType of cntComplect: CompRels := FComplects; cntUnion: CompRels := FConnections; end; if CompRels <> nil then begin case FQueryMode of qmPhisical: begin NewSortID := 0; //FieldNames := TStringList.Create; //FieldNames.Add(fnIDComponent); //FieldNames.Add(fnIDChild); //FieldNames.Add(fnKolvo); //FieldNames.Add(fnIDTopCompon); //FieldNames.Add(fnIDParentCompRel); //FieldNames.Add(fnConnectType); //FieldNames.Add(fnSortID); if ACompRelType = cntComplect then NewSortID := GenNewCompRelSortID(FActiveForm, AID_Component); //setSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnComponentRelation, '', FieldNames, ''), false); setSQLToFIBQuery(FQOperat, GetSQLForInsertCompRel, false); For i:=0 to CompRels.Count - 1 do begin CompRel := CompRels.Items[i]; if CompRel.ConnectType = ACompRelType then begin CompRel.ID_NewComponent := AID_Component; FQOperat.Close; FQOperat.ParamByName(fnIDComponent).AsInteger := AID_Component; FQOperat.ParamByName(fnIDChild).AsInteger := CompRel.ID_Child; FQOperat.ParamByName(fnKolvo).AsInteger := CompRel.Kolvo; FQOperat.ParamByName(fnIDTopCompon).AsInteger := CompRel.IDTopComponent; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDParentCompRel, CompRel.IDParentCompRel); FQOperat.ParamByName(fnKolSubComplect).AsInteger := CompRel.KolSubComplect; FQOperat.ParamByName(fnConnectType).AsInteger := CompRel.ConnectType; FQOperat.ParamByName(fnSortID).AsInteger := NewSortID; FQOperat.ExecQuery; FQOperat.Close; if ACompRelType = cntComplect then begin CompRel.SortID := NewSortID; Inc(NewSortID); end; //*** Определить новый ID CompRel.NewID := GenIDFromTable(FQSelect, gnComponentRelationID, 0); CompRel.ID := CompRel.NewID; end; end; FQOperat.Close; FQSelect.Close; {ChangeSQLQuery(FQuery_Operat, ' insert into component_relation(id_component, id_child, kolvo, connect_type, sort_id) '+ ' values(:id_component, :id_child, :kolvo, :connect_type, :sort_id) '); ChangeSQLQuery(FQuery_Select, ' select MAX(ID) As max_id from component_relation '); For i:=0 to CompRels.Count - 1 do begin CompRel := CompRels.Items[i]; if CompRel.ConnectType = ACompRelType then begin CompRel.ID_NewComponent := AID_Component; FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger('id_component', AID_Component); FQuery_Operat.SetParamAsInteger('id_child', CompRel.ID_Child); FQuery_Operat.SetParamAsInteger('kolvo', CompRel.Kolvo); FQuery_Operat.SetParamAsInteger('connect_type', CompRel.ConnectType); FQuery_Operat.SetParamAsInteger('sort_id', NewSortID); FQuery_Operat.ExecQuery; FQuery_Operat.Close; if ACompRelType = cntComplect then begin CompRel.SortID := NewSortID; Inc(NewSortID); end; //*** Определить новый ID //SetSQLToQuery(FQuery_Select, ' select MAX(ID) from component_relation '); FQuery_Select.Close; FQuery_Select.ExecQuery; CompRel.NewID := FQuery_Select.GetFNAsInteger('max_id'); CompRel.ID := CompRel.NewID; end; end; FQuery_Operat.Close; FQuery_Select.Close;} //FreeAndNil(FieldNames); end; qmMemory: begin NewSortID := 0; if ACompRelType = cntComplect then NewSortID := GenCompRelSortID; with TF_Main(ActiveForm).DM do For i:=0 to CompRels.Count - 1 do begin CompRel := CompRels.Items[i]; if CompRel.ConnectType = ACompRelType then begin {tSQL_ComponentRelation.Append; tSQL_ComponentRelation.FieldByName('id_component').AsInteger := AID_Component; tSQL_ComponentRelation.FieldByName('id_child').AsInteger := Complect.ID_Child; tSQL_ComponentRelation.FieldByName('kolvo').AsInteger := Complect.Kolvo; tSQL_ComponentRelation.FieldByName('connect_type').AsInteger := Complect.ConnectType; tSQL_ComponentRelation.FieldByName('sort_id').AsInteger := NewSortID; tSQL_ComponentRelation.Post; } if ACompRelType = cntComplect then begin CompRel.SortID := NewSortID; Inc(NewSortID); end; //Complect.NewID := tSQL_ComponentRelation.FieldByName(fnID).AsInteger; //Complect.ID := Complect.NewID; CompRel.NewID := GenCurrProjTableID(giComponentRelationID); CompRel.ID := CompRel.NewID; end; end; end; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.SaveCompRels: '+E.Message); end; end; // ##### Сохранить компоненту ##### function TSCSComponent.SaveComponentAsNew(ASaveCompl, ACopiing: Boolean): Integer; begin Result := 0; NewID := SaveData(meMake, ACopiing); OldID := ID; ID := NewID; Result := NewID; if ASaveCompl = true then begin SaveComplects(NewID); SaveInterfaces(NewID); if TF_Main(FActiveForm).GDBMode = bkNormBase then SaveCrossConnectionsAsNew; end; SaveProperties(NewID); SaveCableCanalConnectors(NewID); //SaveComponIcons(NewID); //NormsResources.ActiveForm := ActiveForm; NormsResources.SaveNormsAsNew(NewID); NormsResources.SaveResourcesAsNew(NewID); //SaveNorms(NewID); end; procedure TSCSComponent.SaveComponent; begin SaveData(meEdit, false); end; procedure TSCSComponent.SaveComplects(AID_Component: Integer); begin SaveCompRels(AID_Component, cntComplect); end; procedure TSCSComponent.SaveConnections(AID_Component: Integer); begin SaveCompRels(AID_Component, cntUnion); end; procedure TSCSComponent.SaveCableCanalConnectors(AID_Component: Integer); var i: Integer; ptrCableCanalConnector: PCableCanalConnector; //FieldList: TStringList; begin if ComponentType.SysName = ctsnCableChannel then for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; ptrCableCanalConnector.IDCableCanal := AID_Component; SaveCableCanalConnector(meMake, ptrCableCanalConnector); end; {if ID_ComponentType = ctCableCanal then case FQueryMode of qmPhisical: begin FieldList := TStringList.Create; FieldList.Add(fnIDComponent); FieldList.Add(fnIDNBConnector); FieldList.Add(fnConnectorType); SQLBuilder(FQuery_Operat, qtInsert, tnCableCanalConnectors, '', FieldList, false); ChangeSQLQuery(FQuery_Select, 'select max(ID) from '+tnCableCanalConnectors); for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger(fnIDComponent, AID_Component); FQuery_Operat.SetParamAsInteger(fnIDNBConnector, ptrCableCanalConnector.IDNBConnector); FQuery_Operat.SetParamAsInteger(fnConnectorType, ptrCableCanalConnector.ConnectorType); FQuery_Operat.ExecQuery; FQuery_Select.ExecQuery; ptrCableCanalConnector.NewID := FQuery_Select.GetFNAsInteger(fnMax); ptrCableCanalConnector.ID := ptrCableCanalConnector.NewID; end; FreeAndNil(FieldList); end; qmMemory: with TF_Main(FActiveForm).DM do for i := 0 to FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := FCableCanalConnector[i]; tSQL_CableCanalConnectors.Append; tSQL_CableCanalConnectors.FieldByName(fnIDComponent).AsInteger := AID_Component; tSQL_CableCanalConnectors.FieldByName(fnIDNBConnector).AsInteger := ptrCableCanalConnector.IDNBConnector; tSQL_CableCanalConnectors.FieldByName(fnConnectorType).AsInteger := ptrCableCanalConnector.ConnectorType; tSQL_CableCanalConnectors.Post; ptrCableCanalConnector.NewID := tSQL_CableCanalConnectors.FieldByName(fnID).AsInteger; ptrCableCanalConnector.ID := ptrCableCanalConnector.NewID; end; end; } end; procedure TSCSComponent.SaveCrossConnectionsAsNew; var i: Integer; ptrCrossConnection: TSCSCrossConnection; begin for i := 0 to FCrossConnections.Count - 1 do begin ptrCrossConnection := TSCSCrossConnection(FCrossConnections[i]); //ptrCrossConnection.Save(meMake, false); //TF_Main(FActiveForm).DM.InsertUpdateCrossConnection(meMake, ptrCrossConnection); ptrCrossConnection.Save(meMake, true); end; end; procedure TSCSComponent.SaveInterfaces(AID_Component: Integer; AAutoIDComplRel: Boolean = true); var Interf: TSCSInterface; //IOfIRel: TSCSIOfIRel; IOfIRelList: TList; Connection: PComplect; i, j, k: Integer; NewIDAdverse, NewComplID : Integer; InterfFields: TStringList; function GetNewCompRelID(AOLD_ID: Integer): Integer; var k: Integer; LCount: Integer; Compl: PComplect; begin Result := AOLD_ID; LCount := Complects.Count; for k := 0 to LCount - 1 do begin Compl := Complects.Items[k]; if Compl.ID = AOld_ID then begin Result := Compl.NewID; Break; end; end; end; function GetNewIDByOld(AOldID: Integer): Integer; var i: Integer; ptrInterf: TSCSInterface; begin Result := 0; for i := 0 to Interfaces.Count - 1 do begin ptrInterf := Interfaces.Items[i]; if ptrInterf.ID = AOldID then begin Result := ptrInterf.NewID; Exit; ///// EXIT //// end; end; end; begin try //*** Чистка интерфейсов, которые принимали участвие в соединених //if Connections.Count = 0 then // LoadConections; //*** Звязь интерфейсов(функциональных) на соединении с не внутренними for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.TypeI = itFunctional then if Interf.IsBusy = biTrue then begin { //Interf.IsBusy := biFalse; if Assigned(Interf.IOfIRelOut) then begin for j := 0 to Interf.IOfIRelOut.Count - 1 do begin FreeMem(Interf.IOfIRelOut[j]); Interf.IOfIRelOut[j] := nil; end; Interf.IOfIRelOut.Pack; end; } if (Interf.ConnectedInterfaces.Count = 0) and (Interf.IOfIRelOut.Count = 0) then Interf.IsBusy := biFalse; end; end; //*** Сохранить только интерфейсы for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; Interf.ID_Component := AID_Component; Interf.ID_NewComponent := AID_Component; Interf.SaveAsNew; end; // //*** противоположный интерфейс в НБ настроить после создания, т.к. есть связь ключей if IsLine = biTrue then with TF_Main(FActiveForm) do if GDBMode = bkNormBase then for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IDAdverse <> 0 then DM.UpdateInterfFieldAsInteger(interf.NewID, Interf.IDAdverse, fnIDAdverse); end; //*** СВЯЗИ С ИНТЕРФЕЙСАМИ for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; //*** Интерфейсы с интерфейсами Interf.SaveIOfIRels(meMake); //*** Порты с интерфейсами Interf.SavePortInterfRels(meMake); end; {for i := 0 to Connections.Count - 1 do begin Connection := Connections[i]; IOfIRelList := TF_Main(ActiveForm).DM.GetIOfIRelByFieldValue(fnIDCompRel, Connection.ID); for j := 0 to IOfIRelList.Count - 1 do begin IOfIRel := IOfIRelList[j]; for k := 0 to Interfaces.Count - 1 do begin Interf := Interfaces[k]; if (Interf.ID = IOfIRel.IDInterfRel) or (Interf.ID = IOfIRel.IDInterfTo) then begin Interf.IsBusy := biFalse; Interf.IDConnected := 0; end; end; FQuery_Select.Next; end; FreeList(IOfIRelList); end; // Конец очистки FQuery_Select.Close; } { //*** Звязь интерфейсов на соединении ChangeSQLQuery(FQuery_Select, ' select id_interf_rel, id_interf_to from interfofinterf_relation where id_comp_rel = :id_comp_rel '); for i := 0 to Connections.Count - 1 do begin Connection := Connections[i]; FQuery_Select.Close; FQuery_Select.SetParamAsInteger('id_comp_rel', Connection.ID); FQuery_Select.ExecQuery; while Not FQuery_Select.Eof do begin for j := 0 to Interfaces.Count - 1 do begin Interf := Interfaces[j]; if (Interf.ID = FQuery_Select.GetFNAsInteger('id_interf_rel')) or (Interf.ID = FQuery_Select.GetFNAsInteger('id_interf_to')) then begin Interf.IsBusy := biFalse; Interf.IDConnected := 0; end; end; FQuery_Select.Next; end; end; // Конец очистки FQuery_Select.Close; } { case FQueryMode of qmPhisical: begin InterfFields := TStringList.Create; try InterfFields.Add('ID_Component'); InterfFields.Add('ID_Interface'); InterfFields.Add(fnNpp); InterfFields.Add('TypeI'); InterfFields.Add('Kind'); InterfFields.Add('Gender'); InterfFields.Add('Multiple'); InterfFields.Add('isBusy'); InterfFields.Add('Color'); InterfFields.Add('ValueI'); InterfFields.Add(fnNotice); if IsLine = biTrue then begin InterfFields.Add('Num_Pair'); //InterfFields.Add('ID_Adverse'); InterfFields.Add('Side'); end else begin InterfFields.Add('IsPort'); InterfFields.Add('IsUser_Port'); InterfFields.Add('Npp_Port'); end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLine = biFalse then InterfFields.Add('ID_Connected'); InterfFields.Add('CoordZ'); end; SQLBuilder(FQuery_Operat, qtInsert, 'interface_relation', '', InterfFields, false); ChangeSQLQuery(FQuery_Select, ' select MAX(ID) As max_id from interface_relation '); //*** Сохранение интерфейсов For i:= 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; Interf.ID_NewComponent := AID_Component; FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger('ID_Component', AID_Component); FQuery_Operat.SetParamAsInteger('ID_Interface', Interf.ID_Interface); FQuery_Operat.SetParamAsInteger(fnNpp, Interf.Npp); FQuery_Operat.SetParamAsInteger('TypeI', Interf.TypeI); FQuery_Operat.SetParamAsInteger('Kind', Interf.Kind); FQuery_Operat.SetParamAsInteger('Gender', Interf.Gender); FQuery_Operat.SetParamAsInteger('Multiple', Interf.Multiple); FQuery_Operat.SetParamAsInteger('isBusy', Interf.IsBusy); FQuery_Operat.SetParamAsInteger('Color', Interf.Color); FQuery_Operat.SetParamAsFloat('ValueI', Interf.ValueI); FQuery_Operat.SetParamAsString(fnNotice, Interf.Notice); if IsLine = biTrue then begin FQuery_Operat.SetParamAsInteger('Num_Pair', Interf.NumPair); //FQuery_Operat.SetParamAsInteger0AsNull('ID_Adverse', Interf.IDAdverse); FQuery_Operat.SetParamAsInteger('Side', Interf.Side); end else begin FQuery_Operat.SetParamAsInteger('IsPort', Interf.IsPort); FQuery_Operat.SetParamAsInteger('IsUser_Port', Interf.IsUserPort); FQuery_Operat.SetParamAsInteger('Npp_Port', Interf.NppPort); end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLine = biFalse then FQuery_Operat.SetParamAsInteger('ID_Connected', Interf.IDConnected); FQuery_Operat.SetParamAsFloat('CoordZ', CoordZ); end; FQuery_Operat.ExecQuery; //*** Определить новый ID FQuery_Select.Close; FQuery_Select.ExecQuery; Interf.NewID := FQuery_Select.GetFNAsInteger('max_id'); Interf.ID := Interf.NewID; end; finally FreeAndNil(InterfFields); end; end; qmMemory: with TF_Main(ActiveForm).DM do For i:= 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; Interf.ID_NewComponent := AID_Component; tSQL_InterfaceRelation.Append; tSQL_InterfaceRelation.FieldByName('ID_Component').AsInteger := AID_Component; tSQL_InterfaceRelation.FieldByName('ID_Interface').AsInteger := Interf.ID_Interface; tSQL_InterfaceRelation.FieldByName(fnNpp).AsInteger := Interf.Npp; tSQL_InterfaceRelation.FieldByName('TypeI').AsInteger := Interf.TypeI; tSQL_InterfaceRelation.FieldByName('Kind').AsInteger := Interf.Kind; tSQL_InterfaceRelation.FieldByName('Gender').AsInteger := Interf.Gender; tSQL_InterfaceRelation.FieldByName('Multiple').AsInteger := Interf.Multiple; tSQL_InterfaceRelation.FieldByName('isBusy').AsInteger := Interf.IsBusy; tSQL_InterfaceRelation.FieldByName('Color').AsInteger := Interf.Color; tSQL_InterfaceRelation.FieldByName('ValueI').AsFloat := Interf.ValueI; tSQL_InterfaceRelation.FieldByName(fnNotice).AsString := Interf.Notice; if IsLine = biTrue then begin tSQL_InterfaceRelation.FieldByName('Num_Pair').AsInteger := Interf.NumPair; tSQL_InterfaceRelation.FieldByName('ID_Adverse').AsInteger := Interf.IDAdverse; tSQL_InterfaceRelation.FieldByName('Side').AsInteger := Interf.Side; end else begin tSQL_InterfaceRelation.FieldByName('IsPort').AsInteger := Interf.IsPort; tSQL_InterfaceRelation.FieldByName('IsUser_Port').AsInteger := Interf.IsUserPort; tSQL_InterfaceRelation.FieldByName('Npp_Port').AsInteger := Interf.NppPort; end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLine = biFalse then tSQL_InterfaceRelation.FieldByName('ID_Connected').AsInteger := Interf.IDConnected; tSQL_InterfaceRelation.FieldByName('CoordZ').AsFloat := CoordZ; end; tSQL_InterfaceRelation.FieldByName(fnGuidInterface).AsString := Interf.GUIDInterface; tSQL_InterfaceRelation.Post; //*** Определить новый ID Interf.NewID := tSQL_InterfaceRelation.FieldByName(fnID).AsInteger; Interf.ID := Interf.NewID; end; end; } { //*** противоположный интерфейс в НБ настроить после создания, т.к. есть связь ключей if IsLine = biTrue then with TF_Main(FActiveForm) do if GDBMode = bkNormBase then for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IDAdverse <> 0 then DM.UpdateInterfFieldAsInteger(interf.NewID, Interf.IDAdverse, fnIDAdverse); end; } { //*** Сохранить связи интерфейсов case FQueryMode of qmPhisical: begin ChangeSQLQuery(FQuery_Operat, ' insert into interfofinterf_relation(id_interf_rel, id_interf_to, id_comp_rel) '+ ' values(:id_interf_rel, :id_interf_to, :id_comp_rel) '); ChangeSQLQuery(FQuery_Select, ' select MAX(ID) As max_id from interfofinterf_relation '); for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; for j := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := Interf.IOfIRelOut.Items[j]; IOfIRel.IDInterfRel := Interf.NewID; FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger('id_interf_rel', Interf.NewID); FQuery_Operat.SetParamAsInteger('id_interf_to', IOfIRel.IDInterfTo); //FQuery_Operat.SetParamAsInteger('id_comp_rel', GetNewCompRelID(IOfIRel.IDCompRel)); FQuery_Operat.SetParamAsInteger('id_comp_rel', IOfIRel.IDCompRel); FQuery_Operat.ExecQuery; //*** Определить новый ID FQuery_Select.Close; FQuery_Select.ExecQuery; IOfIRel.NewID := FQuery_Select.GetFNAsInteger('max_id'); IOfIRel.ID := IOfIRel.NewID; end; end; end; qmMemory: with TF_Main(ActiveForm).DM do for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; for j := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := Interf.IOfIRelOut.Items[j]; IOfIRel.IDInterfRel := Interf.NewID; tSQL_InterfOfInterfRelation.Append; tSQL_InterfOfInterfRelation.FieldByName('id_interf_rel').AsInteger := Interf.NewID; tSQL_InterfOfInterfRelation.FieldByName('id_interf_to').AsInteger := IOfIRel.IDInterfTo; //tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger := GetNewCompRelID(IOfIRel.IDCompRel); tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger := IOfIRel.IDCompRel; tSQL_InterfOfInterfRelation.Post; //*** Определить новый ID IOfIRel.NewID := tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger; IOfIRel.ID := IOfIRel.NewID; end; end; end; // Сохранение связей портов с интерфейсами for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; Interf.SavePortInterfRels(meMake); end; } { //*** коррекция связующих полей if IsLine = biTrue then for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; if Interf.IDAdverse > 0 then begin NewIDAdverse := GetNewIDByOld(Interf.IDAdverse); Interf.IDAdverse := NewIDAdverse; if NewIDAdverse <> 0 then TF_Main(ActiveForm).DM.UpdateInterfFieldAsInteger(Interf.NewID, NewIDAdverse, fnIDAdverse); end; end; } { //*** коррекция связующих полей if IsLine = biTrue then begin ChangeSQLQuery(FQuery_Operat, ' update interface_relation set id_adverse = :id_adverse where id = :id '); for i := 0 to Interfaces.Count - 1 do begin Interf := Interfaces.Items[i]; if Interf.IDAdverse > 0 then begin NewIDAdverse := GetNewIDByOld(Interf.IDAdverse); if NewIDAdverse <> 0 then begin FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger('id', Interf.NewID); FQuery_Operat.SetParamAsInteger('id_Adverse', NewIDAdverse); FQuery_Operat.ExecQuery; end; end; end; end; FQuery_Select.Close; FQuery_Operat.Close;} except on E: Exception do AddExceptionToLog('TSCSComponent.SaveInterfaces: '+E.Message); end; end; procedure TSCSComponent.SaveInterfacesByServFields; var i, j: Integer; Interf, InterfAdverse, Port: TSCSInterface; ptrPortInterfRel: PPortInterfRel; LastInterfID, LastPortInterfRelID: Integer; //NewIntrfaces: TSCSInterfaces; begin LastInterfID := GetLastInterfRelID(TF_Main(FActiveForm).GDBMode); LastPortInterfRelID := GetLastPortInterfRelID(TF_Main(FActiveForm).GDBMode); //*** Определить новые ID-ки for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsNew then begin Inc(LastInterfID); Interf.NewID := LastInterfID; Interf.ID_Component := ID; end else Interf.NewID := Interf.ID; end; //*** поле IDAdverse if IsLine = biTrue then for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsNew then if Interf.IDAdverse > 0 then for j := 0 to FInterfaces.Count - 1 do if i <> j then begin InterfAdverse := FInterfaces[j]; if InterfAdverse.IsNew then if Interf.IDAdverse = InterfAdverse.ID then begin Interf.NewIDAdverse := InterfAdverse.NewID; InterfAdverse.NewIDAdverse := Interf.NewID; end; end; end; //*** Очистить внутреннюю связь for i := 0 to FInterfaces.Count - 1 do FInterfaces[i].FInternalConnected.Clear; //*** поле IDInterfRel таблици PORT_INTERFACE_RELATION for i := 0 to FInterfaces.Count - 1 do begin Port := FInterfaces[i]; Port.FPortInterfaces.Clear; for j := 0 to Port.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Port.FPortInterfRels[j]; Interf := GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if Assigned(Interf) then begin ptrPortInterfRel.IDInterfRel := Interf.NewID; if ptrPortInterfRel.RelType = rtPortInterfRel then begin Port.AddInterfaceToPort(Interf); end else if ptrPortInterfRel.RelType = rtInterfInternalConn then begin Port.FInternalConnected.Add(Interf); Interf.FInternalConnected.Add(Port); end; end; end; end; //*** Перебросить ID-ки for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsNew then begin Interf.ID := Interf.NewID; Interf.IDAdverse := Interf.NewIDAdverse; end; end; //*** Сохранить интерфейсы for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsNew then begin Interf.FComponentOwner := Self; Interf.SaveAsNew; end else if Interf.IsModified then Interf.Save; end; //*** противоположный интерфейс в НБ настроить после создания, т.к. есть связь ключей if IsLine = biTrue then with TF_Main(FActiveForm) do if GDBMode = bkNormBase then for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; if Interf.IsNew then if Interf.IDAdverse <> 0 then DM.UpdateInterfFieldAsInteger(interf.NewID, Interf.IDAdverse, fnIDAdverse); end; for i := 0 to FInterfaces.Count - 1 do begin Interf := FInterfaces[i]; Interf.SavePortInterfRelsByServFields; Interf.IsNew := false; Interf.IsModified := false; end; end; procedure TSCSComponent.SaveProperties(AID_Component: Integer); var i: Integer; Propert: PProperty; begin inherited SaveProperties(AID_Component); { try case FQueryMode of qmPhisical: begin FQuery_Operat.Close; FQuery_Operat.SQL.Clear; FQuery_Operat.SQL.Add(' insert into comp_prop_relation(id_component, id_property, pvalue, IsDefault) '+ ' values(:id_component, :id_property, :pvalue, :IsDefault) '); SetSQLToQuery(FQuery_Select, 'select max(id) from comp_prop_relation'); for i:= 0 to Properties.Count - 1 do begin Propert := Properties.Items[i]; FQuery_Operat.Close; FQuery_Operat.SetParamAsInteger('ID_Component', AID_Component); FQuery_Operat.SetParamAsInteger('ID_Property', Propert.ID_Property); //if (Propert.SysName = pnHeight) and (CoordZ > 0) then // FQuery_Operat.SetParamAsString('PValue', FloatToStr(CoordZ)) //else FQuery_Operat.SetParamAsString('PValue', Propert.Value); FQuery_Operat.SetParamAsInteger(fnIsDefault, Propert.IsDefault); FQuery_Operat.ExecQuery; FQuery_Select.Close; FQuery_Select.ExecQuery; Propert.NewID := FQuery_Select.GetFNAsInteger(fnMax); Propert.ID := Propert.NewID; end; FQuery_Operat.Close; end; qmMemory: with TF_Main(ActiveForm).DM do for i:= 0 to Properties.Count - 1 do begin Propert := Properties.Items[i]; tSQL_CompPropRelation.Append; tSQL_CompPropRelation.FieldByName('ID_Component').AsInteger := AID_Component; tSQL_CompPropRelation.FieldByName('ID_Property').AsInteger := Propert.ID_Property; //if (Propert.SysName = pnHeight) and (CoordZ > 0) then // tSQL_CompPropRelation.FieldByName('PValue').AsString := FloatToStr(CoordZ) //else tSQL_CompPropRelation.FieldByName('PValue').AsString := Propert.Value; tSQL_CompPropRelation.FieldByName(fnIsDefault).AsInteger := Propert.IsDefault; tSQL_CompPropRelation.FieldByName(fnGUIDProperty).AsString := Propert.GUIDProperty; tSQL_CompPropRelation.Post; Propert.NewID := tSQL_CompPropRelation.FieldByName(fnID).AsInteger; Propert.ID := Propert.NewID; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.SaveProperties: '+E.Message); end; } end; (* // ##### Сохранить ссылки на иконки (условные обозначения) #### procedure TSCSComponent.SaveComponIcons(AID_Component: Integer); var ComponIcon: PComponIcon; i: Integer; begin {With (ActiveForm as TF_MAIN).DM.DataSet_COMPONENT_ICONS do begin for i := 0 to ComponIcons.Count - 1 do begin ComponIcon := ComponIcons.Items[i]; Append; Edit; FN('ID_Component').AsInteger := AID_Component; FN('ID_Object_Icon').AsInteger := ComponIcon.ID_ObjectIcon; Post; end; end; } try FQuery_Operat.Close; FQuery_Operat.SQL.Clear; FQuery_Operat.SQL.Add(' insert into component_icons(id_component, id_object_icon) '+ ' values(:id_component, :id_object_icon) '); for i:= 0 to ComponIcons.Count - 1 do begin ComponIcon := ComponIcons.Items[i]; FQuery_Operat.Close; FQuery_Operat.ParamByName('ID_Component').AsInteger := AID_Component; FQuery_Operat.ParamByName('id_object_icon').AsInteger := ComponIcon.ID_ObjectIcon; FQuery_Operat.ExecQuery; end; FQuery_Operat.Close; except on E: Exception do AddExceptionToLog('TSCSComponent.SaveComponIcons', E.Message); end; end; *) // ##### Вернет Список ID-в комплектующих всех уровней ##### function TSCSComponent.GetIDListWithAllSCSComplects(AAddCurrIDComponToList: Boolean): TList; var ResList: TList; ptrIDCompl: ^Integer; procedure AddIDComplectsToList(AIDComponent: Integer); var CompRelList: TList; ptrCompRel: PComplect; IDComplects: TList; i, j: integer; begin CompRelList := nil; IDComplects := Tlist.Create; CompRelList := TF_Main(ActiveForm).DM.GetComponCompRels(AIDComponent, cntComplect); //*** Создать список ID-в комплектующих, учитывая поле "количество" if Assigned(CompRelList) then begin for i := 0 to CompRelList.Count - 1 do begin ptrCompRel := CompRelList[i]; for j := 0 to ptrCompRel.Kolvo - 1 do begin //New(ptrIDCompl); GetMem(ptrIDCompl, SizeOf(Integer)); ptrIDCompl^ := ptrCompRel.ID_Child; IDComplects.Add(ptrIDCompl); end; end; FreeList(CompRelList); end; { SetSQLToQuery(FQuery_Select, ' select id_child, kolvo from component_relation where (id_component = '''+IntToStr(AIDComponent)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDComplects := Tlist.Create; //*** Создать список ID-в комплектующих, учитывая поле "количество" while Not FQuery_Select.Eof do begin for i := 0 to FQuery_Select.GetFNAsInteger('kolvo') - 1 do begin New(ptrIDCompl); ptrIDCompl^ := FQuery_Select.GetFNAsInteger('id_child'); IDComplects.Add(ptrIDCompl); end; FQuery_Select.Next; end; } for i := 0 to IDComplects.Count - 1 do begin //*** Добавить в результирующий список ResList.Add(IDComplects.Items[i]); //*** Обработать комплектующуюы AddIDComplectsToList(Integer(IDComplects.Items[i]^)); end; IDComplects.Clear; FreeAndNil(IDComplects); end; begin Result := nil; try ResList := TList.Create; //DefineQuery; //*** Если нужно добавить в список ID текущей компоненты if AAddCurrIDComponToList then begin //New(ptrIDCompl); GetMem(ptrIDCompl, SizeOf(Integer)); ptrIDCompl^ := ID; ResList.Add(ptrIDCompl); end; AddIDComplectsToList(ID); if ResList.Count > 0 then Result := ResList; except on E: Exception do AddExceptionToLog('TSCSComponent.GetIDListWithAllSCSComplects: '+E.Message); end; end; procedure TSCSComponent.FreeInterface(AInterface: TSCSInterface); var i, j: Integer; begin if AInterface <> nil then begin if Assigned(AInterface.ConnectedInterfaces) then for i := 0 to AInterface.ConnectedInterfaces.Count - 1 do begin if Assigned(TSCSInterface(AInterface.ConnectedInterfaces[i]).IOfIRelOut) then begin for j := 0 to TSCSInterface(AInterface.ConnectedInterfaces[i]).IOfIRelOut.Count - 1 do if TSCSIOfIRel(TSCSInterface(AInterface.ConnectedInterfaces[i]).IOfIRelOut[j]).InterfaceTo.ID = AInterface.ID then TSCSInterface(AInterface.ConnectedInterfaces[i]).IOfIRelOut[j] := nil; TSCSInterface(AInterface.ConnectedInterfaces[i]).IOfIRelOut.Pack; end; for j := 0 to TSCSInterface(AInterface.ConnectedInterfaces[i]).ConnectedInterfaces.Count - 1 do if TSCSInterface(TSCSInterface(AInterface.ConnectedInterfaces[i]).ConnectedInterfaces[j]).ID = AInterface.ID then begin TSCSInterface(AInterface.ConnectedInterfaces[i]).ConnectedInterfaces.Delete(j); Break; ///// BREAK ///// end; end; if AInterface.ParallelInterface <> nil then if AInterface.ParallelInterface.ParallelInterface <> nil then AInterface.ParallelInterface.ParallelInterface := nil; // Tolik --19/02/2018 -- //AInterface.Free; FreeAndNil(AInterface); // //FreeMem(AInterface); end; end; // ##### Очищает список интерфейсов ##### {20.08.2007 procedure TSCSComponent.Freeinterfaces; var i: Integer; ICount : Integer; Interf: TSCSInterface; begin try if Assigned(FInterfaces) then begin for i := 0 to FInterfaces.Count - 1 do begin Interf := Interfaces.Items[i]; if Assigned(Interf.ConnectedInterfaces) then FreeAndNil(Interf^.ConnectedInterfaces); if Assigned(Interf^.IOfIRelOut) then ClearList(Interf^.IOfIRelOut); end; ClearList(Interfaces); end; except on E: Exception do AddExceptionToLog('TSCSComponent.Freeinterfaces', E.Message); end; end;} // ##### Очищает список норм ##### {20.08.2007 procedure TSCSComponent.FreeNorms; var i: Integer; //ptrNorm: PSCSNorm; begin for i := 0 to Norms.Count - 1 do begin ptrNorm := Norms.Items[i]; if ptrNorm <> nil then ptrNorm^.Free; //Destroy; end; ClearList(Norms); end;} {20.08.2007 function TSCSComponent.GetCoordZ: Double; var ID_Component: Integer; ID_Catalog: Integer; begin try Result := 0; ID_Catalog := 0; ID_Component := ID; //*** Выйти на компоненту, которая есть в папках данной комплектующей while ID_Catalog = 0 do begin SetSQLToQuery(FQuery_Select, ' SELECT * FROM CATALOG_RELATION ' + ' WHERE ID_COMPONENT = '''+ IntToStr(ID_Component) +''' '); ID_Catalog := FQuery_Select.FN('ID_CATALOG').AsInteger; //*** Если компоненты нет в папке if ID_Catalog = 0 then begin SetSQLToQuery(FQuery_Select, ' SELECT * FROM COMPONENT_RELATION ' + ' WHERE ID_Child = '''+ IntToStr(ID_COMPONENT) +''' '); ID_Component := FQuery_Select.FN('ID_Component').AsInteger; //*** Если компонента также не является комплектующей (ни к чему не привязана) if ID_Component = 0 then Exit; //// EXIT //// end; end; if Result <> 0 then begin end; except ShowMessage('EXCEPTION: TSCSComponent.GetCoordZ'); end; end;} // ##### Обновить количество компл-х в ветви компоненты (KOL_Complect) ##### procedure TSCSComponent.RepairKolComplect; var i: Integer; CCount, ComplectCount: Integer; Compl: PComplect; begin if Complects <> nil then begin ComplectCount := 0; CCount := Complects.Count; for i := 0 to CCount - 1 do begin Compl := Complects.Items[i]; ComplectCount := ComplectCount + Compl.Kolvo; end; KolComplect := ComplectCount; end; end; // ##### Разбить компл-е кт-е заданы в количестве (напр. 4 шт.) на отдельные компл-е ##### procedure TSCSComponent.DivideComplects; var i, j, CCount, ComplectCount: Integer; Compl, DivCompl: PComplect; DividedCompl: TList; begin DividedCompl := TList.Create; ComplectCount := Complects.Count; //*** Создать список добавленных комл-х for i := 0 to ComplectCount - 1 do begin Compl := Complects.Items[i]; if Compl.Kolvo = 0 then Compl.Kolvo := 1; for j := 0 to Compl.Kolvo - 1 do begin //new(DivCompl); GetMem(DivCompl, SizeOf(TComplect)); DivCompl^ := Compl^; DivCompl.Kolvo := 1; DivCompl.ServCopyIndex := j; DividedCompl.Add(DivCompl); end; FreeMem(Complects.Items[i]); Complects.Items[i] := nil; end; Complects.Pack; //*** Убрать удаленные //*** Внести росфасованные комплектующие ComplectCount := DividedCompl.Count; for i := 0 to ComplectCount - 1 do begin Complects.Add(DividedCompl.Items[i]); end; DividedCompl.Clear; FreeAndNil(DividedCompl); end; // ##### Определить начало и конец цельного текущего компонента ##### procedure TSCSComponent.DefineFirstLast(AWithOrderInList: Boolean = false); var FirstConnObjInterfCount: Integer; LastConnObjInterfCount: Integer; BufID: Integer; IDCompRelUnion: Integer; //TopParentCatalog: TSCSCatalog; FirstPartComponent: TSCSComponent; function GetConnObjInterfCount(AConnCompon: TSCSComponent): integer; var //Catalog: TCatalog; {SCSObject: TSCSCatalog; i, j: Integer; InterfCount: Integer; ptrCompon: PSCSComponent; Interfac: TSCSInterface;} ConCompon: TSCSComponent; ConObject: TSCSCatalog; //SCSCompon: TSCSComponent; //Interfac: TSCSInterface; //i, j: Integer; //ConComponObjID: Integer; begin Result := 0; //if AIDConnCompon > 0 then begin //ConCompon := FProjectOwner.GetComponentFromReferences(AIDConnCompon); ConCompon := AConnCompon; if ConCompon <> nil then begin ConObject := ConCompon.GetFirstParentCatalog; if Assigned(ConObject) then Result := ConObject.GetInterfaceCount([itFunctional]); end; end; end; //*** Устанавливает нормальный порядок размещения кусков трасс слева на право procedure SetActualOrderInPartComponent(ALeftComponent: TSCSComponent); var SortedWholeComponent: TIntList; ComponentToOrder, StepComponent, JoinedComponent: TSCSComponent; i, j: Integer; begin SortedWholeComponent := TIntList.Create; ComponentToOrder := ALeftComponent; for i := 0 to FWholeComponent.Count - 1 do begin if ComponentToOrder <> nil then if SortedWholeComponent.IndexOf(ComponentToOrder.ID) = -1 then SortedWholeComponent.Add(ComponentToOrder.ID); StepComponent := ComponentToOrder; ComponentToOrder := nil; //*** Найти следующий подключенный компонент if StepComponent <> nil then for j := 0 to StepComponent.JoinedComponents.Count - 1 do begin JoinedComponent := StepComponent.JoinedComponents[j]; if (SortedWholeComponent.IndexOf(JoinedComponent.ID) = -1) and (FWholeComponent.IndexOf(JoinedComponent.ID) <> -1) then begin ComponentToOrder := JoinedComponent; Break; ///// BREAK ///// end; end; end; //*** Не один участок кабеля не ушел в пизду if FWholeComponent.Count = SortedWholeComponent.Count then begin FWholeComponent.Clear; FWholeComponent.Assign(SortedWholeComponent); end; SortedWholeComponent.Free; end; begin //13.03.2009 FirstConnectedConnCompon := nil; //13.03.2009 LastConnectedConnCompon := nil; FirstPartComponent := nil; try //TopParentCatalog := nil; //TopParentCatalog := GetTopParentCatalog; if FProjectOwner = nil then Exit; //// EXIT //// if (LastIDConnectedConnCompon <> 0) and ((LastConnectedConnCompon = nil) or (LastConnectedConnCompon.ID <> LastIDConnectedConnCompon)) then LastConnectedConnCompon := FProjectOwner.GetComponentFromReferences(LastIDConnectedConnCompon); if (FirstIDConnectedConnCompon <> 0) and ((FirstConnectedConnCompon = nil) or (FirstConnectedConnCompon.ID <> FirstIDConnectedConnCompon)) then FirstConnectedConnCompon := FProjectOwner.GetComponentFromReferences(FirstIDConnectedConnCompon); FirstConnObjInterfCount := GetConnObjInterfCount(FirstConnectedConnCompon); LastConnObjInterfCount := GetConnObjInterfCount(LastConnectedConnCompon); if FirstConnObjInterfCount > LastConnObjInterfCount then begin BufID := FirstIDCompon; FirstIDCompon := LastIDCompon; LastIDCompon := BufID; ExchangeObjects(FirstCompon, LastCompon); BufID := FirstIDConnectedConnCompon; FirstIDConnectedConnCompon := LastIDConnectedConnCompon; LastIDConnectedConnCompon := BufID; ExchangeObjects(FirstConnectedConnCompon, LastConnectedConnCompon); end; {//12.03.2009 if (LastIDConnectedConnCompon <> 0) or (FirstIDConnectedConnCompon <> 0) then if FProjectOwner <> nil then begin if LastIDConnectedConnCompon <> 0 then LastConnectedConnCompon := FProjectOwner.GetComponentFromReferences(LastIDConnectedConnCompon); if FirstIDConnectedConnCompon <> 0 then FirstConnectedConnCompon := FProjectOwner.GetComponentFromReferences(FirstIDConnectedConnCompon); end; } if LastConnectedConnCompon <> nil then begin //IDCompRelUnion := TF_Main(ActiveForm).DM.GetIDCompRelByConnectCompons(LastIDConnectedConnCompon, LastIDCompon, cntUnion); //if IDCompRelUnion = 0 then if LastConnectedConnCompon.JoinedComponents.GetComponenByID(LastIDCompon) = nil then begin BufID := FirstIDCompon; FirstIDCompon := LastIDCompon; LastIDCompon := BufID; ExchangeObjects(FirstCompon, LastCompon); end; end; if AWithOrderInList then begin FirstPartComponent := FProjectOwner.GetComponentFromReferences(FirstIDCompon); if FirstPartComponent <> nil then SetActualOrderInPartComponent(FirstPartComponent); end; except on E: Exception do AddExceptionToLog('TSCSComponent.DefineFirstLast: '+E.Message); end; end; function TSCSComponent.DefineInterfCountToConnect: Integer; var i: Integer; Interfac: TSCSInterface; CanInterfConnect: Boolean; begin Result := 0; ServInterfCntToConnect := 0; {for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac <> nil then if Interfac.TypeI = itFunctional then if (Interfac.IsBusy = biFalse) or (Interfac.Multiple = biTrue) then begin CanInterfConnect := true; if FProjectOwner <> nil then if FProjectOwner.FUsedInterfaces.IndexOf(Interfac) <> -1 then CanInterfConnect := false; if CanInterfConnect then Inc(ServInterfCntToConnect); end; end; } for i := 0 to FInterfaces.Count - 1 do begin Interfac := FInterfaces[i]; if Interfac <> nil then if Interfac.TypeI = itFunctional then begin if (Interfac.Kolvo > Interfac.KolvoBusy) or (Interfac.Multiple = biTrue) then begin CanInterfConnect := true; if FProjectOwner <> nil then if GetValueIndexFromSortedIntList(Interfac.ID, FProjectOwner.FUsedInterfaces) <> -1 then //11.03.2009 if FProjectOwner.FUsedInterfaces.IndexOf(Interfac) <> -1 then CanInterfConnect := false; if CanInterfConnect then if Interfac.Kolvo > Interfac.KolvoBusy then ServInterfCntToConnect := ServInterfCntToConnect + (Interfac.Kolvo - Interfac.KolvoBusy) else Inc(ServInterfCntToConnect); //Inc(ServInterfCntToConnect); end; end; end; if ServInterfCntToConnect > 0 then ServCanConnect := true else ServCanConnect := false; Result := ServInterfCntToConnect; end; // ##### Вернет количество свободных интерфейсов ##### function TSCSComponent.GetNotBusyInterfCount: Integer; var i: Integer; NotBusyCount: Integer; begin Result := 0; NotBusyCount := 0; for i := 0 to Interfaces.Count - 1 do if TSCSInterface(Interfaces.Items[i]).IsBusy = 0 then NotBusyCount := NotBusyCount + 1; Result := NotBusyCount; end; { // ##### Соединиться интерфейсами с ASCSComponent ##### function TSCSComponent.EmConnectTo(ASCSComponent: TSCSComponent): Boolean; var i, j: Integer; InterfOwn: TSCSInterface; InterfArg: TSCSInterface; CanConnect: TCheckInterfForUnionResult; IDComponRel: Integer; procedure DefineIDComponRel; var TopCatalog: TSCSCatalog; begin if IDComponRel = -1 then begin case FQueryMode of qmPhisical: IDComponRel := GenIDFromTable(FQuery_Select.FPhisicalQuery, gnComponentRelationID, 1); //TF_Main(ActiveForm).AppendToComponRel(Self.ID, ASCSComponent.ID, 1, AConnectType); qmMemory: begin IDComponRel := GenCurrProjTableID(giComponentRelationID); //TopCatalog := GetTopParentCatalog; //if TopCatalog <> nil then // if TopCatalog is TSCSProject then // IDComponRel := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID); end; end; end; end; procedure ConnInterf(AInterfTrg, AInterfSrc: TSCSInterface); var IOfIRel: TSCSIOfIRel; begin DefineIDComponRel; //GetZeroMem(ptrIOfIRel, SizeOf(TIOfIRel)); IOfIRel := TSCSIOfIRel.Create; IOfIRel.IDInterfRel := AInterfTRG.ID; IOfIRel.IDInterfTo := AInterfSrc.ID; IOfIRel.IDCompRel := IDComponRel; IOfIRel.InterfaceOwner := AInterfTRG; IOfIRel.InterfaceTo := AInterfSrc; if AInterfTrg.IOfIRelOut = nil then AInterfTrg.IOfIRelOut := TSCSObjectList.Create(true); AInterfTrg.IOfIRelOut.Add(IOfIRel); end; begin Result := false; IDComponRel := -1; if TF_Main(ActiveForm).CanConnCompon(Self, ASCSComponent, cntUnion, smtNone) then begin if Interfaces.Count = 0 then LoadInterfaces(-1, false); if ASCSComponent.Interfaces.Count = 0 then ASCSComponent.LoadInterfaces(-1, false); for i := 0 to Interfaces.Count - 1 do begin InterfOwn := Interfaces.Items[i]; for j := 0 to ASCSComponent.Interfaces.Count - 1 do begin InterfArg := ASCSComponent.Interfaces.Items[j]; if ((InterfOwn.ServIsBusy = 0) or (InterfOwn.Multiple = biTrue)) and ((InterfArg.ServIsBusy = 0) or (InterfArg.Multiple = biTrue)) then begin CanConnect := CheckInterfForUnion(InterfOwn, InterfArg, FActiveForm, ASCSComponent.ActiveForm, cnkVarious or cnkMaleMale, cntUnion); //*** Если патч-корд, то проверить не соединен ли он половиной интерфейсами if CanConnect = chrSuccess then if ComponentType.SysName = ctsnPatchCord then begin if CheckConnectedByHalfEqualInterfaces(ASCSComponent, IDComponRel, cntUnion, true) then CanConnect := chrFail; end else if ASCSComponent.ComponentType.SysName = ctsnPatchCord then if CheckConnectedByHalfEqualInterfaces(Self, IDComponRel, cntUnion, true) then CanConnect := chrFail; if CanConnect = chrSuccess then begin InterfOwn.ServIsBusy := biTrue; InterfArg.ServIsBusy := biTrue; ConnInterf(InterfOwn, InterfArg); ConnInterf(InterfArg, InterfOwn); Result := true; Break; end; end; end; end; end; end; // ##### Отсоединится от ASCSComponent интерфейсами ##### procedure TSCSComponent.EmDisconnect(ASCSComponent: TSCSComponent); var i, j: Integer; ptrInterfaceOwn: TSCSInterface; ptrInterfaceArg: TSCSInterface; function DelConnectedIOfIRel(AInterfTrg, AInterfSrc: TSCSInterface): Boolean; var i, j: Integer; IOfIRelTrg: TSCSIOfIRel; IOfIRelSrc: TSCSIOfIRel; begin Result := false; if (AInterfTrg.IOfIRelOut = nil) or (AInterfSrc.IOfIRelOut = nil) then Exit; //// EXIT ///// i := 0; while i <= AInterfTrg.IOfIRelOut.Count - 1 do begin IOfIRelTrg := TSCSIOfIRel(AInterfTrg.IOfIRelOut.Items[i]); j := 0; while j <= AInterfSrc.IOfIRelOut.Count - 1 do begin IOfIRelSrc := TSCSIOfIRel(AInterfSrc.IOfIRelOut.Items[j]); if (IOfIRelTrg.IDInterfRel = IOfIRelSrc.IDInterfTo) or (IOfIRelTrg.IDInterfTo = IOfIRelSrc.IDInterfRel) then begin FreeAndNil(IOfIRelSrc); FreeAndNil(IOfIRelTrg); AInterfSrc.IOfIRelOut.Delete(i); AInterfTrg.IOfIRelOut.Delete(j); Result := true; Exit; // /////// EXIT /////// end; j := j + 1; end; i := i + 1; end; end; begin for i := 0 to Interfaces.Count - 1 do begin ptrInterfaceOwn := Interfaces.Items[i]; for j := 0 to ASCSComponent.Interfaces.Count - 1 do begin ptrInterfaceArg := ASCSComponent.Interfaces.Items[j]; if (ptrInterfaceOwn.ServIsBusy = 1) and (ptrInterfaceArg.ServIsBusy = 1) then if DelConnectedIOfIRel(ptrInterfaceOwn, ptrInterfaceArg) then begin ptrInterfaceOwn.ServIsBusy := biFalse; ptrInterfaceArg.ServIsBusy := biFalse; //if ptrInterfaceOwn.ConnectedInterfaces.Count = 0 then // ptrInterfaceOwn.IsBusy := 0; //if ptrInterfaceArg.ConnectedInterfaces.Count = 0 then // ptrInterfaceArg.IsBusy := 0; end; end; end; end; } // ##### Освобождает все интерфейсы ##### procedure TSCSComponent.EmSetNoBusyInterf; var i: Integer; Interfac: TSCSInterface; begin for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; Interfac.IsBusy := 0; Interfac.IOfIRelOut.Clear; //ClearList(Interfac.IOfIRelOut); end; end; // ##### Вернет список ID-в своих интерфейсов и комплектующих ##### function TSCSComponent.GetAllInterfIDCompon: TList; var ChildComponsID, CurrIDList, ResList: TList; IDComponList: TList; //*** ID тек-й компоненты + ID-ки комплект-х ptrIDCompon: ^Integer; i: Integer; { procedure AppendComponIDToList(AIDCompon: Integer); var i: Integer; IDComplectList: TList; begin //*** Выбрать все интерфейсы компоненты SetSQLToQuery(FQuery_Select, ' select id from interface_relation where id_component = '''+IntToStr(AIDCompon)+''' '); TF_Main(ActiveForm).DM.IntFieldToList(ResList, FQuery_Select, 'id'); //*** Выбрать комплектующие SetSQLToQuery(FQuery_Select, ' select id_child from component_relation where (id_component = '''+IntToStr(AIDCompon)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDComplectList := Tlist.Create; TF_Main(ActiveForm).DM.IntFieldToList(IDComplectList, FQuery_Select, 'id_child'); for i := 0 to IDComplectList.Count - 1 do AppendComponIDToList(Integer(IDComplectList.Items[i]^)); FreeList(IDComplectList); end; } begin Result := nil; try ChildComponsID := nil; ResList := TList.Create; ChildComponsID := GetIDListWithAllSCSComplects(true); for i := 0 to ChildComponsID.Count - 1 do begin CurrIDList := TF_Main(ActiveForm).DM.GetInterfIDListByIDCompon(Integer(ChildComponsID[i]^)); if Assigned(CurrIDList) then begin Reslist.Assign(CurrIDList, laOr); FreeAndNil(CurrIDList); end; end; if Reslist.Count = 0 then ResList.Free else Result := ResList; // Tolik -- 08/02/2017 -- if ChildComponsID <> nil then FreeAndnil(ChildComponsID); // except on E: Exception do AddExceptionToLog('TSCSComponent.GetIntefIDConnCompon: '+E.Message); end; end; { // ##### Вернет список ID-в своих интерфейсов и комплектующих ##### function TSCSComponent.GetAllInterfIDCompon(AID_Component: Integer): TList; var ResList: TList; IDCompon: Integer; IDComponList: TList; //*** ID тек-й компоненты + ID-ки комплект-х ptrIDCompon: ^Integer; procedure AppendComponIDToList(AIDCompon: Integer); var i: Integer; IDComplectList: TList; begin //*** Выбрать все интерфейсы компоненты SetSQLToQuery(FQuery_Select, ' select id from interface_relation where id_component = '''+IntToStr(AIDCompon)+''' '); TF_Main(ActiveForm).DM.IntFieldToList(ResList, FQuery_Select, 'id'); //*** Выбрать комплектующие SetSQLToQuery(FQuery_Select, ' select id_child from component_relation where (id_component = '''+IntToStr(AIDCompon)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDComplectList := Tlist.Create; TF_Main(ActiveForm).DM.IntFieldToList(IDComplectList, FQuery_Select, 'id_child'); for i := 0 to IDComplectList.Count - 1 do AppendComponIDToList(Integer(IDComplectList.Items[i]^)); FreeList(IDComplectList); end; begin try Result := nil; ResList := TList.Create; if AID_Component = -1 then IDCompon := ID else IDCompon := AID_Component; AppendComponIDToList(IDCompon); if Reslist.Count = 0 then ResList.Free else Result := ResList; except on E: Exception do AddExceptionToLog('TSCSComponent.GetIntefIDConnCompon', E.Message); end; end; } function TSCSComponent.GetVolume(AGenderInterface: Integer; AGUIDInterface: String = ''; AWithMaxVolume: Boolean = false): Double; var i: Integer; Interfac: TSCSInterface; PropSysName: String; Prop: PProperty; PropVolume: Double; begin Result := 0; try if GUseLiteFunctional then begin PropSysName := ''; if AGenderInterface = gtFemale then PropSysName := pnInSection else if AGenderInterface = gtMale then PropSysName := pnOutSection; Prop := nil; if PropSysName <> '' then Prop := GetPropertyBySysName(PropSysName); if Prop <> nil then begin PropVolume := StrToFloatDef_My(Prop.Value, 0); if PropVolume <> 0 then Result := FloatInUOM(PropVolume, umMM, umSM, 2); end; end; if Result = 0 then begin if Interfaces.Count = 0 then LoadInterfaces(-1, false); if AGUIDInterface <> '' then begin Interfac := GetInterfaceByTypeAndGender([itConstructive], [AGenderInterface], biTrue, AGUIDInterface); if Interfac <> nil then Result := Interfac.ValueI; end else // Найти интерфейс с наибольшим сечением for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; if (Interfac.TypeI = itConstructive) and (Interfac.Gender = AGenderInterface) and (Interfac.Multiple = biTrue) then if (AWithMaxVolume = false) or (Result < Interfac.ValueI) then Result := Interfac.ValueI; end; {for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; if Interfac.TypeI = itConstructive then if Interfac.Gender = AGenderInterface then Result := Interfac.ValueI; end;} end; except on E: Exception do AddExceptionToLog('TSCSComponent.GetVolume: '+E.Message); end; end; function TSCSComponent.GetInterfaceByTypeAndGender(ATypes, AGenders: TIntSet; AIsMultiple: Integer; AGUIDInterface: String = ''; AWithMaxVolume: Boolean=false; ACanLoad: Boolean=true): TSCSInterface; var i: Integer; Interfac: TSCSInterface; MaxVolume: Double; begin Result := nil; try if ACanLoad then if Interfaces.Count = 0 then LoadInterfaces(-1, false); MaxVolume := 0; for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; if (Interfac.TypeI in Atypes) and (Interfac.Gender in AGenders) and ((AIsMultiple = biNone) or (Interfac.Multiple = AIsMultiple)) and ((AGUIDInterface = '') or (Interfac.GUIDInterface = AGUIDInterface)) then if (AWithMaxVolume = false) or (Interfac.ValueI > MaxVolume) then begin MaxVolume := Interfac.ValueI; Result := Interfac; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.GetInterfaceByTypeAndGender: '+E.Message); end; end; // ##### Вернет функциональные интерфейсы сторон ##### function TSCSComponent.GetInterfIDLineCompon( AID_Component: Integer): TInterfLists; var InterfList1, InterfList2: Tlist; InterfLists: TInterfLists; IDInterf: ^Integer; IDCompon: Integer; procedure Step(AIDCompon: Integer); var ComplRelList: TList; CurrInterfList: TList; i: Integer; begin //***************** Рекурсивная часть ComplRelList := TF_Main(ActiveForm).DM.GetComponCompRels(AIDCompon, cntComplect); for i := 0 to ComplRelList.Count - 1 do Step(PComplect(ComplRelList.Items[i]).ID_Child); FreeList(ComplRelList); //****************** Рабочая часть ********* //*** Отобрать функциональные интерфейсы CurrInterfList := TF_Main(ActiveForm).DM.GetInterfFieldListByFilter(fnID, '(id_component = '''+IntToStr(AIDCompon)+''') and (typei = '''+IntToStr(itFunctional)+''') and '+ '(side = '''+IntTostr(1)+''') '); InterfList1.Assign(CurrInterfList, laOr); FreeAndNil(CurrInterfList); CurrInterfList := TF_Main(ActiveForm).DM.GetInterfFieldListByFilter(fnID, '(id_component = '''+IntToStr(AIDCompon)+''') and (typei = '''+IntToStr(itFunctional)+''') and '+ '(side = '''+IntTostr(2)+''') '); InterfList2.Assign(CurrInterfList, laOr); FreeAndNil(CurrInterfList); end; { procedure Step(AIDCompon: Integer); var IDComplList: TList; i: Integer; begin //***************** Рекурсивная часть SetSQLToQuery(FQuery_Select, ' select id_child from component_relation '+ ' where (id_component = '''+IntToStr(AIDCompon)+''') and (connect_type = '''+IntToStr(cntComplect)+''') '); IDComplList := TList.Create; TF_Main(ActiveForm).DM.IntFieldToList(IDComplList, FQuery_Select, 'id_child'); for i := 0 to IDComplList.Count - 1 do Step(Integer(IDComplList.Items[i]^)); FreeList(IDComplList); //****************** Рабочая часть ********* //*** Отобрать функциональные интерфейсы ChangeSQLQuery(FQuery_Select, ' select id from interface_relation '+ ' where (id_component = '''+IntToStr(AIDCompon)+''') and (typei = '''+IntToStr(itFunctional)+''') and '+ ' (side = :side) '+ ' order by id_interface, id '); FQuery_Select.SetParamAsInteger('side', 1); FQuery_Select.ExecQuery; TF_Main(ActiveForm).DM.IntFieldToList(InterfList1, FQuery_Select, 'id'); FQuery_Select.Close; FQuery_Select.SetParamAsInteger('side', 2); FQuery_Select.ExecQuery; TF_Main(ActiveForm).DM.IntFieldToList(InterfList2, FQuery_Select, 'id'); FQuery_Select.Close; end; } begin try InterfLists.InterfList1 := nil; InterfLists.InterfList2 := nil; Result := InterfLists; if AID_Component = -1 then IDCompon := ID else IDCompon := AID_Component; InterfList1 := Tlist.Create; InterfList2 := Tlist.Create; Step(IDCompon); if InterfList1.Count > 0 then InterfLists.InterfList1 := InterfList1; if InterfList2.Count > 0 then InterfLists.InterfList2 := InterfList2; Result := InterfLists; except on E: Exception do AddExceptionToLog('TSCSComponent.GetInterfIDLineCompon: '+E.Message); end; end; (*22.08.2007 // ##### Проверить имеет ли компонент(его комплектующие) минимальное количество интерфейсов ##### function TSCSComponent.HaveMinimumInterfaces(AFromLoaded: Boolean): Boolean; var InterfConnCompon: TList; //InterfLineCompon: TInterfLists; i: Integer; SCSComplect: TSCSComponent; SCSComponents: TSCSComponents; begin Result := false; try try InterfConnCompon := nil; SCSComponents := nil; if AFromLoaded then begin SCSComponents := TSCSComponents.Create(false); try SCSComponents.Add(Self); SCSComponents.Assign(ChildReferences, laOr); for i := 0 to SCSComponents.Count - 1 do begin SCSComplect := SCSComponents[i]; if Assigned(SCSComplect) then if SCSComplect.Interfaces.Count > 0 then begin Result := true; Break; ///// BREAK ///// end; end; finally SCSComponents.Free; end; end else begin InterfConnCompon := GetAllInterfIDCompon; if InterfConnCompon <> nil then if InterfConnCompon.Count > 0 then Result := true; end; except on E: Exception do AddExceptionToLog('TSCSComponent.HaveMinimumInterfaces: '+E.Message); end; finally if Assigned(InterfConnCompon) then FreeList(InterfConnCompon); end; {try try Result := false; InterfConnCompon := nil; InterfLineCompon.InterfList1 := nil; InterfLineCompon.InterfList2 := nil; case IsLine of biTrue: begin InterfLineCompon := GetInterfIDLineCompon; if (InterfLineCompon.InterfList1 <> nil) and (InterfLineCompon.InterfList2 <> nil) then if (InterfLineCompon.InterfList1.Count > 0) and (InterfLineCompon.InterfList2.Count > 0) and ((InterfLineCompon.InterfList1.Count + InterfLineCompon.InterfList2.Count) mod 2 = 0) then Result := true; end; biFalse: begin InterfConnCompon := GetInterfIDConnCompon; if InterfConnCompon <> nil then if InterfConnCompon.Count > 0 then Result := true; end; end; except ShowMessage('EXCEPTION: TSCSComponent.HaveMinimumInterfaces'); end; finally FreeList(InterfConnCompon); FreeList(InterfLineCompon.InterfList1); FreeList(InterfLineCompon.InterfList2); end; } end;*) function TSCSComponent.HaveInterfaceByType(AInterfType: TInterfType): Boolean; var i: Integer; Interfac: TSCSInterface; begin Result := false; try if Interfaces.Count = 0 then begin //DefineQuery; LoadInterfaces(-1, false); end; for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; if Interfac.TypeI = AInterfType then begin Result := true; Break; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.HaveInterfaceByType: '+E.Message); end; end; function TSCSComponent.HaveMultipleInterface(CheckFunctional: Boolean = false): Boolean; var i: Integer; Interfac: TSCSInterface; begin Result := false; try if Interfaces.Count = 0 then begin //DefineQuery; LoadInterfaces(-1, false); end; for i := 0 to Interfaces.Count - 1 do begin Interfac := Interfaces.Items[i]; if Interfac.Multiple = biTrue then begin if Not CheckFunctional then begin Result := true; Break; end else begin if Interfac.TypeI = itFunctional then begin Result := true; Break; end; end; end; end; except on E: Exception do AddExceptionToLog('TSCSComponent.HaveMultipleInterface: '+E.Message); end; end; {20.08.2007 procedure TSCSComponent.ChangePrice(ANewPrice: Double); var OldPrice: Double; begin try PRICE_CALC := PRICE_CALC - PRICE + ANewPrice; PRICE := ANewPrice; SaveComponent; TF_Main(ActiveForm).CalcPriceForParents(ID); except on E: Exception do AddExceptionToLog('TSCSComponent.ChangePrice: '+E.Message); end; end; } (* // ##### Вычисляет стоимость работ ##### function TSCSComponent.CalcResourcesCost(ACalcNormTotalCost, ACalcNormCost: Boolean): Double; var CurrResourceCost: Double; i: Integer; ptrSCSNorm: PSCSNorm; begin try Result := 0; CurrResourceCost := 0; ResourcesCostPerOneNorm := 0; //CurrWorkCost := CurrWorkCost + PriceComponWithComplects; for i := 0 to Norms.Count - 1 do begin ptrSCSNorm := Norms.Items[i]; if ptrSCSNorm.IsOn = biTrue then begin if (ACalcNormTotalCost) {and (i > 0)} then if i = 0 then ptrSCSNorm.CalcTotalCost(false) else ptrSCSNorm.CalcTotalCost(ACalcNormCost); ResourcesCostPerOneNorm := ResourcesCostPerOneNorm + ptrSCSNorm.Cost; CurrResourceCost := CurrResourceCost + ptrSCSNorm.TotalCost; end; end; ResourcesCost := CurrResourceCost; TotalCost := CurrResourceCost {+ PriceComponWithComplects}; Result := CurrResourceCost; except on E: Exception do AddExceptionToLog('TSCSComponent.CalcWorkCost', E.Message); end; end; *) // ##### Добавляет к общей стоимости Компоненты, стоимости ресурсов всех ее комплектующих (не вкл. цены компл-х) ##### {20.08.2007 procedure TSCSComponent.AddToTotalCostComplResourcesCost; var i: Integer; SCSComponent: TSCSComponent; CurrComplResCost: Double; begin CurrComplResCost := 0; ComplResourcesCost := 0; for i := 0 to AllSCSComplects.Count - 1 do begin SCSComponent := AllSCSComplects.Items[i]; CurrComplResCost := CurrComplResCost + SCSComponent.NormsResources.ResourcesCost; // - ptrSCSComponent.Price; ComplResourcesCost := ComplResourcesCost + SCSComponent.NormsResources.ResourcesCost; end; TotalCost := TotalCost + CurrComplResCost; end;} function TSCSComponent.GetProducerName: String; var Spravoshnik: TSpravochnik; SprProducer: TNBProducer; begin Result := ''; try Spravoshnik := TF_Main(FActiveForm).GetSpravochnik; if Spravoshnik <> nil then begin SprProducer := nil; if GUIDProducer <> '' then SprProducer := Spravoshnik.GetProducerByGUID(GUIDProducer) else if ID_Producer <> 0 then SprProducer := Spravoshnik.GetProducerByID(ID_Producer); if SprProducer <> nil then Result := SprProducer.Name; end; {with TF_Main(ActiveForm).FNormBase.DM do begin SetSQLToFIBQuery(Query_TSCSSelect, ' select name from producers where id = '''+IntTostr(ID_Producer)+''' '); Result := Query_TSCSSelect.FN('Name').AsString; end;} except on E: Exception do AddExceptionToLog('TSCSComponent.GetProducerName: '+E.Message); end; end; { TSCSInterface } // ####################### Класс TSCSInterface #################################### // ############################################################################# // function TSCSInterface.AddInterfaceToPort( AInterface: TSCSInterface): Integer; begin Result := -1; if FPortInterfaces.IndexOf(AInterface) = -1 then Result := FPortInterfaces.Add(AInterface); AInterface.FPortOwner := Self; end; function TSCSInterface.AddToConnectedInterfaces(AInterface: TSCSInterface): Integer; begin Result := -1; //if FConnectedInterfaces.IndexOf(AInterface) = -1 then Result := FConnectedInterfaces.Add(AInterface); end; procedure TSCSInterface.Assign(AInterface: TSCSInterface; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); begin AssignOnlyInterface(AInterface); AssignIOfIRelOut(AInterface.IOfIRelOut, ANoSkipLineJoin, AFromNew); AssignPortInterfRel(AInterface.FPortInterfRels, AFromNew); end; procedure TSCSInterface.AssignIOfIRelOut(AIOfIRel: TSCSObjectList; ANoSkipLineJoin: Boolean; AFromNew: Boolean = false); var i: Integer; SrcIOfIRel, IOfIRel: TSCSIOfIRel; CanAssign: Boolean; begin if Assigned(AIOfIRel) then //if TypeI <> itFunctional then for i := 0 to AIOFIRel.Count - 1 do begin SrcIOfIRel := TSCSIOfIRel(AIOFIRel[i]); CanAssign := true; //*** пропускать связи с подключениями линейных компонент if Not ANoSkipLineJoin then if (SrcIOfIRel.InterfaceOwner <> nil) and (SrcIOfIRel.InterfaceOwner.ComponentOwner <> nil) then if SrcIOfIRel.InterfaceOwner.ComponentOwner.IsLine = biTrue then if SrcIOfIRel.InterfaceOwner.ComponentOwner.GetComplectByID(SrcIOfIRel.IDCompRel) = nil then CanAssign := false; if CanAssign then begin //GetMem(ptrIOfIRel, SizeOf(TIOfIRel)); IOfIRel := TSCSIOfIRel.Create(Self); ///ptrIOfIRel^ := TIOfIRel(AIOFIRel[i]^); IOfIRel.Assign(SrcIOfIRel); IOfIRel.IDInterfRel := ID; IOfIRel.InterfaceOwner := Self; IOfIRel.InterfaceTo := nil; if AFromNew then IOfIRel.ID := IOfIRel.NewID; Self.IOfIRelOut.Add(IOfIRel); end; end; end; procedure TSCSInterface.AssignPortInterfRel(APortInterfRels: TList; AFromNew: Boolean = false); var i: Integer; ptrPortInterfRel: PPortInterfRel; begin if Assigned(APortInterfRels) then for i := 0 to APortInterfRels.Count - 1 do begin GetMem(ptrPortInterfRel, SizeOf(TPortInterfRel)); ptrPortInterfRel^ := TPortInterfRel(APortInterfRels[i]^); ptrPortInterfRel.IDPort := ID; if AFromNew then ptrPortInterfRel.ID := ptrPortInterfRel.NewID; FPortInterfRels.Add(ptrPortInterfRel); end; end; procedure TSCSInterface.AssignOnlyInterface(AInterface: TSCSInterface); begin ID := AInterface.ID; NewID := AInterface.NewID; NewIDAdverse := AInterface.NewIDAdverse; Npp := AInterface.Npp; ID_Interface := AInterface.ID_Interface; ID_Component := AInterface.ID_Component; ID_NewComponent := AInterface.ID_NewComponent; IsLineCompon := AInterface.IsLineCompon; TypeI := AInterface.TypeI; Kind := AInterface.Kind; IsPort := AInterface.IsPort; IsUserPort := AInterface.IsUserPort; NppPort := AInterface.NppPort; IDConnected := AInterface.IDConnected; Gender := AInterface.Gender; Multiple := AInterface.Multiple; IsBusy := AInterface.IsBusy; ValueI := AInterface.ValueI; CoordZ := AInterface.CoordZ; NumPair := AInterface.NumPair; Color := AInterface.Color; IDAdverse := AInterface.IDAdverse; Side := AInterface.Side; Notice := AInterface.Notice; SortID := AInterface.SortID; Kolvo := AInterface.Kolvo; KolvoBusy := AInterface.KolvoBusy; SignType := AInterface.SignType; ConnToAnyGender := AInterface.ConnToAnyGender; SideSection := AInterface.SideSection; GUIDInterface := AInterface.GUIDInterface; IsModified := AInterface.IsModified; IsNew := AInterface.IsNew; ServCanConnect := AInterface.ServCanConnect; end; procedure TSCSInterface.AssignFromSpr(ASprInterf: TNBInterface); begin Self.ID_INTERFACE := ASprInterf.ID; Self.GUIDInterface := ASprInterf.GUID; Self.Name := ASprInterf.Name; end; procedure TSCSInterface.DefineIsBusy; begin if KolvoBusy = 0 then IsBusy := biFalse else if KolvoBusy = Kolvo then IsBusy := biTrue else if (KolvoBusy > 0) and (KolvoBusy < Kolvo) then IsBusy := biNone else if KolvoBusy < 0 then IsBusy := biFalse; //02.04.2013 - для емкостного интерфейса каб.канала (мама) занятость определяем по наличию связи с другим интерфейсом //if Assigned(FComponentOwner) then // if FComponentOwner.IsLine = biTrue then if (IsLineCompon = biTrue) and (Gender = gtFemale) and (Multiple = biTrue) then //if FComponentOwner.ComponentType.SysName = ctsnCableChannel then IsBusy := BoolToInt(FIOfIRelOut.Count > 0); end; function TSCSInterface.CheckJoinToComponent(AComponent: TSCSComponent): Boolean; var JoinedInterface: TSCSInterface; i: Integer; begin Result := false; case FQueryMode of qmPhisical: begin end; qmMemory: begin for i := 0 to FConnectedInterfaces.Count - 1 do begin JoinedInterface := FConnectedInterfaces[i]; if JoinedInterface.ComponentOwner <> nil then if JoinedInterface.ComponentOwner.ID = AComponent.ID then begin Result := true; Break; ///// BREAK ///// end; end; end; end; end; procedure TSCSInterface.Clear; var InterfPosition: TSCSInterfPosition; InterfPosConnection: TSCSInterfPosConnection; i: Integer; s: string; begin s := 'on Functional Interface!!!'; if Self.TypeI = itConstructive then s := 'on Constructive Interface!!!' else if Self.IsPort = biTrue then s := s + ' isPort!' ; {//23.03.2009 // Связь с инфой о связи ClearIOfIRels; //FIOfIRelOut.Clear; // Занятые позиции for i := 0 to FBusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(FBusyPositions[i]); if InterfPosition.InterfPosConnectionOwner <> nil then begin InterfPosConnection := InterfPosition.InterfPosConnectionOwner; if InterfPosConnection.FSelfInterfPosition <> nil then if InterfPosConnection.FSelfInterfPosition.InterfOwner = Self then InterfPosConnection.FSelfInterfPosition.InterfOwner := nil; if InterfPosConnection.FConnInterfPosition <> nil then if InterfPosConnection.FConnInterfPosition.InterfOwner = Self then InterfPosConnection.FConnInterfPosition.InterfOwner := nil; end; end; FBusyPositions.Clear; // Связь с другими интерфейсами RemoveFromAllReferences(SavedConnectedInterfaces); FConnectedInterfaces.Clear; FInternalConnected.Clear; } try // Tolik - - 28/04/2017 -- // Связь с другими интерфейсами RemoveFromAllReferences; // Tolik 19/02/2018 -- тут // Связь с инфой о связи // ClearIOfIRels; //FIOfIRelOut.Clear; // // Занятые позиции for i := 0 to FBusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(FBusyPositions[i]); if InterfPosition.InterfPosConnectionOwner <> nil then begin InterfPosConnection := InterfPosition.InterfPosConnectionOwner; if InterfPosConnection.FSelfInterfPosition <> nil then if InterfPosConnection.FSelfInterfPosition.InterfOwner = Self then InterfPosConnection.FSelfInterfPosition.InterfOwner := nil; if InterfPosConnection.FConnInterfPosition <> nil then if InterfPosConnection.FConnInterfPosition.InterfOwner = Self then InterfPosConnection.FConnInterfPosition.InterfOwner := nil; end; end; FBusyPositions.Clear; // Связь с другими интерфейсами //RemoveFromAllReferences; FConnectedInterfaces.Clear; FInternalConnected.Clear; //*** Если интерфейс имеет связь с портом if Assigned(FPortOwner) then begin if FPortOwner.ID = 560770 then EmptyProcedure; FPortOwner.RemovePortInterfRelByIDInterfRel(ID); end; //*** Если порт имеет связи с интерфейсами //ClearPortInterfaces; ClearIOfIRels; // Tolik 19/02/2017 -- Name := ''; Kolvo := 0; KolvoBusy := 0; ConnToAnyGender := biFalse; SignType := oitDefault; SideSection := ''; IOfIRelCount := -1; PortInterfRelCount := -1; IsModified := false; IsNew := false; ServIsBusy := biFalse; ServDisabled := false; FComponentOwner := nil; FParallelInterface := nil; PortOwner := nil; except // Tolik -- 28/04/2017 -- on E: Exception do AddExceptionToLogEx('TSCSInterface.Clear:' + 'Component.Name = ' + Self.ComponentOwner.Name + ' ' + Self.ComponentOwner.NameMark + ' ' + s, E.Message); end; end; procedure TSCSInterface.ClearIOfIRels; var //i: Integer; IOfIRel: TSCSIOfIRel; begin //FIOfIRelOut.Clear; //i := 0; while FIOfIRelOut.Count > 0 do begin IOfIRel := TSCSIOfIRel(FIOfIRelOut[0]); FreeIOfIRel(IOfIRel); // FreeMem(ptrIOfIRel); // FIOfIRelOut[i] := nil; end; //FIOfIRelOut.Pack; end; procedure TSCSInterface.ClearPortInterfaces; var i: Integer; ptrPortInterfRel: PPortInterfRel; begin // Tolik 19/02/2018 -- if Self.IsPort = biTrue then begin // for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels[i]; if Assigned(ptrPortInterfRel.Interf) then // if Assigned(ptrPortInterfRel.Interf.FPortOwner) then ptrPortInterfRel.Interf.FPortOwner := nil; end; FPortInterfaces.Clear; ClearList(FPortInterfRels); end; end; constructor TSCSInterface.Create(AFormOwner: TForm); begin //FTableIndex := tiInterfaceRelation; //FTableName := tnInterfaceRelation; inherited Create(AFormOwner); //ActiveForm := AFormOwner; FConnectedInterfaces := TSCSInterfaces.Create(false); FIOfIRelOut := TSCSObjectList.Create(true); FInternalConnected := TSCSInterfaces.Create(false); FPortInterfaces := TSCSInterfaces.Create(false); FPortInterfRels := TList.Create; FBusyPositions := TList.Create; Clear; end; destructor TSCSInterface.Destroy; var i: Integer; ptrPortInterfRel: PPortInterfRel; begin try Clear; FreeAndNil(FConnectedInterfaces); FreeAndNil(FIOfIRelOut); FreeAndNil(FInternalConnected); FreeAndNil(FPortInterfaces); FreeList(FPortInterfRels); // Tolik -- 19/02/2018 -- FPortInterfRels := nil; //AddExceptionToLogSilent(' TSCSInterface.destroy: ID = ' + Inttostr(Self.ID)); // FreeAndNil(FBusyPositions); finally inherited; end; end; procedure TSCSInterface.DefineInternalRelations; var i: Integer; ptrPortInterfRel: PPortInterfRel; Interf: TSCSInterface; begin //if IsPort = biTrue then ##ISPORT if Assigned(FComponentOwner) then begin FPortInterfaces.Clear; //FInternalConnected.Clear; for i := 0 to FPortInterfRels.Count - 1 do begin //ptrPortInterfRel := FPortInterfRels[i]; ptrPortInterfRel := FPortInterfRels.List^[i]; Interf := FComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if Assigned(Interf) then begin ptrPortInterfRel.Interf := Interf; if ptrPortInterfRel.RelType = rtPortInterfRel then begin if IsPort = biTrue then AddInterfaceToPort(Interf); end else if ptrPortInterfRel.RelType = rtInterfInternalConn then begin if FInternalConnected.IndexOf(Interf) = -1 then FInternalConnected.Add(Interf); if Interf.FInternalConnected.IndexOf(Self) = -1 then Interf.FInternalConnected.Add(Self); end; end; end; end; end; procedure TSCSInterface.FreeIOfIRel(AIOfIRel: TSCSIOfIRel; ADefineIsBusy: Boolean = true); var i: Integer; InterfPosConnection: TSCSInterfPosConnection; begin try if AIOfIRel <> nil then begin if FIOfIRelOut.FItemList.IndexOf(AIOfIRel) <> -1 then //if FIOfIRelOut.FItems.IndexOf(AIOfIRel) <> -1 then begin if Assigned(AIOfIRel.InterfaceTo) then begin AIOfIRel.InterfaceTo.ConnectedInterfaces.Remove(Self); FConnectedInterfaces.Remove(AIOfIRel.InterfaceTo); end; if AIOfIRel.FPosConnections <> nil then begin for i := 0 to AIOfIRel.FPosConnections.Count - 1 do begin InterfposConnection := TSCSInterfPosConnection(AIOfIRel.FPosConnections[i]); if Assigned(AIOfIRel.InterfaceOwner) and (InterfPosConnection.FSelfInterfPosition <> nil) and (InterfPosConnection.FSelfInterfPosition.ToPos > 0) and (InterfPosConnection.FSelfInterfPosition.FromPos > 0) then begin AIOfIRel.FInterfaceOwner.KolvoBusy := AIOfIRel.FInterfaceOwner.KolvoBusy - (InterfPosConnection.FSelfInterfPosition.ToPos - (InterfPosConnection.FSelfInterfPosition.FromPos - 1)); if AIOfIRel.FInterfaceOwner.KolvoBusy < 0 then AIOfIRel.FInterfaceOwner.KolvoBusy := 0; end; if Assigned(AIOfIRel.InterfaceTo) and (InterfPosConnection.FConnInterfPosition <> nil) and (InterfPosConnection.FConnInterfPosition.ToPos > 0) and (InterfPosConnection.FConnInterfPosition.FromPos > 0) then begin AIOfIRel.FInterfaceTo.KolvoBusy := AIOfIRel.FInterfaceTo.KolvoBusy - (InterfPosConnection.FConnInterfPosition.ToPos - (InterfPosConnection.FConnInterfPosition.FromPos - 1)); if AIOfIRel.FInterfaceTo.KolvoBusy < 0 then AIOfIRel.FInterfaceTo.KolvoBusy := 0; end; if InterfPosConnection.FSelfInterfPosition <> nil then begin if (AIOfIRel.FInterfaceOwner <> nil) and (AIOfIRel.FInterfaceOwner = InterfPosConnection.FSelfInterfPosition.FInterfOwner) then AIOfIRel.FInterfaceOwner.FBusyPositions.Remove(InterfPosConnection.FSelfInterfPosition) else EmptyProcedure; InterfPosConnection.FSelfInterfPosition.InterfOwner := nil; end; if InterfPosConnection.FConnInterfPosition <> nil then begin if (AIOfIRel.FInterfaceTo <> nil) and (AIOfIRel.FInterfaceTo = InterfPosConnection.FConnInterfPosition.FInterfOwner) then AIOfIRel.FInterfaceTo.FBusyPositions.Remove(InterfPosConnection.FConnInterfPosition) else EmptyProcedure; InterfPosConnection.FConnInterfPosition.InterfOwner := nil; end; end; end; if ADefineIsBusy then begin if AIOfIRel.InterfaceOwner <> nil then AIOfIRel.InterfaceOwner.DefineIsBusy; if AIOfIRel.InterfaceTo <> nil then AIOfIRel.InterfaceTo.DefineIsBusy; end; FIOfIRelOut.FItemList.Remove(AIOfIRel); FreeAndNil(AIOfIRel); end; end; except on E: Exception do AddExceptionToLogEx('TSCSInterface.FreeIOfIRel', E.Message); end; end; function TSCSInterface.GetColJoinedWithNoMultiple: Integer; var i: Integer; CurrJoined: TSCSInterface; begin Result := 0; for i := 0 to FConnectedInterfaces.Count - 1 do begin CurrJoined := FConnectedInterfaces[i]; if CurrJoined.Multiple = biFalse then Inc(Result); end; end; function TSCSInterface.GetEmptyPositions(AMaxPosCount: Integer=-1): TSCSInterfPositions; var CurrBusyPosition, EmptyPosition, NewEmptyPosition: TSCSInterfPosition; i, j, OldEmptyToPos, OldEmptyFromPos: Integer; CurrPosition: TSCSInterfPosition; SparePosCount: Integer; // лишнее количество позиций CurrPosCount, TotalPosCount: Integer; begin Result := TSCSInterfPositions.Create; EmptyPosition := TSCSInterfPosition.Create(Self); //GetZeroMem(EmptyPosition, SizeOf(TInterfPosition)); Result.FPositions.Add(EmptyPosition); EmptyPosition.InterfOwner := Self; EmptyPosition.FromPos := 1; EmptyPosition.ToPos := Kolvo; if TypeI = itConstructive then begin Result.Kolvo := Kolvo; if (IsBusy = biTrue) and (Multiple = biFalse) then Result.Kolvo := 0; end else if TypeI = itFunctional then begin for i := 0 to FBusyPositions.Count - 1 do begin CurrBusyPosition := FBusyPositions[i]; j := 0; while j <= Result.FPositions.Count - 1 do begin EmptyPosition := TSCSInterfPosition(Result.FPositions[j]); //*** Занятый промежуток полностью покрывает свободный, то удалить свободный if (CurrBusyPosition.FromPos <= EmptyPosition.FromPos) and (CurrBusyPosition.ToPos >= EmptyPosition.ToPos) then begin FreeAndNil(EmptyPosition); Result.FPositions.Delete(j); end else //*** Занятый промежуток покрывает свободный со стороны с большей позицией if (EmptyPosition.FromPos < CurrBusyPosition.FromPos) and (EmptyPosition.ToPos >= CurrBusyPosition.FromPos) then begin OldEmptyToPos := EmptyPosition.ToPos; EmptyPosition.ToPos := CurrBusyPosition.FromPos - 1; if OldEmptyToPos > CurrBusyPosition.ToPos then begin NewEmptyPosition := TSCSInterfPosition.Create(Self); //GetZeroMem(NewEmptyPosition, SizeOf(TInterfPosition)); NewEmptyPosition.FromPos := CurrBusyPosition.ToPos + 1; NewEmptyPosition.ToPos := OldEmptyToPos; //*** Вставить новую запись рядом, без сдвига текущей Result.FPositions.Insert(j+1, NewEmptyPosition); Inc(j); end; end else //*** Занятый промежуток покрывает свободный со стороны с меньшей позицией if (CurrBusyPosition.ToPos >= EmptyPosition.FromPos) and (CurrBusyPosition.ToPos < EmptyPosition.ToPos) then begin EmptyPosition.FromPos := CurrBusyPosition.ToPos + 1; end else Inc(j); end; end; if Multiple = biTrue then begin if KolvoBusy > 0 then begin NewEmptyPosition := TSCSInterfPosition.Create(Self); //GetZeroMem(NewEmptyPosition, SizeOf(TInterfPosition)); Result.FPositions.Add(NewEmptyPosition); NewEmptyPosition.FromPos := 1; NewEmptyPosition.ToPos := Kolvo; end; end; Result.DefineKolvo; if AMaxPosCount <> -1 then if Result.FKolvo > AMaxPosCount then begin DecInterfPositionsKolvo(AMaxPosCount, Result); {SparePosCount := Result.FKolvo - AMaxPosCount; //*** Убрать лишние позиции for i := Result.FPositions.Count - 1 downto 0 do begin CurrPosition := TSCSInterfPosition(Result.FPositions[i]); CurrPosCount := CurrPosition.ToPos - (CurrPosition.FromPos-1); if CurrPosCount > SparePosCount then begin CurrPosition.ToPos := CurrPosition.ToPos - SparePosCount; Result.FKolvo := Result.FKolvo - SparePosCount; end else if CurrPosCount <= SparePosCount then begin Result.FKolvo := Result.FKolvo - CurrPosCount; CurrPosition.Free; Result.FPositions[i] := nil; end; if Result.FKolvo <= AMaxPosCount then Break; //// BREAK //// end; Result.FPositions.Pack;} { TotalPosCount := 0; //*** Убрать лишние позиции for i := Result.FPositions.Count - 1 downto 0 do begin CurrPosition := TSCSInterfPosition(Result.FPositions[i]); CurrPosCount := CurrPosition.ToPos - (CurrPosition.FromPos-1); TotalPosCount := TotalPosCount + CurrPosCount; if TotalPosCount > AMaxPosCount then begin SparePosCount := TotalPosCount - AMaxPosCount; CurrPosition.ToPos := CurrPosition.ToPos - SparePosCount; Result.FKolvo := Result.FKolvo - SparePosCount; TotalPosCount := TotalPosCount - SparePosCount; if CurrPosition.ToPos < CurrPosition.FromPos then begin CurrPosition.Free; Result.FPositions[i] := nil; end; end; //if Result.FKolvo <= AMaxPosCount then // Break; //// BREAK //// end; Result.FPositions.Pack;} end; //for i := 0 to Result.FPositions.Count - 1 do // begin // EmptyPosition := TSCSInterfPosition(Result.FPositions[i]); // EmptyPosition.InterfOwner := Self; // Result.Kolvo := Result.Kolvo + (EmptyPosition.ToPos - (EmptyPosition.FromPos - 1)); // end; end; end; function TSCSInterface.GetIOfIByIDInterfTo(AIDInterfTo: Integer): TSCSIOfIRel; var IOfIRel: TSCSIOfIRel; i: Integer; begin Result := nil; for i := 0 to FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(FIOfIRelOut[i]); if IOfIRel.IDInterfTo = AIDInterfTo then begin Result := IOfIRel; Break; ///// BREAK ///// end; end; end; function TSCSInterface.GetIOfIRelsByRange(aFromPos, aToPos: Integer): TSCSObjectList; var RangePositions: TSCSObjectList; i: Integer; begin Result := TSCSObjectList.Create(false); RangePositions := GetInterfPositionsByRange(FBusyPositions, aFromPos, aToPos); for i := 0 to RangePositions.Count - 1 do Result.Add(TSCSInterfPosition(RangePositions[i]).FInterfPosConnectionOwner.Owner); RangePositions.Free; end; function TSCSInterface.GetInterfToIDs: TIntList; var i, j: Integer; IOfIRel: TSCSIOfIRel; //ptrID: ^Integer; ptrComplect: PComplect; CanAddInterfTo: Boolean; begin Result := TIntList.Create; for i := 0 to FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(FIOfIRelOut[i]); //GetZeroMem(ptrID, SizeOf(Integer)); //ptrID^ := ptrIOfIRel.IDInterfTo; CanAddInterfTo := true; if Assigned(FComponentOwner) then begin ptrComplect := FComponentOwner.GetComplectByID(IOfIRel.IDCompRel); if ptrComplect <> nil then if ptrComplect.ConnectType = cntUnion then CanAddInterfTo := false; end; //ptrIOfIRel.IDCompRel if CanAddInterfTo then Result.Add(IOfIRel.IDInterfTo); end; end; function TSCSInterface.GetInterfToValues: Double; var i: Integer; IOfIRel: TSCSIOfIRel; CurrValue: Double; begin Result := 0; CurrValue := 0; for i := 0 to IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRelOut[i]); if Assigned(IOfIRel.InterfaceTo) then if IOfIRel.InterfaceTo.Multiple = biTrue then CurrValue := CurrValue + IOfIRel.InterfaceTo.ValueI; end; Result := CurrValue; end; function TSCSInterface.GetInterfPath(AFromPos: Integer=0; AToPos: Integer=0; AWithSide: Boolean=true): TInterfPath; var StepInterfaces: TList; InterfPathSide: TInterfPath; ResComponents: TRapObjectList; procedure SetInternalJoinedCompons(AParentPath: TInterfPath); var ComponPath: TSCSComponents; Compon: TSCSComponent; i: integer; InterfPath: TInterfPath; begin ComponPath := TSCSComponents.Create(false); GetDepthJoinedConnComponByConnCompon(TSCSComponent(AParentPath.Compon), ComponPath, nil, nil, nil); for i := 0 to ComponPath.Count - 1 do begin Compon := ComponPath[i]; if Not AParentPath.CheckComponInPaths(Compon) then begin InterfPath := TInterfPath.Create(nil, nil, 0, 0); InterfPath.Compon := Compon; AParentPath.AddPath(InterfPath); end; end; //*** Если есть внутри компоненты подключенная еще одна компонента, // тогда выходим из цикла, и не смотрим другие интерфейсы и возможность их подключения // к другим внутренним компонентам {if DepthJoinedConnCompon <> ConnectedInterface.FComponentOwner then begin IsConnectedInterfToOtherCompon := biTrue; //23.03.2009 Result.Assign(DepthComponInternalJoinInterfaces); Result.AddItems(DepthComponInternalJoinInterfaces); Break; //// BREAK //// end;} ComponPath.Free; end; procedure StepLoadPath(AParentPath: TInterfPath; AForFromPos, AForToPos: Integer; AForBusyPosition: TSCSInterfPosition=nil); var i, j, k: Integer; InterfPosition, ConnPosition: TSCSInterfPosition; InterfPosConnection: TSCSInterfPosConnection; InterfPath: TInterfPath; PosFrom, PosTo, NextPosFrom, NextPosTo, ChkPosFrom, ChkPosTo: Integer; ParallelInterf: TSCSInterface; ParallelInterfPos: TSCSInterfPosition; ParallelInterfPath: TInterfPath; InternPosFrom, InternPosTo: Integer; InternRelInterf, TmpInterf: TSCSInterface; RelInterfAtPosFrom, RelInterfAtPosTo: Integer; // В какой позации первая жила интерфейса относительно подключенного ptrPortInterfRel: PPortInterfRel; RelInterf: TSCSInterface; // Подключенный интерфейс SameInterfCnt: Integer; CanLookPosition, PrevPositionIsSuccess: Boolean; begin PrevPositionIsSuccess := false; //26.12.2011 for i := 0 to TSCSInterface(AParentPath.Interf).BusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(TSCSInterface(AParentPath.Interf).BusyPositions[i]); //if (AForBusyPosition = nil) or (InterfPosition = AForBusyPosition) then //if CheckPosIntersectRange(InterfPosition, AForFromPos, AForToPos) then // Получаем занятые позиции с подключенного иентерфейса ConnPosition := InterfPosition.GetConnectedPos; {//16.03.2014 - подходит восновном для оптики, но не подходит для случая когда Панель (витая пара) 9-12 => кабель (витая пара) 1-4 GetPosIntersectRange(InterfPosition.FromPos, InterfPosition.ToPos, AForFromPos, AForToPos, PosFrom, PosTo); CanLookPosition := false; if ((AForFromPos = 0) and (AForToPos = 0)) or ((PosFrom <> 0) and (PosTo <> 0)) then CanLookPosition := true else // Если смотрим из точечного на линейный то м.б такая ситуация: гильза 1-1 => кабель 3-3 if (TSCSComponent(AParentPath.Compon).IsLine = biFalse) and (ConnPosition <> nil) and (ConnPosition.InterfOwner.ComponentOwner.IsLine = biTrue) then if Not PrevPositionIsSuccess then begin GetPosIntersectRange(ConnPosition.FromPos, ConnPosition.ToPos, AForFromPos, AForToPos, PosFrom, PosTo); if (PosFrom <> 0) and (PosTo <> 0) then CanLookPosition := true; end;} //16.03.2014 CanLookPosition := false; // Если смотрим из точечного на линейный то м.б такая ситуация: гильза 1-1 => кабель 3-3, и наоборот: Панель (витая пара) 9-12 => кабель (витая пара) 1-4 if (TSCSComponent(AParentPath.Compon).IsLine = biFalse) and (ConnPosition <> nil) and (ConnPosition.InterfOwner.ComponentOwner.IsLine = biTrue) then begin //for test //if (AForFromPos = 0) and (AForToPos = 0) then // EmptyProcedure; //if (PosFrom <> 0) and (PosTo <> 0) then // if (PosFrom <> ConnPosition.FromPos) and (PosTo <> ConnPosition.ToPos) then // EmptyProcedure; if Not PrevPositionIsSuccess then begin if (ConnPosition.ToPos-ConnPosition.FromPos) = (AForToPos-AForFromPos) then begin PosFrom := ConnPosition.FromPos; PosTo := ConnPosition.ToPos; //ConnPosition.FromPos+(AForToPos-AForFromPos); //ConnPosition.ToPos; CanLookPosition := true; end; end; end; if Not CanLookPosition then begin GetPosIntersectRange(InterfPosition.FromPos, InterfPosition.ToPos, AForFromPos, AForToPos, PosFrom, PosTo); if ((AForFromPos = 0) and (AForToPos = 0)) or ((PosFrom <> 0) and (PosTo <> 0)) then CanLookPosition := true; end; //22.12.2011 Если с линейного пришли на точечный {if (TSCSComponent(AParentPath.Compon).IsLine = biTrue) and (ConnPosition <> nil) and (ConnPosition.InterfOwner.ComponentOwner.IsLine = biFalse) then begin GetPosIntersectRange(ConnPosition.FromPos, ConnPosition.ToPos, AForFromPos, AForToPos, PosFrom, PosTo); if (PosFrom <> 0) and (PosTo <> 0) then CanLookPosition := true; end;} if CanLookPosition then begin if (ConnPosition <> nil) and Not AParentPath.CheckInterfInPaths(ConnPosition.FInterfOwner) then begin PrevPositionIsSuccess := true; //26.12.2011 InterfPath := TInterfPath.Create(ConnPosition.FInterfOwner, ConnPosition, PosFrom, PosTo); AParentPath.AddPath(InterfPath); {if ConnPosition.FInterfOwner.ComponentOwner.IsLine = biTrue then InterfPath := TInterfPath.Create(ConnPosition.FInterfOwner, PosFrom, PosTo) else if ConnPosition.FInterfOwner.ComponentOwner.IsLine = biFalse then InterfPath := TInterfPath.Create(ConnPosition.FInterfOwner, ConnPosition.FFromPos, ConnPosition.FToPos);} // Если это линейный компонент, то добавляем занятые позиции из парного интерфейса if ConnPosition.FInterfOwner.ComponentOwner.IsLine = biTrue then begin ParallelInterf := ConnPosition.FInterfOwner.ParallelInterface; if ParallelInterf <> nil then begin for j := 0 to ParallelInterf.BusyPositions.Count - 1 do begin ParallelInterfPos := TSCSInterfPosition(ParallelInterf.BusyPositions[j]); // Смотрим подходит ли занатые позиции к занятым позициям инетерфейса исходной стороны кабеля GetPosIntersectRange(PosFrom, PosTo, ParallelInterfPos.FromPos, ParallelInterfPos.ToPos, NextPosFrom, NextPosTo); if (NextPosFrom <> 0) and (NextPosTo <> 0) then begin ParallelInterfPath := TInterfPath.Create(ParallelInterfPos.FInterfOwner, ParallelInterfPos, NextPosFrom, NextPosTo); InterfPath.AddPath(ParallelInterfPath); // от этой стороны ищем подключения дальше StepLoadPath(ParallelInterfPath, NextPosFrom, NextPosTo); end; end; end; end else // Если точечный компонент, то определяем на какие интерфейсы и на какие его позиции // подключен ConnPosition внутри компонента // Если в компонента разветвление, то порядок интерфейсов определяем в порядке подключения // например 50 жил расходятся на 30 и 20 (внутри сначала подключен 30 потом 20), то внутри будет такая связь жил: // 50.1-30.1 // 50.2-30.2 // 50.30-30.30 // 50.31-20.1 // 50.32-20.2 // 50.50-20.20 if ConnPosition.FInterfOwner.ComponentOwner.IsLine = biFalse then begin ParallelInterf := nil; // Тут будет найденный внутри подключенный интерфейс ParallelInterfPath := nil; InternPosFrom := 0; // Позиции для этого интерфейса InternPosTo := 0; // Позиции для этого интерфейса //ConnPosition.FInterfOwner.ConnectedInterfaces; // Если этот интерфейс расходится на несколько if ConnPosition.FInterfOwner.FPortInterfRels.Count > 0 then begin RelInterfAtPosFrom := 1; RelInterfAtPosTo := 1; for j := 0 to ConnPosition.FInterfOwner.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := ConnPosition.FInterfOwner.FPortInterfRels.List^[j]; if ptrPortInterfRel.RelType = rtInterfInternalConn then begin TmpInterf := ConnPosition.FInterfOwner.FComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if (TmpInterf <> nil) and (TmpInterf.ConnectedInterfaces.Count > 0) //24.02.2011 then begin RelInterf := TmpInterf; RelInterfAtPosTo := RelInterfAtPosFrom + RelInterf.Kolvo-1; GetPosIntersectRange(PosFrom, PosTo, RelInterfAtPosFrom, RelInterfAtPosTo, InternPosFrom, InternPosTo); // Если по позициям интерфейс подходит if (InternPosFrom <> 0) and (InternPosTo <> 0) then begin InternPosFrom := InternPosFrom - (RelInterfAtPosFrom - 1); InternPosTo := InternPosTo - (RelInterfAtPosFrom - 1); ParallelInterf := TmpInterf; ParallelInterfPath := TInterfPath.Create(ParallelInterf, nil, InternPosFrom, InternPosTo); InterfPath.AddPath(ParallelInterfPath); // от этой стороны ищем подключения дальше StepLoadPath(ParallelInterfPath, InternPosFrom, InternPosTo); end; RelInterfAtPosFrom := RelInterfAtPosFrom + RelInterf.Kolvo; end; end; end; end; // Если не найдены разветвления смотрим в какому интерфейсу подключен этот if ParallelInterf = nil then begin for j := 0 to ConnPosition.FInterfOwner.FInternalConnected.Count - 1 do begin InternRelInterf := ConnPosition.FInterfOwner.FInternalConnected[j]; RelInterfAtPosFrom := 1; RelInterfAtPosTo := 1; for k := 0 to InternRelInterf.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := InternRelInterf.FPortInterfRels.List^[k]; if (ptrPortInterfRel.RelType = rtInterfInternalConn) then begin RelInterf := ConnPosition.FInterfOwner.FComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); RelInterfAtPosTo := RelInterfAtPosFrom + RelInterf.Kolvo-1; if ptrPortInterfRel.IDInterfRel = ConnPosition.FInterfOwner.ID then begin //TmpInterf := ConnPosition.FInterfOwner.FComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); TmpInterf := ConnPosition.FInterfOwner.FComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDPort); if TmpInterf <> nil then begin if (ptrPortInterfRel.IDInterfRel = ConnPosition.FInterfOwner.ID) then begin ChkPosFrom := RelInterfAtPosFrom + (PosFrom - 1); ChkPosTo := RelInterfAtPosFrom + (PosTo - 1); GetPosIntersectRange(1, TmpInterf.Kolvo, ChkPosFrom, ChkPosTo, InternPosFrom, InternPosTo); // Если по позициям интерфейс подходит if (InternPosFrom <> 0) and (InternPosTo <> 0) then begin ParallelInterf := TmpInterf; //ParallelInterfPath := TInterfPath.Create(ParallelInterf, InternPosFrom, InternPosTo); //InterfPath.AddPath(ParallelInterfPath); //// от этой стороны ищем подключения дальше //StepLoadPath(ParallelInterfPath, InternPosFrom, InternPosTo); Break; //// BREAK //// end; end; end; end; RelInterfAtPosFrom := RelInterfAtPosFrom + RelInterf.Kolvo; end; end; if ParallelInterf <> nil then Break; //// BREAK //// end; // Если не нашли интерфейс по внутренним связям, то если связей нету и интерфейсов 2, то берем 2-й if (ParallelInterf = nil) and (ConnPosition.FInterfOwner.FInternalConnected.Count = 0) then begin InternRelInterf := nil; for j := 0 to ConnPosition.FInterfOwner.FComponentOwner.FInterfaces.Count - 1 do begin TmpInterf := ConnPosition.FInterfOwner.FComponentOwner.FInterfaces[j]; if (TmpInterf <> ConnPosition.FInterfOwner) and (TmpInterf.GUIDInterface = ConnPosition.FInterfOwner.GUIDInterface) and (TmpInterf.Kolvo = ConnPosition.FInterfOwner.Kolvo) and (TmpInterf.TypeI = ConnPosition.FInterfOwner.TypeI) and (TmpInterf.ConnectedInterfaces.Count > 0) //25.02.2011 then begin if InternRelInterf = nil then begin InternRelInterf := TmpInterf; InternPosFrom := PosFrom; InternPosTo := PosTo; end else // Если подходящий интерфейс не один, тогда прекращаем поиск begin InternRelInterf := nil; Break; //// BREAK //// end; end; end; if InternRelInterf <> nil then ParallelInterf := InternRelInterf; end; if ParallelInterf <> nil then begin ParallelInterfPath := TInterfPath.Create(ParallelInterf, nil, InternPosFrom, InternPosTo); InterfPath.AddPath(ParallelInterfPath); // от этой стороны ищем подключения дальше StepLoadPath(ParallelInterfPath, InternPosFrom, InternPosTo); end; end; // Если компонент точечный, и после этого сегмента нету веток, // тогда добавляем подключенные компоненты внутри верхнего if ((ParallelInterfPath <> nil) and (ParallelInterfPath.Paths.Count = 0)) then SetInternalJoinedCompons(ParallelInterfPath) else if ParallelInterfPath = nil then begin //12.10.2013 - нежны для отображения если панель не наборная InterfPath.FromPos := ConnPosition.FromPos; InterfPath.ToPos := ConnPosition.ToPos; SetInternalJoinedCompons(InterfPath); //24.02.2011 end; end; end; end; end; end; // Пробегая по всем сегментам, определяем списки компонентов/объектов procedure DefineObjectsList(ATopPath, AParentPath: TInterfPath); var i: Integer; PathCompon: TSCSComponent; begin Result.AllChildPaths.Add(AParentPath); ATopPath.ChildReferences.Add(AParentPath); PathCompon := TSCSComponent(AParentPath.Compon); //TSCSComponent(TSCSInterface(AParentPath.Interf).ComponentOwner); if ResComponents.GetObject(PathCompon.ID) = nil then begin ResComponents.Insert(PathCompon, @PathCompon.ID); Result.Components.Add(PathCompon); end; for i := 0 to AParentPath.Paths.Count - 1 do DefineObjectsList(ATopPath, TInterfPath(AParentPath.Paths[i])); end; begin Result := TInterfPath.Create(Self, nil, AFromPos, AToPos); Result.Components := TSCSComponents.Create(false); Result.ChildReferences := TObjectList.Create(false); Result.AllChildPaths := TObjectList.Create(false); ResComponents := TRapObjectList.Create; StepLoadPath(Result, AFromPos, AToPos); // Учитываем пути с другой стороны кабеля if AWithSide and (FParallelInterface <> nil) then begin InterfPathSide := FParallelInterface.GetInterfPath(AFromPos, AToPos, false); Result.PathSide := InterfPathSide; InterfPathSide.PathSide := Result; //Result.AddPath(InterfPathSide); DefineObjectsList(InterfPathSide, InterfPathSide); end; // Определяем компоненты DefineObjectsList(Result, Result); ResComponents.Free; end; function TSCSInterface.GetIsMultiple: Boolean; begin Result := false; case Multiple of 0: Result := false; 1: Result := true; end; end; function TSCSInterface.GetNameForVisible: String; var InterfName: String; begin Result := ''; case IsPort of biTrue: Result := cSCSComponent_Msg5_1 +IntToStr(NppPort)+ '-"'+Name+'"'; biFalse: Result := cSCSComponent_Msg5_2 +IntToStr(Npp)+ '-"'+Name+'"'; end; end; function TSCSInterface.GetPortInterfRelByInterfID(AIDInterRel: Integer): PPortInterfRel; var i: Integer; ptrPortInterfRel: PPortInterfRel; begin Result := nil; for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels.List^[i]; //11.03.2009 FPortInterfRels[i]; if ptrPortInterfRel.IDInterfRel = AIDInterRel then begin Result := ptrPortInterfRel; Break; ///// BREAK ///// end; end; end; procedure TSCSInterface.LoadByID(AID: Integer); //var // NBInterf: TNBInterface; var FMemTable: TSQLMemTable; begin case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnInterfaceRelation, fnID+' = '''+IntToStr(AID)+'''', nil, fnAll)); LoadFromQuery(FQSelect); //GUIDInterface := ''; //NBInterf := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetInterfaceByID(ID_Interface); //if NBInterf <> nil then //begin // GUIDInterface := NBInterf.GUID; // //NBInterf.Free; //end; if GUIDInterface = '' then GUIDInterface := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnInterface, fnGuid, ID_Interface, qmPhisical); end; qmMemory: begin {FMemTable := TF_Main(FActiveForm).DM.tSQL_InterfaceRelation; FMemTable.Filtered := false; if FMemTable.Locate(fnID, AID, []) then begin LoadFromMemTable(nil); ComponentOwner := nil; IsLineCompon := -1; end;} end; end; end; procedure TSCSInterface.LoadFromMemTable(AStringsMan: TStringsMan); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_InterfaceRelation; ComponentOwner := nil; if TStringsMan(AStringsMan).FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.Notice := FMemTable.Fields[fiInterfRel_Notice].AsString; Self.GUIDInterface := FMemTable.Fields[fiInterfRel_GuidInterface].AsString; if fiInterfRel_SideSection <> -1 then Self.SideSection := FMemTable.Fields[fiInterfRel_SideSection].AsString; end else begin Self.Notice := TStringsMan(AStringsMan).GetStrByID(FMemTable.Fields[fiInterfRel_Notice].AsInteger, AStringsMan.FInterfaceNoticeStrings); Self.GUIDInterface := TStringsMan(AStringsMan).GetStrByID(FMemTable.Fields[fiInterfRel_GuidInterface].AsInteger, AStringsMan.FInterfaceGUIDStrings); if fiInterfRel_SideSection <> -1 then Self.SideSection := TStringsMan(AStringsMan).GetStrByID(FMemTable.Fields[fiInterfRel_SideSection].AsInteger, TStringsMan(AStringsMan).FInterfaceSideSectionStrings); end; Self.ID := FMemTable.Fields[fiInterfRel_ID].AsInteger; Self.ID_Interface := FMemTable.Fields[fiInterfRel_IDInterface].AsInteger; Self.ID_Component := FMemTable.Fields[fiInterfRel_IDComponent].AsInteger; Self.IsLineCompon := biFalse; Self.Npp := FMemTable.Fields[fiInterfRel_Npp].AsInteger; Self.TypeI := FMemTable.Fields[fiInterfRel_TypeI].AsInteger; Self.Kind := FMemTable.Fields[fiInterfRel_Kind].AsInteger; Self.IsPort := FMemTable.Fields[fiInterfRel_IsPort].AsInteger; Self.IsUserPort := FMemTable.Fields[fiInterfRel_IsUserPort].AsInteger; Self.NppPort := FMemTable.Fields[fiInterfRel_NppPort].AsInteger; Self.IsBusy := FMemTable.Fields[fiInterfRel_isBusy].AsInteger; Self.Gender := FMemTable.Fields[fiInterfRel_GENDER].AsInteger; Self.Multiple := FMemTable.Fields[fiInterfRel_Multiple].AsInteger; Self.ValueI := FMemTable.Fields[fiInterfRel_ValueI].AsFloat; Self.NumPair := FMemTable.Fields[fiInterfRel_NumPair].AsInteger; Self.Color := FMemTable.Fields[fiInterfRel_Color].AsInteger; Self.IDAdverse := FMemTable.Fields[fiInterfRel_IDAdverse].AsInteger; Self.Side := FMemTable.Fields[fiInterfRel_Side].AsInteger; Self.Kolvo := 1; if fiInterfRel_Kolvo <> -1 then Self.Kolvo := FMemTable.Fields[fiInterfRel_Kolvo].AsInteger; Self.KolvoBusy := 0; if fiInterfRel_KolvoBusy <> -1 then Self.KolvoBusy := FMemTable.Fields[fiInterfRel_KolvoBusy].AsInteger else if Self.IsBusy = biTrue then Self.KolvoBusy := 1; if fiInterfRel_SignType <> -1 then Self.SignType := FMemTable.Fields[fiInterfRel_SignType].AsInteger; if fiInterfRel_ConnToAnyGender <> -1 then Self.ConnToAnyGender := FMemTable.Fields[fiInterfRel_ConnToAnyGender].AsInteger; //IOfIRelOut := Tlist.Create; //Interf.IOfIRelIn := nil; Self.ParallelInterface := nil; //Result.ConnectedInterfaces := Tlist.Create; //*** Z- координата интерфейса if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin //if IsLine = biFalse then Self.IDConnected := FMemTable.Fields[fiInterfRel_IDConnected].AsInteger; Self.CoordZ := FMemTable.Fields[fiInterfRel_CoordZ].AsFloat; if fiInterfRel_IOfIRelCount <> -1 then Self.IOfIRelCount := FMemTable.Fields[fiInterfRel_IOfIRelCount].AsInteger; if fiInterfRel_PortInterfRelCount <> -1 then Self.PortInterfRelCount := FMemTable.Fields[fiInterfRel_PortInterfRelCount].AsInteger; end else begin Self.IDConnected := 0; Self.CoordZ := 0; end; Self.IsModified := false; Self.IsNew := false; end; { ComponentOwner := nil; ID := FMemTable.FieldByName(fnID).AsInteger; ID_Interface := FMemTable.FieldByName('ID_Interface').AsInteger; ID_Component := FMemTable.FieldByName('ID_Component').AsInteger; IsLineCompon := biFalse; Npp := FMemTable.FieldByName(fnNpp).AsInteger; TypeI := FMemTable.FieldByName('TypeI').AsInteger; Kind := FMemTable.FieldByName('Kind').AsInteger; IsPort := FMemTable.FieldByName('IsPort').AsInteger; IsUserPort := FMemTable.FieldByName('IsUser_Port').AsInteger; NppPort := FMemTable.FieldByName('Npp_Port').AsInteger; IsBusy := FMemTable.FieldByName('isBusy').AsInteger; Gender := FMemTable.FieldByName('GENDER').AsInteger; Multiple := FMemTable.FieldByName('Multiple').AsInteger; ValueI := FMemTable.FieldByName('ValueI').AsFloat; NumPair := FMemTable.FieldByName('Num_Pair').AsInteger; Color := FMemTable.FieldByName('Color').AsInteger; IDAdverse := FMemTable.FieldByName('ID_Adverse').AsInteger; Side := FMemTable.FieldByName('Side').AsInteger; Notice := FMemTable.FieldByName(fnNotice).AsString; GUIDInterface := FMemTable.FieldByName(fnGuidInterface).AsString; //IOfIRelOut := Tlist.Create; //Interf.IOfIRelIn := nil; ParallelInterface := nil; //Result.ConnectedInterfaces := Tlist.Create; //*** Z- координата интерфейса if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin //if IsLine = biFalse then IDConnected := FMemTable.FieldByName('id_Connected').AsInteger; CoordZ := FMemTable.FieldByName('CoordZ').AsFloat; end else begin IDConnected := 0; CoordZ := 0; end; IsModified := false; IsNew := false; } except on E: Exception do AddExceptionToLog('TSCSInterface.LoadFromMemTable: '+E.Message); end; end; procedure TSCSInterface.LoadFromQuery(AQuery: TpFIBQuery); var SprInterface: TNBInterface; begin try ID := AQuery.FN(fnID).AsInteger; ID_Interface := AQuery.FN(fnIDInterface).AsInteger; ID_Component := AQuery.FN(fnIDComponent).AsInteger; IsLineCompon := -1; Npp := AQuery.FN(fnNpp).AsInteger; TypeI := AQuery.FN(fnTypeI).AsInteger; Kind := AQuery.FN(fnKind).AsInteger; IsPort := AQuery.FN(fnIsPort).AsInteger; IsUserPort := AQuery.FN(fnIsUserPort).AsInteger; NppPort := AQuery.FN(fnNppPort).AsInteger; IsBusy := AQuery.FN(fnIsBusy).AsInteger; Gender := AQuery.FN(fnGender).AsInteger; Multiple := AQuery.FN(fnMultiple).AsInteger; ValueI := AQuery.FN(fnValueI).AsFloat; NumPair := AQuery.FN(fnNumPair).AsInteger; Color := AQuery.FN(fnColor).AsInteger; IDAdverse := AQuery.FN(fnIDAdverse).AsInteger; Side := AQuery.FN(fnSide).AsInteger; Notice := AQuery.FN(fnNotice).AsString; Kolvo := AQuery.FN(fnKolvo).AsInteger; SignType := AQuery.FN(fnSignType).AsInteger; ConnToAnyGender := AQuery.FN(fnConnToAnyGender).AsInteger; SideSection := AQuery.FN(fnSideSection).AsString; //IOfIRelOut := nil; //IOfIRelIn := nil; //ParallelInterface := nil; //ConnectedInterfaces := nil; GUIDInterface := ''; //*** Z- координата интерфейса if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //if IsLine = biFalse then IDConnected := AQuery.FN(fnidConnected).AsInteger; CoordZ := AQuery.FN(fnCoordZ).AsFloat; end else if TF_Main(ActiveForm).GDBMode = bkNormBase then begin IDConnected := 0; CoordZ := 0; if IsBusy = biTrue then KolvoBusy := Kolvo; //*** Загрузить GUID_Interface SprInterface := TF_Main(FActiveForm).GSCSBase.FNBSpravochnik.GetInterfaceByID(ID_Interface); if SprInterface <> nil then GUIDInterface := SprInterface.GUID; end; IsModified := false; IsNew := false; except on E: Exception do AddExceptionToLog('TSCSInterface.LoadFromQuery: '+E.Message); end; end; procedure TSCSInterface.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_InterfaceRelation; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.Fields[fiInterfRel_ID].AsInteger := Self.ID; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, Self.ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.Fields[fiInterfRel_IDInterface].AsInteger := Self.ID_Interface; FMemTable.Fields[fiInterfRel_IDComponent].AsInteger := Self.ID_Component; FMemTable.Fields[fiInterfRel_Npp].AsInteger := Self.Npp; FMemTable.Fields[fiInterfRel_TypeI].AsInteger := Self.TypeI; FMemTable.Fields[fiInterfRel_Kind].AsInteger := Self.Kind; FMemTable.Fields[fiInterfRel_IsPort].AsInteger := Self.IsPort; FMemTable.Fields[fiInterfRel_IsUserPort].AsInteger := Self.IsUserPort; FMemTable.Fields[fiInterfRel_NppPort].AsInteger := Self.NppPort; FMemTable.Fields[fiInterfRel_isBusy].AsInteger := Self.IsBusy; FMemTable.Fields[fiInterfRel_GENDER].AsInteger := Self.Gender; FMemTable.Fields[fiInterfRel_Multiple].AsInteger := Self.Multiple; FMemTable.Fields[fiInterfRel_ValueI].AsFloat := Self.ValueI; FMemTable.Fields[fiInterfRel_NumPair].AsInteger := Self.NumPair; FMemTable.Fields[fiInterfRel_Color].AsInteger := Self.Color; FMemTable.Fields[fiInterfRel_IDAdverse].AsInteger := Self.IDAdverse; FMemTable.Fields[fiInterfRel_Side].AsInteger := Self.Side; FMemTable.Fields[fiInterfRel_Notice].AsInteger := TStringsMan(AStringsMan).GenStrID(Self.Notice, TStringsMan(AStringsMan).FInterfaceNoticeStrings); FMemTable.Fields[fiInterfRel_Kolvo].AsInteger := Self.Kolvo; FMemTable.Fields[fiInterfRel_KolvoBusy].AsInteger := Self.KolvoBusy; FMemTable.Fields[fiInterfRel_SignType].AsInteger := Self.SignType; FMemTable.Fields[fiInterfRel_ConnToAnyGender].AsInteger := Self.ConnToAnyGender; FMemTable.Fields[fiInterfRel_SideSection].AsInteger := TStringsMan(AStringsMan).GenStrID(Self.SideSection, TStringsMan(AStringsMan).FInterfaceSideSectionStrings); FMemTable.Fields[fiInterfRel_GuidInterface].AsInteger := TStringsMan(AStringsMan).GenStrID(Self.GUIDInterface, TStringsMan(AStringsMan).FInterfaceGUIDStrings); FMemTable.Fields[fiInterfRel_IDConnected].AsInteger := Self.IDConnected; FMemTable.Fields[fiInterfRel_CoordZ].AsFloat := Self.CoordZ; FMemTable.Fields[fiInterfRel_IOfIRelCount].AsInteger := Self.IOfIRelCount; FMemTable.Fields[fiInterfRel_PortInterfRelCount].AsInteger := Self.PortInterfRelCount; FMemTable.Post; end; end; { case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnID).AsInteger := ID; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName('ID_Interface').AsInteger := ID_Interface; FMemTable.FieldByName('ID_Component').AsInteger := ID_Component; FMemTable.FieldByName(fnNpp).AsInteger := Npp; FMemTable.FieldByName('TypeI').AsInteger := TypeI; FMemTable.FieldByName('Kind').AsInteger := Kind; FMemTable.FieldByName('IsPort').AsInteger := IsPort; FMemTable.FieldByName('IsUser_Port').AsInteger := IsUserPort; FMemTable.FieldByName('Npp_Port').AsInteger := NppPort; FMemTable.FieldByName('isBusy').AsInteger := IsBusy; FMemTable.FieldByName('GENDER').AsInteger := Gender; FMemTable.FieldByName('Multiple').AsInteger := Multiple; FMemTable.FieldByName('ValueI').AsFloat := ValueI; FMemTable.FieldByName('Num_Pair').AsInteger := NumPair; FMemTable.FieldByName('Color').AsInteger := Color; FMemTable.FieldByName('ID_Adverse').AsInteger := IDAdverse; FMemTable.FieldByName('Side').AsInteger := Side; FMemTable.FieldByName(fnNotice).AsString := Notice; FMemTable.FieldByName(fnGuidInterface).AsString := GUIDInterface; FMemTable.FieldByName('id_Connected').AsInteger := IDConnected; FMemTable.FieldByName('CoordZ').AsFloat := CoordZ; FMemTable.Post; end;} except on E: Exception do AddExceptionToLog('TSCSInterface.SaveToMemTable: '+E.Message); end; end; function TSCSInterface.LoadName: String; var Proj: TSCSProject; SprInterf: TNBInterface; begin if TF_Main(FActiveForm).GDBMode = bkNormBase then Name := TF_Main(FActiveForm).FNormBase.DM.GetInterfName(ID_Interface) else begin Proj := TSCSProject(FComponentOwner.GetTopParentCatalog); if Proj <> nil then begin SprInterf := Proj.Spravochnik.GetInterfaceWithAssign(GUIDInterface, TF_Main(FActiveForm).GSCSBase.NBSpravochnik, false, false); if SprInterf <> nil then Name := SprInterf.Name; end; end; Result := Name; end; procedure TSCSInterface.LoadIOfIRels(ALoadSQL: Boolean = true); var IDCompRel: Integer; CanAddIOfIRel: Boolean; i: Integer; IOfIRel: TSCSIOfIRel; begin case FQueryMode of qmPhisical: begin if ALoadSQL then SetSQLToFIBQueryWithCheckSQL(FQSelect, ' SELECT * FROM INTERFOFINTERF_RELATION '+ ' WHERE ID_INTERF_REL = :interf_id', false); if CheckCanLoadInterfIOfIRelsFromBase(Self) then begin FQSelect.Close; FQSelect.ParamByName('interf_id').AsInteger := ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin CanAddIOfIRel := true; IDCompRel := FQSelect.FN(fnIDCompRel).AsInteger; if FComponentOwner <> nil then begin CanAddIOfIRel := false; for i := 0 to FComponentOwner.FComplects.Count - 1 do if PComplect(FComponentOwner.FComplects[i]).ID = IDCompRel then begin CanAddIOfIRel := true; Break; //// BREAK //// end; end; if CanAddIOfIRel then begin //GetZeroMem(IOfIRel, SizeOf(TIOfIRel)); - IOfIRel := TSCSIOfIRel.Create(Self); IOfIRel.ID := FQSelect.FN(fnID).AsInteger; IOfIRel.IDInterfRel := FQSelect.FN(fnIDInterfRel).AsInteger; IOfIRel.IDInterfTo := FQSelect.FN(fnIDInterfTo).AsInteger; IOfIRel.IDCompRel := IDCompRel; IOfIRel.InterfaceOwner := Self; IOfIRel.InterfaceTo := nil; IOfIRel.NewID := 0; IOfIRel.NewIDInterfRel := 0; IOfIRel.NewIDInterfTo := 0; FIOfIRelOut.Add(IOfIRel); end; FQSelect.Next; end; end; end; qmMemory: ; (* with TF_Main(ActiveForm).DM do if SetFilterToSQLMemTable(tSQL_InterfOfInterfRelation, 'id_interf_rel = '''+IntTostr(ID)+'''') then begin tSQL_InterfOfInterfRelation.First; //Interf^.IOfIRelOut := TList.Create; //Interf^.ConnectedInterfaces := TList.Create; //Interf.IOfIRelIn := TList.Create; while Not tSQL_InterfOfInterfRelation.Eof do begin { GetMem(IOfIRel, Sizeof(TIOfIRel)); IOfIRel.ID := tSQL_InterfOfInterfRelation.FieldByName('ID').AsInteger; IOfIRel.IDInterfRel := tSQL_InterfOfInterfRelation.FieldByName('ID_INTERF_REL').AsInteger; IOfIRel.IDInterfTo := tSQL_InterfOfInterfRelation.FieldByName('ID_INTERF_TO').AsInteger; IOfIRel.IDCompRel := tSQL_InterfOfInterfRelation.FieldByName('ID_COMP_REL').AsInteger; IOfIRel.InterfaceTo := nil; IOfIRel.NewID := 0; IOfIRel.NewIDInterfRel := 0; IOfIRel.NewIDInterfTo := 0;} IOfIRel := GetIOfIRelFromMemTable; IOfIRel.InterfaceOwner := Self; FIOfIRelOut.Add(IOfIRel); tSQL_InterfOfInterfRelation.Next; end; end; *) end; end; procedure TSCSInterface.LoadPortInterfaces(ALoadSQL: Boolean = true); begin //if IsPort = biTrue then ##ISPORT if Assigned(FComponentOwner) then begin LoadPortInterfRels(ALoadSQL); FPortInterfaces.Clear; DefineInternalRelations; end; end; procedure TSCSInterface.LoadPortInterfRels(ALoadSQL: Boolean = true); var //strFilter: String; ptrPortInterfRel: PPortInterfRel; begin //if IsPort = biTrue then ##ISPORT begin ClearList(FPortInterfRels); //strFilter := fnIDPort+' = '''+IntToStr(ID)+''''; case FQueryMode of qmPhisical: begin if ALoadSQL then SetSQLToFIBQueryWithCheckSQL(FQSelect, 'select * from '+tnPortInterfaceRelation+' '+ 'where '+fnIDPort+' = :'+fnIDPort, false); if CheckCanLoadInterfInternalConnectionsFromBase(Self) then begin FQSelect.Close; FQSelect.ParamByName(fnIDPort).AsInteger := ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin GetZeroMem(Pointer(ptrPortInterfRel), SizeOf(TPortInterfRel)); ptrPortInterfRel.ID := FQSelect.FN(fnID).AsInteger; ptrPortInterfRel.RelType := FQSelect.FN(fnRelType).AsInteger; ptrPortInterfRel.IDPort := FQSelect.FN(fnIDPort).AsInteger; ptrPortInterfRel.IDInterfRel := FQSelect.FN(fnIDInterfRel).AsInteger; ptrPortInterfRel.UnitInterfKolvo := FQSelect.FN(fnUnitInterfKolvo).AsInteger; FPortInterfRels.Add(ptrPortInterfRel); FQSelect.Next; end; end; end; qmMemory: with TF_Main(FActiveForm).DM do begin { SetFilterToSQLMemTable(tSQL_PortInterfaceRelation, strFilter); if tSQL_PortInterfaceRelation.RecordCount > 0 then begin tSQL_PortInterfaceRelation.First; while Not tSQL_PortInterfaceRelation.Eof do begin ptrPortInterfRel := GetPortInterfRelFromMemTable; FPortInterfRels.Add(ptrPortInterfRel); tSQL_PortInterfaceRelation.Next; end; end; } end; end; end; end; procedure TSCSInterface.RefreshPortInterfaces; begin ClearPortInterfaces; LoadPortInterfaces; end; procedure TSCSInterface.RemoveFromAllReferences(AConnectedInterfaces: TSCSinterfaces=nil); var i: Integer; ptrConnectedInterf: TSCSInterface; CurrConnectedInterfaces: TSCSinterfaces; procedure DisJoin(AInterf1, AInterf2: TSCSInterface); var j: Integer; IOfIRel: TSCSIOfIRel; begin if (AInterf1 = nil) or (AInterf2 = nil) then Exit; ///// EXIT ///// if Assigned(AInterf1.IOfIRelOut) then begin j := 0; while j <= AInterf1.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterf1.IOfIRelOut[j]); if IOfIRel.InterfaceTo = AInterf2 then begin //FreeAndNil(IOfIRel); //AInterf1.FreeIOfIRel(IOfIRel); //FreeAndNil(IOfIRel); AInterf1.FreeIOfIRel(IOfIRel, false); //AInterf1.IOfIRelOut.Delete(j); //AInterf1.IOfIRelOut[j] := nil; end else Inc(j); end; //AInterf1.IOfIRelOut.Pack; end; end; begin if Self <> nil then begin CurrConnectedInterfaces := AConnectedInterfaces; if CurrConnectedInterfaces = nil then CurrConnectedInterfaces := Self.FConnectedInterfaces; if Assigned(CurrConnectedInterfaces) then begin while CurrConnectedInterfaces.Count > 0 do begin ptrConnectedInterf := CurrConnectedInterfaces[0]; CurrConnectedInterfaces.Delete(0); if Assigned(ptrConnectedInterf.FConnectedInterfaces) then ptrConnectedInterf.FConnectedInterfaces.Remove(Self); DisJoin(Self, ptrConnectedInterf); DisJoin(ptrConnectedInterf, Self); end; end; end; end; // Tolik 24/04/2020 -- немножко переписано совсем, чтобы сбросить или переопределить подключенные через удаляемый // интерфейс компоненты в описании компонента (табличка внизу ПМ поле "подключен к..." и "кабель") // заодно (если есть подключенный порт с другой стороны на кабеле -- переопределится подключения е для него, // что есть очень гут!) function TSCSInterface.RemoveInterfaceFromPort(AInterface: TSCSInterface): Integer; var SCSComponent, JoinedComponent, ConnectedCompon: TSCSComponent; i, j, ConnID: Integer; CanDropConnectedCompon: Boolean; currInterface, ConnectedInterface: TSCSInterface; ComponList: TSCSList; JoinedInterfList: TSCSInterfaces; begin Result := FPortInterfaces.Remove(AInterface); if Result <> -1 then AInterface.PortOwner := nil; if self.IDConnected <> 0 then // если к порту был приписан подключенный компонент -- нужно переопределить // останется ли подключение begin ConnID := IDConnected; self.IDConnected := 0; SCSComponent := ComponentOwner; if ((SCSComponent <> nil) and (not SCSComponent.ServToDelete)) then begin if Assigned(SCSComponent.ActiveForm) then begin if TF_Main(SCSComponent.ActiveForm).GDBMode = bkProjectManager then begin ComponList := F_ProjMan.GSCSBase.CurrProject.GetListByID(SCSComponent.ListID); if ComponList <> nil then begin ConnectedInterface := ComponList.GetInterfaceByID(ConnID); if ConnectedInterface <> nil then begin ConnectedCompon := ConnectedInterface.ComponentOwner; if ((ConnectedCompon <> nil) and (not ConnectedCompon.ServToDelete)) then begin ConnectedInterface.IDConnected := 0; for i := 0 to SCSComponent.JoinedComponents.Count - 1 do begin JoinedComponent := SCSComponent.JoinedComponents[i]; if JoinedComponent.IsLine = biTrue then begin JoinedComponent.LoadWholeComponent(false); JoinedComponent.DefineFirstLast; TF_Main(F_ProjMan).F_ChoiceConnectSide.DefinePortConnected(JoinedComponent); end; end; end; end; end; end; end; end; end; (* if self.IDConnected <> 0 then // если к порту был приписан подключенный компонент begin if Self.ComponentOwner <> nil then begin SCSComponent := ComponentOwner; if SCSComponent.ServToDelete = False then begin if SCSComponent.IsLine = biFalse then begin if TF_Main(SCSComponent.ActiveForm).GDBMode = bkProjectManager then begin if Self.FPortInterfaces.Count = 0 then Self.IDConnected := 0 // вот по этому признаку определяется подключенный через порт компонент else begin ComponList := F_ProjMan.GSCSBase.CurrProject.GetListByID(SCSComponent.ListID); if ComponList <> nil then begin //SCSComponent := ComponList.GetComponentFromReferences(Self.IDConnected); ConnectedInterface := ComponList.GetInterfaceByID(self.IDConnected); CanDropConnectedCompon := True; if ConnectedInterface <> nil then begin JoinedComponent := ConnectedInterface.ComponentOwner; if JoinedComponent <> nil then begin JoinedInterfList := TSCSInterfaces.Create(false); for i := 0 to JoinedComponent.Interfaces.Count - 1 do begin if JoinedComponent.Interfaces[i].TypeI = itFunctional then if JoinedInterfList.IndexOf(JoinedComponent.Interfaces[i]) = -1 then JoinedInterfList.Add(JoinedComponent.Interfaces[i]); end; for i := 0 to FPortInterfaces.Count - 1 do begin currInterface := TSCSInterface(FPortInterfaces[i]); for j := 0 to JoinedInterfList.Count - 1 do begin //currInterface.FIOfIRelOut.Count CanDropConnectedCompon := False; break; end; if not CanDropConnectedCompon then break; end; end; end; if CanDropConnectedCompon then self.IDConnected := 0; end; end; end; end; end; end; end; *) end; { function TSCSInterface.RemoveInterfaceFromPort(AInterface: TSCSInterface): Integer; begin Result := FPortInterfaces.Remove(AInterface); if Result <> -1 then AInterface.PortOwner := nil; end; } // function TSCSInterface.RemovePortInterfRelByID(AIDPortInterfRel: Integer): Boolean; var i: Integer; ptrPortInterfRel: PPortInterfRel; begin Result := false; for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels[i]; if ptrPortInterfRel.ID = AIDPortInterfRel then begin //FPortInterfaces.Remove(ptrPortInterfRel.Interf); RemoveInterfaceFromPort(ptrPortInterfRel.Interf); FreeMem(ptrPortInterfRel); FPortInterfRels[i] := nil; Result := true; Break; ///// BREAK ///// end; end; FPortInterfRels.Pack; end; function TSCSInterface.RemovePortInterfRelByIDInterfRel(AIDInterfRel: Integer): Boolean; var i: Integer; ptrPortInterfRel: PPortInterfRel; RemIdx: Integer; begin Result := false; if FPortInterfRels <> nil then begin for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels[i]; if ptrPortInterfRel.IDInterfRel = AIDInterfRel then begin RemIdx := FPortInterfaces.Remove(ptrPortInterfRel.Interf); if RemIdx = -1 then // Tolik 20/02/2018 -- интернальные соединения тут тоже учесть нужно ... //EmptyProcedure; begin RemIdx := FInternalConnected.Remove(ptrPortInterfRel.Interf); if RemIdx = -1 then EmptyProcedure; end; // FreeMem(ptrPortInterfRel); FPortInterfRels[i] := nil; Result := true; //26.01.2013 Break; ///// BREAK ///// end; end; FPortInterfRels.Pack; end; end; procedure TSCSInterface.Save; begin SaveData(meEdit); end; procedure TSCSInterface.SaveAsNew; begin SaveData(meMake); //if ieIOfIRel in ASaveElements then // SaveIOfIRels(meMake); //if iePortInterface in ASaveElements then // SavePortInterfRels(meMake); //if ASaveRelations then //begin // SaveIOfIRels(meMake); // SavePortInterfRels(meMake); //end; end; procedure TSCSInterface.SaveData(AMakeEdit: TMakeEdit); var InterfFields: TStringList; begin case FQueryMode of qmPhisical: begin InterfFields := TStringList.Create; try InterfFields.Add('ID_Interface'); InterfFields.Add(fnNpp); InterfFields.Add('TypeI'); InterfFields.Add('Kind'); InterfFields.Add('Gender'); InterfFields.Add('Multiple'); InterfFields.Add('isBusy'); InterfFields.Add('Color'); InterfFields.Add('ValueI'); InterfFields.Add(fnNotice); InterfFields.Add(fnKolvo); InterfFields.Add(fnSignType); InterfFields.Add(fnConnToAnyGender); InterfFields.Add(fnSideSection); if IsLineCompon = biTrue then begin InterfFields.Add('Num_Pair'); //InterfFields.Add('ID_Adverse'); InterfFields.Add('Side'); end else begin InterfFields.Add('IsPort'); InterfFields.Add('IsUser_Port'); InterfFields.Add('Npp_Port'); end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLineCompon = biFalse then InterfFields.Add('ID_Connected'); InterfFields.Add('CoordZ'); end; case AMakeEdit of meMake: begin InterfFields.Add('ID_Component'); //SQLBuilder(FQuery_Operat, qtInsert, tnInterfaceRelation, '', InterfFields, false); //FQuery_Operat.SetParamAsInteger(fnIDComponent, ID_Component); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnInterfaceRelation, '', InterfFields, ''), false); FQOperat.ParamByName(fnIDComponent).AsInteger := ID_Component; end; meEdit: begin InterfFields.Add(fnIDAdverse); //SQLBuilder(FQuery_Operat, qtUpdate, tnInterfaceRelation, fnID+' = :'+fnID, InterfFields, false); //FQuery_Operat.SetParamAsInteger(fnID, ID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnInterfaceRelation, fnID+' = :'+fnID, InterfFields, ''), false); FQOperat.ParamByName(fnID).AsInteger := ID; end; end; //*** Сохранение интерфейсов FQOperat.Close; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDInterface, ID_Interface); FQOperat.ParamByName(fnNpp).AsInteger := Npp; FQOperat.ParamByName(fnTypeI).AsInteger := TypeI; FQOperat.ParamByName(fnKind).AsInteger := Kind; FQOperat.ParamByName(fnGender).AsInteger := Gender; FQOperat.ParamByName(fnMultiple).AsInteger := Multiple; FQOperat.ParamByName(fnisBusy).AsInteger := IsBusy; FQOperat.ParamByName(fnColor).AsInteger := Color; FQOperat.ParamByName(fnValueI).AsFloat := ValueI; FQOperat.ParamByName(fnNotice).AsString := Notice; FQOperat.ParamByName(fnKolvo).AsInteger := Kolvo; FQOperat.ParamByName(fnSignType).AsInteger := SignType; FQOperat.ParamByName(fnConnToAnyGender).AsInteger := ConnToAnyGender; FQOperat.ParamByName(fnSideSection).AsString := SideSection; if IsLineCompon = biTrue then begin FQOperat.ParamByName(fnNumPair).AsInteger := NumPair; if AMakeEdit = meEdit then SetParamAsInteger0AsNullToQuery(FQOperat, fnIDAdverse, Self.IDAdverse); //FQuery_Operat.SetParamAsInteger0AsNull('ID_Adverse', Interf.IDAdverse); FQOperat.ParamByName(fnSide).AsInteger := Side; end else begin FQOperat.ParamByName(fnIsPort).AsInteger := IsPort; FQOperat.ParamByName(fnIsUserPort).AsInteger := IsUserPort; FQOperat.ParamByName(fnNppPort).AsInteger := NppPort; end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLineCompon = biFalse then FQOperat.ParamByName(fnIDConnected).AsInteger := IDConnected; FQOperat.ParamByName(fnCoordZ).AsFloat := CoordZ; end; FQOperat.ExecQuery; FQOperat.Close; if AMakeEdit = meMake then begin NewID := GenIDFromTable(FQSelect, gnInterfaceRelationID, 0); ID := NewID; end; //*** Определить новый ID //FQuery_Select.Close; //FQuery_Select.ExecQuery; //NewID := FQuery_Select.GetFNAsInteger('max_id'); //ID := NewID; finally FreeAndNil(InterfFields); end; end; qmMemory: begin if AMakeEdit = meMake then begin NewID := GenCurrProjTableID(giInterfaceRelationID); ID := NewID; end; { <#MemTableClear#> FMemTable.Filtered := false; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnIDComponent).AsInteger := ID_Component; end; meEdit: if FMemTable.Locate(fnId, ID, []) then FMemTable.Edit; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName('ID_Interface').AsInteger := ID_Interface; FMemTable.FieldByName(fnNpp).AsInteger := Npp; FMemTable.FieldByName('TypeI').AsInteger := TypeI; FMemTable.FieldByName('Kind').AsInteger := Kind; FMemTable.FieldByName('Gender').AsInteger := Gender; FMemTable.FieldByName('Multiple').AsInteger := Multiple; FMemTable.FieldByName('isBusy').AsInteger := IsBusy; FMemTable.FieldByName('Color').AsInteger := Color; FMemTable.FieldByName('ValueI').AsFloat := ValueI; FMemTable.FieldByName(fnNotice).AsString := Notice; if IsLineCompon = biTrue then begin FMemTable.FieldByName('Num_Pair').AsInteger := NumPair; FMemTable.FieldByName('ID_Adverse').AsInteger := IDAdverse; FMemTable.FieldByName('Side').AsInteger := Side; end else begin FMemTable.FieldByName('IsPort').AsInteger := IsPort; FMemTable.FieldByName('IsUser_Port').AsInteger := IsUserPort; FMemTable.FieldByName('Npp_Port').AsInteger := NppPort; end; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin if IsLineCompon = biFalse then FMemTable.FieldByName('ID_Connected').AsInteger := IDConnected; FMemTable.FieldByName('CoordZ').AsFloat := CoordZ; end; FMemTable.FieldByName(fnGuidInterface).AsString := GUIDInterface; FMemTable.Post; //*** Определить новый ID if AMakeEdit = meMake then begin NewID := FMemTable.FieldByName(fnID).AsInteger; ID := NewID; end; end; } end; end; end; procedure TSCSInterface.SaveIOfIRel(AMakeEdit: TMakeEdit; AIOfIRel: TSCSIOfIRel); var i: Integer; begin case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQOperat, ' insert into interfofinterf_relation(id_interf_rel, id_interf_to, id_comp_rel) '+ ' values(:id_interf_rel, :id_interf_to, :id_comp_rel) ', false); //ChangeSQLQuery(FQuery_Select, ' select MAX(ID) As max_id from interfofinterf_relation '); FQOperat.Close; FQOperat.ParamByName('id_interf_rel').AsInteger := AIOfIRel.IDInterfRel; FQOperat.ParamByName('id_interf_to').AsInteger := AIOfIRel.IDInterfTo; //FQuery_Operat.SetParamAsInteger('id_comp_rel', GetNewCompRelID(IOfIRel.IDCompRel)); FQOperat.ParamByName('id_comp_rel').AsInteger := AIOfIRel.IDCompRel; FQOperat.ExecQuery; ////*** Определить новый ID //FQuery_Select.Close; //FQuery_Select.ExecQuery; if AMakeEdit = meMake then begin AIOfIRel.NewID := GenIDFromTable(FQSelect, gnInterfOfInterfRelationID, 0); //FQuery_Select.GetFNAsInteger('max_id'); AIOfIRel.ID := AIOfIRel.NewID; end; end; qmMemory: if AMakeEdit = meMake then begin AIOfIRel.NewID := GenCurrProjTableID(giInterfOfInterfRelationID); AIOfIRel.ID := AIOfIRel.NewID; end; {<#MemTableClear#> with TF_Main(ActiveForm).DM do begin tSQL_InterfOfInterfRelation.Append; tSQL_InterfOfInterfRelation.FieldByName('id_interf_rel').AsInteger := AIOfIRel.IDInterfRel; tSQL_InterfOfInterfRelation.FieldByName('id_interf_to').AsInteger := AIOfIRel.IDInterfTo; //tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger := GetNewCompRelID(IOfIRel.IDCompRel); tSQL_InterfOfInterfRelation.FieldByName('id_comp_rel').AsInteger := AIOfIRel.IDCompRel; tSQL_InterfOfInterfRelation.Post; //*** Определить новый ID if AMakeEdit = meMake then begin AIOfIRel.NewID := tSQL_InterfOfInterfRelation.FieldByName(fnID).AsInteger; AIOfIRel.ID := AIOfIRel.NewID; end; end;} end; end; procedure TSCSInterface.SaveIOfIRels(AMakeEdit: TMakeEdit); var i: Integer; IOfIRel: TSCSIOfIRel; begin for i := 0 to FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(FIOfIRelOut[i]); IOfIRel.IDInterfRel := ID; SaveIOfIRel(AMakeEdit, IOfIRel); end; end; procedure TSCSInterface.SavePortInterfRel(AMakeEdit: TMakeEdit; APortInterfRel: PPortInterfRel); var PortInterfFields: TStringList; begin case FQueryMode of qmPhisical: begin PortInterfFields := TStringList.Create; PortInterfFields.Add(fnRelType); PortInterfFields.Add(fnIDPort); PortInterfFields.Add(fnIDInterfRel); PortInterfFields.Add(fnUnitInterfKolvo); case AMakeEdit of meMake: //SQLBuilder(FQuery_Operat, qtInsert, tnPortInterfaceRelation, '', PortInterfFields, false); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnPortInterfaceRelation, '', PortInterfFields, ''), false); meEdit: //SQLBuilder(FQuery_Operat, qtUpdate, tnPortInterfaceRelation, 'id = :id', PortInterfFields, false); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnPortInterfaceRelation, 'id = :id', PortInterfFields, ''), false); end; FQOperat.Close; if AMakeEdit = meEdit then FQOperat.ParamByName(fnID).AsInteger := APortInterfRel.ID; FQOperat.ParamByName(fnRelType).AsInteger := APortInterfRel.RelType; FQOperat.ParamByName(fnIDPort).AsInteger := APortInterfRel.IDPort; FQOperat.ParamByName(fnIDInterfRel).AsInteger := APortInterfRel.IDInterfRel; FQOperat.ParamByName(fnUnitInterfKolvo).AsInteger := APortInterfRel.UnitInterfKolvo; FQOperat.ExecQuery; if AMakeEdit = meMake then begin APortInterfRel.NewID := GenIDFromTable(FQSelect, gnPortInterfaceRelationID, 0); APortInterfRel.ID := APortInterfRel.NewID; end; PortInterfFields.Free; end; qmMemory: if AMakeEdit = meMake then begin APortInterfRel.NewID := GenCurrProjTableID(giPortInterfaceRelationID); APortInterfRel.ID := APortInterfRel.NewID; end; {<#MemTableClear#> with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: begin tSQL_PortInterfaceRelation.Append; 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; end;} end; end; procedure TSCSInterface.SavePortInterfRels(AMakeEdit: TMakeEdit); var i: Integer; ptrPortInterfRel: PPortInterfRel; begin for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels[i]; ptrPortInterfRel.IDPort := ID; SavePortInterfRel(AMakeEdit, ptrPortInterfRel); end; end; procedure TSCSInterface.SavePortInterfRelsByServFields; var i: Integer; ptrPortInterfRel: PPortInterfRel; begin for i := 0 to FPortInterfRels.Count - 1 do begin ptrPortInterfRel := FPortInterfRels[i]; ptrPortInterfRel.IDPort := ID; if ptrPortInterfRel.IsNew then SavePortInterfRel(meMake, ptrPortInterfRel) else if ptrPortInterfRel.IsModified then SavePortInterfRel(meEdit, ptrPortInterfRel); end; end; { TSCSIOfIRel } procedure TSCSIOfIRel.Assign(AIOfIRel: TSCSIOfIRel); begin AssignOnlyIOfIRel(AIOfIRel); AssignPosConnections(AIOfIRel.FPosConnections); end; procedure TSCSIOfIRel.AssignOnlyIOfIRel(AIOfIRel: TSCSIOfIRel); begin ID := AIOfIRel.ID; NewID := AIOfIRel.NewID; IDInterfRel := AIOfIRel.IDInterfRel; IDInterfTo := AIOfIRel.IDInterfTo; IDCompRel := AIOfIRel.IDCompRel; IDIOFIRelMain := AIOfIRel.IDIOFIRelMain; //*** Service fileds NewIDInterfRel := AIOfIRel.NewIDInterfRel; NewIDInterfTo := AIOfIRel.NewIDInterfTo; //*** Служебные данные для IDCompRel NewIDCompon := AIOfIRel.NewIDCompon; NewIDChild := AIOfIRel.NewIDChild; end; procedure TSCSIOfIRel.AssignPosConnections(APosConnections: TObjectList); var i: Integer; NewInterfPosConnection: TSCSInterfPosConnection; begin FPosConnections.Clear; for i := 0 to APosConnections.Count - 1 do begin NewInterfPosConnection := TSCSInterfPosConnection.Create(Self, true); if FInterfaceOwner <> nil then NewInterfPosConnection.FSelfInterfPosition.InterfOwner := FInterfaceOwner; NewInterfPosConnection.Assign(TSCSInterfPosConnection(APosConnections[i])); FPosConnections.Add(NewInterfPosConnection); end; end; procedure TSCSIOfIRel.Clear; begin FPosConnections.Clear; FCompRel := nil; ID := 0; NewID := 0; IDInterfRel := 0; IDInterfTo := 0; IDCompRel := 0; IDIOFIRelMain := 0; FInterfaceOwner := nil; FInterfaceTo := nil; //*** Service fileds NewIDInterfRel := 0; NewIDInterfTo := 0; //*** Служебные данные для IDCompRel NewIDCompon := 0; NewIDChild := 0; end; constructor TSCSIOfIRel.Create(AInterfaceOwner: TSCSInterface); begin inherited Create; FPosConnections := TObjectList.Create(true); Clear; FInterfaceOwner := AInterfaceOwner; end; destructor TSCSIOfIRel.Destroy; begin try Clear; FreeAndNil(FPosConnections); except end; inherited; end; { TSCSInterfPosConnection } procedure TSCSInterfPosConnection.Assign( AInterfPosConnection: TSCSInterfPosConnection); begin ID := AInterfPosConnection.ID; IDIOIRel := AInterfPosConnection.IDIOIRel; if (FSelfInterfPosition = nil) and (AInterfPosConnection.FSelfInterfPosition <> nil) then FSelfInterfPosition := GetNewInterfPosition; FSelfInterfPosition.FromPos := AInterfPosConnection.FSelfInterfPosition.FromPos; FSelfInterfPosition.ToPos := AInterfPosConnection.FSelfInterfPosition.ToPos; if (FConnInterfPosition = nil) and (AInterfPosConnection.FConnInterfPosition <> nil) then FConnInterfPosition := GetNewInterfPosition; FConnInterfPosition.FromPos := AInterfPosConnection.FConnInterfPosition.FromPos; FConnInterfPosition.ToPos := AInterfPosConnection.FConnInterfPosition.ToPos; end; constructor TSCSInterfPosConnection.Create(AOwner: TSCSIOfIRel; ACreatePositions: Boolean); begin inherited Create; FOwner := AOwner; FSelfInterfPosition := nil; FConnInterfPosition := nil; if ACreatePositions then begin FSelfInterfPosition := GetNewInterfPosition; FConnInterfPosition := GetNewInterfPosition; end; end; destructor TSCSInterfPosConnection.Destroy; begin try if FSelfInterfPosition <> nil then begin if FSelfInterfPosition.InterfOwner <> nil then FSelfInterfPosition.InterfOwner.FBusyPositions.Remove(FSelfInterfPosition); FreeAndNil(FSelfInterfPosition); end; if FConnInterfPosition <> nil then begin if FConnInterfPosition.InterfOwner <> nil then FConnInterfPosition.InterfOwner.FBusyPositions.Remove(FConnInterfPosition); FreeAndNil(FConnInterfPosition); end; except end; inherited; end; function TSCSInterfPosConnection.GetNewInterfPosition: TSCSInterfPosition; begin //GetZeroMem(Result, SizeOf(TInterfPosition)); Result := TSCSInterfPosition.Create(nil); Result.InterfPosConnectionOwner := Self; Result.InterfOwner := nil; //if (Self.FOwner <> nil) and (Self.FOwner.FInterfaceOwner <> nil) then // Result.InterfOwner := Self.FOwner.FInterfaceOwner end; { TSCSInterfPositions } procedure TSCSInterfPositions.Assign(ASrc: TSCSInterfPositions; AWithInterOwner: Boolean); var i: integer; NewPosition, SrcPosition: TSCSInterfPosition; InterfOwner: TSCSInterface; begin Clear; FKolvo := ASrc.FKolvo; for i := 0 to ASrc.FPositions.Count - 1 do begin SrcPosition := TSCSInterfPosition(ASrc.FPositions[i]); InterfOwner := nil; if AWithInterOwner then InterfOwner := SrcPosition.FInterfOwner; NewPosition := TSCSInterfPosition.Create(InterfOwner); NewPosition.FFromPos := SrcPosition.FFromPos; NewPosition.FToPos := SrcPosition.FToPos; FPositions.Add(NewPosition); end; end; procedure TSCSInterfPositions.Clear; begin FPositions.OwnsObjects := true; try FPositions.Clear; finally FPositions.OwnsObjects := false; FKolvo := 0; end; end; constructor TSCSInterfPositions.Create; begin inherited; FKolvo := 0; FPositions := TObjectList.Create(false); end; procedure TSCSInterfPositions.DefineKolvo; var i: integer; Position: TSCSInterfPosition; begin FKolvo := 0; for i := 0 to FPositions.Count - 1 do begin Position := TSCSInterfPosition(FPositions[i]); FKolvo := FKolvo + (Position.ToPos - (Position.FromPos - 1)); end; end; destructor TSCSInterfPositions.Destroy; begin FPositions.OwnsObjects := true; FreeAndNil(FPositions); inherited; end; procedure TSCSInterfPositions.ZeroPositions; var i: integer; Position: TSCSInterfPosition; begin for i := 0 to FPositions.Count - 1 do begin Position := TSCSInterfPosition(FPositions[i]); Position.FFromPos := 0; Position.FToPos := 0; end; end; { TSCSInterfPosition } constructor TSCSInterfPosition.Create(AInterfOwner: TSCSInterface); begin inherited create; FFromPos := -1; FToPos := -1; FInterfOwner := AInterfOwner; FInterfPosConnectionOwner := nil; end; destructor TSCSInterfPosition.destroy; // Toilk 12/12/2019 -- begin FInterfOwner := nil; FInterfPosConnectionOwner := nil; inherited; end; function TSCSInterfPosition.GetConnectedPos: TSCSInterfPosition; begin Result := nil; if FInterfPosConnectionOwner <> nil then begin if FInterfPosConnectionOwner.SelfInterfPosition = Self then Result := FInterfPosConnectionOwner.ConnInterfPosition else Result := FInterfPosConnectionOwner.SelfInterfPosition; end; end; { TSCSCrossConnection } procedure TSCSCrossConnection.Assign(ACrossConnection: TSCSCrossConnection); begin ID := ACrossConnection.ID; IDComponent := ACrossConnection.IDComponent; IDCompRelFrom := ACrossConnection.IDCompRelFrom; IDCompRelTo := ACrossConnection.IDCompRelTo; IDCompRelWith := ACrossConnection.IDCompRelWith; OldIDCompRelFrom := ACrossConnection.OldIDCompRelFrom; OldIDCompRelTo := ACrossConnection.OldIDCompRelTo; OldIDCompRelWith := ACrossConnection.OldIDCompRelWith; IDComponFrom := ACrossConnection.IDComponFrom; IDComponTo := ACrossConnection.IDComponTo; IDComponWith := ACrossConnection.IDComponWith; NppFrom := ACrossConnection.NppFrom; NppTo := ACrossConnection.NppTo; NppWith := ACrossConnection.NppWith; NameFrom := ACrossConnection.NameFrom; NameTo := ACrossConnection.NameTo; NameWith := ACrossConnection.NameWith; FCompRelFromPath.Assign(ACrossConnection.FCompRelFromPath, laCopy); FCompRelToPath.Assign(ACrossConnection.FCompRelToPath, laCopy); FCompRelWithPath.Assign(ACrossConnection.FCompRelWithPath, laCopy); end; constructor TSCSCrossConnection.Create(AActiveForm: TForm); begin inherited Create(AActiveForm); ID := 0; IDComponent := 0; IDCompRelFrom := 0; IDCompRelTo := 0; IDCompRelWith := 0; OldIDCompRelFrom := 0; OldIDCompRelTo := 0; OldIDCompRelWith := 0; NppFrom := 0; NppTo := 0; NppWith := 0; NameFrom := ''; NameTo := ''; NameWith := ''; FCompRelFromPath := TIntList.Create; FCompRelToPath := TIntList.Create; FCompRelWithPath := TIntList.Create; end; destructor TSCSCrossConnection.Destroy; begin FreeAndNil(FCompRelFromPath); FreeAndNil(FCompRelToPath); FreeAndNil(FCompRelWithPath); inherited; end; procedure TSCSCrossConnection.LoadFromQuery(AQuery: TpFIBQuery); begin ID := AQuery.FN(fnID).AsInteger; IDComponent := AQuery.FN(fnIDComponent).AsInteger; IDCompRelFrom := AQuery.FN(fnIDCompRelFrom).AsInteger; IDCompRelTo := AQuery.FN(fnIDCompRelTo).AsInteger; IDCompRelWith := AQuery.FN(fnIDCompRelWith).AsInteger; NppFrom := AQuery.FN(fnNppFrom).AsInteger; NppTo := AQuery.FN(fnNppTo).AsInteger; NppWith := AQuery.FN(fnNppWith).AsInteger; end; procedure TSCSCrossConnection.Save(AMakeEdit: TMakeEdit; ASavePaths: Boolean); var FieldNames: TStringList; begin try 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 SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnCrossConnection, '', FieldNames, ''), false); end; meEdit: begin FieldNames.Add(fnID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCrossConnection, 'id = :id', FieldNames, ''), false); FQOperat.ParamByName(fnID).AsInteger := Self.ID; end; end; FQOperat.ParamByName(fnIDComponent).AsInteger := Self.IDComponent; //FQOperat.ParamByName(fnIDCompRelFrom).AsInteger := Self.IDCompRelFrom; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCompRelFrom, Self.IDCompRelFrom); //FQOperat.ParamByName(fnIDCompRelTo).AsInteger := Self.IDCompRelTo; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCompRelTo, Self.IDCompRelTo); SetParamAsInteger0AsNullToQuery(FQOperat, fnIDCompRelWith, Self.IDCompRelWith); FQOperat.ParamByName(fnNppFrom).AsInteger := Self.NppFrom; FQOperat.ParamByName(fnNppTo).AsInteger := Self.NppTo; FQOperat.ParamByName(fnNppWith).AsInteger := Self.NppWith; FQOperat.ExecQuery; if AMakeEdit = meMake then Self.ID := GenIDFromTable(FQSelect, gnCrossConnectionID, 0); if ASavePaths then SavePaths; finally FieldNames.Free; end; except on E: Exception do AddExceptionToLogEx('TSCSCrossConnection.Save', E.Message); end; end; procedure TSCSCrossConnection.SavePaths; var FieldNames: TStringList; procedure SavePath(AIDPath: TIntList; AType: Integer); var i: Integer; begin for i := 0 to AIDPath.Count - 1 do begin FQOperat.Close; FQOperat.ParamByName(fnIDCrossConnection).AsInteger := ID; FQOperat.ParamByName(fnIDCompRel).AsInteger := AIDPath[i]; FQOperat.ParamByName(fnPathType).AsInteger := AType; FQOperat.ExecQuery; end; end; begin if (ID > 0) then begin //*** Удалить все пути для даного соединения SetSQLToFIBQuery(FQOperat, 'delete from '+tnCrossConnectionPath+ ' where '+fnIDCrossConnection+' = '''+IntToStr(ID)+''''); if (FCompRelFromPath.Count > 0) or (FCompRelToPath.Count > 0) or (FCompRelWithPath.Count > 0) then begin FieldNames := TStringlist.Create; FieldNames.Add(fnIDCrossConnection); FieldNames.Add(fnIDCompRel); FieldNames.Add(fnPathType); //*** Запрос для вставки новых элементов пути SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnCrossConnectionPath, '', FieldNames, ''), false); SavePath(FCompRelFromPath, ptFrom); SavePath(FCompRelToPath, ptTo); SavePath(FCompRelWithPath, ptWith); FQOperat.Close; FieldNames.Free; end; end; end; { TSCSCatalog } // ####################### Класс TSCSCatalog #################################### // ############################################################################# // procedure TSCSCatalog.LoadFromMemTable(AStringsMan: TStringsMan); var StreamSize: Integer; Stream: TMemoryStream; FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Katalog; Self.ID := FMemTable.Fields[fiKatalog_ID].AsInteger; Self.ParentID := FMemTable.Fields[fiKatalog_ParentID].AsInteger; Self.KolCompon := FMemTable.Fields[fiKatalog_KolCompon].AsInteger; Self.ItemType := FMemTable.Fields[fiKatalog_IDItemType].AsInteger; Self.ItemsCount := FMemTable.Fields[fiKatalog_ItemsCount].AsInteger; if fiKatalog_PropsCount <> -1 then Self.PropsCount := FMemTable.Fields[fiKatalog_PropsCount].AsInteger; //07.11.2013 if fiKatalog_NormsCount <> -1 then Self.NormsCount := FMemTable.Fields[fiKatalog_NormsCount].AsInteger; if fiKatalog_NormsCount <> -1 then Self.ResourcesCount := FMemTable.Fields[fiKatalog_ResourcesCount].AsInteger; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //ProjectID := FMemTable.FieldByName('Project_id').AsInteger; if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.Name := FMemTable.Fields[fiKatalog_Name].AsString; Self.NameShort := FMemTable.Fields[fiKatalog_NameShort].AsString; end else begin Self.Name := AStringsMan.GetStrByID(FMemTable.Fields[fiKatalog_Name].AsInteger, AStringsMan.FCataogNameStrings); Self.NameShort := AStringsMan.GetStrByID(FMemTable.Fields[fiKatalog_NameShort].AsInteger, AStringsMan.FCataogNameShortStrings); end; if Self.ItemType = itRoom then if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithRoomNameShort then Self.NameShort := ''; Self.ListID := FMemTable.Fields[fiKatalog_ListID].AsInteger; Self.NameMark := FMemTable.Fields[fiKatalog_NameMark].AsString; Self.MarkID := FMemTable.Fields[fiKatalog_MarkID].AsInteger; Self.IsUserName := FMemTable.Fields[fiKatalog_IsUserName].AsInteger; Self.SCSID := FMemTable.Fields[fiKatalog_ScsID].AsInteger; if fiKatalog_IsIndexWithName <> -1 then Self.IsIndexWithName := FMemTable.Fields[fiKatalog_IsIndexWithName].AsInteger; Self.IndexPointObj := FMemTable.Fields[fiKatalog_IndexConn].AsInteger; Self.IndexLine := FMemTable.Fields[fiKatalog_IndexLine].AsInteger; Self.IndexConnector := FMemTable.Fields[fiKatalog_IndexJoiner].AsInteger; if Self.ItemType = itRoom then begin CreateRoomSetting; Stream := TMemoryStream.Create; Stream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).SaveToStream(Stream); Stream.Position := 0; StreamSize := Stream.Size; if StreamSize <= sizeof(TRoomSettingRecord) then begin Stream.Position := 0; Stream.ReadBuffer(Self.FRoomSetting^, StreamSize); end; FreeAndNil(Stream); end; end else begin Self.Name := FMemTable.Fields[fiKatalog_Name].AsString; end; Self.SortID := FMemTable.Fields[fiKatalog_SortID].AsInteger; end; { ID := FMemTable.FieldByName('id').AsInteger; ParentID := FMemTable.FieldByName('parent_id').AsInteger; Name := FMemTable.FieldByName('Name').AsString; KolCompon := FMemTable.FieldByName('kol_compon').AsInteger; ItemType := FMemTable.FieldByName('id_item_type').AsInteger; ItemsCount := FMemTable.FieldByName('items_count').AsInteger; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //ProjectID := FMemTable.FieldByName('Project_id').AsInteger; ListID := FMemTable.FieldByName('List_id').AsInteger; NameShort := FMemTable.FieldByName('Name_Short').AsString; NameMark := FMemTable.FieldByName('Name_Mark').AsString; MarkID := FMemTable.FieldByName('Mark_id').AsInteger; IsUserName := FMemTable.FieldByName('IsUser_Name').AsInteger; SCSID := FMemTable.FieldByName('scs_id').AsInteger; IndexPointObj := FMemTable.FieldByName('Index_conn').AsInteger; IndexLine := FMemTable.FieldByName('Index_line').AsInteger; IndexConnector := FMemTable.FieldByName('Index_joiner').AsInteger; end; SortID := FMemTable.FieldByName('sort_id').AsInteger; } except on E: Exception do AddExceptionToLog('TSCSCatalog.LoadFromMemTable: '+E.Message); end; end; procedure TSCSCatalog.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); var Stream: TMemoryStream; //RoomSettingRecord: TRoomSettingRecord; FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Katalog; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.Fields[fiKatalog_ID].AsInteger := Self.ID; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, Self.ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.Fields[fiKatalog_ParentID].AsInteger := Self.ParentID; FMemTable.Fields[fiKatalog_Name].AsInteger := AStringsMan.GenStrID(Self.Name, AStringsMan.FCataogNameStrings); FMemTable.Fields[fiKatalog_SortID].AsInteger := Self.SortID; FMemTable.Fields[fiKatalog_kolCompon].AsInteger := Self.KolCompon; FMemTable.Fields[fiKatalog_ItemsCount].AsInteger := Self.ItemsCount; FMemTable.Fields[fiKatalog_PropsCount].AsInteger := Self.PropsCount; //07.11.2013 FMemTable.Fields[fiKatalog_NormsCount].AsInteger := Self.NormsCount; FMemTable.Fields[fiKatalog_ResourcesCount].AsInteger := Self.ResourcesCount; FMemTable.Fields[fiKatalog_ListID].AsInteger := Self.ListID; FMemTable.Fields[fiKatalog_NameShort].AsInteger := AStringsMan.GenStrID(Self.NameShort, AStringsMan.FCataogNameShortStrings); FMemTable.Fields[fiKatalog_NameMark].AsString := Self.NameMark; FMemTable.Fields[fiKatalog_IsUserName].AsInteger := Self.IsUserName; FMemTable.Fields[fiKatalog_MarkID].AsInteger := Self.MarkID; FMemTable.Fields[fiKatalog_IDItemType].AsInteger := Self.ItemType; FMemTable.Fields[fiKatalog_ScsID].AsInteger := Self.SCSID; FMemTable.Fields[fiKatalog_IsIndexWithName].AsInteger := Self.IsIndexWithName; FMemTable.Fields[fiKatalog_IndexConn].AsInteger := Self.IndexPointObj; FMemTable.Fields[fiKatalog_IndexLine].AsInteger := Self.IndexLine; FMemTable.Fields[fiKatalog_IndexJoiner].AsInteger := Self.IndexConnector; if Self.ItemType = itRoom then if Self.FRoomSetting <> nil then begin //RoomSettingRecord := Self.FRoomSetting^; Stream := TMemoryStream.Create; Stream.Position := 0; Stream.WriteBuffer(Self.FRoomSetting^, SizeOf(TRoomSettingRecord)); Stream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).LoadFromStream(Stream); FreeAndNil(Stream); end; FMemTable.Post; end; end; {with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Katalog; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.Fields[fiKatalog_ID].AsInteger := Self.ID; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, Self.ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.Fields[fiKatalog_ParentID].AsInteger := Self.ParentID; FMemTable.Fields[fiKatalog_Name].AsString := Self.Name; FMemTable.Fields[fiKatalog_SortID].AsInteger := Self.SortID; FMemTable.Fields[fiKatalog_kolCompon].AsInteger := Self.KolCompon; FMemTable.Fields[fiKatalog_ItemsCount].AsInteger := Self.ItemsCount; FMemTable.Fields[fiKatalog_PropsCount].AsInteger := Self.PropsCount; FMemTable.Fields[fiKatalog_ListID].AsInteger := Self.ListID; FMemTable.Fields[fiKatalog_NameShort].AsString := Self.NameShort; FMemTable.Fields[fiKatalog_NameMark].AsString := Self.NameMark; FMemTable.Fields[fiKatalog_IsUserName].AsInteger := Self.IsUserName; FMemTable.Fields[fiKatalog_MarkID].AsInteger := Self.MarkID; FMemTable.Fields[fiKatalog_IDItemType].AsInteger := Self.ItemType; FMemTable.Fields[fiKatalog_ScsID].AsInteger := Self.SCSID; FMemTable.Fields[fiKatalog_IndexConn].AsInteger := Self.IndexPointObj; FMemTable.Fields[fiKatalog_IndexLine].AsInteger := Self.IndexLine; FMemTable.Fields[fiKatalog_IndexJoiner].AsInteger := Self.IndexConnector; if Self.ItemType = itRoom then if Self.FRoomSetting <> nil then begin //RoomSettingRecord := Self.FRoomSetting^; Stream := TMemoryStream.Create; Stream.Position := 0; Stream.WriteBuffer(Self.FRoomSetting^, SizeOf(TRoomSettingRecord)); Stream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).LoadFromStream(Stream); FreeAndNil(Stream); end; FMemTable.Post; end; end; } { case AMakeEdit of ] meMake: begin FMemTable.Append; FMemTable.FieldByName(fnID).AsInteger := ID; end; meEdit: begin //SetFilterToSQLMemTable(FMemTable, 'id = '''+IntToStr(ID)+''''); FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName(fnParentID).AsInteger := ParentID; FMemTable.FieldByName('NAME').AsString := Name; FMemTable.FieldByName('SORT_ID').AsInteger := SortID; FMemTable.FieldByName('KOL_COMPON').AsInteger := KolCompon; FMemTable.FieldByName('ITEMS_COUNT').AsInteger := ItemsCount; //FMemTable.FieldByName('PROJECT_ID').AsInteger := ProjectID; FMemTable.FieldByName('LIST_ID').AsInteger := ListID; FMemTable.FieldByName('NAME_SHORT').AsString := NameShort; FMemTable.FieldByName('NAME_MARK').AsString := NameMark; FMemTable.FieldByName('ISUSER_NAME').AsInteger := IsUserName; FMemTable.FieldByName('MARK_ID').AsInteger := MarkID; FMemTable.FieldByName('ID_ITEM_TYPE').AsInteger := ItemType; FMemTable.FieldByName('SCS_ID').AsInteger := SCSID; FMemTable.FieldByName('INDEX_CONN').AsInteger := IndexPointObj; FMemTable.FieldByName('INDEX_LINE').AsInteger := IndexLine; FMemTable.FieldByName('INDEX_JOINER').AsInteger := IndexConnector; FMemTable.Post; end; } except on E: Exception do AddExceptionToLog('TSCSCatalog.SaveToMemTable: '+E.Message); end; end; function TSCSCatalog.GetFIsLine: Integer; begin Result := biNone; case ItemType of itSCSLine: Result := biTrue; itSCSConnector: Result := biFalse; end; end; //07.11.2013 //procedure TSCSCatalog.SetFID(Value: Integer); //begin // FID := Value; // NormsResources.IDMaster := FID; //end; procedure TSCSCatalog.SetFIsDeleting(Value: Boolean); var i: Integer; begin FIsDeleting := Value; for i := 0 to FChildCatalogs.Count - 1 do FChildCatalogs[i].IsDeleting := Value; end; procedure TSCSCatalog.SetFLength(Value: Double); var i: Integer; begin FLength := Value; NormsResources.Length := FLength; if FComponentReferences.Count > 0 then // Tolik 24/12/2019 -- for i := 0 to FComponentReferences.Count - 1 do FComponentReferences[i].FNormsResources.Length := Value; end; procedure TSCSCatalog.SetFParent(Value: TBasicSCSClass); var i: Integer; SCSComponent: TSCSComponent; ChildCatalog: TSCSCatalog; begin if Assigned(FParent) then begin for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then TSCSCatalog(FParent).RemoveComponentFromReferences(SCSComponent); end; for i := 0 to FChildCatalogReferences.Count - 1 do begin ChildCatalog := FChildCatalogReferences[i]; if Assigned(ChildCatalog) then TSCSCatalog(FParent).RemoveChildFromReferences(ChildCatalog); end; TSCSCatalog(FParent).RemoveChildFromReferences(Self); end; FParent := Value; if Assigned(FParent) then begin TSCSCatalog(FParent).AddChildToReferences(Self); for i := 0 to FChildCatalogReferences.Count - 1 do begin ChildCatalog := FChildCatalogReferences[i]; if Assigned(ChildCatalog) then TSCSCatalog(FParent).AddChildToReferences(ChildCatalog); end; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then TSCSCatalog(FParent).AddComponentToReferences(SCSComponent); end; end; end; procedure TSCSCatalog.SetFTreeViewNode(Value: TTreeNode); begin if Assigned(Value) then begin if Value.Data <> nil then if PObjectData(Value.Data).ItemType = ItemType then if PObjectData(Value.Data).ObjectID = ID then FTreeViewNode := Value; end else FTreeViewNode := nil; end; procedure TSCSCatalog.AddChildToReferences(ASCSCatalog: TSCSCatalog; ACanDefineProjectOwner: Boolean = true); begin if ASCSCatalog <> nil then begin if (Self is TSCSProject) and ACanDefineProjectOwner then ASCSCatalog.FProjectOwner := TSCSProject(Self); FChildCatalogReferences.Add(ASCSCatalog); //if Self is TSCSCatalogExtended then //begin // TSCSCatalogExtended(Self).FCatalogRefSortedByID.Insert(ASCSCatalog, @ASCSCatalog.ID); // TSCSCatalogExtended(Self).FCatalogRefSortedBySCSID.Insert(ASCSCatalog, @ASCSCatalog.SCSID); //end; if Assigned(FParent) then TSCSCatalog(FParent).AddChildToReferences(ASCSCatalog); end; end; procedure TSCSCatalog.RemoveChildFromReferences(ASCSCatalog: TSCSCatalog); begin if ASCSCatalog <> nil then begin if Assigned(FParent) then TSCSCatalog(FParent).RemoveChildFromReferences(ASCSCatalog); //if Self is TSCSCatalogExtended then //begin // TSCSCatalogExtended(Self).FCatalogRefSortedByID.Remove(ASCSCatalog.ID); // TSCSCatalogExtended(Self).FCatalogRefSortedBySCSID.Remove(ASCSCatalog.SCSID); //end; FChildCatalogReferences.Remove(ASCSCatalog); if ASCSCatalog.FProjectOwner = Self then ASCSCatalog.FProjectOwner := nil; end; end; procedure TSCSCatalog.AddComponentToReferences(ASCSComponent: TSCSComponent; ACanDefineProjectOwner: Boolean = true); begin if ASCSComponent <> nil then begin if (Self is TSCSProject) and ACanDefineProjectOwner then ASCSComponent.FProjectOwner := TSCSProject(Self); FComponentReferences.Add(ASCSComponent); //if Self is TSCSCatalogExtended then // TSCSCatalogExtended(Self).FComponRefSortedByID.Insert(ASCSComponent, @ASCSComponent.ID); if Assigned(FParent) then TSCSCatalog(FParent).AddComponentToReferences(ASCSComponent); end; end; procedure TSCSCatalog.RemoveComponentFromReferences(ASCSComponent: TSCSComponent); begin if ASCSComponent <> nil then begin if Assigned(FParent) then TSCSCatalog(FParent).RemoveComponentFromReferences(ASCSComponent); //if Self is TSCSCatalogExtended then // TSCSCatalogExtended(Self).FComponRefSortedByID.Remove(ASCSComponent.ID); FComponentReferences.Remove(ASCSComponent); if ASCSComponent.FProjectOwner = Self then ASCSComponent.FProjectOwner := nil; end; end; procedure TSCSCatalog.SaveData(AMakeEdit: TMakeEdit); var CatalogFields: TStringList; begin try case FQueryMode of qmPhisical: begin try //DefineQuery; CatalogFields := TStringList.Create; CatalogFields.Add('NAME'); CatalogFields.Add('SORT_ID'); CatalogFields.Add('KOL_COMPON'); CatalogFields.Add('ITEMS_COUNT'); CatalogFields.Add('ID_ITEM_TYPE'); if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //CatalogFields.Add('PROJECT_ID'); CatalogFields.Add('LIST_ID'); CatalogFields.Add('NAME_SHORT'); CatalogFields.Add('NAME_MARK'); CatalogFields.Add('MARK_ID'); CatalogFields.Add('ISUSER_NAME'); CatalogFields.Add('SCS_ID'); CatalogFields.Add('INDEX_CONN'); CatalogFields.Add('INDEX_LINE'); CatalogFields.Add('INDEX_JOINER'); CatalogFields.Add(fnIsIndexWithName); end; case AMakeEdit of meMake: begin CatalogFields.Add('PARENT_ID'); //SQLBuilder(FQuery_Operat, qtInsert, FTableName, '', CatalogFields, false); //FQuery_Operat.SetParamAsInteger('PARENT_ID', ParentID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnCatalog, '', CatalogFields, ''), false); FQOperat.ParamByName('PARENT_ID').AsInteger := ParentID; end; meEdit: begin //SQLBuilder(FQuery_Operat, qtUpdate, FTableName, 'id = :id', CatalogFields, false); //FQuery_Operat.SetParamAsInteger('id', ID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCatalog, 'id = :id', CatalogFields, ''), false); FQOperat.ParamByName(fnId).AsInteger := ID; end; end; FQOperat.ParamByName('NAME').AsString := Name; FQOperat.ParamByName('SORT_ID').AsInteger := SortID; FQOperat.ParamByName('KOL_COMPON').AsInteger := KolCompon; FQOperat.ParamByName('ITEMS_COUNT').AsInteger := ItemsCount; FQOperat.ParamByName('ID_ITEM_TYPE').AsInteger := ItemType; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //FQuery_Operat.ParamByName('PROJECT_ID', ProjectID); FQOperat.ParamByName('LIST_ID').AsInteger := ListID; FQOperat.ParamByName('NAME_SHORT').AsString := NameShort; FQOperat.ParamByName('NAME_MARK').AsString := NameMark; FQOperat.ParamByName('ISUSER_NAME').AsInteger := IsUserName; FQOperat.ParamByName('MARK_ID').AsInteger := MarkID; FQOperat.ParamByName('SCS_ID').AsInteger := SCSID; FQOperat.ParamByName('INDEX_CONN').AsInteger := IndexPointObj; FQOperat.ParamByName('INDEX_LINE').AsInteger := IndexLine; FQOperat.ParamByName('INDEX_JOINER').AsInteger := IndexConnector; FQOperat.ParamByName(fnIsIndexWithName).AsInteger := IsIndexWithName; end; FQOperat.ExecQuery; FQOperat.Close; if AMakeEdit = meMake then begin //*** Получить новый ID NewID := GenIDFromTable(FQSelect, gnKatalogID, 0); //SetSQLToQuery(FQuery_Select, ' select MAX(id) as max_id from katalog '); //NewID := FQuery_Select.GetFNAsInteger('max_id'); //FQuery_Select.Close; TF_Main(FActiveForm).DM.AddCatalogToLists(NewID, ParentID); end; finally FreeAndNil(CatalogFields); end; end; qmMemory: begin { case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnParentID).AsInteger := ParentID; end; meEdit: begin //SetFilterToSQLMemTable(FMemTable, 'id = '''+IntToStr(ID)+''''); FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit else Exit; ///// EXIT ///// end; end; FMemTable.FieldByName('NAME').AsString := Name; FMemTable.FieldByName('SORT_ID').AsInteger := SortID; FMemTable.FieldByName('KOL_COMPON').AsInteger := KolCompon; FMemTable.FieldByName('ITEMS_COUNT').AsInteger := ItemsCount; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //FMemTable.FieldByName('PROJECT_ID').AsInteger := ProjectID; FMemTable.FieldByName('LIST_ID').AsInteger := ListID; FMemTable.FieldByName('NAME_SHORT').AsString := NameShort; FMemTable.FieldByName('NAME_MARK').AsString := NameMark; FMemTable.FieldByName('ISUSER_NAME').AsInteger := IsUserName; FMemTable.FieldByName('MARK_ID').AsInteger := MarkID; FMemTable.FieldByName('ID_ITEM_TYPE').AsInteger := ItemType; FMemTable.FieldByName('SCS_ID').AsInteger := SCSID; FMemTable.FieldByName('INDEX_CONN').AsInteger := IndexPointObj; FMemTable.FieldByName('INDEX_LINE').AsInteger := IndexLine; FMemTable.FieldByName('INDEX_JOINER').AsInteger := IndexConnector; end; FMemTable.Post; if AMakeEdit = meMake then NewID := FMemTable.FieldByName(fnID).AsInteger; } if AMakeEdit = meMake then NewID := GenCurrProjTableID(giKatalogID); end; end; except on E: Exception do AddExceptionToLog('TSCSCatalog.SaveData: '+E.Message); end; end; // ##### ##### constructor TSCSCatalog.Create(AFormOwner: TForm); begin //FTableName := tnCatalog; //FTableIndex := tiKatalog; inherited Create(AFormOwner, teCatalog); //ActiveForm := AFormOwner; FRoomSetting := nil; FChildCatalogReferences := TSCSCatalogs.Create(false); FComponentReferences := TSCSComponents.Create(False); FTreeViewNode := nil; //22.08.2007 FUpperComponents := TSCSComponents.Create(false); FSCSComponents := TSCSComponents.Create(true); FChildCatalogs := TSCSCatalogs.Create(true); //07.11.2013 NormsResources := TSCSNormsResources.Create(AFormOwner, ctkCatalog); FNotes := nil; //FProperties := TList.Create; //DefineQuery; //ActivateTransaction; //FQuery := (ActiveForm as TF_Main).DM.Query_TSCSCompon; NewComponList := TList.create; Clear; end; // ##### ##### destructor TSCSCatalog.Destroy; var IndexInParent: Integer; begin try if Assigned(FParent) then begin IndexInParent := -1; IndexInParent := TSCSCatalog(FParent).ChildCatalogs.IndexOf(Self); if IndexInParent <> -1 then TSCSCatalog(FParent).ChildCatalogs.Remove(Self); //TSCSCatalog(FParent).ChildCatalogs[IndexInParent] := nil; end; Parent := nil; Clear; FreeAndNil(FChildCatalogReferences); FreeAndNil(FComponentReferences); //SCSComponents.Free; //22.08.2007 FreeAndNil(FUpperComponents); //FreeListWithObjects(SCSComponents); FreeAndNil(FSCSComponents); FreeAndNil(FChildCatalogs); //FreeListWithObjects(FChildCatalogs); if Assigned(NewComponList) then FreeAndNil(NewComponList); //07.11.2013 FreeAndNil(NormsResources); //FreeAndNil(FProperties); if FNotes <> nil then FreeAndNil(FNotes); if FRoomSetting <> nil then FreeMem(FRoomSetting); except end; inherited; //Destroy; end; procedure TSCSCatalog.Assign(ASCSCatalog: TSCSCatalog); begin try AssignOnlyCatalog(ASCSCatalog); //*** Загрузка свойств AssignProperties(ASCSCatalog.FProperties); //*** Загрузить компоненты AssignComponents(ASCSCatalog.SCSComponents); //ClearListWithObjects(SCSComponents); except on E: Exception do AddExceptionToLog('TSCSCatalog.Assign: '+E.Message); end; end; procedure TSCSCatalog.AssignChildCatalogs(ASCSCatalogs: TSCSCatalogs); var NewCatalog, SrcCatalog: TSCSCatalog; i: Integer; begin for i := 0 to ASCSCatalogs.Count - 1 do begin SrcCatalog := ASCSCatalogs[i]; NewCatalog := TSCSCatalog.Create(SrcCatalog.FActiveForm); AddChildCatalogToList(NewCatalog); NewCatalog.Assign(SrcCatalog); NewCatalog.AssignChildCatalogs(SrcCatalog.ChildCatalogs); NewCatalog.ParentID := ID; end; end; procedure TSCSCatalog.AssignComponents(ASCSComponents: TSCSComponents); var i: Integer; SCSCompon, SrcCompon: TSCSComponent; begin SCSComponents.Clear; for i := 0 to ASCSComponents.Count - 1 do begin SrcCompon := ASCSComponents[i]; SCSCompon := TSCSComponent.Create(SrcCompon.ActiveForm); SCSCompon.Assign(SrcCompon, true, true); SCSCompon.AssignChildComponents(SrcCompon.ChildComplects, true, true); AddComponentToList(SCSCompon); end; end; procedure TSCSCatalog.AssignOnlyCatalog(ASCSCatalog: TSCSCatalog); begin ParentID := ASCSCatalog.ParentID; //ProjectID := ACatalog.ProjectID; ListID := ASCSCatalog.ListID; Name := ASCSCatalog.Name; NameShort := ASCSCatalog.NameShort; NameMark := ASCSCatalog.NameMark; IsUserName := ASCSCatalog.IsUserName; KolCompon := ASCSCatalog.KolCompon; ItemType := ASCSCatalog.ItemType; ItemsCount := ASCSCatalog.ItemsCount; MarkID := ASCSCatalog.MarkID; SCSID := ASCSCatalog.SCSID; SortID := ASCSCatalog.SortID; IndexPointObj := ASCSCatalog.IndexPointObj; IndexConnector := ASCSCatalog.IndexConnector; IndexLine := ASCSCatalog.IndexLine; FDesignIconType := ASCSCatalog.FDesignIconType; ResourcesCost := ASCSCatalog.ResourcesCost; NewID := ASCSCatalog.NewID; ID := ASCSCatalog.ID; FComponTypeSysName := ASCSCatalog.FComponTypeSysName; FGUIDComponentType := ASCSCatalog.FGUIDComponentType; FGUIDDesignIcon := ASCSCatalog.FGUIDDesignIcon; FGUIDJoinedNetType := ASCSCatalog.FGUIDJoinedNetType; Length := ASCSCatalog.Length; if ASCSCatalog.FRoomSetting <> nil then begin if FRoomSetting = nil then CreateRoomSetting; FRoomSetting^ := ASCSCatalog.FRoomSetting^; end; end; procedure TSCSCatalog.AddChildCatalog(ASCSCatalog: TSCSCatalog); begin if FChildCatalogs.IndexOf(ASCSCatalog) = -1 then begin AddChildCatalogToList(ASCSCatalog); Inc(ItemsCount); ASCSCatalog.SortID := GenCatalogSortID; if (FTreeViewNode <> nil) and (FTreeViewNode.Data <> nil) then PObjectData(FTreeViewNode.Data).ChildNodesCount := ItemsCount + KolCompon; if (ASCSCatalog.FTreeViewNode <> nil) and (ASCSCatalog.FTreeViewNode.Data <> nil) then PObjectData(ASCSCatalog.FTreeViewNode.Data).SortID := ASCSCatalog.SortID; end; end; procedure TSCSCatalog.AddChildCatalogToList(ASCSCatalog: TSCSCatalog); var i: Integer; ChildCatalog: TSCSCatalog; IndexOfLastRoom: integer; begin if Assigned(ASCSCatalog) then begin if ASCSCatalog.ItemType = itRoom then begin IndexOfLastRoom := -1; // Определить индеск для всавки комнаты в список for i := 0 to FChildCatalogs.Count - 1 do begin ChildCatalog := FChildCatalogs[i]; if ChildCatalog.ItemType = itRoom then IndexOfLastRoom := i else // Если пошли другие объекты, то выходим из цикла Break; //// BREAK //// end; FChildCatalogs.Insert(IndexOfLastRoom + 1, ASCSCatalog); end else FChildCatalogs.Add(ASCSCatalog); if ItemType = itproject then ASCSCatalog.ParentID := 0 else ASCSCatalog.ParentID := Self.ID; if ASCSCatalog is TSCSList then TSCSList(ASCSCatalog).Parent := Self else if ASCSCatalog is TSCSCatalog then ASCSCatalog.Parent := Self; end; end; procedure TSCSCatalog.AddComponentToList(ASCSComponent: TSCSComponent); begin if Assigned(ASCSComponent) then begin if FSCSComponents.IndexOf(ASCSComponent) = -1 then FSCSComponents.Add(ASCSComponent); ASCSComponent.Parent := Self; end; end; procedure TSCSCatalog.AddComponentToCatRel(ASCSComponent: TSCSComponent); begin if Assigned(ASCSComponent) then begin if FQueryMode = qmPhisical then TF_Main(FActiveForm).AppendToCatalRel(Self.ID, ASCSComponent.ID); AddComponentToList(ASCSComponent); //if FSCSComponents.IndexOf(ASCSComponent) = -1 then // FSCSComponents.Add(ASCSComponent); //ASCSComponent.Parent := Self; if Assigned(FTreeViewNode) and Assigned(ASCSComponent.FTreeViewNode) then begin TF_Main(FActiveForm).MoveNodeTo(ASCSComponent.FTreeViewNode, FTreeViewNode, naAddChild); TF_Main(FActiveForm).OnAddDeleteNode(ASCSComponent.FTreeViewNode, ASCSComponent, nil, true); PObjectData(ASCSComponent.FTreeViewNode.Data).ComponKind := ckCompon; TF_Main(FActiveForm).SortByVetv(FTreeViewNode); TF_Main(FActiveForm).DefineObjectNodeGroup(FTreeViewNode, ASCSComponent.GUIDComponentType, ASCSComponent.IsLine); end; end; end; procedure TSCSCatalog.AddProperty(AIDProperty: Integer; AGUIDProperty: String; AIDDataType, AIsDefault: Integer; const AValue, AName, ASysName: String); begin inherited AddProperty(ID, AIDProperty, AGUIDProperty, AIDDataType, 0, 0, AIsDefault, AValue, AName, ASysName); end; function TSCSCatalog.CheckInterfaceInUse(AIDInterface: Integer): Boolean; var SCSComponent: TSCSComponent; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; i, j, k: Integer; begin Result := false; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interf := SCSComponent.Interfaces[j]; for k := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[k]); if (IOfIRel.IDInterfRel = AIDInterface) or (IOfIRel.IDInterfTo = AIDInterface) then begin Result := true; Break; ///// BREAK ///// end; end; end; end; end; procedure TSCSCatalog.ClearComponents; var i: Integer; begin for i := 0 to SCSComponents.Count - 1 do begin TSCSComponent(SCSComponents[i]).Parent := nil; TSCSComponent(SCSComponents[i]).Free; end; SCSComponents.Clear; end; procedure TSCSCatalog.ClearChildCatalogs; var i: Integer; begin for i := 0 to ChildCatalogs.Count - 1 do begin TSCSCatalog(ChildCatalogs[i]).Parent := nil; TSCSCatalog(ChildCatalogs[i]).Free; end; ChildCatalogs.Clear; end; procedure TSCSCatalog.Clear; var i: integer; SCSComponent: TSCSComponent; // Tolik -- 28/04/2017 -- // needClear: boolean; ComponList: TSCSComponents; begin inherited; // Tolik -- 11/05/2019 -- //Была ОЧЕНЬ НЕУДАЧНАЯ попытка сбросить подключения конструктивов, так как после этого компонент выкидывался // из каталока и не уничтожался, что ведо к утечке памяти, ЕСЛИ АВ опять появится, то наверное // нужно с ней побороться КАК-ТО ИНАЧЕ .... { //Tolik 05/05/2017 -- Этот кусок нужен, чтобы не валилось закрытие проекта // здесь выполняется очистка занятых конструктивных интерфейсов needClear := True; if self.FQueryMode = qmPhisical then needClear := False else begin if self.FTreeViewNode <> nil then if self.FTreeViewNode.Owner <> nil then if self.FTreeViewNode.Owner.Owner <> nil then if self.FTreeViewNode.Owner.Owner.Owner <> nil then if self.FTreeViewNode.Owner.Owner.Owner.ClassName = 'TF_MAin' then if TF_MAin(self.FTreeViewNode.Owner.Owner.Owner).GDBMode = bkNormBase then needClear := false; end; if needClear then begin for i := Self.SCSComponents.Count - 1 downto 0 do begin SCSComponent := Self.SCSComponents[i]; // До ж. //SCSComponent.DisJoinFromAll(True); // это не раскомменчивать, потому что завалится CTRL + Z //////////if Assigned(SCSComponent.Parent) and (SCSComponent.Parent is TSCSComponent) then // єто ведет к утечке памяти потома // SCSComponent.DisConnectFromParent; end; end;} FSCSComponents.Clear; // FChildCatalogs.Clear; //ClearListWithObjects(SCSComponents); //ClearListWithObjects(FChildCatalogs); //ClearComponents; //ClearChildCatalogs; //07.11.2013 NormsResources.Clear; //ClearList(FProperties); if FNotes <> nil then FNotes.Clear; if FRoomSetting <> nil then ZeroMemory(FRoomSetting, SizeOf(TRoomSettingRecord)); ID := 0; ParentID := 0; //ProjectID := 0; ListID := 0; Name := ''; NameShort := ''; NameMark := ''; IsUserName := biFalse; KolCompon := 0; ItemType := 0; MarkID := 0; SCSID := 0; SortID := 0; Level := 0; FComponTypeSysName := ''; FGUIDComponentType := ''; FGUIDDesignIcon := ''; FDesignIconType := -1; FGUIDJoinedNetType := ''; IndexPointObj := 0; IndexLine := 0; IndexConnector := 0; IsIndexWithName := biTrue; Length := 0; TreeViewNode := nil; IDLastAddedComponent := 0; LastAddedComponent := nil; ServDeleting := false; ServDeleteInCAD := false; ServToDefineParamsInCAD := false; ServToDefineObjParams := []; end; procedure TSCSCatalog.CreateRoomSetting; begin if FRoomSetting = nil then GetZeroMem(FRoomSetting, SizeOf(TRoomSettingRecord)); FRoomSetting^ := GetDefaultRoomSettings; end; procedure TSCSCatalog.DefineComponsNameMarks; var i: Integer; SCSComponent: TSCSComponent; begin for i := 0 to FSCSComponents.Count - 1 do begin SCSComponent := Self.FSCSComponents[i]; SCSComponent.DefineNameMarks; end; end; procedure TSCSCatalog.Delete(ACallFrom: TCallFrom = cfBase); begin DeleteNode(FTreeViewNode); TF_Main(FActiveForm).DM.DelCatalog(ACallFrom, ID, ItemType, FQueryMode); end; procedure TSCSCatalog.DisableEnableInterfaces(ADisable: Boolean; ANoDisabling: TSCSInterface); var SCSComponent: TSCSComponent; Interf: TSCSInterface; i, j: Integer; begin for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin Interf := SCSComponent.FInterfaces[j]; if ADisable and (Interf <> ANoDisabling) then Interf.ServDisabled := true else if Not ADisable then Interf.ServDisabled := false; end; end; end; // Tolik -- оригинал см ниже закомменчен function TSCSCatalog.GenCatalogSortID: Integer; var ChildCatalog: TSCSCatalog; i: Integer; begin Result := 0; for i := 0 to FChildCatalogs.Count - 1 do begin ChildCatalog := FChildCatalogs[i]; if ChildCatalog.SortID > Result then Result := ChildCatalog.SortID; end; Inc(Result); end; { function TSCSCatalog.GenCatalogSortID: Integer; var MaxSortID: Integer; ChildCatalog: TSCSCatalog; i: Integer; begin MaxSortID := 0; for i := 0 to FChildCatalogs.Count - 1 do begin ChildCatalog := FChildCatalogs[i]; if ChildCatalog.SortID > MaxSortID then MaxSortID := ChildCatalog.SortID; end; Inc(MaxSortID); Result := MaxSortID; end; } function TSCSCatalog.GetAllInterfaces: TSCSInterfaces; var SCSComponent: TSCSComponent; i, j: Integer; begin Result := TSCSInterfaces.Create(false); for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := FComponentReferences[i]; SCSComponent := TSCSComponent(FComponentReferences.List.List^[i]); if Assigned(SCSComponent) then for j := 0 to SCSComponent.Interfaces.Count - 1 do Result.Add(SCSComponent.Interfaces.List.List^[j]); end; end; function TSCSCatalog.GetAllIOfIRel(ATypeI: Integer = -1): TSCSObjectList; var i, j: Integer; Interf: TSCSInterface; AllInterfaces: TSCSInterfaces; begin Result := TSCSObjectList.Create(false); AllInterfaces := GetAllInterfaces; if Assigned(AllInterfaces) then try for i := 0 to AllInterfaces.Count - 1 do begin //Interf := AllInterfaces[i]; Interf := TSCSInterface(AllInterfaces.List.List^[i]); if Assigned(Interf) then if (ATypeI = -1) or (ATypeI = Interf.TypeI) then //Result.Assign(Interf.IOfIRelOut, laOr); for j := 0 to Interf.IOfIRelOut.Count - 1 do Result.Add(Interf.IOfIRelOut.List.List^[j]); end; finally AllInterfaces.Free; end; end; function TSCSCatalog.GetAllNormsResources(ANormResources: TNormResourcesKinds; AForIBD, ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice: Boolean; ACanOffNorms: Boolean = false; AGroupPreyscurants: Boolean = true; AGroupComponsBySuppliesKind: Boolean = false; aAllowNormPriceForGroup: Boolean = false; aGroupByKolvo: Boolean = false): TSCSNormsResources; const CmpDelta = 0.001; var TopCatalog: TSCSCatalog; LengthForResources, LenghtReserv, ExpenseForMetr_Compon: Double; //InterfaceNormList: TList; //ptrInterfaceNormInfo: PInterfaceNormInfo; ResNormsResources: TSCSNormsResources; GroupNorm: TSCSNorm; i, j: Integer; ChildCatalog: TSCSCatalog; SCSComponent, PartComponent: TSCSComponent; GroupComponentsList, LookedComponents: TSCSComponents; SprCurrency: TNBCurrency; ProjectCurrency, CountryCurrency: TCurrency; ConvertToCountryCurrency: Boolean; ComponSignType: Integer; // Tolik NetTypeGuidList: TStringList; // типы сетей (для отчетов) // ----- Компонент - прейскурант ------ // Примечание - поле длина в точ. компонент использ-ся как количество procedure AddKolvoLengthToGroupComponent(AGroupCompon, AComponToGroup: TSCSComponent); var PartComponent: TSCSComponent; PartLength, ExpenseForMetr: Double; i: Integer; //ExpenseForSection: Double; LengthTrace, ComponentLengthKolvo: Double; begin ComponentLengthKolvo := 0; if AGroupCompon.IsLine = biFalse then begin if ((AGroupCompon.ComponentType.SysName = ctsnCableChannelAccessory) or (AGroupCompon.ComponentType.SysName = ctsnAccessory)) and (AComponToGroup <> nil) then begin ExpenseForMetr := AComponToGroup.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then begin ComponentLengthKolvo := Round(AComponToGroup.Length * ExpenseForMetr); end; end else ComponentLengthKolvo := 1 end else begin // Расход на ед.длины ExpenseForMetr := AComponToGroup.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then begin //LengthTrace := AComponToGroup.GetPartLength; //AGroupCompon.Length := AGroupCompon.Length + Round(LengthTrace) * ExpenseForMetr; //ComponentLengthKolvo := Round(AComponToGroup.Length) * ExpenseForMetr; ComponentLengthKolvo := Round(AComponToGroup.Length * ExpenseForMetr); // 2007.03.16 LengthTrace := 0; // 2007.03.16 for i := 0 to AComponToGroup.WholeComponent.Count - 1 do // 2007.03.16 begin // 2007.03.16 PartComponent := GetComponentFromReferences(AComponToGroup.WholeComponent[i]); // 2007.03.16 if PartComponent <> nil then // 2007.03.16 begin // 2007.03.16 PartLength := PartComponent.GetPartLength; // 2007.03.16 LengthTrace := LengthTrace + PartLength; // 2007.03.16 end; // 2007.03.16 end; // 2007.03.16 ComponentLengthKolvo := Round(LengthTrace) * ExpenseForMetr; end else ComponentLengthKolvo := Round3(AComponToGroup.Length); // Расход на отрезок //ExpenseForSection := AComponToGroup.GetPropertyValueAsFloat(pnExpenseForSection); //if ExpenseForSection > 0 then // ComponentLengthKolvo := ComponentLengthKolvo + ExpenseForSection; end; //*** Учет демонтажа if ACanHaveDismountAccount and (AComponToGroup.IsDismount = biTrue) then if AComponToGroup.IsUseDismounted = biTrue then ComponentLengthKolvo := ComponentLengthKolvo * -1 else ComponentLengthKolvo := 0; AGroupCompon.Length := AGroupCompon.Length + ComponentLengthKolvo; end; procedure AddComponentToGroup(AComponent: TSCSComponent); var GrComponent: TSCSComponent; i: Integer; ExistsGroup, CanAddComponToGroup: Boolean; ComponIzm: String; begin GrComponent := nil; if Assigned(AComponent) then if LookedComponents.IndexOf(AComponent) = -1 then if (AComponent.Price > 0) or AComponsWithZeroPrice then begin ComponIzm := AComponent.Izm; if CheckPriceTransformToUOMByCompType(@AComponent.ComponentType) then ComponIzm := GetNameUOM(umMetr, true); ExistsGroup := false; for i := 0 to GroupComponentsList.Count - 1 do begin GrComponent := GroupComponentsList[i]; CanAddComponToGroup := false; if (GrComponent.GuidNB = AComponent.GuidNB) and (GrComponent.Name = AComponent.Name) and (GrComponent.ArticulProducer = AComponent.ArticulProducer) and (GrComponent.ArticulDistributor = AComponent.ArticulDistributor) and (GrComponent.GUIDComponentType = AComponent.GUIDComponentType) and (GrComponent.GUIDProducer = AComponent.GUIDProducer) and (GrComponent.Izm = ComponIzm) and (Abs(GrComponent.Price - AComponent.Price) < CmpDelta) then begin CanAddComponToGroup := true; //*** Группировать по виду поставки if AGroupComponsBySuppliesKind then if (GrComponent.GUIDSuppliesKind <> '') and (GrComponent.GUIDSuppliesKind <> AComponent.GUIDSuppliesKind) then if FProjectOwner.Spravochnik.GetSuppliesKindByGUID(AComponent.GUIDSuppliesKind) <> nil then CanAddComponToGroup := false; if CanAddComponToGroup then begin AddKolvoLengthToGroupComponent(GrComponent, AComponent); GrComponent.FChildReferences.Add(AComponent); ExistsGroup := true; end; end; end; if Not ExistsGroup then begin GrComponent := TSCSComponent.Create(FActiveForm); GrComponent.AssignOnlyComponent(AComponent); GrComponent.Length := 0; GrComponent.Izm := ComponIzm; AddKolvoLengthToGroupComponent(GrComponent, AComponent); //*** На тот случай, если мертвая ссылка на вид поставки if (GrComponent.GUIDSuppliesKind <> '') and (FProjectOwner <> nil) then if FProjectOwner.Spravochnik.GetSuppliesKindByGUID(GrComponent.GUIDSuppliesKind) = nil then GrComponent.GUIDSuppliesKind := ''; //if GrComponent.isLine = biFalse then // GrComponent.Length := 1 //else // GrComponent.Length := AComponent.Length; GrComponent.FChildReferences.Add(AComponent); GroupComponentsList.Add(GrComponent); end; end; end; procedure AddComponentToPriscurants(AComponent: TSCSComponent); var Resource: TSCSResourceGroup; begin if AComponent.Length > 0 then begin Resource := TSCSResourceGroup.Create(FActiveForm); Resource.IsOn := biTrue; Resource.ServIsResource := false; Resource.ID := AComponent.ID; // Если для ИБД, то Выкинуть нули после тире if AForIBD then Resource.Cypher := FormatShifrToShortDBN(AComponent.Cypher) else Resource.Cypher := AComponent.Cypher; Resource.GuidNB := AComponent.GuidNB; Resource.Name := AComponent.Name; Resource.ArtProducer := AComponent.ArticulProducer; Resource.ArtDistributor := AComponent.ArticulDistributor; Resource.GUIDProducer := AComponent.GUIDProducer; Resource.GUIDSuppliesKind := AComponent.GUIDSuppliesKind; Resource.Izm := AComponent.Izm; Resource.Price := RoundCP(AComponent.Price); Resource.Kolvo := RoundCP(AComponent.Length); Resource.Cost := RoundCP(Resource.Price * Resource.Kolvo); Resource.RType := rtPrice; // Прейскурант Resource.FObjectList.Assign(AComponent.FChildReferences); if ConvertToCountryCurrency then Resource.RefreshPricesAfterChangeCurrency(ProjectCurrency, CountryCurrency, false); ResNormsResources.Resources.Add(Resource); end; end; // ----- Нормы ------ procedure AddExpensiveLengthToGroupNorm(AGrpNorm, ANormToGroup: TSCSNorm; AComponentOwnerToGrp: TSCSComponent; AUsedLength: Double); var i: Integer; NormPreyscurant: TSCSNormPreyscurant; NormKolvo: Double; begin if AComponentOwnerToGrp <> nil then begin case AComponentOwnerToGrp.IsLine of biTrue: begin //if (ANormToGroup.ExpenseForLength = 0) or (ANormToGroup.IsFromInterface = biTrue) then // AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.Kolvo //else //*** Учитывать расход норм только для тех норм, корт-е добавил Юзер if {and (AUsedLength > 0)} (ANormToGroup.IsFromInterface = biFalse) then begin {// расход на ед.длины if ANormToGroup.ExpenseForLength > 0 then begin AGrpNorm.Kolvo := AGrpNorm.Kolvo + RoundX(ANormToGroup.Kolvo, PrecisionNormKolvo) * AUsedLength * RoundCP(ANormToGroup.ExpenseForLength); for i := 0 to ANormToGroup.FPreyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(ANormToGroup.FPreyscurants[i]); NormPreyscurant.Kolvo := RoundX(NormPreyscurant.Kolvo, PrecisionNormKolvo) * AUsedLength * RoundCP(ANormToGroup.ExpenseForLength); end; end else AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.Kolvo; // расход на отрезок //if ANormToGroup.ExpenseForSection > 0 then //begin // AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.ExpenseForSection; // for i := 0 to ANormToGroup.FPreyscurants.Count - 1 do // begin // NormPreyscurant := TSCSNormPreyscurant(ANormToGroup.FPreyscurants[i]); // NormPreyscurant.Kolvo := NormPreyscurant.Kolvo + ANormToGroup.ExpenseForSection; // end; //end; } NormKolvo := CalcNormResourceCount(ANormToGroup.Kolvo, AUsedLength, ANormToGroup.ExpenseForLength, ANormToGroup.CountForPoint, ANormToGroup.StepOfPoint, false); AGrpNorm.Kolvo := AGrpNorm.Kolvo + NormKolvo; for i := 0 to ANormToGroup.FPreyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(ANormToGroup.FPreyscurants[i]); NormPreyscurant.Kolvo := NormKolvo; end; end else if (ANormToGroup.IsFromInterface = biTrue) {or ((ANormToGroup.ExpenseForLength = 0) and (AUsedLength = 0))} then AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.Kolvo; end; biFalse: AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.Kolvo; end; end else AGrpNorm.Kolvo := AGrpNorm.Kolvo + ANormToGroup.Kolvo; AGrpNorm.CalcTotalCost(true); end; procedure AddNormToGroup(ANorm: TSCSNorm; AComponentOwner: TSCSComponent; AUsedLength: Double); var i, j, k: Integer; GrNorm: TSCSNormGroup; ExistsNorm, ExistsResource: Boolean; FirstResource, SecondResource: TSCSResourceRel; LookedResorces: TSCSResources; PreyscurantI, PreyscurantJ: TSCSNormPreyscurant; NormPreyscurantKolvo: Double; RemovedPreyscurant: Boolean; begin GrNorm := nil; if Assigned(ANorm) then if (ANorm.IsOn = biTrue) or (ACanOffNorms and (ANorm.IsOn = biFalse)) then begin ExistsNorm := false; for i := 0 to ResNormsResources.Norms.Count - 1 do begin GrNorm := TSCSNormGroup(ResNormsResources.Norms[i]); if (GrNorm.Cypher = ANorm.Cypher) and (GrNorm.Name = ANorm.Name) and (GrNorm.GuidNB = ANorm.GuidNB) and //24.09.2010 (Abs(GrNorm.Cost - ANorm.Cost) < 0.01) ( Not aAllowNormPriceForGroup or CmpFloatByCP(GrNorm.Price, ANorm.Price) and //18.11.2013 CmpFloatByCP(GrNorm.PricePerTime, ANorm.PricePerTime) and //18.11.2013 (GrNorm.LaborTime = ANorm.LaborTime) //18.11.2013 ) //24.09.2010 //and (Abs(GrNorm.TotalCost - ANorm.TotalCost) < 0.01) then if Not aGroupByKolvo or CmpFloatByCP(GrNorm.FGrpKolvo, ANorm.Kolvo) then begin ExistsNorm := true; (* //*** проверить идентичность ресурсов этих норм if GrNorm.Resources.Count = ANorm.Resources.Count then begin LookedResorces := TSCSResources.Create(false); for j := 0 to GrNorm.Resources.Count - 1 do begin ExistsResource := false; FirstResource := GrNorm.Resources[j]; for k := 0 to ANorm.Resources.Count - 1 do if LookedResorces.IndexOf(ANorm.Resources[k]) = -1 then begin SecondResource := ANorm.Resources[k]; if (FirstResource.IsOn = SecondResource.IsOn) and (FirstResource.Cypher = SecondResource.Cypher) and (FirstResource.Name = SecondResource.Name) and (Abs(FirstResource.Price - SecondResource.Price) < CmpDelta) {and (Abs(FirstResource.Cost - SecondResource.Cost) < CmpDelta)} then begin ExistsResource := true; Break; ///// BREAK ///// end; LookedResorces.Add(SecondResource); end; if Not ExistsResource then ExistsNorm := false; end; LookedResorces.Free; end else ExistsNorm := false; *) if ExistsNorm then begin //GrNorm.Kolvo := GrNorm.Kolvo + ANorm.Kolvo; //GrNorm.CalcTotalCost(true); AddExpensiveLengthToGroupNorm(GrNorm, ANorm, AComponentOwner, AUsedLength); //GrNorm.FPreyscurants.Assign(ANorm.FPreyscurants, laOr); for j := 0 to ANorm.FPreyscurants.Count - 1 do begin PreyscurantI := TSCSNormPreyscurant.Create; PreyscurantI.Assign(TSCSNormPreyscurant(ANorm.FPreyscurants[j])); GrNorm.FPreyscurants.Add(PreyscurantI); //*** Для лиейных компонент найти суммарн. длину прокладки if (PreyscurantI.InterfaceType = itConstructive) and (PreyscurantI.SCSComponent.IsLine = biTrue) then for k := 0 to GrNorm.FPreyscurants.Count - 1 do begin PreyscurantJ := TSCSNormPreyscurant(GrNorm.FPreyscurants[k]); if (PreyscurantJ <> nil) and (PreyscurantI <> PreyscurantJ) then if (PreyscurantI.InterfaceType = PreyscurantJ.InterfaceType) and (PreyscurantI.SCSComponent <> PreyscurantJ.SCSComponent) and (PreyscurantI.SCSComponent.GuidNB = PreyscurantJ.SCSComponent.GuidNB) and (PreyscurantI.PairKolvo = PreyscurantJ.PairKolvo) {and (PreyscurantI.RelationComponentGUID = PreyscurantJ.RelationComponentGUID)} then begin NormPreyscurantKolvo := TSCSNormPreyscurant(ANorm.FPreyscurants[j]).Kolvo; //*** Учет демонтажа //if ACanHaveDismountAccount then //begin // if (PreyscurantI.SCSComponent.IsDismount = biFalse) and // (PreyscurantJ.SCSComponent.IsDismount = biTrue) then // if PreyscurantJ.SCSComponent.IsUseDismounted = biTrue then // NormPreyscurantKolvo := NormPreyscurantKolvo * -1 // else // NormPreyscurantKolvo := 0; //end; PreyscurantI.Kolvo := PreyscurantJ.Kolvo + NormPreyscurantKolvo; PreyscurantJ.Kolvo := PreyscurantI.Kolvo; end; end; end; Break; ///// BREAK ///// end; end; end; if Not ExistsNorm then begin GrNorm := TSCSNormGroup.Create(ANorm.ActiveForm, ANorm.NormType); GrNorm.Assign(ANorm); //if ConvertToCountryCurrency then // GrNorm.RefreshPricesAfterChangeCurrency(ProjectCurrency, CountryCurrency, false); //GrNorm.Kolvo := 1; //GrNorm.CalcTotalCost(true); GrNorm.Kolvo := 0; GrNorm.Cost := 0; GrNorm.TotalCost := 0; GrNorm.FGrpKolvo := ANorm.Kolvo; AddExpensiveLengthToGroupNorm(GrNorm, ANorm, AComponentOwner, AUsedLength); ResNormsResources.Norms.Add(GrNorm); for j := 0 to ANorm.FPreyscurants.Count - 1 do begin PreyscurantI := TSCSNormPreyscurant.Create; PreyscurantI.Assign(TSCSNormPreyscurant(ANorm.FPreyscurants[j])); GrNorm.FPreyscurants.Add(PreyscurantI); end; ExistsNorm := true; end; GrNorm.ObjectList.Add(ANorm); //*** Сгруппировать прейскуранты if AGroupPreyscurants and ExistsNorm and (GrNorm <> nil) then begin RemovedPreyscurant := false; //*** Для точечных прейскурантов определить количество for i := 0 to GrNorm.FPreyscurants.Count - 1 do begin PreyscurantI := TSCSNormPreyscurant(GrNorm.FPreyscurants[i]); if PreyscurantI <> nil then //06.04.2012 такая же проверка во втором цыкле, чтобы не переберать все элементынапрасно, то ставим ее и тута if (PreyscurantI.InterfaceType = itFunctional) or (PreyscurantI.SCSComponent.IsLine = biFalse) then begin for j := i to GrNorm.FPreyscurants.Count - 1 do if j <> i then begin PreyscurantJ := TSCSNormPreyscurant(GrNorm.FPreyscurants[j]); if PreyscurantJ <> nil then if (PreyscurantI.InterfaceType = itFunctional) or ((PreyscurantI.SCSComponent.IsLine = biFalse) and (PreyscurantI.SCSComponentGUID = PreyscurantJ.SCSComponentGUID) {and (PreyscurantI.RelationComponentGUID = PreyscurantJ.RelationComponentGUID)}) then begin PreyscurantI.Kolvo := PreyscurantI.Kolvo + PreyscurantJ.Kolvo; GrNorm.FPreyscurants[j] := nil; FreeAndNil(PreyscurantJ); RemovedPreyscurant := true; end; end; end; end; if RemovedPreyscurant then GrNorm.FPreyscurants.Pack; end; end; end; procedure AddNormsToGroup(ANorms: TSCSNorms; AComponentOwner: TSCSComponent; AUsedLength: Double); var i: Integer; Norm: TSCSNorm; ComponOwnerSignType: Integer; begin if Assigned(ANorms) then begin ComponOwnerSignType := AComponentOwner.GetPropertyValueAsInteger(pnSignType); for i := 0 to ANorms.Count - 1 do begin Norm := ANorms[i]; //*** Не кидать пользовательские нормы для действующих компонент if (ComponOwnerSignType = oitProjectible) or ACanHaveActiveComponents or (Norm.IsFromInterface = biTrue) then AddNormToGroup(Norm, AComponentOwner, AUsedLength); end; end; end; //------------------------------ resources ---------------------------------- procedure AddKolvoAndCostToGrpResource(AGrpResourceRel, ASrcREsourceRel: TSCSResourceRel; AUsedLength: Double; ADismounted, AUseDismounted: Boolean); var ResourceKolvo, ResourceCost: Double; begin ResourceKolvo := 0; ResourceCost := 0; {if AUsedLength = 0 then begin ResourceKolvo := ASrcREsourceRel.Kolvo; ResourceCost := ASrcREsourceRel.Cost; end else begin // Если учитывается расход на метр if ASrcREsourceRel.ExpenseForLength > 0 then begin ResourceKolvo := Round(ASrcREsourceRel.Kolvo * AUsedLength) * ASrcREsourceRel.ExpenseForLength; // 2007.03.16 AGrpResourceRel.Kolvo := AGrpResourceRel.Kolvo + KolvoFromExpense; // 2007.03.16 AGrpResourceRel.Cost := AGrpResourceRel.Cost + CostFromExpense; end else ResourceKolvo := ASrcREsourceRel.Kolvo; // Расход на отрезок //if ASrcREsourceRel.ExpenseForSection > 0 then // ResourceKolvo := ResourceKolvo + ASrcREsourceRel.ExpenseForSection; if ResourceKolvo > 0 then ResourceCost := ASrcREsourceRel.Price * ResourceKolvo; end;} ResourceKolvo := CalcNormResourceCount(ASrcREsourceRel.Kolvo, AUsedLength, ASrcREsourceRel.ExpenseForLength, ASrcREsourceRel.CountForPoint, ASrcREsourceRel.StepOfPoint, ASrcREsourceRel.GUIDNBComponent <> ''); if ResourceKolvo > 0 then ResourceCost := ASrcREsourceRel.Price * ResourceKolvo; //*** Учитывать демонтаж if ADismounted then begin if AUseDismounted then begin ResourceKolvo := ResourceKolvo * -1; ResourceCost := ResourceCost * -1; end else begin ResourceKolvo := 0; ResourceCost := 0; end; end; AGrpResourceRel.Kolvo := AGrpResourceRel.Kolvo + ResourceKolvo; AGrpResourceRel.Cost := AGrpResourceRel.Cost + ResourceCost; end; procedure AddResourceToGroup(AResourceRel: TSCSResourceRel; AUsedLength: Double; ADismounted, AUseDismounted: Boolean); var CanAddResource: Boolean; GrpResource: TSCSResourceGroup; i: Integer; ExistsResourceGroup: Boolean; begin CanAddResource := false; if nrAll in ANormResources then CanAddResource := true else if (nrResources in ANormResources) and (AResourceRel.GUIDNBComponent = '') then CanAddResource := true else if (nrAccessories in ANormResources) and (AResourceRel.GUIDNBComponent <> '') then CanAddResource := true; if CanAddResource then if AResourceRel.IsOn = biTrue then begin ExistsResourceGroup := false; for i := 0 to ResNormsResources.Resources.Count - 1 do begin GrpResource := TSCSResourceGroup(ResNormsResources.Resources[i]); ExistsResourceGroup := false; if (GrpResource.IsOn = AResourceRel.IsOn) and (GrpResource.TableKindNB = AResourceRel.TableKindNB) and (GrpResource.GuidNB = AResourceRel.GuidNB) and (GrpResource.GUIDNBComponent = AResourceRel.GUIDNBComponent) and (GrpResource.Cypher = AResourceRel.Cypher) and (GrpResource.Name = AResourceRel.Name) and (GrpResource.Izm = AResourceRel.Izm) and (Abs(GrpResource.Price - AResourceRel.Price) < CmpDelta) {and (Abs(FirstResource.Cost - SecondResource.Cost) < CmpDelta)} then begin //GrpResource.Kolvo := GrpResource.Kolvo + AResourceRel.Kolvo; //GrpResource.Cost := GrpResource.Cost + AResourceRel.Cost; AddKolvoAndCostToGrpResource(GrpResource, AResourceRel, AUsedLength, ADismounted, AUseDismounted); GrpResource.FObjectList.Add(AResourceRel); ExistsResourceGroup := true; Break; ///// BREAK ///// end; end; if Not ExistsResourceGroup then begin GrpResource := TSCSResourceGroup.Create(FActiveForm); GrpResource.Assign(AResourceRel); GrpResource.ServIsResource := true; GrpResource.Kolvo := 0; GrpResource.Cost := 0; AddKolvoAndCostToGrpResource(GrpResource, AResourceRel, AUsedLength, ADismounted, AUseDismounted); GrpResource.FObjectList.Add(AResourceRel); //if ConvertToCountryCurrency then // GrpResource.RefreshPricesAfterChangeCurrency(ProjectCurrency, CountryCurrency, false); ResNormsResources.Resources.Add(GrpResource); end; end; end; procedure AddResourcesToGroup(AResources: TSCSResources; AUsedLength: Double; ADismounted, AUseDismounted: Boolean); var i: Integer; begin for i := 0 to AResources.Count - 1 do AddResourceToGroup(AResources[i], AUsedLength, ADismounted, AUseDismounted); end; //*** Удалит ресурсы с нулевыми ценами и количествами procedure RemoveResourcesWithZero; var i: Integer; ResourceRel: TSCSResourceGroup; begin i := 0; while i <= ResNormsResources.Resources.Count - 1 do begin ResourceRel := TSCSResourceGroup(ResNormsResources.Resources[i]); if ((ResourceRel.Kolvo <= 0) or (ResourceRel.Cost <= 0)) and Not AComponsWithZeroPrice then ResNormsResources.Resources.Delete(i) else Inc(i); end; end; // Tolik 21/02/2018 -- Procedure ApplySuppliesKind; var i, IDNBComponent: Integer; ResourceRel: TSCSResourceRel; ResourceCompon: TSCSComponent; SprSuppliesKind: TNBSuppliesKind; CachedNBCompons: TSCSComponents; Created: Boolean; // Tolik 12/10/2020 -- CurrProject: TSCSProject; begin CurrProject := nil; if ProjectOwner <> nil then CurrProject := ProjectOwner else begin if itemType = itProject then CurrProject := TSCSProject(self); end; if CurrProject = nil then exit; CachedNBCompons := TSCSComponents.Create(true); for i := 0 to ResNormsResources.Resources.Count - 1 do begin Created := False; ResourceRel := ResNormsResources.Resources[i]; if ResourceRel.IsOn = biTrue then begin ResourceCompon := nil; if ResourceRel.ServIsResource then begin if ResourceRel.GUIDNBComponent <> '' then begin ResourceCompon := GetComponByGUIDFromList(ResourceRel.GUIDNBComponent, CachedNBCompons); if ResourceCompon = nil then begin // Tolik 12/10/2020 -- //ResourceCompon := ProjectOwner.GetSprComponentByGUID(ResourceRel.GUIDNBComponent); ResourceCompon := CurrProject.GetSprComponentByGUID(ResourceRel.GUIDNBComponent); // if ResourceCompon = nil then begin IDNBComponent := F_NormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, ResourceRel.GUIDNBComponent, qmPhisical); if IDNBComponent <> 0 then begin ResourceCompon := TSCSComponent.Create(F_NormBase); ResourceCompon.LoadComponentByID(IDNBComponent, false); ResourceCompon.LoadComponentType; Created := True; end; end; end; end; end; if ResourceCompon <> nil then begin //SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(ResourceRel.GUIDSuppliesKind); // Tolik 12/10/2020 -- //SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(ResourceCompon.GUIDSuppliesKind); SprSuppliesKind := CurrProject.Spravochnik.GetSuppliesKindByGUID(ResourceCompon.GUIDSuppliesKind); // if SprSuppliesKind <> nil then begin if ResourceCompon.IsLine = biFalse then begin ResourceRel.Izm := SprSuppliesKind.Data.Name; ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo; ResourceRel.CalcCost; end; end; if Created then FreeAndNil(ResourceCompon); end; end; end; CachedNBCompons.free; end; // begin Result := nil; TopCatalog := GetTopParentCatalog; ZeroMemory(@CountryCurrency, SizeOf(TCurrency)); ConvertToCountryCurrency := false; //Tolik NetTypeGuidList := TStringList.Create; // if AForIBD then begin //CountryCurrency := TF_Main(FActiveForm).FNormBase.DM.GetCountryCurrency; if TopCatalog is TSCSProject then begin SprCurrency := TSCSProject(TopCatalog).FSpravochnik.GetCurrencyCountry; if SprCurrency <> nil then CountryCurrency := SprCurrency.Data; end; if CountryCurrency.Ratio <> 0 then begin if Assigned(TopCatalog) then if TopCatalog.ItemType = itProject then begin ProjectCurrency := TSCSProject(TopCatalog).GetCurrency(ctMain); if (ProjectCurrency.Ratio <> 0) and (ProjectCurrency.GUID <> CountryCurrency.GUID) then ConvertToCountryCurrency := true; end; end; end; ResNormsResources := TSCSNormsResources.Create(FActiveForm, ctkNone); //TSCSNorms.Create(true); //GLog.Add('----- BEGIN'); {InterfaceNormList := Self.GetNormInfoList; try for i := 0 to InterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := InterfaceNormList[i]; GroupNorm := TSCSNorm.Create(F_NormBase, ntNB); //GroupNorm.LoadNorm(ptrInterfaceNormInfo.IDNBNorm, true); GroupNorm.LoadNormByGUID(ptrInterfaceNormInfo.GUIDNBNorm, true); GroupNorm.Kolvo := ptrInterfaceNormInfo.Expense; GroupNorm.CalcCost; ResNormsResources.Norms.Add(GroupNorm); end; finally FreeList(InterfaceNormList); end;} // #### Не удалять // #### for i := 0 to FChildCatalogReferences.Count - 1 do // #### begin // #### ChildCatalog := FChildCatalogReferences[i]; // #### //ChildCatalog.NormsResources.LoadNorms(); // #### AddNormsToGroup(ChildCatalog.NormsResources.Norms); // #### end; GroupComponentsList := TSCSComponents.Create(true); LookedComponents := TSCSComponents.Create(false); if F_ProjMan.F_ResourceReport = nil then begin F_ProjMan.F_ResourceReport := TF_ResourceReport.Create(F_ProjMan, TForm(F_ProjMan)); {$IF Defined(SCS_RF)} F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false; {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_SPA)} F_ProjMan.F_ResourceReport.pnOtherProperties.Visible := false; {$IFEND} F_ProjMan.F_ResourceReport.AllNetTypes := True; end; try //Tolik if ((not F_ProjMan.F_ResourceReport.INeedNormsRecources) or (F_ProjMan.F_ResourceReport.INeedNormsRecources and F_ProjMan.F_ResourceReport.AllNetTypes)) then begin //09.11.2013 for i := 0 to FNormsResources.FNorms.Count - 1 do AddNormToGroup(FNormsResources.FNorms[i], nil, 0); for i := 0 to FChildCatalogReferences.Count - 1 do begin ChildCatalog := FChildCatalogReferences[i]; for j := 0 to ChildCatalog.FNormsResources.FNorms.Count - 1 do AddNormToGroup(ChildCatalog.FNormsResources.FNorms[j], nil, 0); end; //*** Выгребти нормы и ресурсы с компонент for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if (nrNorms in ANormResources) or (nrAll in ANormResources) then SCSComponent.DefineInterfaceNorms(ACanHaveActiveComponents); LengthForResources := 0; if SCSComponent.IsLine = biTrue then begin LengthForResources := SCSComponent.GetPartLength; SCSComponent.Length := GetComponPartLengthWithReserv(SCSComponent, LenghtReserv, true, true); //2007.03.16 SCSComponent.LoadWholeComponent(false); //2007.03.16 //SCSComponent.RefreshWholeLengthIfNecessary; //2007.03.16 if ItemType = itProject then //2007.03.16 begin //2007.03.16 SCSComponent.RefreshWholeLength; //2007.03.16 SCSComponent.Length := SCSComponent.GetPropertyValueAsFloat(pnLength) //2007.03.16 end //2007.03.16 else //2007.03.16 SCSComponent.Length := SCSComponent.GetWholeLength(false); end else begin if ((SCSComponent.ComponentType.SysName = ctsnCableChannelAccessory) or (SCSComponent.ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr_Compon := SCSComponent.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_Compon > 0 then begin LengthForResources := SCSComponent.GetPartLength; SCSComponent.Length := GetComponPartLengthWithReserv(SCSComponent, LenghtReserv, true, true); end; end end; SCSComponent.NormsResources.CalcResourcesCost(true, true); //*** Компонент может вернуть нормы из комплектующих, кот-е мб проектир. AddNormsToGroup(SCSComponent.NormsResources.Norms, SCSComponent, LengthForResources); //if (nrResources in ANormResources) or (nrAll in ANormResources) then begin //ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if CheckCanLookComponInReportRsrc(SCSComponent, ACanHaveActiveComponents, ACanHaveDismountAccount) then begin AddResourcesToGroup(SCSComponent.NormsResources.Resources, LengthForResources, ACanHaveDismountAccount and (SCSComponent.IsDismount = biTrue), (SCSComponent.IsUseDismounted = biTrue)); if (nrComponents in ANormResources) or (nrAll in ANormResources) then begin AddComponentToGroup(SCSComponent); LookedComponents.Add(SCSComponent); end; //2007.03.16 if SCSComponent.IsLine = biTrue then //2007.03.16 begin //2007.03.16 //SCSComponent.LoadWholeComponent(false); //2007.03.16 for j := 0 to SCSComponent.WholeComponent.Count - 1 do //2007.03.16 begin //2007.03.16 PartComponent := GetComponentFromReferences(SCSComponent.WholeComponent[j]); //2007.03.16 if Assigned(PartComponent) then //2007.03.16 if PartComponent <> SCSComponent then //2007.03.16 LookedComponents.Add(PartComponent); //2007.03.16 end; //2007.03.16 end; end; end; end; end // Tolik // вернуть для отчетов по типам сетей, выбранных пользователем else begin NetTypeGuidList.Clear; for i := 0 to F_ProjMan.F_ResourceReport.NetTypeGuidListSelected.Count - 1 do begin NetTypeGuidList.Add(F_ProjMan.F_ResourceReport.NetTypeGuidListSelected[i]); end; // 20/03/2017 -- Tolik -- для универсальных компонент NetTypeGuidList.Add(''); // //09.11.2013 for i := 0 to FNormsResources.FNorms.Count - 1 do AddNormToGroup(FNormsResources.FNorms[i], nil, 0); for i := 0 to FChildCatalogReferences.Count - 1 do begin ChildCatalog := FChildCatalogReferences[i]; for j := 0 to ChildCatalog.FNormsResources.FNorms.Count - 1 do AddNormToGroup(ChildCatalog.FNormsResources.FNorms[j], nil, 0); end; //*** Выгребти нормы и ресурсы с компонент for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if NetTypeGuidList.IndexOf(SCSComponent.GUIDNetType) <> -1 then begin if (nrNorms in ANormResources) or (nrAll in ANormResources) then SCSComponent.DefineInterfaceNorms(ACanHaveActiveComponents); LengthForResources := 0; if SCSComponent.IsLine = biTrue then begin LengthForResources := SCSComponent.GetPartLength; SCSComponent.Length := GetComponPartLengthWithReserv(SCSComponent, LenghtReserv, true, true); end else begin if ((SCSComponent.ComponentType.SysName = ctsnCableChannelAccessory) or (SCSComponent.ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr_Compon := SCSComponent.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_Compon > 0 then begin LengthForResources := SCSComponent.GetPartLength; SCSComponent.Length := GetComponPartLengthWithReserv(SCSComponent, LenghtReserv, true, true); end; end end; SCSComponent.NormsResources.CalcResourcesCost(true, true); //*** Компонент может вернуть нормы из комплектующих, кот-е мб проектир. AddNormsToGroup(SCSComponent.NormsResources.Norms, SCSComponent, LengthForResources); //if (nrResources in ANormResources) or (nrAll in ANormResources) then begin //ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if CheckCanLookComponInReportRsrc(SCSComponent, ACanHaveActiveComponents, ACanHaveDismountAccount) then begin AddResourcesToGroup(SCSComponent.NormsResources.Resources, LengthForResources, ACanHaveDismountAccount and (SCSComponent.IsDismount = biTrue), (SCSComponent.IsUseDismounted = biTrue)); if (nrComponents in ANormResources) or (nrAll in ANormResources) then begin AddComponentToGroup(SCSComponent); LookedComponents.Add(SCSComponent); end; end; end; end; // end; end; //*** Перевести компоненты в прейскуранты for i := 0 to GroupComponentsList.Count - 1 do begin SCSComponent := GroupComponentsList[i]; AddComponentToPriscurants(SCSComponent); end; RemoveResourcesWithZero; finally GroupComponentsList.Free; LookedComponents.Free; FreeAndNil(NetTypeGuidList); end; //GLog.Add('----- END'); // Tolik 21/02/2018 -- if AGroupComponsBySuppliesKind then ApplySuppliesKind; Result := ResNormsResources; end; function TSCSCatalog.GetAsTCatalog: TCatalog; begin Result.ID := ID; Result.Parent_ID := ParentID; //Result.Project_ID := ProjectID; Result.List_ID := ListID; Result.Name := Name; Result.NameShort := NameShort; Result.NameMark := NameMark; Result.IsUserName := IsUserName; Result.Kol_Compon := KolCompon; Result.ItemType := ItemType; Result.ItemsCount := ItemsCount; Result.MarkID := MarkID; Result.Scs_ID := SCSID; Result.Sort_ID := SortID; Result.IsIndexWithName := IsIndexWithName; Result.IndexPointObj := IndexPointObj; Result.IndexConnector := IndexConnector; Result.IndexLine := IndexLine; end; function TSCSCatalog.GetComponentFromReferences(AIDComponent: Integer): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; //for i := 0 to FComponentReferences.Count - 1 do // begin // SCSComponent := FComponentReferences[i]; // if Assigned(SCSComponent) then // if SCSComponent.ID = AIDComponent then // begin // Result := SCSComponent; // Break; ///// BREAK ///// // end; // end; for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := TSCSComponent(FComponentReferences.FItems[i]); SCSComponent := TSCSComponent(FComponentReferences.FItems.List^[i]); if SCSComponent.ID = AIDComponent then begin Result := SCSComponent; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.GetComponentFromReferencesList(AListID, AIDComponent: Integer): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(FComponentReferences.FItems.List^[i]); if (SCSComponent.ID = AIDComponent)and (SCSComponent.ListID = AListID) then begin Result := SCSComponent; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.GetComponentsByWholeID(AWholeID: Integer): TSCSComponents; var i: Integer; SCSComponent: TSCScomponent; begin Result := TSCSComponents.Create(false); for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if (SCSComponent.Whole_ID = AWholeID) then Result.Add(SCSComponent); end; end; function TSCSCatalog.GetComponentsIDList: TIntList; var i: Integer; SCSComponent: TSCSComponent; begin Result := TIntList.Create; for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents[i]; Result.Add(SCSComponent.ID); end; end; function TSCSCatalog.GetCatalogFromReferences(AIDCatalog: Integer): TSCSCatalog; var i: Integer; SCSCatalog: TSCSCatalog; begin Result := nil; for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := TSCSCatalog(FChildCatalogReferences.FItems.List^[i]); //13.03.2009 FChildCatalogReferences[i]; //if Assigned(SCSCatalog) then if SCSCatalog.ID = AIDCatalog then begin Result := SCSCatalog; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.GetCatalogFromReferencesBySCSID(ASCSID: Integer): TSCSCatalog; var i: Integer; SCSCatalog: TSCSCatalog; begin Result := nil; for i := 0 to FChildCatalogReferences.Count - 1 do begin //SCSCatalog := FChildCatalogReferences[i]; SCSCatalog := TSCSCatalog(FChildCatalogReferences.FItems.List^[i]); if SCSCatalog.SCSID = ASCSID then begin Result := SCSCatalog; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.CheckCatalogFromReferencesBySCSID(ASCSID: Integer; aNeedListID: integer; var aDuplicate: boolean): TSCSCatalog; var i: Integer; SCSCatalog: TSCSCatalog; Exists: boolean; begin Result := nil; Exists := False; aDuplicate := False; for i := 0 to FChildCatalogReferences.Count - 1 do begin //SCSCatalog := FChildCatalogReferences[i]; SCSCatalog := TSCSCatalog(FChildCatalogReferences.FItems.List^[i]); if SCSCatalog.SCSID = ASCSID then begin if Exists then aDuplicate := True; if aNeedListID = SCSCatalog.ListID then Result := SCSCatalog; Exists := True; end; end; end; function TSCSCatalog.GetCatalogFromReferencesBySCSIDUseSortCache(ASCSID: Integer; aSortCache: TRapObjectList): TSCSCatalog; begin Result := TSCSCatalog(aSortCache.GetObject(ASCSID)); if Result = nil then begin Result := GetCatalogFromReferencesBySCSID(ASCSID); aSortCache.Insert(Result, @Result.SCSID); end; end; function TSCSCatalog.GetComponentCountByType(AComponentType: Integer; AOnlyFromRoot: Boolean): Integer; var ComponentList: TSCSComponents; i: Integer; begin Result := 0; ComponentList := nil; case AOnlyFromRoot of true: ComponentList := FSCSComponents; false: ComponentList := FComponentReferences; end; if ComponentList <> nil then for i := 0 to ComponentList.Count - 1 do if ComponentList[i].ID_ComponentType = AComponentType then Inc(Result); end; function TSCSCatalog.GetComponentsByType(AGUIDType: String; AOnlyTopComponents: Boolean): TSCSComponents; var i: Integer; SCSComponent: TSCSComponent; begin Result := TSCSComponents.Create(false); for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if SCSComponent.ComponentType.GUID = AGUIDType then begin if (Not AOnlyTopComponents) or (SCSComponent.IsTop) then Result.Add(SCSComponent); end; end; end; function TSCSCatalog.GetComponRelsByIDChild(AIDChild: Integer; AConnectType: TConnectType): TList; var SCSComponent: TSCSComponent; CompRels: TList; ptrCompRel: PComplect; i, j: Integer; begin Result := TList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; CompRels := nil; case AConnectType of cntComplect: CompRels := SCSComponent.FComplects; cntUnion: CompRels := SCSComponent.FConnections; end; if CompRels <> nil then for j := 0 to CompRels.Count - 1 do begin ptrCompRel := CompRels[j]; if ptrCompRel.ID_Child = AIDChild then Result.Add(ptrCompRel); end; end; end; function TSCSCatalog.GetFirstComponent: TSCSComponent; var i: Integer; MinSortID: Integer; begin Result := nil; MinSortID := MaxInt; if FSCSComponents.Count > 0 then begin MinSortID := FSCSComponents[0].SortID; Result := FSCSComponents[0]; end; for i := 0 to FSCSComponents.Count - 1 do if Assigned(FSCSComponents[i]) then if FSCSComponents[i].SortID < MinSortID then begin Result := FSCSComponents[i]; MinSortID := Result.SortID; end; end; function TSCSCatalog.GetFirstComponentWithObjectIcon: TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; function GetComponentWithIcon(AComponent: TSCSComponent): TSCSComponent; var i: Integer; ResCompon: TSCSComponent; begin Result := nil; if AComponent.GUIDObjectIcon <> '' then Result := AComponent else for i := 0 to AComponent.FChildComplects.Count - 1 do begin ResCompon := GetComponentWithIcon(AComponent.FChildComplects[i]); if ResCompon <> nil then begin Result := ResCompon; Break; //// BREAK //// end; end; end; begin Result := nil; for i := 0 to FSCSComponents.Count - 1 do begin SCSComponent := GetComponentWithIcon(FSCSComponents[i]); if SCSComponent <> nil then begin Result := SCSComponent; Break; //// BREAK //// end; end; end; function TSCSCatalog.GetSideHeight(ANumSide: Integer): Double; var i: Integer; CurrHeight: Double; PropertyName: String; begin Result := 0; PropertyName := ''; case ANumSide of 1: PropertyName := pnHeightSide1; 2: PropertyName := pnHeightSide2; end; for i := 0 to FSCSComponents.Count - 1 do if Assigned(FSCSComponents[i]) then begin CurrHeight := FSCSComponents[i].GetPropertyValueAsFloat(PropertyName); if CurrHeight <> 0 then begin Result := CurrHeight; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.GetInterfaceByID(AIDInterfRel: Integer): TSCSInterface; var CurrComponent: TSCSComponent; CurrInterf: TSCSInterface; i: Integer; begin Result := nil; for i := 0 to FComponentReferences.Count - 1 do begin CurrComponent := FComponentReferences[i]; if Assigned(CurrComponent) then begin CurrInterf := CurrComponent.GetInterfaceByID(AIDInterfRel); if CurrInterf <> nil then begin Result := CurrInterf; Break; //// BREAK //// end; end; end; end; function TSCSCatalog.GetInterfaceByIDAndIDComponent(AIDInterfRel, AIDComponent: Integer): TSCSInterface; var SCSCompon: TSCSComponent; begin Result := nil; SCSCompon := nil; SCSCompon := GetComponentFromReferences(AIDComponent); if Assigned(SCSCompon) then Result := SCSCompon.GetInterfaceByID(AIDInterfRel); end; function TSCSCatalog.GetInterfaceByIDConnected(AIDConnected: Integer): TSCSInterface; var CurrComponent: TSCSComponent; CurrInterf: TSCSInterface; i: Integer; begin Result := nil; for i := 0 to FComponentReferences.Count - 1 do begin CurrComponent := FComponentReferences[i]; if Assigned(CurrComponent) then begin CurrInterf := CurrComponent.GetInterfaceByIDConnected(AIDConnected); if CurrInterf <> nil then begin Result := CurrInterf; Break; //// BREAK //// end; end; end; end; function TSCSCatalog.GetInterfaceCount(AInterfTypes: TIntSet; AIsBusy: Integer = biNone): Integer; var i: Integer; //ptrIntreface: TSCSInterface; begin Result := 0; for i := 0 to FComponentReferences.Count - 1 do begin Result := Result + GetComponInterfaceCount(FComponentReferences[i], AInterfTypes, AIsBusy); end; end; function TSCSCatalog.GetIOfIRelsByIDCompRel(AIDCompRel: Integer): TList; var SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; IofIRel: TSCSIOfIRel; i, j, k: Integer; begin Result := TList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(FComponentReferences.FItems.List^[i]); //22.01.2013 FComponentReferences[i]; for j := 0 to SCSComponent.Interfaces.Count - 1 do begin SCSInterface := TSCSInterface(SCSComponent.Interfaces.FItems.List^[j]); //22.01.2013 SCSComponent.Interfaces[j]; for k := 0 to SCSInterface.IOfIRelOut.Count - 1 do begin IofIRel := TSCSIOfIRel(SCSInterface.IOfIRelOut[k]); if IofIRel.IDCompRel = AIDCompRel then Result.Add(IofIRel); end; end; end; end; function TSCSCatalog.GetIOfIRelsByIDIntercface(AIDInterface: Integer): TList; var SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; IofIRel: TSCSIOfIRel; i, j, k: Integer; begin Result := TList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then for j := 0 to SCSComponent.Interfaces.Count - 1 do begin SCSInterface := SCSComponent.Interfaces[j]; if Assigned(SCSInterface) then for k := 0 to SCSInterface.IOfIRelOut.Count - 1 do begin IofIRel := TSCSIOfIRel(SCSInterface.IOfIRelOut[k]); if (IofIRel.IDInterfRel = AIDInterface) or (IofIRel.IDInterfTo = AIDInterface) then Result.Add(IofIRel); end; end; end; end; function TSCSCatalog.GetMaxMarkIDFromChildReferences(AItemType: Integer): Integer; var ChildCatalog: TSCSCatalog; MaxMarkID: Integer; i: Integer; begin Result := 0; MaxMarkID := 0; for i := 0 to FChildCatalogReferences.Count - 1 do begin ChildCatalog := FChildCatalogReferences[i]; if Assigned(ChildCatalog) then if ChildCatalog.ItemType = AItemType then if ChildCatalog.MarkID > MaxMarkID then MaxMarkID := ChildCatalog.MarkID; end; Result := MaxMarkID; end; function TSCSCatalog.GetListOwner: TSCSList; var //TopCatalog: TSCSCatalog; CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := Self; while CurrParent <> nil do begin if CurrParent is TSCSList then begin Result := TSCSList(CurrParent); CurrParent := nil; end else CurrParent := TSCSCatalog(CurrParent).FParent; end; //TopCatalog := GetTopParentCatalog; //if Assigned(TopCatalog) then // if TopCatalog is TSCSProject then // Result := TSCSProject(TopCatalog).GetListBySCSID(ListID); //TSCSList(TopCatalog.GetCatalogFromReferencesBySCSID(ListID)); end; function TSCSCatalog.GetNameForVisible(AWithComponCount: Boolean): String; var List: TSCSList; ShowObjectType: TShowType; CanAddMarkID: Boolean; begin Result := Name; List := nil; case ItemType of itSCSLine, itSCSConnector, itDir: begin if ItemType in [itSCSLine, itSCSConnector] then begin List := GetListOwner; if Assigned(List) then begin ShowObjectType := List.Setting.ShowObjectTypePM; case ShowObjectType of st_Full: Result := NameMark +' '+ Name; st_Short: if IsIndexWithName = biTrue then Result := GetNameWithIndex(Name, MarkID); //GetNameAndIndex(Name, ItemType, IndexPointObj, // IndexConnector, // IndexLine); end; end; end; if AWithComponCount then Result := GetNameAndKol(Result, KolCompon); end; itProject, itList, itRoom: begin CanAddMarkID := true; case ItemType of itProject, itList: begin CanAddMarkID := false; if IsIndexWithName = biTrue then CanAddMarkID := true; if ItemType = itList then if Self is TSCSList then if TSCSList(Self).Setting.ListType <> lt_Normal then CanAddMarkID := false; end; else CanAddMarkID := true; end; if CanAddMarkID then if (MarkID > 0) or (ItemType = itList) then Result := Result +' '+ IntToStr(MarkID); //if ((ItemType = itProject) and (IsIndexWithName = biTrue)) or // (ItemType <> itProject) then // if MarkID > 0 then // Result := Result +' '+ IntToStr(MarkID); end; end; end; //end. {С наступающим (или может быть уже с наступившим) 1 АПРЕЛЯ} (* function TSCSCatalog.GetNormInfoList: TList; var i, j, k: Integer; LookedInterfaces: TSCSInterfaces; //InterfaceNormList: TList; CurrInterfaceNormList: TList; TempList: TList; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; TraceLength: Double; Interfac: TSCSInterface; ptrJoinedInterf: TSCSInterface; ptrComplectInterf: TSCSInterface; ptrResultInterface: TSCSInterface; ptrIOfIRel: PIOfIRel; ptrInterfaceNormInfo: PInterfaceNormInfo; ptrInterfaceNormInfoI: PInterfaceNormInfo; ptrInterfaceNormInfoJ: PInterfaceNormInfo; begin Result := nil; LookedInterfaces := TSCSInterfaces.Create(false); Result := TList.Create; try for i := 0 to Self.ComponentReferences.Count - 1 do begin SCSComponent := Self.ComponentReferences[i]; TraceLength := 0; if SCSComponent.IsLine = biTrue then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.Length := SCSComponent.GetPropertyValueAsFloat(pnLength); TraceLength := SCSComponent.GetPartLength; end; SCSComponent.NormsResources.CalcResourcesCost(true, true); if Assigned(SCSComponent) then for j := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[j]; if LookedInterfaces.IndexOf(Interfac) = -1 then begin CurrInterfaceNormList := nil; //*** Получить список норм касающих интерфейса case Interfac.TypeI of itFunctional: begin if Assigned(Interfac.ConnectedInterfaces) then for k := 0 to Interfac.ConnectedInterfaces.Count - 1 do begin ptrJoinedInterf := Interfac.ConnectedInterfaces[k]; ptrResultInterface := nil; if ptrJoinedInterf <> nil then begin //*** соединение точ.-лин. if ((Interfac.IsLineCompon = biFalse) and (ptrJoinedInterf.IsLineCompon = biTrue)) or ((Interfac.IsLineCompon = biTrue) and (ptrJoinedInterf.IsLineCompon = biFalse)) then begin if Interfac.Gender = gtMale then ptrResultInterface := Interfac; if ptrJoinedInterf.Gender = gtMale then ptrResultInterface := ptrJoinedInterf; //*** Если интерфейс не занят, то его не берем if ptrResultInterface <> nil then if ptrResultInterface.IsBusy = biFalse then ptrResultInterface := nil; end; //*** соединение лин.-лин. if (Interfac.IsLineCompon = biTrue) and (ptrJoinedInterf.IsLineCompon = biTrue) then begin //*** Если не цельный кабель if SCSComponent.Whole_ID <> TSCSComponent(ptrJoinedInterf.ComponentOwner).Whole_ID then begin if Interfac.Gender = gtMale then ptrResultInterface := Interfac; if ptrJoinedInterf.Gender = gtMale then ptrResultInterface := ptrJoinedInterf; //*** Если интерфейс не занят, то его не берем if ptrResultInterface <> nil then if ptrResultInterface.IsBusy = biFalse then ptrResultInterface := nil; end; end; if ptrResultInterface <> nil then begin CurrInterfaceNormList := GetInterfaceNormInfo(ptrResultInterface); //*** Найдены нормы if CurrInterfaceNormList.Count > 0 then begin LookedInterfaces.Assign(Interfac.ConnectedInterfaces, laOr); Break; ///// BREAK ///// end; end; end; end; end; itConstructive: case SCSComponent.IsLine of biTrue: //*** Для лин. компоненты begin // Мама - занят, берем иннтерфейсы комплект-х папы if Interfac.Gender = gtFemale then if Interfac.IsBusy = biTrue then if Assigned(Interfac.IOfIRelOut) then begin for k := 0 to Interfac.IOfIRelOut.Count - 1 do begin ptrIOfIRel := Interfac.IOfIRelOut[k]; ptrComplectInterf := ptrIOfIRel.InterfaceTo; //*** интерфейс омплектующей папа (кабель) if ptrComplectInterf.Gender = gtMale then begin TempList := GetInterfaceNormInfo(ptrComplectInterf); if TempList.Count > 0 then begin if Not Assigned(CurrInterfaceNormList) then CurrInterfaceNormList := TList.Create; AssignListItems(TempList, CurrInterfaceNormList); end; FreeAndNil(TempList); end; LookedInterfaces.Add(ptrComplectInterf); end; //LookedInterfaces.Assign(Interfac.IOfIRelOut, laOr); end; // Папа - свободен if Interfac.Gender = gtMale then if Interfac.IsBusy = biFalse then CurrInterfaceNormList := GetInterfaceNormInfo(Interfac); //*** Умножить расход нормы на длину компоненты if Assigned(CurrInterfaceNormList) then for k := 0 to CurrInterfaceNormList.Count - 1 do begin ptrInterfaceNormInfo := CurrInterfaceNormList[k]; ptrInterfaceNormInfo.Expense := ptrInterfaceNormInfo.Expense * TraceLength; end; end; biFalse: //*** Для точ. компоненты if Interfac.Gender = gtMale then // можно замнить на gtFemale CurrInterfaceNormList := GetInterfaceNormInfo(Interfac); end; end; LookedInterfaces.Add(Interfac); if Assigned(CurrInterfaceNormList) then begin AssignListItems(CurrInterfaceNormList, Result); FreeAndNil(CurrInterfaceNormList); end; end; end; //*** Нормы компоненты добавить в список норм //ConvertSCSNormsToInterfNormsInfo(SCSComponent.NormsResources.Norms, Result); end; //*** Нормы СКС объектов добавить в список норм {for i := 0 to Self.ChildCatalogReferences.Count - 1 do begin SCSCatalog := Self.ChildCatalogReferences[i]; if Assigned(SCSCatalog) then if (SCSCatalog.ItemType = itSCSConnector) or (SCSCatalog.ItemType = itSCSLine) then begin if SCSCatalog.ItemType = itSCSLine then SCSCatalog.LoadLength; SCSCatalog.NormsResources.CalcResourcesCost(true, true); ConvertSCSNormsToInterfNormsInfo(SCSCatalog.NormsResources.Norms, Result); end; end; } //*** Сгруппировать ссылки на нормы for i := 0 to Result.Count - 1 do if Result[i] <> nil then begin ptrInterfaceNormInfoI := Result[i]; for j := i to Result.Count - 1 do if i <> j then if Result[j] <> nil then begin ptrInterfaceNormInfoJ := Result[j]; if ptrInterfaceNormInfoI.GUIDNBNorm = ptrInterfaceNormInfoJ.GUIDNBNorm then begin ptrInterfaceNormInfoI.Expense := ptrInterfaceNormInfoI.Expense + ptrInterfaceNormInfoJ.Expense; FreeMem(ptrInterfaceNormInfoJ); Result[j] := nil; end; end; end; Result.Pack; finally FreeAndNil(LookedInterfaces); end; end; *) function TSCSCatalog.GetObjectIcon(AIconExt: Integer): TMemoryStream; begin Result := TF_Main(FActiveForm).FNormBase.DM.GetComponIconByIconType(-1, FDesignIconType, AIconExt, FGUIDDesignIcon); end; function TSCSCatalog.GetObjectParams: TObjectParams; begin { Result.CabinetConfig.} Result.ID := SCSID; Result.MarkID := MarkID; Result.Name := Name; Result.NameShort := NameShort; Result.Caption := Name + IntToStr(MarkID); Result.IndexWithName := IsIndexWithName; if ItemType = itRoom then if FRoomSetting <> nil then begin Result.HeightCeiling := FRoomSetting.HeightCeiling; end; end; function TSCSCatalog.GetParentCatalogByItemType(AItemType: Integer): TSCSCatalog; var CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := nil; CurrParent := Parent; while CurrParent <> nil do begin if TSCSCatalog(CurrParent).ItemType = AItemType then begin Result := TSCSCatalog(CurrParent); Break; ///// BREAK ///// end else CurrParent := TSCSCatalog(CurrParent).Parent; end; end; function TSCSCatalog.GetProject: TSCSProject; var TopCatalog: TSCSCatalog; begin Result := nil; TopCatalog := GetTopParentCatalog; if (TopCatalog <> nil) and (TopCatalog is TSCSproject) then Result := TSCSproject(TopCatalog) else if (Result = nil) and (Self is TSCSProject) then Result := TSCSproject(Self); end; function TSCSCatalog.GetPropertyAsNew: PProperty; begin Result := inherited GetPropertyAsNew; if Result <> nil then Result.IDMaster := ID; end; function TSCSCatalog.GetTheirComponentJoinedTo(AJoinedComponent: TSCSComponent): TSCSComponent; var TheirSCSComponent: TSCSComponent; i: Integer; begin Result := nil; for i := 0 to FComponentReferences.Count - 1 do begin TheirSCSComponent := FComponentReferences[i]; if TheirSCSComponent.JoinedComponents.IndexOf(AJoinedComponent) <> -1 then begin Result := TheirSCSComponent; Break; ///// BREAK ///// end; end; end; function TSCSCatalog.GetTopParentCatalog: TSCSCatalog; var CurrParent: TBasicSCSClass; begin Result := nil; CurrParent := FParent; while Assigned(CurrParent) do begin Result := TSCSCatalog(CurrParent); CurrParent := TSCSCatalog(CurrParent).Parent; end; end; function TSCSCatalog.InsertCatalogByID(AIDCatalog: Integer): TSCSCatalog; var InsCatalog: TSCSCatalog; begin Result := nil; InsCatalog := TSCSCatalog.Create(ActiveForm); InsCatalog.LoadCatalogByID(AIDCatalog, false, false); InsCatalog.LoadProperties; if (InsCatalog.ParentID = ID) or ((InsCatalog.ParentID = 0) and (ItemType = itProject)) then begin ChildCatalogs.Add(InsCatalog); InsCatalog.Parent := Self; Result := InsCatalog; end else FreeAndNil(InsCatalog); end; procedure TSCSCatalog.LoadProperties; begin inherited LoadProperties(ID); end; procedure TSCSCatalog.RefreshComponsPriceAfterChangeNDS(AOldNDS, ANewNDS: Double; ASave: Boolean); var SCSComponent: TSCSComponent; i: Integer; begin for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then SCSComponent.RefreshPriceAfterChangeNDS(AOldNDS, ANewNDS, ASave); end; end; procedure TSCSCatalog.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); var i: Integer; SCSComponent: TSCSComponent; ChildCatalog: TSCSCatalog; begin NormsResources.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); for i := 0 to FSCSComponents.Count - 1 do begin SCSComponent := FSCSComponents[i]; if Assigned(SCSComponent) then SCSComponent.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; for i := 0 to ChildCatalogs.Count - 1 do begin ChildCatalog := ChildCatalogs[i]; if Assigned(ChildCatalog) then ChildCatalog.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; end; procedure TSCSCatalog.ReloadComponentReferences; var i: Integer; //SCSComponent: TSCSComponent; procedure LoadChildComponentsToReferences(AComponent: TSCSComponent); var i: Integer; //ChildComponent: TSCSComponent; begin FComponentReferences.Add(AComponent); if AComponent.ID = 26162 then EmptyProcedure; for i := 0 to AComponent.FChildComplects.Count - 1 do begin //ChildComponent := AComponent.FChildComplects[i]; //LoadChildComponentsToReferences(ChildComponent); LoadChildComponentsToReferences(AComponent.FChildComplects[i]); end; end; begin FComponentReferences.Clear; for i := 0 to FSCSComponents.Count - 1 do begin //SCSComponent := FSCSComponents[i]; //LoadChildComponentsToReferences(SCSComponent); LoadChildComponentsToReferences(FSCSComponents[i]); end; end; procedure TSCSCatalog.RemoveChildCatalog(ACatalog: TSCSCatalog); begin if FChildCatalogs.IndexOf(ACatalog) <> -1 then begin RemoveChildCatalogFromList(ACatalog); if ItemsCount > 0 then Dec(ItemsCount); if (FTreeViewNode <> nil) and (FTreeViewNode.Data <> nil) then PObjectData(FTreeViewNode.Data).ChildNodesCount := ItemsCount + KolCompon; end; end; procedure TSCSCatalog.RemoveChildCatalogFromList(AChildCatalog: TSCSCatalog); begin if Assigned(AChildCatalog) then if FChildCatalogs.IndexOf(AChildCatalog) <> -1 then begin FChildCatalogs.Remove(AChildCatalog); AChildCatalog.Parent := nil; end; end; procedure TSCSCatalog.RemoveComponentFromList(AComponent: TSCSComponent); begin if Assigned(AComponent) then if FSCSComponents.Remove(AComponent) <> -1 then AComponent.Parent := nil; end; procedure TSCSCatalog.RemoveComponentFromCatRel(AComponent: TSCSComponent); begin if Assigned(AComponent) then if FSCSComponents.IndexOf(AComponent) <> -1 then begin TF_Main(FActiveForm).OnAddDeleteNode(AComponent.TreeViewNode, AComponent, nil, false); if TF_Main(FActiveForm).GDBMode = bkNormBase then TF_Main(ActiveForm).DM.DelCatRelByIDCompon(AComponent.ID); FSCSComponents.Remove(AComponent); AComponent.Parent := nil; TF_Main(ActiveForm).F_ChoiceConnectSide.DefineObjectParamsInFuture(Self); end; end; procedure TSCSCatalog.SaveNormsToAlPlan(AFileName: String); var NormsAndResources: TSCSNormsResources; Norm: TSCSNorm; i: Integer; FileStrings: TStringList; begin NormsAndResources := GetAllNormsResources([nrAll], true, true, true, true); FileStrings := TStringList.Create; FileStrings.Add(Chr(VK_TAB)); try for i := 0 to NormsAndResources.Norms.Count - 1 do begin Norm := NormsAndResources.Norms.Items[i]; FileStrings.Add(Norm.Cypher + Chr(VK_TAB) + FloatToStr(Norm.Kolvo)); end; FileStrings.SaveToFile(AFileName); finally NormsAndResources.Free; FileStrings.Free; end; end; procedure TSCSCatalog.SetComponentsNewWholeID(AOldWholeID, ANewWholeID: Integer; AComponentsWithOldWholeID: TSCSComponents); var WholeComponents: TSCSComponents; PartCompon: TSCSComponent; i: Integer; begin if (AOldWholeID < 1) or (ANewWholeID < 1) then Exit; ///// EXIT //// WholeComponents := GetComponentsByWholeID(AOldWholeID); for i := 0 to WholeComponents.Count - 1 do begin PartCompon := WholeComponents[i]; if PartCompon.Whole_ID = AOldWholeID then begin PartCompon.Whole_ID := ANewWholeID; PartCompon.ServChangedWholeID := true; if AComponentsWithOldWholeID <> nil then AComponentsWithOldWholeID.Add(PartCompon); end; end; FreeAndNil(WholeComponents); end; { procedure TSCSCatalog.SetComponentsJoining; var i, j: Integer; SCSCompon: TSCSComponent; ptrConnection: PComplect; SCSJoined: TSCSComponent; IDComponsToFind: TIntList; SrcCompons: TSCSComponents; begin IDComponsToFind := TIntList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSCompon := FComponentReferences[i]; SCSCompon.SetInterfacesParallel; if Assigned(SCSCompon) then if SCSCompon.FConnections.Count > 0 then begin if SCSCompon.FConnections.Count = 1 then begin ptrConnection := SCSCompon.Connections[0]; SCSJoined := GetComponentFromReferences(ptrConnection.ID_Child); if Assigned(SCSJoined) then if (SCSCompon.JoinedComponents.IndexOf(SCSJoined) = -1) and (SCSJoined.JoinedComponents.IndexOf(SCSCompon) = -1) then begin SCSCompon.AddToJoined(SCSJoined); SCSCompon.SetInterfacesJoining(SCSJoined); end; end else begin IDComponsToFind.Clear; for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; if IDComponsToFind.IndexOf(ptrConnection.ID_Child) = -1 then IDComponsToFind.Add(ptrConnection.ID_Child); end; SrcCompons := GetComponentsByIDList(IDComponsToFind, FComponentReferences); for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; SCSJoined := SrcCompons.GetComponenByID(ptrConnection.ID_Child); //GetComponentFromReferences(ptrConnection.ID_Child); if Assigned(SCSJoined) then if (SCSCompon.JoinedComponents.IndexOf(SCSJoined) = -1) and (SCSJoined.JoinedComponents.IndexOf(SCSCompon) = -1) then begin SCSCompon.AddToJoined(SCSJoined); SCSCompon.SetInterfacesJoining(SCSJoined); end; end; FreeAndNil(SrcCompons); end; end; end; FreeAndNil(IDComponsToFind); end;} procedure TSCSCatalog.SetComponentsJoining(AComponsSorted: TRapObjectList); var i, j: Integer; SCSCompon: TSCSComponent; ptrConnection: PComplect; SCSJoined: TSCSComponent; IDComponsToFind: TIntList; ComponsWithConnections, SrcCompons: TSCSComponents; procedure SetLinkToJoined; begin if Assigned(SCSJoined) then if (SCSCompon.JoinedComponents.IndexOf(SCSJoined) = -1) and (SCSJoined.JoinedComponents.IndexOf(SCSCompon) = -1) then begin SCSCompon.AddToJoined(SCSJoined); SCSCompon.SetInterfacesJoining(SCSJoined); end; end; begin if AComponsSorted = nil then begin IDComponsToFind := TIntList.Create; SrcCompons := TSCSComponents.Create(false); //*** Отобрать компоненты, которые в подключениях, в отдельный список ComponsWithConnections := TSCSComponents.Create(false); for i := 0 to FComponentReferences.Count - 1 do begin //SCSCompon := FComponentReferences[i]; SCSCompon := TSCSComponent(FComponentReferences.FItems[i]); SCSCompon.SetInterfacesParallel; if SCSCompon.Connections.Count > 0 then begin ComponsWithConnections.Add(SCSCompon); for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; if IDComponsToFind.IndexOf(ptrConnection.ID_Child) = -1 then IDComponsToFind.Add(ptrConnection.ID_Child); end; end; end; SrcCompons := GetComponentsByIDList(IDComponsToFind, FComponentReferences); for i := 0 to ComponsWithConnections.Count - 1 do begin //SCSCompon := ComponsWithConnections[i]; SCSCompon := TSCSComponent(ComponsWithConnections.FItems[i]); for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; SCSJoined := SrcCompons.GetComponenByID(ptrConnection.ID_Child); //GetComponentFromReferences(ptrConnection.ID_Child); SetLinkToJoined; end; end; FreeAndNil(SrcCompons); FreeAndNil(ComponsWithConnections); FreeAndNil(IDComponsToFind); end else begin for i := 0 to FComponentReferences.Count - 1 do begin //SCSCompon := FComponentReferences[i]; SCSCompon := TSCSComponent(FComponentReferences.FItems[i]); SCSCompon.SetInterfacesParallel; for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; SCSJoined := TSCSComponent(AComponsSorted.GetObject(ptrConnection.ID_Child)); SetLinkToJoined; end; end; end; {//11.03.2009 for i := 0 to FComponentReferences.Count - 1 do begin //SCSCompon := FComponentReferences[i]; SCSCompon := TSCSComponent(FComponentReferences.FItems[i]); SCSCompon.SetInterfacesParallel; for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; SCSJoined := GetComponentFromReferences(ptrConnection.ID_Child); //TSCSComponent(AComponsSorted.GetObject(ptrConnection.ID_Child)); SetLinkToJoined; end; end; } end; {procedure TSCSCatalog.SetComponentsJoining; var i, j: Integer; SCSCompon: TSCSComponent; ptrConnection: PComplect; SCSJoined: TSCSComponent; begin for i := 0 to FComponentReferences.Count - 1 do begin //SCSCompon := FComponentReferences[i]; SCSCompon := TSCSComponent(FComponentReferences.Items[i]); SCSCompon.SetInterfacesParallel; for j := 0 to SCSCompon.Connections.Count - 1 do begin ptrConnection := SCSCompon.Connections[j]; SCSJoined := GetComponentFromReferences(ptrConnection.ID_Child); if Assigned(SCSJoined) then if (SCSCompon.JoinedComponents.IndexOf(SCSJoined) = -1) and (SCSJoined.JoinedComponents.IndexOf(SCSCompon) = -1) then begin SCSCompon.AddToJoined(SCSJoined); SCSCompon.SetInterfacesJoining(SCSJoined); end; end; end; end; } procedure TSCSCatalog.SetComponInterfacesForComlects; var i: Integer; SCSComponent: TSCSComponent; begin for i := 0 to ComponentReferences.Count - 1 do begin SCSComponent := ComponentReferences[i]; if Assigned(SCSComponent) then SCSComponent.SetInterfacesComplect; end; end; procedure TSCSCatalog.SetParentWithNoReferences(AParent: TSCSCatalog); begin FParent := AParent; end; procedure TSCSCatalog.UpdateComponsChangedFields; var i: Integer; SCSCatalogOwner: TSCSCatalog; SCSComponent: TSCSComponent; begin if TF_Main(FActiveForm).GDBMode = bkProjectManager then for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if Assigned(SCSComponent) then begin //SCSComponent.UpdateChangedFields; if Not SCSComponent.ServToDelete then if SCSComponent.ServChangedMarkID or SCSComponent.ServChangedNameFromTo or SCSComponent.ServChangedWholeID then begin if SCSComponent.ServChangedMarkID or SCSComponent.ServChangedNameFromTo then begin SCSCatalogOwner := SCSComponent.GetFirstParentCatalog; if SCSComponent.ServChangedMarkID then SCSComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(SCSComponent, SCSCatalogOwner, false); if SCSComponent.TreeViewNode <> nil then SCSComponent.TreeViewNode.Text := TF_Main(FActiveForm).GetNameNode(SCSComponent.TreeViewNode, SCSComponent, true, true); end; SCSComponent.ServChangedMarkID := false; SCSComponent.ServChangedNameFromTo := false; SCSComponent.ServChangedWholeID := false; end; end; end; end; procedure TSCSCatalog.LoadChildCatalogs(ARecursive, ADevideComplects, ALoadComponData: Boolean; AFieldBy: String = ''); var //IDList: Tlist; Catalogs: TList; ptrCatalog: PCatalog; i, j: Integer; SCSCatalog: TSCSCatalog; Compon: TSCSComponent; strOrderBy: String; begin //DefineQuery; ChildCatalogs.Clear; strOrderBy := ''; if AFieldBy <> '' then strOrderBy := ' order by ' + AFieldBy; Catalogs := Tlist.Create; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, ' select id from katalog where (parent_id = '''+IntToStr(ID)+''') or (parent_id = '''+IntToStr(0)+''') ' + strOrderBy); while Not FQSelect.Eof do begin GetMem(ptrCatalog, SizeOf(TCatalog)); ptrCatalog.ID := FQSelect.FN(fnID).AsInteger; ptrCatalog.ItemType := FQSelect.FN(fnIDItemType).AsInteger; ptrCatalog.Scs_ID := FQSelect.FN(fnSCSID).AsInteger; Catalogs.Add(ptrCatalog); FQSelect.Next; end; //TF_Main(ActiveForm).DM.IntFieldToList(IDList, FQuery_Select, 'id'); end; qmMemory: begin { SetFilterToSQLMemTable(FMemTable, 'parent_id = '''+IntToStr(ID)+''''); if AFieldBy <> '' then FMemTable.IndexName := GetIndexByFldFomSQLMemTable(FMemTable, AFieldBy); for i := 0 to FMemTable.RecordCount - 1 do begin FMemTable.RecNo := i+1; GetMem(ptrCatalog, SizeOf(TCatalog)); ptrCatalog.ID := FMemTable.FieldByName(fnID).AsInteger; ptrCatalog.ItemType := FMemTable.FieldByName(fnIDItemType).AsInteger; ptrCatalog.Scs_ID := FMemTable.FieldByName(fnSCSID).AsInteger; Catalogs.Add(ptrCatalog); end; //TF_Main(ActiveForm).DM.IntFieldToListFromSQLMemTable(IDList, FMemTable, fnID); if AFieldBy <> '' then FMemTable.IndexName := ''; } end; end; for i := 0 to Catalogs.Count - 1 do begin ptrCatalog := Catalogs[i]; SCSCatalog := nil; if ptrCatalog.ItemType = itProject then begin SCSCatalog := TSCSProject.Create(ActiveForm); TSCSProject(SCSCatalog).Parent := Self; end else if ptrCatalog.ItemType = itList then begin SCSCatalog := TSCSList.Create(ActiveForm); TSCSList(SCSCatalog).Parent := Self; end else begin SCSCatalog := TSCSCatalog.Create(ActiveForm); SCSCatalog.Parent := Self; end; if Assigned(SCSCatalog) then begin //SCSCatalog := TSCSCatalog.Create(ActiveForm); SCSCatalog.TreeViewNode := nil; //SCSCatalog.Parent := Self; ChildCatalogs.Add(SCSCatalog); if ptrCatalog.ItemType in [itProject, itList] then TSCSList(SCSCatalog).Open(ptrCatalog.Scs_ID) //TSCSList(SCSCatalog).CurrID := ptrCatalog.Scs_ID else SCSCatalog.LoadCatalogByID(ptrCatalog.ID, false, false); if ARecursive then begin SCSCatalog.LoadChildCatalogs(ARecursive, ADevideComplects, ALoadComponData); SCSCatalog.LoadComponents(SCSCatalog.ID, true); for j := 0 to SCSCatalog.SCSComponents.Count - 1 do begin Compon := SCSCatalog.SCSComponents[j]; Compon.LoadChildComplects(true, ADevideComplects, ALoadComponData); end; end; end; end; FreeList(Catalogs); end; // ##### ##### procedure TSCSCatalog.LoadCatalogByID(AIDCatalog: Integer; ALoadCompons: Boolean=true; ALoadCompData: Boolean=true; ALoadSQL: Boolean=true); var strWhere: String; begin //ActivateTransaction; //FQuery := (ActiveForm as TF_Main).DM.Query_TSCSCompon; Clear; //DefineQuery; //strWhere := 'id = '''+IntToStr(AIDCatalog)+''''; case FQueryMode of qmPhisical: begin FQSelect.Close; if ALoadSQL then SetSQLToFIBQuery(FQSelect, 'select * from katalog where id = :id', false); FQSelect.ParamByName(fnId).AsInteger := AIDCatalog; FQSelect.ExecQuery; ID := FQSelect.FN(fnID).AsInteger; ParentID := FQSelect.FN(fnParentID).AsInteger; Name := FQSelect.FN(fnName).AsString; // HARDCOD Hyperline - через Y if name = 'Hiperline' then name := 'Hyperline'; KolCompon := FQSelect.FN(fnKolCompon).AsInteger; ItemType := FQSelect.FN(fnIDItemType).AsInteger; ItemsCount := FQSelect.FN(fnItemsCount).AsInteger; if TF_Main(ActiveForm).GDBMode = bkProjectManager then begin //ProjectID := FQSelect.FN('Project_id').AsInteger; ListID := FQSelect.FN(fnListID).AsInteger; NameShort := FQSelect.FN(fnNameShort).AsString; NameMark := FQSelect.FN(fnNameMark).AsString; MarkID := FQSelect.FN(fnMarkID).AsInteger; IsUserName := FQSelect.FN(fnIsUserName).AsInteger; SCSID := FQSelect.FN(fnSCSID).AsInteger; IndexPointObj := FQSelect.FN(fnIndexConn).AsInteger; IndexLine := FQSelect.FN(fnIndexLine).AsInteger; IndexConnector := FQSelect.FN(fnIndexJoiner).AsInteger; if FQSelect.FieldIndex[fnIsIndexWithName] <> -1 then IsIndexWithName := FQSelect.FN(fnIsIndexWithName).AsInteger; end; SortID := FQSelect.FN(fnSortID).AsInteger; end; qmMemory: begin { FMemTable.Filtered := false; if FMemTable.Locate(fnID, AIDCatalog, []) then LoadFromMemTable; //if SetFilterToSQLMemTable(FMemTable, strWhere) then // LoadFromMemTable; } end; end; if ALoadCompons then LoadComponents(AIDCatalog, ALoadCompData); end; (* procedure TSCSCatalog.LoadCatalogByIDFigure(AIDFigure: Integer; ALoadCompons, ALoadCompData: Boolean); var IDCat: Integer; begin try IDCat := TF_Main(ActiveForm).DM.GetIDCatalogByIDFigure(AIDFigure); LoadCatalogByID(IDCat, ALoadCompons, ALoadCompData); except on E: Exception do AddExceptionToLog('TSCSCatalog.LoadCatalogBySCSID: '+E.Message); end; end; procedure TSCSCatalog.LoadCatalogBySCSID(ASCSID: Integer; ALoadCompons, ALoadCompData: Boolean); var IDCat: Integer; begin try IDCat := TF_Main(ActiveForm).DM.GetIDCatalogBySCSID(ASCSID); LoadCatalogByID(IDCat, ALoadCompons, ALoadCompData); except on E: Exception do AddExceptionToLog('TSCSCatalog.LoadCatalogBySCSID: '+E.Message); end; end; *) procedure TSCSCatalog.LoadLength; begin try Length := 0; Length := GetPropertyValueAsFloat(pnLength); //TF_Main(ActiveForm).DM.GetPropertyValueAsFloat(tkCatalog, ID, pnLength, FQueryMode, -1); except on E: Exception do AddExceptionToLog('TSCSCatalog.LoadLength: '+E.Message); end; end; procedure TSCSCatalog.Save; begin if ID > 0 then SaveData(meEdit) else SaveData(meMake); end; procedure TSCSCatalog.SaveAsNew; begin SaveData(meMake); end; function TSCSCatalog.UpdateObjectName: String; begin Name := GetOobjectName(true); end; function TSCSCatalog.GetOobjectName(AShowKolCompon: Boolean): String; begin {with TF_Main(ActiveForm).GListSetting do begin Result := Name; if IsUserName = biFalse then case Setting.ShowObjectType of st_Full: Result := Name; st_Short: Result := NameShort; end; end;} end; // ##### ##### procedure TSCSCatalog.LoadComponents(AIDCatalog: Integer; ALoadCompData: Boolean =true); var SCSCompon: TSCSComponent; CompIDList: TIntList; i: Integer; strWhere: String; //ptrID: ^Integer; begin //DefineQuery; //22.08.2007 UpperComponents.Clear; //ClearListWithObjects(SCSComponents); SCSComponents.Clear; strWhere := 'id_catalog = '''+IntToStr(AIDCatalog)+''''; CompIDList := TIntList.Create; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, 'select id_component from catalog_relation where '+strWhere); IntFIBFieldToIntList(CompIDList, FQSelect, fnIDComponent); end; qmMemory: with TF_Main(ActiveForm).DM do begin { SetFilterToSQLMemTable(tSQL_CatalogRelation, strWhere); TF_Main(ActiveForm).DM.IntFieldToListFromSQLMemTable(CompIDList, tSQL_CatalogRelation, fnIDComponent); SetFilterToSQLMemTable(tSQL_CatalogRelation, strWhere); SetFilterToSQLMemTable(tSQL_Component, 'object_id = '''+IntToStr(AIDCatalog)+''''); tSQL_Component.IndexName := GetIndexByFldFomSQLMemTable(tSQL_Component, ASortFld); 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(ptrID, SizeOf(Integer)); ptrID^ := tSQL_Component.FieldByName(fnID).AsInteger; Result.Add(ptrID); end; tSQL_CatalogRelation.Next; end; tSQL_Component.Next; end; tSQL_Component.IndexName := ''; } end; end; for i := 0 to CompIDList.Count - 1 do begin SCSCompon := TSCSComponent.Create(ActiveForm); SCSCompon.Parent := Self; SCSCompon.LoadComponentByID(CompIDList[i], ALoadCompData); SCSComponents.Add(SCSCompon); end; SCSComponents.SortBySortID; CompIDList.Free; end; procedure TSCSCatalog.LoadAllComponents(AIDCatalog: Integer; ALoadCompData: Boolean = true); var SCSCompon: TSCSComponent; CompIDList: TIntList; i: Integer; ComplectsList: TList; begin try try ComplectsList := TList.Create; //DefineQuery; //22.08.2007 UpperComponents.Clear; //ClearListWithObjects(SCSComponents); SCSComponents.Clear; //CompIDList := TList.Create; //SetSQLToQuery(FQuery_Select, ' select id_component from catalog_relation where id_catalog = '''+IntToStr(AIDCatalog)+''''); //TF_Main(ActiveForm).DM.IntFieldToList(CompIDList, FQuery_Select, 'id_component'); CompIDList := TF_Main(ActiveForm).DM.GetCatalogComponentsID(AIDCatalog); {22.08.2007 for i := 0 to CompIDList.Count - 1 do begin SCSCompon := TSCSComponent.Create(ActiveForm); SCSCompon.Parent := Self; SCSCompon.IDTopComponent := CompIDList[i]; SCSCompon.LoadComponentByID(CompIDList[i], ALoadCompData, true, false); SCSComponents.Add(SCSCompon); UpperComponents.Add(SCSCompon); SCSCompon.LoadAllSCSComplects([cdNone]); if SCSCompon.AllSCSComplects.Count > 0 then begin SCSComponents.Assign(SCSCompon.AllSCSComplects, laOr); SCSCompon.AllSCSComplects.Clear; end; end; } for i := 0 to CompIDList.Count - 1 do begin SCSCompon := TSCSComponent.Create(ActiveForm); SCSCompon.Parent := Self; SCSCompon.IDTopComponent := CompIDList[i]; SCSCompon.LoadComponentByID(CompIDList[i], ALoadCompData, true, false); SCSCompon.LoadChildComplects(true, false, ALoadCompData, SCSCompon.IDTopComponent); SCSComponents.Add(SCSCompon); //22.08.2007 UpperComponents.Add(SCSCompon); end; except on E: Exception do AddExceptionToLog('TSCSCatalog.LoadAllComponentns: '+E.Message); end; finally FreeAndNil(ComplectsList); FreeAndNil(CompIDList); end; end; //22.08.2007 //procedure TSCSCatalog.LoadAllComponentsByObjectID(AIDObject: Integer; AFieldIndexses: TIntSet); //var SCSCompon: TSCSComponent; // CompIDList: TList; // i: Integer; // //QSelect: TSCSQuery; //begin // try // try // //DefineQuery; // // UpperComponents.Clear; // //ClearListWithObjects(SCSComponents); // SCSComponents.Clear; // // CompIDList := TF_Main(ActiveForm).DM.GetCatalogComponentsIDByObjectID(AIDObject); // for i := 0 to CompIDList.Count - 1 do // begin // SCSCompon := TSCSComponent.Create(ActiveForm); // SCSCompon.ID := Integer(CompIDList[i]^); // SCSComponents.Add(SCSCompon);// // SCSCompon.LoadComponentByFi(AFieldIndexses); // end; // FreeList(CompIDList);// // { SetSQLToQuery(FQuery_Select, ' select ID from component where object_id = '''+IntToStr(AIDObject)+''' '); // while Not FQuery_Select.Eof do // begin // SCSCompon := TSCSComponent.Create(ActiveForm); // SCSCompon.ID := FQuery_Select.GetFNAsInteger('id'); // SCSComponents.Add(SCSCompon);// // FQuery_Select.Next; // end; }// // { with TF_Main(ActiveForm).DM do // QSelect := TSCSQuery.Create(ActiveForm, Query_Select, qSQL_QuerySelect); // SetSQLToQuery(QSelect, ' select ID from component where object_id = '''+IntToStr(AIDObject)+''' '); // while Not QSelect.Eof do // begin // SCSCompon := TSCSComponent.Create(ActiveForm); // SCSCompon.ID := QSelect.GetFNAsInteger('id'); // SCSComponents.Add(SCSCompon);// // QSelect.Next; // end; // QSelect.Free; // // for i := 0 to SCSComponents.Count - 1 do // begin // SCSCompon := SCSComponents[i]; // SCSCompon.LoadComponentByFi(AFieldIndexses); // end; } // // //*** Компоненты высшего уровня // for i := 0 to SCSComponents.Count - 1 do // begin // SCSCompon := SCSComponents[i]; // if TF_Main(ActiveForm).DM.GetCatRelCountByFilter(fnID, '(id_component = '''+IntToStr(SCSCompon.ID)+''') and (id_catalog = '''+IntToStr(AIDObject)+''')', true) > 0 then // UpperComponents.Add(SCSCompon); // end; // //FQuery_Select.Close;// // { // //*** Компоненты высшего уровня // ChangeSQLQuery(FQuery_Select, ' select count(*) As Cnt from catalog_relation '+ // ' where (id_component = :id_component) and (id_catalog = '''+IntToStr(AIDObject)+''') '); // for i := 0 to SCSComponents.Count - 1 do // begin // SCSCompon := SCSComponents[i]; // // FQuery_Select.Close; // FQuery_Select.SetParamAsInteger('id_component', SCSCompon.ID); // FQuery_Select.ExecQuery; // if FQuery_Select.GetFNAsInteger('Cnt') > 0 then // UpperComponents.Add(SCSCompon); // end; // FQuery_Select.Close; } // except // on E: Exception do AddExceptionToLog('TSCSCatalog.LoadAllComponentsByObjectID: '+E.Message); // end; // finally // //FreeList(CompIDList); // end; //end; function TSCSCatalog.CalcResourcesCost(ACalcComponWorkCost, ACalcNormTotalCost, ACalcNormCost: Boolean): Double; var i: Integer; SCSComponent: TSCSComponent; CurrResourceCost: Double; begin Result := 0; try CurrResourceCost := 0; for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents.Items[i]; if ACalcComponWorkCost then SCSComponent.NormsResources.CalcResourcesCost(ACalcNormTotalCost, ACalcNormCost); CurrResourceCost := NormsResources.ResourcesCost + CurrResourceCost; end; ResourcesCost := CurrResourceCost; Result := CurrResourceCost; except on E: Exception do AddExceptionToLog('TSCSCatalog.CalcWorkCost: '+E.Message); end; end; {22.08.2007 function TSCSCatalog.GetAllInterfID: TList; var ResList: TList; CurrComponInteraces: Tlist; i: Integer; SCSCompon: TSCSComponent; begin try Result := nil; ResList := TList.Create; if SCSComponents.Count = 0 then LoadAllComponents(ID, false); for i := 0 to SCSComponents.Count - 1 do begin SCSCompon := SCSComponents.Items[i]; CurrComponInteraces := SCSCompon.GetAllInterfIDCompon; if CurrComponInteraces <> nil then begin ResList.Assign(CurrComponInteraces, laOr); FreeAndNil(CurrComponInteraces); end; end; if Reslist.Count = 0 then ResList.Free else Result := ResList; except on E: Exception do AddExceptionToLog('TSCSCatalog.GetAllInterfID: '+E.Message); end; end;} function TSCSCatalog.RemoveChildCatalogByID(AID: Integer): Boolean; var RmCatalog: TSCSCatalog; begin Result := false; RmCatalog := GetCatalogFromReferences(AID); if RmCatalog <> nil then begin FreeAndNil(RmCatalog); Result := true; end; end; {TSCSCatalogExtended} // ##################### Класс TSCSCatalogExtended ############################# // ############################################################################# // procedure TSCSCatalogExtended.Clear; begin inherited; FIDFromOpened := 0; FCADCrossObjects.Clear; FCADNorms.Clear; FSpravochnik.Clear; FSpravComponents.Clear; FFilters.Clear; FUpdatedSprObjIcons.Clear; TMemoryStream(FMarkMasrksStream).Clear; FConnectedComponsList.Clear; end; constructor TSCSCatalogExtended.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); //ActiveForm := AFormOwner; FActive := false; FCurrID := -1; FConnectedComponsList := TConnectedComponsList.Create; FMemBase := TMemBase.Create(Self); FMarkMasks := TList.Create; //FMTMarkMasks := nil; //FDSrcMarkMasks := nil; FIsClousing := false; FIsOpening := false; FLoadComponData := true; //FComponRefSortedByID := TRapObjectList.Create; //FCatalogRefSortedByID := TRapObjectList.Create; //FCatalogRefSortedBySCSID := TRapObjectList.Create; FCADCrossObjects := TObjectList.Create(true); FCADNorms := TObjectList.Create(true); FSpravochnik := TSpravochnik.Create(FActiveForm, Self); FSpravComponents := TSCSComponents.Create(true); FStringsMan := TStringsMan.Create(Self); FFilters := TObjectList.Create(true); FObjectsBlobs := TObjectsBlobs.Create(FActiveForm); FUpdatedSprObjIcons := TStringList.Create; FUpdatedSprObjIcons.Sorted := true; FMarkMasrksStream := TMemoryStream.Create; end; destructor TSCSCatalogExtended.Destroy; begin //CurrID := -1; Close; //FreeAndNil(FComponRefSortedByID); //FreeAndNil(FCatalogRefSortedByID); //FreeAndNil(FCatalogRefSortedBySCSID); FreeAndNil(FObjectsBlobs); FreeAndNil(FSpravComponents); FreeAndNil(FSpravochnik); FreeAndNil(FCADNorms); FreeAndNil(FCADCrossObjects); FreeAndNil(FMarkMasrksStream); FreeList(FMarkMasks); FreeAndNil(FMemBase); FreeAndNil(FStringsMan); FreeAndNil(FFilters); FreeAndNil(FConnectedComponsList); FreeAndNil(FUpdatedSprObjIcons); inherited end; procedure TSCSCatalogExtended.AssignCADCrossObjects(ACADCrossObjects: TObjectList); var i: Integer; NewCADCrossObject: TCADCrossObject; begin FCADCrossObjects.Clear; for i := 0 to ACADCrossObjects.Count - 1 do begin NewCADCrossObject := TCADCrossObject.Create; NewCADCrossObject.Assign(TCADCrossObject(ACADCrossObjects[i])); FCADCrossObjects.Add(NewCADCrossObject); end; end; procedure TSCSCatalogExtended.AssignCADNorms(ACADNorms: TObjectList); var CADNormStruct: TCADNormStruct; i: Integer; begin CopyCADNormsToList(ACADNorms, FCADNorms); for i := 0 to FCADNorms.Count - 1 do begin CADNormStruct := TCADNormStruct(FCADNorms[i]); CADNormStruct.IDCatalog := ID; CADNormStruct.CatalogItemType := ItemType; end; end; procedure TSCSCatalogExtended.SetActive(Value: Boolean); begin if Value = FActive then Exit; ///// Exit ///// if Value = true then Open(FCurrID); if Value = false then Close; end; procedure TSCSCatalogExtended.SetCurrID(Value: Integer); begin if Value = FCurrID then Exit; ///// Exit ///// Close; Open(Value); {Save; FCurrID := Value; Load;} end; procedure TSCSCatalogExtended.CleanComponIDList(AComponIDList: TIntList); var i: Integer; begin i := 0; while i <= AComponIDList.Count - 1 do begin if GetComponentFromReferences(AComponIDList[i]) = nil then AComponIDList.Delete(i) else Inc(i); end; end; procedure TSCSCatalogExtended.OpenWithParams(AID: Integer; AAsLoaded: Boolean); var IDOpen: Integer; begin try if AID > 0 then begin if FActive then Close; IDOpen := -1; if Not AAsLoaded then IDOpen := AID else case ItemType of itList: IDOpen := SCSID; else IDOpen := ID; end; if IDOpen > 0 then begin FIsOpening := true; try FCurrID := IDOpen; if Assigned(FOnBeforeOpen) then FOnBeforeOpen(Self); //FMTMarkMasks := TSQLMemTable.Create(nil); //FDSrcMarkMasks := TDataSource.Create(nil); //FDSrcMarkMasks.DataSet := FMTMarkMasks; if Not AAsLoaded then Load; LoadMarkMasks; FActive := true; if Assigned(FOnAfterOpen) then FOnAfterOpen(Self); finally FIsOpening := false; end; end; end; except on E: Exception do AddExceptionToLog('TSCSCatalogExtended.OpenWithParams: '+E.Message); end; end; procedure TSCSCatalogExtended.SaveMarkMaskAsNew(var ACatalogMarkMask: TCatalogMarkMask); begin (* try {with TF_Main(ActiveForm).DM do begin Query_Operat.Close; Query_Operat.SQL.Text := ' insert into catalog_mark_mask (id_catalog, id_component_type, mark_mask) '+ ' values (:id_catalog, :id_component_type, :mark_mask) '; Query_Operat.ParamByName('id_Catalog').AsInteger := ID; Query_Operat.ParamByName('id_component_type').AsInteger := ACatalogMarkMask.IDComponentType; Query_Operat.ParamByName('mark_mask').AsString := ACatalogMarkMask.MarkMask; Query_Operat.ExecQuery; SetSQLToQuery(FQuery_Select, ' select MAX(ID) from catalog_mark_mask '); ACatalogMarkMask.ID := FQuery_Select.GetFNAsInteger('MAX'); ACatalogMarkMask.MakeEdit := meNone; end; } case FQueryMode of qmPhisical: begin ChangeSQLQuery(FQuery_Operat, ' insert into catalog_mark_mask (id_catalog, id_component_type, mark_mask) '+ ' values (:id_catalog, :id_component_type, :mark_mask) '); FQuery_Operat.SetParamAsInteger('id_Catalog', ID); FQuery_Operat.SetParamAsInteger('id_component_type', ACatalogMarkMask.IDComponentType); FQuery_Operat.SetParamAsString('mark_mask', ACatalogMarkMask.MarkMask); FQuery_Operat.ExecQuery; FQuery_Operat.Close; SetSQLToQuery(FQuery_Select, ' select MAX(ID) As max_id from catalog_mark_mask '); ACatalogMarkMask.ID := FQuery_Select.GetFNAsInteger('Max_id'); ACatalogMarkMask.MakeEdit := meNone; FQuery_Select.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin tSQL_CatalogMarkMask.Append; tSQL_CatalogMarkMask.FieldByName('id_Catalog').AsInteger := ID; tSQL_CatalogMarkMask.FieldByName('id_component_type').AsInteger := ACatalogMarkMask.IDComponentType; tSQL_CatalogMarkMask.FieldByName('mark_mask').AsString := ACatalogMarkMask.MarkMask; tSQL_CatalogMarkMask.Post; ACatalogMarkMask.ID := tSQL_CatalogMarkMask.FieldByName(fnID).AsInteger; ACatalogMarkMask.MakeEdit := meNone; end; end; except on E: Exception do AddExceptionToLog('SaveAsNewMarkMask: '+E.Message); end; *) end; procedure TSCSCatalogExtended.UpdateMarkMask(var ACatalogMarkMask: TCatalogMarkMask); begin (* try case FQueryMode of qmPhisical: begin ChangeSQLQuery(FQuery_Operat, ' update catalog_mark_mask set mark_mask = :mark_mask where id = :id '); FQuery_Operat.SetParamAsInteger('id', ACatalogMarkMask.ID); FQuery_Operat.SetParamAsString('mark_mask', ACatalogMarkMask.MarkMask); FQuery_Operat.ExecQuery; FQuery_Operat.Close; ACatalogMarkMask.MakeEdit := meNone; end; qmMemory: with TF_Main(ActiveForm).DM do begin if SetFilterToSQLMemTable(tSQL_CatalogMarkMask, 'id = '''+IntToStr(ACatalogMarkMask.ID)+'''') then begin tSQL_CatalogMarkMask.Edit; tSQL_CatalogMarkMask.FieldByName('mark_mask').AsString := ACatalogMarkMask.MarkMask; tSQL_CatalogMarkMask.Post; end; ACatalogMarkMask.MakeEdit := meNone; end; end; except on E: Exception do AddExceptionToLog('SaveAsNewMarkMask: '+E.Message); end; *) end; procedure TSCSCatalogExtended.AssignMarkMasks(AMarkMasks: TList; AsNew: Boolean); var i: Integer; ptrCatalogMarkMask: PCatalogMarkMask; begin if AMarkMasks = nil then Exit; //// EXIT ///// ClearList(MarkMasks); for i := 0 to AMarkMasks.Count - 1 do begin //New(ptrCatalogMarkMask); GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask^ := TCatalogMarkMask(AMarkMasks[i]^); ptrCatalogMarkMask^.IDCatalog := ID; ptrCatalogMarkMask^.MakeEdit := meMake; FMarkMasks.Add(ptrCatalogMarkMask); end; end; procedure TSCSCatalogExtended.AssignSprComponents(AComponents: TSCSComponents); var i: Integer; SrcComponent: TSCSComponent; NewComponent: TSCSComponent; begin FSpravComponents.Clear; for i := 0 to AComponents.Count - 1 do begin SrcComponent := AComponents[i]; NewComponent := TSCSComponent.Create(FActiveForm); NewComponent.Assign(SrcComponent, true, true); NewComponent.AssignChildComponents(SrcComponent.ChildComplects, true, true); AddComponToSprComponents(NewComponent); end; end; procedure TSCSCatalogExtended.AddComponToSprComponents(AComponent: TSCSComponent); var i: Integer; procedure DefineProjectOwner(ACompon: TSCSComponent); begin if Self is TSCSProject then ACompon.FProjectOwner := TSCSProject(Self); end; begin if FSpravComponents.IndexOf(AComponent) = -1 then begin FSpravComponents.Add(AComponent); AComponent.FParent := Self; DefineProjectOwner(AComponent); for i := 0 to AComponent.ChildReferences.Count - 1 do DefineProjectOwner(AComponent.ChildReferences[i]); end; end; procedure TSCSCatalogExtended.ApplySpavDataForObjects; var i, j, k: Integer; SprNorm: TNBNorm; SprResource: TNBResource; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; SCSResource: TSCSResourceRel; SCSNorm: TSCSNorm; begin for i := 0 to FSpravochnik.FNBNorms.Count - 1 do begin SprNorm := TNBNorm(FSpravochnik.FNBNorms[i]); if SprNorm.IsApplyDataForAllSame then begin for j := 0 to ComponentReferences.Count - 1 do begin SCSComponent := ComponentReferences[j]; for k := 0 to SCSComponent.NormsResources.Norms.Count - 1 do begin SCSNorm := SCSComponent.NormsResources.Norms[k]; if SCSNorm.GuidNB = SprNorm.GUID then begin SCSNorm.Cypher := SprNorm.Cypher; SCSNorm.Name := SprNorm.Name; SCSNorm.Izm_ := SprNorm.Izm; SCSNorm.LaborTime := SprNorm.LaborTime; SCSNorm.PricePerTime := SprNorm.PricePerTime; SCSNorm.Price := SprNorm.Price; end; end; end; end; end; for i := 0 to FSpravochnik.FNBResources.Count - 1 do begin SprResource := TNBResource(FSpravochnik.FNBResources[i]); if SprResource.IsApplyDataForAllSame then begin for j := 0 to ComponentReferences.Count - 1 do begin SCSComponent := ComponentReferences[j]; for k := 0 to SCSComponent.NormsResources.Resources.Count - 1 do begin SCSResource := SCSComponent.NormsResources.Resources[k]; if SCSResource.GuidNB = SprResource.GUID then begin SCSResource.Cypher := SprResource.Cypher; SCSResource.Name := SprResource.Name; SCSResource.Izm := SprResource.Izm; SCSResource.Price := SprResource.Price; SCSResource.RType := SprResource.RType; end; end; end; end; end; end; function TSCSCatalogExtended.CheckUseCompRelAtInterfaces(AIDCompRel: Integer): Boolean; var IOfIRelList: TList; begin Result := false; IOfIRelList := GetIOfIRelsByIDCompRel(AIDCompRel); if Assigned(IOfIRelList) then begin if IOfIRelList.Count > 0 then Result := true; IOfIRelList.Free; end; end; procedure TSCSCatalogExtended.CopyCADNormsToList(ASrcList, ADestList: TObjectList); var CADNormStruct: TCADNormStruct; NewCADNormStruct: TCADNormStruct; i: Integer; begin ADestList.Clear; for i := 0 to ASrcList.Count - 1 do begin CADNormStruct := TCADNormStruct(ASrcList[i]); NewCADNormStruct := TCADNormStruct.Create; ADestList.Add(NewCADNormStruct); NewCADNormStruct.Assing(CADNormStruct); end; end; function TSCSCatalogExtended.CreateObjFromObjectsBlob(AObjectClass: TComponentClass; ATableKind, ADataKind, AObjectID: Integer): TComponent; var ObjBlob: TObjectsBlob; UnpackedStream: TMemoryStream; begin Result := nil; ObjBlob := GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID); if ObjBlob <> nil then begin ObjBlob.ObjectData.Position := 0; Result := AObjectClass.Create(nil); if CheckPakedStream(ObjBlob.ObjectData) then begin UnpackedStream := TMemoryStream.Create; UnPakStream(ObjBlob.ObjectData, UnpackedStream); UnpackedStream.Position := 0; TComponentLoadFromStream(Result, UnpackedStream); FreeAndNil(UnpackedStream); end else TComponentLoadFromStream(Result, ObjBlob.ObjectData); end; end; // Tolik -- 27/04/2017-- старая закомменчена см. ниже procedure TSCSCatalogExtended.DefineObjectsParamsInCADByServFld; var i, j, PrevCount: Integer; SCSObject, ChildObject: TSCSCatalog; tmpF: TFigure; SavedGCadForm: TF_CAD; Refreshflag: Boolean; // Tolik 27/10/2017 -- //F_ProgressFormVisibility: Boolean; ProgressStarted: Boolean; // Tolik 24/11/2021 -- begin i := 0; SavedGCadForm := GCadForm; //Tolik 27/10/2017 -- RefreshFlag := GCanREfreshCad; GCanRefreshCad := False; SetCADsProgressMode(true); // try if (GEndpoint = nil) or ((GListWithEndPoint <> nil) and (GCadForm = GListWithEndPoint)) then begin // -- Здесь форма прогресса перекроет вопрос на автоматическую расстановку // точечных объектов при дропе на КАД из НБ, так что юзать не желательно -- Tolik -- 31/10/2017 // да и кроме того вызов BeginProgress если мы сюда попали при удалении кабинета ни к чему // не приведет потому что в EndProgress; есть BaseEndUpdate в которой в наглую вызывается // процедура обработки таймера // а GIsProgressHandling сбрасывается аж потом.... (* if Assigned(F_Progress) then // // Tolik 27/10/2017 begin F_ProgressFormVisibility := F_Progress.Visible; F_Progress.Visible := True; ProgressPaused := False; {if GIsProgress then begin PauseProgress(True); ProgressPaused := True; end;} BeginProgress(cProgress_Mes1, FChildCatalogReferences.Count - 1, true); F_Progress.BringToFront; end;*) //Tolik 24/11/2021 -- {ProgressStarted := False; if FChildCatalogReferences.Count > 30 then begin if Assigned(F_Progress) then F_Progress.StartProgress(cProgress_Mes1, FChildCatalogReferences.Count, true); end;} while i <= FChildCatalogReferences.Count - 1 do begin SCSObject := FChildCatalogReferences[i]; PrevCount := FChildCatalogReferences.Count; if SCSObject.ItemType in [itSCSLine, itSCSConnector] then begin GCadForm := GetListByID(SCSObject.GetListOwner.SCSID); // Tolik 16/05/2017 -- if GCadForm <> nil then begin tmpF := GetFigureByID(GCadForm, SCSObject.SCSID); if (assigned(tmpF)) and (not tmpF.Deleted) then begin if SCSObject.ServToDefineParamsInCAD then begin SCSObject.ServToDefineParamsInCAD := false; TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParams(SCSObject); end else begin if dopStatus in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectStatus(SCSObject); if dopIcon in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSObject); end; if dopJoinedTrunk in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectJoinedTrunk(SCSObject); if dopTrunkChanged in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectTrunkAfterChange(SCSObject); if dopLengthNearPointObject in SCSObject.ServToDefineObjParams then RefreshLengthInFutureNearPointObject(SCSObject); if dopMark in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(SCSObject); SCSObject.ServToDefineObjParams := []; end; end; end; //*** Если пред. количество не совп-т с текущим, то вероятно что был удален объект // При определении параметров высот if PrevCount = FChildCatalogReferences.Count then Inc(i); (* if Assigned(F_Progress) then // Tolik 27/10/2017 -- StePProgressRE;*) //if ProgressStarted then // StepProgress; end; //if ProgressStarted then // F_Progress.StopProgress; (* if Assigned(F_Progress) then begin EndProgress; F_Progress.Visible := F_ProgressFormVisibility; end; *) end else begin (* if Assigned(F_Progress) then // // Tolik 27/10/2017 -- begin { ProgressPaused := False; if GIsProgress then begin PauseProgress(True); ProgressPaused := True; end;} BeginProgress(cProgress_Mes1, Self.ChildCatalogs.Count - 1, true); F_Progress.BringToFront; end; *) for i := 0 to Self.ChildCatalogs.Count - 1 do begin ChildObject := Self.ChildCatalogs[i]; if ChildObject.ItemType = itList then begin GCadForm := GetListByID(ChildObject.SCSID); if GCadForm <> nil then begin j := 0; while j <= ChildObject.FChildCatalogReferences.Count - 1 do begin SCSObject := ChildObject.FChildCatalogReferences[j]; PrevCount := ChildObject.FChildCatalogReferences.Count; if SCSObject.ItemType in [itSCSLine, itSCSConnector] then begin tmpF := GetFigureByID(GCadForm, SCSObject.SCSID); if (assigned(tmpF)) and (not tmpF.Deleted) then begin if SCSObject.ServToDefineParamsInCAD then begin SCSObject.ServToDefineParamsInCAD := false; TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParams(SCSObject); end else begin if dopStatus in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectStatus(SCSObject); if dopIcon in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSObject); end; if dopJoinedTrunk in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectJoinedTrunk(SCSObject); if dopTrunkChanged in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectTrunkAfterChange(SCSObject); if dopLengthNearPointObject in SCSObject.ServToDefineObjParams then RefreshLengthInFutureNearPointObject(SCSObject); if dopMark in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(SCSObject); SCSObject.ServToDefineObjParams := []; end; end; //*** Если пред. количество не совп-т с текущим, то вероятно что был удален объект // При определении параметров высот if PrevCount = ChildObject.FChildCatalogReferences.Count then Inc(j); end; //GCadForm.PCad.Refresh; end; end; (* if Assigned(F_Progress) then StepProgressRE;*) end; (* if Assigned(F_Progress) then begin EndProgress; F_Progress.Visible := F_ProgressFormVisibility; end; *) end; except on E: Exception do AddExceptionToLogEx('DefineObjectsParamsInCADByServFld', E.Message); end; SetCADsProgressMode(false); GCadForm := SavedGCadForm; // Tolik 27/10/2017 -- {if Assigned(F_Progress) then begin if ProgressPaused then PauseProgress(False); end;} GCanrefreshCad := RefreshFlag; if GCadForm <> nil then GCadForm.PCad.Refresh; // end; // (* procedure TSCSCatalogExtended.DefineObjectsParamsInCADByServFld; var i: Integer; SCSObject: TSCSCatalog; PrevCount: Integer; tmpF: TFigure; begin i := 0; begin while i <= FChildCatalogReferences.Count - 1 do begin SCSObject := FChildCatalogReferences[i]; PrevCount := FChildCatalogReferences.Count; if SCSObject.ItemType in [itSCSLine, itSCSConnector] then begin tmpF := GetFigureByID(GCadForm, SCSObject.SCSID); if (assigned(tmpF)) and (not tmpF.Deleted) then begin if SCSObject.ServToDefineParamsInCAD then begin SCSObject.ServToDefineParamsInCAD := false; TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParams(SCSObject); end else begin if dopStatus in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectStatus(SCSObject); if dopIcon in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSObject); end; if dopJoinedTrunk in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectJoinedTrunk(SCSObject); if dopTrunkChanged in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectTrunkAfterChange(SCSObject); if dopLengthNearPointObject in SCSObject.ServToDefineObjParams then RefreshLengthInFutureNearPointObject(SCSObject); if dopMark in SCSObject.ServToDefineObjParams then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(SCSObject); SCSObject.ServToDefineObjParams := []; end; end; //*** Если пред. количество не совп-т с текущим, то вероятно что был удален объект // При определении параметров высот if PrevCount = FChildCatalogReferences.Count then Inc(i); end; end; *) function TSCSCatalogExtended.GenComponentMarkIDByMode(AComponent: TSCSComponent; APointComonIndexingMode: TPointComonIndexingMode; APointComplIndexingMode: TPointComplIndexingMode): Integer; var ComponObjectOwner: TSCSCatalog; i, MaxMarkID: Integer; ParentCompon, ChildCompon: TSCSComponent; IsInComponArea: Boolean; // ищется индекс для комплектующей в пределах компоненты AreaObject: TSCSCatalog; begin Result := 0; if FCanGenMarkID then begin IsInComponArea := false; case APointComplIndexingMode of pcimInProject: IsInComponArea := false; pcimInCompon, pcimInTopCompon: begin ParentCompon := nil; if APointComplIndexingMode = pcimInCompon then ParentCompon := AComponent.GetParentComponent else if APointComplIndexingMode = pcimInTopCompon then begin ParentCompon := AComponent.GetTopComponent; // Если этот компонент есть верхний, тогда ищем индекс за пределами компонента if ParentCompon = AComponent then ParentCompon := nil; end; if (ParentCompon = nil) or (AComponent.IsLine = biTrue) then IsInComponArea := false else begin IsInComponArea := true; MaxMarkID := 0; //20.09.2010 //for i := 0 to ParentCompon.ChildComplects.Count - 1 do //begin // ChildCompon := ParentCompon.ChildComplects[i]; // if ChildCompon.ComponentType.GUID = AComponent.ComponentType.GUID then // if ChildCompon.MarkID > MaxMarkID then // MaxMarkID := ChildCompon.MarkID; //end; //20.09.2010 for i := 0 to ParentCompon.ChildReferences.Count - 1 do begin ChildCompon := ParentCompon.ChildReferences[i]; if ChildCompon.ComponentType.GUID = AComponent.ComponentType.GUID then if ChildCompon.MarkID > MaxMarkID then MaxMarkID := ChildCompon.MarkID; end; Result := MaxMarkID + 1; end; end; end; if Not IsInComponArea then begin if (AComponent.IsLine = biTrue) or (APointComonIndexingMode = cimInProject) then begin if AComponent.IsLine = biTrue then Result := GenComponentMarkIDByType(AComponent.ComponentType.GUID, true) else Result := GenComponentMarkIDByType(AComponent.ComponentType.GUID, false) end else begin AreaObject := nil; // Определяем объект, в пределах которого идет индексация if APointComonIndexingMode = cimInList then AreaObject := AComponent.GetListOwner else if APointComonIndexingMode = cimInRoom then begin // Получить объект компонента ComponObjectOwner := AComponent.GetFirstParentCatalog; if ComponObjectOwner <> nil then if (ComponObjectOwner.FParent <> nil) and (ComponObjectOwner.FParent is TSCSCatalog) then if (TSCSCatalog(ComponObjectOwner.FParent).ItemType = itRoom) or (TSCSCatalog(ComponObjectOwner.FParent).ItemType = itList) then begin AreaObject := TSCSCatalog(ComponObjectOwner.FParent); end; end; if AreaObject <> nil then Result := GenComponMarkIDByAreaObject(AComponent, AreaObject, APointComonIndexingMode = cimInList, APointComplIndexingMode); end; end; end else AComponent.ServToMark := true; //15.01.2011 - Ставим признак чтобы поставить маркировку позже end; function TSCSCatalogExtended.GenComponentMarkIDByType(const AComponentTypeGUID: String; isLine : boolean; AByEnumeration: Boolean = false): Integer; var SprComponentType: TNBComponentType; SCSComponent: TSCSComponent; i: Integer; MaxMarkID: Integer; begin Result := 0; if FCanGenMarkID then begin SprComponentType := FSpravochnik.GetComponentTypeByGUID(AComponentTypeGUID); if (SprComponentType <> nil) and FActive then begin case AByEnumeration of True: begin // Вызывается на подгрузке проекта, чтобы новый индекс компоненты был больше максимального MaxMarkID := 0; for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := FComponentReferences[i]; SCSComponent := TSCSComponent(FComponentReferences.List.List[i]); if SCSComponent.GUIDComponentType = AComponentTypeGUID then if SCSComponent.MarkID > MaxMarkID then MaxMarkID := SCSComponent.MarkID; end; Result := MaxMarkID; SprComponentType.ComponentType.ComponentIndex := MaxMarkID; end; False: begin if IsLine then begin case SprComponentType.ComponentType.ComponentIndex of -2: // нумерацию линейных в пределах проекта begin MaxMarkID := 0; for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := FComponentReferences[i]; SCSComponent := TSCSComponent(FComponentReferences.List.List[i]); if SCSComponent.GUIDComponentType = AComponentTypeGUID then if SCSComponent.MarkID > MaxMarkID then MaxMarkID := SCSComponent.MarkID; end; Result := MAxMarkId + 1; end; -3: // нумерация линейных в пределах листа begin MaxMarkID := 0; for i := 0 to F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences.Count -1 do begin SCScomponent := F_ProjMan.GSCSBase.CurrProject.CurrList.ComponentReferences[i]; if (SCSComponent.GUIDComponentType = AComponentTypeGUID) and (SCSComponent.MarkID > MaxMarkID) then MaxMarkId := SCSComponent.MarkID; end; Result := MaxMarkId +1; end; else begin Inc(SprComponentType.ComponentType.ComponentIndex); Result := SprComponentType.ComponentType.ComponentIndex; end; end; { MaxMarkID := 0; for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := FComponentReferences[i]; SCSComponent := TSCSComponent(FComponentReferences.List.List[i]); if SCSComponent.GUIDComponentType = AComponentTypeGUID then if SCSComponent.MarkID > MaxMarkID then MaxMarkID := SCSComponent.MarkID; end; SprComponentType.ComponentType.ComponentIndex := MaxMarkID;} end else // нелинейная компонента begin Inc(SprComponentType.ComponentType.ComponentIndex); Result := SprComponentType.ComponentType.ComponentIndex; end; //Result := MaxMarkID; end; end; end; end; end; function TSCSCatalogExtended.GetAllStrings: TObject; {var i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; Norm: TSCSNorm; ResourceRel: TSCSResourceRel; ptrCableCanalConnector: PCableCanalConnector; ptrProperty: PProperty; CataogNameStrings: TStringList; CataogNameShortStrings: TStringList; ComponGuidNBStrings: TStringList; ComponNameStrings: TStringList; ComponNameShortStrings: TStringList; ComponCypherStrings: TStringList; ComponNoticeStrings: TStringList; ComponArticulStrings: TStringList; ComponentTypeGUIDStrings: TStringList; ObjectIconGUIDStrings: TStringList; ProducerGUIDStrings: TStringList; SuppliesKindGUIDStrings: TStringList; SupplierGUIDStrings: TStringList; NetTypeGUIDStrings: TStringList; IzmStrings: TStringList; InterfaceGUIDStrings: TStringList; InterfaceNoticeStrings: TStringList; InterfaceSideSectionStrings: TStringList; PropertyGUIDStrings: TStringList; PropertyValueStrings: TStringList; NBConnectorGuidStrings: TStringList; NormGuidNBStrings: TStringList; NormCypherStrings: TStringList; NormNameStrings: TStringList; NormWorkKindStrings: TStringList; ResourceRelGuidNBStrings: TStringList; ResourceRelCypherStrings: TStringList; ResourceRelNameStrings: TStringList; OldTick, CurrTick: Cardinal; function AddStrToStringList(AStr: String; AStringList: TStringList): Integer; var ItemIndex: Integer; Obj: TObject; begin Result := 0; Obj := nil; if AStringList.Find(AStr, ItemIndex) then Obj := AStringList.Objects[ItemIndex] else begin AStringList.AddObject(AStr, Obj); end; Result := 0; end; function GetStringList: TStringList; begin Result := TStringList.Create; Result.Sorted := true; end; } begin Result := nil; { OldTick := GetTickCount; CataogNameStrings := GetStringList; CataogNameShortStrings := GetStringList; ComponGuidNBStrings := GetStringList; ComponNameStrings := GetStringList; ComponNameShortStrings := GetStringList; ComponCypherStrings := GetStringList; ComponNoticeStrings := GetStringList; ComponArticulStrings := GetStringList; ComponentTypeGUIDStrings := GetStringList; ObjectIconGUIDStrings := GetStringList; ProducerGUIDStrings := GetStringList; SuppliesKindGUIDStrings := GetStringList; SupplierGUIDStrings := GetStringList; NetTypeGUIDStrings := GetStringList; IzmStrings := GetStringList; InterfaceGUIDStrings := GetStringList; InterfaceNoticeStrings := GetStringList; InterfaceSideSectionStrings := GetStringList; PropertyGUIDStrings := GetStringList; PropertyValueStrings := GetStringList; NBConnectorGuidStrings := GetStringList; NormGuidNBStrings := GetStringList; NormCypherStrings := GetStringList; NormNameStrings := GetStringList; NormWorkKindStrings := GetStringList; ResourceRelGuidNBStrings := GetStringList; ResourceRelCypherStrings := GetStringList; ResourceRelNameStrings := GetStringList; for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; AddStrToStringList(SCSCatalog.Name, CataogNameStrings); AddStrToStringList(SCSCatalog.NameShort, CataogNameShortStrings); for j := 0 to SCSCatalog.FProperties.Count - 1 do begin ptrProperty := SCSCatalog.FProperties[j]; AddStrToStringList(ptrProperty.GUIDProperty, PropertyGUIDStrings); AddStrToStringList(ptrProperty.Value, PropertyValueStrings); end; end; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; AddStrToStringList(SCSComponent.GuidNB, ComponGuidNBStrings); AddStrToStringList(SCSComponent.Name, ComponNameStrings); AddStrToStringList(SCSComponent.NameShort, ComponNameShortStrings); AddStrToStringList(SCSComponent.Cypher, ComponCypherStrings); AddStrToStringList(SCSComponent.Izm, IzmStrings); AddStrToStringList(SCSComponent.Notice, ComponNoticeStrings); AddStrToStringList(SCSComponent.ArticulProducer, ComponArticulStrings); AddStrToStringList(SCSComponent.ArticulDistributor, ComponArticulStrings); AddStrToStringList(SCSComponent.GUIDComponentType, ComponentTypeGUIDStrings); AddStrToStringList(SCSComponent.GUIDSymbol, ObjectIconGUIDStrings); AddStrToStringList(SCSComponent.GUIDObjectIcon, ObjectIconGUIDStrings); AddStrToStringList(SCSComponent.GUIDProducer, ProducerGUIDStrings); AddStrToStringList(SCSComponent.GUIDSuppliesKind, SuppliesKindGUIDStrings); AddStrToStringList(SCSComponent.GUIDSupplier, SupplierGUIDStrings); AddStrToStringList(SCSComponent.GUIDNetType, NetTypeGUIDStrings); //*** Элементы каб. каналов for j := 0 to SCSComponent.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := SCSComponent.FCableCanalConnector[j]; AddStrToStringList(ptrCableCanalConnector.GuidNBConnector, NBConnectorGuidStrings); end; for j := 0 to SCSComponent.FProperties.Count - 1 do begin ptrProperty := SCSComponent.FProperties[j]; AddStrToStringList(ptrProperty.GUIDCrossProperty, PropertyGUIDStrings); AddStrToStringList(ptrProperty.GUIDProperty, PropertyGUIDStrings); AddStrToStringList(ptrProperty.Value, PropertyValueStrings); end; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSInterface := SCSComponent.FInterfaces[j]; AddStrToStringList(SCSInterface.GUIDInterface, InterfaceGUIDStrings); AddStrToStringList(SCSInterface.Notice, InterfaceNoticeStrings); AddStrToStringList(SCSInterface.SideSection, InterfaceSideSectionStrings); end; for j := 0 to SCSComponent.FNormsResources.FNorms.Count - 1 do begin Norm := SCSComponent.FNormsResources.FNorms[j]; AddStrToStringList(Norm.GuidNB, NormGuidNBStrings); AddStrToStringList(Norm.Cypher, NormCypherStrings); AddStrToStringList(Norm.Name, NormNameStrings); AddStrToStringList(Norm.WorkKind, NormWorkKindStrings); AddStrToStringList(Norm.Izm, IzmStrings); end; for j := 0 to SCSComponent.FNormsResources.FResources.Count - 1 do begin ResourceRel := SCSComponent.FNormsResources.FResources[j]; AddStrToStringList(ResourceRel.GuidNB, ResourceRelGuidNBStrings); AddStrToStringList(ResourceRel.Cypher, ResourceRelCypherStrings); AddStrToStringList(ResourceRel.Name, ResourceRelNameStrings); AddStrToStringList(ResourceRel.Izm, IzmStrings); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; } end; function TSCSCatalogExtended.GetCADCrossObjectByObjectID(AObjectID: Integer): TCADCrossObject; var i: Integer; CADCrossObject: TCADCrossObject; begin Result := nil; for i := 0 to FCADCrossObjects.Count - 1 do begin CADCrossObject := TCADCrossObject(FCADCrossObjects[i]); if CADCrossObject.ObjectID = AObjectID then begin Result := CADCrossObject; Break; //// BREAK //// end; end; end; function TSCSCatalogExtended.GetCatalogFromSortedRefByID(AID: Integer): TSCSCatalog; begin Result := nil; //Result := TSCSCatalog(FCatalogRefSortedByID.GetObject(AID)); end; function TSCSCatalogExtended.GetCatalogFromSortedRefBySCSID(ASCSID: Integer): TSCSCatalog; begin Result := nil; //Result := TSCSCatalog(FCatalogRefSortedBySCSID.GetObject(ASCSID)); end; function TSCSCatalogExtended.GetComponDefectAct(AComponent: TSCSComponent): TDefectAct; var ObjBlob: TObjectsBlob; UnpackedStream: TMemoryStream; begin Result := nil; ObjBlob := GetObjectsBlobByParams(tiComponent, obdkDefectAct, AComponent.ID); if ObjBlob <> nil then begin UnpackedStream := TMemoryStream.Create; UnPakStream(ObjBlob.ObjectData, UnpackedStream); UnpackedStream.Position := 0; Result := TDefectAct.Create(nil); Result.LoadFromStream(UnpackedStream); FreeAndNil(UnpackedStream); end; end; function TSCSCatalogExtended.GetComponSortedRefByID(AID: Integer): TSCSComponent; begin Result := nil; //Result := TSCSComponent(FComponRefSortedByID.GetObject(AID)); end; function TSCSCatalogExtended.GetCompRelByID(AIDCompRel: Integer): PComplect; var i: Integer; ptrCompRel: PComplect; SCSComponent: TSCSComponent; function GetCompRelByIDFromList(AIDCompRelAtList: Integer; AList: TList): PComplect; var i: Integer; ptrCompRel: PComplect; begin Result := nil; for i := 0 to AList.Count - 1 do begin ptrCompRel := AList[i]; if ptrCompRel.ID = AIDCompRelAtList then begin Result := ptrCompRel; Break; ///// BREAK ///// end; end; end; begin Result := nil; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; ptrCompRel := nil; ptrCompRel := GetCompRelByIDFromList(AIDCompRel, SCSComponent.Complects); if ptrCompRel = nil then ptrCompRel := GetCompRelByIDFromList(AIDCompRel, SCSComponent.Connections); if ptrCompRel <> nil then begin Result := ptrCompRel; Break; ///// BREAK ///// end; end; end; function TSCSCatalogExtended.GetCompRelsByConnectType(AConnectType: Integer): TList; var i: Integer; SCSComponent: TSCSComponent; CompRelsList: TList; begin Result := TList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; CompRelsList := nil; case AConnectType of cntComplect: CompRelsList := SCSComponent.FComplects; cntUnion: CompRelsList := SCSComponent.FConnections; end; if CompRelsList <> nil then Result.Assign(CompRelsList, laOr); end; end; function TSCSCatalogExtended.GetComponentsForReindexOrderType(AReindexOrderType: TReindexOrderType): TSCSComponents; procedure LoadComponent(ACompon: TSCSComponent); var i: Integer; begin Result.Add(ACompon); for i := 0 to ACompon.FChildComplects.Count - 1 do LoadComponent(ACompon.FChildComplects[i]); end; procedure LoadComponentsFromCatalog(ACatalog: TSCSCatalog); var i: Integer; SCSCatalogList: TSCSCatalogs; begin for i := 0 to ACatalog.FChildCatalogs.Count - 1 do LoadComponentsFromCatalog(ACatalog.FChildCatalogs[i]); for i := 0 to ACatalog.FSCSComponents.Count - 1 do LoadComponent(ACatalog.FSCSComponents[i]); end; begin Result := TSCSComponents.Create(false); case AReindexOrderType of rotCreated: begin Result.Assign(FComponentReferences, laCopy); SortComponentsByID(Result); end; rotPositionPM: begin LoadComponentsFromCatalog(Self); end; end; end; function TSCSCatalogExtended.GetInterfacesWithIDConnected: TSCSInterfaces; var i, j: Integer; SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; begin Result := TSCSinterfaces.Create(false); for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSInterface := SCSComponent.FInterfaces[j]; if SCSInterface.IDConnected > 0 then Result.Add(SCSInterface); end; end; end; function TSCSCatalogExtended.GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID: Integer): TObjectsBlob; var i: Integer; ObjBlob: TObjectsBlob; begin Result := nil; for i := 0 to FObjectsBlobs.ObjectsBlobs.Count - 1 do begin ObjBlob := TObjectsBlob(FObjectsBlobs.ObjectsBlobs[i]); if (ObjBlob.TableKind = ATableKind) and (ObjBlob.DataKind = ADataKind) and ((AObjectID = 0) or (ObjBlob.ObjIDs.IndexOf(AObjectID) <> -1)) then begin Result := ObjBlob; Break; //// BREAK //// end; end; end; function TSCSCatalogExtended.GetSprComponentByGUID(AGUID: String): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; try for i := 0 to FSpravComponents.Count - 1 do begin SCSComponent := FSpravComponents[i]; if SCSComponent.GuidNB = AGUID then begin Result := SCSComponent; Break; //// BREAK //// end; end; except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.GetSprComponentByGUID', E.Message); end; end; // Переиндексирует компоненты по типам AGUIDComponTypeList // AComponOwnersWithReindexed - сюда заполняется список объектов, компоненты которых меняли индекс // AResetMarkIdTo - в какой индекс сбрасывать компоненты перединдексацией, // нужно для случая когда индексация в пределах листа и новый индекс берется не с типа компонента, а с максимального компонента листа procedure TSCSCatalogExtended.ReindexComponentsByTypes(AGUIDComponTypeList: TStringList; AComponOwnersWithReindexed: TSCSCatalogs{; AReindexOrderType: TReindexOrderType}; AResetMarkIdTo: Integer=0; aOnlySelected: boolean = False); var Proj: TSCSProject; i, j: Integer; SCSComponent: TSCSComponent; SCSCatalog, CurrCatalog: TSCSCatalog; ComponentList, ComponentListToReindex, WholeComponents, LookedCompons: TSCSComponents; PartComponent: TSCSComponent; SCSList: TSCSList; SelectedObjectsInCAD: TIntList; Figure: TFigure; begin if AGUIDComponTypeList.Count > 0 then begin Proj := GetProject; LookedCompons := TSCSComponents.Create(false); ComponentList := GetComponentsForReindexOrderType(Proj.Setting.ReindexOrderType); ComponentListToReindex := TSCSComponents.Create(false); (* aOnlySelected := True; SelectedObjectsInCAD := nil; SCSList := nil; if aOnlySelected then begin if ComponentList.Count > 0 then begin SCSComponent := ComponentList[0]; SCSList := SCSComponent.GetListOwner; end; if (SCSList <> nil) and SCSList.OpenedInCAD then begin SelectedObjectsInCAD := GetObjectsListWithSelectedInCAD(SCSComponent.ListID); end; end; *) //*** Определить компоненты для переиндексации for i := 0 to ComponentList.Count - 1 do begin SCSComponent := ComponentList[i]; if AGUIDComponTypeList.IndexOf(SCSComponent.GUIDComponentType) <> -1 then begin if aOnlySelected then begin CurrCatalog := SCSComponent.GetFirstParentCatalog; Figure := GetFigureObjectByID(CurrCatalog.ListID, CurrCatalog.SCSID); if Figure.Selected then begin ComponentListToReindex.Add(SCSComponent); SCSComponent.MarkID := AResetMarkIdTo; //02.02.2011 0; end; (* if SelectedObjectsInCAD.IndexOf(CurrCatalog.SCSID) <> -1 then begin ComponentListToReindex.Add(SCSComponent); SCSComponent.MarkID := AResetMarkIdTo; //02.02.2011 0; end; *) end else begin ComponentListToReindex.Add(SCSComponent); SCSComponent.MarkID := AResetMarkIdTo; //02.02.2011 0; end; end; end; (* if aOnlySelected then begin if SelectedObjectsInCAD <> nil then freeandnil(SelectedObjectsInCAD); end; *) for i := 0 to ComponentListToReindex.Count - 1 do begin SCSComponent := ComponentListToReindex[i]; if AGUIDComponTypeList.IndexOf(SCSComponent.GUIDComponentType) <> -1 then if LookedCompons.IndexOf(SCSComponent) = -1 then begin //SCSComponent.MarkID := GenComponentMarkIDByType(SCSComponent.GUIDComponentType); SCSComponent.MarkID := Proj.GenComponentMarkIDByMode(SCSComponent, Proj.Setting.PointComonIndexingMode, Proj.Setting.PointComplIndexingMode); if SCSComponent.IsLine = biTrue then begin WholeComponents := GetComponentsByWholeID(SCSComponent.Whole_ID); for j := 0 to WholeComponents.Count - 1 do begin PartComponent := WholeComponents[j]; if PartComponent <> SCSComponent then begin PartComponent.MarkID := SCSComponent.MarkID; LookedCompons.Add(PartComponent); end; end; FreeAndNil(WholeComponents); end; LookedCompons.Add(SCSComponent); end; end; for i := 0 to LookedCompons.Count - 1 do begin SCSComponent := LookedCompons[i]; SCSCatalog := SCSComponent.GetFirstParentCatalog; ApplyChangeComponMarkID(SCSComponent, true, false, LookedCompons); //TF_Main(FActiveForm).DefineConnectorObjectNodeName(SCSCatalog); //TF_Main(FActiveForm).F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(SCSComponent, true); //SCSComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(SCSComponent, SCSCatalog, true); //if Assigned(SCSComponent.TreeViewNode) then // SCSComponent.TreeViewNode.Text := TF_Main(FActiveForm).GetNameNode(SCSComponent.TreeViewNode, SCSComponent, true, true); //if SCSComponent.IsTop then // TF_Main(FActiveForm).F_ChoiceConnectSide.DefineChildComponsMarksByTop(SCSComponent, LookedCompons); if AComponOwnersWithReindexed <> nil then if AComponOwnersWithReindexed.IndexOf(SCSCatalog) = -1 then AComponOwnersWithReindexed.Add(SCSCatalog); end; FreeAndNil(ComponentListToReindex); FreeAndNil(ComponentList); FreeAndNil(LookedCompons); end; end; function TSCSCatalogExtended.RemoveSprComponentByGUID(AGUID: String): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; try for i := 0 to FSpravComponents.Count - 1 do begin SCSComponent := FSpravComponents[i]; if SCSComponent.GuidNB = AGUID then begin Result := SCSComponent; Break; //// BREAK //// end; end; if Result <> nil then FSpravComponents.Delete(i); except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.RemoveSprComponentByGUID', E.Message); end; end; function TSCSCatalogExtended.SetObjToObjectsBlob(AObj: TComponent; ATableKind, ADataKind, AObjectID: Integer): TObjectsBlob; var ObjBlob: TObjectsBlob; Proj: TSCSProject; //UnpackedStream: TMemoryStream; //SizeUnPak: integer; //SizePak: integer; begin ObjBlob := GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID); if ObjBlob = nil then begin Proj := GetProject; ObjBlob := TObjectsBlob.Create(FActiveForm); ObjBlob.ID := Proj.GenIDByGeneratorIndex(giObjectsBlobID); ObjBlob.TableKind := ATableKind; ObjBlob.DataKind := ADataKind; FObjectsBlobs.AddObjectsBlob(ObjBlob); end; ObjBlob.ObjectData.Position := 0; ObjBlob.ObjectData.Clear; // паковать особого понту нету //UnpackedStream := TMemoryStream.Create; //TComponentSaveToStream(AObj, UnpackedStream); //UnpackedStream.Position := 0; //PakStream(UnpackedStream, ObjBlob.ObjectData); //ObjBlob.ObjectData.Position := 0; //SizeUnPak := UnpackedStream.Size; //SizePak := ObjBlob.ObjectData.Size; //UnpackedStream.Free; TComponentSaveToStream(AObj, ObjBlob.ObjectData); Result := ObjBlob; end; procedure TSCSCatalogExtended.Open(AID: Integer); begin OpenWithParams(AID, false); end; procedure TSCSCatalogExtended.OpenAsLoaded; begin OpenWithParams(ID, true); end; procedure TSCSCatalogExtended.Close; begin try if FActive then begin FIsClousing := true; try if Assigned(FOnBeforeClose) then FOnBeforeClose(Self); try if Not FIsDeleting then Save; //FreeAndNil(FMTMarkMasks); //FreeAndNil(FDSrcMarkMasks); //FCurrID := -1; finally FActive := false; if Assigned(FOnAfterClose) then FOnAfterClose(Self); end; finally FActive := false; FIsClousing := false; end; end; except on E: Exception do AddExceptionToLog('TSCSCatalogExtended.Close: '+E.Message); end; end; procedure TSCSCatalogExtended.SaveAsNew; begin if Assigned(FOnBeforeNew) then FOnBeforeNew(Self); Close; inherited; //SaveCatalogAsNew; ID := NewID; FCurrID := NewID; //if ItemType = itProject then // ProjectID := NewID; Save; if Assigned(FOnAfterNew) then FOnAfterNew(Self); end; procedure TSCSCatalogExtended.CorrectAfterFullOpen; var BuidID: Integer; i: Integer; SCSCatalog: TSCSCatalog; Figure: TFigure; begin // Выполняется когда уже все подгружено и CAD листы открыты try if FBuildID > 0 then begin BuidID := FBuildID; while BuidID < 20 do BuidID := BuidID + 1; if BuidID = 20 then begin if Self is TSCSList then DefineCADPointCornersObjects(GetCADFormBySCSObject(Self)) else begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then DefineCADPointCornersObjects(GetCADFormBySCSObject(SCSCatalog)); end; end; Inc(BuidID); end; //28.05.2013 while BuidID < ProjBuildIDBeforeRaiseDrawFigure do BuidID := BuidID + 1; //28.05.2013 - На с-п определить УГО каб.каналов if BuidID = ProjBuildIDBeforeRaiseDrawFigure then begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSLine then if SCSCatalog.FComponentReferences.GetComponentByType(ctsnCableChannel) <> nil then begin Figure := GetFigureObjectByID(SCSCatalog.ListID, SCSCatalog.SCSID); if Figure <> nil then if CheckFigureByClassName(Figure, cTOrthoLine) then if TOrthoLine(Figure).FIsRaiseUpDown then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSCatalog); end; end; Inc(BuidID); end; end; // Tolik 31/01/2020 -- проверить на версию, и, если нужно выдать сообщение, чтобы пользователь // перезагрузил растровые изображения в новой версии программы (для проектов, собранных на Делфи 6) // вплоть до версии проекта № 25 if CheckProjForOptimizedRasterImageLoad then begin PauseProgress(true); ShowMessageByType(0, smtDisplay, cRasterImgOptimize, '', MB_OK); Application.ProcessMessages; //ShowMessage(cRasterImgOptimize); PauseProgress(false); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'CorrectAfterFullOpen', E.Message); end; end; procedure TSCSCatalogExtended.CorrectConnectedComponsInfo; var ConnectedComponsInfo: TConnectedComponsInfo; WholeIDList: TIntList; WholeLineCompon: TWholeLineCompon; LineCompon: TSCSComponent; i: integer; begin WholeIDList := TIntList.Create; //формируем список ID-в цельных кабелей for i := 0 to FConnectedComponsList.Count - 1 do begin ConnectedComponsInfo := FConnectedComponsList[i]; if WholeIDList.IndexOf(ConnectedComponsInfo.ComponWholeID) = -1 then WholeIDList.Add(ConnectedComponsInfo.ComponWholeID); end; for i := 0 to WholeIDList.Count - 1 do begin ZeroMemory(@WholeLineCompon, SizeOf(TWholeLineCompon)); ConnectedComponsInfo := FConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(WholeIDList[i], tcoFrom); WholeLineCompon.FirstIDCompon := ConnectedComponsInfo.IDSideCompon; WholeLineCompon.FirstIDConnectedConnCompon := ConnectedComponsInfo.IDConnectCompon; ConnectedComponsInfo := FConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(WholeIDList[i], tcoTo); WholeLineCompon.LastIDCompon := ConnectedComponsInfo.IDSideCompon; WholeLineCompon.LastIDConnectedConnCompon := ConnectedComponsInfo.IDConnectCompon; // Проверяем признак дефектности этой инфы if WholeLineCompon.FirstIDCompon = WholeLineCompon.LastIDCompon then //if WholeLineCompon.FirstIDConnectedConnCompon <> WholeLineCompon.LastIDConnectedConnCompon then begin LineCompon := GetComponentFromReferences(WholeLineCompon.FirstIDCompon); if LineCompon <> nil then begin LineCompon.LoadWholeComponent(true); LineCompon.RefreshWholeLengthInFuture; LineCompon.DefineFirstLast; TF_Main(FActiveForm).F_ChoiceConnectSide.DefinePortConnected(LineCompon); TF_Main(FActiveForm).F_ChoiceConnectSide.DeleteConnectedComponByWholeID(LineCompon.Whole_ID); TF_Main(FActiveForm).F_ChoiceConnectSide.InsertToConnectedComponents(LineCompon, LineCompon.FirstConnectedConnCompon, LineCompon.FirstIDCompon, tcoFrom); TF_Main(FActiveForm).F_ChoiceConnectSide.InsertToConnectedComponents(LineCompon, LineCompon.LastConnectedConnCompon, LineCompon.LastIDCompon, tcoTo); end; end; end; FreeAndNil(WholeIDList); end; procedure TSCSCatalogExtended.DefineLackComponProps; var i: Integer; ComponTypes: TStringList; // Типы компонентов со свойствами (SYS_NAME) CompTypeProps: TStringList; // Свойства необходимые для типа компонента (SYS_NAME) Project: TSCSProject; Sprav: TSpravochnik; procedure DefProps(AComponent: TSCSComponent); var PropForCompon: TStringList; i: Integer; CompType: TNBComponentType; CompTypeProp: TNBCompTypeProperty; PropSN: String; PropValue: String; begin PropForCompon := TStringList(GetObjFromStringsByStr(ComponTypes, Acomponent.ComponentType.SysName)); if PropForCompon <> nil then begin CompType := Sprav.GetComponentTypeObjBySysName(Acomponent.ComponentType.SysName); for i := 0 to PropForCompon.Count - 1 do begin PropSN := PropForCompon[i]; if Acomponent.GetPropertyBySysName(PropSN) = nil then if CheckCanUsePropInCompon(PropSN, Acomponent) = true then begin PropValue := ''; // Толщину фундаменда по дефолту от толщины стены //if PropSN = pnPlinthThickness then // PropValue := AComponent.GetPropertyValueBySysName(pnThickness); if PropValue = '' then begin CompTypeProp := CompType.GetPropertyBySN(PropSN); if CompTypeProp <> nil then PropValue := CompTypeProp.PropertyData.Value; end; AddPropertyToComponFromSprBySysName(AComponent, Sprav, PropSN, PropValue); end; end; end; end; begin try Sprav := nil; Project := GetProject; if Project <> nil then Sprav := Project.FSpravochnik else Sprav := FSpravochnik; // Задаем правила - какому типу какие свойства необходимы ComponTypes := CreateStringListSorted; // Комната CompTypeProps := CreateStringListSorted; CompTypeProps.Add(pnPlinthVolume); CompTypeProps.Add(pnTrenchVolume); CompTypeProps.Add(pnBasementVolume); CompTypeProps.Add(pnWallsVolume); ComponTypes.AddObject(ctsnArhRoom, CompTypeProps); // Кир стена CompTypeProps := CreateStringListSorted; CompTypeProps.Add(pnPlinthVolume); //CompTypeProps.Add(pnBasementVolumeunderGround); CompTypeProps.Add(pnTrenchVolume); CompTypeProps.Add(pnBasementVolume); CompTypeProps.Add(pnWallsVolume); ComponTypes.AddObject(ctsnArhBrickWall, CompTypeProps); // Стена - сегмент CompTypeProps := CreateStringListSorted; CompTypeProps.Add(pnGroupName); CompTypeProps.Add(pnPlinthVolume); //CompTypeProps.Add(pnBasementVolumeunderGround); CompTypeProps.Add(pnTrenchVolume); CompTypeProps.Add(pnBasementVolume); CompTypeProps.Add(pnVolume); CompTypeProps.Add(pnPlinthThickness); CompTypeProps.Add(pnBasementThickness); CompTypeProps.Add(pnPlinthHeight); CompTypeProps.Add(pnBasementDepth); CompTypeProps.Add(pnBasementArea); CompTypeProps.Add(pnBasement); CompTypeProps.Add(pnSquareOut); ComponTypes.AddObject(ctsnArhWall, CompTypeProps); // Перестенок - сегмент CompTypeProps := CreateStringListSorted; CompTypeProps.Add(pnVolume); ComponTypes.AddObject(ctsnArhWallDivision, CompTypeProps); for i := 0 to FComponentReferences.Count - 1 do DefProps(FComponentReferences[i]); for i := 0 to FSpravComponents.Count - 1 do DefProps(FSpravComponents[i]); FreeStringsObjects(ComponTypes, true); // Tolik 22/01/2021 -- //ComponTypes.Clear; ComponTypes.Free; // except on E: Exception do AddExceptionToLogExt(ClassName, 'DefineLackComponProps', E.Message); end; end; procedure TSCSCatalogExtended.DefineSpravComponents; var ComponGUIDS: TStringList; i, j, k: Integer; SCSComponent, NBComponent, NBCompon: TSCSComponent; ptrCableCanalConnector: PCableCanalConnector; ResourceRel: TSCSResourceRel; IDNBComponent: Integer; NBComponList: TSCSComponents; Proj: TSCSProject; SprProperty: TNBProperty; SprPropValRel: TNBPropValRel; SprPropValNormRes: TNBPropValNormRes; begin try if TF_Main(FActiveForm).FNormBase.GSCSBase.Active then begin ComponGUIDS := TStringList.Create; NBComponList := TSCSComponents.Create(false); // формируем список ComponGUIDS for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := PCableCanalConnector(SCSComponent.FCableCanalConnector[j]); if ComponGUIDS.IndexOf(ptrCableCanalConnector.GuidNBConnector) = -1 then ComponGUIDS.Add(ptrCableCanalConnector.GuidNBConnector); end; for j := 0 to SCSComponent.FNormsResources.FResources.Count - 1 do begin ResourceRel := SCSComponent.FNormsResources.FResources[j]; if ResourceRel.GUIDNBComponent <> '' then if ComponGUIDS.IndexOf(ResourceRel.GUIDNBComponent) = -1 then ComponGUIDS.Add(ResourceRel.GUIDNBComponent); end; end; // формируем список ComponGUIDS из справочных данных проекта Proj := GetProject; if Proj <> nil then for i := 0 to Proj.FSpravochnik.FNBProperties.Count - 1 do begin SprProperty := TNBProperty(Proj.FSpravochnik.FNBProperties[i]); for j := 0 to SprProperty.FPropValRelList.Count - 1 do begin SprPropValRel := TNBPropValRel(SprProperty.FPropValRelList[j]); for k := 0 to SprPropValRel.FPropValNormResList.Count - 1 do begin SprPropValNormRes := TNBPropValNormRes(SprPropValRel.FPropValNormResList[k]); if SprPropValNormRes.GuidNBComponent <> '' then if ComponGUIDS.IndexOf(SprPropValNormRes.GuidNBComponent) = -1 then ComponGUIDS.Add(SprPropValNormRes.GuidNBComponent); end; end; end; i := 0; while i <= (ComponGUIDS.Count - 1) do begin //*** занести гуид в список просмотренных IDNBComponent := TF_Main(FActiveForm).FNormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, ComponGUIDS[i], qmPhisical); //*** если найден эл-т каб канала в нормативке, то перегрузить его if IDNBComponent <> 0 then begin //*** найти существующий элемент каб канала, и удалить его из списка NBComponent := RemoveSprComponentByGUID(ComponGUIDS[i]); if NBComponent = nil then NBComponent := TSCSComponent.Create(TF_Main(FActiveForm).FNormBase) else // если такой элемент существует, то его чистим NBComponent.Clear; NBComponent.UseKindInProj := ukSprav; NBComponent.ActiveForm := TF_Main(FActiveForm).FNormBase; NBComponent.LoadComponentByID(IDNBComponent, true, true, false); NBComponent.LoadChildComplects(true, true, true); //ClearList(NBCableCanalConnector.FComplects); //NBCableCanalConnector.KolComplect := 0; NBComponent.ActiveForm := FActiveForm; AddComponToSprComponents(NBComponent); //*** Сохранить компонент с новыми ID TF_Main(FActiveForm).SaveComponent(NBComponent, nil, nil, TF_Main(FActiveForm).FNormBase, FActiveForm, nil, Self, false, false, ckCompon); //*** подгрузить данные в справочники AddNewSprGUIDsToProjectFromComponent(NBComponent, FSpravochnik); for j := 0 to NBComponent.FChildReferences.Count - 1 do AddNewSprGUIDsToProjectFromComponent(NBComponent.FChildReferences[j], FSpravochnik); FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); NBComponList.Clear; NBComponList.Assign(NBComponent.FChildReferences, laCopy); NBComponList.Insert(0, NBComponent); // Добавить в конец списка связанные компоненты с данными этого компонента for j := 0 to NBComponList.Count - 1 do begin NBCompon := NBComponList[j]; for k := 0 to NBCompon.FNormsResources.Resources.Count - 1 do begin ResourceRel := NBCompon.FNormsResources.Resources[k]; if ResourceRel.GUIDNBComponent <> '' then if ComponGUIDS.IndexOf(ResourceRel.GUIDNBComponent) = -1 then ComponGUIDS.Add(ResourceRel.GUIDNBComponent); end; end; end; i := i + 1; end; // удаляем все справочные компоненты, которые ни кчему не привязаны i := 0; while i <= FSpravComponents.Count - 1 do begin SCSComponent := FSpravComponents[i]; if SCSComponent <> nil then if ComponGUIDS.IndexOf(SCSComponent.GuidNB) = -1 then begin FSpravComponents.Delete(i); FreeAndNil(SCSComponent); end else Inc(i); end; FreeAndNil(NBComponList); FreeAndNil(ComponGUIDS); end; except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.DefineSpravComponents', E.Message); end; end; {procedure TSCSCatalogExtended.DefineSpravComponents; var i, j: Integer; SCSComponent: TSCSComponent; ptrCableCanalConnector: PCableCanalConnector; IDNBCableCanalConnector: Integer; NBCableCanalConnector: TSCSComponent; LookedConnectorGUIDs: TStringList; // GUIDNBы всех встречающегся элементов каб каналов LookedConnectorID: TIntList; // ID всех встречающегся элементов каб каналов begin try if TF_Main(FActiveForm).FNormBase.GSCSBase.Active then begin LookedConnectorGUIDs := TStringList.Create; LookedConnectorID := TIntList.Create; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := PCableCanalConnector(SCSComponent.FCableCanalConnector[j]); //*** занести гуид в список просмотренных if LookedConnectorGUIDs.IndexOf(ptrCableCanalConnector.GuidNBConnector) = -1 then begin LookedConnectorGUIDs.Add(ptrCableCanalConnector.GuidNBConnector); IDNBCableCanalConnector := TF_Main(FActiveForm).FNormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, ptrCableCanalConnector.GuidNBConnector, qmPhisical); //*** если найден эл-т каб канала в нормативке, то перегрузить его if IDNBCableCanalConnector <> 0 then begin //*** найти существующий элемент каб канала, и удалить его из списка NBCableCanalConnector := RemoveSprComponentByGUID(ptrCableCanalConnector.GuidNBConnector); if NBCableCanalConnector = nil then NBCableCanalConnector := TSCSComponent.Create(TF_Main(FActiveForm).FNormBase) else // если такой элемент существует, то его чистим NBCableCanalConnector.Clear; NBCableCanalConnector.UseKindInProj := ukSprav; NBCableCanalConnector.ActiveForm := TF_Main(FActiveForm).FNormBase; NBCableCanalConnector.LoadComponentByID(IDNBCableCanalConnector, true, true, false); NBCableCanalConnector.LoadChildComplects(true, true, true); //ClearList(NBCableCanalConnector.FComplects); //NBCableCanalConnector.KolComplect := 0; NBCableCanalConnector.ActiveForm := FActiveForm; AddComponToSprComponents(NBCableCanalConnector); //*** Сохранить компонент с новыми ID TF_Main(FActiveForm).SaveComponent(NBCableCanalConnector, nil, nil, TF_Main(FActiveForm).FNormBase, FActiveForm, nil, Self, false, false, ckCompon); LookedConnectorID.Add(NBCableCanalConnector.ID); //*** подгрузить данные в справочники AddNewSprGUIDsToProjectFromComponent(NBCableCanalConnector, FSpravochnik); FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); end else begin NBCableCanalConnector := GetSprComponentByGUID(ptrCableCanalConnector.GuidNBConnector); if NBCableCanalConnector <> nil then LookedConnectorID.Add(NBCableCanalConnector.ID); end; end; end; end; //*** Удалить те, что небыли расмотрены, другими словами это те, для которых небыли найдены каб каналы, или сдублированы i := 0; while i <= FSpravComponents.Count - 1 do begin SCSComponent := FSpravComponents[i]; if SCSComponent <> nil then if LookedConnectorID.IndexOf(SCSComponent.ID) = -1 then begin FSpravComponents.Delete(i); FreeAndNil(SCSComponent); end else Inc(i); end; FreeAndNil(LookedConnectorID); FreeAndNil(LookedConnectorGUIDs); end; except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.DefineSpravComponents', E.Message); end; end;} procedure TSCSCatalogExtended.LoadNormsResourcesFromClasses(ANormsResources: TSCSNormsResources; AIDMaster: Integer; AStringsMan: TStringsMan); var i, j: Integer; CurrNorm: TSCSNorm; CurrResourceRel: TSCSResourceRel; begin for i := 0 to ANormsResources.FNorms.Count - 1 do begin CurrNorm := ANormsResources.FNorms[i]; CurrNorm.IDMaster := AIDMaster; if FMemBase.FMemBaseMode = mbmSQLMemTable then CurrNorm.SaveToMemTable(meMake, AStringsMan) else FMemBase.SaveNormToBuff(CurrNorm); for j := 0 to CurrNorm.FResources.Count - 1 do begin CurrResourceRel := CurrNorm.FResources[j]; CurrResourceRel.IDMaster := CurrNorm.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then CurrResourceRel.SaveToMemTable(meMake, AStringsMan) else FMemBase.SaveResourceRelToBuff(CurrResourceRel); end; end; for i := 0 to ANormsResources.FResources.Count - 1 do begin CurrResourceRel := ANormsResources.FResources[i]; CurrResourceRel.IDMaster := AIDMaster; if FMemBase.FMemBaseMode = mbmSQLMemTable then CurrResourceRel.SaveToMemTable(meMake, AStringsMan) else FMemBase.SaveResourceRelToBuff(CurrResourceRel); end; end; procedure TSCSCatalogExtended.LoadPropertyNames; var PropNamesInfo: TList; LookedSprProperties: TStringList; i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; PropSpravochnik: TSpravochnik; procedure LoadPropNamesForList(AList: TList); var {ptrPropertyNamesInfo: PPropertyNamesInfo; ptrProperty: PProperty; i, j: Integer; FindedProp: Boolean; PropName: String; PropSysName: String; NBProperty: TNBProperty;} i, IndexInLooked: Integer; ptrProperty: PProperty; SprProperty: TNBProperty; begin for i := 0 to AList.Count - 1 do begin //ptrProperty := AList[i]; ptrProperty := AList.List^[i]; SprProperty := nil; IndexInLooked := LookedSprProperties.IndexOf(ptrProperty.GUIDProperty); if IndexInLooked = -1 then begin SprProperty := FSpravochnik.GetPropertyByGUID(ptrProperty.GUIDProperty); if SprProperty <> nil then LookedSprProperties.AddObject(ptrProperty.GUIDProperty, SprProperty); end else SprProperty := TNBProperty(LookedSprProperties.Objects[IndexInLooked]); if SprProperty <> nil then begin ptrProperty.Name_ := SprProperty.PropertyData.Name; ptrProperty.SysName := SprProperty.PropertyData.SysName; ptrProperty.IDDataType := SprProperty.PropertyData.IDDataType; //22.09.2010 ptrProperty.IsForWholeComponent := SprProperty.PropertyData.IsForWholeComponent; end; end; {for i := 0 to AList.Count - 1 do begin ptrProperty := AList[i]; //*** посмотреть в ранее просмотренных FindedProp := false; for j := 0 to PropNamesInfo.Count - 1 do begin ptrPropertyNamesInfo := PropNamesInfo[j]; if ptrPropertyNamesInfo.GUIDProperty = ptrProperty.GUIDProperty then begin ptrProperty.Name := ptrPropertyNamesInfo.Name; ptrProperty.SysName := ptrPropertyNamesInfo.SysName; ptrProperty.IsForWholeComponent := ptrPropertyNamesInfo.IsForWholeComponent; FindedProp := true; Break; ///// BREAK ///// end; end; //*** Свойство небыло ранее расмотрено if Not FindedProp then begin GetZeroMem(ptrPropertyNamesInfo, SizeOf(TPropertyNamesInfo)); ptrPropertyNamesInfo.ID_Property := ptrProperty.ID_Property; ptrPropertyNamesInfo.GUIDProperty := ptrProperty.GUIDProperty; //PropName := ''; //PropSysName := ''; //TF_Main(FActiveForm).FNormBase.DM.LoadPropNamesByID(ptrPropertyNamesInfo.ID_Property, // PropName, PropSysName); //ptrProperty.Name := PropName; //ptrProperty.SysName := PropSysName; //ptrPropertyNamesInfo.Name := PropName; //ptrPropertyNamesInfo.SysName := PropSysName; //NBProperty := TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik.GetPropertyByGUID(ptrProperty.GUIDProperty); NBProperty := FSpravochnik.GetPropertyByGUID(ptrProperty.GUIDProperty); if NBProperty <> nil then begin ptrProperty.Name := NBProperty.PropertyData.Name; ptrProperty.SysName := NBProperty.PropertyData.SysName; ptrProperty.IsForWholeComponent := NBProperty.PropertyData.IsForWholeComponent; ptrPropertyNamesInfo.Name := NBProperty.PropertyData.Name; ptrPropertyNamesInfo.SysName := NBProperty.PropertyData.SysName; ptrPropertyNamesInfo.IsForWholeComponent := NBProperty.PropertyData.IsForWholeComponent; PropNamesInfo.Add(ptrPropertyNamesInfo); end; end; end; } end; begin //PropNamesInfo := TList.Create; LookedSprProperties := TStringList.Create; LookedSprProperties.Sorted := true; PropSpravochnik := FSpravochnik; if (PropSpravochnik.FNBProperties.Count = 0) and Assigned(FProjectOwner) and (FProjectOwner.FSpravochnik.FNBProperties.Count > 0) then PropSpravochnik := FProjectOwner.FSpravochnik; //*** Свойства папок for i := 0 to FChildCatalogReferences.Count - 1 do begin //SCSCatalog := FChildCatalogReferences[i]; SCSCatalog := TSCSCatalog(FChildCatalogReferences.List.List[i]); LoadPropNamesForList(SCSCatalog.FProperties); end; //*** Свойства компонент for i := 0 to FComponentReferences.Count - 1 do begin //SCSComponent := FComponentReferences[i]; SCSComponent := TSCSComponent(FComponentReferences.List.List^[i]); LoadPropNamesForList(SCSComponent.FProperties); end; FreeAndNil(LookedSprProperties); //FreeList(PropNamesInfo); end; procedure TSCSCatalogExtended.LoadSimpleCatalogsFromClasses(AStringsMan: TStringsMan; ASaveCAD: Boolean; AOutListInPlacing: TSCSCatalogs); procedure LoadChildCatalogs(AParentCatalog: TSCSCatalog); var i: Integer; ChildCatalog: TSCSCatalog; begin for i := 0 to AParentCatalog.ChildCatalogs.Count - 1 do begin ChildCatalog := AParentCatalog.ChildCatalogs[i]; if AOutListInPlacing <> nil then AOutListInPlacing.Add(ChildCatalog); if AParentCatalog.ItemType = itProject then ChildCatalog.ParentID := 0 else ChildCatalog.ParentID := AParentCatalog.ID; if ChildCatalog.ItemType in [itSCSLine, itSCSConnector] then ChildCatalog.ListID := AParentCatalog.ListID; ChildCatalog.KolCompon := ChildCatalog.FSCSComponents.Count; ChildCatalog.PropsCount := ChildCatalog.Properties.Count; ChildCatalog.NormsCount := ChildCatalog.FNormsResources.Norms.Count; ChildCatalog.ResourcesCount := ChildCatalog.FNormsResources.FResources.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then begin //*** сохранить в MemTable if ChildCatalog is TSCSList then TSCSList(ChildCatalog).SaveToMemTable(meMake, AStringsMan, ASaveCAD) else ChildCatalog.SaveToMemTable(meMake, AStringsMan); end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCatalogToBuff(ChildCatalog); //*** обработать внутренние каталоги LoadChildCatalogs(ChildCatalog); end; end; begin //*** сохраняет только папки в табл tSQL_Katalog try LoadChildCatalogs(Self); except on E: Exception do AddExceptionToLog('TSCSCatalogExtended.LoadSimpleCatalogsFromClasses: '+E.Message); end; end; procedure TSCSCatalogExtended.LoadSimpleComponentsFromClasses(ACatalogOwner: TSCSCatalog; AComponents: TSCSComponents; AStringsMan: TStringsMan; ACanSaveBlobs: Boolean; AOutListInPlacing: TSCSComponents); var i: Integer; CurrCompon: TSCSComponent; procedure LoadStep(AComponent: TSCSComponent); var i: Integer; ChildComponent: TSCSComponent; begin AComponent.KolComplect := AComponent.FComplects.Count; AComponent.CableCanalConnectorsCnt := AComponent.FCableCanalConnector.Count; AComponent.InterfCount := AComponent.FInterfaces.Count; AComponent.JoinsCount := AComponent.FConnections.Count; AComponent.NormsCount := AComponent.FNormsResources.Norms.Count; AComponent.PropsCount := AComponent.FProperties.Count; AComponent.ResourcesCount := AComponent.FNormsResources.FResources.Count; if AOutListInPlacing <> nil then AOutListInPlacing.Add(AComponent); if FMemBase.FMemBaseMode = mbmSQLMemTable then AComponent.SaveToMemTable(meMake, AStringsMan, ACanSaveBlobs) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveComponToBuff(AComponent); for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildComponent := AComponent.ChildComplects[i]; LoadStep(ChildComponent); end; end; begin try for i := 0 to AComponents.Count - 1 do begin CurrCompon := AComponents[i]; CurrCompon.ObjectID := ACatalogOwner.ID; CurrCompon.ListID := ACatalogOwner.ListID; LoadStep(CurrCompon); end; except on E: Exception do AddExceptionToLog('TSCSCatalogExtended.LoadSimpleComponentsFromClasses: '+E.Message); end; end; procedure TSCSCatalogExtended.SendFromCADObjectsToMemTables(AStringsMan: TStringsMan); var CatalogsWithCADNorms: TSCSCatalogs; CurrCatalog: TSCSCatalogExtended; CADNormStruct: TCADNormStruct; CADNormColumn: TCADNormColumn; CADCrossObject: TCADCrossObject; CADCrossObjectElement: TCADCrossObjectElement; i, j, k: Integer; begin try CatalogsWithCADNorms := TSCSCatalogs.Create(false); CatalogsWithCADNorms.Add(Self); if Self is TSCSProject then CatalogsWithCADNorms.Assign(TSCSProject(Self).FProjectLists, laOr); with TF_Main(FActiveForm).DM do for i := 0 to CatalogsWithCADNorms.Count - 1 do begin CurrCatalog := TSCSCatalogExtended(CatalogsWithCADNorms[i]); for j := 0 to CurrCatalog.FCADNorms.Count - 1 do begin CADNormStruct := TCADNormStruct(CurrCatalog.FCADNorms[j]); CADNormStruct.IDCatalog := CurrCatalog.ID; CADNormStruct.CatalogItemType := CurrCatalog.ItemType; SaveCADNormStructToMemTable(meMake, CADNormStruct, AStringsMan); for k := 0 to CADNormStruct.FNormColumns.Count - 1 do begin CADNormColumn := TCADNormColumn(CADNormStruct.FNormColumns[k]); CADNormColumn.IDCADNormStruct := CADNormStruct.ID; SaveCADNormColumnToMemTable(meMake, CADNormColumn, AStringsMan); end; end; if CurrCatalog is TSCSList then begin for j := 0 to CurrCatalog.FCADCrossObjects.Count - 1 do begin CADCrossObject := TCADCrossObject(CurrCatalog.FCADCrossObjects[j]); CADCrossObject.ListID := CurrCatalog.SCSID; SaveCADCrossObjectToMemTable(meMake, CADCrossObject, AStringsMan); for k := 0 to CADCrossObject.Elements.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement(CADCrossObject.Elements[k]); CADCrossObjectElement.IDCADCrossObject := CADCrossObject.ID; SaveCADCrossObjectElementToMemTable(meMake, CADCrossObjectElement, AStringsMan); end; end; end; end; FreeAndNil(CatalogsWithCADNorms); except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.SendFromCADNormsToMemTables', E.Message); end; end; procedure TSCSCatalogExtended.SendFromClassesToMemTables(AConnectedComponsInfoList: TConnectedComponsList; AObjectsBlobs: TObjectsBlobs; AIsLightSaving: Boolean); var i, j, k, l: Integer; CatalogsInPacing: TSCSCatalogs; ComponsInPacing: TSCSComponents; CurrCatalog: TSCSCatalog; CurrCompon: TSCSComponent; ComponObject: TSCSCatalog; //ComponList: TSCSList; ptrProperty: PProperty; ptrCompRel: PComplect; ptrCableCanalConnector: PCableCanalConnector; Interf: TSCSInterface; //IOfIRelExt: TIOfIRelExt; IOfIRel: TSCSIOfIRel; InterfPosConnection: TSCSInterfPosConnection; ptrPortInterfRel: PPortInterfRel; ConnectedComponsInfo: TConnectedComponsInfo; ObjectsBlob: TObjectsBlob; GuidProperties, GuidComponentTypes, GuidObjectIcons, GuidProduces, GuidSuppliesKinds, GuidSuppliers: TIDStringList; GuidNetTypes, GuidComponents, GuidInterfaces: TIDStringList; IDList: TStringList; ProcedureName: String; // Tolik 28/08/2019 - - //Old, Curr: Cardinal; Old, Curr: DWord; // function GetGUIDByID(AID: Integer; ADefGUID, ATableName: String; ALooked: TIDStringList): String; begin Result := ''; if Not GIsLostConnect then try if AID > 0 then begin Result := ALooked.GetStringByID(AID); if Result = '' then begin Result := TF_Main(FActiveForm).FNormBase.DM.GetStringFromTableByID(ATableName, fnGuid, AID, qmPhisical); if Result <> '' then ALooked.Add(AID, Result); end; end; if (Result = '') and (ADefGUID <> '') then Result := ADefGUID; except // on E: Exception do AddExceptionToLog(ProcedureName+':GetGUIDByID: '+E.Message); on E: Exception do AddExceptionToLog('GetGuidByID'+':GetGUIDByID: '+E.Message); end; end; procedure SaveComponentsDataFromList(AComponents: TSCSComponents); var i, j, k, l: Integer; begin //*** сохранить все содержимое компонент for i := 0 to AComponents.Count - 1 do begin try //CurrCompon := AComponents[i]; CurrCompon := TSCSComponent(AComponents.List.List^[i]); //*** Связь с комплектующими for j := 0 to CurrCompon.FComplects.Count - 1 do begin ptrCompRel := CurrCompon.FComplects[j]; ptrCompRel.ID_Component := CurrCompon.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCompRelToBuff(ptrCompRel); end; //*** Связь с подключенными компонентами for j := 0 to CurrCompon.FConnections.Count - 1 do begin ptrCompRel := CurrCompon.FConnections[j]; ptrCompRel.ID_Component := CurrCompon.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCompRelToBuff(ptrCompRel); end; //*** Элементы каб. каналов for j := 0 to CurrCompon.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := CurrCompon.FCableCanalConnector[j]; ptrCableCanalConnector.IDCableCanal := CurrCompon.ID; //18.10.2007 if (ptrCableCanalConnector.GuidNBConnector = '') and (ptrCableCanalConnector.IDNBConnector > 0) then //18.10.2007 ptrCableCanalConnector.GuidNBConnector := GetGUIDByID(ptrCableCanalConnector.IDNBConnector, ptrCableCanalConnector.GuidNBConnector, tnComponent, GuidComponents); if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveCableCanalConnectorToMemTable(meMake, ptrCableCanalConnector, FStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCableCanalConnectorToBuff(ptrCableCanalConnector); end; //*** Свойста //if FMemBase.FMemBaseMode = mbmSQLMemTable then {for j := CurrCompon.FProperties.Count - 1 downto 0 do //13.12.2011 }for j := 0 to CurrCompon.FProperties.Count - 1 do begin //ptrProperty := CurrCompon.FProperties[j]; ptrProperty := PProperty(CurrCompon.FProperties.List^[j]); ptrProperty.IDMaster := CurrCompon.ID; //18.10.2007 if (ptrProperty.GUIDProperty = '') and (ptrProperty.ID_Property > 0) then //18.10.2007 ptrProperty.GUIDProperty := GetGUIDByID(ptrProperty.ID_Property, ptrProperty.GUIDProperty, tnProperties, GuidProperties); //18.10.2007 if (ptrProperty.GUIDCrossProperty = '') and (ptrProperty.IDCrossProperty > 0) then //18.10.2007 ptrProperty.GUIDCrossProperty := GetGUIDByID(ptrProperty.IDCrossProperty, ptrProperty.GUIDCrossProperty, tnProperties, GuidProperties); if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveComponPropertyToMemTable(meMake, ptrProperty, FStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveComponPropToBuff(ptrProperty); end; //else //if FMemBase.FMemBaseMode = mbmFiles then // for j := 0 to CurrCompon.FProperties.Count - 1 do // begin // ptrProperty := CurrCompon.FProperties[j]; // ptrProperty.IDMaster := CurrCompon.ID; // FMemBase.SaveComponPropToBuff(ptrProperty); // end; //*** Интерфейсы/Порты for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin //Interf := CurrCompon.FInterfaces[j]; Interf := TSCSInterface(CurrCompon.FInterfaces.List.List^[j]); Interf.ID_Component := CurrCompon.ID; //18.10.2007 if (Interf.GUIDInterface = '') and (Interf.ID_Interface > 0) then //18.10.2007 Interf.GUIDInterface := GetGUIDByID(Interf.ID_Interface, Interf.GUIDInterface, tnInterface, GuidInterfaces); Interf.IOfIRelCount := Interf.FIOfIRelOut.Count; Interf.PortInterfRelCount := Interf.FPortInterfRels.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then Interf.SaveToMemTable(meMake, FStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveInterfRelToBuff(Interf); //*** Связь интерфейсов с интерфейсами других компонент for k := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[k]); IOfIRel.IDInterfRel := Interf.ID; IOfIRel.PosConnectionsCount := IOfIRel.FPosConnections.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, IOfIRel) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveIOfIRelToBuff(IOfIRel); for l := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[l]); InterfPosConnection.IDIOIRel := IOfIRel.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveInterfPosConnectionToMemTable(meMake, InterfPosConnection) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveInterfPosConnectionToBuff(InterfPosConnection); end; end; //*** Связь портов с интерфейсами for k := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Interf.FPortInterfRels[k]; ptrPortInterfRel.IDPort := Interf.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SavePortInterfRelToMemTable(meMake, ptrPortInterfRel) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SavePortInterfRelToBuff(ptrPortInterfRel); end; end; //*** нормы и ресурсы компоненты LoadNormsResourcesFromClasses(CurrCompon.NormsResources, CurrCompon.ID, FStringsMan); except // on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); on E: Exception do AddExceptionToLog('SaveComponentsDataFromList'+': '+E.Message); end; end; { //*** Связи интерфейсов for i := 0 to AComponents.Count - 1 do begin try CurrCompon := AComponents[i]; ComponList := CurrCompon.GetListOwner; ComponObject := CurrCompon.GetFirstParentCatalog; for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin Interf := CurrCompon.FInterfaces[j]; //*** Связь интерфейсов с интерфейсами других компонент for k := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[k]); IOfIRel.IDInterfRel := Interf.ID; TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, IOfIRel); for l := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[l]); InterfPosConnection.IDIOIRel := IOfIRel.ID; TF_Main(FActiveForm).DM.SaveInterfPosConnectionToMemTable(meMake, InterfPosConnection); end; end; //*** Связь портов с интерфейсами for k := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Interf.FPortInterfRels[k]; ptrPortInterfRel.IDPort := Interf.ID; TF_Main(FActiveForm).DM.SavePortInterfRelToMemTable(meMake, ptrPortInterfRel); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end;} { //*** сохранить все содержимое компонент for i := 0 to AComponents.Count - 1 do begin try CurrCompon := AComponents[i]; //*** Связь с комплектующими for j := 0 to CurrCompon.FComplects.Count - 1 do begin ptrCompRel := CurrCompon.FComplects[j]; ptrCompRel.ID_Component := CurrCompon.ID; TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel); end; //*** Связь с подключенными компонентами for j := 0 to CurrCompon.FConnections.Count - 1 do begin ptrCompRel := CurrCompon.FConnections[j]; ptrCompRel.ID_Component := CurrCompon.ID; TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel); end; //*** Элементы каб. каналов for j := 0 to CurrCompon.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := CurrCompon.FCableCanalConnector[j]; ptrCableCanalConnector.IDCableCanal := CurrCompon.ID; if (ptrCableCanalConnector.GuidNBConnector = '') and (ptrCableCanalConnector.IDNBConnector > 0) then ptrCableCanalConnector.GuidNBConnector := GetGUIDByID(ptrCableCanalConnector.IDNBConnector, ptrCableCanalConnector.GuidNBConnector, tnComponent, GuidComponents); TF_Main(FActiveForm).DM.SaveCableCanalConnectorToMemTable(meMake, ptrCableCanalConnector); end; //*** Свойста for j := 0 to CurrCompon.FProperties.Count - 1 do begin ptrProperty := CurrCompon.FProperties[j]; ptrProperty.IDMaster := CurrCompon.ID; if (ptrProperty.GUIDProperty = '') and (ptrProperty.ID_Property > 0) then ptrProperty.GUIDProperty := GetGUIDByID(ptrProperty.ID_Property, ptrProperty.GUIDProperty, tnProperties, GuidProperties); if (ptrProperty.GUIDCrossProperty = '') and (ptrProperty.IDCrossProperty > 0) then ptrProperty.GUIDCrossProperty := GetGUIDByID(ptrProperty.IDCrossProperty, ptrProperty.GUIDCrossProperty, tnProperties, GuidProperties); TF_Main(FActiveForm).DM.SaveComponPropertyToMemTable(meMake, ptrProperty); end; //*** Интерфейсы/Порты for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin Interf := CurrCompon.FInterfaces[j]; Interf.ID_Component := CurrCompon.ID; if (Interf.GUIDInterface = '') and (Interf.ID_Interface > 0) then Interf.GUIDInterface := GetGUIDByID(Interf.ID_Interface, Interf.GUIDInterface, tnInterface, GuidInterfaces); Interf.IOfIRelCount := Interf.FIOfIRelOut.Count; Interf.PortInterfRelCount := Interf.FPortInterfRels.Count; Interf.SaveToMemTable(meMake); end; //*** нормы и ресурсы компоненты LoadNormsResourcesFromClasses(CurrCompon.NormsResources, CurrCompon.ID); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Связи интерфейсов for i := 0 to AComponents.Count - 1 do begin try CurrCompon := AComponents[i]; ComponList := CurrCompon.GetListOwner; ComponObject := CurrCompon.GetFirstParentCatalog; for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin Interf := CurrCompon.FInterfaces[j]; //*** Связь интерфейсов с интерфейсами других компонент for k := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[k]); IOfIRel.IDInterfRel := Interf.ID; TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, IOfIRel); //ZeroMemory(@IOfIRelExt, SizeOf(TIOfIRelExt)); //IOfIRelExt.IOfIRel := ptrIOfIRel^; //if ComponList <> nil then // IOfIRelExt.IDList := ComponList.CurrID; //if ComponObject <> nil then // IOfIRelExt.IDObject := ComponObject.ID; //IOfIRelExt.IDComponent := CurrCompon.ID; //TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, IOfIRelExt); for l := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[l]); InterfPosConnection.IDIOIRel := IOfIRel.ID; TF_Main(FActiveForm).DM.SaveInterfPosConnectionToMemTable(meMake, InterfPosConnection); end; end; //*** Связь портов с интерфейсами for k := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Interf.FPortInterfRels[k]; ptrPortInterfRel.IDPort := Interf.ID; TF_Main(FActiveForm).DM.SavePortInterfRelToMemTable(meMake, ptrPortInterfRel); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } end; begin ProcedureName := 'TSCSCatalogExtended.SendFromClassesToMemTables'; FMemBase.BeginWrite; //CloseAllTables; FMemBase.EmptyAllTables; //DeleteAllIndexes; FMemBase.UnSortingTables; FMemBase.OpenAllTables; FStringsMan.OnBeforeLoad; Old := GetTickCount; //**** Насыпка из классов в МэмТаблы GuidProperties := TIDStringList.Create; GuidComponentTypes := TIDStringList.Create; GuidObjectIcons := TIDStringList.Create; GuidProduces := TIDStringList.Create; GuidSuppliesKinds := TIDStringList.Create; GuidSuppliers := TIDStringList.Create; GuidNetTypes := TIDStringList.Create; GuidComponents := TIDStringList.Create; GuidInterfaces := TIDStringList.Create; CatalogsInPacing := TSCSCatalogs.Create(false); ComponsInPacing := TSCSComponents.Create(false); IDList := TStringList.Create; try //*** определить элементы каб каналов if Not AIsLightSaving then DefineSpravComponents; //*** Насыпать справочники //if Not AIsLightSaving then SendFromSpravochnikClassesToMemTables(FStringsMan); if Not AIsLightSaving then begin //*** Нормы Листов SendFromCADObjectsToMemTables(FStringsMan); // Фильтры SendFromFiltesToMemTables; end; //*** насыпает только папки LoadSimpleCatalogsFromClasses(FStringsMan, AIsLightSaving=false, CatalogsInPacing); //*** сохранить все содержимое папок (кроме папок) for i := 0 to CatalogsInPacing.Count - 1 do begin try CurrCatalog := CatalogsInPacing[i]; //if CurrCatalog is TSCSList then // TSCSList(CurrCatalog).SaveMarkMasks; //*** Свойства объекта for j := 0 to CurrCatalog.FProperties.Count - 1 do begin ptrProperty := CurrCatalog.FProperties[j]; ptrProperty.IDMaster := CurrCatalog.ID; //18.10.2007 if (ptrProperty.GUIDProperty = '') and (ptrProperty.ID_Property > 0) then //18.10.2007 ptrProperty.GUIDProperty := GetGUIDByID(ptrProperty.ID_Property, ptrProperty.GUIDProperty, tnProperties, GuidProperties); if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveCatalogPropertyToMemTable(meMake, ptrProperty, FStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCatalogPropToBuff(ptrProperty); IDList.Add(IntToStr(ptrProperty.ID)); end; //*** Компоненты проекта //*** Сохранить все (сами) компоненты тек-й папки {18.10.2007 for j := 0 to CurrCatalog.FComponentReferences.Count - 1 do begin CurrCompon := CurrCatalog.FComponentReferences[j]; if (CurrCompon.GUIDComponentType = '') and (CurrCompon.ID_ComponentType > 0) then CurrCompon.GUIDComponentType := GetGUIDByID(CurrCompon.ID_ComponentType, CurrCompon.GUIDComponentType, tnComponentTypes, GuidComponentTypes); if (CurrCompon.GUIDSymbol = '') and (CurrCompon.IDSymbol > 0) then CurrCompon.GUIDSymbol := GetGUIDByID(CurrCompon.IDSymbol, CurrCompon.GUIDSymbol, tnObjectIcons, GuidObjectIcons); if (CurrCompon.GUIDObjectIcon = '') and (CurrCompon.IDObjectIcon = 0) then CurrCompon.GUIDObjectIcon := GetGUIDByID(CurrCompon.IDObjectIcon, CurrCompon.GUIDObjectIcon, tnObjectIcons, GuidObjectIcons); if (CurrCompon.GUIDProducer = '') and (CurrCompon.ID_Producer > 0) then CurrCompon.GUIDProducer := GetGUIDByID(CurrCompon.ID_Producer, CurrCompon.GUIDProducer, tnProducers, GuidProduces); if (CurrCompon.GUIDSuppliesKind = '') and (CurrCompon.IDSuppliesKind > 0) then CurrCompon.GUIDSuppliesKind := GetGUIDByID(CurrCompon.IDSuppliesKind, CurrCompon.GUIDSuppliesKind, tnSuppliesKinds, GuidSuppliesKinds); if (CurrCompon.GUIDSupplier = '') and (CurrCompon.ID_SUPPLIER > 0) then CurrCompon.GUIDSupplier := GetGUIDByID(CurrCompon.ID_SUPPLIER, CurrCompon.GUIDSupplier, tnSupplier, GuidSuppliers); if (CurrCompon.GUIDNetType = '') and (CurrCompon.IDNetType > 0) then CurrCompon.GUIDNetType := GetGUIDByID(CurrCompon.IDNetType, CurrCompon.GUIDNetType, tnNetType, GuidNetTypes); end; } LoadSimpleComponentsFromClasses(CurrCatalog, CurrCatalog.FSCSComponents, FStringsMan, true, ComponsInPacing); //*** Связи папок с компонентами for j := 0 to CurrCatalog.SCSComponents.Count - 1 do begin CurrCompon := CurrCatalog.SCSComponents[j]; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveCatalogRelation(meMake, CurrCatalog.ID, CurrCompon.ID) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveCatRelToBuff(CurrCatalog.ID, CurrCompon.ID); end; //*** нормы и ресурсы объекта LoadNormsResourcesFromClasses(CurrCatalog.NormsResources, CurrCatalog.ID, FStringsMan); except // on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); on E: Exception do AddExceptionToLog('LoadNormsResourcesFromClasses'+': '+E.Message); end; end; SaveComponentsDataFromList(ComponsInPacing); //*** справочные компоненты if Not AIsLightSaving then begin LoadSimpleComponentsFromClasses(Self, FSpravComponents, FStringsMan, true, nil); SaveComponentsDataFromList(FSpravComponents); end; //*** информация о соединении компонент for i := 0 to AConnectedComponsInfoList.Count - 1 do begin try ConnectedComponsInfo := AConnectedComponsInfoList[i]; if FMemBase.FMemBaseMode = mbmSQLMemTable then TF_Main(FActiveForm).DM.SaveConnectedComponsInfoToMemTable(meMake, ConnectedComponsInfo) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveConnectedComponsToBuff(ConnectedComponsInfo); except // on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); on E: Exception do AddExceptionToLog('AConnectedComponsInfoList'+': '+E.Message); end; end; // Блобы объектов for i := 0 to AObjectsBlobs.ObjectsBlobs.Count - 1 do begin try ObjectsBlob := TObjectsBlob(AObjectsBlobs.ObjectsBlobs[i]); if FMemBase.FMemBaseMode = mbmSQLMemTable then ObjectsBlob.SaveToMemTable(meMake) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveObjectsBlobsToBuff(ObjectsBlob); except //on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); on E: Exception do AddExceptionToLog('AObjectsBlobs'+': '+E.Message); end; end; //*** сохранить менеджер строк SendFromStringsManToMemTables; if Not AIsLightSaving and (Self is TSCSProject) then TSCSProject(Self).SaveMemTablesToMemBase; //07.01.2014 FMemBase.EndWrite; finally IDList.Free; FMemBase.CloseAllTables; FreeAndNil(ComponsInPacing); FreeAndNil(CatalogsInPacing); FreeAndNil(GuidProperties); FreeAndNil(GuidComponentTypes); FreeAndNil(GuidObjectIcons); FreeAndNil(GuidProduces); FreeAndNil(GuidSuppliesKinds); FreeAndNil(GuidSuppliers); FreeAndNil(GuidNetTypes); FreeAndNil(GuidComponents); FreeAndNil(GuidInterfaces); end; Curr := GetTickCount - Old; Curr := GetTickCount - Old; end; procedure TSCSCatalogExtended.SendFromFiltesToMemTables; var FilterInfo: TFilterInfo; i: Integer; begin with TF_Main(FActiveForm).DM do begin for i := 0 to FFilters.Count - 1 do begin FilterInfo := TFilterInfo(FFilters[i]); SaveFilterInfoToMemTable(FilterInfo); end; end; end; procedure TSCSCatalogExtended.SendFromSpravochnikClassesToMemTables(AStringsMan: TStringsMan); var CatalogsInPlacing, CatalogsWithSpravochniks: TSCSCatalogs; ChildCatalog: TSCSCatalog; CurrCatalog: TSCSCatalogExtended; Currency: TNBCurrency; ComponentType: TNBComponentType; CompTypePropRelation: TNBCompTypeProperty; Interf: TNBInterface; InterfaceAccordance: TNBInterfaceAccordance; InterfaceNorm: TNBInterfaceNorm; NetType: TNBNetType; Norm: TNBNorm; ObjectIcon: TNBObjectIcon; Producer: TNBProducer; Propert: TNBProperty; PropValRel: TNBPropValRel; PropValNormRes: TNBPropValNormRes; Resource: TNBResource; SuppliesKind: TNBSuppliesKind; i, j, k, l: Integer; begin CatalogsInPlacing := GetChildCatalogsInPlacingOrder(Self, []); CatalogsWithSpravochniks := TSCSCatalogs.Create(false); CatalogsWithSpravochniks.Add(Self); for i := 0 to CatalogsInPlacing.Count - 1 do begin ChildCatalog := CatalogsInPlacing[i]; if ChildCatalog is TSCSCatalogExtended then CatalogsWithSpravochniks.Add(ChildCatalog); end; FreeAndNil(CatalogsInPlacing); for i := 0 to CatalogsWithSpravochniks.Count - 1 do begin CurrCatalog := TSCSCatalogExtended(CatalogsWithSpravochniks[i]); //*** Валюты for j := 0 to CurrCatalog.FSpravochnik.FNBCurrencies.Count - 1 do begin Currency := TNBCurrency(CurrCatalog.FSpravochnik.FNBCurrencies[j]); Currency.IDCatalog := CurrCatalog.ID; Currency.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then Currency.SaveToMemTable(meMake) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprCurrencyToBuff(Currency); end; //*** Типы компонент со свойствами по - умолчанию for j := 0 to CurrCatalog.FSpravochnik.FNBComponentTypes.Count - 1 do begin ComponentType := TNBComponentType(CurrCatalog.FSpravochnik.FNBComponentTypes[j]); ComponentType.IDCatalog := CurrCatalog.ID; ComponentType.CatalogItemType := CurrCatalog.ItemType; ComponentType.PropsCount := ComponentType.FProperties.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then ComponentType.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprCompTypeToBuff(ComponentType); for k := 0 to ComponentType.FProperties.Count - 1 do begin CompTypePropRelation := TNBCompTypeProperty(ComponentType.FProperties[k]); CompTypePropRelation.GuidComponentType := ComponentType.ComponentType.GUID; CompTypePropRelation.PropertyData.IDMaster := ComponentType.ComponentType.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then CompTypePropRelation.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprCompTypePropToBuff(CompTypePropRelation); end; end; //*** Инетрфейсы с указателями на нормы в НБ for j := 0 to CurrCatalog.FSpravochnik.FNBInterfaces.Count - 1 do begin Interf := TNBInterface(CurrCatalog.FSpravochnik.FNBInterfaces[j]); Interf.IDCatalog := CurrCatalog.ID; Interf.CatalogItemType := CurrCatalog.ItemType; Interf.InterfAccordanceCount := Interf.FInterfaceAccordance.Count; Interf.InterfNormsCount := Interf.FInterfaceNorms.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then Interf.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprInterfaceToBuff(Interf); // соответсвия интерфейсов for k := 0 to Interf.FInterfaceAccordance.Count - 1 do begin InterfaceAccordance := TNBInterfaceAccordance(Interf.FInterfaceAccordance[k]); InterfaceAccordance.GuidInterface := Interf.GUID; InterfaceAccordance.IDInterface := Interf.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then InterfaceAccordance.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprInterfAccordanceToBuff(InterfaceAccordance); end; // интерфейсы норм for k := 0 to Interf.FInterfaceNorms.Count - 1 do begin InterfaceNorm := TNBInterfaceNorm(Interf.FInterfaceNorms[k]); InterfaceNorm.GuidInterface := Interf.GUID; InterfaceNorm.IDInterface := Interf.ID; if FMemBase.FMemBaseMode = mbmSQLMemTable then InterfaceNorm.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprInterfNormToBuff(InterfaceNorm); end; end; // Типы сетей for j := 0 to CurrCatalog.FSpravochnik.FNBNetTypes.Count - 1 do begin NetType := TNBNetType(CurrCatalog.FSpravochnik.FNBNetTypes[j]); NetType.IDCatalog := CurrCatalog.ID; NetType.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then NetType.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprNetTypeToBuff(NetType); end; // Нормы for j := 0 to CurrCatalog.FSpravochnik.FNBNorms.Count - 1 do begin Norm := TNBNorm(CurrCatalog.FSpravochnik.FNBNorms[j]); Norm.IDCatalog := CurrCatalog.ID; Norm.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then Norm.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprNormToBuff(Norm); end; // Условные обозначения for j := 0 to CurrCatalog.FSpravochnik.FNBObjectIcons.Count - 1 do begin ObjectIcon := TNBObjectIcon(CurrCatalog.FSpravochnik.FNBObjectIcons[j]); ObjectIcon.IDCatalog := CurrCatalog.ID; ObjectIcon.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then ObjectIcon.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprObjectIconToBuff(ObjectIcon); end; // Производители for j := 0 to CurrCatalog.FSpravochnik.FNBProducers.Count - 1 do begin Producer := TNBProducer(CurrCatalog.FSpravochnik.FNBProducers[j]); Producer.IDCatalog := CurrCatalog.ID; Producer.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then Producer.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprProducerToBuff(Producer); end; // Свойства for j := 0 to CurrCatalog.FSpravochnik.FNBProperties.Count - 1 do begin Propert := TNBProperty(CurrCatalog.FSpravochnik.FNBProperties[j]); Propert.IDCatalog := CurrCatalog.ID; Propert.CatalogItemType := CurrCatalog.ItemType; Propert.PropValRelCount := Propert.FPropValRelList.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then Propert.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprPropertyToBuff(Propert); for k := 0 to Propert.FPropValRelList.Count - 1 do begin PropValRel := TNBPropValRel(Propert.FPropValRelList[k]); PropValRel.PropValNormResCount := PropValRel.FPropValNormResList.Count; if FMemBase.FMemBaseMode = mbmSQLMemTable then PropValRel.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprPropValRelToBuff(PropValRel); for l := 0 to PropValRel.FPropValNormResList.Count - 1 do begin PropValNormRes := TNBPropValNormRes(PropValRel.FPropValNormResList[l]); if FMemBase.FMemBaseMode = mbmSQLMemTable then PropValNormRes.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprPropValNormResToBuff(PropValNormRes); end; end; end; // Ресурсы for j := 0 to CurrCatalog.FSpravochnik.FNBResources.Count - 1 do begin Resource := TNBResource(CurrCatalog.FSpravochnik.FNBResources[j]); Resource.IDCatalog := CurrCatalog.ID; Resource.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then Resource.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprResourceToBuff(Resource); end; // Виды поставок for j := 0 to CurrCatalog.FSpravochnik.FNBSuppliesKinds.Count - 1 do begin SuppliesKind := TNBSuppliesKind(CurrCatalog.FSpravochnik.FNBSuppliesKinds[j]); SuppliesKind.IDCatalog := CurrCatalog.ID; SuppliesKind.CatalogItemType := CurrCatalog.ItemType; if FMemBase.FMemBaseMode = mbmSQLMemTable then SuppliesKind.SaveToMemTable(meMake, AStringsMan) else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.SaveSprSuppliesKindToBuff(SuppliesKind); end; end; FreeAndNil(CatalogsWithSpravochniks); end; procedure TSCSCatalogExtended.SendFromStringsManToMemTables; var CurrStrKind: integer; i: Integer; procedure SaveStringsToMemTable(AStringList: TStringList; AStrType: Integer); var i: Integer; StringsManInfo: TStringsManInfo; begin if FMemBase.FMemBaseMode = mbmSQLMemTable then begin with TF_Main(FActiveForm).DM do for i := 0 to AStringList.Count - 1 do begin tSQL_StringsMan.Append; tSQL_StringsMan.Fields[fiStringsMan_ID].AsInteger := Integer(AStringList.Objects[i]); tSQL_StringsMan.Fields[fiStringsMan_StrType].AsInteger := AStrType; tSQL_StringsMan.Fields[fiStringsMan_Name].AsString := AStringList[i]; tSQL_StringsMan.Post; end; end else if FMemBase.FMemBaseMode = mbmFiles then begin ZeroMemory(@StringsManInfo, SizeOf(TStringsManInfo)); for i := 0 to AStringList.Count - 1 do begin StringsManInfo.ID := Integer(AStringList.Objects[i]); StringsManInfo.StrType := AStrType; StringsManInfo.Name := AStringList[i]; FMemBase.SaveStringsManInfoBuff(@StringsManInfo); end; end; end; begin CurrStrKind := 0; SaveStringsToMemTable(FStringsMan.FCataogNameStrings, stCataogName); SaveStringsToMemTable(FStringsMan.FCataogNameShortStrings,stCataogNameShort); SaveStringsToMemTable(FStringsMan.FComponGuidNBStrings, stComponGuidNB); SaveStringsToMemTable(FStringsMan.FComponNameStrings, stComponName); SaveStringsToMemTable(FStringsMan.FComponNameShortStrings, stComponNameShort); SaveStringsToMemTable(FStringsMan.FComponCypherStrings, stComponCypher); SaveStringsToMemTable(FStringsMan.FComponNoticeStrings, stComponNotice); SaveStringsToMemTable(FStringsMan.FComponArticulStrings, stComponArticul); SaveStringsToMemTable(FStringsMan.FComponentTypeGUIDStrings, stComponentTypeGUID); SaveStringsToMemTable(FStringsMan.FObjectIconGUIDStrings, stObjectIconGUID); SaveStringsToMemTable(FStringsMan.FProducerGUIDStrings, stProducerGUID); SaveStringsToMemTable(FStringsMan.FSuppliesKindGUIDStrings, stSuppliesKindGUID); SaveStringsToMemTable(FStringsMan.FSupplierGUIDStrings, skSupplierGUID); SaveStringsToMemTable(FStringsMan.FNetTypeGUIDStrings, stNetTypeGUID); SaveStringsToMemTable(FStringsMan.FIzmStrings, stIzm); SaveStringsToMemTable(FStringsMan.FInterfaceGUIDStrings, stInterfaceGUID); SaveStringsToMemTable(FStringsMan.FInterfaceNoticeStrings, stInterfaceNotice); SaveStringsToMemTable(FStringsMan.FInterfaceSideSectionStrings, stInterfaceSideSection); SaveStringsToMemTable(FStringsMan.FPropertyGUIDStrings, stPropertyGUID); SaveStringsToMemTable(FStringsMan.FPropertyValueStrings, stPropertyValue); SaveStringsToMemTable(FStringsMan.FPropValRelGUIDStrings, stPropValRelGUID); SaveStringsToMemTable(FStringsMan.FNBConnectorGuidStrings, stNBConnectorGuid); SaveStringsToMemTable(FStringsMan.FNormGuidNBStrings, stNormGuidNB); SaveStringsToMemTable(FStringsMan.FNormCypherStrings, stNormCypher); SaveStringsToMemTable(FStringsMan.FNormNameStrings, stNormName); SaveStringsToMemTable(FStringsMan.FNormWorkKindStrings, stNormWorkKind); SaveStringsToMemTable(FStringsMan.FResourceRelGuidNBStrings, stResourceRelGuidNB); SaveStringsToMemTable(FStringsMan.FResourceRelCypherStrings, stResourceRelCypher); SaveStringsToMemTable(FStringsMan.FResourceRelNameStrings, stResourceRelName); SaveStringsToMemTable(FStringsMan.FCompTypeSysNameStrings, stCompTypeSysNameStrings); end; procedure TSCSCatalogExtended.SendFromMemTablesToCADObjects; var i, j, k: Integer; CatalogsWithCADNorms: TSCSCatalogs; CurrCatalog: TSCSCatalogExtended; FindedForI, FindedForJ: Boolean; CADNormStruct: TCADNormStruct; CADNormColumn: TCADNormColumn; CADCrossObject: TCADCrossObject; CADCrossObjectElement: TCADCrossObjectElement; CADNormStructList, CADNormColumnList, CADCrossObjectList, CADCrossObjectElementList: TSCSObjectList; ProcedureName: String; begin ProcedureName := 'TSCSCatalogExtended.SendFromMemTablesToCADObjects'; CADNormStructList := TSCSObjectList.Create(true); CADNormColumnList := TSCSObjectList.Create(true); CADCrossObjectList := TSCSObjectList.Create(true); CADCrossObjectElementList := TSCSObjectList.Create(true); CatalogsWithCADNorms := TSCSCatalogs.Create(false); CatalogsWithCADNorms.Add(Self); if Self is TSCSProject then CatalogsWithCADNorms.Assign(TSCSProject(Self).FProjectLists, laOr); with TF_Main(FActiveForm).DM do begin if tSQL_CADNormStruct.RecordCount > 0 then begin tSQL_CADNormStruct.First; while Not tSQL_CADNormStruct.Eof do begin CADNormStruct := GetCADNormStructFromMemTable(FStringsMan); CADNormStructList.Add(CADNormStruct); tSQL_CADNormStruct.Next; end; end; if tSQL_CADNormColumn.RecordCount > 0 then begin tSQL_CADNormColumn.First; while Not tSQL_CADNormColumn.Eof do begin CADNormColumn := GetCADNormColumnFromMemTable(FStringsMan); CADNormColumnList.Add(CADNormColumn); tSQL_CADNormColumn.Next; end; end; if tSQL_CADCrossObject.RecordCount > 0 then begin tSQL_CADCrossObject.First; while Not tSQL_CADCrossObject.Eof do begin CADCrossObject := GetCADCrossObjectFromMemTable(FStringsMan); CADCrossObjectList.Add(CADCrossObject); tSQL_CADCrossObject.Next; end; end; if tSQL_CADCrossObjectElement.RecordCount > 0 then begin tSQL_CADCrossObjectElement.First; while Not tSQL_CADCrossObjectElement.Eof do begin CADCrossObjectElement := GetCADCrossObjectElementFromMemTable(FStringsMan); CADCrossObjectElementList.Add(CADCrossObjectElement); tSQL_CADCrossObjectElement.Next; end; end; end; for i := 0 to CatalogsWithCADNorms.Count - 1 do begin CurrCatalog := TSCSCatalogExtended(CatalogsWithCADNorms[i]); //*** Нормы КАДа FindedForI := false; j := 0; while j <= CADNormStructList.Count - 1 do begin try CADNormStruct := TCADNormStruct(CADNormStructList[j]); if (CADNormStruct.IDCatalog = CurrCatalog.ID) and (CADNormStruct.CatalogItemType = CurrCatalog.ItemType) then begin FindedForI := true; CurrCatalog.FCADNorms.Add(CADNormStruct); CADNormStructList.Delete(j); FindedForJ := false; k := 0; while k <= CADNormColumnList.Count - 1 do begin try CADNormColumn := TCADNormColumn(CADNormColumnList[k]); if CADNormColumn.IDCADNormStruct = CADNormStruct.ID then begin FindedForJ := true; CADNormStruct.FNormColumns.Add(CADNormColumn); CADNormColumnList.Delete(k); end else begin if FindedForJ then Break; //// BREAK //// Inc(k); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; if CurrCatalog is TSCSList then begin //*** Инфа о кроссах КАДа FindedForI := false; j := 0; while j <= CADCrossObjectList.Count - 1 do begin try CADCrossObject := TCADCrossObject(CADCrossObjectList[j]); if CADCrossObject.ListID = CurrCatalog.SCSID then begin try FindedForI := true; CurrCatalog.FCADCrossObjects.Add(CADCrossObject); CADCrossObjectList.Delete(j); FindedForJ := false; k := 0; while k <= CADCrossObjectElementList.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement(CADCrossObjectElementList[k]); if CADCrossObjectElement.IDCADCrossObject = CADCrossObject.ID then begin FindedForJ := true; CADCrossObject.Elements.Add(CADCrossObjectElement); CADCrossObjectElementList.Delete(k); end else begin if FindedForJ then Break; //// BREAK //// Inc(k); end; end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; end; end; FreeAndNil(CatalogsWithCADNorms); FreeAndNil(CADNormStructList); FreeAndNil(CADNormColumnList); FreeAndNil(CADCrossObjectList); FreeAndNil(CADCrossObjectElementList); end; procedure TSCSCatalogExtended.SendFromMemTablesToClasses(ASetComponsJoining: Boolean=true; AIsLightSaving: Boolean=false); var SCSCatalog: TSCSCatalog; // SCSList: TSCSList; SCSCatalogs, SCSCatalogsForParse: TSCSCatalogs; Compons: TSCSComponents; ComponsSorted: TRapObjectList; // ChildCompons: TSCSComponents; ComponIndex, ComponID: Integer; SCSComponent, SCSComponentTmp, ChildComponent: TSCSComponent; CatalogRelationList, ComplectList, ConnectionList, CableCanalConnectorList, CatalogPropertyList, CompPropertyList: TList; CatalogRelationIndex, ComplectIndex, ConnectionIndex, CableCanalConnectorIndex, CatalogPropertyIndex: Integer; ptrCatalogRelation: PCatalogRelation; ptrCompRel: PComplect; ConnectedComponsInfo: TConnectedComponsInfo; ObjectsBlob: TObjectsBlob; ptrCableCanalConnector: PCableCanalConnector; CompPropertyIndex, InterfaceIndex, PortInterfRelIndex, IOfIRelIndex, InterfPosConnectionIndex, NormIndex, i, j, k, l: Integer; ptrProperty: PProperty; InterfaceList: TSCSInterfaces; Interfac, InterfacInPortRel: TSCSInterface; PortInterfRels, PortInterfRelsLooked: TList; ptrPortInterfRel: PPortInterfRel; PortInterf: TSCSInterface; IOfIRelList, InterfPosConnections: TSCSObjectList; IOfIRel: TSCSIOfIRel; InterfPosConnection: TSCSInterfPosConnection; NormsList: TSCSNorms; ResourceRelList: TSCSResources; ResourceRelIndex: Integer; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; FindedForI, FindedForJ, FindedForK: Boolean; ProcedureName: String; OldTick, CurrTick, ComponsTick, ComplectListTick, ConnectionListTick, CableCanalConnectorListTick, CompPropertyListTick: Cardinal; InterfaceListTick, IOfIRelListTick, InterfPosConnectionsTick, PortInterfRelsTick, NormsListTick, ResourceRelListTick, CatalogRelationListTick: Cardinal; procedure ParseCatalogs(AParentCatalog: TSCSCatalog; AParentID: Integer); var i: Integer; ChildCatalog: TSCSCatalog; Rooms: TSCSCatalogs; IsChild: Boolean; begin if Assigned(AParentCatalog) then begin Rooms := nil; for i := 0 to SCSCatalogsForParse.Count - 1 do begin ChildCatalog := SCSCatalogsForParse[i]; if Assigned(ChildCatalog) then begin IsChild := false; if AParentCatalog.ItemType = itProject then begin if ChildCatalog.ParentID = 0 then IsChild := true else if ChildCatalog.ParentID = AParentID then if ChildCatalog.ItemType in [itList, itDir] then IsChild := true; end else if ChildCatalog.ParentID = AParentID then IsChild := true; if IsChild then begin if ChildCatalog.ItemType = itProject then TSCSProject(ChildCatalog).Parent := AParentCatalog else if ChildCatalog.ItemType = itList then TSCSList(ChildCatalog).Parent := AParentCatalog else ChildCatalog.Parent := AParentCatalog; // Добавляем Чайлд в список if ChildCatalog.ItemType = itRoom then begin if Rooms = nil then Rooms := TSCSCatalogs.Create(false); Rooms.Add(ChildCatalog); end else AParentCatalog.FChildCatalogs.Add(ChildCatalog); SCSCatalogsForParse[i] := nil; ParseCatalogs(ChildCatalog, ChildCatalog.ID); end; end; end; AParentCatalog.ChildCatalogs.SortBySortID; // Комнаты в список первыми if Rooms <> nil then begin Rooms.SortBySortID; for i := Rooms.Count - 1 downto 0 do AParentCatalog.ChildCatalogs.Insert(0, Rooms[i]); Rooms.Free; end; end; end; procedure PrepareComponsObjects(ACompons: TSCSComponents); var i, j: Integer; SCSCompon: TSCSComponent; begin for i := 0 to ACompons.Count - 1 do begin try SCSCompon := ACompons[i]; SCSCompon.LoadComponentType; SCSCompon.SortComplects; for j := 0 to SCSCompon.FInterfaces.Count - 1 do TSCSInterface(SCSCompon.FInterfaces.List.List^[j]).DefineInternalRelations; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; begin ProcedureName := 'TSCSCatalogExtended.SendFromMemTablesToClasses'; OldTick := GetTickCount; SCSCatalogs := TSCSCatalogs.Create(false); CatalogPropertyList := TList.Create; Compons := TSCSComponents.Create(false); ComponsSorted := TRapObjectList.Create; CatalogRelationList := TList.Create; ComplectList := Tlist.Create; ConnectionList := TList.Create; CableCanalConnectorList := Tlist.Create; CompPropertyList := TList.Create; InterfaceList := TSCSInterfaces.Create(false); IOfIRelList := TSCSObjectList.Create(true); InterfPosConnections := TSCSObjectList.Create(true); PortInterfRels := TList.Create; PortInterfRelsLooked := TList.Create; NormsList := TSCSNorms.Create(true); ResourceRelList := TSCSResources.Create(true); ComponIndex := 0; CatalogRelationIndex := 0; ComplectIndex := 0; ConnectionIndex := 0; CableCanalConnectorIndex := 0; CatalogPropertyIndex := 0; CompPropertyIndex := 0; InterfaceIndex := 0; PortInterfRelIndex := 0; IOfIRelIndex := 0; InterfPosConnectionIndex := 0; NormIndex := 0; ResourceRelIndex := 0; OldTick := GetTickCount; //*** загрузить менеджер строк SendFromMemTablesToStringsMan; with TF_Main(ActiveForm).DM do begin //*** Загрузить каталоги if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_Katalog.Filtered := false; if tSQL_Katalog.RecordCount > 0 then begin tSQL_Katalog.First; while Not tSQL_Katalog.Eof do begin SCSCatalog := nil; if tSQL_Katalog.FieldByName(fnIDItemType).AsInteger = itList then begin SCSCatalog := TSCSList.Create(FActiveForm); TSCSList(SCSCatalog).LoadFromMemTable(FStringsMan); end else begin SCSCatalog := TSCSCatalog.Create(FActiveForm); SCSCatalog.LoadFromMemTable(FStringsMan); end; if Assigned(SCSCatalog) then SCSCatalogs.Add(SCSCatalog); tSQL_Katalog.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCatalogs(SCSCatalogs); //*** Загрузить свойства каталогов if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_CatalogPropRelation.Filtered := false; if tSQL_CatalogPropRelation.RecordCount > 0 then begin tSQL_CatalogPropRelation.First; while Not tSQL_CatalogPropRelation.Eof do begin ptrProperty := GetCatalogPropertyFromMemTable(false, FStringsMan); CatalogPropertyList.Add(ptrProperty); tSQL_CatalogPropRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCatalogProps(CatalogPropertyList); //*** Загрузить компоненты if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_Component.Filtered := false; if tSQL_Component.RecordCount > 0 then begin tSQL_Component.First; while Not tSQL_Component.Eof do begin SCSComponent := nil; ComponID := tSQL_Component.Fields[fiCompon_ID].AsInteger; //if Compons.GetComponenByID(ComponID) = nil then //begin SCSComponent := TSCSComponent.Create(FActiveForm); SCSComponent.LoadFromMemTable(FStringsMan); Compons.Add(SCSComponent); //if SCSComponent.UseKindInProj = ukSprav then // AddComponToSprCableChannelElements(SCSComponent); //end //else //EmptyProcedure; tSQL_Component.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCompons(Compons); //*** Связи с объектами if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_CatalogRelation.Filtered := false; if tSQL_CatalogRelation.RecordCount > 0 then begin tSQL_CatalogRelation.First; while Not tSQL_CatalogRelation.Eof do begin ptrCatalogRelation := GetCatalogRelationFromMemTable; CatalogRelationList.Add(ptrCatalogRelation); tSQL_CatalogRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCatRels(CatalogRelationList); //*** Загрузить комплектующие и соединения if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.RecordCount > 0 then begin tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin ptrCompRel := GetCompRelFromMemTable; case ptrCompRel.ConnectType of cntComplect: ComplectList.Add(ptrCompRel); cntUnion: ConnectionList.Add(ptrCompRel); end; tSQL_ComponentRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCompRels(ComplectList, ConnectionList); //*** Загрузить инфу о соединении if FMemBase.FMemBaseMode = mbmSQLMemTable then begin FConnectedComponsList.Clear; tSQL_ConnectedComponents.Filtered := false; if tSQL_ConnectedComponents.RecordCount > 0 then begin tSQL_ConnectedComponents.First; while Not tSQL_ConnectedComponents.Eof do begin ConnectedComponsInfo := GetConnectedComponsInfoFromMemTable; FConnectedComponsList.Add(ConnectedComponsInfo); tSQL_ConnectedComponents.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadConnectedComponsInfo(FConnectedComponsList); // Загрузить блобы объектов FObjectsBlobs.Clear; if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_ObjectsBlobs.RecordCount > 0 then begin tSQL_ObjectsBlobs.First; while Not tSQL_ObjectsBlobs.Eof do begin ObjectsBlob := TObjectsBlob.Create(FActiveForm); ObjectsBlob.LoadFromMemTable; FObjectsBlobs.AddObjectsBlob(ObjectsBlob); tSQL_ObjectsBlobs.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadObjectsBlobs(FObjectsBlobs); //*** Загрузить элементы кабельных каналов if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_CableCanalConnectors.Filtered := false; if tSQL_CableCanalConnectors.RecordCount > 0 then begin tSQL_CableCanalConnectors.First; while Not tSQL_CableCanalConnectors.Eof do begin ptrCableCanalConnector := GetCableCanalConnectorFromMemTable(FStringsMan); CableCanalConnectorList.Add(ptrCableCanalConnector); tSQL_CableCanalConnectors.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadCableCanalConnectors(CableCanalConnectorList); //*** Загрузка свойств компонент if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_CompPropRelation.Filtered := false; if tSQL_CompPropRelation.RecordCount > 0 then begin tSQL_CompPropRelation.First; while Not tSQL_CompPropRelation.Eof do begin ptrProperty := GetComponPropertyFromMemTable(false, FStringsMan); CompPropertyList.Add(ptrProperty); tSQL_CompPropRelation.Next end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadComponProps(CompPropertyList); //*** Загрузить интерфейсы if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_InterfaceRelation.Filtered := false; if tSQL_InterfaceRelation.RecordCount > 0 then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin //Interfac := GetInterfRelFromMemTable; Interfac := TSCSInterface.Create(FActiveForm); Interfac.LoadFromMemTable(FStringsMan); InterfaceList.Add(Interfac); tSQL_InterfaceRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadInterfRels(InterfaceList); //*** Загрузить связи соединений интерфейсов if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_InterfOfInterfRelation.Filtered := false; if tSQL_InterfOfInterfRelation.RecordCount > 0 then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin IOfIRel := GetIOfIRelFromMemTable; IOfIRelList.Add(IOfIRel); tSQL_InterfOfInterfRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadIOfIRels(IOfIRelList); //*** Загрузка соединенных позиция интерфейсов if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_InterfPosConnection.Filtered := false; if tSQL_InterfPosConnection.RecordCount > 0 then begin tSQL_InterfPosConnection.First; while Not tSQL_InterfPosConnection.Eof do begin InterfPosConnection := GetInterfPosConnectionFromMemTable; InterfPosConnections.Add(InterfPosConnection); tSQL_InterfPosConnection.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadInterfPosConnections(InterfPosConnections); //*** Загрузка связи интерфейсов и портов if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_PortInterfaceRelation.Filtered := false; if tSQL_PortInterfaceRelation.RecordCount > 0 then begin tSQL_PortInterfaceRelation.First; while Not tSQL_PortInterfaceRelation.Eof do begin ptrPortInterfRel := GetPortInterfRelFromMemTable; PortInterfRels.Add(ptrPortInterfRel); tSQL_PortInterfaceRelation.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadPortInterfRels(PortInterfRels); //*** Загрузить ресурсы if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_NormResourceRel.Filtered := false; if tSQL_NormResourceRel.RecordCount > 0 then begin tSQL_NormResourceRel.First; while Not tSQL_NormResourceRel.Eof do begin SCSResourceRel := TSCSResourceRel.Create(FActiveForm, ntProj); SCSResourceRel.LoadResourceRelFromMemTable(FStringsMan); ResourceRelList.Add(SCSResourceRel); tSQL_NormResourceRel.Next; end; end; tSQL_Resources.Filtered := false; if tSQL_Resources.RecordCount > 0 then begin tSQL_Resources.First; while Not tSQL_Resources.Eof do begin //*** найти для тек. записи ранее подгруженный класс SCSResourceRel := nil; SCSResourceRel := ResourceRelList.GetResourceByIDResource(tSQL_Resources.FieldByName(fnID).AsInteger); if Assigned(SCSResourceRel) then SCSResourceRel.LoadResourceFromMemTable(FStringsMan); tSQL_Resources.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadResourceRels(ResourceRelList); //*** загрузить нормы if FMemBase.FMemBaseMode = mbmSQLMemTable then begin tSQL_Norms.Filtered := false; if tSQL_Norms.RecordCount > 0 then begin tSQL_Norms.First; while Not tSQL_Norms.Eof do begin SCSNorm := TSCSNorm.Create(FActiveForm, ntProj); SCSNorm.LoadFromMemTable(FStringsMan); NormsList.Add(SCSNorm); tSQL_Norms.Next; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadNorms(NormsList); end; //****** Parsing ****** (* for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; //*** Распарсить свойства каталогов if (SCSCatalog.PropsCount > 0) or (SCSCatalog.PropsCount = -1) then begin try { FindedForI := false; j := 0; while j <= CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[j]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; end; } FindedForI := false; for CatalogPropertyIndex := 0 to CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[CatalogPropertyIndex]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList[CatalogPropertyIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; end; CatalogPropertyList.Pack; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсит подкаталоги по каталогам ParseCatalogs(Self, Self.ID); {//*** Открыть листы for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if Assigned(SCSList) then SCSList.OpenAsLoaded; end;} OldTick := GetTickCount; CompPropertyIndex := 0; // for i := 0 to Compons.Count - 1 do begin SCSComponent := Compons[i]; if SCSComponent.UseKindInProj = ukSprav then AddComponToSprCableChannelElements(SCSComponent); //*** Распарсить связи с комплектующими if SCSComponent.KolComplect > 0 then begin {FindedForI := false; j := 0; while j <= ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); ComplectList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } FindedForI := false; for ComplectIndex := 0 to ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[ComplectIndex]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); ComplectList[ComplectIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ComplectList.Pack; end; //*** Распарсить соединения по компонентам if (SCSComponent.JoinsCount > 0) or (SCSComponent.JoinsCount = -1) then begin {FindedForI := false; j := 0; while j <= ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); ConnectionList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } FindedForI := false; for ConnectionIndex := 0 to ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[ConnectionIndex]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); ConnectionList[ConnectionIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ConnectionList.Pack; end; //*** Распарсить элементы кабельных каналов if (SCSComponent.CableCanalConnectorsCnt > 0) or (SCSComponent.CableCanalConnectorsCnt = -1) then begin {FindedForI := false; j := 0; while j <= CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[j]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end;} FindedForI := false; for CableCanalConnectorIndex := 0 to CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[CableCanalConnectorIndex]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList[CableCanalConnectorIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CableCanalConnectorList.Pack; end; //*** Распарсить свойства компонент if (SCSComponent.PropsCount > 0) or (SCSComponent.PropsCount = -1) then begin {FindedForI := false; j := 0; while j <= CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[j]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); CompPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end;} FindedForI := false; for CompPropertyIndex := 0 to CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[CompPropertyIndex]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); CompPropertyList[CompPropertyIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CompPropertyList.Pack; end; //*** Распарсит интерфейсы if (SCSComponent.InterfCount > 0) or (SCSComponent.InterfCount = -1) then begin {FindedForI := false; j := 0; while j <= InterfaceList.Count - 1 do begin try Interfac := InterfaceList[j]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList.Delete(j); //*** Распарсить связи соединений интерфейов if (Interfac.IOfIRelCount > 0) or (Interfac.IOfIRelCount = -1) then begin FindedForJ := false; k := 0; while k <= IOfIRelList.Count - 1 do begin try IOfIRel := TSCSIOfIRel(IOfIRelList[k]); if IOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; //if Not Assigned(Interfac.IOfIRelOut) then // Interfac.IOfIRelOut := Tlist.Create; IOfIRel.FInterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(IOfIRel); //FreeMem(ptrIOfIRelExt); IOfIRelList.Delete(k); FindedForK := false; l := 0; while l <= InterfPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(InterfPosConnections[l]); if InterfPosConnection.IDIOIRel = IOfIRel.ID then begin FindedForK := true; IOfIRel.FPosConnections.Add(InterfPosConnection); InterfPosConnections.Delete(l); InterfPosConnection.FOwner := IOfIRel; end else begin if FindedForK then Break; //// BREAK //// Inc(l); end; end; end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить связи портов с интерфейоами if (Interfac.PortInterfRelCount > 0) or (Interfac.PortInterfRelCount = -1) then begin FindedForJ := false; k := 0; PortInterf := Interfac; while k <= PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[k]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Add(ptrPortInterfRel); PortInterfRelsLooked.Add(ptrPortInterfRel); PortInterfRels.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } FindedForI := false; for InterfaceIndex := 0 to InterfaceList.Count - 1 do begin try Interfac := InterfaceList[InterfaceIndex]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList[InterfaceIndex] := nil; //*** Распарсить связи соединений интерфейов if (Interfac.IOfIRelCount > 0) or (Interfac.IOfIRelCount = -1) then begin FindedForJ := false; for IOfIRelIndex := IOfIRelIndex to IOfIRelList.Count - 1 do begin try IOfIRel := TSCSIOfIRel(IOfIRelList[IOfIRelIndex]); if IOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; //if Not Assigned(Interfac.IOfIRelOut) then // Interfac.IOfIRelOut := Tlist.Create; IOfIRel.FInterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(IOfIRel); //FreeMem(ptrIOfIRelExt); IOfIRelList[IOfIRelIndex] := nil; FindedForK := false; for InterfPosConnectionIndex := InterfPosConnectionIndex to InterfPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(InterfPosConnections[InterfPosConnectionIndex]); if InterfPosConnection.IDIOIRel = IOfIRel.ID then begin FindedForK := true; IOfIRel.FPosConnections.Add(InterfPosConnection); InterfPosConnections[InterfPosConnectionIndex] := nil; InterfPosConnection.FOwner := IOfIRel; end else begin if FindedForK then Break; //// BREAK //// end; end; end else begin if FindedForJ then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить связи портов с интерфейоами if (Interfac.PortInterfRelCount > 0) or (Interfac.PortInterfRelCount = -1) then begin FindedForJ := false; PortInterf := Interfac; for PortInterfRelIndex := PortInterfRelIndex to PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[PortInterfRelIndex]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Add(ptrPortInterfRel); PortInterfRelsLooked.Add(ptrPortInterfRel); PortInterfRels[PortInterfRelIndex] := nil; end else begin if FindedForJ then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; InterfaceList.Pack; end; //*** Распарсить нормы if (SCSComponent.NormsCount > 0) or (SCSComponent.NormsCount = -1) then begin {FindedForI := false; j := 0; while j <= NormsList.Count - 1 do begin try SCSNorm := NormsList[j]; if (SCSNorm.FMasterTableKind = ctkComponent) and (SCSNorm.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FNorms.Add(SCSNorm); NormsList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end;} FindedForI := false; for NormIndex := 0 to NormsList.Count - 1 do begin try SCSNorm := NormsList[NormIndex]; if (SCSNorm.FMasterTableKind = ctkComponent) and (SCSNorm.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FNorms.Add(SCSNorm); NormsList[NormIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; NormsList.Pack; end; //*** Распарсить ресурсы if (SCSComponent.ResourcesCount > 0) or (SCSComponent.ResourcesCount = -1) then begin {FindedForI := false; j := 0; while j <= ResourceRelList.Count - 1 do begin try SCSResourceRel := ResourceRelList[j]; if (SCSResourceRel.FMasterTableKind = ctkComponent) and (SCSResourceRel.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FResources.Add(SCSResourceRel); ResourceRelList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } FindedForI := false; for ResourceRelIndex := 0 to ResourceRelList.Count - 1 do begin try SCSResourceRel := ResourceRelList[ResourceRelIndex]; if (SCSResourceRel.FMasterTableKind = ctkComponent) and (SCSResourceRel.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FResources.Add(SCSResourceRel); ResourceRelList[ResourceRelIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ResourceRelList.Pack; end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; *) if FBuildID < ProjBuildIDWithSaveComponDataInPlacing then begin for i := SCSCatalogs.Count - 1 downto 0 do begin SCSCatalog := SCSCatalogs[i]; //*** Распарсить свойства каталогов if (SCSCatalog.PropsCount > 0) or (SCSCatalog.PropsCount = -1) then begin try FindedForI := false; j := CatalogPropertyList.Count - 1; while j >= 0 do begin ptrProperty := CatalogPropertyList[j]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); end; if FindedForI then if SCSCatalog.Properties.Count > 1 then if PProperty(SCSCatalog.Properties[0])^.ID > PProperty(SCSCatalog.Properties[1])^.ID then SCSCatalog.Properties.Sort(@ComparePropsByID); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; OldTick := GetTickCount; //*** Распарсит подкаталоги по каталогам SCSCatalogsForParse := TSCSCatalogs.Create(false); SCSCatalogsForParse.Assign(SCSCatalogs); ParseCatalogs(Self, Self.ID); FreeAndNil(SCSCatalogsForParse); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {//*** Открыть листы for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if Assigned(SCSList) then SCSList.OpenAsLoaded; end;} CompPropertyIndex := 0; // (* for i := Compons.Count - 1 downto 0 do begin SCSComponent := Compons[i]; if SCSComponent <> nil then begin if SCSComponent.GUIDComponentType <> '{0B8B2B89-9259-4688-9553-C85FED94D228}' then for j := 0 to Compons.Count - 1 do if (i <> j) and (SCSComponent <> SCSComponentTmp) then begin SCSComponentTmp := Compons[j]; if SCSComponentTmp <> nil then if SCSComponent.ID = SCSComponentTmp.ID then begin if SCSComponentTmp.GUIDComponentType = '{0B8B2B89-9259-4688-9553-C85FED94D228}' then begin Compons[j] := nil; FreeAndNil(SCSComponentTmp); Break; //// BREAK //// end; end; end; end; end; Compons.Pack; *) CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; ComplectListTick := 0; ConnectionListTick := 0; CableCanalConnectorListTick := 0; CompPropertyListTick := 0; InterfaceListTick := 0; IOfIRelListTick := 0; InterfPosConnectionsTick := 0; PortInterfRelsTick := 0; NormsListTick := 0; ResourceRelListTick := 0; CatalogRelationListTick := 0; for i := Compons.Count - 1 downto 0 do begin SCSComponent := Compons[i]; ComponsSorted.Insert(SCSComponent, @SCSComponent.ID); if SCSComponent.UseKindInProj = ukSprav then AddComponToSprComponents(SCSComponent); //*** Распарсить связи с комплектующими //OldTick := GetTickCount; if SCSComponent.KolComplect > 0 then begin FindedForI := false; j := ComplectList.Count - 1; while j >= 0 do begin try ptrCompRel := ComplectList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); ComplectList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.FComplects.Count > 1 then if PComplect(SCSComponent.FComplects[0])^.SortID > PComplect(SCSComponent.FComplects[1])^.SortID then SCSComponent.FComplects.Sort(@CompareCompRelsBySortID); end; //ComplectListTick := ComplectListTick + GetTickCount - OldTick; //*** Распарсить соединения по компонентам //OldTick := GetTickCount; if (SCSComponent.JoinsCount > 0) or (SCSComponent.JoinsCount = -1) then begin FindedForI := false; j := ConnectionList.Count - 1; while j >= 0 do begin try ptrCompRel := ConnectionList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); ConnectionList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.FConnections.Count > 1 then if PComplect(SCSComponent.FConnections[0])^.ID > PComplect(SCSComponent.FConnections[1])^.ID then SCSComponent.FConnections.Sort(@CompareCompRelsByID); end; //ConnectionListTick := ConnectionListTick + GetTickCount - OldTick; //*** Распарсить элементы кабельных каналов //OldTick := GetTickCount; if (SCSComponent.CableCanalConnectorsCnt > 0) or (SCSComponent.CableCanalConnectorsCnt = -1) then begin FindedForI := false; j := CableCanalConnectorList.Count - 1; while j >= 0 do begin try ptrCableCanalConnector := CableCanalConnectorList[j]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.FCableCanalConnector.Count > 1 then if PCableCanalConnector(SCSComponent.FCableCanalConnector[0])^.ID > PCableCanalConnector(SCSComponent.FCableCanalConnector[1])^.ID then SCSComponent.FCableCanalConnector.Sort(@CompareCCEsByID); //CableCanalConnectorList.Pack; end; //CableCanalConnectorListTick := CableCanalConnectorListTick + GetTickCount - OldTick; //*** Распарсить свойства компонент //OldTick := GetTickCount; if (SCSComponent.PropsCount > 0) or (SCSComponent.PropsCount = -1) then begin FindedForI := false; j := CompPropertyList.Count - 1; while j >= 0 do begin try ptrProperty := CompPropertyList[j]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); CompPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.FProperties.Count > 1 then if PProperty(SCSComponent.FProperties[0])^.ID > PProperty(SCSComponent.FProperties[1])^.ID then SCSComponent.FProperties.Sort(@ComparePropsByID); end; //CompPropertyListTick := CompPropertyListTick + GetTickCount - OldTick; //*** Распарсит интерфейсы //OldTick := GetTickCount; if (SCSComponent.InterfCount > 0) or (SCSComponent.InterfCount = -1) then begin FindedForI := false; j := InterfaceList.Count - 1; while j >= 0 do begin try Interfac := InterfaceList[j]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList.Delete(j); //*** Распарсить связи соединений интерфейов if (Interfac.IOfIRelCount > 0) or (Interfac.IOfIRelCount = -1) then begin FindedForJ := false; k := IOfIRelList.Count - 1; while k >= 0 do begin try IOfIRel := TSCSIOfIRel(IOfIRelList[k]); if IOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; //if Not Assigned(Interfac.IOfIRelOut) then // Interfac.IOfIRelOut := Tlist.Create; IOfIRel.FInterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(IOfIRel); //FreeMem(ptrIOfIRelExt); IOfIRelList.Delete(k); FindedForK := false; l := InterfPosConnections.Count - 1; while l >= 0 do begin InterfPosConnection := TSCSInterfPosConnection(InterfPosConnections[l]); if InterfPosConnection.IDIOIRel = IOfIRel.ID then begin FindedForK := true; IOfIRel.FPosConnections.Add(InterfPosConnection); InterfPosConnections.Delete(l); InterfPosConnection.FOwner := IOfIRel; end else begin if FindedForK then Break; //// BREAK //// end; Dec(l); end; if FindedForK then if IOfIRel.FPosConnections.Count > 1 then if TSCSInterfPosConnection(IOfIRel.FPosConnections[0]).ID > TSCSInterfPosConnection(IOfIRel.FPosConnections[1]).ID then IOfIRel.FPosConnections.Sort(@CompareInterfPosConnectionsByID); end else begin if FindedForJ then Break; ///// BREAK ///// end; Dec(k); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForJ then if Interfac.IOfIRelOut.Count > 1 then if TSCSIOfIRel(Interfac.IOfIRelOut[0]).ID > TSCSIOfIRel(Interfac.IOfIRelOut[1]).ID then Interfac.IOfIRelOut.FItemList.Sort(@CompareIOfIRelsByID); end; //*** Распарсить связи портов с интерфейоами if (Interfac.PortInterfRelCount > 0) or (Interfac.PortInterfRelCount = -1) then begin FindedForJ := false; k := PortInterfRels.Count - 1; PortInterf := Interfac; while k >= 0 do begin try ptrPortInterfRel := PortInterfRels[k]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Insert(0, ptrPortInterfRel); //16.02.2011 }PortInterf.FPortInterfRels.Add(ptrPortInterfRel); PortInterfRelsLooked.Add(ptrPortInterfRel); PortInterfRels.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// end; Dec(k); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForJ then if PortInterf.FPortInterfRels.Count > 1 then if PPortInterfRel(PortInterf.FPortInterfRels[0])^.ID > PPortInterfRel(PortInterf.FPortInterfRels[1])^.ID then PortInterf.FPortInterfRels.Sort(@ComparePortInterfRelsByID); end; end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.FInterfaces.Count > 1 then if SCSComponent.FInterfaces[0].ID > SCSComponent.FInterfaces[1].ID then SCSComponent.FInterfaces.SortByID; end; //InterfaceListTick := InterfaceListTick + GetTickCount - OldTick; //*** Распарсить нормы if (SCSComponent.NormsCount > 0) or (SCSComponent.NormsCount = -1) then begin FindedForI := false; j := NormsList.Count - 1; while j >= 0 do begin try SCSNorm := NormsList[j]; if (SCSNorm.FMasterTableKind = ctkComponent) and (SCSNorm.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FNorms.Add(SCSNorm); NormsList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.NormsResources.FNorms.Count > 1 then if TSCSNorm(SCSComponent.NormsResources.FNorms[0]).ID > TSCSNorm(SCSComponent.NormsResources.FNorms[1]).ID then SCSComponent.NormsResources.FNorms.FItemList.Sort(@CompareNormsByID); end; //*** Распарсить ресурсы if (SCSComponent.ResourcesCount > 0) or (SCSComponent.ResourcesCount = -1) then begin FindedForI := false; j := ResourceRelList.Count - 1; while j >= 0 do begin try SCSResourceRel := ResourceRelList[j]; if (SCSResourceRel.FMasterTableKind = ctkComponent) and (SCSResourceRel.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FResources.Add(SCSResourceRel); ResourceRelList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSComponent.NormsResources.FResources.Count > 1 then if TSCSResourceRel(SCSComponent.NormsResources.FResources[0]).ID > TSCSResourceRel(SCSComponent.NormsResources.FResources[1]).ID then SCSComponent.NormsResources.FResources.FItemList.Sort(@CompareResourcessByID); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end else begin CatalogPropertyIndex := 0; for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; //*** Распарсить свойства каталогов if (SCSCatalog.PropsCount > 0) or (SCSCatalog.PropsCount = -1) then begin try FindedForI := false; for j := CatalogPropertyIndex to CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[j]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); end else begin //CatalogPropertyIndex := j; if FindedForI then Break; ///// BREAK ///// end; end; CatalogPropertyIndex := j; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //07.11.2013 Распарсить нормы if (SCSCatalog.NormsCount > 0) or (SCSCatalog.NormsCount = -1) then begin FindedForI := false; j := NormsList.Count - 1; while j >= 0 do begin try SCSNorm := NormsList[j]; if (SCSNorm.FMasterTableKind = ctkCatalog) and (SCSNorm.IDMaster = SCSCatalog.ID) then begin FindedForI := true; SCSCatalog.NormsResources.FNorms.Add(SCSNorm); NormsList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// end; Dec(j); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; if FindedForI then if SCSCatalog.NormsResources.FNorms.Count > 1 then if TSCSNorm(SCSCatalog.NormsResources.FNorms[0]).ID > TSCSNorm(SCSCatalog.NormsResources.FNorms[1]).ID then SCSCatalog.NormsResources.FNorms.FItemList.Sort(@CompareNormsByID); end; end; CatalogPropertyList.Clear; OldTick := GetTickCount; //*** Распарсит подкаталоги по каталогам SCSCatalogsForParse := TSCSCatalogs.Create(false); SCSCatalogsForParse.Assign(SCSCatalogs); ParseCatalogs(Self, Self.ID); FreeAndNil(SCSCatalogsForParse); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; CompPropertyIndex := 0; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; ComplectListTick := 0; ConnectionListTick := 0; CableCanalConnectorListTick := 0; CompPropertyListTick := 0; InterfaceListTick := 0; IOfIRelListTick := 0; InterfPosConnectionsTick := 0; PortInterfRelsTick := 0; NormsListTick := 0; ResourceRelListTick := 0; CatalogRelationListTick := 0; for i := 0 to Compons.Count - 1 do begin SCSComponent := Compons[i]; ComponsSorted.Insert(SCSComponent, @SCSComponent.ID); if SCSComponent.UseKindInProj = ukSprav then AddComponToSprComponents(SCSComponent); //*** Распарсить связи с комплектующими //OldTick := GetTickCount; if SCSComponent.KolComplect > 0 then begin FindedForI := false; for j := ComplectIndex to ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); end else begin if FindedForI then begin //ComplectIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ComplectIndex := j; end; //ComplectListTick := ComplectListTick + GetTickCount - OldTick; //*** Распарсить соединения по компонентам //OldTick := GetTickCount; if (SCSComponent.JoinsCount > 0) or (SCSComponent.JoinsCount = -1) then begin FindedForI := false; for j := ConnectionIndex to ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); end else begin if FindedForI then begin //ConnectionIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ConnectionIndex := j; end; //ConnectionListTick := ConnectionListTick + GetTickCount - OldTick; //*** Распарсить элементы кабельных каналов //OldTick := GetTickCount; if (SCSComponent.CableCanalConnectorsCnt > 0) or (SCSComponent.CableCanalConnectorsCnt = -1) then begin FindedForI := false; for j := CableCanalConnectorIndex to CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[j]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CableCanalConnectorIndex := j; //CableCanalConnectorList.Pack; end; //CableCanalConnectorListTick := CableCanalConnectorListTick + GetTickCount - OldTick; //*** Распарсить свойства компонент //OldTick := GetTickCount; if (SCSComponent.PropsCount > 0) or (SCSComponent.PropsCount = -1) then begin FindedForI := false; for j := CompPropertyIndex to CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[j]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); end else begin if FindedForI then begin //CompPropertyIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CompPropertyIndex := j; end; //CompPropertyListTick := CompPropertyListTick + GetTickCount - OldTick; //*** Распарсит интерфейсы //OldTick := GetTickCount; if (SCSComponent.InterfCount > 0) or (SCSComponent.InterfCount = -1) then begin FindedForI := false; for j := InterfaceIndex to InterfaceList.Count - 1 do begin try Interfac := InterfaceList[j]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; //*** Распарсить связи соединений интерфейов if (Interfac.IOfIRelCount > 0) or (Interfac.IOfIRelCount = -1) then begin FindedForJ := false; for k := IOfIRelIndex to IOfIRelList.Count - 1 do begin try IOfIRel := TSCSIOfIRel(IOfIRelList[k]); if IOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; //if Not Assigned(Interfac.IOfIRelOut) then // Interfac.IOfIRelOut := Tlist.Create; IOfIRel.FInterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(IOfIRel); if (IOfIRel.PosConnectionsCount > 0) or (IOfIRel.PosConnectionsCount = -1) then begin FindedForK := false; for l := InterfPosConnectionIndex to InterfPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(InterfPosConnections[l]); if InterfPosConnection.IDIOIRel = IOfIRel.ID then begin FindedForK := true; IOfIRel.FPosConnections.Add(InterfPosConnection); InterfPosConnection.FOwner := IOfIRel; end else begin if FindedForK then begin //InterfPosConnectionIndex := l; Break; //// BREAK //// end; end; end; if FindedForK then InterfPosConnectionIndex := l; end; end else begin if FindedForJ then begin //IOfIRelIndex := k; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; IOfIRelIndex := k; end; //*** Распарсить связи портов с интерфейоами if (Interfac.PortInterfRelCount > 0) or (Interfac.PortInterfRelCount = -1) then begin FindedForJ := false; PortInterf := Interfac; for k := PortInterfRelIndex to PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[k]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Insert(0, ptrPortInterfRel); //16.02.2011 }PortInterf.FPortInterfRels.Add(ptrPortInterfRel); PortInterfRelsLooked.Add(ptrPortInterfRel); end else begin if FindedForJ then begin //PortInterfRelIndex := k; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; PortInterfRelIndex := k; end; end else begin if FindedForI then begin //InterfaceIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; InterfaceIndex := j; end; //InterfaceListTick := InterfaceListTick + GetTickCount - OldTick; //*** Распарсить нормы if (SCSComponent.NormsCount > 0) or (SCSComponent.NormsCount = -1) then begin FindedForI := false; for j := NormIndex to NormsList.Count - 1 do begin try SCSNorm := NormsList[j]; if (SCSNorm.FMasterTableKind = ctkComponent) and (SCSNorm.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FNorms.Add(SCSNorm); end else begin if FindedForI then begin //NormIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; NormIndex := j; end; //*** Распарсить ресурсы if (SCSComponent.ResourcesCount > 0) or (SCSComponent.ResourcesCount = -1) then begin FindedForI := false; for j := ResourceRelIndex to ResourceRelList.Count - 1 do begin try SCSResourceRel := ResourceRelList[j]; if (SCSResourceRel.FMasterTableKind = ctkComponent) and (SCSResourceRel.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FResources.Add(SCSResourceRel); end else begin if FindedForI then begin //ResourceRelIndex := j; Break; ///// BREAK ///// end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; ResourceRelIndex := j; end; end; ComplectList.Clear; ConnectionList.Clear; CableCanalConnectorList.Clear; CompPropertyList.Clear; InterfaceList.OwnsObjects := false; InterfaceList.Clear; IOfIRelList.OwnsObjects := false; IOfIRelList.Clear; InterfPosConnections.OwnsObjects := false; InterfPosConnections.Clear; PortInterfRels.Clear; NormsList.OwnsObjects := false; NormsList.Clear; ResourceRelList.OwnsObjects := false; ResourceRelList.Clear; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; OldTick := GetTickCount; //*** В связях портов с интерфейсами найти интерфейсы кот-е связ-е с портом for i := 0 to PortInterfRelsLooked.Count - 1 do begin try ptrPortInterfRel := PortInterfRelsLooked[i]; if (ptrPortInterfRel.PortOwner <> nil) and (ptrPortInterfRel.PortOwner.ComponentOwner <> nil) then begin InterfacInPortRel := ptrPortInterfRel.PortOwner.ComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if InterfacInPortRel <> nil then begin ptrPortInterfRel.Interf := InterfacInPortRel; ptrPortInterfRel.PortOwner.AddInterfaceToPort(InterfacInPortRel); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {//*** Распарсить компоненты как комплектующие for i := 0 to Compons.Count - 1 do begin try SCSComponent := Compons[i]; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; ChildComponent := Compons.GetComponenByID(ptrCompRel.ID_Child); if ChildComponent <> nil then begin ChildComponent.IDCompRel := ptrCompRel.ID; SCSComponent.AddChildComponent(ChildComponent); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end;} //*** Распарсить компоненты как комплектующие {ChildCompons := TSCSComponents.Create(false); ChildCompons.Assign(Compons); for i := 0 to Compons.Count - 1 do begin try SCSComponent := Compons[i]; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; for k := 0 to ChildCompons.Count - 1 do begin ChildComponent := ChildCompons[k]; if ChildComponent.ID = ptrCompRel.ID_Child then begin ChildComponent.IDCompRel := ptrCompRel.ID; SCSComponent.AddChildComponent(ChildComponent); ChildCompons.Delete(k); Break; //// BREAK //// end; end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; Compons.Assign(ChildCompons); FreeAndNil(ChildCompons);} OldTick := GetTickCount; //ChildCompons := TSCSComponents.Create(false); for i := 0 to Compons.Count - 1 do begin try SCSComponent := Compons[i]; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; ChildComponent := TSCSComponent(ComponsSorted.GetObject(ptrCompRel.ID_Child)); if ChildComponent <> nil then begin ChildComponent.IDCompRel := ptrCompRel.ID; SCSComponent.AddChildComponent(ChildComponent); //ChildCompons.Add(ChildComponent); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //Compons.Assign(ChildCompons, laXor); //FreeAndNil(ChildCompons); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; //*** выгрузить справочные компоненты из общего списка for i := 0 to FSpravComponents.Count - 1 do begin Compons.Remove(FSpravComponents[i]); //FSpravComponents[i].LoadComponentType; end; //*** Распарсить компоненты по объектам if FBuildID < ProjBuildIDWithSaveInPlacing then begin for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; if SCSCatalog.KolCompon > 0 then begin FindedForI := false; for CatalogRelationIndex := 0 to CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[CatalogRelationIndex]; if ptrCatalogRelation.IDCatalog = SCSCatalog.ID then begin FindedForI := true; //for k := 0 to Compons.Count - 1 do //begin // SCSComponent := Compons[k]; // if SCSComponent.ID = ptrCatalogRelation.IDComponent then // begin // SCSCatalog.AddComponentToList(SCSComponent); // Compons.Delete(k); // Break; ///// BREAK ///// // end; //end; SCSComponent := TSCSComponent(ComponsSorted.GetObject(ptrCatalogRelation.IDComponent)); if SCSComponent <> nil then SCSCatalog.AddComponentToList(SCSComponent); CatalogRelationList[CatalogRelationIndex] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CatalogRelationList.Pack; end; end; end else begin CatalogRelationIndex := 0; for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; if SCSCatalog.KolCompon > 0 then begin FindedForI := false; for j := CatalogRelationIndex to CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[j]; if ptrCatalogRelation.IDCatalog = SCSCatalog.ID then begin FindedForI := true; //for k := 0 to Compons.Count - 1 do //begin // SCSComponent := Compons[k]; // if SCSComponent.ID = ptrCatalogRelation.IDComponent then // begin // SCSCatalog.AddComponentToList(SCSComponent); // Compons.Delete(k); // Break; ///// BREAK ///// // end; //end; SCSComponent := TSCSComponent(ComponsSorted.GetObject(ptrCatalogRelation.IDComponent)); if SCSComponent <> nil then SCSCatalog.AddComponentToList(SCSComponent); CatalogRelationList[j] := nil; end else begin if FindedForI then Break; ///// BREAK ///// end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CatalogRelationIndex := j; //CatalogRelationList.Pack; end; end; end; CatalogRelationList.Pack; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; //*** Установить соединения if ASetComponsJoining then begin Self.SetComponentsJoining(ComponsSorted); Self.SetComponInterfacesForComlects; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; // Справочникики Проекта и Листов SendFromMemTablesToSpravochnik; if Not AIsLightSaving then begin // Нормы Листов SendFromMemTablesToCADObjects; // Фильтры SendFromMemTablesToFilters; if Self is TSCSProject then TSCSProject(Self).LoadMemTablesFromMemBase; //07.01.2014 end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; // Имена свойств LoadPropertyNames; LoadMarkMasks; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; //*** Сортировка компонент в объектах for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then SCSCatalog.SCSComponents.SortBySortID; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; //*** Сортировка комплектующих в компонентах //for i := 0 to FComponentReferences.Count - 1 do //begin // try // SCSComponent := FComponentReferences[i]; // SCSComponent.LoadComponentType; // SCSComponent.SortComplects; // for j := 0 to SCSComponent.FInterfaces.Count - 1 do // //SCSComponent.FInterfaces[j].DefineInternalRelations; // TSCSInterface(SCSComponent.FInterfaces.List.List^[j]).DefineInternalRelations; // // ////*** Нормы и ресурсы // except // on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); // end; //end; PrepareComponsObjects(FComponentReferences); PrepareComponsObjects(FSpravComponents); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; UpdateValuesAfterLoadFromMemTablesToClasses; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; OldTick := GetTickCount; SCSCatalogs.Free; FreeAndDisposeList(CatalogPropertyList); //FreeList(CatalogPropertyList); Compons.Free; ComponsSorted.Free; InterfaceList.Free; FreeList(CatalogRelationList); FreeList(ComplectList); FreeList(ConnectionList); FreeList(CableCanalConnectorList); FreeAndDisposeList(CompPropertyList); IOfIRelList.Free; //FreeList(IOfIRelList); FreeList(PortInterfRels); PortInterfRelsLooked.Free; InterfPosConnections.Free; NormsList.Free; ResourceRelList.Free; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; {Compons := TSCSComponents.Create; // Чистка аксесссуаров с одинаковыми ID for i := 0 to ChildCatalogReferences.Count - 1 do begin SCSCatalog := ChildCatalogReferences[i]; if IsSCSObjectItemType(SCSCatalog.ItemType) then for j := 0 to SCSCatalog.SCSComponents.Count - 1 do begin SCSComponent := SCSCatalog.SCSComponents[j]; if SCSComponent.ComponentType.SysName <> ctsnAccessory then for k := j to SCSCatalog.SCSComponents.Count - 1 do begin SCSComponentTmp := SCSCatalog.SCSComponents[k]; if SCSComponent.ID = SCSComponentTmp.ID then begin if SCSComponentTmp.ComponentType.SysName = ctsnAccessory then begin Compons[j] := nil; FreeAndNil(SCSComponentTmp); Break; //// BREAK //// end; end; end; end; end; FreeAndNil(Compons); } end; procedure TSCSCatalogExtended.SendFromMemTablesToFilters; var FilterInfo: TFilterInfo; begin with TF_Main(FActiveForm).DM do begin if tSQL_Filters.RecordCount > 0 then begin tSQL_Filters.First; while Not tSQL_Filters.Eof do begin FilterInfo := GetFilterInfoFromMemTable; FFilters.Add(FilterInfo); tSQL_Filters.Next; end; end; end; end; procedure TSCSCatalogExtended.SendFromMemTablesToSpravochnik; var CatalogsInPlacing: TSCSCatalogs; Currencies, ComponentTypes, CompTypePropRelations, Interfaces, InterfaceAccordances, InterfaceNorms, NetTypes, Norms: TSCSObjectList; ObjectIcons, Producers, Properts, PropValRelList, PropValNormResList, Resources, SuppliesKinds: TSCSObjectList; Currency: TNBCurrency; ComponentType: TNBComponentType; CompTypePropRelation: TNBCompTypeProperty; Interf: TNBInterface; InterfaceAccordance: TNBInterfaceAccordance; InterfaceNorm: TNBInterfaceNorm; NetType: TNBNetType; Norm: TNBNorm; ObjectIcon: TNBObjectIcon; Producer: TNBProducer; Propert: TNBProperty; PropValRel: TNBPropValRel; PropValNormRes: TNBPropValNormRes; Resource: TNBResource; SuppliesKind: TNBSuppliesKind; CatalogOwners: TSCSCatalogs; CatalogOwner: TSCSCatalogExtended; ChildCatalog: TSCSCatalog; i, j, k, l: Integer; FindedForI, FindedForJ, FindedForK: Boolean; ProcedureName: String; begin ProcedureName := 'TSCSCatalogExtended.SendFromMemTablesToSpravochnik'; Currencies := TSCSObjectList.Create(false); ComponentTypes := TSCSObjectList.Create(false); CompTypePropRelations := TSCSObjectList.Create(false); Interfaces := TSCSObjectList.Create(false); InterfaceAccordances := TSCSObjectList.Create(false); InterfaceNorms := TSCSObjectList.Create(false); NetTypes := TSCSObjectList.Create(false); Norms := TSCSObjectList.Create(false); ObjectIcons := TSCSObjectList.Create(false); Producers := TSCSObjectList.Create(false); Properts := TSCSObjectList.Create(false); PropValRelList := TSCSObjectList.Create(false); PropValNormResList := TSCSObjectList.Create(false); Resources := TSCSObjectList.Create(false); SuppliesKinds := TSCSObjectList.Create(false); CatalogsInPlacing := GetChildCatalogsInPlacingOrder(Self, []); CatalogOwners := TSCSCatalogs.Create(false); CatalogOwners.Add(Self); for i := 0 to CatalogsInPlacing.Count - 1 do begin ChildCatalog := CatalogsInPlacing[i]; if ChildCatalog is TSCSCatalogExtended then CatalogOwners.Add(ChildCatalog); end; FreeAndNil(CatalogsInPlacing); with TF_Main(FActiveForm).DM do begin if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_Currency.Exists then begin tSQL_Currency.Filtered := false; if tSQL_Currency.RecordCount > 0 then begin tSQL_Currency.First; while Not tSQL_Currency.Eof do begin Currency := TNBCurrency.Create(FActiveForm); Currency.LoadFromMemTable; if Currency.IDCatalog = FIDFromOpened then Currency.IDCatalog := ID; Currencies.Add(Currency); tSQL_Currency.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprCurrencies(Currencies); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_ComponentTypes.Exists then begin tSQL_ComponentTypes.Filtered := false; if tSQL_ComponentTypes.RecordCount > 0 then begin tSQL_ComponentTypes.First; while Not tSQL_ComponentTypes.Eof do begin ComponentType := TNBComponentType.Create(FActiveForm); ComponentType.LoadFromMemTable(FStringsMan); if ComponentType.IDCatalog = FIDFromOpened then ComponentType.IDCatalog := ID; ComponentTypes.Add(ComponentType); tSQL_ComponentTypes.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprCompTypes(ComponentTypes); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_CompTypePropRelation.Exists then begin tSQL_CompTypePropRelation.Filtered := false; if tSQL_CompTypePropRelation.RecordCount > 0 then begin tSQL_CompTypePropRelation.First; while Not tSQL_CompTypePropRelation.Eof do begin CompTypePropRelation := TNBCompTypeProperty.Create(FActiveForm); CompTypePropRelation.LoadFromMemTable(FStringsMan); CompTypePropRelations.Add(CompTypePropRelation); tSQL_CompTypePropRelation.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprCompTypeProps(CompTypePropRelations); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_Interface.Exists then begin tSQL_Interface.Filtered := false; if tSQL_Interface.RecordCount > 0 then begin tSQL_Interface.First; while Not tSQL_Interface.Eof do begin Interf := TNBInterface.Create(FActiveForm); Interf.LoadFromMemTable(FStringsMan); if Interf.IDCatalog = FIDFromOpened then Interf.IDCatalog := ID; Interfaces.Add(Interf); tSQL_Interface.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprInterfaces(Interfaces); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_InterfaceAccordance.Exists then begin tSQL_InterfaceAccordance.Filtered := false; if tSQL_InterfaceAccordance.RecordCount > 0 then begin tSQL_InterfaceAccordance.First; while Not tSQL_InterfaceAccordance.Eof do begin InterfaceAccordance := TNBInterfaceAccordance.Create(FActiveForm); InterfaceAccordance.LoadFromMemTable(FStringsMan); InterfaceAccordances.Add(InterfaceAccordance); tSQL_InterfaceAccordance.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprInterfAccordances(InterfaceAccordances); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_InterfaceNorms.Exists then begin tSQL_InterfaceNorms.Filtered := false; if tSQL_InterfaceNorms.RecordCount > 0 then begin tSQL_InterfaceNorms.First; while Not tSQL_InterfaceNorms.Eof do begin InterfaceNorm := TNBInterfaceNorm.Create(FActiveForm); InterfaceNorm.LoadFromMemTable(FStringsMan); InterfaceNorms.Add(InterfaceNorm); tSQL_InterfaceNorms.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprInterfNorms(InterfaceNorms); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_NetType.Exists then begin tSQL_NetType.Filtered := false; if tSQL_NetType.RecordCount > 0 then begin tSQL_NetType.First; while Not tSQL_NetType.Eof do begin NetType := TNBNetType.Create(FActiveForm); NetType.LoadFromMemTable(FStringsMan); if NetType.IDCatalog = FIDFromOpened then NetType.IDCatalog := ID; NetTypes.Add(NetType); tSQL_NetType.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprNetTypes(NetTypes); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_NBNorms.Exists then begin tSQL_NBNorms.Filtered := false; if tSQL_NBNorms.RecordCount > 0 then begin tSQL_NBNorms.First; while Not tSQL_NBNorms.Eof do begin Norm := TNBNorm.Create(FActiveForm); Norm.LoadFromMemTable(FStringsMan); if Norm.IDCatalog = FIDFromOpened then Norm.IDCatalog := ID; Norms.Add(Norm); tSQL_NBNorms.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprNorms(Norms); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_ObjectIcons.Exists then begin tSQL_ObjectIcons.Filtered := false; if tSQL_ObjectIcons.RecordCount > 0 then begin tSQL_ObjectIcons.First; while Not tSQL_ObjectIcons.Eof do begin ObjectIcon := TNBObjectIcon.Create(FActiveForm); ObjectIcon.LoadFromMemTable(FStringsMan); if ObjectIcon.IDCatalog = FIDFromOpened then ObjectIcon.IDCatalog := ID; ObjectIcons.Add(ObjectIcon); tSQL_ObjectIcons.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprObjectIcons(ObjectIcons); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_Producers.Exists then begin tSQL_Producers.Filtered := false; if tSQL_Producers.RecordCount > 0 then begin tSQL_Producers.First; while Not tSQL_Producers.Eof do begin Producer := TNBProducer.Create(FActiveForm); Producer.LoadFromMemTable(FStringsMan); if Producer.IDCatalog = FIDFromOpened then Producer.IDCatalog := ID; Producers.Add(Producer); tSQL_Producers.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprProducers(Producers); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_Properties.Exists then begin tSQL_Properties.Filtered := false; if tSQL_Properties.RecordCount > 0 then begin tSQL_Properties.First; while Not tSQL_Properties.Eof do begin Propert := TNBProperty.Create(FActiveForm); Propert.LoadFromMemTable(FStringsMan); if Propert.IDCatalog = FIDFromOpened then Propert.IDCatalog := ID; Properts.Add(Propert); tSQL_Properties.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprProperties(Properts); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_PropValRel.Exists then begin tSQL_PropValRel.Filtered := false; if tSQL_PropValRel.RecordCount > 0 then begin tSQL_PropValRel.First; while Not tSQL_PropValRel.Eof do begin PropValRel := TNBPropValRel.Create(FActiveForm); PropValRel.LoadFromMemTable(FStringsMan); PropValRelList.Add(PropValRel); tSQL_PropValRel.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprPropValRels(PropValRelList); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_PropValNormRes.Exists then begin tSQL_PropValNormRes.Filtered := false; if tSQL_PropValNormRes.RecordCount > 0 then begin tSQL_PropValNormRes.First; while Not tSQL_PropValNormRes.Eof do begin PropValNormRes := TNBPropValNormRes.Create(FActiveForm); PropValNormRes.LoadFromMemTable(FStringsMan); PropValNormResList.Add(PropValNormRes); tSQL_PropValNormRes.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprPropValNormRes(PropValNormResList); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_NBResources.Exists then begin tSQL_NBResources.Filtered := false; if tSQL_NBResources.RecordCount > 0 then begin tSQL_NBResources.First; while Not tSQL_NBResources.Eof do begin Resource := TNBResource.Create(FActiveForm); Resource.LoadFromMemTable(FStringsMan); if Resource.IDCatalog = FIDFromOpened then Resource.IDCatalog := ID; Resources.Add(Resource); tSQL_NBResources.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprResources(Resources); if FMemBase.FMemBaseMode = mbmSQLMemTable then begin if tSQL_SuppliesKinds.Exists then begin tSQL_SuppliesKinds.Filtered := false; if tSQL_SuppliesKinds.RecordCount > 0 then begin tSQL_SuppliesKinds.First; while Not tSQL_SuppliesKinds.Eof do begin SuppliesKind := TNBSuppliesKind.Create(FActiveForm); SuppliesKind.LoadFromMemTable(FStringsMan); if SuppliesKind.IDCatalog = FIDFromOpened then SuppliesKind.IDCatalog := ID; SuppliesKinds.Add(SuppliesKind); tSQL_SuppliesKinds.Next; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadSprSuppliesKinds(SuppliesKinds); end; //***** PARSING for i := 0 to CatalogOwners.Count - 1 do begin CatalogOwner := TSCSCatalogExtended(CatalogOwners[i]); //*** Валюты FindedForI := false; j := 0; while j <= Currencies.Count - 1 do begin try Currency := TNBCurrency(Currencies[j]); if (Currency.IDCatalog = CatalogOwner.ID) and (Currency.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddCurrency(Currency); Currencies.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Типы компонент FindedForI := false; j := 0; while j <= ComponentTypes.Count - 1 do begin try ComponentType := TNBComponentType(ComponentTypes[j]); if (ComponentType.IDCatalog = CatalogOwner.ID) and (ComponentType.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddComponentType(ComponentType); ComponentTypes.Delete(j); //*** Свойства для типа компоненты if ComponentType.PropsCount > 0 then begin FindedForJ := false; k := 0; while k <= CompTypePropRelations.Count - 1 do begin try CompTypePropRelation := TNBCompTypeProperty(CompTypePropRelations[k]); if CompTypePropRelation.GuidComponentType = ComponentType.ComponentType.GUID then begin FindedForJ := true; ComponentType.AddProperty(CompTypePropRelation); CompTypePropRelations.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Интерфейсы //if CatalogOwner.ItemType = itProject then begin FindedForI := false; j := 0; while j <= Interfaces.Count - 1 do begin try Interf := TNBInterface(Interfaces[j]); if (Interf.IDCatalog = CatalogOwner.ID) and (Interf.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddInterface(Interf); Interfaces.Delete(j); if Interf.InterfAccordanceCount > 0 then begin FindedForJ := false; k := 0; while k <= InterfaceAccordances.Count - 1 do begin try InterfaceAccordance := TNBInterfaceAccordance(InterfaceAccordances[k]); if InterfaceAccordance.GuidInterface = Interf.GUID then begin FindedForJ := true; Interf.AddInterfaceAccordance(InterfaceAccordance); InterfaceAccordances.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; if Interf.InterfNormsCount > 0 then begin FindedForJ := false; k := 0; while k <= InterfaceNorms.Count - 1 do begin try InterfaceNorm := TNBInterfaceNorm(InterfaceNorms[k]); if InterfaceNorm.GuidInterface = Interf.GUID then begin FindedForJ := true; Interf.AddInterfaceNorm(InterfaceNorm); InterfaceNorms.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Типы сетей FindedForI := false; j := 0; while j <= NetTypes.Count - 1 do begin try NetType := TNBNetType(NetTypes[j]); if (NetType.IDCatalog = CatalogOwner.ID) and (NetType.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddNetType(NetType); NetTypes.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Нормы FindedForI := false; j := 0; while j <= Norms.Count - 1 do begin try Norm := TNBNorm(Norms[j]); if (Norm.IDCatalog = CatalogOwner.ID) and (Norm.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddNorm(Norm); Norms.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Условные обозначения FindedForI := false; j := 0; while j <= ObjectIcons.Count - 1 do begin try ObjectIcon := TNBObjectIcon(ObjectIcons[j]); if (ObjectIcon.IDCatalog = CatalogOwner.ID) and (ObjectIcon.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddObjectIcon(ObjectIcon); ObjectIcons.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** производители FindedForI := false; j := 0; while j <= Producers.Count - 1 do begin try Producer := TNBProducer(Producers[j]); if (Producer.IDCatalog = CatalogOwner.ID) and (Producer.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddProducer(Producer); Producers.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Свойства FindedForI := false; j := 0; while j <= Properts.Count - 1 do begin try Propert := TNBProperty(Properts[j]); if (Propert.IDCatalog = CatalogOwner.ID) and (Propert.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddProperty(Propert); Properts.Delete(j); if Propert.PropValRelCount > 0 then begin FindedForJ := false; k := 0; while k <= PropValRelList.Count - 1 do begin try PropValRel := TNBPropValRel(PropValRelList[k]); if PropValRel.GuidProperty = Propert.PropertyData.GUID then begin FindedForJ := true; Propert.AddPropValRel(PropValRel); PropValRelList.Delete(k); if PropValRel.PropValNormResCount > 0 then begin FindedForK := false; l := 0; while l <= PropValNormResList.Count - 1 do begin try PropValNormRes := TNBPropValNormRes(PropValNormResList[l]); if PropValNormRes.GuidPropValRel = PropValRel.GUID then begin FindedForK := true; PropValRel.AddPropValNormRes(PropValNormRes); PropValNormResList.Delete(l); end else begin if FindedForK then Break; ///// BREAK ///// Inc(l); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Ресурсы FindedForI := false; j := 0; while j <= Resources.Count - 1 do begin try Resource := TNBResource(Resources[j]); if (Resource.IDCatalog = CatalogOwner.ID) and (Resource.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddResource(Resource); Resources.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; //*** Виды поставок FindedForI := false; j := 0; while j <= SuppliesKinds.Count - 1 do begin try SuppliesKind := TNBSuppliesKind(SuppliesKinds[j]); if (SuppliesKind.IDCatalog = CatalogOwner.ID) and (SuppliesKind.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddSuppliesKind(SuppliesKind); SuppliesKinds.Delete(j); end else begin if FindedForI then Break; //// BREAK //// Inc(j); end; except on E: Exception do AddExceptionToLogEx(ProcedureName, E.Message); end; end; end; for i := 0 to CatalogOwners.Count - 1 do begin CatalogOwner := TSCSCatalogExtended(CatalogOwners[i]); CatalogOwner.SynchonizeSpravochikWithMarkMasks(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); if CatalogOwner.ItemType = itProject then CatalogOwner.SynchonizeSpravochikElements(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik, [vkInterface, vkComponentType, vkCurrency]) else CatalogOwner.SynchonizeSpravochikElements(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik, [vkComponentType]); end; FreeAndNil(Currencies); FreeAndNil(ComponentTypes); FreeAndNil(CompTypePropRelations); FreeAndNil(Interfaces); FreeAndNil(InterfaceAccordances); FreeAndNil(InterfaceNorms); FreeAndNil(NetTypes); FreeAndNil(Norms); FreeAndNil(ObjectIcons); FreeAndNil(Producers); FreeAndNil(Properts); FreeAndNil(PropValRelList); FreeAndNil(PropValNormResList); FreeAndNil(Resources); FreeAndNil(SuppliesKinds); FreeAndNil(CatalogOwners); end; procedure TSCSCatalogExtended.SendFromMemTablesToStringsMan; var LastStrType: Integer; CurrStrType: Integer; CurrStringList: TStringList; StringsManList: TList; ptrStringsManInfo: PStringsManInfo; i: integer; begin {FStringsMan.Clear; with TF_Main(FActiveForm).DM do begin if tSQL_StringsMan.Exists then begin if tSQL_StringsMan.Active then if tSQL_StringsMan.RecordCount > 0 then begin tSQL_StringsMan.First; LastStrType := -1; CurrStringList := nil; while Not tSQL_StringsMan.Eof do begin //*** Текущий тип строки CurrStrType := tSQL_StringsMan.Fields[fiStringsMan_StrType].AsInteger; //*** Если не совпадают тек. с последним типом строки, то ищем подходящий стринг лист if CurrStrType <> LastStrType then begin CurrStringList := nil; case CurrStrType of stCataogName: CurrStringList := FStringsMan.FCataogNameStrings; stCataogNameShort: CurrStringList := FStringsMan.FCataogNameShortStrings; stComponGuidNB: CurrStringList := FStringsMan.FComponGuidNBStrings; stComponName: CurrStringList := FStringsMan.FComponNameStrings; stComponNameShort: CurrStringList := FStringsMan.FComponNameShortStrings; stComponCypher: CurrStringList := FStringsMan.FComponCypherStrings; stComponNotice: CurrStringList := FStringsMan.FComponNoticeStrings; stComponArticul: CurrStringList := FStringsMan.FComponArticulStrings; stComponentTypeGUID: CurrStringList := FStringsMan.FComponentTypeGUIDStrings; stObjectIconGUID: CurrStringList := FStringsMan.FObjectIconGUIDStrings; stProducerGUID: CurrStringList := FStringsMan.FProducerGUIDStrings; stSuppliesKindGUID: CurrStringList := FStringsMan.FSuppliesKindGUIDStrings; skSupplierGUID: CurrStringList := FStringsMan.FSupplierGUIDStrings; stNetTypeGUID: CurrStringList := FStringsMan.FNetTypeGUIDStrings; stIzm: CurrStringList := FStringsMan.FIzmStrings; stInterfaceGUID: CurrStringList := FStringsMan.FInterfaceGUIDStrings; stInterfaceNotice: CurrStringList := FStringsMan.FInterfaceNoticeStrings; stInterfaceSideSection: CurrStringList := FStringsMan.FInterfaceSideSectionStrings; stPropertyGUID: CurrStringList := FStringsMan.FPropertyGUIDStrings; stPropertyValue: CurrStringList := FStringsMan.FPropertyValueStrings; stNBConnectorGuid: CurrStringList := FStringsMan.FNBConnectorGuidStrings; stNormGuidNB: CurrStringList := FStringsMan.FNormGuidNBStrings; stNormCypher: CurrStringList := FStringsMan.FNormCypherStrings; stNormName: CurrStringList := FStringsMan.FNormNameStrings; stNormWorkKind: CurrStringList := FStringsMan.FNormWorkKindStrings; stResourceRelGuidNB: CurrStringList := FStringsMan.FResourceRelGuidNBStrings; stResourceRelCypher: CurrStringList := FStringsMan.FResourceRelCypherStrings; stResourceRelName: CurrStringList := FStringsMan.FResourceRelNameStrings; stCompTypeSysNameStrings: CurrStringList := FStringsMan.FCompTypeSysNameStrings; end; if CurrStringList <> nil then LastStrType := CurrStrType; end; //*** если определен стринг лист if CurrStringList <> nil then begin FStringsMan.AddStrToList(tSQL_StringsMan.Fields[fiStringsMan_Name].AsString, tSQL_StringsMan.Fields[fiStringsMan_ID].AsInteger, CurrStringList ); end; tSQL_StringsMan.Next; end; end; end; end; } StringsManList := TList.Create; FStringsMan.Clear; if FMemBase.FMemBaseMode = mbmSQLMemTable then begin with TF_Main(FActiveForm).DM do begin if tSQL_StringsMan.Exists then begin if tSQL_StringsMan.Active then if tSQL_StringsMan.RecordCount > 0 then begin tSQL_StringsMan.First; LastStrType := -1; CurrStringList := nil; while Not tSQL_StringsMan.Eof do begin GetMem(ptrStringsManInfo, SizeOf(TStringsManInfo)); ptrStringsManInfo.ID := tSQL_StringsMan.Fields[fiStringsMan_ID].AsInteger; ptrStringsManInfo.StrType := tSQL_StringsMan.Fields[fiStringsMan_StrType].AsInteger; ptrStringsManInfo.Name := tSQL_StringsMan.Fields[fiStringsMan_Name].AsString; StringsManList.Add(ptrStringsManInfo); tSQL_StringsMan.Next; end; end; end; end; end else if FMemBase.FMemBaseMode = mbmFiles then FMemBase.LoadStringsManInfos(StringsManList); LastStrType := -1; CurrStringList := nil; for i := 0 to StringsManList.Count - 1 do begin ptrStringsManInfo := PStringsManInfo(StringsManList[i]); //*** Текущий тип строки CurrStrType := ptrStringsManInfo.StrType; //*** Если не совпадают тек. с последним типом строки, то ищем подходящий стринг лист if CurrStrType <> LastStrType then begin CurrStringList := nil; case CurrStrType of stCataogName: CurrStringList := FStringsMan.FCataogNameStrings; stCataogNameShort: CurrStringList := FStringsMan.FCataogNameShortStrings; stComponGuidNB: CurrStringList := FStringsMan.FComponGuidNBStrings; stComponName: CurrStringList := FStringsMan.FComponNameStrings; stComponNameShort: CurrStringList := FStringsMan.FComponNameShortStrings; stComponCypher: CurrStringList := FStringsMan.FComponCypherStrings; stComponNotice: CurrStringList := FStringsMan.FComponNoticeStrings; stComponArticul: CurrStringList := FStringsMan.FComponArticulStrings; stComponentTypeGUID: CurrStringList := FStringsMan.FComponentTypeGUIDStrings; stObjectIconGUID: CurrStringList := FStringsMan.FObjectIconGUIDStrings; stProducerGUID: CurrStringList := FStringsMan.FProducerGUIDStrings; stSuppliesKindGUID: CurrStringList := FStringsMan.FSuppliesKindGUIDStrings; skSupplierGUID: CurrStringList := FStringsMan.FSupplierGUIDStrings; stNetTypeGUID: CurrStringList := FStringsMan.FNetTypeGUIDStrings; stIzm: CurrStringList := FStringsMan.FIzmStrings; stInterfaceGUID: CurrStringList := FStringsMan.FInterfaceGUIDStrings; stInterfaceNotice: CurrStringList := FStringsMan.FInterfaceNoticeStrings; stInterfaceSideSection: CurrStringList := FStringsMan.FInterfaceSideSectionStrings; stPropertyGUID: CurrStringList := FStringsMan.FPropertyGUIDStrings; stPropertyValue: CurrStringList := FStringsMan.FPropertyValueStrings; stPropValRelGUID: CurrStringList := FStringsMan.FPropValRelGUIDStrings; stNBConnectorGuid: CurrStringList := FStringsMan.FNBConnectorGuidStrings; stNormGuidNB: CurrStringList := FStringsMan.FNormGuidNBStrings; stNormCypher: CurrStringList := FStringsMan.FNormCypherStrings; stNormName: CurrStringList := FStringsMan.FNormNameStrings; stNormWorkKind: CurrStringList := FStringsMan.FNormWorkKindStrings; stResourceRelGuidNB: CurrStringList := FStringsMan.FResourceRelGuidNBStrings; stResourceRelCypher: CurrStringList := FStringsMan.FResourceRelCypherStrings; stResourceRelName: CurrStringList := FStringsMan.FResourceRelNameStrings; stCompTypeSysNameStrings: CurrStringList := FStringsMan.FCompTypeSysNameStrings; end; if CurrStringList <> nil then LastStrType := CurrStrType; end; //*** если определен стринг лист if CurrStringList <> nil then begin FStringsMan.AddStrToList(ptrStringsManInfo.Name, ptrStringsManInfo.ID, CurrStringList ); end; end; FreeList(StringsManList); end; procedure TSCSCatalogExtended.SetItemsFTreeNodeToNil; var i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; SCSCatalog.FTreeViewNode := nil; for j := 0 to SCSCatalog.FComponentReferences.Count - 1 do SCSCatalog.FComponentReferences[j].FTreeViewNode := nil; end; for i := 0 to FComponentReferences.Count - 1 do FComponentReferences[i].FTreeViewNode := nil; end; procedure TSCSCatalogExtended.Save; begin inherited; end; procedure TSCSCatalogExtended.UpdateCADObjIconsFromUpdatedSpav; var i, j: Integer; SCSCatalog: TSCSCatalog; CanUpdateIconInCAD: Boolean; begin try if FUpdatedSprObjIcons.Count > 0 then begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if IsSCSObjectItemType(SCSCatalog.ItemType) then begin CanUpdateIconInCAD := false; for j := 0 to SCSCatalog.FComponentReferences.Count - 1 do if FUpdatedSprObjIcons.IndexOf(SCSCatalog.FComponentReferences[j].GUIDObjectIcon) <> -1 then begin CanUpdateIconInCAD := true; Break; //// BREAK //// end; if CanUpdateIconInCAD then TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectIcon(SCSCatalog); end; end; FUpdatedSprObjIcons.Clear; end; except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.UpdateCADObjIconsFromUpdatedSpav', E.Message); end; end; procedure TSCSCatalogExtended.UpdateSpravObjIconsFromNB; var i: Integer; SprObjectIcon: TNBObjectIcon; NBObjectIcon: TNBObjectIcon; begin try FUpdatedSprObjIcons.Clear; for i := 0 to FSpravochnik.FNBObjectIcons.Count - 1 do begin SprObjectIcon := TNBObjectIcon(FSpravochnik.FNBObjectIcons[i]); NBObjectIcon := TF_Main(FActiveForm).FNormBase.GSCSBase.NBSpravochnik.GetObjectIconByGUID(SprObjectIcon.GUID); if NBObjectIcon <> nil then begin CopyStream(SprObjectIcon.FProjBlk, NBObjectIcon.FProjBlk); CopyStream(SprObjectIcon.FActiveBlk, NBObjectIcon.FActiveBlk); end; end; except on E: Exception do AddExceptionToLogEx('TSCSCatalogExtended.UpdateSpravObjIconsFromNB', E.Message); end; end; procedure TSCSCatalogExtended.UpdateValuesAfterLoadFromMemTablesToClasses; var i, j, k, BuildID, CurrNBBuildID: Integer; ProjectOwner: TSCSProject; ListOwner: TSCSList; SCSCatalog: TSCSCatalog; Propert: PProperty; NBPropertyData: TPropertyData; SCSComponent, TopComponent, ChildCompon, NBCompon: TSCSComponent; Interf: TSCSInterface; ComponList: TSCSComponents; IOfIRels: TSCSObjectList; IOfIRel: TSCSIOfIRel; //InterfPosConnection: TSCSInterfPosConnection; ConnectedComponsInfo: TConnectedComponsInfo; SprProperty: TNBProperty; SprCompType: TNBComponentType; CadForm: TForm; begin BuildID := FBuildID; CurrNBBuildID := FNBBuildID; ProjectOwner := nil; ProjectOwner := TSCSProject(GetTopParentCatalog); while BuildID < 6 do Inc(BuildID); if BuildID = 6 then begin //*** Многократные интерфейсы для сечения for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if SCSComponent.IsLine = biTrue then for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin Interf := SCSComponent.FInterfaces[j]; if (Interf.TypeI = itConstructive) and (Interf.Multiple = biFalse) and (Interf.ValueI > 0) then Interf.Multiple := biTrue; end; end; Inc(BuildID); end; if BuildID = 7 then begin Inc(BuildID); end; //*** Определить занятые позиции интерфейсов IOfIRels := GetAllIOfIRel; for i := 0 to IOfIRels.Count - 1 do begin //IOfIRel := TSCSIOfIRel(IOfIRels[i]); IOfIRel := TSCSIOfIRel(IOfIRels.List.List^[i]); DefineNoExistsInterfPosConnection(IOfIRel); end; FreeAndNil(IOfIRels); // Inc(BuildID); //end; if BuildID = 8 then begin //*** проектируемые/дествующие интерфейсы for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FInterfaces.Count - 1 do SCSComponent.FInterfaces[j].SignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); end; Inc(BuildID); end; if BuildID = 9 then begin for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if SCSComponent.IsLine = biTrue then begin if SCSComponent.ComponentType.SysName = ctsnCableChannel then begin NBPropertyData := TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik.GetPropertyDataBySysName(pnCableChannelFullnessKoef); if NBPropertyData.GUID <> '' then SCSComponent.AddProperty(NBPropertyData.ID, NBPropertyData.GUID, NBPropertyData.IDDataType, biFalse, biFalse, biTrue, NBPropertyData.DefValue, NBPropertyData.Name, NBPropertyData.SysName); end; NBPropertyData := TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik.GetPropertyDataBySysName(pnPercentCableLengthReserv); if NBPropertyData.GUID <> '' then SCSComponent.AddProperty(NBPropertyData.ID, NBPropertyData.GUID, NBPropertyData.IDDataType, biFalse, biFalse, biTrue, NBPropertyData.DefValue, NBPropertyData.Name, NBPropertyData.SysName); end; end; Inc(BuildID); end; if BuildID = 10 then begin //*** Загнать данные компонент в справочники for i := 0 to FComponentReferences.Count - 1 do AddNewSprGUIDsToProjectFromComponent(FComponentReferences[i], FSpravochnik); //*** Загнать свойства объектов в справочники for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; for j := 0 to SCSCatalog.FProperties.Count - 1 do begin Propert := SCSCatalog.FProperties[j]; AddStringToStringListOnce(FSpravochnik.FNewGUIDsProperties, Propert.GUIDProperty); AddStringToStringListOnce(FSpravochnik.FNewGUIDsProperties, Propert.GUIDCrossProperty); if Propert.GUIDProperty = '' then begin NBPropertyData := F_NormBase.GSCSBase.FNBSpravochnik.GetPropertyDataBySysName(Propert.SysName); Propert.GUIDProperty := NBPropertyData.GUID; end; end; end; FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); if ProjectOwner <> nil then ProjectOwner.DefineSpravDataFromOtherSpravByNewGUIDs(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); Inc(BuildID); end; ProjectOwner := GetProject; if BuildID = 11 then begin //*** Определить высоту подвесного потолка для комнат for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if (SCSCatalog.ItemType = itRoom) and (SCSCatalog.FRoomSetting <> nil) then begin ListOwner := SCSCatalog.GetListOwner; if ListOwner <> nil then SCSCatalog.FRoomSetting.HeightCeiling := ListOwner.Setting.HeightCeiling; end; end; Inc(BuildID); end; if BuildID = 12 then begin //*** Определить трассы с кабельными каналами for i := 0 to FChildCatalogReferences.Count - 1 do TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectHaveCableChannel(FChildCatalogReferences[i]); Inc(BuildID); end; while BuildID < 14 do Inc(BuildID); if BuildID = 14 then begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType = itRoom then if SCSCatalog.NameShort = '' then SCSCatalog.NameShort := DecToABC(SCSCatalog.MarkID); end; Inc(BuildID); end; if BuildID = 15 then begin for i := 0 to FConnectedComponsList.Count - 1 do begin ConnectedComponsInfo := FConnectedComponsList[i]; if ConnectedComponsInfo.IDConnectObject = -1 then ConnectedComponsInfo.IDConnectObject := 0; if ConnectedComponsInfo.IDConnectCompon = -1 then ConnectedComponsInfo.IDConnectCompon := 0; if ConnectedComponsInfo.IDSideCompon = -1 then ConnectedComponsInfo.IDSideCompon := 0; end; Inc(BuildID); end; while BuildID < 17 do Inc(BuildID); if BuildID = 17 then begin CorrectConnectedComponsInfo; Inc(BuildID); end; if BuildID = 18 then begin // ЭКК установить поле ComeFrom что они пришли автоматом for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if SCSComponent.ComponentType.SysName = ctsnCableChannelElement then begin if SCSComponent.Parent is TSCSCatalog then SCSComponent.ComeFrom := cftAuto else begin TopComponent := SCSComponent.GetTopComponent; if TopComponent.ComponentType.SysName = ctsnCableChannelElement then begin TopComponent.ComeFrom := cftAuto; for j := 0 to TopComponent.ChildReferences.Count - 1 do TopComponent.ChildReferences[j].ComeFrom := cftAuto; end; end; end; end; Inc(BuildID); end; if BuildID = 19 then begin // Меняем тип данных свойства Категория с текстового на строковый список for i := 0 to FSpravochnik.FNBProperties.Count - 1 do begin SprProperty := TNBProperty(FSpravochnik.FNBProperties[i]); if AnsiUpperCase(SprProperty.PropertyData.SysName) = pnCategory then SprProperty.PropertyData.IDDataType := dtStringList; // Поправить системные имена в свойствах (первая буква "С" кирилическая - меняем на латинницу) if SprProperty.PropertyData.SysName = 'СONDUIT_SIDE_DIMENSIONS' then SprProperty.PropertyData.SysName := pnConduitSideDimensions else if SprProperty.PropertyData.SysName = 'СONDUITELMT_SIDE_DIMNS' then SprProperty.PropertyData.SysName := pnConduitElmentSideDimensions else if SprProperty.PropertyData.SysName = 'СONDUITELMT_SIDE1_DIMNS' then SprProperty.PropertyData.SysName := pnConduitElmentSideDimensions else if SprProperty.PropertyData.SysName = 'СONDUITELMT_SIDE2_DIMNS' then SprProperty.PropertyData.SysName := pnConduitElmentSide2Dimensions else if SprProperty.PropertyData.SysName = 'СONDUITELMT_SIDE3_DIMNS' then SprProperty.PropertyData.SysName := pnConduitElmentSide3Dimensions else if SprProperty.PropertyData.SysName = 'СONDUITELMT_SIDE4_DIMNS' then SprProperty.PropertyData.SysName := pnConduitElmentSide4Dimensions; end; Inc(BuildID); end; if BuildID = 20 then begin //if Self is TSCSList then // DefineCADPointCornersObjects(GetCADFormBySCSObject(Self)); // обработка в CorrectAfterFullOpen; DefineLackComponProps; Inc(BuildID); end; if BuildID = 21 then begin // Кир. стены в комнаты NBCompon := nil; // НБ компонент "комната" SprCompType := nil; // Тип компонента "комната" в справочнике проекта ComponList := TSCSComponents.Create(false); // список стен for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType = itArhContainer then begin for j := 0 to SCSCatalog.FComponentReferences.Count - 1 do begin SCSComponent := SCSCatalog.FComponentReferences[j]; if SCSComponent.IsLine = ctArhBrickWall then begin if NBCompon = nil then begin NBCompon := F_NormBase.GSCSBase.GetComponByIsLine(ctArhRoom); if NBCompon <> nil then begin NBCompon.LoadComponentType; SprCompType := ProjectOwner.FSpravochnik.GetComponentTypeWithAssign(NBCompon.ComponentType.GUID, F_NormBase.GSCSBase.FNBSpravochnik); end; end; // Если не нашли в базе, то прекращаем поиск if (NBCompon = nil) or (SprCompType = nil) then Break; //// BREAK //// SCSComponent.GuidNB := NBCompon.GuidNB; SCSComponent.Name := NBCompon.Name; SCSComponent.IsLine := ctArhRoom; SCSComponent.MarkID := SCSComponent.MarkID + 100; // чтобы не совпадасть с существующими комнатами SCSComponent.ComponentType := SprCompType.ComponentType; SCSComponent.GUIDComponentType := SprCompType.ComponentType.GUID; SCSComponent.DefineNameMarks; // стены в список for k := 0 to SCSComponent.ChildComplects.Count - 1 do begin ChildCompon := SCSComponent.ChildComplects[k]; if ChildCompon.IsLine = ctArhWall then ComponList.Add(ChildCompon); end; end; end; end; end; DefineLackComponProps; // стенам ставим признак что есть фундамент и подтягиваем свойства для фундаментов for i := 0 to ComponList.Count - 1 do begin ChildCompon := ComponList[i]; ChildCompon.SetPropertyValueAsBoolean(pnBasement, true); DefineBasementProps(ChildCompon, false, false); end; FreeAndNil(ComponList); Inc(BuildID); end; //21.08.2012 - Определяем флаг IsMarkInCaptions - "Использовать маркировку в подписях" if BuildID = 22 then begin for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; for j := 0 to SCSComponent.FInterfaces.Count - 1 do if SCSComponent.FInterfaces[j].IsPort = biTrue then begin SCSComponent.IsMarkInCaptions := biTrue; if SCSComponent.IsLine = biTrue then EmptyProcedure; Break; //// BREAK //// end; end; end; //20.01.2014 if BuildID = 25 then begin if Self is TSCSProject then if TSCSProject(Self).Setting.Revision = 0 then TSCSProject(Self).Setting.Revision := 1; end; // Если справочник объекта более старый со справочником НБ, то обновляем некоторые данные FUpdatedSprObjIcons.Clear; if CurrNBBuildID < 28 then begin UpdateSpravObjIconsFromNB; end; end; procedure TSCSCatalogExtended.LoadMarkMasks; var NBMarkTemplates: TList; ptrCatalogMarkMask, ptrNBMarkTemplate: PCatalogMarkMask; //CanSaveMarkMask: Boolean; strFilter: String; Stream: TStream; StreamSize, i: Integer; FMTMarkMasks: TSQLMemTable; begin try //CanSaveMarkMask := false; ClearList(MarkMasks); Exit; ///// EXIT ///// Stream := nil; Stream := TMemoryStream.Create; strFilter := 'id = '''+IntTostr(ID)+''''; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, 'select '+fnCompTypeMarkMasks+' from '+tnCatalog+' where '+strFilter); FQSelect.FN(fnCompTypeMarkMasks).SaveToStream(Stream); FQSelect.Close; end; qmMemory: begin FMarkMasrksStream.Position := 0; Stream.Position := 0; Stream.CopyFrom(FMarkMasrksStream, 0); FMarkMasrksStream.Position := 0; Stream.Position := 0; {SetFilterToSQLMemTable(FMemTable, strFilter); if FMemTable.RecordCount > 0 then begin FMemTable.First; TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).SaveToStream(Stream); end;} end; end; Stream.Position := 0; StreamSize := Stream.Size; if StreamSize > 0 then try FMTMarkMasks := TSQLMemTable.Create(nil); try //FMTMarkMasks.Close; FMTMarkMasks.LoadTableFromStream(Stream); FMTMarkMasks.Open; for i := 0 to FMTMarkMasks.RecordCount - 1 do begin FMTMarkMasks.RecNo := i+1; GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask.ID := -1; ptrCatalogMarkMask.IDCatalog := ID; ptrCatalogMarkMask.IDComponentType := FMTMarkMasks.FieldByName('ID_component_type').AsInteger; ptrCatalogMarkMask.MarkMask := FMTMarkMasks.FieldByName('Mark_Mask').AsString; ptrCatalogMarkMask.MakeEdit := meNone; FMarkMasks.Add(ptrCatalogMarkMask); end; finally FMTMarkMasks.Close; FMTMarkMasks.DeleteTable(true); FreeAndNil(FMTMarkMasks); end; except raise; end; FreeAndNil(Stream); //*** Загрузить маски с неопределенными типами NBMarkTemplates := GetNBMarkTemplates; for i := 0 to NBMarkTemplates.Count - 1 do begin ptrNBMarkTemplate := NBMarkTemplates[i]; ptrCatalogMarkMask := nil; ptrCatalogMarkMask := GetMarkMaskByComponType(ptrNBMarkTemplate.IDComponentType); if ptrCatalogMarkMask = nil then begin FMarkMasks.Add(ptrNBMarkTemplate); NBMarkTemplates[i] := nil; end; end; NBMarkTemplates.Pack; FreeList(NBMarkTemplates); { //*** Загрузить маски с неопределенными типами with TF_MAIN(ActiveForm).FNormBase.DM do begin SetSQLToQuery(scsQTSCSSelect, ' select id, mark_mask from component_types '); while Not scsQTSCSSelect.Eof do begin ptrCatalogMarkMask := nil; ptrCatalogMarkMask := GetMarkMaskByComponType(scsQTSCSSelect.GetFNAsInteger('id')); if ptrCatalogMarkMask = nil then begin //CanSaveMarkMask := true; //New(ptrCatalogMarkMask); GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask.ID := -1; ptrCatalogMarkMask.IDCatalog := ID; ptrCatalogMarkMask.IDComponentType := scsQTSCSSelect.GetFNAsInteger('id'); ptrCatalogMarkMask.MarkMask := scsQTSCSSelect.GetFNAsString('Mark_Mask'); ptrCatalogMarkMask.MakeEdit := meMake; MarkMasks.Add(ptrCatalogMarkMask); end; scsQTSCSSelect.Next; end; scsQTSCSSelect.Close; //if CanSaveMarkMask then //SaveMarkMasks; end; } {strWhere := 'id_catalog = '''+IntToStr(ID)+''''; case FQueryMode of qmPhisical: begin SetSQLToQuery(FQuery_Select, ' select * from catalog_mark_mask where '+strWhere); while Not FQuery_Select.Eof do begin //New(ptrCatalogMarkMask); GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask.ID := FQuery_Select.GetFNAsInteger('ID'); ptrCatalogMarkMask.IDCatalog := FQuery_Select.GetFNAsInteger('ID_Catalog'); ptrCatalogMarkMask.IDComponentType := FQuery_Select.GetFNAsInteger('ID_component_type'); ptrCatalogMarkMask.MarkMask := FQuery_Select.GetFNAsString('Mark_Mask'); ptrCatalogMarkMask.MakeEdit := meNone; MarkMasks.Add(ptrCatalogMarkMask); FQuery_Select.Next; end; end; qmMemory: with TF_Main(ActiveForm).DM do begin SetFilterToSQLMemTable(tSQL_CatalogMarkMask, strWhere); tSQL_CatalogMarkMask.First; while Not tSQL_CatalogMarkMask.Eof do begin //New(ptrCatalogMarkMask); GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask.ID := tSQL_CatalogMarkMask.FieldByName('ID').AsInteger; ptrCatalogMarkMask.IDCatalog := tSQL_CatalogMarkMask.FieldByName('ID_Catalog').AsInteger; ptrCatalogMarkMask.IDComponentType := tSQL_CatalogMarkMask.FieldByName('ID_component_type').AsInteger; ptrCatalogMarkMask.MarkMask := tSQL_CatalogMarkMask.FieldByName('Mark_Mask').AsString; ptrCatalogMarkMask.MakeEdit := meNone; MarkMasks.Add(ptrCatalogMarkMask); tSQL_CatalogMarkMask.Next; end; end; end; //*** Загрузить маски с неопределенными типами with TF_MAIN(ActiveForm).FNormBase.DM do begin SetSQLToQuery(scsQTSCSSelect, ' select id, mark_mask from component_types '); while Not scsQTSCSSelect.Eof do begin ptrCatalogMarkMask := nil; ptrCatalogMarkMask := GetMarkMaskByComponType(scsQTSCSSelect.GetFNAsInteger('id')); if ptrCatalogMarkMask = nil then begin CanSaveMarkMask := true; //New(ptrCatalogMarkMask); GetMem(ptrCatalogMarkMask, SizeOf(TCatalogMarkMask)); ptrCatalogMarkMask.ID := -1; ptrCatalogMarkMask.IDCatalog := ID; ptrCatalogMarkMask.IDComponentType := scsQTSCSSelect.GetFNAsInteger('id'); ptrCatalogMarkMask.MarkMask := scsQTSCSSelect.GetFNAsString('Mark_Mask'); ptrCatalogMarkMask.MakeEdit := meMake; MarkMasks.Add(ptrCatalogMarkMask); end; scsQTSCSSelect.Next; end; scsQTSCSSelect.Close; if CanSaveMarkMask then SaveMarkMasks; end; } except on E: Exception do AddExceptionToLog(': '+E.Message); end; end; function TSCSCatalogExtended.SaveMarkMasks: Boolean; var i: Integer; ptrCatalogMarkMask: PCatalogMarkMask; FMTMarkMasks: TSQLMemTable; Stream: TStream; //IDCatMarkMask: Integer; strFilter: String; begin Result := false; (* try Stream := TMemoryStream.Create; FMTMarkMasks := TSQLMemTable.Create(nil); try FMTMarkMasks.FieldDefs.Add(fnIDComponentType, ftInteger); FMTMarkMasks.FieldDefs.Add(fnMarkMask, ftString, 200); FMTMarkMasks.Open; for i := 0 to MarkMasks.Count - 1 do begin ptrCatalogMarkMask := MarkMasks[i]; FMTMarkMasks.Append; FMTMarkMasks.FieldByName(fnIDComponentType).AsInteger := ptrCatalogMarkMask.IDComponentType; FMTMarkMasks.FieldByName(fnMarkMask).AsString := ptrCatalogMarkMask.MarkMask; FMTMarkMasks.Post; end; FMTMarkMasks.Close; FMTMarkMasks.SaveTableToStream(Stream); Stream.Position := 0; finally if FMTMarkMasks.Active then FMTMarkMasks.Close; FMTMarkMasks.DeleteTable(true); FMTMarkMasks.Free; end; strFilter := 'id = '''+IntTostr(ID)+''''; case FQueryMode of qmPhisical: begin ChangeSQLQuery(FQuery_Operat, 'update '+tnCatalog+' set '+ fnCompTypeMarkMasks +' = :'+fnCompTypeMarkMasks +' '+ 'where '+strFilter); FQuery_Operat.ParamLoadFromStream(fnCompTypeMarkMasks, Stream); FQuery_Operat.ExecQuery; FQuery_Operat.Close; end; qmMemory: begin FMarkMasrksStream.Position := 0; FMarkMasrksStream.CopyFrom(Stream, 0); {SetFilterToSQLMemTable(FMemTable, strFilter); if FMemTable.RecordCount > 0 then begin FMemTable.First; FMemTable.Edit; TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(Stream); FMemTable.Post; end;} end; end; { for i := 0 to MarkMasks.Count - 1 do begin ptrCatalogMarkMask := MarkMasks[i]; case ptrCatalogMarkMask.MakeEdit of meMake: begin SaveMarkMaskAsNew(ptrCatalogMarkMask^); Result := True; end; meEdit: begin UpdateMarkMask(ptrCatalogMarkMask^); Result := true; end; end; } {//*** Проверить есть ли такая маска в базе IDCatMarkMask := 0; SetSQLToQuery(FQuery_Select, ' select id from catalog_mark_mask '+ ' where (id_catalog = '''+IntToStr(ID)+''') and (id_component_type = '''+IntToStr(ptrCatalogMarkMask.IDComponentType)+''') '); IDCatMarkMask := FQuery_Select.FN('ID').AsInteger; if IDCatMarkMask = 0 then begin ChangeSQLQuery(FQuery_Operat, ' insert into catalog_mark_mask (id_catalog, id_component_type, ) '); end; end; } except on E: Exception do AddExceptionToLog('TSCSCatalogExtended.SaveMarkMasks: '+E.Message); end; *) end; procedure TSCSCatalogExtended.SynchonizeSpravochikElements(ANBSpravochnik: TSpravochnik; AElements: TSprElements); var SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; SCSInterface: TSCSinterface; SprCurrencyM, SprCurrencyS, NBCurrencyM, NBCurrencyS, NBCurrency: TNBCurrency; SprComponentType, NBComponentType: TNBComponentType; SprInterface, NBInterface: TNBInterface; LookedCompTypeGuids, LookedInterfGuids: TStringList; i, j, k: Integer; ProjOwner: TSCSProject; procedure AddInterfaceAccordanceIfNoExists(const AInterfGUID, AAccordGUID: string; AKolvo: Integer); var SprInterf: TNBInterface; SprInterfAccord: TNBInterfaceAccordance; begin SprInterf := FSpravochnik.GetInterfaceByGUID(AInterfGUID); if SprInterf <> nil then begin SprInterfAccord := SprInterf.GetInterfAccordanceByGUIDAccordance(AAccordGUID); if SprInterfAccord = nil then begin SprInterfAccord := TNBInterfaceAccordance.Create(FActiveForm); SprInterfAccord.GUID := CreateGUID; SprInterfAccord.GuidInterface := AInterfGUID; SprInterfAccord.GUIDAccordance := AAccordGUID; SprInterfAccord.InterfComponIsLine := ltAnyType; SprInterfAccord.AccordComponIsLine := ltAnyType; SprInterfAccord.Kolvo := AKolvo; SprInterf.AddInterfaceAccordance(SprInterfAccord); end; end; end; begin LookedCompTypeGuids := TStringList.Create; LookedInterfGuids := TStringList.Create; LookedCompTypeGuids.Sorted := true; LookedInterfGuids.Sorted := true; //*** валюты if vkCurrency in AElements then begin //*** Если в проекте нет вобще валют, то добавить из НБ по ссылке на главную валюту if Self is TSCSProject then if FSpravochnik.FNBCurrencies.Count = 0 then begin NBCurrencyM := ANBSpravochnik.GetCurrencyByID(TSCSProject(Self).Setting.IDCurrency); //*** по ссылке не удалось найти главную валюту проэкта, то берем главную валюту НБ if NBCurrencyM = nil then NBCurrencyM := ANBSpravochnik.GetCurrencyByType(ctMain); if NBCurrencyM <> nil then begin SprCurrencyM := TNBCurrency.Create(FActiveForm); SprCurrencyM.Assign(NBCurrencyM); SprCurrencyM.Data.Main := ctMain; SprCurrencyM.Data.Ratio := SprCurrencyM.Data.Kolvo; FSpravochnik.AddCurrency(SprCurrencyM); end; //*** Закинуть вторую валюту NBCurrencyS := ANBSpravochnik.GetCurrencyByType(ctSecond); if NBCurrencyS <> nil then begin SprCurrencyS := TNBCurrency.Create(FActiveForm); SprCurrencyS.Assign(NBCurrencyS); FSpravochnik.AddCurrency(SprCurrencyS); end; end; //*** Закинуть валюты из НБ, которых нет в текщем справочнике for i := 0 to ANBSpravochnik.FNBCurrencies.Count - 1 do begin NBCurrency := TNBCurrency(ANBSpravochnik.FNBCurrencies[i]); FSpravochnik.GetCurrencyWithAssign(NBCurrency, ANBSpravochnik); end; end; //*** типы компонент, интерфейсы компонент for i := 0 to FChildCatalogReferences.Count - 1 do begin //SCSCatalog := FChildCatalogReferences[i]; SCSCatalog := TSCSCatalog(FChildCatalogReferences.List.List^[i]); for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin //SCSComponent := SCSCatalog.ComponentReferences[j]; SCSComponent := TSCSComponent(SCSCatalog.ComponentReferences.List.List^[j]); if vkComponentType in AElements then //if LookedCompTypeGuids.IndexOf(SCSComponent.GUIDComponentType) = -1 then begin SprComponentType := FSpravochnik.GetComponentTypeWithAssign(SCSComponent.GUIDComponentType, ANBSpravochnik); //LookedCompTypeGuids.Add(SCSComponent.GUIDComponentType); end; if vkInterface in AElements then for k := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSInterface := SCSComponent.FInterfaces[k]; //FSpravochnik.GetInterfaceWithAssign(SCSInterface.GUIDInterface, ANBSpravochnik, false, true); if LookedInterfGuids.IndexOf(SCSInterface.GUIDInterface) = -1 then begin FSpravochnik.GetInterfaceWithAssign(SCSInterface.GUIDInterface, ANBSpravochnik, false, false); LookedInterfGuids.Add(SCSInterface.GUIDInterface); end; end; end; end; //*** Заполнить Системные имена типов компонент if vkComponentType in AElements then begin for i := 0 to FSpravochnik.FNBComponentTypes.Count - 1 do begin SprComponentType := TNBComponentType(FSpravochnik.FNBComponentTypes[i]); if SprComponentType.ComponentType.SysName = '' then begin NBComponentType := ANBSpravochnik.GetComponentTypeByGUID(SprComponentType.ComponentType.GUID); if NBComponentType <> nil then SprComponentType.ComponentType.SysName := NBComponentType.ComponentType.SysName; end; // Если индекс для новых компонентов = 0, а компоненты такого типа уже существуют на проекте if ItemType = itProject then if SprComponentType.ComponentType.ComponentIndex = 0 then // Если этот тип компонентов встречался среди компонентов //if LookedCompTypeGuids.IndexOf(SCSComponent.GUIDComponentType) <> -1 then ; //15.01.2011 GenComponentMarkIDByType(SprComponentType.ComponentType.GUID, true); // отменено, так как уже предусматривается применение одного индекса для разных компонентов //07.10.2010 Подтягиваем отсутствующие свойства на тип из НБ NBComponentType := ANBSpravochnik.GetComponentTypeByGUID(SprComponentType.ComponentType.GUID); if NBComponentType <> nil then SprComponentType.AssignCompTypeNewProperties(NBComponentType.FProperties, ANBSpravochnik); end; // Определяем текущий тип проекта ProjOwner := GetProject; if ProjOwner <> nil then if ProjOwner.DefListSettings.SCSType = st_External then begin // Тип компонента ДОМ FSpravochnik.CreateCompTypeByStandartGUID(ctsnHouse, guidCompTypeHouse); // Тип компонента Подъезд FSpravochnik.CreateCompTypeByStandartGUID(ctsnApproach, guidCompTypeApproach); end; end; {if vkInterface in AElements then begin //*** Вкинуть отсутствующие соответствия интерфейсов i := 0; while i <= FSpravochnik.FNBInterfaces.Count - 1 do begin SprInterface := TNBInterface(FSpravochnik.FNBInterfaces[i]); NBInterface := ANBSpravochnik.GetInterfaceByGUID(SprInterface.GUID); if NBInterface <> nil then for j := 0 to NBInterface.FInterfaceAccordance.Count - 1 do begin end; Inc(i); end; end;} if vkInterface in AElements then begin // связываем универсальную жилу с интерфейсами // сначала определяем эту жилу if FSpravochnik.GetInterfaceWithAssign(guidUniversalWire, ANBSpravochnik, false, false) <> nil then begin AddInterfaceAccordanceIfNoExists(guidTwistedPair, guidUniversalWire, 2); AddInterfaceAccordanceIfNoExists(guidTwistedPairFTP, guidUniversalWire, 3); AddInterfaceAccordanceIfNoExists(guidInterfCoaxial, guidUniversalWire, 2); AddInterfaceAccordanceIfNoExists(guidInterf1pin, guidUniversalWire, 1); AddInterfaceAccordanceIfNoExists(guidInterf2pin, guidUniversalWire, 2); AddInterfaceAccordanceIfNoExists(guidInterf3pin, guidUniversalWire, 3); AddInterfaceAccordanceIfNoExists(guidInterf4pin, guidUniversalWire, 4); AddInterfaceAccordanceIfNoExists(guidInterf6pin, guidUniversalWire, 6); AddInterfaceAccordanceIfNoExists(guidInterf8pin, guidUniversalWire, 8); AddInterfaceAccordanceIfNoExists(guidInterf10pin, guidUniversalWire, 10); AddInterfaceAccordanceIfNoExists(guidInterf14pin, guidUniversalWire, 14); AddInterfaceAccordanceIfNoExists(guidInterf16pin, guidUniversalWire, 16); end; end; FreeAndNil(LookedCompTypeGuids); FreeAndNil(LookedInterfGuids); end; procedure TSCSCatalogExtended.SynchonizeSpravochikWithMarkMasks(ANBSpravochnik: TSpravochnik); var i: Integer; ptrCatalogMarkMask: PCatalogMarkMask; SelfComponentType: TNBComponentType; NBComponentType: TNBComponentType; begin for i := 0 to ANBSpravochnik.FNBComponentTypes.Count - 1 do begin AddStringToStringListOnce(FSpravochnik.FNewGUIDsComponentType, TNBComponentType(ANBSpravochnik.FNBComponentTypes[i]).ComponentType.GUID); end; FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(ANBSpravochnik); {for i := 0 to FMarkMasks.Count - 1 do begin ptrCatalogMarkMask := FMarkMasks[i]; SelfComponentType := FSpravochnik.GetNBComponentTypeByID(ptrCatalogMarkMask.IDComponentType); if SelfComponentType = nil then begin NBComponentType := ANBSpravochnik.GetNBComponentTypeByID(ptrCatalogMarkMask.IDComponentType); if NBComponentType <> nil then begin SelfComponentType := TNBComponentType.Create(FActiveForm); SelfComponentType.Assign(NBComponentType); FSpravochnik.AddComponentType(SelfComponentType); end; if SelfComponentType <> nil then SelfComponentType.ComponentType.MarkMask := ptrCatalogMarkMask.MarkMask; end; end;} end; function TSCSCatalogExtended.GetMarkMaskByComponType(AComponType: Integer): PCatalogMarkMask; var i: Integer; ptrCatalogMarkMask: PCatalogMarkMask; begin Result := nil; Result := GetMarkMaskTemplateByCompTypeFromList(FMarkMasks, AComponType); //for i := 0 to MarkMasks.Count - 1 do //begin // ptrCatalogMarkMask := MarkMasks[i]; // if ptrCatalogMarkMask.IDComponentType = AComponType then // begin // Result := ptrCatalogMarkMask; // Break; ///// BREAK ///// // end; //end; end; {TSCSList} // ############################## Класс TSCSList ############################### // ############################################################################# // procedure TSCSList.Clear; begin inherited; TMemoryStream(FCADStream).Clear; DeleteCADFile; Delete3DFile; TMemoryStream(FSettingStream).Clear; FOpenedInCAD := false; FCreatedObjCountOnClick := 0; if FObjIDsBeforeCopy <> nil then FObjIDsBeforeCopy.Clear; if FObjIDsAfterCopy <> nil then FObjIDsAfterCopy.Clear; end; constructor TSCSList.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FCADStream := TMemoryStream.Create; FSettingStream := TMemoryStream.Create; FListCADFile := GetCADFileName; FFile3D := GetCADFileName('3d'); FIsNormalType := true; FObjIDsBeforeCopy := nil; FObjIDsAfterCopy := nil; FNewComponNameMark := ''; FNewComponNameMarkSaved := ''; FNewComponNameMarkAsk := true; end; destructor TSCSList.Destroy; begin Clear; FreeAndNil(FCADStream); FreeAndNil(FSettingStream); FListCADFile := ''; FFile3D := ''; if FObjIDsBeforeCopy <> nil then FreeAndNil(FObjIDsBeforeCopy); if FObjIDsAfterCopy <> nil then FreeAndNil(FObjIDsAfterCopy); inherited; end; function TSCSList.GetCADFileName(const APrefix: String): String; var DirPath: String; begin Result := ''; DirPath := GetPathToSCSCADDir(true); if DirectoryExists(DirPath) then Result := DirPath +'\'+ GetUniqueFileName(APrefix, enTmp); end; function TSCSList.GetConnectedComponsInfoForLocalList: TConnectedComponsList; var FProject: TSCSProject; CurrConnectedComponsInfo: TConnectedComponsInfo; SideComponentID: Integer; ConnectedComponID: Integer; ConnectedObjectID: Integer; i: Integer; begin Result := TConnectedComponsList.Create; FProject := TSCSProject(GetTopParentCatalog); if FProject <> nil then for i := 0 to FProject.FConnectedComponsList.Count - 1 do begin CurrConnectedComponsInfo := FProject.FConnectedComponsList[i]; SideComponentID := -1; ConnectedComponID := -1; ConnectedObjectID := -1; if GetComponentFromReferences(CurrConnectedComponsInfo.IDSideCompon) <> nil then SideComponentID := CurrConnectedComponsInfo.IDSideCompon; if GetComponentFromReferences(CurrConnectedComponsInfo.IDConnectCompon) <> nil then ConnectedComponID := CurrConnectedComponsInfo.IDConnectCompon; if GetCatalogFromReferences(CurrConnectedComponsInfo.IDConnectObject) <> nil then ConnectedObjectID := CurrConnectedComponsInfo.IDConnectObject; if (SideComponentID <> -1) or (ConnectedComponID <> -1) or (ConnectedObjectID <> -1) then begin Result.InsertRecord(CurrConnectedComponsInfo.ComponWholeID, ConnectedObjectID, ConnectedComponID, SideComponentID, CurrConnectedComponsInfo.TypeConnect); end; end; end; function TSCSList.GetObjectsBlobsForLocalList: TObjectsBlobs; var FProject: TSCSProject; i, j: Integer; SrcObjectsBlob, NewObjectsBlob: TObjectsBlob; ObjectIDsInLocalList: TIntList; begin Result := TObjectsBlobs.Create(FActiveForm); FProject := TSCSProject(GetTopParentCatalog); if FProject <> nil then begin ObjectIDsInLocalList := TIntList.Create; for i := 0 to FProject.FObjectsBlobs.ObjectsBlobs.Count - 1 do begin SrcObjectsBlob := TObjectsBlob(FProject.FObjectsBlobs.ObjectsBlobs[i]); if SrcObjectsBlob.TableKind = tiComponent then begin ObjectIDsInLocalList.Clear; // Отбираем ID компонентов, которые есть на листе for j := 0 to SrcObjectsBlob.ObjIDs.Count - 1 do if GetComponentFromReferences(SrcObjectsBlob.ObjIDs[j]) <> nil then ObjectIDsInLocalList.Add(SrcObjectsBlob.ObjIDs[j]); if ObjectIDsInLocalList.Count > 0 then begin NewObjectsBlob := TObjectsBlob.Create(FActiveForm); NewObjectsBlob.Assign(SrcObjectsBlob); NewObjectsBlob.ObjIDs.Clear; NewObjectsBlob.ObjIDs.Assign(ObjectIDsInLocalList); end; end; end; FreeAndNil(ObjectIDsInLocalList); end; end; procedure TSCSList.LoadFromMemTable(AStringsMan: TStringsMan); var //SettingsStream: TStream; //09.10.2012 StreamSize: Integer; //IDCat: Integer; FMemTable: TSQLMemTable; begin inherited LoadFromMemTable(AStringsMan); FMemTable := TF_Main(FActiveForm).DM.tSQL_Katalog; FSettingStream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).SaveToStream(FSettingStream); //09.10.2012 FSettingStream.Position := 0; FMarkMasrksStream.Position := 0; TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).SaveToStream(FMarkMasrksStream); FMarkMasrksStream.Position := 0; //FCADStream.Position := 0; //TBlobField(FMemTable.FieldByName(fnCADBlock)).SaveToStream(FCADStream); //FCADStream.Position := 0; DeleteCADFile; Delete3DFile; TBlobField(FMemTable.FieldByName(fnCADBlock)).SaveToFile(FListCADFile); if FMemTable.FieldDefs.IndexOf(fnCAD3D) <> -1 then TBlobField(FMemTable.FieldByName(fnCAD3D)).SaveToFile(FFile3D); LoadSettingsFromStream; //09.10.2012 {//09.10.2012 - теперь этим занимается LoadSettingsFromStream; StreamSize := FSettingStream.Size; Setting := GetDefaultListSettings(false); if StreamSize <= sizeof(Setting) then begin FSettingStream.Position := 0; FSettingStream.ReadBuffer(Setting, StreamSize); end; if Setting.CADCaptionsKind = skExternalSCS then Setting.SCSType := st_External else Setting.SCSType := st_Internal; if Setting.CADNewTraceLengthType = Ord(tltNone) then begin if Setting.SCSType = st_Internal then Setting.CADNewTraceLengthType := Ord(tltAuto) else if Setting.SCSType = st_External then Setting.CADNewTraceLengthType := Ord(tltUser); end; OldSetting := Setting; } {<#MemTableClear#> inherited; SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).SaveToStream(SettingsStream); StreamSize := SettingsStream.Size; SettingsStream.Position := 0; Setting := GetDefaultListSettings; if StreamSize <= sizeof(Setting) then SettingsStream.ReadBuffer(Setting, StreamSize); OldSetting := Setting; FreeAndNil(SettingsStream); } end; procedure TSCSList.LoadSettingsFromStream; var StreamSize: Integer; begin StreamSize := FSettingStream.Size; Setting := GetDefaultListSettings(false); Setting.SCSType := st_NoChoose; if StreamSize <= sizeof(Setting) then begin FSettingStream.Position := 0; FSettingStream.ReadBuffer(Setting, StreamSize); FSettingStream.Position := 0; end; AfterLoadListSetting(Setting); //09.10.2012 OldSetting := Setting; end; procedure TSCSList.SaveSettingsToStream; begin if FSettingStream <> nil then begin FSettingStream.Position := 0; FSettingStream.WriteBuffer(Setting, sizeof(Setting)); FSettingStream.Position := 0; end; end; procedure TSCSList.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan; ACanSaveCAD: Boolean); var //StreamSize: Integer; FileSize: Integer; //CadFileName: String; TmpStream: TMemoryStream; ProjectOwner: TSCSCatalog; IsNoSavedCAD: Boolean; FMemTable: TSQLMemTable; //OldSettings: TListSettingRecord; //TempSettings: TListSettingRecord; begin IsNoSavedCAD := false; if ACanSaveCAD then begin FileSize := GetFileSizeByName(FListCADFile); //*** Сохранить в файл CAD Если Стрим пустой if FileSize = 0 then begin DeleteCADFile; //*** Сохранить КАД в файл try GTempFilesInfo.Add(FListCADFile); TmpStream := GetCADStreamByIDList(CurrID, FListCADFile); except on E: Exception do begin AddExceptionToLogEx('GetCADStreamByIDList', E.Message); IsNoSavedCAD := true; //*** Занести ID Листа в список не сохраненных нормально ProjectOwner := GetTopParentCatalog; if (ProjectOwner <> nil) and (ProjectOwner is TSCSProject) then if TSCSProject(ProjectOwner).FBadSavedListIDs.IndexOf(CurrID) = -1 then TSCSProject(ProjectOwner).FBadSavedListIDs.Add(CurrID); end; end; if TmpStream <> nil then try FreeAndNil(TmpStream); except end; end; end; //OldSettings := Setting; //LoadSettingsFromStream; //TempSettings := Setting; //Setting := OldSettings; if Not IsNoSavedCAD then begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Katalog; case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnID).AsInteger := ID; end; meEdit: begin //SetFilterToSQLMemTable(FMemTable, 'id = '''+IntToStr(ID)+''''); FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName(fnParentID).AsInteger := ParentID; FMemTable.FieldByName('NAME').AsInteger := AStringsMan.GenStrID(Name, AStringsMan.FCataogNameStrings); FMemTable.FieldByName('SORT_ID').AsInteger := SortID; FMemTable.FieldByName('KOL_COMPON').AsInteger := KolCompon; FMemTable.FieldByName('ITEMS_COUNT').AsInteger := ItemsCount; FMemTable.FieldByName(fnPropsCount).AsInteger := PropsCount; FMemTable.FieldByName(fnNormsCount).AsInteger := NormsCount; FMemTable.FieldByName(fnResourcesCount).AsInteger := ResourcesCount; //FMemTable.FieldByName('PROJECT_ID').AsInteger := ProjectID; FMemTable.FieldByName('LIST_ID').AsInteger := ListID; FMemTable.FieldByName('NAME_SHORT').AsInteger := AStringsMan.GenStrID(NameShort, AStringsMan.FCataogNameShortStrings); FMemTable.FieldByName('NAME_MARK').AsString := NameMark; FMemTable.FieldByName('ISUSER_NAME').AsInteger := IsUserName; FMemTable.FieldByName('MARK_ID').AsInteger := MarkID; FMemTable.FieldByName('ID_ITEM_TYPE').AsInteger := ItemType; FMemTable.FieldByName('SCS_ID').AsInteger := SCSID; FMemTable.FieldByName(fnIsIndexWithName).AsInteger := IsIndexWithName; FMemTable.FieldByName('INDEX_CONN').AsInteger := IndexPointObj; FMemTable.FieldByName('INDEX_LINE').AsInteger := IndexLine; FMemTable.FieldByName('INDEX_JOINER').AsInteger := IndexConnector; SaveSettingsToStream; FSettingStream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).LoadFromStream(FSettingStream); FSettingStream.Position := 0; FMarkMasrksStream.Position := 0; TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(FMarkMasrksStream); FMarkMasrksStream.Position := 0; if ACanSaveCAD then begin if FileExists(FListCADFile) then TBlobField(FMemTable.FieldByName(fnCADBlock)).LoadFromFile(FListCADFile); if FileExists(FFile3D) then TBlobField(FMemTable.FieldByName(fnCAD3D)).LoadFromFile(FFile3D); end; FMemTable.Post; end; end; { IsNoSavedCAD := false; StreamSize := FCADStream.Size; //*** Сохранить в файл CAD Если Стрим пустой if StreamSize = 0 then begin CadFileName := GetAnsiTempPath + GetUniqueFileName(fnListCADFile, enTmp); //fnListCADFileTmp; if FileExists(CadFileName) then DeleteFile(CadFileName); if FileExists(CadFileName) then DeleteFile(CadFileName); //*** Сохранить КАД в файл try TmpStream := GetCADStreamByIDList(CurrID, CadFileName); except on E: Exception do begin AddExceptionToLogEx('GetCADStreamByIDList', E.Message); IsNoSavedCAD := true; //*** Занести ID Листа в список не сохраненных нормально ProjectOwner := GetTopParentCatalog; if (ProjectOwner <> nil) and (ProjectOwner is TSCSProject) then if TSCSProject(ProjectOwner).FBadSavedListIDs.IndexOf(CurrID) = -1 then TSCSProject(ProjectOwner).FBadSavedListIDs.Add(CurrID); end; end; if TmpStream <> nil then try FreeAndNil(TmpStream); except end; end; if Not IsNoSavedCAD then begin case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnID).AsInteger := ID; end; meEdit: begin //SetFilterToSQLMemTable(FMemTable, 'id = '''+IntToStr(ID)+''''); FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName(fnParentID).AsInteger := ParentID; FMemTable.FieldByName('NAME').AsString := Name; FMemTable.FieldByName('SORT_ID').AsInteger := SortID; FMemTable.FieldByName('KOL_COMPON').AsInteger := KolCompon; FMemTable.FieldByName('ITEMS_COUNT').AsInteger := ItemsCount; //FMemTable.FieldByName('PROJECT_ID').AsInteger := ProjectID; FMemTable.FieldByName('LIST_ID').AsInteger := ListID; FMemTable.FieldByName('NAME_SHORT').AsString := NameShort; FMemTable.FieldByName('NAME_MARK').AsString := NameMark; FMemTable.FieldByName('ISUSER_NAME').AsInteger := IsUserName; FMemTable.FieldByName('MARK_ID').AsInteger := MarkID; FMemTable.FieldByName('ID_ITEM_TYPE').AsInteger := ItemType; FMemTable.FieldByName('SCS_ID').AsInteger := SCSID; FMemTable.FieldByName('INDEX_CONN').AsInteger := IndexPointObj; FMemTable.FieldByName('INDEX_LINE').AsInteger := IndexLine; FMemTable.FieldByName('INDEX_JOINER').AsInteger := IndexConnector; FSettingStream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).LoadFromStream(FSettingStream); FSettingStream.Position := 0; FMarkMasrksStream.Position := 0; TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(FMarkMasrksStream); FMarkMasrksStream.Position := 0; FCADStream.Position := 0; StreamSize := FCADStream.Size; if StreamSize > 0 then begin TBlobField(FMemTable.FieldByName(fnCADBlock)).LoadFromStream(FCADStream); FCADStream.Position := 0; end else begin if FileExists(CadFileName) then begin TBlobField(FMemTable.FieldByName(fnCADBlock)).LoadFromFile(CadFileName); DeleteFile(CadFileName); end; end; //if FileExists(FListCADFile) then // DeleteFile(FListCADFile); //TBlobField(FMemTable.FieldByName(fnCADBlock)).LoadFromFile(FListCADFile); FMemTable.Post; end; end;} end; function TSCSList.GetFParent: TBasicSCSClass{TSCSCatalog}; begin Result := nil; Result := FParent; //TSCSCatalog(FParent); end; procedure TSCSList.SetFParent(Value: TBasicSCSClass); var TopCatalog: TSCSCatalog; begin TopCatalog := GetTopParentCatalog; if Assigned(TopCatalog) then if TopCatalog.ItemType = itProject then TSCSProject(TopCatalog).ProjectLists.Remove(Self); inherited SetFParent(TBasicSCSClass(Value)); TopCatalog := GetTopParentCatalog; if Assigned(TopCatalog) then if TopCatalog.ItemType = itProject then if TSCSProject(TopCatalog).ProjectLists.IndexOf(Self) = -1 then TSCSProject(TopCatalog).ProjectLists.Add(Self); end; procedure TSCSList.Assign(ASCSList: TSCSList; aAllObjects: Boolean=true); var CADStream: TMemoryStream; begin AssignSettings(ASCSList.Setting); if aAllObjects then //18.06.2013 begin TSCSCatalog(Self).Assign(ASCSList); TSCSCatalog(Self).AssignChildCatalogs(ASCSList.ChildCatalogs); //AssignMarkMasks(ASCSList.MarkMasks, false); FSpravochnik.Assign(ASCSList.Spravochnik); FConnectedComponsList.Assign(ASCSList.FConnectedComponsList); AssignCADCrossObjects(ASCSList.FCADCrossObjects); AssignCADNorms(ASCSList.FCADNorms); FObjectsBlobs.Assign(ASCSList.FObjectsBlobs); end else begin AssignOnlyCatalog(ASCSList); //*** Загрузка свойств AssignProperties(ASCSList.FProperties); end; //CADStream := ASCSList.GetCADStream; //try // SetCADStream(CADStream); //finally // FreeAndNil(CADStream); //end; DeleteCADFile; Delete3DFile; CopyFileToByName(ASCSList.FListCADFile, FListCADFile); //CopyFileToByName(ASCSList.FFile3D, FFile3D); FBuildID := ASCSList.FBuildID; //05.10.2010 end; procedure TSCSList.AssignSettings(ASetting: TListSettingRecord); begin Setting := ASetting; end; function TSCSList.ComplexLoadFromDir(ADirName: string; ASetComponsJoining: Boolean=true): TOpenCatalogFromFileResult; var ListData: TCatalog; SavedProjectOwner: TSCSProject; SavedMemBaseMode: TMemBaseMode; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin Result := ocrFoulItemType; OldTick := GetTickCount; try //*** Загрузить данные литса if LoadBufferFromFile(ListData, SizeOf(ListData), ADirName+'\'+fnObjData) then begin if ListData.ItemType = itList then begin SavedProjectOwner := FProjectOwner; Clear; FProjectOwner := SavedProjectOwner; FBuildID := ListData.BuildID; FNBBuildID := ListData.NBBuildID; //FOpenedInCAD := ListData.OpenedInCAD; ID := ListData.ID; ParentID := ListData.Parent_ID; ListID := ListData.List_ID; Name := ListData.Name; NameShort := ListData.NameShort; NameMark := ListData.NameMark; IsUserName := ListData.IsUserName; KolCompon := ListData.Kol_Compon; ItemType := ListData.ItemType; ItemsCount := ListData.ItemsCount; MarkID := ListData.MarkID; SCSID := ListData.Scs_ID; SortID := ListData.Sort_ID; IsIndexWithName := ListData.IsIndexWithName; IndexPointObj := ListData.IndexPointObj; IndexConnector := ListData.IndexConnector; IndexLine := ListData.IndexLine; //*** Загрузить свойства листа LoadBufferFromFile(Setting, SizeOf(Setting), ADirName+'\'+fnObjSettings); //*** Загрузить объекты листа FMemBase.FDirName := ADirName; SavedMemBaseMode := FMemBase.FMemBaseMode; FMemBase.FMemBaseMode := mbmFiles; FMemBase.FFileAccesFailCount := 0; try FMemBase.CloseAllTables; FMemBase.DeleteAllTables; //FMemBase.LoadAllTablesFromDir(ADirName); //FMemBase.LoadAllTablesFromFile(ADirName+'\'+fnObjContent); FMemBase.OpenAllTables; //*** Определить справочник свойств для разгкрзки наименований свойств if FProjectOwner <> nil then FSpravochnik.AssignProperties(FProjectOwner.FSpravochnik.FNBProperties); SendFromMemTablesToClasses(ASetComponsJoining, true); finally FMemBase.FMemBaseMode := SavedMemBaseMode; end; FSpravochnik.ClearNoListData; FOpenedInCAD := CheckListExist(SCSID); Result := ocrSuccessful; end; end else Result := orcFailAccess; if Result = orcFailAccess then AddExceptionToLog(cSCSComponent_Msg22_9, true); except on E: Exception do AddExceptionToLogEx('TSCSList.ComplexLoadFromDir', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; function TSCSList.ComplexSaveToDir(const ADirName: string; AAllowMsg: Boolean=true): Boolean; var ConnectedComponsList: TConnectedComponsList; ListData: TCatalog; SavedMemBaseMode: TMemBaseMode; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // ProcName: String; begin Result := false; OldTick := GetTickCount; ProcName := Self.ClassName + '.ComplexSaveToDir'; try if ADirName <> '' then if FActive then begin if DirectoryExists(ADirName) then FullRemoveDir(ADirName, true, true); if Not DirectoryExists(ADirName) then begin CreateDir(ADirName); if DirectoryExists(ADirName) then begin //ConnectedComponsList := //GetConnectedComponsInfoForLocalList; try HotSave(false); //*** подготовка к сохранению в MemTabl-ы //FSpravochnik.AssignProperties(); //*** Засыпать из классов в MemTabl-ы FMemBase.FDirName := ADirName; SavedMemBaseMode := FMemBase.FMemBaseMode; FMemBase.FMemBaseMode := mbmFiles; FMemBase.FFileAccesFailCount := 0; try SendFromClassesToMemTables(FProjectOwner.FConnectedComponsList, FProjectOwner.FObjectsBlobs, true); finally FMemBase.FMemBaseMode := SavedMemBaseMode; end; { //24.09.2008 FMemBase.SaveAllTablesToDir(ADirName); //FMemBase.SaveAllTablesToFile(ADirName+'\'+fnObjContent); try FMemBase.DeleteAllTables; except end;} //*** Сохранить данные литса ListData := GetAsTCatalog; ListData.BuildID := CurrentProjBuildID; ListData.NBBuildID := CurrentNBBuildID; ListData.OpenedInCAD := FOpenedInCAD; try SaveBufferToFile(ListData, SizeOf(ListData), ADirName+'\'+fnObjData); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; //*** Сохранить свойства листа try SaveBufferToFile(Setting, SizeOf(Setting), ADirName+'\'+fnObjSettings); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; Result := FMemBase.FFileAccesFailCount = 0; finally //FreeAndNil(ConnectedComponsList); end; end; end; if Not Result and AAllowMsg then AddExceptionToLog(cSCSComponent_Msg22_6, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_6); end; except on E: Exception do AddExceptionToLogEx('TSCSList.ComplexSaveToDir', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; function TSCSList.CreateCCEForCCTemplates(ACableChannels: TSCSComponents; AConnOwner: TSCSCatalog; AConnectorType: Integer): TSCSComponent; var IsAllTemplates: Boolean; i: integer; SCSComponent, CableChannel, CCElement: TSCSComponent; CCEGuid, CCEName, ConduitSideDimensions: string; ExistsCCElement: TSCSComponent; SprComponType, NBComponType: TNBComponentType; NBSpravochnik: TSpravochnik; NBProperty: TNBProperty; PropSysNamesConduitElmtSideDimensions: TStringList; begin Result := nil; try IsAllTemplates := false; for i := 0 to ACableChannels.Count - 1 do begin CableChannel := ACableChannels[i]; if CableChannel.IsTemplate = biTrue then IsAllTemplates := true else begin IsAllTemplates := false; Break; //// BREAK //// end; end; if IsAllTemplates then begin NBSpravochnik := TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik; SprComponType := FSpravochnik.GetComponentTypeObjBySysName(ctsnCableChannelElement); if SprComponType = nil then begin NBComponType := NBSpravochnik.GetComponentTypeObjBySysName(ctsnCableChannelElement); if NBComponType <> nil then SprComponType := FSpravochnik.GetComponentTypeWithAssign(NBComponType.ComponentType.GUID, NBSpravochnik); end; if SprComponType <> nil then begin CCEGuid := GetCCEGuid(AConnectorType); CCEName := GetCableChannelElementName(AConnectorType); if (CCEGuid <> '') and (CCEName <> '') then begin CCElement := TSCSComponent.Create(FActiveForm); CCElement.GuidNB := CCEGuid; CCElement.Name := CCEName; CCElement.GUIDComponentType := SprComponType.ComponentType.GUID; CCElement.ComponentType := SprComponType.ComponentType; CCElement.IsLine := SprComponType.ComponentType.IsLine; CCElement.GUIDNetType := ACableChannels[0].GUIDNetType; CCElement.Price := 1; CCElement.IsTemplate := biTrue; // Ищем такойже компонент на проекте с последним ID ExistsCCElement := nil; for i := FProjectOwner.FComponentReferences.Count - 1 downto 0 do begin SCSComponent := TSCSComponent(FProjectOwner.FComponentReferences.List.List^[i]); if SCSComponent.IsTemplate = CCElement.IsTemplate then if SCSComponent.GUIDNB = CCElement.GUIDNB then if (ExistsCCElement = nil) or (ExistsCCElement.ID < SCSComponent.ID) then ExistsCCElement := SCSComponent; end; if ExistsCCElement <> nil then CCElement.Price := ExistsCCElement.Price; CCElement.Price_Calc := CCElement.Price; // Добавляем свойства // Тип обозначения AddPropertyToComponFromSprBySysName(CCElement, NBSpravochnik, pnSignType, IntToStr(oitDefault)); // Тип ЭКК AddPropertyToComponFromSprBySysName(CCElement, NBSpravochnik, pnCableCanalElemetType, IntToStr(AConnectorType)); // Размеры сторон элемента канала PropSysNamesConduitElmtSideDimensions := TStringList.Create; if ACableChannels.Count = 1 then PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSideDimensions) // Размеры стороны элемента канала else begin PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide1Dimensions); // Размеры стороны 1 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide2Dimensions); // Размеры стороны 2 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide3Dimensions); // Размеры стороны 3 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide4Dimensions); // Размеры стороны 4 элемента канала end; for i := 0 to ACableChannels.Count - 1 do begin ConduitSideDimensions := ACableChannels[i].GetPropertyValueBySysName(pnConduitSideDimensions); AddPropertyToComponFromSprBySysName(CCElement, NBSpravochnik, PropSysNamesConduitElmtSideDimensions[i], ConduitSideDimensions); if (PropSysNamesConduitElmtSideDimensions.Count - 1) = i then Break; //// BREAK //// end; FreeAndNil(PropSysNamesConduitElmtSideDimensions); // Цвет AddPropertyToComponFromSprBySysName(CCElement, NBSpravochnik, pnColor, IntToStr(clWhite)); // Сохраняем в проект if AConnOwner.FTreeViewNode = nil then TF_Main(FActiveForm).FindComponOrDirInTree(AConnOwner.ID, false); TF_Main(FActiveForm).DefineChildNodes(AConnOwner.FTreeViewNode); TF_Main(FActiveForm).SaveComponent(CCElement, nil, AConnOwner.FTreeViewNode, FActiveForm, FActiveForm, nil, AConnOwner, true, true, ckCompon); TF_Main(FActiveForm).AfterSaveComponent(0, CCElement, AConnOwner, FActiveForm, FActiveForm, ckCompon, mrNone, nil, false); SetComponAsLite(CCElement, true); Result := CCElement; end; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'CreateCCEForCCTemplates', E.Message); end; end; procedure TSCSList.DefineCADNorms(ACanHaveActiveNorms, AShowNormContentsResources: Boolean); const Prec = PrecisionNormKolvo; var ProjectOwner: TSCSProject; NormResources: TSCSNormsResources; SCSNorm: TSCSNorm; NormPreyscurant: TSCSNormPreyscurant; i, j, k, l, RecNpp, ColumnIndex: Integer; TotalCountInRow: Double; CADNormStructHeader, CADNormStruct, CADResourceStruct: TCADNormStruct; CADNormColumnHeader, CADNormColumn, CADPrevNormColumn, CADResourceColumn: TCADNormColumn; ptrNormCableColumn: PNormCableColumn; NormCableColumns, ResourceColumnIndexes: TList; CurrNormResourcesStructList: TObjectList; ptrResourceColumnIndex, ptrResourceColumnIndexi, ptrResourceColumnIndexj: PNormResourceColumnIndex; ptrJoinedComponents: PJoinedComponents; LookedPointComponResourcesIDs, LookedWholeIDs: TIntList; function FindNormCableColumnByPreyscurant(ANormPreyscurant: TSCSNormPreyscurant): PNormCableColumn; var i: Integer; ptrNormCableColumn: PNormCableColumn; begin Result := nil; for i := 0 to NormCableColumns.Count - 1 do begin ptrNormCableColumn := NormCableColumns[i]; if (ptrNormCableColumn.GUID = ANormPreyscurant.SCSComponentGUID) and (ptrNormCableColumn.PairKolvo = ANormPreyscurant.PairKolvo) then begin Result := ptrNormCableColumn; Break; //// BREAK //// end; end; end; function GetIndexNormCableColumnByPreyscurant(ANormPreyscurant: TSCSNormPreyscurant): Integer; var i: Integer; ptrNormCableColumn: PNormCableColumn; begin Result := -1; for i := 0 to NormCableColumns.Count - 1 do begin ptrNormCableColumn := NormCableColumns[i]; if (ptrNormCableColumn.GUID = ANormPreyscurant.SCSComponentGUID) and (ptrNormCableColumn.PairKolvo = ANormPreyscurant.PairKolvo) then begin Result := i; Break; //// BREAK //// end; end; end; procedure SortNormCableColumns; var i, j: Integer; ptrNormCableColumnI: PNormCableColumn; ptrNormCableColumnJ: PNormCableColumn; ptrTpmNormCableColumn: PNormCableColumn; begin for i := 0 to NormCableColumns.Count - 1 do begin ptrNormCableColumnI := NormCableColumns[i]; for j := i to NormCableColumns.Count - 1 do begin ptrNormCableColumnJ := NormCableColumns[j]; if ptrNormCableColumnJ.Name < ptrNormCableColumnI.Name then begin ptrTpmNormCableColumn := ptrNormCableColumnJ; ptrNormCableColumnJ := ptrNormCableColumnI; ptrNormCableColumnI := ptrNormCableColumnJ; end; end; end; end; function FindResourceColumnIndexInfo(AComponent: TSCSComponent; AColumnIndex: Integer): PNormResourceColumnIndex; var ptrResourceColumnIndex: PNormResourceColumnIndex; i: Integer; begin Result := nil; for i := 0 to ResourceColumnIndexes.Count - 1 do begin ptrResourceColumnIndex := ResourceColumnIndexes[i]; if (TSCSComponent(ptrResourceColumnIndex.ResourceComponent).GuidNB = AComponent.GuidNB) or (TSCSComponent(ptrResourceColumnIndex.ResourceComponent).NameShort = AComponent.NameShort) { and ((AColumnIndex = -1) or (ptrResourceColumnIndex.ColumnIndex = AColumnIndex))} then begin Result := ptrResourceColumnIndex; Break; //// BREAK //// end; end; end; function GetNewResourceColumnIndex(AColumnCount: Integer): PNormResourceColumnIndex; var i: Integer; begin GetZeroMem(Result, SizeOf(TNormResourceColumnIndex)); Result.Kolvos := TIntList.Create; Result.ComponIDs := TIntList.Create; for i := 0 to AColumnCount - 1 do Result.Kolvos.Add(0); end; function GetNewNormStruct(AColumnCount: Integer): TCADNormStruct; var CADNormColumn: TCADNormColumn; i: Integer; begin Result := TCADNormStruct.Create; Result.ID := ProjectOwner.GenIDByGeneratorIndex(giCADNormStructID); Result.IDCatalog := ID; Result.CatalogItemType := ItemType; CADNormColumn := TCADNormColumn.Create; CADNormColumn.ID := ProjectOwner.GenIDByGeneratorIndex(giCADNormColumnID); CADNormColumn.IDCADNormStruct := Result.ID; Result.FNormColumns.Add(CADNormColumn); //*** насыпать пустые значения в колонки for i := 0 to AColumnCount - 1 do CADNormColumn.FColumns.Add(''); end; function AddConnComponToResorceColumn(AConnComponent, AJoinedLine: TSCSComponent; AColumnIndex: Integer): Boolean; var ptrResourceColumnIndex: PNormResourceColumnIndex; ComponSignType: Integer; begin Result := false; //ComponSignType := AComponent.GetPropertyValueAsInteger(pnSignType); //*** Учитывать десйтвующие/проектуруемые //if (ComponSignType = oitProjectible) or ACanHaveActiveNorms then //*** проверка на подключение линейной компоненты к входящим интерфейсам точточечного // тип компоненты МУФТА if AConnComponent.ComponentType.GUID = guidCTMufta then if Not CheckHaveComponentInternalInterfConnection(AConnComponent) or CheckJoinedComponToIncomingInterface(AJoinedLine, AConnComponent) then begin ptrResourceColumnIndex := FindResourceColumnIndexInfo(AConnComponent, AColumnIndex); if ptrResourceColumnIndex = nil then begin ptrResourceColumnIndex := GetNewResourceColumnIndex(NormCableColumns.Count); ResourceColumnIndexes.Add(ptrResourceColumnIndex); ptrResourceColumnIndex.ResourceComponent := AConnComponent; ptrResourceColumnIndex.ColumnIndex := AColumnIndex; ptrResourceColumnIndex.Kolvo := 1; end; if ptrResourceColumnIndex <> nil then //# #!!!Не Удалять# if LookedPointComponResourcesIDs.IndexOf(AConnComponent.ID) = -1 then begin ptrResourceColumnIndex.Kolvos[ColumnIndex] := ptrResourceColumnIndex.Kolvos[ColumnIndex] + 1; LookedPointComponResourcesIDs.Add(AConnComponent.ID); Result := true; end; {if ptrResourceColumnIndex.ComponIDS.IndexOf(AComponent.ID) = -1 then begin ptrResourceColumnIndex.Kolvos[ColumnIndex] := ptrResourceColumnIndex.Kolvos[ColumnIndex] + 1; ptrResourceColumnIndex.ComponIDs.Add(AComponent.ID); Result := true; end;} end; end; //*** Обэединяет две позиции ресурса/нормы в одну procedure UnionOfCADNormStructs(ADestCADNormStruct, ASrcCADNormStruct: TCADNormStruct); var i: Integer; DestCADNormColumn, SrcCADNormColumn: TCADNormColumn; ResCount: Double; begin ResCount := StrAsEmptyToFloat(ADestCADNormStruct.FCount) + StrAsEmptyToFloat(ASrcCADNormStruct.FCount); if ResCount > 0 then ADestCADNormStruct.FCount := FloatToStrFix(ResCount, Prec); //FloatToStr(RoundX(ResCount, Prec)); DestCADNormColumn := TCADNormColumn(ADestCADNormStruct.NormColumns[0]); SrcCADNormColumn := TCADNormColumn(ASrcCADNormStruct.NormColumns[0]); if DestCADNormColumn.FColumns.Count = SrcCADNormColumn.FColumns.Count then for i := 0 to DestCADNormColumn.FColumns.Count - 1 do begin ResCount := StrAsEmptyToFloat(DestCADNormColumn.FColumns[i]) + StrAsEmptyToFloat(SrcCADNormColumn.FColumns[i]); if ResCount > 0 then DestCADNormColumn.FColumns[i] := FloatToStrFix(ResCount, Prec); //FloatToStr(RoundX(ResCount, Prec)); end; end; //*** Группирует нормы/ресурсы procedure GroupCADNormStructs(ACADNormStructList: TObjectList); var i, j: Integer; CADNormStructI, CADNormStructj: TCADNormStruct; begin for i := 0 to ACADNormStructList.Count - 1 do begin CADNormStructI := TCADNormStruct(ACADNormStructList[i]); if CADNormStructI <> nil then for j := i+1 to ACADNormStructList.Count - 1 do begin CADNormStructJ := TCADNormStruct(ACADNormStructList[j]); if CADNormStructJ <> nil then if (CADNormStructI.FName = CADNormStructJ.FName) then begin //*** объеденить две в одну UnionOfCADNormStructs(CADNormStructI, CADNormStructJ); FreeAndNil(CADNormStructJ); ACADNormStructList[j] := nil; end; end; end; ACADNormStructList.Pack; end; procedure FreeNormResourceColumnIndexes(ANormResourceColumnIndexes: TList); var i: Integer; ptrResourceColumnIndex: PNormResourceColumnIndex; begin for i := 0 to ANormResourceColumnIndexes.Count - 1 do begin ptrResourceColumnIndex := ANormResourceColumnIndexes[i]; FreeAndNil(ptrResourceColumnIndex.Kolvos); FreeAndNil(ptrResourceColumnIndex.ComponIDs); end; FreeAndNil(ANormResourceColumnIndexes); end; begin try FCADNorms.Clear; RecNpp := 0; NormResources := GetAllNormsResources([nrAll], false, ACanHaveActiveNorms, true, false); ProjectOwner := TSCSProject(GetTopParentCatalog); if NormResources.Norms.Count > 0 then begin CADNormStructHeader := TCADNormStruct.Create; FCADNorms.Add(CADNormStructHeader); CADNormStructHeader.ID := ProjectOwner.GenIDByGeneratorIndex(giCADNormStructID); CADNormStructHeader.IDCatalog := ID; CADNormStructHeader.CatalogItemType := ItemType; CADNormStructHeader.FNumber := cSCSComponent_Msg6_1; CADNormStructHeader.FName := cSCSComponent_Msg6_2; CADNormStructHeader.FIzm := cSCSComponent_Msg6_3; CADNormStructHeader.FCount := cSCSComponent_Msg6_4; NormCableColumns := TList.Create; ResourceColumnIndexes := TList.Create; LookedPointComponResourcesIDs := TIntList.Create; LookedWholeIDs := TIntList.Create; //*** ресурсы текущей расматриваемой нормы CurrNormResourcesStructList := TObjectList.Create(false); //*** Проход #1 - построить шапку for i := 0 to NormResources.Norms.Count - 1 do begin SCSNorm := NormResources.Norms[i]; for j := 0 to SCSNorm.Preyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(SCSNorm.Preyscurants[j]); if (NormPreyscurant.SCSComponent <> nil) and (NormPreyscurant.SCSComponent.IsLine = biTrue) then begin ptrNormCableColumn := FindNormCableColumnByPreyscurant(NormPreyscurant); if ptrNormCableColumn = nil then begin GetZeroMem(ptrNormCableColumn, SizeOf(TNormCableColumn)); NormCableColumns.Add(ptrNormCableColumn); ptrNormCableColumn.Name := NormPreyscurant.SCSComponent.NameShort; ptrNormCableColumn.GUID := NormPreyscurant.SCSComponentGUID; ptrNormCableColumn.PairKolvo := NormPreyscurant.PairKolvo; end; end; end; end; SortNormCableColumns; //*** Вкинуть Столбци в CADNormStructHeader // примечание: для заголовка количество CADNormStructHeader.FNormColumns.Count зависит от кол-ва видов лин. компонент // для норм и ресурсов это количество всегда будет 1-цей CADPrevNormColumn := nil; for i := 0 to NormCableColumns.Count - 1 do begin ptrNormCableColumn := NormCableColumns[i]; CADNormColumn := nil; if (CADPrevNormColumn <> nil) and (CADPrevNormColumn.FCableName = ptrNormCableColumn.Name) then CADNormColumn := CADPrevNormColumn else begin CADNormColumn := TCADNormColumn.Create; CADNormColumn.ID := ProjectOwner.GenIDByGeneratorIndex(giCADNormColumnID); CADNormColumn.IDCADNormStruct := CADNormStructHeader.ID; CADNormStructHeader.FNormColumns.Add(CADNormColumn); end; CADNormColumn.FCableName := ptrNormCableColumn.Name; CADNormColumn.FColumns.Add(''); if ptrNormCableColumn.PairKolvo > 0 then CADNormColumn.FColumns[CADNormColumn.FColumns.Count - 1] := IntToStr(ptrNormCableColumn.PairKolvo); CADPrevNormColumn := CADNormColumn; end; //*** Проход #2 - Собрать инфу о подключенных точечных компонент-ресурсов for i := 0 to NormResources.Norms.Count - 1 do begin SCSNorm := NormResources.Norms[i]; for j := 0 to SCSNorm.Preyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(SCSNorm.Preyscurants[j]); //*** Если норма применяется для прокладки линейн. компонент if NormPreyscurant.SCSComponent.IsLine = biTrue then begin ColumnIndex := GetIndexNormCableColumnByPreyscurant(NormPreyscurant); if (ColumnIndex <> -1) and (LookedWholeIDs.IndexOf(NormPreyscurant.SCSComponent.Whole_ID) = -1) then begin NormPreyscurant.SCSComponent.LoadNet; for k := 0 to NormPreyscurant.SCSComponent.Net.Count - 1 do begin ptrJoinedComponents := NormPreyscurant.SCSComponent.Net[k]; for l := 0 to ptrJoinedComponents.FirstConnCompons.Count - 1 do begin AddConnComponToResorceColumn(ptrJoinedComponents.FirstConnCompons[l], ptrJoinedComponents.First, ColumnIndex); end; for l := 0 to ptrJoinedComponents.LastConnCompons.Count - 1 do begin AddConnComponToResorceColumn(ptrJoinedComponents.LastConnCompons[l], ptrJoinedComponents.Last, ColumnIndex); end; for l := 0 to ptrJoinedComponents.JoinedLines.Count - 1 do LookedWholeIDs.Add(ptrJoinedComponents.JoinedLines[l].Whole_ID); end; //for l := 0 to ptrJoinedComponents.JoinedLines.Count - 1 do // LookedWholeIDs.Add(ptrJoinedComponents.JoinedLines[l].Whole_ID); end; end; end; end; //*** Проход #3 - Закинуть в таблицу данные for i := 0 to NormResources.Norms.Count - 1 do begin SCSNorm := NormResources.Norms[i]; CADNormStruct := GetNewNormStruct(NormCableColumns.Count); FCADNorms.Add(CADNormStruct); Inc(RecNpp); CADNormStruct.FNumber := IntToStr(RecNpp); CADNormStruct.FName := SCSNorm.Name; CADNormStruct.FIzm := SCSNorm.Izm_; CADNormColumn := TCADNormColumn(CADNormStruct.FNormColumns[0]); CurrNormResourcesStructList.Clear; for j := 0 to SCSNorm.Preyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(SCSNorm.Preyscurants[j]); ColumnIndex := -1; //*** Если норма применяется для прокладки линейн. компонент, то закинуть длины if NormPreyscurant.InterfaceType = itConstructive then begin if NormPreyscurant.SCSComponent.IsLine = biTrue then begin ColumnIndex := GetIndexNormCableColumnByPreyscurant(NormPreyscurant); if ColumnIndex <> -1 then begin //*** Если новая колонка, то подсчет сумарного количества для графы if CADNormColumn.FColumns[ColumnIndex] = '' then begin if CADNormStruct.FCount = '' then CADNormStruct.FCount := FloatToStrFix(NormPreyscurant.Kolvo, Prec) //}FloatToStr(RoundX(NormPreyscurant.Kolvo, Prec)) else CADNormStruct.FCount := FloatToStrFix(StrToFloat_My(CADNormStruct.FCount) + RoundX(NormPreyscurant.Kolvo, Prec), Prec); //FloatToStr(RoundX(StrToFloat_My(CADNormStruct.FCount) + RoundX(NormPreyscurant.Kolvo, Prec), Prec)); end; //*** внести количество в колонку определенного кабеля CADNormColumn.FColumns[ColumnIndex] := FloatToStrFix(NormPreyscurant.Kolvo, Prec); //FloatToStr(RoundX(NormPreyscurant.Kolvo, Prec)); end; end else begin //*** Закинуть ресурсы этой монтажной нормы CADResourceStruct := GetNewNormStruct(NormCableColumns.Count); CurrNormResourcesStructList.Add(CADResourceStruct); //FCADNorms.Add(CADResourceStruct); CADResourceStruct.FName := NormPreyscurant.SCSComponent.NameShort; CADResourceStruct.FIzm := NormPreyscurant.SCSComponent.Izm; //Chanred by Tolik CADResourceStruct.FCount := FloatToStrFix(NormPreyscurant.Kolvo, Prec); //FloatToStr(NormPreyscurant.Kolvo); // CADResourceColumn := TCADNormColumn(CADResourceStruct.FNormColumns[0]); ptrResourceColumnIndex := FindResourceColumnIndexInfo(NormPreyscurant.SCSComponent, ColumnIndex); if ptrResourceColumnIndex <> nil then begin //ptrResourceColumn.FColumns[ptrResourceColumnIndex.ColumnIndex] := IntToStr(ptrResourceColumnIndex.Kolvo); //for k := 0 to ptrResourceColumnIndex.Kolvos.Count - 1 do // if ptrResourceColumnIndex.Kolvos[k] > 0 then // ptrResourceColumn.FColumns[k] := IntToStr(ptrResourceColumnIndex.Kolvos[k]); for k := 0 to ptrResourceColumnIndex.Kolvos.Count - 1 do if ptrResourceColumnIndex.Kolvos[k] > 0 then CADResourceColumn.FColumns[k] := IntToStr(ptrResourceColumnIndex.Kolvos[k]); //*** Убрать подключения с оборудования ResourceColumnIndexes.Remove(ptrResourceColumnIndex); FreeMem(ptrResourceColumnIndex); ptrResourceColumnIndex := nil; end else //Changed by Tolik // CADResourceStruct.FCount := FloatToStr(NormPreyscurant.Kolvo); CADResourceStruct.FCount := FloatToStrFix(NormPreyscurant.Kolvo,prec); end; end; end; //*** сгруппировать ресурсы по обозначению GroupCADNormStructs(CurrNormResourcesStructList); //*** Если прейскуранты моэно отображать в отдельных позициях, то перекинуть их if (AShowNormContentsResources) and (CurrNormResourcesStructList.Count > 1) then AssignListItems(CurrNormResourcesStructList, FCADNorms) else begin //*** Добавить наименования прейскурантов через запятую в позицию нормы for k := 0 to CurrNormResourcesStructList.Count - 1 do begin CADResourceStruct := TCADNormStruct(CurrNormResourcesStructList[k]); if k = 0 then CADNormStruct.FName := CADNormStruct.FName + ': ' else if k > 0 then CADNormStruct.FName := CADNormStruct.FName + ', '; CADNormStruct.FName := CADNormStruct.FName + CADResourceStruct.Name; if k = (CurrNormResourcesStructList.Count - 1) then CADNormStruct.FName := CADNormStruct.FName + '.'; UnionOfCADNormStructs(CADNormStruct, CADResourceStruct); FreeAndNil(CADResourceStruct); CurrNormResourcesStructList[k] := nil; end; end; CurrNormResourcesStructList.Clear; end; //*** Сгруппировать оставшиеся ресурсы по типу компоненты for i := 0 to ResourceColumnIndexes.Count - 1 do begin ptrResourceColumnIndexI := ResourceColumnIndexes[i]; if ptrResourceColumnIndexI <> nil then for j := i+1 to ResourceColumnIndexes.Count - 1 do begin ptrResourceColumnIndexJ := ResourceColumnIndexes[j]; if ptrResourceColumnIndexJ <> nil then if TSCSComponent(ptrResourceColumnIndexI.ResourceComponent).GUIDComponentType = TSCSComponent(ptrResourceColumnIndexJ.ResourceComponent).GUIDComponentType then begin for k := 0 to NormCableColumns.Count - 1 do begin ptrResourceColumnIndexI.Kolvos[k] := ptrResourceColumnIndexI.Kolvos[k] + ptrResourceColumnIndexJ.Kolvos[k]; end; FreeMem(ptrResourceColumnIndexJ); ResourceColumnIndexes[j] := nil; end; end; end; ResourceColumnIndexes.Pack; //*** Закинуть оставшиеся ресурсы по позициям for i := 0 to ResourceColumnIndexes.Count - 1 do begin ptrResourceColumnIndex := ResourceColumnIndexes[i]; CADResourceStruct := GetNewNormStruct(NormCableColumns.Count); FCADNorms.Add(CADResourceStruct); Inc(RecNpp); CADResourceStruct.FNumber := IntToStr(RecNpp); CADResourceStruct.FName := TSCSComponent(ptrResourceColumnIndex.ResourceComponent).NameShort; //NormPreyscurant.SCSComponent.NameShort; CADResourceStruct.FIzm := TSCSComponent(ptrResourceColumnIndex.ResourceComponent).Izm; TotalCountInRow := 0; CADResourceColumn := TCADNormColumn(CADResourceStruct.FNormColumns[0]); //ptrResourceColumn.FColumns[ptrResourceColumnIndex.ColumnIndex] := IntToStr(ptrResourceColumnIndex.Kolvo); for j := 0 to ptrResourceColumnIndex.Kolvos.Count - 1 do if ptrResourceColumnIndex.Kolvos[j] > 0 then begin CADResourceColumn.FColumns[j] := IntToStr(ptrResourceColumnIndex.Kolvos[j]); TotalCountInRow := TotalCountInRow + ptrResourceColumnIndex.Kolvos[j]; end; //*** общее количество в графе CADResourceStruct.FCount := FloatToStrFix(TotalCountInRow, Prec); //FloatToStr(RoundX(TotalCountInRow, Prec)); end; //*** Очистить ненужное нах... FreeAndNil(CurrNormResourcesStructList); FreeAndNil(LookedWholeIDs); FreeAndNil(lookedPointComponResourcesIDs); FreeNormResourceColumnIndexes(ResourceColumnIndexes); FreeList(NormCableColumns); FreeAndNil(NormResources); // FREE ResourceColumnIndexes // FREE NormCableColumns // FREE NormResources end; except on E: Exception do AddExceptionToLogEx('TSCSList.DefineCADNorms', E.Message); end; end; procedure TSCSList.DefinePricesByProjectCurrencies(AProject: TSCSProject); var ProjCurrencyM, ListCurrencyM, ListCurrencyMFromProject: TNBCurrency; begin ProjCurrencyM := AProject.FSpravochnik.GetCurrencyByType(ctMain); ListCurrencyM := Self.FSpravochnik.GetCurrencyByType(ctMain); if (ProjCurrencyM <> nil) and (ListCurrencyM <> nil) then if ProjCurrencyM.Data.GUID <> ListCurrencyM.Data.GUID then begin ListCurrencyMFromProject := AProject.FSpravochnik.GetCurrencyByGUID(ListCurrencyM.Data.GUID); if ListCurrencyMFromProject <> nil then Self.RefreshPricesAfterChangeCurrency(ListCurrencyMFromProject.Data, ProjCurrencyM.Data, false); end; end; procedure TSCSList.DeleteCADFile; begin DeleteFile(FListCADFile); if FileExists(FListCADFile) then FListCADFile := GetCADFileName; end; procedure TSCSList.Delete3DFile; begin DeleteFile(FFile3D); if FileExists(FFile3D) then FFile3D := GetCADFileName('3d'); end; function TSCSList.GetCADStream: TMemoryStream; var FileStream: TFileStream; begin Result := TMemoryStream.Create; if FileExists(FListCADFile) then begin FileStream := TFileStream.Create(FListCADFile, fmOpenRead); FileStream.Position := 0; Result.CopyFrom(FileStream, 0); Result.Position := 0; FileStream.Free; end; //Result := TMemoryStream.Create; //CopyStream(Result, FCADStream); end; function TSCSList.GetParams: TListParams; begin // Tolik 20/12/2019 -- ZeroMemory(@Result, SizeOf(TListParams)); // Result.ID := Self.CurrID; Result.Name := Self.Name; Result.MarkID := Self.MarkID; //if Self.MarkID > 0 then // Result.Caption := Result.Name + ' ' + IntTostr(Result.MarkID) //else // Result.Caption := Result.Name; Result.Caption := GetNameForVisible; // Tolik -- 07/06/2021 -- индекс листа только для нормальных листов Result.IsIndexWithName := biFalse; if Self is TSCSList then if TSCSList(Self).Setting.ListType = lt_Normal then // Result.IsIndexWithName := IsIndexWithName; Result.IndexConnector := IndexConnector; Result.IndexLine := Indexline; Result.IndexPointObj := IndexPointObj; Result.Settings := Self.Setting; end; function TSCSList.HotSave(ASaveCAD: Boolean): Boolean; begin Result := true; Save; if ASaveCAD then if Not SaveCAD then Result := false; end; // ##### Загрузка настроек Листа ##### procedure TSCSList.Load; {var SettingsStream: TStream; StreamSize: Integer; IDCat: Integer;} begin try if FCurrID < 1 then Exit; //// EXIT ///// //StreamSize := 0; try Screen.Cursor := crHourGlass; LoadSettingsFromStream; {//09.10.2012 перенесено в LoadSettingsFromStream if Setting.CADCaptionsKind = skExternalSCS then Setting.SCSType := st_External else Setting.SCSType := st_Internal;} {<#MemTableClear#> if SetFilterToSQLMemTable(FMemTable, '(scs_id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itList)+''')') then begin LoadFromMemTable; LoadProperties; end; } { IDCat := FMemTable.FieldByName(fnID).AsInteger; if IDCat <> 0 then begin SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; TBlobField(FMemTable.FieldByName(fnSettings)).SaveToStream(SettingsStream); StreamSize := SettingsStream.Size; SettingsStream.Position := 0; if StreamSize = sizeof(Setting) then SettingsStream.ReadBuffer(Setting, sizeof(Setting)); OldSetting := Setting; FreeAndNil(SettingsStream); LoadCatalogByID(IDCat, false, false); LoadChildCatalogs(true, FLoadComponData); LoadMarkMasks; end; } { SetSQLToQuery(FQuery_Select, ' select id, settings from katalog '+ ' where (scs_id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itList)+''') '); IDCat := FQuery_Select.GetFNAsInteger('ID'); if IDCat <> 0 then begin SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; FQuery_Select.FNSaveToStream('Settings', SettingsStream); FQuery_Select.Close; SettingsStream.Position := 0; if SettingsStream.Size = sizeof(Setting) then SettingsStream.ReadBuffer(Setting, sizeof(Setting)); OldSetting := Setting; SettingsStream.Free; LoadCatalogByID(IDCat, false, false); LoadMarkMasks; end; } finally Screen.Cursor := crDefault; end; except on E: Exception do AddExceptionToLog('TSCSList.LoadSettings: '+E.Message); end; end; function TSCSList.LoadFromStreamOrFile(AProject: TSCSProject; AStream: TStream; AFileName: String): TOpenCatalogFromFileResult; var MTKatalog: TSQLMemTable; StreamSize: Integer; //PMStream: TStream; PMFile: String; SavedID: Integer; SavedActive: Boolean; SavedTreeViewNode: TTreeNode; OpenID: Integer; OpenName: String; i: Integer; OpenedIsIndexWithName: Integer; UStream: TStream; SprComponent: TSCSComponent; TmpFileName: String; // Tolik 28/08/2019 - - //Old: Cardinal; //Curr: Cardinal; Old, Curr: DWord; // begin Result := ocrSuccessful; try if Assigned(AStream) or (AFileName <> '') then begin Old := GetTickCount; SavedID := FCurrID; SavedActive := FActive; SavedTreeViewNode := FTreeViewNode; FBuildID := 0; FNBBuildID := 0; if FActive then Close; Clear; try MTKatalog := FMemBase.GetMTKatalog; try OpenName := ''; if Assigned(AStream) then begin UStream := TMemoryStream.Create; try UnPakStream(AStream, UStream); UStream.Position := 0; try MTKatalog.LoadTableFromStream(UStream); except Result := ocrBadFormat; end; finally UStream.Free; end; end else begin if AFileName <> '' then begin //TmpFileName := ExtractFileDir(Application.ExeName) + '\'+dnTemp+'\'+ ExtractFileName(AFileName); //29.04.2011 TmpFileName := GetPathToSCSTmpDir + '\' + ExtractFileName(AFileName); TmpFileName := GetPathToSCSTmpDir + '\' + GetUniqueFileName('', ''); if FileExists(TmpFileName) then if Not DeleteFile(TmpFileName) then TmpFileName := GetNoExistsFileNameForCopy(TmpFileName); if CopyFileTo(AFileName, TmpFileName) then begin UnPakFile(TmpFileName); try if CheckOneStrInFilePos(TmpFileName, GSQLMTSignatures, 0) then MTKatalog.LoadTableFromFile(TmpFileName) else Result := ocrBadFormat; except Result := ocrBadFormat; end; OpenName := ExtractFileNameOnly(TmpFileName); DeleteFile(TmpFileName); end; end; end; if Result = ocrSuccessful then MTKatalog.Open; if MTKatalog.Active then begin ItemType := MTKatalog.FieldByName(fnIDItemType).AsInteger; if ItemType <> itList then Result := ocrFoulItemType else if MTKatalog.FieldByName(fnBuildID).AsInteger > CurrentProjBuildID then Result := orcIsOldRelease; end; if Result = ocrSuccessful then begin ID := MTKatalog.FieldByName(fnID).AsInteger; ParentID := MTKatalog.FieldByName(fnParentID).AsInteger; ListID := MTKatalog.FieldByName(fnListID).AsInteger; Name := MTKatalog.FieldByName(fnName).AsString; NameShort := MTKatalog.FieldByName(fnNameShort).AsString; NameMark := MTKatalog.FieldByName(fnNameMark).AsString; IsUserName := MTKatalog.FieldByName(fnIsUserName).AsInteger; SortID := MTKatalog.FieldByName(fnSortID).AsInteger; KolCompon := MTKatalog.FieldByName(fnKolCompon).AsInteger; ItemsCount := MTKatalog.FieldByName(fnItemsCount).AsInteger; MarkID := MTKatalog.FieldByName(fnMarkID).AsInteger; IsIndexWithName := MTKatalog.FieldByName(fnIsIndexWithName).AsInteger; SCSID := MTKatalog.FieldByName(fnSCSID).AsInteger; IndexPointObj := MTKatalog.FieldByName(fnIndexConn).AsInteger; IndexConnector := MTKatalog.FieldByName(fnIndexJoiner).AsInteger; IndexLine := MTKatalog.FieldByName(fnIndexLine).AsInteger; FBuildID := MTKatalog.FieldByName(fnBuildID).AsInteger; if MTKatalog.FieldDefs.IndexOf(fnNBBuildID) <> -1 then FNBBuildID := MTKatalog.FieldByName(fnNBBuildID).AsInteger; //LoadBufferToMemTableBlobField(MTKatalog, fnSettings, Setting, SizeOf(Setting)); //TBlobField(MTKatalog.FieldByName(fnPMBlock)).LoadFromFile(GetPathToProjectTmp); //FCADStream.Position := 0; //TBlobField(MTKatalog.FieldByName(fnCADBlock)).SaveToStream(FCADStream); //FCADStream.Position := 0; //StreamSize := FCADStream.Size; DeleteCADFile; Delete3DFile; TBlobField(MTKatalog.FieldByName(fnCADBlock)).SaveToFile(FListCADFile); if MTKatalog.FieldDefs.IndexOf(fnCAD3D) <> -1 then TBlobField(MTKatalog.FieldByName(fnCAD3D)).SaveToFile(FFile3D); FSettingStream.Position := 0; TBlobField(MTKatalog.FieldByName(fnSettings)).SaveToStream(FSettingStream); FSettingStream.Position := 0; LoadSettingsFromStream; //PMStream := TMemoryStream.Create; //try // TBlobField(MTKatalog.FieldByName(fnPMBlock)).SaveToStream(PMStream); // // MTKatalog.Close; // MTKatalog.DeleteTable(true); // FreeAndNil(MTKatalog); // // FMemBase.CloseAllTables; // FMemBase.DeleteAllTables; // FMemBase.LoadAllTablesFromStream(PMStream); // FMemBase.OpenAllTables; // // SendFromMemTablesToClasses; //finally // PMStream.Free; //end; PMFile := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + '\' + fnPMBlockTmp); try TBlobField(MTKatalog.FieldByName(fnPMBlock)).SaveToFile(PMFile); MTKatalog.Close; MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); FMemBase.CloseAllTables; FMemBase.DeleteAllTables; FMemBase.LoadAllTablesFromFile(PMFile); FMemBase.OpenAllTables; SendFromMemTablesToClasses; FMemBase.CloseAllTables; FMemBase.DeleteAllTables; finally if FileExists(PMFile) then DeleteFile(PMFile); end; //*** Определить цены по валюте проекта if AProject <> nil then begin //*** Переопределить цены в новой валюте проекта DefinePricesByProjectCurrencies(AProject); //*** Перекинуть новые справочные данные в проект AProject.FSpravochnik.DefineNewGUIDsFromOtherSprav(FSpravochnik); AProject.FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(FSpravochnik); //*** Выкинуть валюты с листа FSpravochnik.ClearNoListData; //FSpravochnik.ClearCurrencies; //*** перекинуть отсутствующие справочные компоненты i := 0; while i <= FSpravComponents.Count - 1 do begin SprComponent := FSpravComponents[i]; if AProject.GetSprComponentByGUID(SprComponent.GuidNB) = nil then begin //*** Сохранить компонент с новыми ID TF_Main(FActiveForm).SaveComponent(SprComponent, nil, nil, FActiveForm, FActiveForm, nil, AProject, false, false, ckCompon); AProject.AddComponToSprComponents(SprComponent); FSpravComponents.Delete(i); end else Inc(i); end; FSpravComponents.Clear; end; end; { OpenID := MTKatalog.FieldByName(fnID).AsInteger; SQLBuilder(FQuery_Operat, qtUpdate, tnCatalog, 'id = '''+IntToStr(SavedID)+'''', FieldNames, false); //FQuery_Select.SetParamAsInteger(fnID, MTKatalog.FieldByName(fnID).AsInteger); FQuery_Operat.SetParamAsInteger(fnParentID, MTKatalog.FieldByName(fnParentID).AsInteger); //FQuery_Operat.SetParamAsInteger(fnProjectID, SavedID); FQuery_Operat.SetParamAsInteger(fnListID, MTKatalog.FieldByName(fnListID).AsInteger); if OpenName <> '' then FQuery_Operat.SetParamAsString(fnName, OpenName) else FQuery_Operat.SetParamAsString(fnName, MTKatalog.FieldByName(fnName).AsString); FQuery_Operat.SetParamAsString(fnNameShort, MTKatalog.FieldByName(fnNameShort).AsString); FQuery_Operat.SetParamAsString(fnNameMark, MTKatalog.FieldByName(fnNameMark).AsString); FQuery_Operat.SetParamAsInteger(fnIsUserName, MTKatalog.FieldByName(fnIsUserName).AsInteger); //FQuery_Operat.SetParamAsInteger(fnSortID, MTKatalog.FieldByName(fnSortID).AsInteger); FQuery_Operat.SetParamAsInteger(fnKolCompon, MTKatalog.FieldByName(fnKolCompon).AsInteger); FQuery_Operat.SetParamAsInteger(fnItemsCount, MTKatalog.FieldByName(fnItemsCount).AsInteger); FQuery_Operat.SetParamAsInteger(fnIDItemType, MTKatalog.FieldByName(fnIDItemType).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexConn, MTKatalog.FieldByName(fnIndexConn).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexJoiner, MTKatalog.FieldByName(fnIndexJoiner).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexLine, MTKatalog.FieldByName(fnIndexLine).AsInteger); //*** добавленные поля в структуру позже. if MTKatalog.FieldDefs.IndexOf(fnBuildID) <> -1 then FBuildID := MTKatalog.FieldByName(fnBuildID).AsInteger; FQuery_Operat.SetParamAsInteger(fnBuildID, FBuildID); OpenedIsIndexWithName := biTrue; if MTKatalog.FieldDefs.IndexOf(fnIsIndexWithName) <> -1 then OpenedIsIndexWithName := MTKatalog.FieldByName(fnIsIndexWithName).AsInteger; FQuery_Operat.SetParamAsInteger(fnIsIndexWithName, OpenedIsIndexWithName); if MTKatalog.FieldDefs.IndexOf(fnDefListSettings) <> -1 then StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnDefListSettings, fnDefListSettings); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnSettings, fnSettings); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnCompTypeMarkMasks, fnCompTypeMarkMasks); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnCADBlock, fnCADBlock); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnPMBlock, fnPMBlock); if MTKatalog.FieldDefs.IndexOf(fnGenerators) <> - 1 then StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnGenerators, fnGenerators); if AAsNew then FQuery_Operat.SetParamAsInteger(fnIDFromOpened, OpenID); MTKatalog.Close; MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); FQuery_Operat.ExecQuery; FTreeViewNode := SavedTreeViewNode;} finally if Assigned(MTKatalog) then begin if MTKatalog.Active then MTKatalog.Close; if MTKatalog.Exists then MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); end; end; finally if (SavedActive) and (Result = ocrSuccessful) then Open(SavedID); end; Curr := GetTickCount - old; Curr := GetTickCount - old; end; except on E: Exception do AddExceptionToLog('TSCSList.LoadFromStreamOrFile: '+E.Message); end; end; // ##### Сохранение настроек листа ##### procedure TSCSList.Save; //var SettingsStream: TStream; begin // Tolik 19/12/2019-- if GProjectClose then exit; // try if FCurrID < 1 then Exit; //// EXIT ///// inherited; SaveMarkMasks; if CmpRecords(Integer(@OldSetting), Integer(@Setting), SizeOf(OldSetting), SizeOf(Setting)) then Exit; //// EXIT //// SaveSettingsToStream; {<#MemTableClear#> with TF_Main(ActiveForm).DM do begin if SetFilterToSQLMemTable(tSQL_Katalog, '(scs_id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itList)+''')') then if Not tSQL_Katalog.Eof then begin SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(Setting, sizeof(Setting)); SettingsStream.Position := 0; tSQL_Katalog.Edit; TBlobField(tSQL_Katalog.FieldByName(fnSettings)).LoadFromStream(SettingsStream); tSQL_Katalog.Post; FreeAndNil(SettingsStream); end; end;} { ChangeSQLQuery(FQuery_Operat, ' update katalog set '+ ' settings = :settings '+ ' where (scs_id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itList)+''') '); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(Setting, sizeof(Setting)); SettingsStream.Position := 0; FQuery_Operat.ParamLoadFromStream('settings', SettingsStream); FQuery_Operat.ExecQuery; FQuery_Operat.Close; //SettingsStream.Free;} OldSetting := Setting; except on E: Exception do AddExceptionToLog('TSCSList.SaveSettings: '+E.Message); end; end; procedure TSCSList.SaveAsNew; begin inherited; FOpenedInCAD := true; end; function TSCSList.SaveCAD: Boolean; var CADData: TMemoryStream; StreamSize, PrevExceptCount: Integer; Projectowner: TSCSCatalog; IsBadList: Boolean; begin Result := false; if FCurrID > 0 then begin IsBadList := false; try PrevExceptCount := GExceptionCount; //DeleteCADFile; GTempFilesInfo.Add(FListCADFile); CADData := GetCADStreamByIDList(FCurrID, FListCADFile); //2012-04-18 if PrevExceptCount <> GExceptionCount then IsBadList := true; except on E: Exception do IsBadList := true; end; if CADData <> nil then try FreeAndNil(CADData); except end; if IsBadList then begin Projectowner := GetTopParentCatalog; if (Projectowner <> nil) and (Projectowner is TSCSProject) then TSCSProject(Projectowner).FBadSavedListIDs.Add(CurrID); end; end; if FileExists(FListCADFile) and (GetFileSizeByName(FListCADFile) > 0) then Result := true; {Result := false; CADData := nil; if FCurrID > 0 then begin try CADData := GetCADStreamByIDList(FCurrID); except end; end; StreamSize := 0; if Assigned(CADData) then begin if Assigned(FCADStream) then FreeAndNil(FCADStream); FCADStream := CADData; StreamSize := FCADStream.Size; //SetCADStream(CADData); // <#MemTableClear#> // Result := SetCadDataToPM(FCurrID, CADData); //FreeAndNil(CADData); Result := True; end; if StreamSize = 0 then begin Projectowner := GetTopParentCatalog; if (Projectowner <> nil) and (Projectowner is TSCSProject) then TSCSProject(Projectowner).FBadSavedListIDs.Add(CurrID); end;} end; procedure TSCSList.SetCADStream(ACADStream: TMemoryStream); var FileStream: TFileStream; begin //CopyStream(FCADStream, ACADStream); DeleteCADFile; FileStream := TFileStream.Create(FListCADFile, fmCreate); ACADStream.Position := 0; FileStream.CopyFrom(ACADStream, 0); FileStream.Free; end; function TSCSList.SaveToStreamOrFile(AStream: TStream; AFileName: String): Boolean; var ProjectOwner: TSCSCatalog; i: Integer; List: TSCSList; MTKatalog: TSQLMemTable; UStream: TStream; StreamSize: Integer; TablesWasSavedToFile: Boolean; ConnectedComponsList: TConnectedComponsList; ObjectsBlobsToSave: TObjectsBlobs; PackedStream: TFileStream; UnPackedStream: TFileStream; UnPackedTmpFile: String; begin Result := false; ProjectOwner := GetTopParentCatalog; try if (FActive) and (Assigned(AStream)) or (AFileName <> '') then begin GTempFilesInfo.Active := true; try HotSave(true); ConnectedComponsList := GetConnectedComponsInfoForLocalList; ObjectsBlobsToSave := GetObjectsBlobsForLocalList; try if ProjectOwner is TSCSProject then begin //*** Закинуть валюты проекта в лист FSpravochnik.AssignNoListData(TSCSProject(ProjectOwner).FSpravochnik); //FSpravochnik.AssignCurrencies(TSCSProject(ProjectOwner).FSpravochnik.FNBCurrencies); //*** Закинуть элементы каб каналов AssignSprComponents(TSCSProject(ProjectOwner).FSpravComponents); end; //*** Засыпать из классов в MemTabl-ы SendFromClassesToMemTables(ConnectedComponsList, ObjectsBlobsToSave, false); finally FSpravochnik.ClearNoListData; //FSpravochnik.ClearCurrencies; FreeAndNil(ConnectedComponsList); FreeAndNil(ObjectsBlobsToSave); FSpravComponents.Clear; end; TablesWasSavedToFile := FMemBase.SaveAllTablesToFile(GetPathToProjectTmp); try FMemBase.DeleteAllTables; except end; if TablesWasSavedToFile then begin MTKatalog := FMemBase.GetMTKatalog; try MTKatalog.Open; MTKatalog.Append; MTKatalog.FieldByName(fnID).AsInteger := ID; MTKatalog.FieldByName(fnParentID).AsInteger := 0; MTKatalog.FieldByName(fnListID).AsInteger := ListID; MTKatalog.FieldByName(fnName).AsString := Name; MTKatalog.FieldByName(fnNameShort).AsString := NameShort; MTKatalog.FieldByName(fnNameMark).AsString := NameMark; MTKatalog.FieldByName(fnIsUserName).AsInteger := IsUserName; MTKatalog.FieldByName(fnSortID).AsInteger := SortID; MTKatalog.FieldByName(fnKolCompon).AsInteger := KolCompon; MTKatalog.FieldByName(fnItemsCount).AsInteger := ItemsCount; MTKatalog.FieldByName(fnIDItemType).AsInteger := ItemType; MTKatalog.FieldByName(fnMarkID).AsInteger := MarkID; MTKatalog.FieldByName(fnIsIndexWithName).AsInteger := IsIndexWithName; MTKatalog.FieldByName(fnSCSID).AsInteger := SCSID; MTKatalog.FieldByName(fnIndexConn).AsInteger := IndexPointObj; MTKatalog.FieldByName(fnIndexJoiner).AsInteger := IndexConnector; MTKatalog.FieldByName(fnIndexLine).AsInteger := IndexLine; //*** Новые поля try MTKatalog.FieldByName(fnBuildID).AsInteger := CurrentProjBuildID; except end; MTKatalog.FieldByName(fnNBBuildID).AsInteger := CurrentNBBuildID; LoadBufferToMemTableBlobField(MTKatalog, fnSettings, Setting, SizeOf(Setting)); TBlobField(MTKatalog.FieldByName(fnPMBlock)).LoadFromFile(GetPathToProjectTmp); //FCADStream.Position := 0; //StreamSize := FCADStream.Size; //TBlobField(MTKatalog.FieldByName(fnCADBlock)).LoadFromStream(FCADStream); if FileExists(FListCADFile) then TBlobField(MTKatalog.FieldByName(fnCADBlock)).LoadFromFile(FListCADFile); if FileExists(FFile3D) then TBlobField(MTKatalog.FieldByName(fnCAD3D)).LoadFromFile(FFile3D); //LoadBufferToMemTableBlobField(MTKatalog, fnSettings, Setting, SizeOf(Setting)); //LoadBufferToMemTableBlobField(MTKatalog, fnDefListSettings, DefListSettings, SizeOf(DefListSettings)); //LoadBufferToMemTableBlobField(MTKatalog, fnGenerators, FGenerators, SizeOf(FGenerators)); //FMarkMasrksStream.Position := 0; //TBlobField(MTKatalog.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(FMarkMasrksStream); //TBlobField(MTKatalog.FieldByName(fnPMBlock)).LoadFromFile(GetPathToProjectTmp); MTKatalog.Post; MTKatalog.Close; if Assigned(AStream) then begin UStream := TMemoryStream.Create; try MTKatalog.SaveTableToStream(UStream); PakStream(UStream, AStream); AStream.Position := 0; Result := true; finally UStream.Free; end; end else begin if AFileName <> '' then begin if GTempFilesInfo.CheckIntegrity(cSCSComponent_Msg22_14) then begin //MTKatalog.SaveTableToFile(AFileName); //PakFile(AFileName, clBetter); DeleteFile(GetPathToUnPackedTmp(false)); UnPackedTmpFile := GetPathToUnPackedTmp(true); MTKatalog.SaveTableToFile(UnPackedTmpFile); GTempFilesInfo.Clear; GTempFilesInfo.Add(UnPackedTmpFile); if GTempFilesInfo.CheckIntegrity(cSCSComponent_Msg22_14) then begin UnPackedStream := TFileStream.Create(UnPackedTmpFile, fmOpenRead); PackedStream := TFileStream.Create(AFileName, fmCreate); try UnPackedStream.Position := 0; //PakStream(UnPackedStream, PackedStream, clWorse); PakStream(UnPackedStream, PackedStream); PackedStream.Position := 0; Result := true; finally FreeAndNil(UnPackedStream); FreeAndNil(PackedStream); DeleteFile(UnPackedTmpFile); end; end; end; end; end; finally DeleteFile(GetPathToProjectTmp); MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); end; end; finally GTempFilesInfo.Active := false; end; end; except on E: Exception do AddExceptionToLog('TSCSList.SaveToFileOrStream: '+E.Message); end; end; { TCatalogGroupConnection } function TCatalogGroupConnection.CheckEqualNet(ANetElement: PJoinedComponents): Boolean; var i, j: Integer; LineComponent, SelfLineComponExemplar: TSCSComponent; //LineComponentObject: TSCSCatalog; //SelfLineObject: TSCSCatalog; ExistsExemplar: Boolean; function CheckGroupPoinCatalog(AGroupCatalog: TSCSCatalog; APoinComponents: TSCSComponents): Boolean; var i, j: Integer; PointCopmponent, JoinedComponent: TSCSComponent; ExitsJoinedNetType: Boolean; begin Result := true; if (AGroupCatalog.FComponentReferences.Count > 0) and (APoinComponents.Count = 0) then Result := false else for i := 0 to APoinComponents.Count - 1 do begin PointCopmponent := APoinComponents[i]; if AGroupCatalog.FComponentReferences.IndexOf(PointCopmponent) = -1 then begin Result := false; Break; //// BREAK //// end else //*** Учитывать подключение по типу сети if AGroupCatalog.FGUIDJoinedNetType <> '' then begin ExitsJoinedNetType := false; for j := 0 to PointCopmponent.JoinedComponents.Count - 1 do if PointCopmponent.JoinedComponents[j].GUIDNetType = AGroupCatalog.FGUIDJoinedNetType then begin ExitsJoinedNetType := true; Break; //// BREAK //// end; if Not ExitsJoinedNetType then begin Result := false; Break; //// BREAK //// end; end; end; end; begin Result := true; {//15.12.2011 if Not CheckGroupPoinCatalog(FBeginCatalogGroup, ANetElement.FirstConnCompons) or Not CheckGroupPoinCatalog(FEndCatalogGroup, ANetElement.LastConnCompons) then Result := false //Not CheckGroupPoinCatalog(FBeginCatalogGroup, ANetElement.LastConnCompons) or //Not CheckGroupPoinCatalog(FEndCatalogGroup, ANetElement.FirstConnCompons)) then} if (CheckGroupPoinCatalog(FBeginCatalogGroup, ANetElement.FirstConnCompons) and CheckGroupPoinCatalog(FEndCatalogGroup, ANetElement.LastConnCompons)) or (CheckGroupPoinCatalog(FBeginCatalogGroup, ANetElement.LastConnCompons) and CheckGroupPoinCatalog(FEndCatalogGroup, ANetElement.FirstConnCompons)) then Result := true else Result := false; if Result then begin //if (Lines.Count <> ANetElement.JoinedLines.Count) or (Lines.Count = 0) then if ANetElement.JoinedLines.Count = 0 then Result := false else begin for i := 0 to ANetElement.JoinedLines.Count - 1 do begin LineComponent := ANetElement.JoinedLines[i]; //*** Есть ли в списке екземпляров компонент с аналогичным типом компонен ExistsExemplar := false; for j := 0 to FComponExemplars.Count - 1 do begin SelfLineComponExemplar := FComponExemplars[j]; if SelfLineComponExemplar.ComponentType.GUID = LineComponent.ComponentType.GUID then begin ExistsExemplar := true; Break; //// BREAK //// end; end; if Not ExistsExemplar then begin Result := false; Break; //// BREAK //// end; end; end; {for i := 0 to ANetElement.JoinedLines.Count - 1 do begin SelfLineObject := Lines[i]; LineComponent := ANetElement.JoinedLines[i]; LineComponentObject := LineComponent.GetFirstParentCatalog; if SelfLineObject.ID <> LineComponentObject.ID then begin Result := false; Break; //// BREAK //// end; end;} end; end; procedure TCatalogGroupConnection.Clear; begin FComponExemplars.Clear; FLines.Clear; FBeginCatalogGroup := nil; FEndCatalogGroup := nil; end; constructor TCatalogGroupConnection.Create(AProjectOwner: TSCSProject); begin inherited create; FProjectOwner := AProjectOwner; FComponExemplars := TSCSComponents.Create(false); FLines := TSCSCatalogs.Create(true); FLinesNote := TStringList.Create; Clear; end; procedure TCatalogGroupConnection.DefineLinesNote; var i: integer; SCSComponent: TSCSComponent; ComponTypeGUIDs: TStringList; ComponTypeNames: TStringList; ComponTypeCounts: TIntList; ComponIndex: Integer; PrefixCount: String; NoteStr: String; begin ComponTypeGUIDs := TStringList.Create; ComponTypeNames := TStringList.Create; ComponTypeCounts := TIntList.Create; for i := 0 to FComponExemplars.Count - 1 do begin SCSComponent := FComponExemplars[i]; ComponIndex := ComponTypeGUIDs.IndexOf(SCSComponent.ComponentType.GUID); if ComponIndex = -1 then begin ComponIndex := ComponTypeGUIDs.Add(SCSComponent.ComponentType.GUID); if SCSComponent.NameShort <> '' then ComponTypeNames.Add(SCSComponent.NameShort) else ComponTypeNames.Add(SCSComponent.ComponentType.NamePlural); ComponTypeCounts.Add(0); end; if ComponIndex <> -1 then ComponTypeCounts[ComponIndex] := ComponTypeCounts[ComponIndex] + 1; end; PrefixCount := 'x'; if FProjectOwner.DefListSettings.NoteCountPrefix <> '' then PrefixCount := FProjectOwner.DefListSettings.NoteCountPrefix; FLinesNote.Clear; for i := 0 to ComponTypeGUIDs.Count - 1 do begin NoteStr := ComponTypeNames[i]; if ComponTypeCounts[i] > 1 then case FProjectOwner.DefListSettings.PrefixCountType of pctBefore: NoteStr := IntToStr(ComponTypeCounts[i])+PrefixCount +' '+ NoteStr; pctAfter: NoteStr := NoteStr +' '+ PrefixCount + IntToStr(ComponTypeCounts[i]); end; FLinesNote.Add(NoteStr); end; FreeAndNil(ComponTypeGUIDs); FreeAndNil(ComponTypeNames); FreeAndNil(ComponTypeCounts); end; destructor TCatalogGroupConnection.Destroy; begin Clear; FreeAndNil(FComponExemplars); FreeAndNil(FLines); FreeAndNil(FLinesNote); inherited; end; {TSCSProject} // ############################# Класс TSCSProject ############################# // ############################################################################# // constructor TSCSProject.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); QueryMode := qmPhisical; FCanAutoSave := false; FCanJoinComponsInfo := TJoinComponsInfoList.Create; //FConnectedComponsList := TConnectedComponsList.Create; FNoSaveListsToFiles := TIDStringList.Create; FNotJoinComponsInfo := TJoinComponsInfoList.Create; FProjectLists := TSCSLists.Create(false); FUsedInterfaces := TIntList.Create; //11.03.2009 TSCSInterfaces.Create(false); FCanGenMarkID := true; //15.01.2011 FBadSavedListIDs := TIntList.Create; FIDsNearFloorFigures := TIntList.Create; FIDsOppositeNearFloorFigures := TIntList.Create; FIDsSrcObjects := TIntList.Create; FIDsNewObjects := TIntList.Create; CurrList := nil; FReadOnly := false; FFilterBlock := TFilterBlock.Create(nil, btBlock); //FLoaded := false; FOnAfterNew := AfterNew; FOnAfterOpen := AfterOpen; FOnAfterClose := AfterClose; FOnBeforeNew := BeforeNew; FOnBeforeOpen := BeforeOpen; FOnBeforeClose := BeforeClose; FMemTablesInfo := TMemTableInfoList.Create; FMemTablesInfo.AddToMemTablesInfo(FMTNormsComplete, tnNormsComplete, tiNormsComplete, [fnGuid, fnCypher, fnName, fnIzm], [FStringsMan.FNormGuidNBStrings, FStringsMan.FNormCypherStrings, FStringsMan.FNormNameStrings, FStringsMan.FIzmStrings] ); Clear; //Setting.Revision := 1; end; destructor TSCSProject.Destroy; begin if FActive then Close; Clear; //ClearProject; FCanJoinComponsInfo.Free; //FConnectedComponsList.Free; FNoSaveListsToFiles.Free; FNotJoinComponsInfo.Free; FreeAndNil(FProjectLists); FreeAndNil(FUsedInterfaces); FreeAndNil(FBadSavedListIDs); FreeAndNil(FIDsNearFloorFigures); FreeAndNil(FIDsOppositeNearFloorFigures); FreeAndNil(FIDsSrcObjects); FreeAndNil(FIDsNewObjects); FreeAndNil(FMemTablesInfo); //FreeList(ProjectLists); inherited ; end; procedure TSCSProject.AddChildCatalogToList(ASCSCatalog: TSCSCatalog); begin FChildCatalogs.Add(ASCSCatalog); if ASCSCatalog is TSCSCatalog then ASCSCatalog.Parent := Self else if ASCSCatalog is TSCSList then TSCSList(ASCSCatalog).Parent := Self; end; procedure TSCSProject.AddList(ASCSList: TSCSList); begin FChildCatalogs.Add(ASCSList); ASCSlist.Parent := Self; end; function TSCSProject.AddListFromFile(const AFileName: String; AOldIdxToName: Boolean=true; ATargetObject: TSCSCatalog = nil): TSCSList; var TmpNewList: TSCSList; OpenCatalogResult: TOpenCatalogFromFileResult; ListName: String; begin Result := nil; if FileExists(AFileName) then begin TmpNewList := TSCSList.Create(FActiveForm); OpenCatalogResult := TmpNewList.LoadFromStreamOrFile(Self, nil, AFileName); if OpenCatalogResult = ocrSuccessful then begin ListName := ''; if AOldIdxToName then ListName := TmpNewList.GetNameForVisible else ListName := TmpNewList.Name; Result := CopyList(TmpNewList, ListName, ATargetObject); if Result <> nil then begin Result.FUpdatedSprObjIcons.Assign(TmpNewList.FUpdatedSprObjIcons); Result.UpdateCADObjIconsFromUpdatedSpav; Result.CorrectAfterFullOpen; //05.10.2010 end; end else begin PauseProgress(true); if OpenCatalogResult = ocrFoulItemType then MessageModal(cFileOf +' '+AFileName+' '+cSCSComponent_Msg18, ApplicationName, MB_ICONINFORMATION or MB_OK) else if OpenCatalogResult = ocrBadFormat then MessageModal(cFileOf+' '+AFileName+' '+cMain_Msg40_3+'.', ApplicationName, MB_ICONINFORMATION or MB_OK) else if OpenCatalogResult = orcIsOldRelease then MessageModal(cFileOf+' '+AFileName+' '+cMain_Msg40_4+'.', ApplicationName, MB_ICONINFORMATION or MB_OK); PauseProgress(false); end; FreeAndNil(TmpNewList); end; end; procedure TSCSProject.AssignSettings(ASetting: TProjectSettingRecord); begin Setting := ASetting; end; function TSCSProject.CheckSCSObjectsInSameIndexingArea(AObject1, AObject2: TSCSCatalog): Boolean; var AreaObj1: TSCSCatalog; AreaObj2: TSCSCatalog; begin Result := false; try if AObject1 = AObject2 then Result := true else if (Setting.PointComonIndexingMode = cimInProject) and (AObject1.FProjectOwner = AObject2.FProjectOwner) then Result := true else if Setting.PointComonIndexingMode <> cimInProject then begin if (Setting.PointComonIndexingMode = cimInList) and (AObject1.GetListOwner = AObject2.GetListOwner) then Result := true else if (Setting.PointComonIndexingMode = cimInRoom) and (AObject1.FParent = AObject2.FParent) then begin AreaObj1 := GetCatalogAreaObject(AObject1); AreaObj2 := GetCatalogAreaObject(AObject2); if AreaObj1 = AreaObj2 then Result := true; end; end; except on E: Exception do AddExceptionToLogEx('TSCSProject.CheckSCSObjectsInSameIndexingArea', E.Message); end; end; function TSCSProject.CheckProjectInUse(AIDProject: Integer; var AUserName: String; var AUserDateTime: TDateTime): Boolean; var UserDate: TDate; UserTime: TTime; CurrDateTime: TDateTime; DeltaTime: TDateTime; ProjSetting: TProjectSettingRecord; begin Result := TF_Main(FActiveForm).DM.CheckProjectInUse(AIDProject, AUserName, AUserDateTime); {Result := true; ProjSetting := GetProjectSettings(AIDProject); with F_ProjMan.DM do begin 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; end; 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 := false; end;} end; procedure TSCSProject.Clear; begin inherited; FCanOpenFromBeatenBlock := false; FCanJoinComponsInfo.Clear; FChildCatalogs.Clear; FNotJoinComponsInfo.Clear; FProjectLists.Clear; FUsedInterfaces.Clear; ClearNearFloorFiguresIDs; FConnectedComponsList.Clear; FNoSaveListsToFiles.Clear; FBuildID := 0; FNBBuildID := 0; FIsAutoTracing := false; FBadSavedListIDs.Clear; FIDsSrcObjects.Clear; FIDsNewObjects.Clear; FFilterBlock.IsOn := false; FFilterBlock.Clear; //*** NormBase Links ClearNBDirInfo; end; procedure TSCSProject.ClearNearFloorFiguresIDs; begin FIDsNearFloorFigures.Clear; FIDsOppositeNearFloorFigures.Clear; end; procedure TSCSProject.ClearNBDirInfo; begin FNBDirID := 0; FNBDirNode := nil; end; procedure TSCSProject.ClearOpenedListsCADStream; var i: Integer; SCSList: TSCSList; begin try for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if CheckListExist(SCSList.CurrID) then TMemoryStream(SCSList.FCADStream).Clear; end; except on E: Exception do AddExceptionToLogEx('', E.Message); end; end; function TSCSProject.GetCurrency(ACurrencyType: Integer): TCurrency; var SprCurrency: TNBCurrency; begin ZeroMemory(@Result, SizeOf(TCurrency)); SprCurrency := FSpravochnik.GetCurrencyByType(ACurrencyType); if SprCurrency <> nil then Result := SprCurrency.Data; {case ACurrencyType of ctMain: begin Result.ID := Setting.IDCurrency; Result.Ratio := Setting.CurrencyRatio; Result.Kolvo := Setting.CurrencyKolvo; end; ctSecond: begin Result.ID := Setting.CurrensySID; Result.Ratio := Setting.CurrensySRatio; Result.Kolvo := Setting.CurrencySKolvo; end; end;} end; function TSCSProject.GetDefListSettings(AID: Integer): TListSettingRecord; var ListSettingsStream: TStream; StreamSize: Integer; begin Result := GetDefaultListSettings(false); ListSettingsStream := nil; if TF_Main(FActiveForm).DM.ExistsFieldInTable(tnCatalog, fnDefListSettings, FQueryMode) then ListSettingsStream := TF_Main(FActiveForm).DM.GetStreamFromTableByID(tnCatalog, fnDefListSettings, AID, FQueryMode); if Assigned(ListSettingsStream) then begin ListSettingsStream.Position := 0; StreamSize := ListSettingsStream.Size; if StreamSize <= SizeOf(Result) then begin ListSettingsStream.Position := 0; ListSettingsStream.Read(Result, StreamSize); end; //Tolik 18/08/2021 -- {$if defined(SCS_PE) } if Result.CadFontName = 'GOST' then Result.CadFontName := 'Tahoma'; {$IfEnd} // AfterLoadListSetting(Result); end; end; function TSCSProject.GetFilterInfoByType(AFilterType: Integer): TFilterInfo; var i: Integer; FFilterInfo: TFilterInfo; begin Result := nil; for i := 0 to FFilters.Count - 1 do begin FFilterInfo := TFilterInfo(FFilters[i]); if FFilterInfo.FilterType = AFilterType then begin Result := FFilterInfo; Break; //// BREAK //// end; end; end; function TSCSProject.GetInterfaceByListObjCompIDs(AIDList, AIDObject, AIDCOmponent, AIDInterfRel: Integer): TSCSInterface; var SCSList: TSCSList; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; begin Result := nil; if (AIDList > 0) and (AIDObject > 0) and (AIDCOmponent > 0) then begin SCSList := GetListBySCSID(AIDList); if SCSList <> nil then begin SCSCatalog := SCSList.GetCatalogFromReferences(AIDObject); if SCSCatalog <> nil then begin SCSComponent := SCSCatalog.GetComponentFromReferences(AIDComponent); if SCSComponent <> nil then Result := SCSComponent.GetInterfaceByID(AIDInterfRel); end; end; end; end; //*** Вернет структурированные листы с компонентами, кот-е попадают под типы AComponentTypes // Структура имеет след-й вид: Лист->Комната(Виртуальная с ID=-1)->Группа объектов(с общим типом и условным обозначением) function TSCSProject.GetListsFilteredByComponentTypes(AComponentTypes: TObjectList; ADevideByJoinedNetType, AExtendedNotes: Boolean): TSCSLists; var i, j: Integer; GrpComponentType: TNBComponentType; CurrList, FilteredList: TSCSList; ComponentsFromType: TSCSComponents; FilteredLists: TSCSLists; FilteredRoom, CurrListRoom: TSCSCatalog; function GreateGroupCatalog: TSCSCatalog; begin Result := TSCSCatalog.Create(FActiveForm); Result.FSCSComponents.FOwnsObjects := false; Result.FChildCatalogs.FOwnsObjects := false; //*** Подписи Result.FNotes := TStringList.Create; end; function HandleObject(AFilteredList: TSCSList; AGrpComponentsByType: TSCSComponents): TBasicSCSClass; var i, j, k: Integer; ObjectRoom, FilteredRoom, FilteredGroupCatalog: TSCSCatalog; CurrFilteredRoom, CurrFilteredGroupCatalog, ObjectFromGruop, ObjectOwner: TSCSCatalog; SCSComponent: TSCSComponent; ObjectIconType: Integer; JoiningLineComponIDs: TIntList; LengthLineCompons: Double; begin Result := nil; for i := 0 to AGrpComponentsByType.Count - 1 do begin SCSComponent := AGrpComponentsByType[i]; ObjectOwner := SCSComponent.GetFirstParentCatalog; ObjectIconType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (ObjectIconType <> oitNone) and (ObjectOwner.GetFirstComponent = SCSComponent) then begin FilteredRoom := nil; FilteredGroupCatalog := nil; //*** Определится с коминатой if ObjectOwner.Parent is TSCSCatalog then begin ObjectRoom := nil; //*** На объект в комнате if TSCSCatalog(ObjectOwner.Parent).ItemType = itRoom then begin ObjectRoom := TSCSCatalog(ObjectOwner.Parent); FilteredRoom := AFilteredList.GetCatalogFromReferences(ObjectRoom.ID); //*** Такой комнаты еще нет if FilteredRoom = nil then begin FilteredRoom := TSCSCatalog.Create(FActiveForm); FilteredRoom.AssignOnlyCatalog(ObjectRoom); AFilteredList.AddChildCatalogToList(FilteredRoom); end end else //*** Если объект вне комнаты, а просто валяется на листе, // то определится с виртуальной еомнатой if TSCSCatalog(ObjectOwner.Parent).ItemType = itList then begin for j := 0 to AFilteredList.ChildCatalogs.Count - 1 do begin CurrFilteredRoom := AFilteredList.ChildCatalogs[j]; if (CurrFilteredRoom.ID = -1) and (CurrFilteredRoom.ItemType = itRoom) then begin FilteredRoom := CurrFilteredRoom; Break; //// BREAK //// end; end; if FilteredRoom = nil then begin FilteredRoom := TSCSCatalog.Create(FActiveForm); FilteredRoom.ID := -1; FilteredRoom.Name := Setting.DefRoomName; FilteredRoom.ItemType := itRoom; AFilteredList.AddChildCatalogToList(FilteredRoom); end; end; //*** Если комната Определена, то нужно определится с группой объектов if FilteredRoom <> nil then begin for j := 0 to FilteredRoom.ChildCatalogs.Count - 1 do begin CurrFilteredGroupCatalog := FilteredRoom.ChildCatalogs[j]; if (CurrFilteredGroupCatalog.ItemType = itDir) and (CurrFilteredGroupCatalog.FGUIDComponentType = SCSComponent.ComponentType.GUID) {and (CurrFilteredGroupCatalog.FGUIDDesignIcon = SCSComponent.GUIDSymbol) and (CurrFilteredGroupCatalog.FDesignIconType = ObjectIconType)} then begin FilteredGroupCatalog := CurrFilteredGroupCatalog; //*** Если в найденной группе есть объект, кот. подкл. кабелем к тек. объекту, то // не добавлть его в группу if (SCSComponent.ComponentType.SysName <> ctsnWorkPlace) then for k := 0 to CurrFilteredGroupCatalog.ChildCatalogs.Count - 1 do begin ObjectFromGruop := CurrFilteredGroupCatalog.ChildCatalogs[k]; JoiningLineComponIDs := GetComponentsJoiningCatalogs(ObjectFromGruop.SCSID, ObjectOwner.SCSID, LengthLineCompons); if JoiningLineComponIDs <> nil then begin FreeAndNil(JoiningLineComponIDs); FilteredGroupCatalog := nil; Break; //// BREAK //// end; end; if FilteredGroupCatalog <> nil then Break; //// BREAK //// end; end; if FilteredGroupCatalog = nil then begin FilteredGroupCatalog := GreateGroupCatalog; FilteredGroupCatalog.SCSID := GenIDByGeneratorIndex(giKatalogSCSID); FilteredGroupCatalog.FGUIDComponentType := SCSComponent.ComponentType.GUID; FilteredGroupCatalog.FComponTypeSysName := SCSComponent.ComponentType.SysName; FilteredGroupCatalog.FGUIDDesignIcon := SCSComponent.GUIDSymbol; FilteredGroupCatalog.FDesignIconType := ObjectIconType; if SCSComponent.ComponentType.NamePlural <> '' then FilteredGroupCatalog.Name := SCSComponent.ComponentType.NamePlural else FilteredGroupCatalog.Name := SCSComponent.ComponentType.Name; FilteredRoom.AddChildCatalogToList(FilteredGroupCatalog); end; end; //*** Если определена группа, то добавить Объект с компонентой в группу if FilteredGroupCatalog <> nil then begin FilteredGroupCatalog.FChildCatalogs.Add(ObjectOwner); FilteredGroupCatalog.AddChildToReferences(ObjectOwner, false); for j := 0 to ObjectOwner.FComponentReferences.Count - 1 do FilteredGroupCatalog.AddComponentToReferences(ObjectOwner.FComponentReferences[j], false); end; end; end; end; end; //*** Разбивает группы procedure DevideGroupsByJoinedNetTypes(AFilteredList: TSCSList); var i, j, k, l: Integer; RoomCatalog, GroupCatalog, NewGroupCatalog: TSCSCatalog; SCSComponent, JoinedComponent: TSCSComponent; LookedNetTypeGUIDs: TStringList; begin LookedNetTypeGUIDs := TStringList.Create; for i := 0 to AFilteredList.ChildCatalogs.Count - 1 do begin RoomCatalog := AFilteredList.ChildCatalogs[i]; for j := 0 to RoomCatalog.ChildCatalogs.Count - 1 do begin GroupCatalog := RoomCatalog.ChildCatalogs[j]; LookedNetTypeGUIDs.Clear; for k := 0 to GroupCatalog.FComponentReferences.Count - 1 do begin SCSComponent := GroupCatalog.FComponentReferences[k]; for l := 0 to SCSComponent.JoinedComponents.Count - 1 do begin JoinedComponent := SCSComponent.JoinedComponents[l]; //*** Первый тип сети пусть и будет существующая группа if LookedNetTypeGUIDs.Count = 0 then begin GroupCatalog.FGUIDJoinedNetType := JoinedComponent.GUIDNetType; LookedNetTypeGUIDs.Add(JoinedComponent.GUIDNetType); end else if LookedNetTypeGUIDs.IndexOf(JoinedComponent.GUIDNetType) = -1 then begin NewGroupCatalog := GreateGroupCatalog; NewGroupCatalog.AssignOnlyCatalog(GroupCatalog); NewGroupCatalog.SCSID := GenIDByGeneratorIndex(giKatalogSCSID); NewGroupCatalog.FGUIDJoinedNetType := JoinedComponent.GUIDNetType; NewGroupCatalog.FChildCatalogs.Assign(GroupCatalog.FChildCatalogs); NewGroupCatalog.FChildCatalogReferences.Assign(GroupCatalog.FChildCatalogReferences); NewGroupCatalog.FComponentReferences.Assign(GroupCatalog.FComponentReferences); RoomCatalog.AddChildCatalogToList(NewGroupCatalog); LookedNetTypeGUIDs.Add(JoinedComponent.GUIDNetType); end; end; end; end; end; FreeAndNil(LookedNetTypeGUIDs); end; //*** Определяет подписи для групп объектов, таким образом, что бы туды попадали // подключенные компоненты с подключенных объектов procedure DefineNotesAtGroupObjects(AFilteredList: TSCSList); var i, j, k, l, m, ComponentIndex, CurrCount: Integer; RoomCatalog, GrpCatalog, SCSObject: TSCSCatalog; FirstComponent: TSCSComponent; //CurrComponent: TSCSComponent; //CurrTopComponent: TSCSComponent; //JoinedComponent: TSCSComponent; ComponentGUIDs, ComponentNames: TStringList; ComponentCount: TIntList; //LookedIDs: TIntList; PrefixOfCount: String; begin ComponentGUIDs := TStringList.Create; ComponentNames := TStringList.Create; ComponentCount := TIntList.Create; //LookedIDs := TIntList.Create; try PrefixOfCount := DefListSettings.NoteCountPrefix; if PrefixOfCount = '' then PrefixOfCount := 'x'; for i := 0 to AFilteredList.ChildCatalogs.Count - 1 do begin RoomCatalog := AFilteredList.ChildCatalogs[i]; for j := 0 to RoomCatalog.ChildCatalogs.Count - 1 do begin GrpCatalog := RoomCatalog.ChildCatalogs[j]; ComponentGUIDs.Clear; ComponentNames.Clear; ComponentCount.Clear; //LookedIDs.Clear; case AExtendedNotes of true: for k := 0 to GrpCatalog.ChildCatalogs.Count - 1 do begin SCSObject := GrpCatalog.ChildCatalogs[k]; GrpCatalog.FNotes.Add(SCSObject.GetNameForVisible); GrpCatalog.FNotes.Sort; end; false: begin //*** Определить количества разных компнент for k := 0 to GrpCatalog.ChildCatalogs.Count - 1 do begin SCSObject := GrpCatalog.ChildCatalogs[k]; FirstComponent := SCSObject.GetFirstComponent; if FirstComponent <> nil then begin ComponentIndex := ComponentGUIDs.IndexOf(FirstComponent.GuidNB); if ComponentIndex = -1 then begin ComponentIndex := ComponentGUIDs.Add(FirstComponent.GuidNB); if FirstComponent.NameShort <> '' then ComponentNames.Add(FirstComponent.NameShort) else ComponentNames.Add(FirstComponent.ComponentType.NamePlural); ComponentCount.Add(0); end; if ComponentIndex <> -1 then ComponentCount[ComponentIndex] := ComponentCount[ComponentIndex] + 1; end; end; {//*** Определить количества разных компнент for k := 0 to GrpCatalog.ComponentReferences.Count - 1 do begin CurrComponent := GrpCatalog.ComponentReferences[k]; CurrTopComponent := CurrComponent.GetTopComponent; for l := 0 to CurrComponent.JoinedComponents.Count - 1 do begin JoinedComponent := CurrComponent.JoinedComponents[l]; //*** Подключенный компонент не должен быть внутренним соединением if JoinedComponent.GetTopComponent = CurrTopComponent then Continue; //// CONTINUE //// //*** Учитывать тип сети подключений к группе if (GrpCatalog.FGUIDJoinedNetType = '') or (GrpCatalog.FGUIDJoinedNetType = JoinedComponent.GUIDNetType) then begin //*** Вдрух один кабель подключен к нескольким компонентам (разветлен) if LookedIDs.IndexOf(JoinedComponent.ID) = -1 then begin ComponentIndex := ComponentGUIDs.IndexOf(JoinedComponent.GuidNB); if ComponentIndex = -1 then begin ComponentIndex := ComponentGUIDs.Add(JoinedComponent.GuidNB); ComponentNames.Add(JoinedComponent.Name); ComponentCount.Add(0); end; if ComponentIndex <> -1 then ComponentCount[ComponentIndex] := ComponentCount[ComponentIndex] + 1; LookedIDs.Add(JoinedComponent.ID); end; end; end; end; } //*** Сформировать подпись GrpCatalog.FNotes.Clear; for k := 0 to ComponentGUIDs.Count - 1 do begin CurrCount := ComponentCount[k]; GrpCatalog.FNotes.Add(GetPrefixCountByType(ComponentNames[k], PrefixOfCount, CurrCount, DefListSettings.PrefixCountType)); //if CurrCount = 1 then // GrpCatalog.FNotes.Add(ComponentNames[k]) //else //if CurrCount > 1 then // GrpCatalog.FNotes.Add(ComponentNames[k] + PrefixOfCount + IntToStr(CurrCount)); end; end; end; end; end; finally FreeAndNil(ComponentGUIDs); FreeAndNil(ComponentNames); FreeAndNil(ComponentCount); //FreeAndNil(LookedIDs); end; end; begin Result := nil; FilteredLists := TSCSLists.Create(true); try if AComponentTypes <> nil then begin for i := 0 to FProjectLists.Count - 1 do begin CurrList := FProjectLists[i]; if CheckListNormalType(CurrList.CurrID) then begin FilteredList := nil; FilteredList := TSCSList.Create(FActiveForm); FilteredList.AssignOnlyCatalog(CurrList); FilteredList.AssignSettings(CurrList.Setting); FilteredLists.Add(FilteredList); //*** Вкинуть комнаты for j := 0 to CurrList.ChildCatalogs.Count - 1 do begin CurrListRoom := CurrList.ChildCatalogs[j]; if CurrListRoom.ItemType = itRoom then begin FilteredRoom := TSCSCatalog.Create(FActiveForm); FilteredRoom.AssignOnlyCatalog(CurrListRoom); FilteredList.AddChildCatalogToList(FilteredRoom); end; end; //*** Добавить объекты по отобранным по типам, компонентах for j := 0 to AComponentTypes.Count - 1 do begin GrpComponentType := TNBComponentType(AComponentTypes[j]); if GrpComponentType.IsSelected then begin ComponentsFromType := CurrList.GetComponentsByType(GrpComponentType.ComponentType.GUID, true); if ComponentsFromType.Count > 0 then begin HandleObject(FilteredList, ComponentsFromType); end; FreeAndNil(ComponentsFromType); end; end; if ADevideByJoinedNetType then DevideGroupsByJoinedNetTypes(FilteredList); DefineNotesAtGroupObjects(FilteredList); end; end; end; except on E: Exception do AddExceptionToLog('TSCSProject.GetListsFilteredByComponentTypes: '+E.Message); end; Result := FilteredLists; //GetPlanJoining(Result); end; function TSCSProject.GetParams: TProjectParams; begin Result.ID := Self.CurrID; Result.MarkID := Self.MarkID; Result.Name := Self.Name; Result.IsIndexWithName := IsIndexWithName; Result.Caption := Result.Name; if Result.IsIndexWithName = biTrue then Result.Caption := Result.Caption + ' ' + IntTostr(Result.MarkID); Result.Setting := Self.Setting; Result.DefListSetting := Self.DefListSettings; //Tolik 18/08/2021 -- {$if defined(SCS_PE) } if Result.DefListSetting.CADFontName = 'GOST' then Result.DefListSetting.CadFontName := 'Tahoma'; {$IfEnd} // Result.ServCanRecalcPricesByNDSChange := true; end; procedure TSCSProject.LoadParams(AProjectParams: TProjectParams); begin Name := AProjectParams.Name; MarkID := AProjectParams.MarkID; IsIndexWithName := AProjectParams.IsIndexWithName; Setting := AProjectParams.Setting; DefListSettings := AProjectParams.DefListSetting; //Tolik 18/08/2021 -- {$if defined(SCS_PE) } if DefListSettings.CadFontName = 'GOST' then DefListSettings.CadFontName := 'Tahoma'; {$IfEnd} // end; procedure TSCSProject.NotifyBeforeReport; begin ClearNearFloorFiguresIDs; end; function TSCSProject.GetUsingComponentTypes: TObjectList; var i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; LookedGUIDESOfComponTypes: TStringList; SprComponentType, GrpComponentType: TNBComponentType; begin Result := TObjectList.Create(true); LookedGUIDESOfComponTypes := TStringList.Create; try for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSConnector then for j := 0 to SCSCatalog.SCSComponents.Count - 1 do begin SCSComponent := SCSCatalog.SCSComponents[j]; SprComponentType := FSpravochnik.GetComponentTypeWithAssign(SCSComponent.ComponentType.GUID, TF_Main(FActiveForm).GSCSBase.FNBSpravochnik); if SprComponentType <> nil then if LookedGUIDESOfComponTypes.IndexOf(SprComponentType.ComponentType.GUID) = -1 then begin GrpComponentType := TNBComponentType.Create(FActiveForm); GrpComponentType.AssignOnlyComponentType(SprComponentType); Result.Add(GrpComponentType); LookedGUIDESOfComponTypes.Add(SprComponentType.ComponentType.GUID); end; end; end; finally LookedGUIDESOfComponTypes.Free; end; end; // added by Tolik (Если требуется получить точечные не на проекте, а, допустим, на листе) function TSCSProject.GetUsingComponentTypes(ACatalog : TSCSCatalog): TObjectList; var i, j: Integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; LookedGUIDESOfComponTypes: TStringList; SprComponentType, GrpComponentType: TNBComponentType; begin Result := TObjectList.Create(true); LookedGUIDESOfComponTypes := TStringList.Create; try for i := 0 to ACatalog.ChildCatalogReferences.Count - 1 do begin SCSCatalog := ACatalog.ChildCatalogReferences[i]; if SCSCatalog.ItemType = itSCSConnector then for j := 0 to SCSCatalog.SCSComponents.Count - 1 do begin SCSComponent := SCSCatalog.SCSComponents[j]; SprComponentType := FSpravochnik.GetComponentTypeWithAssign(SCSComponent.ComponentType.GUID, TF_Main(FActiveForm).GSCSBase.FNBSpravochnik); if SprComponentType <> nil then if LookedGUIDESOfComponTypes.IndexOf(SprComponentType.ComponentType.GUID) = -1 then begin GrpComponentType := TNBComponentType.Create(FActiveForm); GrpComponentType.AssignOnlyComponentType(SprComponentType); Result.Add(GrpComponentType); LookedGUIDESOfComponTypes.Add(SprComponentType.ComponentType.GUID); end; end; end; finally LookedGUIDESOfComponTypes.Free; end; end; //#### Вернет сгруппированные соединения по всему проэкту #### function TSCSProject.GetPlanJoining(AFilteredLists: TSCSLists): TObjectList; var FilteredList: TSCSList; RoomCatalog, GroupCatalog, EndGroupCatalog: TSCSCatalog; SCSComponent, LineComponent: TSCSComponent; GroupNetList: TObjectList; CurrGroupNet: TList; ExistsGroupInEndGroupField: Boolean; ExistedGroupInBegin, LineComponOwner, LineObjectToList: TSCSCatalog; CatalogGroupConnection, CurrCatalogGroupConnection: TCatalogGroupConnection; ptrJoinedComponents: PJoinedComponents; LookedComponentTypesGUIDs: TStringList; ComponIdx, i, j, k, l, m, n, o: Integer; function GetGroupCatalogByPoinComponList(APoinComponList: TSCSComponents; AGUIDJoinedNetType: String): TSCSCatalog; var CurrFilteredList: TSCSList; CurrRoomCatalog, CurrGroupCatalog: TSCSCatalog; i, j, k, l: Integer; PointComponet: TSCSComponent; begin Result := nil; for i := 0 to AFilteredLists.Count - 1 do begin CurrFilteredList := AFilteredLists[i]; for j := 0 to CurrFilteredList.ChildCatalogs.Count - 1 do begin CurrRoomCatalog := CurrFilteredList.ChildCatalogs[j]; for k := 0 to CurrRoomCatalog.ChildCatalogs.Count - 1 do begin CurrGroupCatalog := CurrRoomCatalog.ChildCatalogs[k]; for l := 0 to APoinComponList.Count - 1 do begin PointComponet := APoinComponList[l]; if CurrGroupCatalog.FComponentReferences.IndexOf(PointComponet) <> -1 then if (AGUIDJoinedNetType = '') or (CurrGroupCatalog.FGUIDJoinedNetType = AGUIDJoinedNetType) then begin Result := CurrGroupCatalog; Exit; ///// EXIT ///// end; end; end; end; end; end; begin Result := TObjectList.Create(true); try GroupNetList := TObjectList.Create(false); LookedComponentTypesGUIDs := TStringList.Create; for i := 0 to AFilteredLists.Count - 1 do begin FilteredList := AFilteredLists[i]; for j := 0 to FilteredList.ChildCatalogs.Count - 1 do begin RoomCatalog := FilteredList.ChildCatalogs[j]; for k := 0 to RoomCatalog.ChildCatalogs.Count - 1 do begin GroupCatalog := RoomCatalog.ChildCatalogs[k]; //*** Проверить, не используется ли тек. группа в поле FEndCatalogGroup ExistedGroupInBegin := nil; ExistsGroupInEndGroupField := false; for l := 0 to Result.Count - 1 do begin CatalogGroupConnection := TCatalogGroupConnection(Result[l]); if CatalogGroupConnection.FEndCatalogGroup = GroupCatalog then begin ExistsGroupInEndGroupField := true; ExistedGroupInBegin := CatalogGroupConnection.FBeginCatalogGroup; Break; //// BREAK //// end; end; //if ExistsGroupInEndGroupField then // Continue; //// CONTINUE //// //*** Найти соединения для всей группы учитывая разгруппировку по подключенному типу сети GroupNetList.Clear; for l := 0 to GroupCatalog.FComponentReferences.Count - 1 do begin SCSComponent := GroupCatalog.FComponentReferences[l]; SCSComponent.LoadNet(GroupCatalog.FGUIDJoinedNetType); if SCSComponent.FNet.Count > 0 then GroupNetList.Add(SCSComponent.FNet); end; //*** Создать Объекты соединения от группы СКС объектов for l := 0 to GroupNetList.Count - 1 do begin CurrGroupNet := TList(GroupNetList[l]); for m := 0 to CurrGroupNet.Count - 1 do begin ptrJoinedComponents := CurrGroupNet[m]; //**** Соединение с обоих сторон if (ptrJoinedComponents.FirstConnCompons.Count > 0) and (ptrJoinedComponents.LastConnCompons.Count > 0) then begin //*** Найты найденные трассы для списка линейных компонент CatalogGroupConnection := nil; for n := 0 to Result.Count - 1 do begin CurrCatalogGroupConnection := TCatalogGroupConnection(Result[n]); if CurrCatalogGroupConnection.CheckEqualNet(ptrJoinedComponents) then begin CatalogGroupConnection := CurrCatalogGroupConnection; Break; //// BREAK //// end; end; //*** Если найти не удалось if CatalogGroupConnection = nil then begin //*** Найти группу, в которой находятся ptrJoinedComponents.LastConnCompons EndGroupCatalog := GetGroupCatalogByPoinComponList(ptrJoinedComponents.LastConnCompons, GroupCatalog.FGUIDJoinedNetType); if EndGroupCatalog = nil then Continue; //// CONTINUE //// if ExistsGroupInEndGroupField then if EndGroupCatalog = ExistedGroupInBegin then Continue; //// CONTINUE //// //*** Группы должны быть разными объектами if GroupCatalog <> EndGroupCatalog then begin CatalogGroupConnection := TCatalogGroupConnection.Create(Self); CatalogGroupConnection.BeginCatalogGroup := GroupCatalog; CatalogGroupConnection.EndCatalogGroup := EndGroupCatalog; Result.Add(CatalogGroupConnection); end; end; //*** Вставить линейные компоненты в трассы CatalogGroupConnection.Lines if CatalogGroupConnection <> nil then begin LookedComponentTypesGUIDs.Clear; for n := 0 to ptrJoinedComponents.JoinedLines.Count - 1 do begin LineComponent := ptrJoinedComponents.JoinedLines[n]; if LookedComponentTypesGUIDs.IndexOf(LineComponent.ComponentType.GUID) = -1 then begin //06.07.2013 ComponIdx := -1; for o := 0 to CatalogGroupConnection.FComponExemplars.Count - 1 do if CatalogGroupConnection.FComponExemplars[o].Whole_ID = LineComponent.Whole_ID then begin ComponIdx := o; Break; //// BREAK //// end; if ComponIdx = -1 then CatalogGroupConnection.FComponExemplars.Add(LineComponent); LookedComponentTypesGUIDs.Add(LineComponent.ComponentType.GUID); end; end; end; end; end; end; end; end; end; //*** Подписи к соединенным линейным компонентам for i := 0 to Result.Count - 1 do TCatalogGroupConnection(Result[i]).DefineLinesNote; FreeAndNil(LookedComponentTypesGUIDs); FreeAndNil(GroupNetList); except on E: Exception do AddExceptionToLog('TSCSProject.GetPlanJoining: '+E.Message); end; end; function TSCSProject.GetProjectSettings(AID: Integer): TProjectSettingRecord; //var // SettingsStream: TStream; // StreamSize: Integer; begin Result := TF_Main(FActiveForm).DM.GetProjectSettings(AID); {Result := GetDefaultProjectSettings; try StreamSize := 0; SetSQLToQuery(FQuery_Select, ' select settings from katalog '+ ' where (id = '''+IntToStr(AID)+''') and (id_item_type = '''+IntToStr(itProject)+''') '); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; FQuery_Select.FNSaveToStream('Settings', SettingsStream); FQuery_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 TSCSProject.RefreshWholeLengthThroughFloorComponsInFuture; var CurrThroughFloorObjectIDs: TIntList; i, j, k: Integer; SCSList: TSCSList; SCSObject: TSCSCatalog; begin for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; CurrThroughFloorObjectIDs := GetBetweenFloorObjectsID(SCSList.FCurrID); for j := 0 to CurrThroughFloorObjectIDs.Count - 1 do begin SCSObject := SCSList.GetCatalogFromReferencesBySCSID(CurrThroughFloorObjectIDs[j]); if SCSObject <> nil then for k := 0 to SCSObject.ComponentReferences.Count - 1 do SCSObject.ComponentReferences[k].RefreshWholeLengthInFuture; end; CurrThroughFloorObjectIDs.Free; end; end; procedure TSCSProject.ReindexPointComponent(AComponent: TSCSComponent); var i: Integer; ComplectsToReindex: TSCSComponents; ChildComponent: TSCSComponent; begin if AComponent.IsLine = biFalse then //if (Setting.PointComplIndexingMode = pcimInProject) or AComponent.IsTop then begin AComponent.MarkID := 0; // Сбросить индексы в комплектующих if Setting.PointComplIndexingMode = pcimInProject then for i := 0 to AComponent.FChildReferences.Count - 1 do AComponent.FChildReferences[i].MarkID := 0; AComponent.MarkID := GenComponentMarkIDByMode(AComponent, Setting.PointComonIndexingMode, Setting.PointComplIndexingMode); // Определить индексы комплектующих if Setting.PointComplIndexingMode = pcimInProject then begin ComplectsToReindex := nil; if Setting.ReindexOrderType = rotCreated then begin ComplectsToReindex := TSCSComponents.Create(false); ComplectsToReindex.Assign(AComponent.FChildReferences, laCopy); SortComponentsByID(ComplectsToReindex); end else if Setting.ReindexOrderType = rotPositionPM then ComplectsToReindex := GetComponStructuredChilds(AComponent, true); if ComplectsToReindex <> nil then for i := 0 to ComplectsToReindex.Count - 1 do begin ChildComponent := ComplectsToReindex[i]; ChildComponent.MarkID := GenComponentMarkIDByMode(ChildComponent, Setting.PointComonIndexingMode, Setting.PointComplIndexingMode); ApplyChangeComponMarkID(ChildComponent, false, false, nil); end; ComplectsToReindex.Free; end; ApplyChangeComponMarkID(AComponent, true, false, nil); end; end; procedure TSCSProject.ReindexPointComponentAfterChangeCatalogOwner(AComponent: TSCSComponent; AOldParent: TSCSComponCatalogClass; AOldCatalog: TSCSCatalog); var CatalogOwner: TSCSCatalog; begin try if AComponent.IsLine = biFalse then if Setting.PointComonIndexingMode <> cimInProject then //if (Setting.PointComplIndexingMode = pcimInProject) or AComponent.IsTop then begin CatalogOwner := AComponent.GetFirstParentCatalog; if CatalogOwner <> nil then if Not CheckSCSObjectsInSameIndexingArea(CatalogOwner, AOldCatalog) or // если компонент между областями индексации (((AOldParent is TSCSComponent) or (AComponent.FParent is TSCSComponent)) and // если комплектующая сменила парента при инндексации компл-х в пределах компоненты //20.09.2010 (Setting.PointComplIndexingMode = pcimInCompon)) ((Setting.PointComplIndexingMode = pcimInCompon) or (Setting.PointComplIndexingMode = pcimInTopCompon))) then begin ReindexPointComponent(AComponent); TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(CatalogOwner); end; end; except on E: Exception do AddExceptionToLogEx('TSCSProject.ReindexComponentAfterChangeCatalogOwner', E.Message); end; end; procedure TSCSProject.ReindexPointComponentsAfterChangeCatalogOwner(ACatalog: TSCSCatalog; AOldOwner: TSCSCatalog); var CurrOwner: TSCSCatalog; i: Integer; SCSComponent: TSCSComponent; begin try if ACatalog.ItemType = itSCSConnector then if Setting.PointComonIndexingMode <> cimInProject then begin CurrOwner := nil; if ACatalog.FParent <> nil then if ACatalog.FParent is TSCSCatalog then CurrOwner := TSCSCatalog(ACatalog.FParent); // Определить находится ли новый парент в другой области для индексации if Not CheckSCSObjectsInSameIndexingArea(CurrOwner, AOldOwner) then begin for i := 0 to ACatalog.FSCSComponents.Count - 1 do ReindexPointComponent(ACatalog.FSCSComponents[i]); TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectParamsAfterChangeComponMark(ACatalog); end; end; except on E: Exception do AddExceptionToLogEx('TSCSProject.ReindexPointComponentsAfterChangeCatalogOwner', E.Message); end; end; procedure TSCSProject.RemarkComponents(AComponOwnersWithReindexed: TSCSCatalogs); var i, j: Integer; SCSCatalog: TSCSCatalog; begin for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; for j := 0 to SCSCatalog.FComponentReferences.Count - 1 do begin if j = 0 then if AComponOwnersWithReindexed <> nil then AComponOwnersWithReindexed.Add(SCSCatalog); ApplyChangeComponMarkID(SCSCatalog.FComponentReferences[j], false, (AComponOwnersWithReindexed = nil), nil); end; end; end; procedure TSCSProject.SetComponMarkIDGeneratorToMin(ASprComponType: TNBComponentType); var i: integer; SCSComponent: TSCSComponent; UsedMaxMarkID, CompTypeComponCount: Integer; //LookedWholeID: TRapList; //IndexToInsert: Integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin OldTick := GetTickCount; if FCanGenMarkID then begin try UsedMaxMarkID := 0; CompTypeComponCount := 0; for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(FComponentReferences.FItems.List^[i]); if SCSComponent.GUIDComponentType = ASprComponType.ComponentType.GUID then begin CompTypeComponCount := CompTypeComponCount + 1; if SCSComponent.MarkID > UsedMaxMarkID then UsedMaxMarkID := SCSComponent.MarkID; end; end; if CompTypeComponCount > 0 then ASprComponType.ComponentType.ComponentIndex := UsedMaxMarkID; except on E: Exception do AddExceptionToLogEx('TSCSProject.SetComponMarkIDGeneratorToMin', E.Message); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TSCSProject.SetFilterParamsToForm; begin if TF_Main(FActiveForm).FFilterParams.FFilterBlock = nil then TF_Main(FActiveForm).FFilterParams.FFilterBlock := TFilterBlock.Create(nil, btBlock); TF_Main(FActiveForm).FFilterParams.FFilterBlock.Clear; if FActive then TF_Main(FActiveForm).FFilterParams.FFilterBlock.Assign(FFilterBlock) else TF_Main(FActiveForm).FFilterParams.FFilterBlock.IsOn := false; TF_Main(FActiveForm).FFilterParams.DefineIsUseFilterField; TF_Main(FActiveForm).ApplyComponentFilter(nil, TF_Main(FActiveForm).FFilterParams, true); TF_Main(FActiveForm).DM.DefineIsOnFilterBlocks(TF_Main(FActiveForm).FFilterParams, true); if FActive then if TF_Main(FActiveForm).FFilterParams.IsUseFilter then ProcessMessagesEx; end; procedure TSCSProject.SetPriceParamsToForm; var SprCurrencyM, SprCurrencyS: TNBCurrency; begin with TF_Main(FActiveForm) do begin //GCurrencyM := TF_Main(FActiveForm).FNormBase.DM.GetCurrencyByID(Setting.IDCurrency); //GCurrencyS := F_NormBase.GCurrencyS; SprCurrencyM := FSpravochnik.GetCurrencyByType(ctMain); SprCurrencyS := FSpravochnik.GetCurrencyByType(ctSecond); //*** Базовая валюта if SprCurrencyM <> nil then GCurrencyM := SprCurrencyM.Data else GCurrencyM := TF_Main(FActiveForm).FNormBase.DM.GetCurrencyByID(Setting.IDCurrency); //*** Вторая валюта if SprCurrencyS <> nil then GCurrencyS := SprCurrencyS.Data else GCurrencyS := F_NormBase.GCurrencyS; LoadLocalCurrencyFromDefault; GNDS := Setting.NDS; FUOM := Setting.UnitOfMeasure; SetCurrencyBriefToControls; end; end; procedure TSCSProject.StartStopAutoSaveDateTime(AStart: Boolean); begin //WriteUserNowDateTime; case AStart of True: begin WriteUserNowDateTime; SetTimer(FActiveForm.Handle, TimerIDProjectSaveDateTime, Setting.AutoSaveDateTimeMinutes * 60 * 1000, @SaveProjectDateTime); end; False: KillTimer(FActiveForm.Handle, TimerIDProjectSaveDateTime); end; end; procedure TSCSProject.StartStopAutoSaveProject(AStart: Boolean); begin FCanAutoSave := false; case AStart of True: if Setting.IsAutoSaveProject = true then SetTimer(FActiveForm.Handle, TimerIDProjectAutoSave, Setting.AutoSaveProjectMinutes * 60 * 1000, @AutoSaveCurrentProject); False: KillTimer(FActiveForm.Handle, TimerIDProjectAutoSave); end; end; procedure TSCSProject.WriteUserNowDateTime; var UserName: String; DateTime: TDateTime; begin UserName := GetComputerNetName; DateTime := GetPMNow; WriteUserDateTime(DateTime, UserName); end; procedure TSCSProject.WriteUserNowDateTimeWithCheckName; var CurrUserName: String; ProjectUserName: String; begin try CurrUserName := GetComputerNetName; SetSQLToFIBQuery(FQSelect, 'select '+fnUserName+' from '+tnCatalog+' where id = '''+IntToStr(FCurrID)+''''); ProjectUserName := FQSelect.FN(fnUserName).AsString; if CurrUserName = ProjectUserName then WriteUserNowDateTime else //ShowMessageByType(smtDisplay, 'Проект открыт пользователем '+ProjectUserName+'. У вас нет воз', Application.Title, MB_OK or MB_ICONINFORMATION); MessageDlg(cSCSComponent_Msg19+' '+ProjectUserName+'.', mtInformation, [mbOk], 0); except on E: Exception do AddExceptionToLog('TSCSProject.WriteUserNowDateTimeWithCheckName: '+E.Message); end; end; procedure TSCSProject.WriteUserDateTime(ADateTime: TDateTime; AUserName: String); var FieldNames: TStringList; begin FieldNames := TStringList.Create; FieldNames.Add(fnUserDate); FieldNames.Add(fnUserTime); FieldNames.Add(fnUserName); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCatalog, 'id = '''+IntToStr(FCurrID)+'''', FieldNames, ''), false); FQOperat.ParamByName(fnUserDate).AsDate := ADateTime; FQOperat.ParamByName(fnUserTime).AsTime := ADateTime; FQOperat.ParamByName(fnUserName).AsString := AUserName; FQOperat.ExecQuery; FieldNames.Free; end; procedure TSCSProject.UpdateDesignListsNamesByOwnerList(AOwnerList: TSCSList); var i: Integer; DesignList: TSCSList; DesignLists: TSCSLists; begin if Assigned(AOwnerList) then begin DesignLists := GetDesignListsFromList(AOwnerList); if Assigned(DesignLists) then begin for i := 0 to DesignLists.Count - 1 do begin DesignList := DesignLists[i]; if Assigned(DesignList) then if Assigned(DesignList.TreeViewNode) then begin TF_Main(FActiveForm).RenameNode(cfBase, DesignList.TreeViewNode, DesignList, GetListDesignedName(DesignList.Setting.IDFigureForDesignList)); DesignList.TreeViewNode.Text := DesignList.GetNameForVisible(true); end; end; DesignLists.Free; end; end; end; procedure TSCSProject.UpdatePrices; var NBCurrency: TCurrency; begin {NBCurrency := TF_Main(FActiveForm).FNormBase.DM.GetCurrencyByID(Setting.IDCurrency); //*** Если валюта была удалена из НБ if NBCurrency.ID < 1 then NBCurrency := TF_Main(FActiveForm).FNormBase.DM.GetCurrencyByType(ctMain); //NBCurrency := GetCurrencyByType(ctMain); //*** Проверить не менялась ли валюта if NBCurrency.ID > 0 then begin if Abs(NBCurrency.Ratio - Setting.CurrencyRatio) > 0.01 then begin //Self.RefreshPricesAfterChangeRatio(Setting.CurrencyRatio, NBCurrency.Ratio, true); Setting.CurrencyRatio := NBCurrency.Ratio; SetPriceParamsToForm; end; if Setting.IDCurrency <> NBCurrency.ID then begin Self.RefreshPricesAfterChangeCurrency(GetCurrency(ctMain), NBCurrency, true); Setting.IDCurrency := NBCurrency.ID; Setting.CurrencyRatio := NBCurrency.Ratio; SetPriceParamsToForm; end; end;} end; procedure TSCSProject.SetFCurrList(Value: TSCSList); begin if Assigned(Value) then FIDLastList := Value.CurrID else FIDLastList := -1; FCurrList := Value; GIDLastList := FIDLastList; end; procedure TSCSProject.SetFIsAutoTracing(Value: Boolean); begin FIsAutoTracing := Value; FCanJoinComponsInfo.Clear; FNotJoinComponsInfo.Clear; FUsedInterfaces.Clear; end; procedure TSCSProject.LoadProject; var ProjList: TSCSList; SCSCatalog: TSCSCatalog; IDDirList: TList; DirItemType: Integer; i, j: integer; QSelect: TSCSQuery; //SCSCatalogs //SCSComponents: TSCSComponents; begin try //Clear; //ClearProject; {try QueryMode := qmMemory; LoadChildCatalogs(true, FLoadComponData); finally QueryMode := qmPhisical; end;} //SendFromMemBaseToClasses; if FGenerators.LastGen_ComponentWholeID = 0 then FGenerators.LastGen_ComponentWholeID := FComponentReferences.GetMaxWholeID; Self.SetComponentsJoining; Self.SetComponInterfacesForComlects; //*** Найти последний лист даного проекта if FIDLastList > 0 then CurrList := GetListBySCSID(FIDLastList); if Not Assigned(CurrList) then if FProjectLists.Count > 0 then CurrList := FProjectLists[0]; {while Not FQuery_Select.Eof do begin ProjList := TSCSList.Create(ActiveForm); ProjList.SCSID := FQuery_Select.GetFNAsInteger('SCS_ID'); ProjectLists.Add(ProjList); FQuery_Select.Next; end; for i := 0 to ProjectLists.Count - 1 do begin ProjList := ProjectLists[i]; ProjList.CurrID := ProjList.SCSID; end; } except on E: Exception do AddExceptionToLog('TSCSProject.LoadProject: '+E.Message); end; end; (* procedure TSCSProject.ClearProject; var ProjList: TSCSList; i: integer; begin try {for i := 0 to ProjectLists.Count - 1 do begin ProjList := TSCSList(ProjectLists[i]); if ProjList <> nil then ProjList.Free; end; } FChildCatalogs.Clear; ProjectLists.Clear; except on E: Exception do AddExceptionToLog('TSCSProject.ClearProject: '+E.Message); end; end;*) { function TSCSProject.GetMTKatalog: TSQLMemTable; begin Result := nil; Result := TSQLMemTable.Create(nil); Result.FieldDefs.Add(fnID, ftInteger); Result.FieldDefs.Add(fnParentID, ftInteger); //Result.FieldDefs.Add(fnProjectID, ftInteger); Result.FieldDefs.Add(fnListID, ftInteger); Result.FieldDefs.Add(fnName, ftString, 255); Result.FieldDefs.Add(fnNameShort, ftString, 200); Result.FieldDefs.Add(fnNameMark, ftString, 200); Result.FieldDefs.Add(fnIsUserName, ftInteger); Result.FieldDefs.Add(fnSortID, ftInteger); Result.FieldDefs.Add(fnKolCompon, ftInteger); Result.FieldDefs.Add(fnItemsCount, ftInteger); Result.FieldDefs.Add(fnIDItemType, ftInteger); Result.FieldDefs.Add(fnMarkID, ftInteger); Result.FieldDefs.Add(fnIsIndexWithName, ftInteger); Result.FieldDefs.Add(fnSCSID, ftInteger); Result.FieldDefs.Add(fnIndexConn, ftInteger); Result.FieldDefs.Add(fnIndexJoiner, ftInteger); Result.FieldDefs.Add(fnIndexLine, ftInteger); Result.FieldDefs.Add(fnSettings, ftBlob); Result.FieldDefs.Add(fnDefListSettings, ftBlob); Result.FieldDefs.Add(fnCompTypeMarkMasks, ftBlob); Result.FieldDefs.Add(fnCADBlock, ftBlob); Result.FieldDefs.Add(fnPMBlock, ftBlob); Result.FieldDefs.Add(fnGenerators, ftBlob); Result.FieldDefs.Add(fnBuildID, ftInteger); end; } (* procedure TSCSProject.CloseAllTables; var CurrTable: TSQLMemTable; i: Integer; begin with TF_Main(ActiveForm).DM do begin for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Active then CurrTable.Close; end; { tSQL_Resources.Filtered := false; tSQL_NormResourceRel.Filtered := false; tSQL_Norms.Filtered := false; tSQL_ConnectedComponents.Filtered := false; tSQL_CableCanalConnectors.Filtered := false; tSQL_CompPropRelation.Filtered := false; tSQL_ComponentRelation.Filtered := false; tSQL_PortInterfaceRelation.Filtered := false; tSQL_InterfOfInterfRelation.Filtered := false; tSQL_InterfaceRelation.Filtered := false; tSQL_Component.Filtered := false; tSQL_CatalogRelation.Filtered := false; tSQL_CatalogPropRelation.Filtered := false; tSQL_CatalogMarkMask.Filtered := false; tSQL_Katalog.Filtered := false;} { if tSQL_Katalog.Active then tSQL_Katalog.Close; if tSQL_CatalogRelation.Active then tSQL_CatalogRelation.Close; if tSQL_Component.Active then tSQL_Component.Close; if tSQL_CatalogMarkMask.Active then tSQL_CatalogMarkMask.Close; if tSQL_CatalogPropRelation.Active then tSQL_CatalogPropRelation.Close; if tSQL_ComponentRelation.Active then tSQL_ComponentRelation.Close; if tSQL_CompPropRelation.Active then tSQL_CompPropRelation.Close; if tSQL_CableCanalConnectors.Active then tSQL_CableCanalConnectors.Close; if tSQL_ConnectedComponents.Active then tSQL_ConnectedComponents.Close; if tSQL_InterfaceRelation.Active then tSQL_InterfaceRelation.Close; if tSQL_InterfOfInterfRelation.Active then tSQL_InterfOfInterfRelation.Close; if tSQL_PortInterfaceRelation.Active then tSQL_PortInterfaceRelation.Close; if tSQL_Norms.Active then tSQL_Norms.Close; if tSQL_NormResourceRel.Active then tSQL_NormResourceRel.Close; if tSQL_Resources.Active then tSQL_Resources.Close;} end; end;*) procedure TSCSProject.ClearClasses; begin FChildCatalogs.Clear; ProjectLists.Clear; if FComponentReferences.Count > 0 then AddExceptionToLog('TSCSProject.ClearClasses: '+cNoFullyFreeComponentList); if FChildCatalogReferences.Count > 0 then AddExceptionToLog('TSCSProject.ClearClasses: '+cNoFullyFreeObjectList); FComponentReferences.Clear; FChildCatalogReferences.Clear; ClearNBDirInfo; end; function TSCSProject.GetProjectGenerators(AID: Integer): TProjectGenerators; var Stream: TStream; StreamSize: Integer; begin ZeroMemory(@Result, SizeOf(TProjectGenerators)); try StreamSize := 0; SetSQLToFIBQuery(FQSelect, 'select '+fnGenerators+' from katalog '+ 'where (id = '''+IntToStr(AID)+''') and (id_item_type = '''+IntToStr(itProject)+''') '); Stream := TMemoryStream.Create; Stream.Position := 0; FQSelect.FN(fnGenerators).SaveToStream(Stream); FQSelect.Close; StreamSize := Stream.Size; Stream.Position := 0; if StreamSize <= sizeof(TProjectGenerators) then Stream.ReadBuffer(Result, StreamSize); FreeAndNil(Stream); except on E: Exception do AddExceptionToLog('TSCSProject.GetProjectGenerators: '+E.Message); end; end; procedure TSCSProject.LoadCatalogsFromMemTable; var SCSCatalog: TSCSCatalog; SCSCatalogs: TSCSCatalogs; i, j: Integer; SCSList: TSCSList; //RecNo: Integer; CatalogPropertyList: TList; ptrProperty: PProperty; FindedForI: Boolean; procedure ParseCatalogs(AParentCatalog: TSCSCatalog; AParentID: Integer); var i: Integer; ChildCatalog: TSCSCatalog; IsChild: Boolean; begin if Assigned(AParentCatalog) then begin for i := 0 to SCSCatalogs.Count - 1 do begin ChildCatalog := SCSCatalogs[i]; if Assigned(ChildCatalog) then begin IsChild := false; if AParentCatalog.ItemType = itProject then begin if ChildCatalog.ParentID = 0 then IsChild := true else if ChildCatalog.ParentID = AParentID then if ChildCatalog.ItemType in [itList, itDir] then IsChild := true; end else if ChildCatalog.ParentID = AParentID then IsChild := true; if IsChild then begin if ChildCatalog.ItemType = itProject then TSCSProject(ChildCatalog).Parent := AParentCatalog else if ChildCatalog.ItemType = itList then TSCSList(ChildCatalog).Parent := AParentCatalog else ChildCatalog.Parent := AParentCatalog; AParentCatalog.FChildCatalogs.Add(ChildCatalog); SCSCatalogs[i] := nil; ParseCatalogs(ChildCatalog, ChildCatalog.ID); end; end; end; AParentCatalog.ChildCatalogs.SortBySortID; end; end; begin (* CatalogPropertyList := TList.Create; SCSCatalogs := TSCSCatalogs.Create(false); with TF_Main(ActiveForm).DM do begin //*** Загрузить каталоги tSQL_Katalog.Filtered := false; if tSQL_Katalog.RecordCount > 0 then begin tSQL_Katalog.First; while Not tSQL_Katalog.Eof do begin SCSCatalog := nil; if tSQL_Katalog.FieldByName(fnIDItemType).AsInteger = itList then begin SCSCatalog := TSCSList.Create(FActiveForm); TSCSList(SCSCatalog).LoadFromMemTable(nil); end else begin SCSCatalog := TSCSCatalog.Create(FActiveForm); SCSCatalog.LoadFromMemTable(nil); end; if Assigned(SCSCatalog) then SCSCatalogs.Add(SCSCatalog); tSQL_Katalog.Next; end; end; //*** Загрузить свойства каталогов tSQL_CatalogPropRelation.Filtered := false; if tSQL_CatalogPropRelation.RecordCount > 0 then begin tSQL_CatalogPropRelation.First; while Not tSQL_CatalogPropRelation.Eof do begin ptrProperty := GetCatalogPropertyFromMemTable(false); CatalogPropertyList.Add(ptrProperty); tSQL_CatalogPropRelation.Next; end; end; //***** Parsing //*** Распарсить свойства каталогов for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; FindedForI := false; j := 0; while j <= CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[j]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; end; end; //*** Распарсит каталоги ParseCatalogs(Self, Self.ID); SCSCatalogs.Pack; { //*** Распарсить свойства каталогов for i := 0 to CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[i]; SCSCatalog := GetCatalogFromReferences(ptrProperty.IDMaster); if Assigned(SCSCatalog) then begin SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList[i] := nil; end; end; } //*** Открыть листы for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if Assigned(SCSList) then SCSList.OpenAsLoaded; end; //*** Нормы и ресурсы //for i := 0 to FChildCatalogReferences.Count - 1 do //begin // SCSCatalog := FChildCatalogReferences[i]; // if Assigned(SCSCatalog) then // SCSCatalog.NormsResources.LoadNorms(true, true); //end; end; SCSCatalogs.Free; FreeAndDisposeList(CatalogPropertyList); //16.10.2007 FreeList(CatalogPropertyList); *) end; { procedure TSCSProject.LoadSimpleCatalogsFromClasses; procedure LoadChildCatalogs(AParentCatalog: TSCSCatalog); var i: Integer; ChildCatalog: TSCSCatalog; begin for i := 0 to AParentCatalog.ChildCatalogs.Count - 1 do begin ChildCatalog := AParentCatalog.ChildCatalogs[i]; if AParentCatalog.ItemType = itProject then ChildCatalog.ParentID := 0 else ChildCatalog.ParentID := AParentCatalog.ID; if ChildCatalog.ItemType in [itSCSLine, itSCSConnector] then ChildCatalog.ListID := AParentCatalog.ListID; ChildCatalog.KolCompon := ChildCatalog.FSCSComponents.Count; ChildCatalog.PropsCount := ChildCatalog.Properties.Count; //*** сохранить в MemTable ChildCatalog.SaveToMemTable(meMake); //*** обработать внутренние каталоги LoadChildCatalogs(ChildCatalog); end; end; begin //*** сохраняет только папки в табл tSQL_Katalog try LoadChildCatalogs(Self); except on E: Exception do AddExceptionToLog('TSCSProject.LoadSimpleCatalogsFromClasses;: '+E.Message); end; end; } procedure TSCSProject.LoadComponentsFromMemTable; var //SCSList: TSCSList; //SCSCatalogs: TSCSCatalogs; Compons: TSCSComponents; SCSComponent, ChildComponent: TSCSComponent; SCSCatalog: TSCSCatalog; CatalogRelationList, CableCanalConnectorList, ComplectList, ConnectionList, CompPropertyList: TList; ptrCatalogRelation: PCatalogRelation; ptrCompRel: PComplect; ConnectedComponsInfo: TConnectedComponsInfo; ptrCableCanalConnector: PCableCanalConnector; //CatalogPropertyList: TList; ptrProperty: PProperty; InterfaceList: TSCSInterfaces; Interfac, InterfacInPortRel, PortInterf: TSCSInterface; PortInterfRels, PortInterfRelsLooked: TList; ptrPortInterfRel: PPortInterfRel; IOfIRelList: TList; //ptrIOfIRelExt: PIOfIRelExt; IOfIRel: TSCSIOfIRel; //OffsetDelta: Integer; FindedForI, FindedForJ: Boolean; i, j, k: Integer; ProcedureName: String; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin ProcedureName := 'TSCSProject.LoadComponentsFromMemTable'; (* OldTick := GetTickCount; Compons := TSCSComponents.Create(false); CatalogRelationList := TList.Create; ComplectList := Tlist.Create; ConnectionList := TList.Create; CableCanalConnectorList := Tlist.Create; CompPropertyList := TList.Create; InterfaceList := TSCSInterfaces.Create(false); IOfIRelList := TList.Create; PortInterfRels := TList.Create; PortInterfRelsLooked := TList.Create; with TF_Main(ActiveForm).DM do begin //*** Загрузить компоненты tSQL_Component.Filtered := false; if tSQL_Component.RecordCount > 0 then begin tSQL_Component.First; while Not tSQL_Component.Eof do begin SCSComponent := nil; SCSComponent := TSCSComponent.Create(FActiveForm); SCSComponent.LoadFromMemTable(nil); Compons.Add(SCSComponent); tSQL_Component.Next; end; end; //*** Связи с объектами tSQL_CatalogRelation.Filtered := false; if tSQL_CatalogRelation.RecordCount > 0 then begin tSQL_CatalogRelation.First; while Not tSQL_CatalogRelation.Eof do begin ptrCatalogRelation := GetCatalogRelationFromMemTable; CatalogRelationList.Add(ptrCatalogRelation); tSQL_CatalogRelation.Next; end; end; //*** Загрузить комплектующие и соединения tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.RecordCount > 0 then begin tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin ptrCompRel := GetCompRelFromMemTable; case ptrCompRel.ConnectType of cntComplect: ComplectList.Add(ptrCompRel); cntUnion: ConnectionList.Add(ptrCompRel); end; tSQL_ComponentRelation.Next; end; end; //*** Загрузить инфу о соединении FConnectedComponsList.Clear; tSQL_ConnectedComponents.Filtered := false; if tSQL_ConnectedComponents.RecordCount > 0 then begin tSQL_ConnectedComponents.First; while Not tSQL_ConnectedComponents.Eof do begin ConnectedComponsInfo := GetConnectedComponsInfoFromMemTable; FConnectedComponsList.Add(ConnectedComponsInfo); tSQL_ConnectedComponents.Next; end; end; //*** Загрузить элементы кабельных каналов tSQL_CableCanalConnectors.Filtered := false; if tSQL_CableCanalConnectors.RecordCount > 0 then begin tSQL_CableCanalConnectors.First; while Not tSQL_CableCanalConnectors.Eof do begin ptrCableCanalConnector := GetCableCanalConnectorFromMemTable; CableCanalConnectorList.Add(ptrCableCanalConnector); tSQL_CableCanalConnectors.Next; end; end; //*** Загрузка свойств компонент tSQL_CompPropRelation.Filtered := false; if tSQL_CompPropRelation.RecordCount > 0 then begin tSQL_CompPropRelation.First; while Not tSQL_CompPropRelation.Eof do begin ptrProperty := GetComponPropertyFromMemTable(false); CompPropertyList.Add(ptrProperty); tSQL_CompPropRelation.Next end; end; //*** Загрузить интерфейсы tSQL_InterfaceRelation.Filtered := false; if tSQL_InterfaceRelation.RecordCount > 0 then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin Interfac := TSCSInterface.Create(FActiveForm); Interfac.LoadFromMemTable; InterfaceList.Add(Interfac); tSQL_InterfaceRelation.Next; end; end; //*** Загрузить связи соединений интерфейсов tSQL_InterfOfInterfRelation.Filtered := false; if tSQL_InterfOfInterfRelation.RecordCount > 0 then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin IOfIRel := GetIOfIRelFromMemTable; IOfIRelList.Add(IOfIRel); tSQL_InterfOfInterfRelation.Next; end; end; //*** Загрузка связи интерфейсов и портов tSQL_PortInterfaceRelation.Filtered := false; if tSQL_PortInterfaceRelation.RecordCount > 0 then begin tSQL_PortInterfaceRelation.First; while Not tSQL_PortInterfaceRelation.Eof do begin ptrPortInterfRel := GetPortInterfRelFromMemTable; PortInterfRels.Add(ptrPortInterfRel); tSQL_PortInterfaceRelation.Next; end; end; end; //****** Parsing ****** // for i := 0 to Compons.Count - 1 do begin SCSComponent := Compons[i]; //*** Распарсить связи с комплектующими FindedForI := false; j := 0; while j <= ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); ComplectList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить соединения по компонентам FindedForI := false; j := 0; while j <= ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); ConnectionList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить элементы кабельных каналов FindedForI := false; j := 0; while j <= CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[j]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить свойства компонент FindedForI := false; j := 0; while j <= CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[j]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); CompPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсит интерфейсы FindedForI := false; j := 0; while j <= InterfaceList.Count - 1 do begin try Interfac := InterfaceList[j]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList.Delete(j); //*** Распарсить связи соединений интерфейов FindedForJ := false; k := 0; while k <= IOfIRelList.Count - 1 do begin try IOfIRel := TSCSIOfIRel(IOfIRelList[k]); if IOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; if Not Assigned(Interfac.IOfIRelOut) then Interfac.IOfIRelOut := TSCSObjectList.Create(true); //Tlist.Create; //GetMem(ptrIOfIRel, SizeOf(TIOfiRelExt)); //ptrIOfIRel^ := ptrIOfIRelExt.IOfIRel; IOfIRel.InterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(IOfIRel); //FreeMem(ptrIOfIRelExt); IOfIRelList.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить связи портов с интерфейоами FindedForJ := false; k := 0; PortInterf := Interfac; while k <= PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[k]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Add(ptrPortInterfRel); //InterfacInPortRel := nil; //InterfacInPortRel := SCSComponent.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); //if InterfacInPortRel = nil then // InterfacInPortRel := InterfaceList.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); //if InterfacInPortRel <> nil then // ptrPortInterfRel.Interf := InterfacInPortRel; PortInterfRels.Delete(k) end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** В связях портов с интерфейсами найти интерфейсы кот-е связ-е с портом for i := 0 to PortInterfRelsLooked.Count - 1 do begin ptrPortInterfRel := PortInterfRelsLooked[i]; if (ptrPortInterfRel.PortOwner <> nil) and (ptrPortInterfRel.PortOwner.ComponentOwner <> nil) then begin InterfacInPortRel := ptrPortInterfRel.PortOwner.ComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if InterfacInPortRel <> nil then ptrPortInterfRel.Interf := InterfacInPortRel; end; end; //*** Распарсить компоненты как комплектующие for i := 0 to Compons.Count - 1 do begin try SCSComponent := Compons[i]; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; ChildComponent := Compons.GetComponenByID(ptrCompRel.ID_Child); if ChildComponent <> nil then begin ChildComponent.IDCompRel := ptrCompRel.ID; SCSComponent.AddChildComponent(ChildComponent); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты по объектам for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; FindedForI := false; j := 0; while j <= CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[j]; if ptrCatalogRelation.IDCatalog = SCSCatalog.ID then begin FindedForI := true; k := 0; while k <= Compons.Count - 1 do begin SCSComponent := Compons[k]; if SCSComponent.ID = ptrCatalogRelation.IDComponent then begin SCSCatalog.AddComponentToList(SCSComponent); Compons.Delete(k); Break; ///// BREAK ///// end else Inc(k); end; CatalogRelationList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; { //*** Распарсить комплектующие for i := 0 to ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[i]; SCSComponent := Compons.GetComponenByID(ptrCompRel.ID_Component); ChildComponent := Compons.GetComponenByID(ptrCompRel.ID_Child); if ChildComponent <> nil then ChildComponent.IDCompRel := ptrCompRel.ID; if Assigned(SCSComponent) and Assigned(ChildComponent) then SCSComponent.AddChildComponent(ChildComponent); if Assigned(SCSComponent) then begin SCSComponent.FComplects.Add(ptrCompRel); ComplectList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты по объектам for i := 0 to CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[i]; SCSComponent := Compons.GetComponenByID(ptrCatalogRelation.IDComponent); SCSCatalog := GetCatalogFromReferences(ptrCatalogRelation.IDCatalog); if Assigned(SCSComponent) and Assigned(SCSCatalog) then SCSCatalog.AddComponentToList(SCSComponent); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить соединения for i := 0 to ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[i]; SCSComponent := GetComponentFromReferences(ptrCompRel.ID_Component); if Assigned(SCSComponent) then begin SCSComponent.FConnections.Add(ptrCompRel); ConnectionList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить элементы кабельных каналов for i := 0 to CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[i]; SCSComponent := GetComponentFromReferences(ptrCableCanalConnector.IDCableCanal); if Assigned(SCSComponent) then begin SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить свойства компонент for i := 0 to CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[i]; SCSComponent := GetComponentFromReferences(ptrProperty.IDMaster); if Assigned(SCSComponent) then begin SCSComponent.FProperties.Add(ptrProperty); CompPropertyList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсит интерфейсы for i := 0 to InterfaceList.Count - 1 do begin try Interfac := InterfaceList[i]; SCSComponent := GetComponentFromReferences(Interfac.ID_Component); if Assigned(SCSComponent) then begin SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить связи соединений интерфейов for i := 0 to IOfIRelExtList.Count - 1 do begin try ptrIOfIRelExt := IOfIRelExtList[i]; Interfac := GetInterfaceByListObjCompIDs(ptrIOfIRelExt.IDList, ptrIOfIRelExt.IDObject, ptrIOfIRelExt.IDComponent, ptrIOfIRelExt.IOfIRel.IDInterfRel); if Interfac = nil then Interfac := GetInterfaceByID(ptrIOfIRelExt.IOfIRel.IDInterfRel); if Interfac <> nil then begin if Not Assigned(Interfac.IOfIRelOut) then Interfac.IOfIRelOut := Tlist.Create; GetMem(ptrIOfIRel, SizeOf(TIOfiRelExt)); ptrIOfIRel^ := ptrIOfIRelExt.IOfIRel; ptrIOfIRel.InterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(ptrIOfIRel); FreeMem(ptrIOfIRelExt); IOfIRelExtList[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить связи портов с интерфейоами for i := 0 to PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[i]; PortInterf := GetInterfaceByID(ptrPortInterfRel.IDPort); if Assigned(PortInterf) then begin PortInterf.FPortInterfRels.Add(ptrPortInterfRel); SCSComponent := PortInterf.ComponentOwner; if Assigned(SCSComponent) then begin Interfac := SCSComponent.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if Assigned(Interfac) then begin ptrPortInterfRel.Interf := Interfac; PortInterf.AddInterfaceToPort(Interfac); end; end; PortInterfRels[i] := nil; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты как комплектующие i := 0; while i <= ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[i]; SCSComponent := Compons.GetComponenByID(ptrCompRel.ID_Component); ChildComponent := Compons.GetComponenByID(ptrCompRel.ID_Child); if ChildComponent <> nil then ChildComponent.IDCompRel := ptrCompRel.ID; if Assigned(SCSComponent) and Assigned(ChildComponent) then SCSComponent.AddChildComponent(ChildComponent); if Assigned(SCSComponent) then begin SCSComponent.FComplects.Add(ptrCompRel); ComplectList.Delete(i) end else Inc(i); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты по объектам for i := 0 to CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[i]; SCSComponent := Compons.GetComponenByID(ptrCatalogRelation.IDComponent); SCSCatalog := GetCatalogFromReferences(ptrCatalogRelation.IDCatalog); if Assigned(SCSComponent) and Assigned(SCSCatalog) then SCSCatalog.AddComponentToList(SCSComponent); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; } for i := 0 to FComponentReferences.Count - 1 do begin try SCSComponent := FComponentReferences[i]; SCSComponent.SortComplects; ////*** Нормы и ресурсы //if Assigned(SCSComponent) then // SCSComponent.NormsResources.LoadNorms(true, true); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Compons.Free; InterfaceList.Free; FreeList(CatalogRelationList); FreeList(ComplectList); FreeList(ConnectionList); FreeList(CableCanalConnectorList); FreeList(CompPropertyList); FreeList(IOfIRelList); FreeList(PortInterfRels); PortInterfRelsLooked.Free; *) end; { procedure TSCSProject.LoadSimpleComponentsFromClasses(ACatalogOwner: TSCSCatalog); var i: Integer; CurrCompon: TSCSComponent; procedure LoadStep(AComponent: TSCSComponent); var i: Integer; ChildComponent: TSCSComponent; begin AComponent.KolComplect := AComponent.FComplects.Count; AComponent.CableCanalConnectorsCnt := AComponent.FCableCanalConnector.Count; AComponent.InterfCount := AComponent.FInterfaces.Count; AComponent.JoinsCount := AComponent.FConnections.Count; AComponent.NormsCount := AComponent.FNormsResources.Norms.Count; AComponent.PropsCount := AComponent.FProperties.Count; AComponent.ResourcesCount := AComponent.FNormsResources.FResources.Count; AComponent.SaveToMemTable(meMake); for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildComponent := AComponent.ChildComplects[i]; LoadStep(ChildComponent); end; end; begin try for i := 0 to ACatalogOwner.SCSComponents.Count - 1 do begin CurrCompon := ACatalogOwner.SCSComponents[i]; CurrCompon.ObjectID := ACatalogOwner.ID; CurrCompon.ListID := ACatalogOwner.ListID; LoadStep(CurrCompon); end; except on E: Exception do AddExceptionToLog('TSCSProject.LoadSimpleComponentsFromClasses: '+E.Message); end; end; } procedure TSCSProject.LoadNormsResourcesFromMemTable; var NormsList: TSCSNorms; ResourceRelList: TSCSResources; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; i: Integer; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; begin {NormsList := TSCSNorms.Create(true); ResourceRelList := TSCSResources.Create(true); try with TF_Main(FActiveForm).DM do begin //*** Загрузить ресурсы tSQL_NormResourceRel.Filtered := false; tSQL_NormResourceRel.First; while Not tSQL_NormResourceRel.Eof do begin SCSResourceRel := TSCSResourceRel.Create(FActiveForm, ntProj); SCSResourceRel.LoadResourceRelFromMemTable; ResourceRelList.Add(SCSResourceRel); tSQL_NormResourceRel.Next; end; tSQL_Resources.Filtered := false; tSQL_Resources.First; while Not tSQL_Resources.Eof do begin //*** найти для тек. записи ранее подгруженный класс SCSResourceRel := nil; SCSResourceRel := ResourceRelList.GetResourceByIDResource(tSQL_Resources.FieldByName(fnID).AsInteger); if Assigned(SCSResourceRel) then SCSResourceRel.LoadResourceFromMemTable; tSQL_Resources.Next; end; //*** загрузить нормы tSQL_Norms.Filtered := false; tSQL_Norms.First; while Not tSQL_Norms.Eof do begin SCSNorm := TSCSNorm.Create(FActiveForm, ntProj); SCSNorm.LoadFromMemTable; NormsList.Add(SCSNorm); tSQL_Norms.Next; end; //*** Parsing //*** Распарсить ресурсы for i := 0 to ResourceRelList.Count - 1 do begin SCSResourceRel := ResourceRelList[i]; if Assigned(SCSResourceRel) then begin case SCSResourceRel.FMasterTableKind of ctkComponent: begin SCSComponent := GetComponentFromReferences(SCSResourceRel.IDMaster); if Assigned(SCSComponent) then begin SCSComponent.NormsResources.FResources.Add(SCSResourceRel); ResourceRelList[i] := nil; end; end; ctkNorm: begin SCSNorm := nil; SCSNorm := NormsList.GetNormByID(SCSResourceRel.IDMaster); if Assigned(SCSNorm) then begin SCSNorm.FResources.Add(SCSResourceRel); ResourceRelList[i] := nil; end; end; end; end; end; ResourceRelList.Pack; //*** Распарсить нормы for i := 0 to NormsList.Count - 1 do begin SCSNorm := NormsList[i]; if Assigned(SCSNorm) then case SCSNorm.FMasterTableKind of ctkComponent: begin SCSComponent := GetComponentFromReferences(SCSNorm.IDMaster); if Assigned(SCSComponent) then begin SCSComponent.NormsResources.FNorms.Add(SCSNorm); NormsList[i] := nil; end; end; ctkCatalog: begin SCSCatalog := GetCatalogFromReferences(SCSNorm.IDMaster); if Assigned(SCSCatalog) then begin SCSCatalog.NormsResources.FNorms.Add(SCSNorm); NormsList[i] := nil; end; end; end; end; NormsList.Pack; end; finally NormsList.Free; ResourceRelList.Free; end; } end; { procedure TSCSProject.LoadNormsResourcesFromClasses(ANormsResources: TSCSNormsResources; AIDMaster: Integer); var i, j: Integer; CurrNorm: TSCSNorm; CurrResourceRel: TSCSResourceRel; begin for i := 0 to ANormsResources.FNorms.Count - 1 do begin CurrNorm := ANormsResources.FNorms[i]; CurrNorm.IDMaster := AIDMaster; CurrNorm.SaveToMemTable(meMake); for j := 0 to CurrNorm.FResources.Count - 1 do begin CurrResourceRel := CurrNorm.FResources[j]; CurrResourceRel.IDMaster := CurrNorm.ID; CurrResourceRel.SaveToMemTable(meMake); end; end; for i := 0 to ANormsResources.FResources.Count - 1 do begin CurrResourceRel := ANormsResources.FResources[i]; CurrResourceRel.IDMaster := AIDMaster; CurrResourceRel.SaveToMemTable(meMake); end; end; } procedure TSCSProject.SendFromClassesToMemTables(AIsLightSaving: Boolean=false); {var i, j, k: Integer; CurrCatalog: TSCSCatalog; CurrCompon: TSCSComponent; ComponObject: TSCSCatalog; ComponList: TSCSList; ptrProperty: PProperty; ptrCompRel: PComplect; ptrCableCanalConnector: PCableCanalConnector; Interf: TSCSInterface; //IOfIRelExt: TIOfIRelExt; ptrIOfIRel: PIOfIRel; ptrPortInterfRel: PPortInterfRel; ConnectedComponsInfo: TConnectedComponsInfo; GuidProperties: TIDStringList; GuidComponentTypes: TIDStringList; GuidObjectIcons: TIDStringList; GuidProduces: TIDStringList; GuidSuppliesKinds: TIDStringList; GuidSuppliers: TIDStringList; GuidNetTypes: TIDStringList; GuidComponents: TIDStringList; GuidInterfaces: TIDStringList; ProcedureName: String; Old, Curr: Cardinal; function GetGUIDByID(AID: Integer; ADefGUID, ATableName: String; ALooked: TIDStringList): String; begin Result := ''; try if AID > 0 then begin Result := ALooked.GetStringByID(AID); if Result = '' then begin Result := TF_Main(FActiveForm).FNormBase.DM.GetStringFromTableByID(ATableName, fnGuid, AID, qmPhisical); if Result <> '' then ALooked.Add(AID, Result); end; end; if (Result = '') and (ADefGUID <> '') then Result := ADefGUID; except on E: Exception do AddExceptionToLog('TSCSProject.SendFromClassesToDatFile:GetGUIDByID: '+E.Message); end; end; } begin inherited SendFromClassesToMemTables(FConnectedComponsList, FObjectsBlobs, AIsLightSaving); { ProcedureName := 'TSCSProject.SendFromMemTablesToClasses'; //CloseAllTables; FMemBase.EmptyAllTables; //DeleteAllIndexes; FMemBase.UnSortingTables; FMemBase.OpenAllTables; Old := GetTickCount; //**** Насыпка из классов в МэмТаблы GuidProperties := TIDStringList.Create; GuidComponentTypes := TIDStringList.Create; GuidObjectIcons := TIDStringList.Create; GuidProduces := TIDStringList.Create; GuidSuppliesKinds := TIDStringList.Create; GuidSuppliers := TIDStringList.Create; GuidNetTypes := TIDStringList.Create; GuidComponents := TIDStringList.Create; GuidInterfaces := TIDStringList.Create; try //*** Насыпать справочники SendFromSpavochnikClassesToMemTables; //*** насыпает только папки LoadSimpleCatalogsFromClasses; //*** сохранить все содержимое папок (кроме папок) for i := 0 to FChildCatalogReferences.Count - 1 do begin try CurrCatalog := FChildCatalogReferences[i]; //if CurrCatalog is TSCSList then // TSCSList(CurrCatalog).SaveMarkMasks; //*** Свойства объекта for j := 0 to CurrCatalog.FProperties.Count - 1 do begin ptrProperty := CurrCatalog.FProperties[j]; ptrProperty.IDMaster := CurrCatalog.ID; ptrProperty.GUIDProperty := GetGUIDByID(ptrProperty.ID_Property, ptrProperty.GUIDProperty, tnProperties, GuidProperties); TF_Main(FActiveForm).DM.SaveCatalogPropertyToMemTable(meMake, ptrProperty); end; //*** Компоненты //*** Сохранить все (сами) компоненты тек-й папки for j := 0 to CurrCatalog.FComponentReferences.Count - 1 do begin CurrCompon := CurrCatalog.FComponentReferences[j]; CurrCompon.GUIDComponentType := GetGUIDByID(CurrCompon.ID_ComponentType, CurrCompon.GUIDComponentType, tnComponentTypes, GuidComponentTypes); CurrCompon.GUIDSymbol := GetGUIDByID(CurrCompon.IDSymbol, CurrCompon.GUIDSymbol, tnObjectIcons, GuidObjectIcons); CurrCompon.GUIDObjectIcon := GetGUIDByID(CurrCompon.IDObjectIcon, CurrCompon.GUIDObjectIcon, tnObjectIcons, GuidObjectIcons); CurrCompon.GUIDProducer := GetGUIDByID(CurrCompon.ID_Producer, CurrCompon.GUIDProducer, tnProducers, GuidProduces); CurrCompon.GUIDSuppliesKind := GetGUIDByID(CurrCompon.IDSuppliesKind, CurrCompon.GUIDSuppliesKind, tnSuppliesKinds, GuidSuppliesKinds); CurrCompon.GUIDSupplier := GetGUIDByID(CurrCompon.ID_SUPPLIER, CurrCompon.GUIDSupplier, tnSupplier, GuidSuppliers); CurrCompon.GUIDNetType := GetGUIDByID(CurrCompon.IDNetType, CurrCompon.GUIDNetType, tnNetType, GuidNetTypes); end; LoadSimpleComponentsFromClasses(CurrCatalog); //*** Связи папок с компонентами for j := 0 to CurrCatalog.SCSComponents.Count - 1 do begin CurrCompon := CurrCatalog.SCSComponents[j]; TF_Main(FActiveForm).DM.SaveCatalogRelation(meMake, CurrCatalog.ID, CurrCompon.ID); end; //*** нормы и ресурсы объекта LoadNormsResourcesFromClasses(CurrCatalog.NormsResources, CurrCatalog.ID); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** сохранить все содержимое компонент for i := 0 to FComponentReferences.Count - 1 do begin try CurrCompon := FComponentReferences[i]; //CurrCompon.GUIDComponentType := GetGUIDByID(CurrCompon.ID_ComponentType, CurrCompon.GUIDComponentType, tnComponentTypes, GuidComponentTypes); //CurrCompon.GUIDSymbol := GetGUIDByID(CurrCompon.IDSymbol, CurrCompon.GUIDSymbol, tnObjectIcons, GuidObjectIcons); //CurrCompon.GUIDObjectIcon := GetGUIDByID(CurrCompon.IDObjectIcon, CurrCompon.GUIDObjectIcon, tnObjectIcons, GuidObjectIcons); //CurrCompon.GUIDProducer := GetGUIDByID(CurrCompon.ID_Producer, CurrCompon.GUIDProducer, tnProducers, GuidProduces); //CurrCompon.GUIDSuppliesKind := GetGUIDByID(CurrCompon.IDSuppliesKind, CurrCompon.GUIDSuppliesKind, tnSuppliesKinds, GuidSuppliesKinds); //CurrCompon.GUIDSupplier := GetGUIDByID(CurrCompon.ID_SUPPLIER, CurrCompon.GUIDSupplier, tnSupplier, GuidSuppliers); //CurrCompon.GUIDNetType := GetGUIDByID(CurrCompon.IDNetType, CurrCompon.GUIDNetType, tnNetType, GuidNetTypes); //*** Связь с комплектующими for j := 0 to CurrCompon.FComplects.Count - 1 do begin ptrCompRel := CurrCompon.FComplects[j]; ptrCompRel.ID_Component := CurrCompon.ID; TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel); end; //*** Связь с подключенными компонентами for j := 0 to CurrCompon.FConnections.Count - 1 do begin ptrCompRel := CurrCompon.FConnections[j]; ptrCompRel.ID_Component := CurrCompon.ID; TF_Main(FActiveForm).DM.SaveCompRelToMemTable(meMake, ptrCompRel); end; //*** Элементы каб. каналов for j := 0 to CurrCompon.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := CurrCompon.FCableCanalConnector[j]; ptrCableCanalConnector.IDCableCanal := CurrCompon.ID; ptrCableCanalConnector.GuidNBConnector := GetGUIDByID(ptrCableCanalConnector.IDNBConnector, ptrCableCanalConnector.GuidNBConnector, tnComponent, GuidComponents); TF_Main(FActiveForm).DM.SaveCableCanalConnectorToMemTable(meMake, ptrCableCanalConnector); end; //*** Свойста for j := 0 to CurrCompon.FProperties.Count - 1 do begin ptrProperty := CurrCompon.FProperties[j]; ptrProperty.IDMaster := CurrCompon.ID; ptrProperty.GUIDProperty := GetGUIDByID(ptrProperty.ID_Property, ptrProperty.GUIDProperty, tnProperties, GuidProperties); ptrProperty.GUIDCrossProperty := GetGUIDByID(ptrProperty.IDCrossProperty, ptrProperty.GUIDCrossProperty, tnProperties, GuidProperties); TF_Main(FActiveForm).DM.SaveComponPropertyToMemTable(meMake, ptrProperty); end; //*** Интерфейсы/Порты for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin Interf := CurrCompon.FInterfaces[j]; Interf.ID_Component := CurrCompon.ID; Interf.GUIDInterface := GetGUIDByID(Interf.ID_Interface, Interf.GUIDInterface, tnInterface, GuidInterfaces); Interf.IOfIRelCount := Interf.FIOfIRelOut.Count; Interf.PortInterfRelCount := Interf.FPortInterfRels.Count; Interf.SaveToMemTable(meMake); end; //*** нормы и ресурсы компоненты LoadNormsResourcesFromClasses(CurrCompon.NormsResources, CurrCompon.ID); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Связи интерфейсов for i := 0 to FComponentReferences.Count - 1 do begin try CurrCompon := FComponentReferences[i]; ComponList := CurrCompon.GetListOwner; ComponObject := CurrCompon.GetFirstParentCatalog; for j := 0 to CurrCompon.FInterfaces.Count - 1 do begin Interf := CurrCompon.FInterfaces[j]; //*** Связь интерфейсов с интерфейсами других компонент for k := 0 to Interf.IOfIRelOut.Count - 1 do begin ptrIOfIRel := Interf.IOfIRelOut[k]; ptrIOfIRel.IDInterfRel := Interf.ID; TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, ptrIOfIRel); //ZeroMemory(@IOfIRelExt, SizeOf(TIOfIRelExt)); //IOfIRelExt.IOfIRel := ptrIOfIRel^; //if ComponList <> nil then // IOfIRelExt.IDList := ComponList.CurrID; //if ComponObject <> nil then // IOfIRelExt.IDObject := ComponObject.ID; //IOfIRelExt.IDComponent := CurrCompon.ID; //TF_Main(FActiveForm).DM.SaveIOfIRelToMemTable(meMake, IOfIRelExt); end; //*** Связь портов с интерфейсами for k := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := Interf.FPortInterfRels[k]; ptrPortInterfRel.IDPort := Interf.ID; TF_Main(FActiveForm).DM.SavePortInterfRelToMemTable(meMake, ptrPortInterfRel); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** информация о соединении компонент for i := 0 to FConnectedComponsList.Count - 1 do begin try ConnectedComponsInfo := FConnectedComponsList[i]; TF_Main(FActiveForm).DM.SaveConnectedComponsInfoToMemTable(meMake, ConnectedComponsInfo); except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; finally FMemBase.CloseAllTables; FreeAndNil(GuidProperties); FreeAndNil(GuidComponentTypes); FreeAndNil(GuidObjectIcons); FreeAndNil(GuidProduces); FreeAndNil(GuidSuppliesKinds); FreeAndNil(GuidSuppliers); FreeAndNil(GuidNetTypes); FreeAndNil(GuidComponents); FreeAndNil(GuidInterfaces); end; Curr := GetTickCount - Old; Curr := GetTickCount - Old; } end; (* procedure TSCSProject.SendFromSpavochnikClassesToMemTables; var CurrList: TSCSList; i: Integer; {CatalogsWithSpravochniks: TSCSCatalogs; CurrCatalog: TSCSCatalogExtended; ComponentType: TNBComponentType; CompTypePropRelation: TNBCompTypeProperty; Interf: TNBInterface; InterfaceNorm: TNBInterfaceNorm; i, j, k: Integer; } begin inherited; for i := 0 to FProjectLists.Count - 1 do begin CurrList := FProjectLists[i]; CurrList.SendFromSpavochnikClassesToMemTables; end; { CatalogsWithSpravochniks := TSCSCatalogs.Create(false); CatalogsWithSpravochniks.Add(Self); CatalogsWithSpravochniks.Assign(FProjectLists, laOr); for i := 0 to CatalogsWithSpravochniks.Count - 1 do begin CurrCatalog := TSCSCatalogExtended(CatalogsWithSpravochniks[i]); //*** Типы компонент со свойствами по - умолчанию for j := 0 to CurrCatalog.FSpravochnik.FNBComponentTypes.Count - 1 do begin ComponentType := TNBComponentType(CurrCatalog.FSpravochnik.FNBComponentTypes[j]); ComponentType.IDCatalog := CurrCatalog.ID; ComponentType.CatalogItemType := CurrCatalog.ItemType; ComponentType.PropsCount := ComponentType.FProperties.Count; ComponentType.SaveToMemTable(meMake); for k := 0 to ComponentType.FProperties.Count - 1 do begin CompTypePropRelation := TNBCompTypeProperty(ComponentType.FProperties[k]); CompTypePropRelation.GuidComponentType := ComponentType.ComponentType.GUID; CompTypePropRelation.PropertyData.IDMaster := ComponentType.ComponentType.ID; CompTypePropRelation.SaveToMemTable(meMake); end; end; //*** Инетрфейсы с указателями на нормы в НБ for j := 0 to CurrCatalog.FSpravochnik.FNBInterfaces.Count - 1 do begin Interf := TNBInterface(CurrCatalog.FSpravochnik.FNBInterfaces[j]); Interf.IDCatalog := CurrCatalog.ID; Interf.CatalogItemType := CurrCatalog.ItemType; Interf.InterfNormsCount := Interf.FInterfaceNorms.Count; Interf.SaveToMemTable(meMake); for k := 0 to Interf.FInterfaceNorms.Count - 1 do begin InterfaceNorm := TNBInterfaceNorm(Interf.FInterfaceNorms[k]); InterfaceNorm.GuidInterface := Interf.GUID; InterfaceNorm.IDInterface := Interf.ID; InterfaceNorm.SaveToMemTable(meMake); end; end; end; FreeAndNil(CatalogsWithSpravochniks);} end; *) function TSCSProject.SendFromClassesToDatFile(aSaveToBase: Boolean): Boolean; begin SendFromClassesToMemTables; if aSaveToBase then begin //*** Фильтр компонент SaveComponFilter; //*** Сохранить в InterBase Result := FMemBase.SaveAllTables; FMemBase.DeleteAllTables; end; end; procedure TSCSProject.SendFromMemTablesToClasses(AIsLightSaving: Boolean=false); var SCSList: TSCSList; i: Integer; {SCSCatalog: TSCSCatalog; SCSList: TSCSList; SCSCatalogs: TSCSCatalogs; Compons: TSCSComponents; SCSComponent: TSCSComponent; ChildComponent: TSCSComponent; CatalogRelationList: TList; ptrCatalogRelation: PCatalogRelation; ComplectList: TList; ConnectionList: TList; ptrCompRel: PComplect; ConnectedComponsInfo: TConnectedComponsInfo; CableCanalConnectorList: TList; ptrCableCanalConnector: PCableCanalConnector; CatalogPropertyList: TList; CompPropertyList: TList; ptrProperty: PProperty; InterfaceList: TSCSInterfaces; Interfac: TSCSInterface; InterfacInPortRel: TSCSInterface; PortInterfRels: TList; PortInterfRelsLooked: TList; ptrPortInterfRel: PPortInterfRel; PortInterf: TSCSInterface; IOfIRelList: TList; ptrIOfIRel: PIOfIRel; NormsList: TSCSNorms; ResourceRelList: TSCSResources; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; FindedForI: Boolean; FindedForJ: Boolean; i, j, k: Integer; ProcedureName: String; OldTick, CurrTick: Cardinal; procedure ParseCatalogs(AParentCatalog: TSCSCatalog; AParentID: Integer); var i: Integer; ChildCatalog: TSCSCatalog; IsChild: Boolean; begin if Assigned(AParentCatalog) then begin for i := 0 to SCSCatalogs.Count - 1 do begin ChildCatalog := SCSCatalogs[i]; if Assigned(ChildCatalog) then begin IsChild := false; if AParentCatalog.ItemType = itProject then begin if ChildCatalog.ParentID = 0 then IsChild := true else if ChildCatalog.ParentID = AParentID then if ChildCatalog.ItemType in [itList, itDir] then IsChild := true; end else if ChildCatalog.ParentID = AParentID then IsChild := true; if IsChild then begin if ChildCatalog.ItemType = itProject then TSCSProject(ChildCatalog).Parent := AParentCatalog else if ChildCatalog.ItemType = itList then TSCSList(ChildCatalog).Parent := AParentCatalog else ChildCatalog.Parent := AParentCatalog; AParentCatalog.FChildCatalogs.Add(ChildCatalog); SCSCatalogs[i] := nil; ParseCatalogs(ChildCatalog, ChildCatalog.ID); end; end; end; AParentCatalog.ChildCatalogs.SortBySortID; end; end; } begin inherited SendFromMemTablesToClasses(true, AIsLightSaving); //*** Открыть листы for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if Assigned(SCSList) then SCSList.OpenAsLoaded; end; {ProcedureName := 'TSCSProject.SendFromMemTablesToClasses'; OldTick := GetTickCount; SCSCatalogs := TSCSCatalogs.Create(false); CatalogPropertyList := TList.Create; Compons := TSCSComponents.Create(false); CatalogRelationList := TList.Create; ComplectList := Tlist.Create; ConnectionList := TList.Create; CableCanalConnectorList := Tlist.Create; CompPropertyList := TList.Create; InterfaceList := TSCSInterfaces.Create(false); IOfIRelList := TList.Create; PortInterfRels := TList.Create; PortInterfRelsLooked := TList.Create; NormsList := TSCSNorms.Create(true); ResourceRelList := TSCSResources.Create(true); with TF_Main(ActiveForm).DM do begin //*** Загрузить каталоги tSQL_Katalog.Filtered := false; if tSQL_Katalog.RecordCount > 0 then begin tSQL_Katalog.First; while Not tSQL_Katalog.Eof do begin SCSCatalog := nil; if tSQL_Katalog.FieldByName(fnIDItemType).AsInteger = itList then begin SCSCatalog := TSCSList.Create(FActiveForm); TSCSList(SCSCatalog).LoadFromMemTable; end else begin SCSCatalog := TSCSCatalog.Create(FActiveForm); SCSCatalog.LoadFromMemTable; end; if Assigned(SCSCatalog) then SCSCatalogs.Add(SCSCatalog); tSQL_Katalog.Next; end; end; //*** Загрузить свойства каталогов tSQL_CatalogPropRelation.Filtered := false; if tSQL_CatalogPropRelation.RecordCount > 0 then begin tSQL_CatalogPropRelation.First; while Not tSQL_CatalogPropRelation.Eof do begin ptrProperty := GetCatalogPropertyFromMemTable(false); CatalogPropertyList.Add(ptrProperty); tSQL_CatalogPropRelation.Next; end; end; //*** Загрузить компоненты tSQL_Component.Filtered := false; if tSQL_Component.RecordCount > 0 then begin tSQL_Component.First; while Not tSQL_Component.Eof do begin SCSComponent := nil; SCSComponent := TSCSComponent.Create(FActiveForm); SCSComponent.LoadFromMemTable; Compons.Add(SCSComponent); tSQL_Component.Next; end; end; //*** Связи с объектами tSQL_CatalogRelation.Filtered := false; if tSQL_CatalogRelation.RecordCount > 0 then begin tSQL_CatalogRelation.First; while Not tSQL_CatalogRelation.Eof do begin ptrCatalogRelation := GetCatalogRelationFromMemTable; CatalogRelationList.Add(ptrCatalogRelation); tSQL_CatalogRelation.Next; end; end; //*** Загрузить комплектующие и соединения tSQL_ComponentRelation.Filtered := false; if tSQL_ComponentRelation.RecordCount > 0 then begin tSQL_ComponentRelation.First; while Not tSQL_ComponentRelation.Eof do begin ptrCompRel := GetCompRelFromMemTable; case ptrCompRel.ConnectType of cntComplect: ComplectList.Add(ptrCompRel); cntUnion: ConnectionList.Add(ptrCompRel); end; tSQL_ComponentRelation.Next; end; end; //*** Загрузить инфу о соединении FConnectedComponsList.Clear; tSQL_ConnectedComponents.Filtered := false; if tSQL_ConnectedComponents.RecordCount > 0 then begin tSQL_ConnectedComponents.First; while Not tSQL_ConnectedComponents.Eof do begin ConnectedComponsInfo := GetConnectedComponsInfoFromMemTable; FConnectedComponsList.Add(ConnectedComponsInfo); tSQL_ConnectedComponents.Next; end; end; //*** Загрузить элементы кабельных каналов tSQL_CableCanalConnectors.Filtered := false; if tSQL_CableCanalConnectors.RecordCount > 0 then begin tSQL_CableCanalConnectors.First; while Not tSQL_CableCanalConnectors.Eof do begin ptrCableCanalConnector := GetCableCanalConnectorFromMemTable; CableCanalConnectorList.Add(ptrCableCanalConnector); tSQL_CableCanalConnectors.Next; end; end; //*** Загрузка свойств компонент tSQL_CompPropRelation.Filtered := false; if tSQL_CompPropRelation.RecordCount > 0 then begin tSQL_CompPropRelation.First; while Not tSQL_CompPropRelation.Eof do begin ptrProperty := GetComponPropertyFromMemTable(false); CompPropertyList.Add(ptrProperty); tSQL_CompPropRelation.Next end; end; //*** Загрузить интерфейсы tSQL_InterfaceRelation.Filtered := false; if tSQL_InterfaceRelation.RecordCount > 0 then begin tSQL_InterfaceRelation.First; while Not tSQL_InterfaceRelation.Eof do begin //Interfac := GetInterfRelFromMemTable; Interfac := TSCSInterface.Create(FActiveForm); Interfac.LoadFromMemTable; InterfaceList.Add(Interfac); tSQL_InterfaceRelation.Next; end; end; //*** Загрузить связи соединений интерфейсов tSQL_InterfOfInterfRelation.Filtered := false; if tSQL_InterfOfInterfRelation.RecordCount > 0 then begin tSQL_InterfOfInterfRelation.First; while Not tSQL_InterfOfInterfRelation.Eof do begin ptrIOfIRel := GetIOfIRelFromMemTable; IOfIRelList.Add(ptrIOfIRel); tSQL_InterfOfInterfRelation.Next; end; end; //*** Загрузка связи интерфейсов и портов tSQL_PortInterfaceRelation.Filtered := false; if tSQL_PortInterfaceRelation.RecordCount > 0 then begin tSQL_PortInterfaceRelation.First; while Not tSQL_PortInterfaceRelation.Eof do begin ptrPortInterfRel := GetPortInterfRelFromMemTable; PortInterfRels.Add(ptrPortInterfRel); tSQL_PortInterfaceRelation.Next; end; end; //*** Загрузить ресурсы tSQL_NormResourceRel.Filtered := false; if tSQL_NormResourceRel.RecordCount > 0 then begin tSQL_NormResourceRel.First; while Not tSQL_NormResourceRel.Eof do begin SCSResourceRel := TSCSResourceRel.Create(FActiveForm, ntProj); SCSResourceRel.LoadResourceRelFromMemTable; ResourceRelList.Add(SCSResourceRel); tSQL_NormResourceRel.Next; end; end; tSQL_Resources.Filtered := false; if tSQL_Resources.RecordCount > 0 then begin tSQL_Resources.First; while Not tSQL_Resources.Eof do begin //*** найти для тек. записи ранее подгруженный класс SCSResourceRel := nil; SCSResourceRel := ResourceRelList.GetResourceByIDResource(tSQL_Resources.FieldByName(fnID).AsInteger); if Assigned(SCSResourceRel) then SCSResourceRel.LoadResourceFromMemTable; tSQL_Resources.Next; end; end; //*** загрузить нормы tSQL_Norms.Filtered := false; if tSQL_Norms.RecordCount > 0 then begin tSQL_Norms.First; while Not tSQL_Norms.Eof do begin SCSNorm := TSCSNorm.Create(FActiveForm, ntProj); SCSNorm.LoadFromMemTable; NormsList.Add(SCSNorm); tSQL_Norms.Next; end; end; end; //****** Parsing ****** for i := 0 to SCSCatalogs.Count - 1 do begin SCSCatalog := SCSCatalogs[i]; //*** Распарсить свойства каталогов if (SCSCatalog.PropsCount > 0) or (SCSCatalog.PropsCount = -1) then begin try FindedForI := false; j := 0; while j <= CatalogPropertyList.Count - 1 do begin ptrProperty := CatalogPropertyList[j]; if ptrProperty.IDMaster = SCSCatalog.ID then begin FindedForI := true; SCSCatalog.Properties.Add(ptrProperty); CatalogPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсит подкаталоги по каталогам ParseCatalogs(Self, Self.ID); //*** Открыть листы for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if Assigned(SCSList) then SCSList.OpenAsLoaded; end; // for i := 0 to Compons.Count - 1 do begin SCSComponent := Compons[i]; //*** Распарсить связи с комплектующими if SCSComponent.KolComplect > 0 then begin FindedForI := false; j := 0; while j <= ComplectList.Count - 1 do begin try ptrCompRel := ComplectList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FComplects.Add(ptrCompRel); ComplectList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить соединения по компонентам if (SCSComponent.JoinsCount > 0) or (SCSComponent.JoinsCount = -1) then begin FindedForI := false; j := 0; while j <= ConnectionList.Count - 1 do begin try ptrCompRel := ConnectionList[j]; if ptrCompRel.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FConnections.Add(ptrCompRel); ConnectionList.Delete(j) end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить элементы кабельных каналов if (SCSComponent.CableCanalConnectorsCnt > 0) or (SCSComponent.CableCanalConnectorsCnt = -1) then begin FindedForI := false; j := 0; while j <= CableCanalConnectorList.Count - 1 do begin try ptrCableCanalConnector := CableCanalConnectorList[j]; if ptrCableCanalConnector.IDCableCanal = SCSComponent.ID then begin FindedForI := true; SCSComponent.FCableCanalConnector.Add(ptrCableCanalConnector); CableCanalConnectorList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить свойства компонент if (SCSComponent.PropsCount > 0) or (SCSComponent.PropsCount = -1) then begin FindedForI := false; j := 0; while j <= CompPropertyList.Count - 1 do begin try ptrProperty := CompPropertyList[j]; if ptrProperty.IDMaster = SCSComponent.ID then begin FindedForI := true; SCSComponent.FProperties.Add(ptrProperty); CompPropertyList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсит интерфейсы if (SCSComponent.InterfCount > 0) or (SCSComponent.InterfCount = -1) then begin FindedForI := false; j := 0; while j <= InterfaceList.Count - 1 do begin try Interfac := InterfaceList[j]; if Interfac.ID_Component = SCSComponent.ID then begin FindedForI := true; SCSComponent.FInterfaces.Add(Interfac); Interfac.ComponentOwner := SCSComponent; Interfac.IsLineCompon := SCSComponent.IsLine; InterfaceList.Delete(j); //*** Распарсить связи соединений интерфейов if (Interfac.IOfIRelCount > 0) or (Interfac.IOfIRelCount = -1) then begin FindedForJ := false; k := 0; while k <= IOfIRelList.Count - 1 do begin try ptrIOfIRel := IOfIRelList[k]; if ptrIOfIRel.IDInterfRel = Interfac.ID then begin FindedForJ := true; //if Not Assigned(Interfac.IOfIRelOut) then // Interfac.IOfIRelOut := Tlist.Create; ptrIOfIRel.InterfaceOwner := Interfac; Interfac.IOfIRelOut.Add(ptrIOfIRel); //FreeMem(ptrIOfIRelExt); IOfIRelList.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить связи портов с интерфейоами if (Interfac.PortInterfRelCount > 0) or (Interfac.PortInterfRelCount = -1) then begin FindedForJ := false; k := 0; PortInterf := Interfac; while k <= PortInterfRels.Count - 1 do begin try ptrPortInterfRel := PortInterfRels[k]; if ptrPortInterfRel.IDPort = PortInterf.ID then begin FindedForJ := true; ptrPortInterfRel.PortOwner := PortInterf; PortInterf.FPortInterfRels.Add(ptrPortInterfRel); PortInterfRelsLooked.Add(ptrPortInterfRel); PortInterfRels.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить нормы if (SCSComponent.NormsCount > 0) or (SCSComponent.NormsCount = -1) then begin FindedForI := false; j := 0; while j <= NormsList.Count - 1 do begin try SCSNorm := NormsList[j]; if (SCSNorm.FMasterTableKind = ctkComponent) and (SCSNorm.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FNorms.Add(SCSNorm); NormsList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; //*** Распарсить ресурсы if (SCSComponent.ResourcesCount > 0) or (SCSComponent.ResourcesCount = -1) then begin FindedForI := false; j := 0; while j <= ResourceRelList.Count - 1 do begin try SCSResourceRel := ResourceRelList[j]; if (SCSResourceRel.FMasterTableKind = ctkComponent) and (SCSResourceRel.IDMaster = SCSComponent.ID) then begin FindedForI := true; SCSComponent.NormsResources.FResources.Add(SCSResourceRel); ResourceRelList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end; //*** В связях портов с интерфейсами найти интерфейсы кот-е связ-е с портом for i := 0 to PortInterfRelsLooked.Count - 1 do begin try ptrPortInterfRel := PortInterfRelsLooked[i]; if (ptrPortInterfRel.PortOwner <> nil) and (ptrPortInterfRel.PortOwner.ComponentOwner <> nil) then begin InterfacInPortRel := ptrPortInterfRel.PortOwner.ComponentOwner.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); if InterfacInPortRel <> nil then begin ptrPortInterfRel.Interf := InterfacInPortRel; ptrPortInterfRel.PortOwner.AddInterfaceToPort(InterfacInPortRel); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты как комплектующие for i := 0 to Compons.Count - 1 do begin try SCSComponent := Compons[i]; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; ChildComponent := Compons.GetComponenByID(ptrCompRel.ID_Child); if ChildComponent <> nil then begin ChildComponent.IDCompRel := ptrCompRel.ID; SCSComponent.AddChildComponent(ChildComponent); end; end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Распарсить компоненты по объектам for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.KolCompon > 0 then begin FindedForI := false; j := 0; while j <= CatalogRelationList.Count - 1 do begin try ptrCatalogRelation := CatalogRelationList[j]; if ptrCatalogRelation.IDCatalog = SCSCatalog.ID then begin FindedForI := true; k := 0; while k <= Compons.Count - 1 do begin SCSComponent := Compons[k]; if SCSComponent.ID = ptrCatalogRelation.IDComponent then begin SCSCatalog.AddComponentToList(SCSComponent); Compons.Delete(k); Break; ///// BREAK ///// end else Inc(k); end; CatalogRelationList.Delete(j); end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end; OldTick := GetTickCount; //*** Справочникики Проекта и Листов SendFromMemTablesToSpravochnik; //*** Сортировка компонент в объектах for i := 0 to FChildCatalogReferences.Count - 1 do begin SCSCatalog := FChildCatalogReferences[i]; if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then SCSCatalog.SCSComponents.SortBySortID; end; //*** Сортировка комплектующих в компонентах for i := 0 to FComponentReferences.Count - 1 do begin try SCSComponent := FComponentReferences[i]; SCSComponent.LoadComponentType; SCSComponent.SortComplects; ////*** Нормы и ресурсы except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; UpdateValuesAfterLoadFromMemTablesToClasses; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; SCSCatalogs.Free; FreeList(CatalogPropertyList); Compons.Free; InterfaceList.Free; FreeList(CatalogRelationList); FreeList(ComplectList); FreeList(ConnectionList); FreeList(CableCanalConnectorList); FreeList(CompPropertyList); FreeList(IOfIRelList); FreeList(PortInterfRels); PortInterfRelsLooked.Free; NormsList.Free; ResourceRelList.Free; } end; { procedure TSCSProject.SendFromMemTablesToSpravochnik; var ComponentTypes: TSCSObjectList; CompTypePropRelations: TSCSObjectList; Interfaces: TSCSObjectList; InterfaceNorms: TSCSObjectList; ComponentType: TNBComponentType; CompTypePropRelation: TNBCompTypeProperty; Interf: TNBInterface; InterfaceNorm: TNBInterfaceNorm; CatalogOwners: TSCSCatalogs; CatalogOwner: TSCSCatalogExtended; i, j, k: Integer; FindedForI: Boolean; FindedForJ: Boolean; ProcedureName: String; begin ProcedureName := 'TSCSProject.SendFromMemTablesToSpravochnik'; ComponentTypes := TSCSObjectList.Create(false); CompTypePropRelations := TSCSObjectList.Create(false); Interfaces := TSCSObjectList.Create(false); InterfaceNorms := TSCSObjectList.Create(false); CatalogOwners := TSCSCatalogs.Create(false); CatalogOwners.Add(Self); CatalogOwners.Assign(FProjectLists, laOr); with TF_Main(FActiveForm).DM do begin if tSQL_ComponentTypes.Exists then begin tSQL_ComponentTypes.Filtered := false; if tSQL_ComponentTypes.RecordCount > 0 then begin tSQL_ComponentTypes.First; while Not tSQL_ComponentTypes.Eof do begin ComponentType := TNBComponentType.Create(FActiveForm); ComponentType.LoadFromMemTable; ComponentTypes.Add(ComponentType); tSQL_ComponentTypes.Next; end; end; end; if tSQL_CompTypePropRelation.Exists then begin tSQL_CompTypePropRelation.Filtered := false; if tSQL_CompTypePropRelation.RecordCount > 0 then begin tSQL_CompTypePropRelation.First; while Not tSQL_CompTypePropRelation.Eof do begin CompTypePropRelation := TNBCompTypeProperty.Create(FActiveForm); CompTypePropRelation.LoadFromMemTable; CompTypePropRelations.Add(CompTypePropRelation); tSQL_CompTypePropRelation.Next; end; end; end; if tSQL_Interface.Exists then begin tSQL_Interface.Filtered := false; if tSQL_Interface.RecordCount > 0 then begin tSQL_Interface.First; while Not tSQL_Interface.Eof do begin Interf := TNBInterface.Create(FActiveForm); Interf.LoadFromMemTable; Interfaces.Add(Interf); tSQL_Interface.Next; end; end; end; if tSQL_InterfaceNorms.Exists then begin tSQL_InterfaceNorms.Filtered := false; if tSQL_InterfaceNorms.RecordCount > 0 then begin tSQL_InterfaceNorms.First; while Not tSQL_InterfaceNorms.Eof do begin InterfaceNorm := TNBInterfaceNorm.Create(FActiveForm); InterfaceNorm.LoadFromMemTable; InterfaceNorms.Add(InterfaceNorm); tSQL_InterfaceNorms.Next; end; end; end; end; //***** PARSING for i := 0 to CatalogOwners.Count - 1 do begin CatalogOwner := TSCSCatalogExtended(CatalogOwners[i]); //*** Типы компонент FindedForI := false; j := 0; while j <= ComponentTypes.Count - 1 do begin try ComponentType := TNBComponentType(ComponentTypes[j]); if (ComponentType.IDCatalog = CatalogOwner.ID) and (ComponentType.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddComponentType(ComponentType); ComponentTypes.Delete(j); //*** Свойства для типа компоненты if ComponentType.PropsCount > 0 then begin FindedForJ := false; k := 0; while k <= CompTypePropRelations.Count - 1 do begin try CompTypePropRelation := TNBCompTypeProperty(CompTypePropRelations[k]); if CompTypePropRelation.GuidComponentType = ComponentType.ComponentType.GUID then begin FindedForJ := true; ComponentType.AddProperty(CompTypePropRelation); CompTypePropRelations.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; //*** Интерфейсы if CatalogOwner.ItemType = itProject then begin FindedForI := false; j := 0; while j <= Interfaces.Count - 1 do begin try Interf := TNBInterface(Interfaces[j]); if (Interf.IDCatalog = CatalogOwner.ID) and (Interf.CatalogItemType = CatalogOwner.ItemType) then begin FindedForI := true; CatalogOwner.FSpravochnik.AddInterface(Interf); Interfaces.Delete(j); if Interf.InterfNormsCount > 0 then begin FindedForJ := false; k := 0; while k <= InterfaceNorms.Count - 1 do begin try InterfaceNorm := TNBInterfaceNorm(InterfaceNorms[k]); if InterfaceNorm.GuidInterface = Interf.GUID then begin FindedForJ := true; Interf.AddInterfaceNorm(InterfaceNorm); InterfaceNorms.Delete(k); end else begin if FindedForJ then Break; ///// BREAK ///// Inc(k); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end else begin if FindedForI then Break; ///// BREAK ///// Inc(j); end; except on E: Exception do AddExceptionToLog(ProcedureName+': '+E.Message); end; end; end; end; for i := 0 to CatalogOwners.Count - 1 do begin CatalogOwner := TSCSCatalogExtended(CatalogOwners[i]); CatalogOwner.SynchonizeSpravochikWithMarkMasks(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik); if CatalogOwner.ItemType = itProject then CatalogOwner.SynchonizeSpravochikElements(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik, [cdInterfaces, cdComponentType]) else CatalogOwner.SynchonizeSpravochikElements(TF_Main(FActiveForm).FNormBase.GSCSBase.FNBSpravochnik, [cdComponentType]); end; FreeAndNil(ComponentTypes); FreeAndNil(CompTypePropRelations); FreeAndNil(Interfaces); FreeAndNil(InterfaceNorms); FreeAndNil(CatalogOwners); end;} procedure TSCSProject.SendFromDatFileToClasses; begin try //*** Открыть мемтаблы для чтения FMemBase.CloseAllTables; FMemBase.DeleteAllTables; FMemBase.LoadAllTables; FMemBase.OpenAllTables; UpdateValues; with TF_Main(FActiveForm).DM do begin //if (FGenerators.LastGen_KatalogID = 0) and // (FGenerators.LastGen_KatalogSCSID = 0) then //begin // tSQL_Katalog.Append; // tSQL_Katalog.Post; // FGenerators.LastGen_KatalogID := tSQL_Katalog.FieldByName(fnID).AsInteger; // FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; // tSQL_Katalog.Delete; //end; if FGenerators.LastGen_KatalogID = 0 then FGenerators.LastGen_KatalogID := GetLastIDFromSQLMemTable(tSQL_Katalog, fnID); if FGenerators.LastGen_KatalogSCSID = 0 then FGenerators.LastGen_KatalogSCSID := GetLastIDFromSQLMemTable(tSQL_Katalog, fnSCSID); //if FGenerators.LastGen_KatalogSCSID = 0 then //begin // tSQL_Katalog.Append; // tSQL_Katalog.Post; // FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; // tSQL_Katalog.Delete; //end; //if FGenerators.LastGen_CatalogRelationID = 0 then // FGenerators.LastGen_CatalogRelationID := GetLastIDFromSQLMemTable(tSQL_CatalogRelation, fnID); if FGenerators.LastGen_ComponentID = 0 then FGenerators.LastGen_ComponentID := GetLastIDFromSQLMemTable(tSQL_Component, fnID); if FGenerators.LastGen_CatalogPropRelationID = 0 then FGenerators.LastGen_CatalogPropRelationID := GetLastIDFromSQLMemTable(tSQL_CatalogPropRelation, fnID); if FGenerators.LastGen_ComponentRelationID = 0 then FGenerators.LastGen_ComponentRelationID := GetLastIDFromSQLMemTable(tSQL_ComponentRelation, fnID); if FGenerators.LastGen_CompPropRelationID = 0 then FGenerators.LastGen_CompPropRelationID := GetLastIDFromSQLMemTable(tSQL_CompPropRelation, fnID); if FGenerators.LastGen_CableCanalConnectorsID = 0 then FGenerators.LastGen_CableCanalConnectorsID := GetLastIDFromSQLMemTable(tSQL_CableCanalConnectors, fnID); if FGenerators.LastGen_ConnectedComponentsID = 0 then FGenerators.LastGen_ConnectedComponentsID := GetLastIDFromSQLMemTable(tSQL_ConnectedComponents, fnID); if FGenerators.LastGen_InterfaceRelationID = 0 then FGenerators.LastGen_InterfaceRelationID := GetLastIDFromSQLMemTable(tSQL_InterfaceRelation, fnID); if FGenerators.LastGen_InterfOfInterfRelationID = 0 then FGenerators.LastGen_InterfOfInterfRelationID := GetLastIDFromSQLMemTable(tSQL_InterfOfInterfRelation, fnID); if FGenerators.LastGen_PortInterfaceRelationID = 0 then FGenerators.LastGen_PortInterfaceRelationID := GetLastIDFromSQLMemTable(tSQL_PortInterfaceRelation, fnID); if FGenerators.LastGen_NormsID = 0 then FGenerators.LastGen_NormsID := GetLastIDFromSQLMemTable(tSQL_Norms, fnID); if FGenerators.LastGen_NormResourceRelID = 0 then FGenerators.LastGen_NormResourceRelID := GetLastIDFromSQLMemTable(tSQL_NormResourceRel, fnID); if FGenerators.LastGen_ResourcesID = 0 then FGenerators.LastGen_ResourcesID := GetLastIDFromSQLMemTable(tSQL_Resources, fnID); if FGenerators.LastGen_CADNormStructID = 0 then FGenerators.LastGen_CADNormStructID := GetLastIDFromSQLMemTable(tSQL_CADNormStruct, fnID); if FGenerators.LastGen_CADNormColumnID = 0 then FGenerators.LastGen_CADNormColumnID := GetLastIDFromSQLMemTable(tSQL_CADNormColumn, fnID); if FGenerators.LastGen_StringID = 0 then FGenerators.LastGen_StringID := GetLastIDFromSQLMemTable(tSQL_StringsMan, fnID); if FGenerators.LastGen_FilterInfoID = 0 then FGenerators.LastGen_FilterInfoID := GetLastIDFromSQLMemTable(tSQL_Filters, fnID); end; try UpdateAfterOpenFromFileStream; FComponentReferences.Clear; FChildCatalogReferences.Clear; //*** Насыпать в классы SendFromMemTablesToClasses; //*** Фильтр компонент LoadComponFilter; //LoadCatalogsFromMemTable; //LoadComponentsFromMemTable; //LoadNormsResourcesFromMemTable; //LoadPropertyNames; //LoadMarkMasks; //*** освободить память FMemBase.CloseAllTables; FMemBase.DeleteAllTables; if FGenerators.LastGen_ComponentWholeID = 0 then FGenerators.LastGen_ComponentWholeID := FComponentReferences.GetMaxWholeID; ////*** Установить соединения //Self.SetComponentsJoining; //Self.SetComponInterfacesForComlects; //*** Найти последний лист даного проекта if FIDLastList > 0 then CurrList := GetListBySCSID(FIDLastList); if Not Assigned(CurrList) then if FProjectLists.Count > 0 then CurrList := FProjectLists[0]; finally FIDFromOpened := 0; end; except on E: Exception do AddExceptionToLogEx('TSCSProject.SendFromDatFileToClasses', E.Message); end; end; procedure TSCSProject.SaveListsToFileFromNoSaved; var i: Integer; ListIDToSave: Integer; PathToSave: String; SCSList: TSCSList; begin try for i := 0 to FNoSaveListsToFiles.Count - 1 do begin ListIDToSave := FNoSaveListsToFiles.GetIDByIndex(i); PathToSave := FNoSaveListsToFiles.GetStringByIndex(i); SCSList := GetListByID(ListIDToSave); if SCSList <> nil then SCSList.SaveToStreamOrFile(nil, PathToSave); end; except on E: Exception do AddExceptionToLogEx('TSCSProject.SaveListsToFileFromNoSaved', E.Message); end; FNoSaveListsToFiles.Clear; end; (* procedure TSCSProject.CreateAllTables; begin with TF_Main(ActiveForm).DM do begin //qSQLMQuery.GetCurrentRecordID. qSQL_QueryTSCSOperat.Close; qSQL_QueryTSCSOperat.SQL.Text := 'CREATE TABLE KATALOG (ID Autoinc, '+ ' PARENT_ID INTEGER, '+ //' PROJECT_ID INTEGER, '+ ' LIST_ID INTEGER, '+ ' NAME VARCHAR(255), '+ ' NAME_SHORT VARCHAR(200), '+ ' NAME_MARK VARCHAR(200), '+ ' ISUSER_NAME INTEGER, '+ ' SORT_ID INTEGER DEFAULT 0, '+ ' KOL_COMPON INTEGER DEFAULT 0, '+ ' ITEMS_COUNT INTEGER DEFAULT 0, '+ ' PROPS_COUNT INTEGER DEFAULT 0, '+ ' ID_ITEM_TYPE INTEGER, '+ ' MARK_ID INTEGER, '+ ' SCS_ID AUTOINC, '+ ' INDEX_CONN INTEGER DEFAULT 0, '+ ' INDEX_LINE INTEGER DEFAULT 0, '+ ' INDEX_JOINER INTEGER DEFAULT 0, '+ ' SETTINGS BLOB, '+ ' COMPTYPE_MARK_MASKS BLOB,'+ ' CAD_BLOCK BLOB,'+ ' PM_BLOCK BLOB ); '+ // ' ALTER TABLE KATALOG ADD PRIMARY KEY PK_KATALOG (ID); '+ // ' CREATE INDEX KATALOG_IDX1 ON KATALOG (PARENT_ID); '+ // ' CREATE INDEX KATALOG_IDX2 ON KATALOG (SCS_ID); '+ // ' CREATE INDEX KATALOG_IDX3 ON KATALOG (SORT_ID); '+ // //' CREATE INDEX KATALOG_IDX4 ON KATALOG (PROJECT_ID); '+ // ' CREATE INDEX KATALOG_IDX5 ON KATALOG (MARK_ID); '+ // ' CREATE INDEX KATALOG_IDX6 ON KATALOG (LIST_ID); '+ { ' CREATE TABLE CATALOG_MARK_MASK ( '+ ' ID AUTOINC, '+ ' ID_CATALOG INTEGER, '+ ' ID_COMPONENT_TYPE INTEGER, '+ ' MARK_MASK VARCHAR(200) ); '+ // ' ALTER TABLE CATALOG_MARK_MASK ADD PRIMARY KEY PK_CATALOG_MARK_MASK (ID); '+ // ' CREATE INDEX CATALOG_MARK_MASK_IDX1 ON CATALOG_MARK_MASK (ID_COMPONENT_TYPE); '+ } ' CREATE TABLE CATALOG_PROP_RELATION ( '+ ' ID AUTOINC, '+ ' ID_CATALOG INTEGER, '+ ' ID_PROPERTY INTEGER, '+ ' GUID_PROPERTY VARCHAR(40), '+ ' PVALUE VARCHAR(255), '+ ' ISDEFAULT INTEGER, '+ ' SORT_ID INTEGER ); '+ // ' ALTER TABLE CATALOG_PROP_RELATION ADD PRIMARY KEY PK_CATALOG_PROP_RELATION (ID); '+ // ' CREATE INDEX CATALOG_PROP_RELATION_IDX1 ON CATALOG_PROP_RELATION (ID_PROPERTY); '+ ' CREATE TABLE CATALOG_RELATION ( '+ ' ID_CATALOG INTEGER, '+ ' ID_COMPONENT INTEGER); '+ ' CREATE TABLE COMPONENT ( '+ ' ID AUTOINC, '+ ' GUID_NB VARCHAR(40), '+ ' NAME VARCHAR(255), '+ ' NAME_SHORT VARCHAR(200), '+ ' NAME_MARK VARCHAR(200), '+ ' MARK_ID INTEGER, '+ ' MARK_Str VARCHAR(200), '+ ' CYPHER VARCHAR(200), '+ ' IZM VARCHAR(200), '+ ' NOTICE VARCHAR(255), '+ ' DESCRIPTION BLOB, '+ ' ISUSER_MARK INTEGER DEFAULT 0, '+ ' PICTURE BLOB, '+ ' COLOR INTEGER, '+ ' ISLINE SMALLINT DEFAULT 1, '+ ' ISCOMPLECT SMALLINT DEFAULT 1, '+ ' PRICE_SUPPLY FLOAT DEFAULT 0, '+ ' PRICE FLOAT DEFAULT 0, '+ ' PRICE_CALC FLOAT DEFAULT 0, '+ ' USER_LENGTH FLOAT DEFAULT 0, '+ ' MAX_LENGTH FLOAT, '+ ' HASNDS SMALLINT DEFAULT 1, '+ ' ID_COMPONENT_TYPE INTEGER, '+ ' ID_SYMBOL INTEGER, '+ ' ID_OBJECT_ICON INTEGER, '+ ' ID_PRODUCER INTEGER, '+ ' ID_SUPPLIES_KIND INTEGER, '+ ' ID_SUPPLIER INTEGER, '+ ' ID_NET_TYPE INTEGER, '+ ' GUID_COMPONENT_TYPE VARCHAR(40), '+ ' GUID_SYMBOL VARCHAR(40), '+ ' GUID_OBJECT_ICON VARCHAR(40), '+ ' GUID_PRODUCER VARCHAR(40), '+ ' GUID_SUPPLIES_KIND VARCHAR(40), '+ ' GUID_SUPPLIER VARCHAR(40), '+ ' GUID_NET_TYPE VARCHAR(40), '+ ' OBJECT_ICON_STEP FLOAT DEFAULT 0, '+ ' ID_CURRENCY INTEGER, '+ ' ARTICUL_DISTRIBUTOR VARCHAR(255), '+ ' ARTICUL_PRODUCER VARCHAR(255), '+ ' SORT_ID INTEGER DEFAULT 0, '+ ' WHOLE_ID INTEGER DEFAULT 0 NOT NULL, '+ ' KOL_COMPLECT INTEGER DEFAULT 0, '+ ' CABLE_CANAL_CONNECTORS_CNT INTEGER DEFAULT 0, '+ ' INTERF_COUNT INTEGER DEFAULT 0, '+ ' JOINS_COUNT INTEGER DEFAULT 0, '+ ' NORMS_COUNT INTEGER DEFAULT 0, '+ ' PROPS_COUNT INTEGER DEFAULT 0, '+ ' RESOURCES_COUNT INTEGER DEFAULT 0, '+ ' ID_NORMBASE INTEGER, '+ ' OBJECT_ID INTEGER, '+ ' LIST_ID INTEGER DEFAULT 0); '+ //' PROJECT_ID INTEGER ); '+ // ' ALTER TABLE COMPONENT ADD PRIMARY KEY PK_COMPONENT (ID); '+ // ' CREATE INDEX COMPONENT_IDX1 ON COMPONENT (SORT_ID); '+ // ' CREATE INDEX COMPONENT_IDX10 ON COMPONENT (LIST_ID); '+ // ' CREATE INDEX COMPONENT_IDX11 ON COMPONENT (OBJECT_ID); '+ // ' CREATE INDEX COMPONENT_IDX2 ON COMPONENT (ID_NORMBASE); '+ // ' CREATE INDEX COMPONENT_IDX3 ON COMPONENT (ISLINE); '+ // ' CREATE INDEX COMPONENT_IDX4 ON COMPONENT (ISCOMPLECT); '+ // ' CREATE INDEX COMPONENT_IDX5 ON COMPONENT (MARK_ID); '+ // //' CREATE INDEX COMPONENT_IDX6 ON COMPONENT (ID_NORMBASE, PROJECT_ID); '+ // ' CREATE INDEX COMPONENT_IDX7 ON COMPONENT (ID_COMPONENT_TYPE); '+ // ' CREATE INDEX COMPONENT_IDX8 ON COMPONENT (WHOLE_ID); '+ // //' CREATE INDEX COMPONENT_IDX9 ON COMPONENT (PROJECT_ID); '+ ' CREATE TABLE COMPONENT_RELATION ( '+ ' ID AUTOINC, '+ ' ID_COMPONENT INTEGER, '+ ' ID_CHILD INTEGER, '+ ' KOLVO INTEGER, '+ ' SORT_ID INTEGER, '+ ' CONNECT_TYPE INTEGER ); '+ // ' ALTER TABLE COMPONENT_RELATION ADD PRIMARY KEY PK_COMPONENT_RELATION (ID); '+ // ' CREATE INDEX COMPONENT_RELATION_IDX1 ON COMPONENT_RELATION (ID_CHILD); '+ // ' CREATE INDEX COMPONENT_RELATION_IDX2 ON COMPONENT_RELATION (SORT_ID); '+ // ' CREATE INDEX COMPONENT_RELATION_IDX3 ON COMPONENT_RELATION (CONNECT_TYPE, ID_COMPONENT, ID_CHILD); '+ ' CREATE TABLE COMP_PROP_RELATION ( '+ ' ID AUTOINC, '+ ' ID_COMPONENT INTEGER, '+ ' ID_PROPERTY INTEGER, '+ ' GUID_PROPERTY VARCHAR(40), '+ ' PVALUE VARCHAR(255), '+ ' ISDEFAULT INTEGER, '+ ' SORT_ID INTEGER, '+ ' TAKE_INTO_JOIN INTEGER DEFAULT 0, '+ ' TAKE_INTO_CONNECT INTEGER DEFAULT 0, '+ ' ISTAKE_JOIN_FOR_POINTS INTEGER DEFAULT 0, '+ ' ISCROSS_CONTROL INTEGER DEFAULT 0, '+ ' ID_CROSS_PROPERTY INTEGER DEFAULT 0, '+ ' GUID_CROSS_PROPERTY VARCHAR(40)); '+ // ' ALTER TABLE COMP_PROP_RELATION ADD PRIMARY KEY PK_COMP_PROP_RELATION (ID); '+ // ' CREATE INDEX COMP_PROP_RELATION_IDX1 ON COMP_PROP_RELATION (ID_PROPERTY); '+ ' CREATE TABLE CABLE_CANAL_CONNECTORS ( '+ ' ID AUTOINC, '+ ' ID_COMPONENT INTEGER, '+ ' ID_NB_CONNECTOR INTEGER, '+ ' GUID_NB_CONNECTOR VARCHAR(40), '+ ' CONNECTOR_TYPE INTEGER); '+ // ' ALTER TABLE CABLE_CANAL_CONNECTORS ADD PRIMARY KEY PK_CABLE_CANAL_CONNECTORS (ID); '+ ' CREATE TABLE CONNECTED_COMPONENTS ( '+ ' ID AUTOINC, '+ ' COMPON_WHOLE_ID INTEGER DEFAULT 0, '+ ' ID_CONNECT_OBJECT INTEGER DEFAULT 0, '+ ' ID_CONNECT_COMPON INTEGER, '+ ' ID_SIDE_COMPON INTEGER, '+ ' TYPE_CONNECT INTEGER ); '+ // ' ALTER TABLE CONNECTED_COMPONENTS ADD PRIMARY KEY PK_CONNECTED_COMPONENTS (ID); '+ // ' CREATE INDEX CONNECTED_COMPONENTS_IDX1 ON CONNECTED_COMPONENTS (COMPON_WHOLE_ID); '+ // ' CREATE INDEX CONNECTED_COMPONENTS_IDX2 ON CONNECTED_COMPONENTS (COMPON_WHOLE_ID, TYPE_CONNECT); '+ ' CREATE TABLE INTERFACE_RELATION ( '+ ' ID AUTOINC, '+ ' ID_COMPONENT INTEGER, '+ ' ID_INTERFACE INTEGER, '+ ' GUID_INTERFACE VARCHAR(40), '+ ' NPP INTEGER DEFAULT 0, '+ ' TYPEI SMALLINT DEFAULT 1, '+ ' KIND INTEGER, '+ ' ISPORT INTEGER DEFAULT 0, '+ ' ISUSER_PORT INTEGER DEFAULT 0, '+ ' NPP_PORT INTEGER, '+ ' ID_CONNECTED INTEGER DEFAULT 0, '+ ' GENDER INTEGER DEFAULT 0, '+ ' MULTIPLE INTEGER DEFAULT 0, '+ ' ISBUSY INTEGER, '+ ' VALUEI FLOAT, '+ ' COORDZ FLOAT DEFAULT 0, '+ ' SORT_ID INTEGER DEFAULT 0, '+ ' NUM_PAIR INTEGER DEFAULT 0, '+ ' COLOR INTEGER DEFAULT 0, '+ ' ID_ADVERSE INTEGER, '+ ' SIDE INTEGER, '+ ' NOTICE VARCHAR(255), '+ ' IOFI_REL_COUNT INTEGER DEFAULT 0, '+ ' PORT_INTERF_REL_COUNT INTEGER DEFAULT 0); '+ // ' ALTER TABLE INTERFACE_RELATION ADD PRIMARY KEY PK_INTERFACE_RELATION (ID); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX1 ON INTERFACE_RELATION (ID_INTERFACE); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX2 ON INTERFACE_RELATION (ISBUSY); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX3 ON INTERFACE_RELATION (MULTIPLE); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX4 ON INTERFACE_RELATION (GENDER); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX5 ON INTERFACE_RELATION (TYPEI); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX6 ON INTERFACE_RELATION (NUM_PAIR); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX7 ON INTERFACE_RELATION (ID_ADVERSE); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX8 ON INTERFACE_RELATION (SIDE); '+ // ' CREATE INDEX INTERFACE_RELATION_IDX9 ON INTERFACE_RELATION (ID_CONNECTED); '+ ' CREATE TABLE INTERFOFINTERF_RELATION ( '+ ' ID AUTOINC, '+ ' ID_INTERF_REL INTEGER, '+ ' ID_INTERF_TO INTEGER, '+ ' ID_COMP_REL INTEGER, '+ ' CON_POSITION INTEGER, '+ ' CONNECT_KIND INTEGER ); '+ // ' ALTER TABLE INTERFOFINTERF_RELATION ADD PRIMARY KEY PK_INTERFOFINTERF_RELATION (ID); '+ // ' CREATE INDEX INTERFOFINTERF_RELATION_IDX1 ON INTERFOFINTERF_RELATION (ID_INTERF_TO); '+ // ' CREATE INDEX INTERFOFINTERF_RELATION_IDX2 ON INTERFOFINTERF_RELATION (ID_COMP_REL); '+ // ' CREATE INDEX INTERFOFINTERF_RELATION_IDX3 ON INTERFOFINTERF_RELATION (ID_INTERF_REL, ID_INTERF_TO, ID_COMP_REL); '+ ' CREATE TABLE NORMS ( '+ ' ID AUTOINC, '+ ' ID_NB INTEGER, '+ ' GUID_NB VARCHAR(40), '+ ' ID_MASTER INTEGER, '+ ' TABLE_KIND INTEGER, '+ ' NPP INTEGER, '+ ' ISON INTEGER DEFAULT 1, '+ ' KOLVO FLOAT DEFAULT 1, '+ ' TOTAL_COST FLOAT, '+ ' CYPHER VARCHAR(255), '+ ' NAME VARCHAR(255), '+ ' WORK_KIND VARCHAR(255), '+ ' IZM VARCHAR(255), '+ ' ZARPLAT FLOAT, '+ ' COST FLOAT, '+ ' ISFROM_INTERFACE INTEGER, '+ fnExpenseForLength + ' FLOAT); '+ // ' ALTER TABLE NORMS ADD PRIMARY KEY PK_NORMS (ID); '+ // ' CREATE INDEX NORMS_IDX1 ON NORMS (NPP); '+ // ' CREATE INDEX NORMS_IDX2 ON NORMS (ISON); '+ // ' CREATE INDEX NORMS_IDX3 ON NORMS (ID_MASTER, TABLE_KIND); '+ ' CREATE TABLE NORM_RESOURCE_REL ( '+ ' ID AUTOINC, '+ ' ID_MASTER INTEGER, '+ ' TABLE_KIND INTEGER DEFAULT 0, '+ ' NPP INTEGER, '+ ' ID_RESOURCE INTEGER, '+ ' KOLVO FLOAT, '+ ' ISON INTEGER DEFAULT 1, '+ ' COST FLOAT, '+ ' RVALUE FLOAT, '+ fnExpenseForLength + ' FLOAT); '+ // ' ALTER TABLE NORM_RESOURCE_REL ADD PRIMARY KEY PK_NORM_RESOURCE_REL (ID); '+ // ' CREATE INDEX NORM_RESOURCE_REL_IDX1 ON NORM_RESOURCE_REL (ID_MASTER, ID_RESOURCE); '+ // ' CREATE INDEX NORM_RESOURCE_REL_IDX2 ON NORM_RESOURCE_REL (ISON); '+ ' CREATE TABLE RESOURCES ( '+ ' ID AUTOINC, '+ ' ID_NB INTEGER DEFAULT 0, '+ ' GUID_NB VARCHAR(40), '+ ' TABLE_KIND_NB INTEGER DEFAULT 0, '+ ' CYPHER VARCHAR(255), '+ ' NAME VARCHAR(255), '+ ' IZM VARCHAR(255), '+ ' PRICE FLOAT, '+ ' ADDITIONAL_PRICE FLOAT, '+ ' RTYPE INTEGER ); '+ // ' ALTER TABLE RESOURCES ADD PRIMARY KEY PK_RESOURCES (ID); '+ // ' CREATE INDEX RESOURCES_IDX1 ON RESOURCES (RTYPE); '+ { //****** Вторичные ключи ****** ' ALTER TABLE CATALOG_MARK_MASK ADD FOREIGN KEY FK_CATALOG_MARK_MASK (ID_CATALOG) REFERENCES KATALOG MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE CATALOG_PROP_RELATION ADD FOREIGN KEY FK_CATALOG_PROP_RELATION (ID_CATALOG) REFERENCES KATALOG MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE CATALOG_RELATION ADD FOREIGN KEY FK_CAT_REL (ID_CATALOG) REFERENCES KATALOG MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE COMPONENT_RELATION ADD FOREIGN KEY FK_COMPONENT_RELATION (ID_COMPONENT) REFERENCES COMPONENT MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE COMP_PROP_RELATION ADD FOREIGN KEY FK_COMP_PROP_RELATION (ID_COMPONENT) REFERENCES COMPONENT MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE CABLE_CANAL_CONNECTORS ADD FOREIGN KEY FK_CABLE_CANAL_CONNECTORS (ID_COMPONENT) REFERENCES COMPONENT MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE INTERFACE_RELATION ADD FOREIGN KEY FK_INTERFACE_RELATION (ID_COMPONENT) REFERENCES COMPONENT MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ ' ALTER TABLE INTERFOFINTERF_RELATION ADD FOREIGN KEY FK_INTERFOFINTERF_RELATION (ID_INTERF_REL) REFERENCES INTERFACE_RELATION MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '+ } GetScriptForCreatePortInterfaceRelation + GetScriptForCreateSpravochniks; try qSQL_QueryTSCSOperat.Open; except on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; FActive := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; FActive := false; raise; end; end; end; end; *) (* procedure TSCSProject.OpenAllTables; var QSelect: TSCSQuery; LastID: Integer; strSQL: String; CurrTable: TSQLMemTable; i: Integer; procedure CheckUpdateFieds(ATable: TSQLMemTable; AFieldName: String; AFieldType: TFieldType; ASize: Integer); begin if Assigned(ATable) then begin if ATable.FieldDefs.IndexOf(AFieldName) = -1 then begin ATable.FieldDefs.Add(AFieldName, AFieldType, ASize); end; end; end; begin if FLoaded then with TF_Main(ActiveForm).DM do begin { if Not tSQL_Katalog.Active then tSQL_Katalog.Open; if Not tSQL_CatalogRelation.Active then tSQL_CatalogRelation.Open; if Not tSQL_Component.Active then tSQL_Component.Open; if Not tSQL_CatalogMarkMask.Active then tSQL_CatalogMarkMask.Open; if Not tSQL_CatalogPropRelation.Active then tSQL_CatalogPropRelation.Open; if Not tSQL_ComponentRelation.Active then tSQL_ComponentRelation.Open; if Not tSQL_CompPropRelation.Active then tSQL_CompPropRelation.Open; if Not tSQL_CableCanalConnectors.Active then tSQL_CableCanalConnectors.Open; if Not tSQL_ConnectedComponents.Active then tSQL_ConnectedComponents.Open; if Not tSQL_InterfaceRelation.Active then tSQL_InterfaceRelation.Open; if Not tSQL_InterfOfInterfRelation.Active then tSQL_InterfOfInterfRelation.Open; if Not tSQL_PortInterfaceRelation.Active then tSQL_PortInterfaceRelation.Open; if Not tSQL_Norms.Active then tSQL_Norms.Open; if Not tSQL_NormResourceRel.Active then tSQL_NormResourceRel.Open; if Not tSQL_Resources.Active then tSQL_Resources.Open; } for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists and Not CurrTable.Active then CurrTable.Open; end; UpdateValues; { if (FGenerators.LastGen_KatalogID = 0) and (FGenerators.LastGen_KatalogSCSID = 0) then begin tSQL_Katalog.Append; tSQL_Katalog.Post; FGenerators.LastGen_KatalogID := tSQL_Katalog.FieldByName(fnID).AsInteger; FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; end; if FGenerators.LastGen_KatalogID = 0 then FGenerators.LastGen_KatalogID := GetLastIDFromMemTable(tSQL_Katalog); if FGenerators.LastGen_KatalogSCSID = 0 then begin tSQL_Katalog.Append; tSQL_Katalog.Post; FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; end; //if FGenerators.LastGen_CatalogRelationID = 0 then // FGenerators.LastGen_CatalogRelationID := GetLastIDFromMemTable(tSQL_CatalogRelation); if FGenerators.LastGen_ComponentID = 0 then FGenerators.LastGen_ComponentID := GetLastIDFromMemTable(tSQL_Component); if FGenerators.LastGen_CatalogPropRelationID = 0 then FGenerators.LastGen_CatalogPropRelationID := GetLastIDFromMemTable(tSQL_CatalogPropRelation); if FGenerators.LastGen_ComponentRelationID = 0 then FGenerators.LastGen_ComponentRelationID := GetLastIDFromMemTable(tSQL_ComponentRelation); if FGenerators.LastGen_CompPropRelationID = 0 then FGenerators.LastGen_CompPropRelationID := GetLastIDFromMemTable(tSQL_CompPropRelation); if FGenerators.LastGen_CableCanalConnectorsID = 0 then FGenerators.LastGen_CableCanalConnectorsID := GetLastIDFromMemTable(tSQL_CableCanalConnectors); if FGenerators.LastGen_ConnectedComponentsID = 0 then FGenerators.LastGen_ConnectedComponentsID := GetLastIDFromMemTable(tSQL_ConnectedComponents); if FGenerators.LastGen_InterfaceRelationID = 0 then FGenerators.LastGen_InterfaceRelationID := GetLastIDFromMemTable(tSQL_InterfaceRelation); if FGenerators.LastGen_InterfOfInterfRelationID = 0 then FGenerators.LastGen_InterfOfInterfRelationID := GetLastIDFromMemTable(tSQL_InterfOfInterfRelation); if FGenerators.LastGen_PortInterfaceRelationID = 0 then FGenerators.LastGen_PortInterfaceRelationID := GetLastIDFromMemTable(tSQL_PortInterfaceRelation); if FGenerators.LastGen_NormsID = 0 then FGenerators.LastGen_NormsID := GetLastIDFromMemTable(tSQL_Norms); if FGenerators.LastGen_NormResourceRelID = 0 then FGenerators.LastGen_NormResourceRelID := GetLastIDFromMemTable(tSQL_NormResourceRel); if FGenerators.LastGen_ResourcesID = 0 then FGenerators.LastGen_ResourcesID := GetLastIDFromMemTable(tSQL_Resources); } //*** Индексы полей DefineFieldIndexesForKatalog; DefineFieldIndexesForCatRel; DefineFieldIndexesForCatPropRel; DefineFieldIndexesForComponent; DefineFieldIndexesForCompRel; DefineFieldIndexesForCompPropRel; DefineFieldIndexesForCableCanalConnectors; DefineFieldIndexesForConnectedComponents; DefineFieldIndexesForInterfaceRelation; DefineFieldIndexesForIOfIRel; DefineFieldIndexesForPortInterfRel; DefineFieldIndexesForNorms; DefineFieldIndexesForNormResRel; DefineFieldIndexesForResource; { //*** Добавление новых полей if Not FieldExistsInTable(tSQL_Component, fnNotice) then begin tSQL_Component.Close; tSQL_Component.FieldDefs.Add(fnNotice, ftString, 255); tSQL_Component.Open; end; if Not FieldExistsInTable(tSQL_InterfaceRelation, fnNotice) then begin tSQL_InterfaceRelation.Close; tSQL_InterfaceRelation.FieldDefs.Add(fnNotice, ftString, 255); tSQL_InterfaceRelation.Open; end; } { tSQL_Katalog.Append; tSQL_Katalog.Post; FLastKatalogID := tSQL_Katalog.FieldByName(fnID).AsInteger; FLastKatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; FLastCableCanalConnectorID := GetLastIDFromMemTable(tSQL_CableCanalConnectors); FLastComponentID := GetLastIDFromMemTable(tSQL_Component); FLastCompRelID := GetLastIDFromMemTable(tSQL_ComponentRelation); FLastInterfRelID := GetLastIDFromMemTable(tSQL_InterfaceRelation); FLastInterfOfInterfRel := GetLastIDFromMemTable(tSQL_InterfOfInterfRelation); FLastComponPropRelID := GetLastIDFromMemTable(tSQL_CompPropRelation); FLastPortInterfRelID := GetLastIDFromMemTable(tSQL_PortInterfaceRelation); } end; end; *) (* procedure TSCSProject.LoadAllTables; var Stream: TStream; Size: Integer; PStream: TStream; begin SetSQLToQuery(FQuery_Select, ' select PM_BLOCK from katalog where id = '''+IntTostr(FCurrID)+''' '); Stream := TMemoryStream.Create; PStream := TMemoryStream.Create; try PStream.Position := 0; FQuery_Select.FNSaveToStream('PM_BLOCK', PStream); FQuery_Select.Close; PStream.Position := 0; UnPakStream(PStream, Stream); Stream.Position := 0; Size := Stream.Size; if Size > 0 then begin TF_Main(ActiveForm).DM.tSQL_Katalog.LoadAllTablesFromStream(Stream); UpdateStructure; FLoaded := true; { with TF_Main(ActiveForm).DM do begin qSQL_QueryTSCSOperat.Close; //qSQL_QueryTSCSOperat.SQL.Text := 'alter table component add(notice char(255)); '+ // 'alter table interface_relation add(notice char(255)); '; qSQL_QueryTSCSOperat.SQL.Text := 'alter table norms add(ID_NB INTEGER); '; try qSQL_QueryTSCSOperat.Open; except on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; raise; end; end; qSQL_QueryTSCSOperat.Close; end; } end else begin FActive := false; FLoaded := false; TF_Main(ActiveForm).DM.FMemBaseActive := false; end; //TF_Main(ActiveForm).DM.qSQL_QuerySelect.r finally FreeAndNil(Stream); FreeAndNil(PStream); end; end; *) (* procedure TSCSProject.SaveAllTables; var Stream: TStream; TmpProjectFilePath: String; begin ChangeSQLQuery(FQuery_Operat, ' update katalog set PM_BLOCK = :PM_BLOCK where id = '''+IntTostr(FCurrID)+''' '); {TmpProjectFilePath := ExtractFileDir(Application.ExeName); if DirectoryExists(TmpProjectFilePath +'\'+ dnTemp) then TmpProjectFilePath := TmpProjectFilePath +'\'+ dnTemp else begin if CreateDir(TmpProjectFilePath +'\'+ dnTemp) then TmpProjectFilePath := TmpProjectFilePath +'\'+ dnTemp; end; TmpProjectFilePath := TmpProjectFilePath + '\~Project.bin'; TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(TmpProjectFilePath);} TmpProjectFilePath := GetPathToProjectTmp; if SaveAllTablesToFile(TmpProjectFilePath) then begin PakFile(TmpProjectFilePath, clWorse); Stream := TFileStream.Create(TmpProjectFilePath, fmOpenRead); try Stream.Position := 0; FQuery_Operat.ParamLoadFromStream(fnPMBlock, Stream); FQuery_Operat.ExecQuery; FQuery_Operat.Close; finally FreeAndNil(Stream); end; DeleteFile(TmpProjectFilePath); end; { Stream := TMemoryStream.Create; try Stream.Position := 0; TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(ExtractFileDir(Application.ExeName)+'\Stream.bin'); TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToStream(Stream); Stream.Position := 0; FQuery_Operat.ParamLoadFromStream('PM_BLOCK', Stream); FQuery_Operat.ExecQuery; FQuery_Operat.Close; finally FreeAndNil(Stream); end; } end; *) { function TSCSProject.SaveAllTablesToFile(AFileName: String): Boolean; var FileDir: String; DirExists: Boolean; begin Result := false; try FileDir := ExtractFileDir(AFileName); DirExists := false; if DirectoryExists(FileDir) then DirExists := true else if CreateDir(FileDir) then DirExists := true; if DirExists then begin TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(AFileName); if FileExists(AFileName) then Result := true; end; except on E: Exception do AddExceptionToLog('TSCSProject.SaveAllTablesToFile: '+E.Message); end; end; } { procedure TSCSProject.UnSortingTables; var CurrTable: TSQLMemTable; i: Integer; begin with TF_Main(ActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Filtered then CurrTable.Filtered := false; if CurrTable.IndexName <> '' then CurrTable.IndexName := ''; end; end; } procedure TSCSProject.DefineIDPointer(ATableName: String; APointerFields, AGuidFields: TStringList); var DestTable: TSQLMemTable; i, j, k, CorrectID: Integer; CorrectValues: TList; ptrCorrectValue: PIDPointerInfo; IsFindedValue: Boolean; GUIDTableName: String; begin DestTable := nil; CorrectValues := nil; with TF_Main(FActiveForm).DM do begin DestTable := GetSQLMemTableByName(ATableName); if Assigned(DestTable) then begin CorrectValues := TList.Create; try DestTable.Filtered := false; for i:= 0 to DestTable.RecordCount - 0 do begin DestTable.RecNo := i+1; for j := 0 to APointerFields.Count - 1 do begin IsFindedValue := false; //*** Найти инфу о значении for k := 0 to CorrectValues.Count - 1 do begin ptrCorrectValue := CorrectValues[k]; if ptrCorrectValue.FieldName = APointerFields[j] then if ptrCorrectValue.GUIDValue = DestTable.FieldByName(AGuidFields[j]).AsString then begin if ptrCorrectValue.IDValue <> DestTable.FieldByName(APointerFields[j]).AsInteger then begin if DestTable.State = dsBrowse then DestTable.Edit; DestTable.FieldByName(APointerFields[j]).AsInteger := ptrCorrectValue.IDValue; end; IsFindedValue := true; Break; ///// BREAK ///// end; end; if Not IsFindedValue then begin CorrectID := -1; GUIDTableName := ''; GUIDTableName := GetTableNameByGUIDFieldPointer(AGuidFields[j]); if GUIDTableName <> '' then CorrectID := F_NormBase.DM.GetIntFromTableByGUID(GUIDTableName, fnID, DestTable.FieldByName(AGuidFields[j]).AsString, qmPhisical); if CorrectID <> -1 then begin if CorrectID <> DestTable.FieldByName(APointerFields[j]).AsInteger then begin if DestTable.State = dsBrowse then DestTable.Edit; DestTable.FieldByName(APointerFields[j]).AsInteger := CorrectID; end; //*** Добавить инфу в список GetMem(ptrCorrectValue, SizeOf(TIDPointerInfo)); ptrCorrectValue.FieldName := APointerFields[j]; ptrCorrectValue.GUIDValue := DestTable.FieldByName(AGuidFields[j]).AsString; ptrCorrectValue.IDValue := CorrectID; CorrectValues.Add(ptrCorrectValue); end; end; end; if DestTable.State = dsEdit then DestTable.Post; end; finally FreeList(CorrectValues); end; end; end; end; // Tolik 16/05/2019 -- При присвоении парента в nil количество FProjectLists уменьшается, поэтому, собственно // и простой цикл ебнется ... так что как-то так... procedure TSCSProject.CloseAllLists; var i: Integer; SCSList: TSCSList; begin // 13/12/2019 -- //FProjectLists := TSCSLists.Create(false); // временно для эксперимента for i := FProjectLists.Count - 1 downto 0 do begin SCSList := FProjectLists[i]; if SCSList.Active then SCSList.Close; SCSList.Free; end; // { while FProjectLists.Count > 0 do begin SCSList := FProjectLists[0]; if SCSList.Active then SCSList.Close; // SCSList.Free; end;} end; { procedure TSCSProject.CloseAllLists; var i: Integer; SCSList: TSCSList; begin for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if SCSList.Active then SCSList.Close; SCSList.Free; end; end; } // // продолжить индексы компонент procedure FillAllMarkIDs(ASrcCatalog: TSCSCatalog; var aSpav: TSCSObjectList); var ii, i, j: integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; ComponList: TSCSComponents; begin for i := 0 to ASrcCatalog.FChildCatalogs.Count - 1 do begin SCSCatalog := ASrcCatalog.FChildCatalogs[i]; if (SCSCatalog.ItemType = itSCSConnector) or (SCSCatalog.ItemType = itArhContainer) then begin ComponList := nil; //if APointComplIndexingMode = pcimInProject then ComponList := SCSCatalog.FComponentReferences; //else //if (APointComplIndexingMode = pcimInCompon) or (APointComplIndexingMode = pcimInTopCompon) then //ComponList := SCSCatalog.FSCSComponents; if ComponList <> nil then for j := 0 to ComponList.Count - 1 do begin SCSComponent := ComponList[j]; for ii := 0 to aSpav.Count - 1 do begin if SCSComponent.GUIDComponentType = TNBComponentType(aSpav[ii]).ComponentType.GUID then begin if SCSComponent.MarkID > TNBComponentType(aSpav[ii]).ComponentType.ComponentIndex then TNBComponentType(aSpav[ii]).ComponentType.ComponentIndex := SCSComponent.MarkID; break; end; end; end; end; FillAllMarkIDs(SCSCatalog, aSpav); end; end; function TSCSProject.CopyList(ASrcList: TSCSList; ANewCopyName: String; ATargetObject: TSCSCatalog = nil; aCopyCompons: Boolean=true): TSCSList; var NewList: TSCSList; i, j, k, l, ii, NewListSCSID, NewObjectSCSID, SavedNewListID, SavedNewListSortID, NewPortInterfID, OldWholeID: Integer; NewListNode, TargetTreeViewNode: TTreeNode; ListParams: TListParams; NewCAD: TForm; CADNormStruct: TCADNormStruct; CADNormColumn: TCADNormColumn; CADCrossObject: TCADCrossObject; CADCrossObjectElement: TCADCrossObjectElement; SCSCatalog, ChildCatalog, ComponOwner, PartComponentOwner: TSCSCatalog; SCSComponent, PartComponent, RelatedComponent: TSCSComponent; SCSinterface, SCSinterfaceTo, SCSinterfaceAdverse, SCSinterfaceConnected, InterfInternalConnected: TSCSInterface; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; ptrPortInterfRel: PPortInterfRel; WholeComponent, LookedWholeComponents: TSCSComponents; NewListCompRelComplects, NewListCompRelConnections: TList; NewListIOfIRelsConstructiv, NewListIOfIRelsFunctional: TSCSObjectList; NewListInterfacesWithIDConnected: TSCSInterfaces; IOfIRel, IOfIRelMain: TSCSIOfIRel; InterfPosConnection: TSCSInterfPosConnection; IsHaveIDIOfIRelMain: Boolean; ptrProperty: PProperty; ptrCompRel: PComplect; ptrCableCanalConnector: PCableCanalConnector; ptrCatalogMarkMask: PCatalogMarkMask; WholeIDsOld, WholeIDsNew, BetweenFloorObjectIDs, CADObjectOldIDList, CADObjectNewIDList: TIntList; WholeIDIndex: Integer; ConnectedComponsInfoList: TConnectedComponsList; ConnectedComponsInfoListCreated, ObjectsBlobsCreated: Boolean; ConnectedComponsInfo: TConnectedComponsInfo; ObjectsBlobs: TObjectsBlobs; ObjectsBlob: TObjectsBlob; CADObjectList: TObjectList; CADObject: TObject; CADObjectIndex, ValueIndex, NewObjectID: Integer; CompPropRelOldIDs, CompPropRelNewIDs, ComponOldIDs, ComponNewIDs: TIntList; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // AddMarkID: string; // Tolik -- 21/02/2017 -- CanCopyComponsToList, CanRefreshFlag, CanRefreshTreeFlag, RefreshFlag: Boolean; // Tolik -- 26/04/2017 -- //Tolik 26/07/2017 -- ListToDel: TList; Figure: TFigure; SCSFigureGrp: TSCSFigureGrp; // function GetCompRelsByIDChildFromList(AIDChild: Integer; AList: TList): TList; var i: Integer; ptrCompRel: PComplect; begin Result := TList.Create; for i := 0 to AList.Count - 1 do begin ptrCompRel := AList[i]; if ptrCompRel.ID_Child = AIDChild then Result.Add(ptrCompRel); end; end; function GetIOfIRelsByIDCompRelFromList(AIDCompRel: Integer; AList: TSCSObjectList): TList; var i: Integer; IOfIRel: TSCSIOfIRel; begin Result := TList.Create; for i := 0 to AList.Count - 1 do begin IOfIRel := TSCSIOfIRel(AList[i]); if IOfIRel.IDCompRel = AIDCompRel then Result.Add(IOfIRel); end; end; function GetInterfaceByIDConnectedFromList(AIDConnected: Integer; AList: TSCSInterfaces): TSCSinterface; var i: Integer; SCSInterface: TSCSinterface; begin Result := nil; for i := 0 to AList.Count - 1 do begin SCSInterface := AList[i]; if SCSInterface.IDConnected = AIDConnected then begin Result := SCSInterface; Break; ///// BREAK ///// end; end; end; {function GetIOfIRelsFromComponsByIDCompRel(ACompon1, ACompon2: TSCSComponent; AIDCompRel: Integer): TList; var i, j: Integer; Interf: TSCSInterface; ptrIOfIRel: PIOfIRel; begin Result := TList.Create; for i := 0 to ACompon1.Interfaces.Count - 1 do begin Interf := ACompon1.Interfaces[i]; for j := 0 to Interf.FIOfIRelOut.Count - 1 do begin ptrIOfIRel := Interf.FIOfIRelOut[j]; if ptrIOfIRel.IDCompRel = AIDCompRel then Result.Add(ptrIOfIRel); end; end; for i := 0 to ACompon2.Interfaces.Count - 1 do begin Interf := ACompon2.Interfaces[i]; for j := 0 to Interf.FIOfIRelOut.Count - 1 do begin ptrIOfIRel := Interf.FIOfIRelOut[j]; if ptrIOfIRel.IDCompRel = AIDCompRel then Result.Add(ptrIOfIRel); end; end; end; } procedure SetNewIDsToCompRels(AComponent: TSCSComponent; AConnectType: Integer); var i, j: Integer; CompRelList: TList; // Список связи комплектующих/соединений компоненты AComponent CompRelInChildList: TList; // Список связей комплектующих/соединений, где AComponent явл-ся комплектующей NewListCompRelList: TList; NewListIOfIRelList: TSCSObjectList; ptrCompRel: PComplect; ChildComponent: TSCSComponent; IOfIRelList: TList; IOfIRel: TSCSIOfIRel; begin CompRelList := nil; NewListCompRelList := nil; NewListIOfIRelList := nil; case AConnectType of cntComplect: begin CompRelList := AComponent.FComplects; NewListCompRelList := NewListCompRelComplects; NewListIOfIRelList := NewListIOfIRelsConstructiv; end; cntUnion: begin; CompRelList := AComponent.FConnections; NewListCompRelList := NewListCompRelConnections; NewListIOfIRelList := NewListIOfIRelsFunctional; end; end; if CompRelList <> nil then for i := 0 to CompRelList.Count - 1 do begin ptrCompRel := CompRelList[i]; IOfIRelList := nil; IOfIRelList := GetIOfIRelsByIDCompRelFromList(ptrCompRel.ID, NewListIOfIRelList); //NewList.GetIOfIRelsByIDCompRel(ptrCompRel.ID); ptrCompRel.ID := GenIDByGeneratorIndex(giComponentRelationID); ptrCompRel.ID_Component := AComponent.NewID; if IOfIRelList <> nil then begin //*** связь соединений интерфейсами с соединениями компонент for j := 0 to IOfIRelList.Count - 1 do begin IOfIRel := TSCSIOfIRel(IOfIRelList[j]); IOfIRel.IDCompRel := ptrCompRel.ID; end; IOfIRelList.Free; end; end; CompRelInChildList := GetCompRelsByIDChildFromList(AComponent.ID, NewListCompRelList); //}NewList.GetComponRelsByIDChild(AComponent.ID, AConnectType); for i := 0 to CompRelInChildList.Count - 1 do begin ptrCompRel := CompRelInChildList[i]; ptrCompRel.ID_NewChild := AComponent.NewID; end; CompRelInChildList.Free; end; { procedure CopyConnectedComponsInfo(AWholeID, ANewWholeID, AType: Integer); var ConnectedComponsInfo: TConnectedComponsInfo; SideComponent: TSCSComponent; ConnectedCompon: TSCSComponent; ConnectedObject: TSCSCatalog; NewSideComponentID: Integer; NewConnectedComponID: Integer; NewConnectedObjectID: Integer; begin ConnectedComponsInfo := FConnectedComponsList.GetConnectedComponsInfoByWholeIDAndType(AWholeID, AType); if ConnectedComponsInfo.ComponWholeID > 0 then begin NewSideComponentID := -1; NewConnectedComponID := -1; NewConnectedObjectID := -1; SideComponent := NewList.GetComponentFromReferences(ConnectedComponsInfo.IDSideCompon); if SideComponent <> nil then NewSideComponentID := SideComponent.NewID; ConnectedCompon := NewList.GetComponentFromReferences(ConnectedComponsInfo.IDConnectCompon); if ConnectedCompon <> nil then NewConnectedComponID := ConnectedCompon.NewID; ConnectedObject := NewList.GetCatalogFromReferences(ConnectedComponsInfo.IDConnectObject); if ConnectedObject <> nil then NewConnectedObjectID := ConnectedObject.NewID; if (NewSideComponentID <> -1) or (NewConnectedComponID <> -1) or (NewConnectedObjectID <> -1) then begin FConnectedComponsList.InsertRecord(ANewWholeID, NewConnectedObjectID, NewConnectedComponID, NewSideComponentID, AType); end; end; end; } // Tolik 28/01/2020 -- Procedure ClearDelBetweenFloorRaiseOnCopyList(aRaiseCatalog: TSCSCatalog); var i: Integer; BetweenRaiseFigure: TFigure; JoinConn: TConnectorObject; ChildCompon: TSCSComponent; ComponToDelList: TSCSComponents; SCSList: TSCSList; Procedure DelJoinedRaiseLines(aConn: TConnectorObject; aDeletedId: Integer); var JoinedLine: TOrthoLine; NextConn: TConnectorObject; deletedLineID: Integer; CanProceed: Boolean; begin if aConn.JoinedConnectorsList.Count > 0 then // дошло до точечного exit; if aConn.JoinedOrthoLinesList.Count > 2 then // стоим на перекрестка exit; JoinedLine := nil; JoinedLine := TOrthoLine(aConn.JoinedOrthoLinesList[0]); if JoinedLine.ID = aDeletedId then begin if aConn.JoinedOrtholinesList.Count > 1 then JoinedLine := TOrthoLine(aConn.JoinedOrthoLinesList[1]) else JoinedLine := nil; end; if JoinedLine <> nil then begin if JoinedLine.JoinConnector1.ID = aConn.ID then NextConn := TConnectorObject(JoinedLine.JoinConnector2) else NextConn := TConnectorObject(JoinedLine.JoinConnector1); CanProceed := True; CanProceed := (NextConn.JoinedConnectorsList.Count = 0); if CanProceed then CanProceed := (NextConn.JoinedOrthoLinesList.Count = 2); deletedLineID := JoinedLine.ID; JoinedLine.Delete; if CanProceed then DelJoinedRaiseLines(NextConn, deletedLineID); end; end; begin if aRaiseCatalog = nil then exit; ComponToDelList := TSCSComponents.Create(false); // удалить кабель, проходящий по межэтажке по всей длине for I := 0 to aRaiseCatalog.ComponentReferences.Count - 1 do begin ChildCompon := aRaiseCatalog.ComponentReferences[i]; if ChildCompon.ComponentType.SysName = ctsnCable then if CompontoDelList.IndexOf(ChildCompon) = -1 then CompontoDelList.Add(ChildCompon); end; if CompontoDelList.Count > 0 then begin SCSList := CompontoDelList[0].GetListOwner; if SCSList <> nil then F_ProjMan.DelComponentsFromList(SCSList, CompontoDelList, true, biTrue); end; CompontoDelList.Free; // // удалить присоединенные трассы до ближейшего пересечения более чем 2-х трасс // начиная с обеих коннекторов удаляемой межэтажки BetweenRaiseFigure := GetFigureByID(TF_CAD(NewCad), aRaiseCatalog.SCSID); if BetweenRaiseFigure <> nil then begin if checkFigureByClassName(BetweenRaiseFigure, ctOrthoLine) then begin DelJoinedRaiseLines(TConnectorObject(TOrthoLine(BetweenRaiseFigure).JoinConnector1), BetweenRaiseFigure.ID); DelJoinedRaiseLines(TConnectorObject(TOrthoLine(BetweenRaiseFigure).JoinConnector2), BetweenRaiseFigure.ID); TOrthoLine(BetweenRaiseFigure).Delete; end; end else TF_Main(FActiveForm).DeleteCatalog(SCSCatalog, nil, true); end; // begin //NewList := TSCSList.Create(FActiveForm); //NewList.Assign(ASrcList); Result := nil; CanCopyComponsToList := False; // Tolik 21/07/2017 -- if aCopyCompons then CanCopyComponsToList := CheckCanCopyComponsFromListToList; ConnectedComponsInfoList := nil; ConnectedComponsInfoListCreated := false; ObjectsBlobs := nil; ObjectsBlobsCreated := false; NewListSCSID := GenNewListID; ListParams := ASrcList.GetParams; if ListParams.IsIndexWithName <> 0 then AddMarkID := ' ' + inttostr(ListParams.MarkID) + ')' else AddMarkID := ')'; ListParams.ID := NewListSCSID; ListParams.MarkID := GetMaxMarkIDFromChildReferences(itList) + 1; //ListParams.Name := ANewCopyName; // 'Копия '+ASrcList.Name; // Tolik 20/07/2017 -*- //ListParams.Name := ANewCopyName + ' '+ inttostr(ListParams.MarkID) + ' ' + cMain_Msg103 + ' '+ ANewCopyName + AddMarkID; //Tolik 29/09/2021 -- // ListParams.Name := cMasterNewList_Mes6 + ' ' + inttostr(ListParams.MarkID) + ' ' + cMain_Msg103 + ' '+ ANewCopyName + AddMarkID; ListParams.Name := cMasterNewList_Mes6 + ' ' + inttostr(ListParams.MarkID); // + ' ' + cMain_Msg103 + ' '+ ANewCopyName + AddMarkID; // ListParams.IsIndexWithName := 0; TargetTreeViewNode := FTreeViewNode; if (ATargetObject <> nil) and (ATargetObject.FTreeViewNode <> nil) then TargetTreeViewNode := ATargetObject.FTreeViewNode; TF_Main(FActiveForm).MakeDir(cfBase, TargetTreeViewNode, ListParams.Name, itList, @ListParams, NewListSCSID); NewList := GetListBySCSID(NewListSCSID); if Assigned(NewList) then begin SavedNewListID := NewList.ID; SavedNewListSortID := NewList.SortID; // Tolik -- 21/02/2017 -- NewList.Assign(ASrcList, (aCopyCompons and CanCopyComponsToList)); // NewList.Assign(ASrcList, aCopyCompons); // if Not aCopyCompons then NewList.FSpravochnik.Assign(ASrcList.Spravochnik); {$if Not Defined(ES_GRAPH_SC)} // продолжить индексы компонент if Not aCopyCompons then // проверить - продолжать индексацию только если в пределах листа и объекта begin if (ASrcList.ProjectOwner.Setting.PointComonIndexingMode = cimInList) and (ASrcList.ProjectOwner.Setting.PointComplIndexingMode = pcimInProject) then begin PauseProgress(true); if MessageModal(cMain_Msg199, ApplicationName, MB_YESNO or MB_ICONQUESTION) = IDYES then begin FillAllMarkIDs(ASrcList, NewList.FSpravochnik.FNBComponentTypes); { for i := 0 to ASrcList.FSpravochnik.FNBComponentTypes.Count - 1 do begin for j := 0 to NewList.FSpravochnik.FNBComponentTypes.Count - 1 do if TNBComponentType(ASrcList.FSpravochnik.FNBComponentTypes[i]).ComponentType.GUID = TNBComponentType(NewList.FSpravochnik.FNBComponentTypes[j]).ComponentType.GUID then begin if TNBComponentType(ASrcList.FSpravochnik.FNBComponentTypes[i]).ComponentType.ComponentIndex > TNBComponentType(NewList.FSpravochnik.FNBComponentTypes[j]).ComponentType.ComponentIndex then begin TNBComponentType(NewList.FSpravochnik.FNBComponentTypes[j]).ComponentType.ComponentIndex := TNBComponentType(ASrcList.FSpravochnik.FNBComponentTypes[i]).ComponentType.ComponentIndex; break; end; end; end; } end else begin for j := 0 to NewList.FSpravochnik.FNBComponentTypes.Count - 1 do TNBComponentType(NewList.FSpravochnik.FNBComponentTypes[j]).ComponentType.ComponentIndex := 0; end; PauseProgress(False); end; end; {$IFEND} NewList.ID := SavedNewListID; NewList.SortID := SavedNewListSortID; NewList.FCurrID := NewListSCSID; NewList.ListID := NewListSCSID; NewList.SCSID := NewListSCSID; NewList.MarkID := ListParams.MarkID; NewList.Name := ListParams.Name; //CreateListDuplicate(NewList.GetParams, TMemoryStream(NewList.FCADStream)); NewCAD := TForm(CreateListDuplicate(NewList.GetParams, nil, NewList.FListCADFile, aCopyCompons)); NewList.OpenedInCAD := true; try CADBeginUpdate(NewCAD); // Tolik -- 21/02/2017 -- // Tolik -- 26/07/2017 -- //if (aCopyCompons and CanCopyComponsToList) then // if aCopyCompons then //if ({aCopyCompons and }CanCopyComponsToList) then // begin NewListCompRelComplects := NewList.GetCompRelsByConnectType(cntComplect); NewListCompRelConnections := NewList.GetCompRelsByConnectType(cntUnion); NewListIOfIRelsConstructiv := NewList.GetAllIOfIRel(itConstructive); NewListIOfIRelsFunctional := NewList.GetAllIOfIRel(itFunctional); NewListInterfacesWithIDConnected := NewList.GetInterfacesWithIDConnected; ComponOldIDs := TIntList.Create; //05.10.2010 ComponNewIDs := TIntList.Create; //05.10.2010 NewList.FObjIDsBeforeCopy := TIntList.Create; NewList.FObjIDsAfterCopy := TIntList.Create; CompPropRelOldIDs := TIntList.Create; CompPropRelNewIDs := TIntList.Create; OldTick := GetTickCount; for i := 0 to NewListIOfIRelsConstructiv.Count - 1 do TSCSIOfIRel(NewListIOfIRelsConstructiv[i]).InterfaceTo := nil; for i := 0 to NewListIOfIRelsFunctional.Count - 1 do TSCSIOfIRel(NewListIOfIRelsFunctional[i]).InterfaceTo := nil; NewList.SetComponentsJoining; NewList.SetComponInterfacesForComlects; //*** Создать новые ID для, комнат, объетов //*** для комнат и объектов CADObjectList := TObjectList.Create(false); CADObjectOldIDList := TIntList.Create; CADObjectNewIDList := TIntList.Create; for i := 0 to NewList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := NewList.ChildCatalogReferences[i]; SCSCatalog.NewID := GenIDByGeneratorIndex(giKatalogID); NewObjectSCSID := GenIDByGeneratorIndex(giKatalogSCSID); {if SCSCatalog.ItemType in [itSCSLine, itSCSConnector] then begin //*** Передать на КАД ChangeObjectID(NewList.FCurrID, SCSCatalog.SCSID, NewObjectSCSID); end else if SCSCatalog.ItemType = itRoom then ChangeCabinetID(NewList.FCurrID, SCSCatalog.SCSID, NewObjectSCSID);} CADObject := GetFigureObjectByID(NewList.FCurrID, SCSCatalog.SCSID); if CADObject = nil then CADObject := GetHouseByID(U_Common.GetListByID(NewList.FCurrID), SCSCatalog.SCSID); if CADObject <> nil then begin CADObjectList.Add(CADObject); CADObjectOldIDList.Add(SCSCatalog.SCSID); CADObjectNewIDList.Add(NewObjectSCSID); NewList.FObjIDsBeforeCopy.Add(SCSCatalog.ID); NewList.FObjIDsAfterCopy.Add(SCSCatalog.NewID); end; SCSCatalog.SCSID := NewObjectSCSID; SCSCatalog.ListID := NewList.CurrID; //*** Определить ParentID if TSCSCatalog(SCSCatalog.Parent).ID = NewList.ID then SCSCatalog.ParentID := NewList.ID; for j := 0 to SCSCatalog.ChildCatalogs.Count - 1 do begin ChildCatalog := SCSCatalog.ChildCatalogs[j]; ChildCatalog.ParentID := SCSCatalog.NewID; end; end; //*** Пкредать новые ID на КАД SetNewObjectsIDs(CADObjectList, CADObjectNewIDList); //*** Шаблоны маркировок for i := 0 to FMarkMasks.Count - 1 do begin ptrCatalogMarkMask := FMarkMasks[i]; ptrCatalogMarkMask.IDCatalog := NewList.ID; end; //*** Для компонент, интерфейсов, портов, свойств и всего остального, что касается компонент for i := 0 to NewList.ComponentReferences.Count - 1 do begin SCSComponent := NewList.ComponentReferences[i]; SCSComponent.NewID := GenIDByGeneratorIndex(giComponentID); ComponOldIDs.Add(SCSComponent.ID); ComponNewIDs.Add(SCSComponent.NewID); ComponOwner := SCSComponent.GetFirstParentCatalog; SCSComponent.ObjectID := ComponOwner.NewID; SCSComponent.ListID := NewList.FCurrID; //SCSComponent.JoinedComponents.Clear; //*** порты/интерфейсы SCSComponent.SetPortInterfRelInterfaces; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSInterface := SCSComponent.FInterfaces[j]; NewPortInterfID := GenIDByGeneratorIndex(giInterfaceRelationID); SCSInterface.NewID := NewPortInterfID; ////*** связь портов с интерфейсами // ptrPortInterfRel := nil; // if SCSInterface.FPortOwner <> nil then // ptrPortInterfRel := SCSInterface.FPortOwner.GetPortInterfRelByInterfID(SCSInterface.ID); // //ptrPortInterfRel := SCSComponent.GetPortInterfRelByIDInterfRel(SCSInterface.ID); // if ptrPortInterfRel <> nil then // ptrPortInterfRel.NewIDInterfRel := NewPortInterfID; // for k := 0 to SCSInterface.FPortInterfRels.Count - 1 do // begin // ptrPortInterfRel := SCSInterface.FPortInterfRels[k]; // ptrPortInterfRel.ID := GenIDByGeneratorIndex(giPortInterfaceRelationID); // ptrPortInterfRel.IDPort := NewPortInterfID; // end; //*** связь интерфейсов с интерфейсами for k := 0 to SCSInterface.FConnectedInterfaces.Count - 1 do begin SCSinterfaceConnected := SCSInterface.FConnectedInterfaces[k]; for l := 0 to SCSinterfaceConnected.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(SCSinterfaceConnected.FIOfIRelOut[l]); if IOfIRel.InterfaceTo = SCSInterface then IOfIRel.IDInterfTo := NewPortInterfID; end; end; //IOfIRels := NewList.GetIOfIRelsByIDIntercface(SCSInterface.ID); //for k := 0 to IOfIRels.Count - 1 do //begin // ptrIOfIRel := IOfIRels[k]; // if ptrIOfIRel.IDInterfTo = SCSInterface.ID then // ptrIOfIRel.IDInterfTo := NewPortInterfID; //end; //IOfIRels.Free; IsHaveIDIOfIRelMain := false; for k := 0 to SCSInterface.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(SCSInterface.FIOfIRelOut[k]); IOfIRel.NewID := GenIDByGeneratorIndex(giInterfOfInterfRelationID); IOfIRel.IDInterfRel := NewPortInterfID; IOfIRel.InterfaceOwner := SCSInterface; //ptrIOfIRel.InterfaceTo := nil; if IOfIRel.IDIOfIRelMain <> 0 then IsHaveIDIOfIRelMain := true; for l := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[l]); InterfPosConnection.ID := GenIDByGeneratorIndex(giInterfPosConnectionID); InterfPosConnection.IDIOIRel := IOfIRel.NewID; end; end; // Установить новое значение в поле IDIOfIRelMain if IsHaveIDIOfIRelMain then for k := 0 to SCSInterface.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(SCSInterface.FIOfIRelOut[k]); if IOfIRel.IDIOfIRelMain <> 0 then begin IOfIRelMain := GetIOfIRelFromInterfByID(SCSInterface, IOfIRel.IDIOfIRelMain); if IOfIRelMain <> nil then IOfIRel.IDIOfIRelMain := IOfIRelMain.NewID; end; end; // Установить новое значение поля ID for k := 0 to SCSInterface.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(SCSInterface.FIOfIRelOut[k]); IOfIRel.ID := IOfIRel.NewID; end; //*** противоположный инетрфейс if SCSInterface.IDAdverse > 0 then begin //SCSInterfaceAdverse := NewList.GetInterfaceByID(SCSInterface.IDAdverse); SCSInterfaceAdverse := SCSInterface.ParallelInterface; if SCSInterfaceAdverse <> nil then SCSInterfaceAdverse.IDAdverse := NewPortInterfID; end; //*** Связь с интерфейсом другого компоненты SCSinterfaceConnected := GetInterfaceByIDConnectedFromList(SCSInterface.ID, NewListInterfacesWithIDConnected); //NewList.GetInterfaceByIDConnected(SCSInterface.ID); if SCSinterfaceConnected <> nil then SCSinterfaceConnected.IDConnected := NewPortInterfID; //SCSInterface.ID := NewPortInterfID; SCSInterface.ID_Component := SCSComponent.NewID; SCSInterface.ComponentOwner := SCSComponent; //SCSInterface.ConnectedInterfaces.Clear; end; //*** Внутренние связи интерфейсов for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSInterface := SCSComponent.FInterfaces[j]; for k := 0 to SCSInterface.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := SCSInterface.FPortInterfRels[k]; ptrPortInterfRel.ID := GenIDByGeneratorIndex(giPortInterfaceRelationID); ptrPortInterfRel.IDPort := SCSinterface.NewID; InterfInternalConnected := SCSComponent.GetInterfaceByID(ptrPortInterfRel.IDInterfRel); // Tolik -- 16/02/2018 -- if InterfInternalConnected <> nil then // а то писец.... // ptrPortInterfRel.NewIDInterfRel := InterfInternalConnected.NewID; end; end; //*** Свойства CompPropRelOldIDs.Clear; CompPropRelNewIDs.Clear; for j := 0 to SCSComponent.FProperties.Count - 1 do begin ptrProperty := SCSComponent.FProperties[j]; ValueIndex := InsertValueToSortetIntList(ptrProperty.ID, CompPropRelOldIDs); ptrProperty.ID := GenIDByGeneratorIndex(giCompPropRelationID); ptrProperty.IDMaster := SCSComponent.NewID; CompPropRelNewIDs.Insert(ValueIndex, ptrProperty.ID); end; //*** Комплектующие SetNewIDsToCompRels(SCSComponent, cntComplect); //*** Подключения SetNewIDsToCompRels(SCSComponent, cntUnion); //*** Элементы кабельных каналов for j := 0 to SCSComponent.FCableCanalConnector.Count - 1 do begin ptrCableCanalConnector := SCSComponent.FCableCanalConnector[j]; ptrCableCanalConnector.ID := GenIDByGeneratorIndex(giCableCanalConnectorsID); ptrCableCanalConnector.IDCableCanal := SCSComponent.NewID; end; //*** Нормы for j := 0 to SCSComponent.NormsResources.Norms.Count - 1 do begin SCSNorm := SCSComponent.NormsResources.Norms[j]; SCSNorm.ID := GenIDByGeneratorIndex(giNormsID); SCSNorm.IDMaster := SCSComponent.NewID; if SCSNorm.IDCompPropRel <> 0 then begin NewObjectID := 0; ValueIndex := GetValueIndexFromSortedIntList(SCSNorm.IDCompPropRel, CompPropRelOldIDs); if ValueIndex <> -1 then NewObjectID := CompPropRelNewIDs[ValueIndex]; SCSNorm.IDCompPropRel := NewObjectID; end; end; //*** Ресурсы for j := 0 to SCSComponent.NormsResources.Resources.Count - 1 do begin SCSResourceRel := SCSComponent.NormsResources.Resources[j]; SCSResourceRel.IDMaster := SCSComponent.NewID; SCSResourceRel.ID := GenIDByGeneratorIndex(giNormResourceRelID); SCSResourceRel.IDResource := GenIDByGeneratorIndex(giResourcesID); if SCSResourceRel.IDCompPropRel <> 0 then begin NewObjectID := 0; ValueIndex := GetValueIndexFromSortedIntList(SCSResourceRel.IDCompPropRel, CompPropRelOldIDs); if ValueIndex <> -1 then NewObjectID := CompPropRelNewIDs[ValueIndex]; SCSResourceRel.IDCompPropRel := NewObjectID; end; end; // Связанный арх. объект на КАД-е //if IsArchComponByIsLine(SCSComponent.IsLine) then // SetCADArchObjComponIDByCompon(SCSComponent, SCSComponent.NewID); end; //NewList.SetComponentsJoining; SetCADArchObjectsNewID(NewList, ComponOldIDs, ComponNewIDs); //*** Индексы маркировок и цельные линейные компоненты WholeIDsOld := TIntList.Create; WholeIDsNew := TIntList.Create; LookedWholeComponents := TSCSComponents.Create(false); {//25.07.2013 for i := 0 to NewList.FComponentReferences.Count - 1 do begin SCSComponent := NewList.FComponentReferences[i]; //*** Цельнй компонент if LookedWholeComponents.IndexOf(SCSComponent) = -1 then begin ComponOwner := SCSComponent.GetFirstParentCatalog; SCSComponent.MarkID := TF_Main(FActiveForm).GenComponentMarkID(SCSComponent); SCSComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(SCSComponent, ComponOwner, false); if SCSComponent.IsLine = biTrue then begin OldWholeID := SCSComponent.Whole_ID; SCSComponent.Whole_ID := GenIDByGeneratorIndex(giComponentWholeID); WholeComponent := NewList.GetComponentsByWholeID(OldWholeID); WholeIDsOld.Add(OldWholeID); WholeIDsNew.Add(SCSComponent.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; PartComponent.Whole_ID := SCSComponent.Whole_ID; PartComponent.MarkID := SCSComponent.MarkID; PartComponentOwner := PartComponent.GetFirstParentCatalog; PartComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(PartComponent, PartComponentOwner, false); LookedWholeComponents.Add(PartComponent); end; //CopyConnectedComponsInfo(OldWholeID, SCSComponent.Whole_ID, tcoFrom); //CopyConnectedComponsInfo(OldWholeID, SCSComponent.Whole_ID, tcoTo); WholeComponent.Free; end; end; // Если есть связанный компонент if SCSComponent.IDRelatedCompon <> 0 then begin RelatedComponent := NewList.GetComponentFromReferences(SCSComponent.IDRelatedCompon); if RelatedComponent <> nil then SCSComponent.IDRelatedCompon := RelatedComponent.NewID; end; end;} //Цельные линейные компоненты for i := 0 to NewList.FComponentReferences.Count - 1 do begin SCSComponent := NewList.FComponentReferences[i]; //*** Цельнй компонент if LookedWholeComponents.IndexOf(SCSComponent) = -1 then begin if SCSComponent.IsLine = biTrue then begin OldWholeID := SCSComponent.Whole_ID; SCSComponent.Whole_ID := GenIDByGeneratorIndex(giComponentWholeID); WholeComponent := NewList.GetComponentsByWholeID(OldWholeID); WholeIDsOld.Add(OldWholeID); WholeIDsNew.Add(SCSComponent.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; PartComponent.Whole_ID := SCSComponent.Whole_ID; LookedWholeComponents.Add(PartComponent); end; //CopyConnectedComponsInfo(OldWholeID, SCSComponent.Whole_ID, tcoFrom); //CopyConnectedComponsInfo(OldWholeID, SCSComponent.Whole_ID, tcoTo); WholeComponent.Free; end; end; // Если есть связанный компонент if SCSComponent.IDRelatedCompon <> 0 then begin RelatedComponent := NewList.GetComponentFromReferences(SCSComponent.IDRelatedCompon); if RelatedComponent <> nil then SCSComponent.IDRelatedCompon := RelatedComponent.NewID; end; end; //*** Инфа о подключениях в пределах листа if NewList.FConnectedComponsList.Count > 0 then ConnectedComponsInfoList := NewList.FConnectedComponsList else begin ConnectedComponsInfoList := NewList.GetConnectedComponsInfoForLocalList; ConnectedComponsInfoListCreated := true; end; if ConnectedComponsInfoList <> nil then begin for i := 0 to ConnectedComponsInfoList.Count - 1 do begin ConnectedComponsInfo := ConnectedComponsInfoList[i]; if ConnectedComponsInfo.IDSideCompon > 0 then begin SCSComponent := NewList.GetComponentFromReferences(ConnectedComponsInfo.IDSideCompon); ConnectedComponsInfo.IDSideCompon := -1; if SCSComponent <> nil then ConnectedComponsInfo.IDSideCompon := SCSComponent.NewID; end; if ConnectedComponsInfo.IDConnectCompon > 0 then begin SCSComponent := NewList.GetComponentFromReferences(ConnectedComponsInfo.IDConnectCompon); ConnectedComponsInfo.IDConnectCompon := -1; if SCSComponent <> nil then ConnectedComponsInfo.IDConnectCompon := SCSComponent.NewID; end; if ConnectedComponsInfo.IDConnectObject > 0 then begin SCSCatalog := NewList.GetCatalogFromReferences(ConnectedComponsInfo.IDConnectObject); ConnectedComponsInfo.IDConnectObject := -1; if SCSCatalog <> nil then ConnectedComponsInfo.IDConnectObject := SCSCatalog.NewID; end; //*** Поправить WholeID if (ConnectedComponsInfo.IDSideCompon > 0) and (ConnectedComponsInfo.IDConnectCompon > 0) and (ConnectedComponsInfo.IDConnectObject > 0) then begin WholeIDIndex := WholeIDsOld.IndexOf(ConnectedComponsInfo.ComponWholeID); if WholeIDIndex <> -1 then ConnectedComponsInfo.ComponWholeID := WholeIDsNew[WholeIDIndex]; FConnectedComponsList.InsertRecord(ConnectedComponsInfo.ComponWholeID, ConnectedComponsInfo.IDConnectObject, ConnectedComponsInfo.IDConnectCompon, ConnectedComponsInfo.IDSideCompon, ConnectedComponsInfo.TypeConnect); end; end; if ConnectedComponsInfoListCreated then FreeAndNil(ConnectedComponsInfoList); end; //*** Вся инфа о подключениях нового листа находится на проекте и здесь она больше не нужна NewList.FConnectedComponsList.Clear; // Блобы объектов if NewList.FObjectsBlobs.ObjectsBlobs.Count > 0 then ObjectsBlobs := NewList.ObjectsBlobs else begin ObjectsBlobs := NewList.GetObjectsBlobsForLocalList; ObjectsBlobsCreated := true; end; if ObjectsBlobs <> nil then begin for i := 0 to ObjectsBlobs.ObjectsBlobs.Count - 1 do begin ObjectsBlob := TObjectsBlob(ObjectsBlobs.ObjectsBlobs[i]); if ObjectsBlob.TableKind = tiComponent then begin j := ObjectsBlob.ObjIDs.Count - 1; while j >= 0 do begin SCSComponent := GetComponentFromReferences(ObjectsBlob.ObjIDs[j]); if SCSComponent <> nil then ObjectsBlob.ObjIDs[j] := SCSComponent.NewID else ObjectsBlob.ObjIDs.Delete(j); j := j - 1; end; end; // Если у блоба есть объекты, то перекидываем его в if ObjectsBlob.ObjIDs.Count > 0 then begin ObjectsBlob.ID := GenIDByGeneratorIndex(giObjectsBlobID); FObjectsBlobs.AddObjectsBlob(ObjectsBlob); ObjectsBlobs.ObjectsBlobs[i] := nil; end; end; ObjectsBlobs.ObjectsBlobs.Pack; if ObjectsBlobsCreated then FreeAndNil(ObjectsBlobs); end; //*** Все блобы объектов нового листа находится на проекте и здесь они больше не нужны NewList.FObjectsBlobs.Clear; //*** Нормы КАДа for i := 0 to NewList.FCADNorms.Count - 1 do begin CADNormStruct := TCADNormStruct(NewList.FCADNorms[i]); CADNormStruct.ID := GenIDByGeneratorIndex(giCADNormStructID); for j := 0 to CADNormStruct.FNormColumns.Count - 1 do begin CADNormColumn := TCADNormColumn(CADNormStruct.FNormColumns[j]); CADNormColumn.ID := GenIDByGeneratorIndex(giCADNormColumnID); CADNormColumn.IDCADNormStruct := CADNormStruct.ID; end; end; //*** Инфа о кросах for i := 0 to NewList.FCADCrossObjects.Count - 1 do begin CADCrossObject := TCADCrossObject(NewList.FCADCrossObjects[i]); CADCrossObject.ID := GenIDByGeneratorIndex(giCADCrossObjectID); CADCrossObject.ListID := NewList.SCSID; SCSCatalog := NewList.GetCatalogFromReferences(CADCrossObject.ObjectID); if SCSCatalog <> nil then CADCrossObject.ObjectID := SCSCatalog.NewID else CADCrossObject.ObjectID := -1; for j := 0 to CADCrossObject.Elements.Count - 1 do begin CADCrossObjectElement := TCADCrossObjectElement(CADCrossObject.Elements[j]); CADCrossObjectElement.ID := GenIDByGeneratorIndex(giCADCrossObjectElementID); CADCrossObjectElement.IDCADCrossObject := CADCrossObject.ID; //*** Поле IDComponent SCSComponent := NewList.GetComponentFromReferences(CADCrossObjectElement.IDComponent); if SCSComponent <> nil then CADCrossObjectElement.IDComponent := SCSComponent.NewID else CADCrossObjectElement.IDComponent := -1; //*** Поле ConnectingTraceID CADObjectIndex := CADObjectOldIDList.IndexOf(CADCrossObjectElement.ConnectingTraceID); if CADObjectIndex <> -1 then CADCrossObjectElement.ConnectingTraceID := CADObjectNewIDList[CADObjectIndex] else CADCrossObjectElement.ConnectingTraceID := -1; {SCSinterface := NewList.GetInterfaceByID(CADCrossObjectElement.IDInterface); if SCSinterface <> nil then CADCrossObjectElement.IDInterface := SCSinterface.NewID else CADCrossObjectElement.IDInterface := -1;} end; end; FreeAndNil(CADObjectList); FreeAndNil(CADObjectOldIDList); FreeAndNil(CADObjectNewIDList); FreeAndNil(WholeIDsOld); FreeAndNil(WholeIDsNew); NewListCompRelComplects.Free; NewListCompRelConnections.Free; NewListIOfIRelsConstructiv.Free; NewListIOfIRelsFunctional.Free; NewListInterfacesWithIDConnected.Free; //*** Перебросить ID-ки for i := 0 to NewList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := NewList.ChildCatalogReferences[i]; SCSCatalog.ID := SCSCatalog.NewID; end; for i := 0 to NewList.ComponentReferences.Count - 1 do begin SCSComponent := NewList.ComponentReferences[i]; SCSComponent.ID := SCSComponent.NewID; for j := 0 to SCSComponent.FComplects.Count - 1 do begin ptrCompRel := SCSComponent.FComplects[j]; ptrCompRel.ID_Child := ptrCompRel.ID_NewChild; end; for j := 0 to SCSComponent.FConnections.Count - 1 do begin ptrCompRel := SCSComponent.FConnections[j]; ptrCompRel.ID_Child := ptrCompRel.ID_NewChild; end; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin SCSinterface := SCSComponent.FInterfaces[j]; SCSinterface.ID := SCSinterface.NewID; for k := 0 to SCSInterface.FPortInterfRels.Count - 1 do begin ptrPortInterfRel := SCSInterface.FPortInterfRels[k]; ptrPortInterfRel.IDInterfRel := ptrPortInterfRel.NewIDInterfRel; end; end; end; //Индексы маркировок LookedWholeComponents.Clear; for i := 0 to NewList.FComponentReferences.Count - 1 do begin SCSComponent := NewList.FComponentReferences[i]; //*** Цельнй компонент if LookedWholeComponents.IndexOf(SCSComponent) = -1 then begin ComponOwner := SCSComponent.GetFirstParentCatalog; SCSComponent.MarkID := TF_Main(FActiveForm).GenComponentMarkID(SCSComponent); SCSComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(SCSComponent, ComponOwner, false); if SCSComponent.IsLine = biTrue then begin WholeComponent := NewList.GetComponentsByWholeID(SCSComponent.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; PartComponentOwner := PartComponent.GetFirstParentCatalog; PartComponent.MarkID := SCSComponent.MarkID; PartComponent.NameMark := TF_Main(FActiveForm).MakeNameMarkComponent(PartComponent, PartComponentOwner, false); LookedWholeComponents.Add(PartComponent); end; WholeComponent.Free; end; end; end; LookedWholeComponents.Free; end; if NewList.FTreeViewNode <> nil then begin TF_Main(FActiveForm).AddNodes(NewList.FTreeViewNode); ShowNode(TF_Main(FActiveForm).Tree_Catalog, NewList.FTreeViewNode); end; //*** Удалить межэтажные спуски подъемы BetweenFloorObjectIDs := GetBetweenFloorObjectsID(NewList.FCurrID, true); for i := 0 to BetweenFloorObjectIDs.Count - 1 do begin SCSCatalog := NewList.GetCatalogFromReferencesBySCSID(BetweenFloorObjectIDs[i]); if SCSCatalog <> nil then // Tolik 28/01/2020 //TF_Main(FActiveForm).DeleteCatalog(SCSCatalog, nil, true); ClearDelBetweenFloorRaiseOnCopyList(SCSCatalog); // //TF_Main(FActiveForm).DM.DelCatalog(cfBase, SCSCatalog.ID, SCSCatalog.ItemType); end; BetweenFloorObjectIDs.Free; // Tolik -- 26/04/2017 -- обновить после удаления М-э или магистралей CanRefreshFlag := GCanRefreshCad; CanRefreshTreeFlag := GCanRefreshTree; GCanRefreshTree := True; GCanRefreshCad := True; try GCadForm.PCad.Refresh; Except on E: Exception do; end; GCanRefreshCad := CanRefreshFlag; GCanRefreshTree := GCanRefreshTree; // //08.02.2011 Маркировка объектов нового листа for i := 0 to NewList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := NewList.ChildCatalogReferences[i]; if (SCSCatalog.ItemType = itSCSConnector) and Assigned(SCSCatalog.TreeViewNode) then TF_Main(FActiveForm).DefineConnectorObjectNodeName(SCSCatalog); TF_Main(FActiveForm).F_ChoiceConnectSide.DefineObjectSignature(SCSCatalog); end; FreeAndNil(CompPropRelOldIDs); FreeAndNil(CompPropRelNewIDs); FreeAndNil(ComponOldIDs); FreeAndNil(ComponNewIDs); finally CADEndUpdate(NewCAD); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; //01.07.2013 CorrectStampView; - перенесено в CreateListDuplicate end; // Tolik 26/07/2017 -- if (Not aCopyCompons) {and CanCopyComponsToList)} then begin // Tolik -- 24/07/2017 -*- RefreshFlag := GCanRefreshCad; GCanRefreshCad := False; // try ListToDel := TList.Create; // Tolik -- 28/06/2016 -- //for i := 0 to GCadForm.PCad.FigureCount - 1 do for i := 0 to GCadForm.FSCSFigures.Count - 1 do // begin // Tolik 28/06/2016-- //Figure := TFigure(GCadForm.PCad.Figures.Items[i]); Figure := TFigure(GCadForm.FSCSFigures[i]); // Tolik -- 24/07/2017 -*- if not Figure.deleted then if ListToDel.indexof(Figure) = -1 then begin // if CheckFigureByClassName(Figure, cTConnectorObject) then begin //TConnectorObject(Figure).ID := 0; // Tolik -- 06/03/2017 -- if TConnectorObject(Figure).ConnectorType = ct_Clear then begin TConnectorObject(Figure).FID_ConnToPassage := -1; TConnectorObject(Figure).FID_ListToPassage := -1; end; // ListToDel.Add(Figure); end else if CheckFigureByClassName(Figure, cTOrthoLine) then begin //TOrthoLine(Figure).ID := 0; ListToDel.Add(Figure); end else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then begin SCSFigureGrp := TSCSFigureGrp(Figure); ListToDel.Add(Figure); end; end; end; if ListToDel.Count > 0 then begin for i := ListToDel.Count - 1 downto 0 do begin Figure := TFigure(ListToDel[i]); if CheckFigureByClassName(Figure, cTConnectorObject) then TConnectorObject(Figure).Delete else if CheckFigureByClassName(Figure, cTOrthoLine) then TOrthoLine(Figure).Delete else if CheckFigureByClassName(Figure, cTSCSFigureGrp) then TSCSFigureGrp(Figure).Delete; end; //RefreshCAD(GCadForm.PCad); end; FreeAndNil(ListToDel); except on E: Exception do AddExceptionToLogExt('U_SCSComponent', 'CopyList:removeSCSObjects', E.Message); end; // Tolik 24/07/2017 -- GCanRefreshCad := True; GCadForm.PCad.Refresh; GCanRefreshCad := RefreshFlag; //RefreshCAD(GCadForm.PCad); // end; // if (aCopyCompons and (not CanCopyComponsToList)) then ShowMessage(cSCSComponent_Msg_23); Result := NewList; end; function TSCSProject.DefineNBDir: Boolean; var DirExists: Boolean; CurrDirID: Integer; NBTopUserNode: TTreeNode; NewNBDirNode: TTreeNode; NewDirName: String; OldSettings: TProjectSettingRecord; begin Result := false; ClearNBDirInfo; DirExists := false; CurrDirID := 0; if Setting.GUIDNBDir <> '' then begin CurrDirID := TF_Main(FActiveForm).FNormBase.DM.GetIntFromTableByGUID(tnCatalog, fnID, Setting.GUIDNBDir, qmPhisical); if CurrDirID <> 0 then begin DirExists := true; FNBDirID := CurrDirID; FNBDirNode := TF_Main(FActiveForm).FNormBase.FindComponOrDirInTree(CurrDirID, false); if FNBDirNode <> nil then Result := true; end; end; //*** папку не удалось найти, тогда создаем if Not DirExists then begin NBTopUserNode := TF_Main(FActiveForm).FNormBase.GetTopNodeByNBMode(nbmUser, itDir); if NBTopUserNode <> nil then begin NewDirName := cSCSComponent_Msg12 + ' "'+ GetNameForVisible+'"'; NewNBDirNode := TF_Main(FActiveForm).FNormBase.MakeDir(cfBase, NBTopUserNode, NewDirName, itDir, nil); if NewNBDirNode <> nil then begin Result := true; FNBDirID := PObjectData(NewNBDirNode.Data).ObjectID; FNBDirNode := NewNBDirNode; Setting.GUIDNBDir := TF_Main(FActiveForm).FNormBase.DM.GetStringFromTableByID(tnCatalog, fnGuid, FNBDirID, qmPhisical); //*** сохранить гуид на папку в настройках проекта OldSettings := GetProjectSettings(FCurrID); OldSettings.GUIDNBDir := Setting.GUIDNBDir; SaveSettings(OldSettings); end; end; end; end; procedure TSCSProject.DefineSpravObjectIconFromCAD(AGUIDIcon: String; ASrcSCSObject: TSCSCatalog); var ObjectIconParams: TObjectIconParams; SprObjectIcon: TNBObjectIcon; begin if FSpravochnik.GetObjectIconByGUID(AGUIDIcon) = nil then if ASrcSCSObject <> nil then begin ObjectIconParams := GetObjectBlockByID(ASrcSCSObject.ListID, ASrcSCSObject.SCSID, false); if (ObjectIconParams.GUIDIcon <> '') or (ObjectIconParams.IDIcon > 0) then if (ObjectIconParams.GUIDIcon = AGUIDIcon) then begin ObjectIconParams := GetObjectBlockByID(ASrcSCSObject.ListID, ASrcSCSObject.SCSID, true); if (ObjectIconParams.IconBLK <> nil) and (ObjectIconParams.IconBMP <> nil) then begin SprObjectIcon := TNBObjectIcon.Create(FSpravochnik.FActiveForm); FSpravochnik.AddObjectIcon(SprObjectIcon); SprObjectIcon.ID := ObjectIconParams.IDIcon; SprObjectIcon.GUID := ObjectIconParams.GUIDIcon; SprObjectIcon.Name := cSCSComponent_Msg15; CopyStream(SprObjectIcon.ProjBlk, ObjectIconParams.IconBLK); CopyStream(SprObjectIcon.ActiveBlk, ObjectIconParams.IconBLK); ObjectIconParams.IconBMP.SaveToStream(SprObjectIcon.ProjBmp); ObjectIconParams.IconBMP.SaveToStream(SprObjectIcon.ActiveBmp); end; end; //Очистить память нах if ObjectIconParams.IconBLK <> nil then ObjectIconParams.IconBLK.Free; if ObjectIconParams.IconBMP <> nil then ObjectIconParams.IconBMP.Free; end; end; procedure TSCSProject.DefineSpravDataFromOtherSpravByNewGUIDs(ASpravochnik: Tspravochnik); var i: Integer; begin FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(ASpravochnik); for i := 0 to FProjectLists.Count - 1 do FProjectLists[i].FSpravochnik.DefineDataFromOtherSpravByNewGUIDs(ASpravochnik); end; procedure TSCSProject.DeleteObjectsBlobByParams(ATableKind, ADataKind, AObjectID: Integer; AObjectIDs: TIntList); var ObjectIDs: TIntList; ObjBlob: TObjectsBlob; i, j: integer; begin //if AObjectID <> 0 then // begin // ObjBlob := GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID); // if ObjBlob <> nil then // begin // ObjBlob.FObjIDs.Remove(AObjectID); // if ObjBlob.FObjIDs.Count = 0 then // ObjBlob.FOwner.DeleteObjectsBlob(ObjBlob); // end; // end; ObjBlob := GetObjectsBlobByParams(ATableKind, ADataKind, AObjectID); if ObjBlob <> nil then begin if AObjectID <> 0 then ObjBlob.ObjIDs.Remove(AObjectID); if ObjBlob.ObjIDs.Count = 0 then ObjBlob.Owner.DeleteObjectsBlob(ObjBlob); end; // Удаляем по списку ID if AObjectIDs <> nil then begin ObjectIDs := TIntList.Create; ObjectIDs.Assign(AObjectIDs); for i := 0 to ObjectIDs.Count - 1 do begin if ObjectIDs[i] <> 0 then begin ObjBlob := GetObjectsBlobByParams(ATableKind, ADataKind, ObjectIDs[i]); if ObjBlob <> nil then begin for j := 0 to ObjectIDs.Count - 1 do begin if ObjectIDs[j] <> 0 then begin ObjBlob.ObjIDs.Remove(ObjectIDs[j]); ObjectIDs[j] := 0; end; end; if ObjBlob.ObjIDs.Count = 0 then ObjBlob.Owner.DeleteObjectsBlob(ObjBlob); end; end; end; FreeAndNil(ObjectIDs); end; end; // Генерит маркировку для компонентов, которые требуется домаркировать procedure TSCSProject.FinishMarkingCompons; //15.01.2011 var i, j : Integer; Compon: TSCSComponent; WholeCompons: TSCSComponents; PartCompon: TSCSComponent; PartComponMarked: TSCSComponent; procedure SetMarkID(ACompon: TSCSComponent; AMarkID: Integer); begin ACompon.MarkID := AMarkID; ACompon.ServToMark := false; ApplyChangeComponMarkID(ACompon, true, true, nil); end; begin try for i := 0 to FComponentReferences.Count - 1 do begin Compon := FComponentReferences[i]; if Compon.ServToMark then begin if Compon.Whole_ID <> 0 then begin WholeCompons := GetComponentsByWholeID(Compon.Whole_ID); PartComponMarked := nil; // Если среди кусков есть ранее промаркирован for j := 0 to WholeCompons.Count - 1 do begin PartCompon := WholeCompons[j]; if Not PartCompon.ServToMark then begin PartComponMarked := PartCompon; Break; //// BREAK //// end; end; // Если не нашли, то генерим маркировку if PartComponMarked = nil then begin SetMarkID(Compon, GenComponentMarkIDByMode(Compon, Setting.PointComonIndexingMode, Setting.PointComplIndexingMode)); PartComponMarked := Compon; end; // Ставим маркировку для участков for j := 0 to WholeCompons.Count - 1 do begin PartCompon := WholeCompons[j]; if PartCompon.ServToMark then SetMarkID(PartCompon, PartComponMarked.MarkID); end; FreeAndNil(WholeCompons); end else SetMarkID(Compon, GenComponentMarkIDByMode(Compon, Setting.PointComonIndexingMode, Setting.PointComplIndexingMode)); end; end; except on E: Exception do AddExceptionToLogExt(ClassName, 'FinishMarkingCompons', E.Message); end; end; function TSCSProject.GenIDByGeneratorIndex(AGeneratorIndex: Integer; AIncrement: Integer = 1): Integer; var ptrLastGenValue: ^Integer; begin Result := 0; ptrLastGenValue := nil; case AGeneratorIndex of giKatalogID: ptrLastGenValue := @FGenerators.LastGen_KatalogID; giKatalogSCSID: ptrLastGenValue := @FGenerators.LastGen_KatalogSCSID; giCatalogRelationID: ptrLastGenValue := @FGenerators.LastGen_CatalogRelationID; giComponentID: ptrLastGenValue := @FGenerators.LastGen_ComponentID; giComponentWholeID: ptrLastGenValue := @FGenerators.LastGen_ComponentWholeID; giCatalogPropRelationID: ptrLastGenValue := @FGenerators.LastGen_CatalogPropRelationID; giComponentRelationID: ptrLastGenValue := @FGenerators.LastGen_ComponentRelationID; giCompPropRelationID: ptrLastGenValue := @FGenerators.LastGen_CompPropRelationID; giCableCanalConnectorsID: ptrLastGenValue := @FGenerators.LastGen_CableCanalConnectorsID; giConnectedComponentsID: ptrLastGenValue := @FGenerators.LastGen_ConnectedComponentsID; giInterfaceRelationID: ptrLastGenValue := @FGenerators.LastGen_InterfaceRelationID; giInterfOfInterfRelationID: ptrLastGenValue := @FGenerators.LastGen_InterfOfInterfRelationID; giPortInterfaceRelationID: ptrLastGenValue := @FGenerators.LastGen_PortInterfaceRelationID; giNormsID: ptrLastGenValue := @FGenerators.LastGen_NormsID; giNormResourceRelID: ptrLastGenValue := @FGenerators.LastGen_NormResourceRelID; giResourcesID: ptrLastGenValue := @FGenerators.LastGen_ResourcesID; giCADNormStructID: ptrLastGenValue := @FGenerators.LastGen_CADNormStructID; giCADNormColumnID: ptrLastGenValue := @FGenerators.LastGen_CADNormColumnID; giInterfPosConnectionID: ptrLastGenValue := @FGenerators.LastGen_InterfPosConnection; giCADCrossObjectID: ptrLastGenValue := @FGenerators.LastGen_CADCrossObject; giCADCrossObjectElementID: ptrLastGenValue := @FGenerators.LastGen_CADCrossObjectElement; giStringID: ptrLastGenValue := @FGenerators.LastGen_StringID; giFilterinfoID: ptrLastGenValue := @FGenerators.LastGen_FilterInfoID; giObjectsBlobID: ptrLastGenValue := @FGenerators.LastGen_ObjectsBlobs; end; if ptrLastGenValue <> nil then begin if AIncrement > 0 then Inc(ptrLastGenValue^, AIncrement); Result := ptrLastGenValue^; end else raise Exception.Create(cSCSComponent_Msg7+' '+IntToStr(AGeneratorIndex)); end; function TSCSProject.GetScriptForCreatePortInterfaceRelation: String; begin Result := ' CREATE TABLE PORT_INTERFACE_RELATION ( '+ ' ID AUTOINC, '+ ' ID_PORT INTEGER, '+ ' ID_INTERF_REL INTEGER); '; // ' ALTER TABLE PORT_INTERFACE_RELATION ADD PRIMARY KEY PK_PORT_INTERF_REL (ID); '; // ' ALTER TABLE PORT_INTERFACE_RELATION ADD FOREIGN KEY FK_PORTINTERF_RELATION (ID_PORT) REFERENCES INTERFACE_RELATION MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '; // ' CREATE INDEX PORT_INTERF_REL_IDX1 ON PORT_INTERFACE_RELATION (ID_INTERF_REL); '; end; function TSCSProject.GetScriptForCreateSpravochniks: String; begin Result := ' '+ 'CREATE TABLE COMPONENT_TYPES ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID VARCHAR(40), '+ 'NAME VARCHAR(255), '+ 'NAME_PLURAL VARCHAR(255), '+ 'SYSNAME VARCHAR(100), '+ 'PORT_KIND INTEGER DEFAULT 0, '+ 'ACTIVE_STATE INTEGER DEFAULT 0, '+ 'ISLINE INTEGER DEFAULT 0, '+ 'ISSTANDART INTEGER DEFAULT 0, '+ 'MARK_MASK VARCHAR(200), '+ 'ID_DESIGN_ICON INTEGER, '+ 'COORDZ FLOAT, '+ 'PROPS_COUNT INTEGER, '+ 'COMPONENT_INDEX INTEGER'+ '); '+ 'CREATE TABLE COMP_TYPE_PROP_RELATION ( '+ 'ID INTEGER NOT NULL, '+ 'GUID VARCHAR(40), '+ 'GUID_COMPONENT_TYPE VARCHAR(40), '+ 'GUID_PROPERTY VARCHAR(40), '+ 'ID_COMPONENT_TYPE INTEGER, '+ 'ID_PROPERTY INTEGER, '+ 'PVALUE VARCHAR(255), '+ 'TAKE_INTO_CONNECT INTEGER DEFAULT 0, '+ 'TAKE_INTO_JOIN INTEGER, '+ 'ISSTANDART INTEGER DEFAULT 0 '+ '); '+ 'CREATE TABLE INTERFACE ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID VARCHAR(40), '+ 'NAME VARCHAR(255), '+ 'GUID_NET_TYPE VARCHAR(40), '+ 'ID_NET_TYPE INTEGER, '+ 'SORT_ID INTEGER, '+ 'CONSTRUCTIVE_WIDTH FLOAT, '+ 'INTERF_NORMS_COUNT INTEGER'+ '); '+ 'CREATE TABLE INTERFACE_NORMS ( '+ 'ID INTEGER NOT NULL, '+ 'GUID VARCHAR(40), '+ 'GUID_INTERFACE VARCHAR(40), '+ 'ID_INTERFACE INTEGER, '+ 'GUID_NB_NORM VARCHAR(40), '+ 'ID_NB_NORM INTEGER, '+ 'EXPENSE FLOAT, '+ 'INTERFACE_ISBUSY INTEGER DEFAULT 0 '+ '); '; end; procedure TSCSProject.UpdateAfterOpenFromFileStream; var i: Integer; IDPointerFields: TStringList; GUIDPointerFields: TStringList; begin if FIDFromOpened <> 0 then if FIDFromOpened <> FCurrID then try with TF_Main(FActiveForm).DM do begin //*** Выстроить ID-ки указатели на проект tSQL_Katalog.Filtered := false; for i := 0 to tSQL_Katalog.RecordCount - 1 do begin tSQL_Katalog.RecNo := i+1; if tSQL_Katalog.FieldByName(fnParentID).AsInteger = FIDFromOpened then begin tSQL_Katalog.Edit; tSQL_Katalog.FieldByName(fnParentID).AsInteger := 0; //FCurrID; tSQL_Katalog.Post; end; //tSQL_Katalog.Edit; //tSQL_Katalog.FieldByName(fnProjectID).AsInteger := FCurrID; //if tSQL_Katalog.FieldByName(fnParentID).AsInteger = FIDFromOpened then // tSQL_Katalog.FieldByName(fnParentID).AsInteger := 0; //FCurrID; //tSQL_Katalog.Post; end; //tSQL_Component.Filtered := false; //for i := 0 to tSQL_Component.RecordCount - 1 do //begin // tSQL_Component.RecNo := i+1; // tSQL_Component.Edit; // tSQL_Component.FieldByName(fnProjectID).AsInteger := FCurrID; // tSQL_Component.Post; //end; //*** Определить поля указатели на таблици с НБ { IDPointerFields := TStringList.Create; GUIDPointerFields := TStringList.Create; try IDPointerFields.Add(fnIDProperty); GUIDPointerFields.Add(fnGUIDProperty); DefineIDPointer(tnCatalogPropRelation, IDPointerFields, GUIDPointerFields); DefineIDPointer(tnCompPropRelation, IDPointerFields, GUIDPointerFields); IDPointerFields.Clear; IDPointerFields.Add(fnIDComponentType); IDPointerFields.Add(fnIDSymbol); IDPointerFields.Add(fnIDObjectIcon); IDPointerFields.Add(fnIDProducer); IDPointerFields.Add(fnIDSuppliesKind); IDPointerFields.Add(fnIDSupplier); IDPointerFields.Add(fnIDNetType); GUIDPointerFields.Clear; GUIDPointerFields.Add(fnGUIDComponentType); GUIDPointerFields.Add(fnGUIDSymbol); GUIDPointerFields.Add(fnGUIDObjectIcon); GUIDPointerFields.Add(fnGUIDProducer); GUIDPointerFields.Add(fnGUIDSuppliesKind); GUIDPointerFields.Add(fnGUIDSupplier); GUIDPointerFields.Add(fnGUIDNetType); DefineIDPointer(tnComponent, IDPointerFields, GUIDPointerFields); IDPointerFields.Clear; IDPointerFields.Add(fnIDNBConnector); GUIDPointerFields.Clear; GUIDPointerFields.Add(fnGuidNBConnector); DefineIDPointer(tnCableCanalConnectors, IDPointerFields, GUIDPointerFields); IDPointerFields.Clear; IDPointerFields.Add(fnIDInterface); GUIDPointerFields.Clear; GUIDPointerFields.Add(fnGUIDInterface); DefineIDPointer(tnInterfaceRelation, IDPointerFields, GUIDPointerFields); finally IDPointerFields.Free; GUIDPointerFields.Free; end;} end; finally //FIDFromOpened := 0; end; end; procedure TSCSProject.UpdateStructure; var UpdateSQL: String; BuildID: Integer; begin UpdateSQL := ''; BuildID := FBuildID; with TF_Main(ActiveForm).DM do begin try qSQL_QueryTSCSOperat.Close; if BuildID = 0 then begin UpdateSQL := GetSQLForAddFieldToTable(tnComponent, fnCypher, ftString, 200, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnResources, fnAdditionalPrice, ftFloat, -1, qmMemory); Inc(BuildID); end; if BuildID = 1 then begin UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGuidNB, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDComponentType, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDSymbol, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDObjectIcon, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDProducer, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDSupplier, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDNetType, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCatalogPropRelation, fnGuidProperty, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCableCanalConnectors, fnGuidNBConnector, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCompPropRelation, fnGuidProperty, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnInterfaceRelation, fnGuidInterface, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnNorms, fnGuidNB, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnResources, fnGuidNB, ftString, cnstGUIDLength, qmMemory); Inc(BuildID); end; if BuildID = 2 then begin UpdateSQL := UpdateSQL +' '+GetScriptForCreatePortInterfaceRelation; Inc(BuildID); end; if BuildID = 3 then begin try qSQL_QueryTSCSOperat.Close; qSQL_QueryTSCSOperat.SQL.Text := 'drop table '+tnCatalogMarkMask+' CASCADE '; qSQL_QueryTSCSOperat.Open; except end; qSQL_QueryTSCSOperat.Close; Inc(BuildID); end; if BuildID = 4 then begin UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGuidSuppliesKind, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnNorms, fnIsFromInterface, ftInteger, cnstGUIDLength, qmMemory); end; if UpdateSQL <> '' then begin qSQL_QueryTSCSOperat.SQL.Text := UpdateSQL; qSQL_QueryTSCSOperat.Open; end; except {on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end;} end; end; end; procedure TSCSProject.UpdateStructureAfterUpdateValue; var UpdateSQL: String; BuildID: Integer; begin BuildID := FBuildID; with TF_Main(FActiveForm).DM do begin end; end; procedure TSCSProject.UpdateValues; var BuildID: Integer; i: Integer; BufIDNB: Integer; ComponCypher: String; BufGuid: String; procedure UpdateNewGUIDField(AMemTable: TSQLMemTable; AIDFieldName, AGUIDFieldName: String); var NBTableName: String; i: Integer; begin NBTableName := GetTableNameByGUIDFieldPointer(AGUIDFieldName); for i := 0 to AMemTable.RecordCount - 1 do begin AMemTable.RecNo := i+1; WriteToSQLMemTable(AMemTable, AGUIDFieldName, F_NormBase.DM.GetStringFromTableByID(NBTableName, fnGUID, AMemTable.FieldByName(AIDFieldName).AsInteger, qmPhisical)); end; end; begin BuildID := FBuildID; with TF_Main(ActiveForm).DM do begin if BuildID = 0 then begin //*** Загрузить шифр от компоненты с нормативной базы for i := 0 to tSQL_Component.RecordCount - 1 do begin tSQL_Component.RecNo := i+1; BufIDNB := tSQL_Component.FieldByName(fnIDNormbase).AsInteger; ComponCypher := ''; with F_NormBase.DM do ComponCypher := GetComponFldValueAsString(BufIDNB, fnCypher); tSQL_Component.Edit; tSQL_Component.FieldByName(fnCypher).AsString := ComponCypher; tSQL_Component.Post; end; Inc(BuildID); end; if BuildID = 1 then begin //*** Загрузить GUIDы в компоненты for i := 0 to tSQL_Component.RecordCount - 1 do begin tSQL_Component.RecNo := i+1; BufIDNB := tSQL_Component.FieldByName(fnIDNormbase).AsInteger; tSQL_Component.Edit; tSQL_Component.FieldByName(fnGuidNB).AsString := F_NormBase.DM.GetComponFldValueAsString(BufIDNB, fnGUID); tSQL_Component.FieldByName(fnGUIDComponentType).AsString := F_NormBase.DM.GetStringFromTableByID(tnComponentTypes, fnGUID, tSQL_Component.FieldByName(fnIDComponentType).AsInteger, qmPhisical); tSQL_Component.FieldByName(fnGUIDSymbol).AsString := F_NormBase.DM.GetStringFromTableByID(tnObjectIcons, fnGUID, tSQL_Component.FieldByName(fnIDSymbol).AsInteger, qmPhisical); tSQL_Component.FieldByName(fnGUIDObjectIcon).AsString := F_NormBase.DM.GetStringFromTableByID(tnObjectIcons, fnGUID, tSQL_Component.FieldByName(fnIDObjectIcon).AsInteger, qmPhisical); tSQL_Component.FieldByName(fnGUIDProducer).AsString := F_NormBase.DM.GetStringFromTableByID(tnProducers, fnGUID, tSQL_Component.FieldByName(fnIDProducer).AsInteger, qmPhisical); tSQL_Component.FieldByName(fnGUIDSupplier).AsString := F_NormBase.DM.GetStringFromTableByID(tnSupplier, fnGUID, tSQL_Component.FieldByName(fnIDSupplier).AsInteger, qmPhisical); tSQL_Component.FieldByName(fnGUIDNetType).AsString := F_NormBase.DM.GetStringFromTableByID(tnNetType, fnGUID, tSQL_Component.FieldByName(fnIDNetType).AsInteger, qmPhisical); tSQL_Component.Post; end; UpdateNewGUIDField(tSQL_CatalogPropRelation, fnIDProperty, fnGuidProperty); UpdateNewGUIDField(tSQL_CableCanalConnectors, fnIDNBConnector, fnGuidNBConnector); UpdateNewGUIDField(tSQL_CompPropRelation, fnIDProperty, fnGuidProperty); UpdateNewGUIDField(tSQL_InterfaceRelation, fnIDInterface, fnGuidInterface); //*** Загрузить GUIDы с норманивной базы норм в нормы проекта for i := 0 to tSQL_Norms.RecordCount - 1 do begin tSQL_Norms.RecNo := i+1; BufIDNB := tSQL_Norms.FieldByName(fnIDNB).AsInteger; BufGuid := ''; with F_NormBase.DM do BufGuid := GetStringFromTableByID(tnNBNorms, fnGUID, BufIDNB, qmPhisical); if BufGuid <> '' then begin tSQL_Norms.Edit; tSQL_Norms.FieldByName(fnGuidNB).AsString := BufGuid; tSQL_Norms.Post; end; end; //*** Загрузить GUIDы с норманивной базы ресурсов в ресурсы проекта for i := 0 to tSQL_Resources.RecordCount - 1 do begin tSQL_Resources.RecNo := i+1; BufIDNB := tSQL_Resources.FieldByName(fnIDNB).AsInteger; BufGuid := ''; with F_NormBase.DM do BufGuid := GetStringFromTableByID(tnNBResources, fnGUID, BufIDNB, qmPhisical); if BufGuid <> '' then begin tSQL_Resources.Edit; tSQL_Resources.FieldByName(fnGuidNB).AsString := BufGuid; tSQL_Resources.Post; end; end; Inc(BuildID); end; end; //FBuildID := CurrentBuildID; end; {procedure TSCSProject.UpdateValuesAfterLoadFromMemTablesToClasses; var BuildID: Integer; i, j: Integer; SCSComponent: TSCSComponent; Interf: TSCSInterface; begin BuildID := FBuildID; while BuildID < 6 do Inc(BuildID); if BuildID = 6 then begin //*** Многократные интерфейсы для сечения for i := 0 to FComponentReferences.Count - 1 do begin SCSComponent := FComponentReferences[i]; if SCSComponent.IsLine = biTrue then for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin Interf := SCSComponent.FInterfaces[j]; if (Interf.TypeI = itConstructive) and (Interf.Multiple = biFalse) and (Interf.ValueI > 0) then Interf.Multiple := biTrue; end; end; Inc(BuildID); end; end; } { procedure TSCSProject.DeleteAllIndexes; var CurrTable: TSQLMemTable; i, j: Integer; HaveNoPrimaryIndex: Boolean; begin with TF_Main(ActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); //CurrTable.DeleteAllIndexes; HaveNoPrimaryIndex := true; while HaveNoPrimaryIndex do begin HaveNoPrimaryIndex := false; for j := 0 to CurrTable.IndexDefs.Count - 1 do if Not(ixPrimary in CurrTable.IndexDefs[j].Options) then begin HaveNoPrimaryIndex := true; CurrTable.IndexDefs.Delete(j); Break; ///// BREAK ///// end; end; end; end;} (* procedure TSCSProject.DeleteAllTables; var CurrTable: TSQLMemTable; i: Integer; begin //DeleteAllIndexes; with TF_Main(ActiveForm).DM do begin //TSQLMemTable(SQLMemTsbles[0]).Database.DeleteDatabase; for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists then begin //CurrTable.DeleteAllIndexes; CurrTable.DeleteTable(true); end; end; { if tSQL_Katalog.Exists then tSQL_Katalog.DeleteTable(true); if tSQL_CatalogRelation.Exists then tSQL_CatalogRelation.DeleteTable(true); if tSQL_Component.Exists then tSQL_Component.DeleteTable(true); if tSQL_CatalogMarkMask.Exists then tSQL_CatalogMarkMask.DeleteTable(true); if tSQL_CatalogPropRelation.Exists then tSQL_CatalogPropRelation.DeleteTable(true); if tSQL_ComponentRelation.Exists then tSQL_ComponentRelation.DeleteTable(true); if tSQL_CompPropRelation.Exists then tSQL_CompPropRelation.DeleteTable(true); if tSQL_CableCanalConnectors.Exists then tSQL_CableCanalConnectors.DeleteTable(true); if tSQL_ConnectedComponents.Exists then tSQL_ConnectedComponents.DeleteTable(true); if tSQL_InterfaceRelation.Exists then tSQL_InterfaceRelation.DeleteTable(true); if tSQL_InterfOfInterfRelation.Exists then tSQL_InterfOfInterfRelation.DeleteTable(true); if tSQL_PortInterfaceRelation.Exists then tSQL_PortInterfaceRelation.DeleteTable(true); if tSQL_Norms.Exists then tSQL_Norms.DeleteTable(true); if tSQL_NormResourceRel.Exists then tSQL_NormResourceRel.DeleteTable(true); if tSQL_Resources.Exists then tSQL_Resources.DeleteTable(true); } end; end; *) (* procedure TSCSProject.EmptyAllTables; procedure DeleteTableRecords(ATable: TSQLMemTable); var SavedBeforeDelete: TDataSetNotifyEvent; begin ATable.Filtered := false; SavedBeforeDelete := ATable.BeforeDelete; ATable.BeforeDelete := nil; try ATable.Close; ATable.EmptyTable; ATable.Open; //ATable.DeleteVisibleRecords; //TF_Main(FActiveForm).DM.DeleteRecords(ATable); finally ATable.BeforeDelete := SavedBeforeDelete; end; end; begin FMemBase.CloseAllTables; FMemBase.DeleteAllTables; FMemBase.CreateAllTables; with TF_Main(FActiveForm).DM do begin{ if tSQL_Katalog.Active then DeleteTableRecords(tSQL_Katalog); if tSQL_CatalogRelation.Active then DeleteTableRecords(tSQL_CatalogRelation); if tSQL_Component.Active then DeleteTableRecords(tSQL_Component); if tSQL_CatalogMarkMask.Active then DeleteTableRecords(tSQL_CatalogMarkMask); if tSQL_CatalogPropRelation.Active then DeleteTableRecords(tSQL_CatalogPropRelation); if tSQL_ComponentRelation.Active then DeleteTableRecords(tSQL_ComponentRelation); if tSQL_CompPropRelation.Active then DeleteTableRecords(tSQL_CompPropRelation); if tSQL_CableCanalConnectors.Active then DeleteTableRecords(tSQL_CableCanalConnectors); if tSQL_ConnectedComponents.Active then DeleteTableRecords(tSQL_ConnectedComponents); if tSQL_InterfaceRelation.Active then DeleteTableRecords(tSQL_InterfaceRelation); if tSQL_InterfOfInterfRelation.Active then DeleteTableRecords(tSQL_InterfOfInterfRelation); if tSQL_PortInterfaceRelation.Active then DeleteTableRecords(tSQL_PortInterfaceRelation); if tSQL_Norms.Active then DeleteTableRecords(tSQL_Norms); if tSQL_NormResourceRel.Active then DeleteTableRecords(tSQL_NormResourceRel); if tSQL_Resources.Active then DeleteTableRecords(tSQL_Resources); } { //if tSQL_Resources.Exists then tSQL_Resources.EmptyTable; //if tSQL_NormResourceRel.Exists then tSQL_NormResourceRel.EmptyTable; //ForeignKeyDefs[0].ReferencedTableName //if tSQL_Norms.Exists then tSQL_Norms.EmptyTable; //if tSQL_ConnectedComponents.Exists then tSQL_ConnectedComponents.EmptyTable; //if tSQL_CableCanalConnectors.Exists then tSQL_CableCanalConnectors.EmptyTable; //if tSQL_CompPropRelation.Exists then tSQL_CompPropRelation.EmptyTable; //if tSQL_ComponentRelation.Exists then tSQL_ComponentRelation.EmptyTable; //if tSQL_InterfOfInterfRelation.Exists then tSQL_InterfOfInterfRelation.EmptyTable; //if tSQL_PortInterfaceRelation.Exists then tSQL_PortInterfaceRelation.EmptyTable; //if tSQL_InterfaceRelation.Exists then tSQL_InterfaceRelation.EmptyTable; //if tSQL_Component.Exists then tSQL_Component.EmptyTable; //if tSQL_CatalogRelation.Exists then tSQL_CatalogRelation.EmptyTable; //if tSQL_CatalogPropRelation.Exists then tSQL_CatalogPropRelation.EmptyTable; //if tSQL_CatalogMarkMask.Exists then tSQL_CatalogMarkMask.EmptyTable; //if tSQL_Katalog.Exists then tSQL_Katalog.EmptyTable; } end; end; *) function TSCSProject.Open(AID: Integer; AOpenProjectMode: TOpenProjectMode): TOpenProjectResult; var OldExceptionCount: Integer; Stream: TMemoryStream; StreamSize: Integer; // Tolik 28/08/2019 -- //OldTick, PrevTick, CurrTick: Cardinal; OldTick, PrevTick, CurrTick: DWord; // // Tolik ProgressPaused: Boolean; // begin OldTick := GetTickCount; // Tolik 10/11/2016 -- GProjectHasBrokenFigures := False; ProgressPaused := False; // try Result.OpenProjectState := []; Result.UserName := ''; if GetGuiResources(GetCurrentProcess, GR_GDIOBJECTS) > MaxGDIObjects then Result.OpenProjectState := Result.OpenProjectState + [opsNoEnoughGDI]; if Not CheckProjectInUse(AID, Result.UserName, Result.UserDateTime) then begin if Result.OpenProjectState = [] then begin OldExceptionCount := GExceptionCount; //*** Открыть блок из параметров FCanOpenFromBeatenBlock := false; FOpenProjectMode := AOpenProjectMode; inherited Open(AID); PrevTick := GetTickCount - OldTick; if FOpenProjectMode = opmStandart then begin Stream := nil; try //*** Сохранить проект в резерв if GExceptionCount = OldExceptionCount then begin Stream := GetStreamFromTableByID(tnCatalog, fnPMBlock, CurrID, FQSelect); SetStreamToTableByID(tnCatalog, fnCADBlock, CurrID, Stream, FQOperat); //*** Определить, есть ли битый блок FreeAndNil(Stream); Stream := GetStreamFromTableByID(tnCatalog, fnBeatenBlock, CurrID, FQSelect); StreamSize := Stream.Size; if StreamSize > 0 then FCanOpenFromBeatenBlock := true; end else if GExceptionCount > OldExceptionCount then begin Stream := GetStreamFromTableByID(tnCatalog, fnCADBlock, CurrID, FQSelect); StreamSize := Stream.Size; if StreamSize > 0 then begin // Tolik --10/11/2016-- if GisProgress then begin ProgressPaused := true; PauseProgress(true); end; // if MessageModal(cSCSComponent_Msg8, ApplicationName, MB_YESNO or MB_ICONQUESTION) = IDYES then begin // Tolik -- 10/11/2016 -- if ProgressPaused then begin PauseProgress(False); ProgressPaused := False; end; // ProcessMessagesEx; BeginProgress; try //*** Сохранить битый блок FreeAndNil(Stream); Stream := GetStreamFromTableByID(tnCatalog, fnPMBlock, CurrID, FQSelect); SetStreamToTableByID(tnCatalog, fnBeatenBlock, CurrID, Stream, FQOperat); FreeAndNil(Stream); //*** Закрыть хреново открытый проект try Close; except end; //*** Открыть из резерва FOpenProjectMode := opmReserv; inherited Open(AID); FCanOpenFromBeatenBlock := true; finally EndProgress; end; end else begin // Tolik -- 10/11/2016 -- if ProgressPaused then begin PauseProgress(False); ProgressPaused := False; end; end; // end else // Tolik -- 10/11/2016-- если были битые фигуры if GProjectHasBrokenFigures then begin if GisProgress then begin ProgressPaused := true; PauseProgress(true); end; if MessageModal(cSCSComponent_Msg8, ApplicationName, MB_YESNO or MB_ICONQUESTION) = IDYES then begin if ProgressPaused then begin PauseProgress(False); ProgressPaused := False; end; ProcessMessagesEx; BeginProgress; try //*** Закрыть хреново открытый проект try Close; except end; //*** Открыть из резерва FOpenProjectMode := opmReserv; inherited Open(AID); FCanOpenFromBeatenBlock := true; finally EndProgress; end; GProjectHasBrokenFigures := False; end else begin if ProgressPaused then begin PauseProgress(False); ProgressPaused := False; end; end; end; // ----- --- -- end; finally if Stream <> nil then FreeAndNil(Stream); end; end; Result.OpenProjectState := [opsSuccessful]; end; end else Result.OpenProjectState := Result.OpenProjectState + [opsInUse]; if Not(opsSuccessful in Result.OpenProjectState) then Result.OpenProjectState := Result.OpenProjectState + [opsFoul]; except end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; // ##### Загрузка настроек Проекта ##### procedure TSCSProject.Load; //var SettingsStream: TStream; // StreamSize: Integer; begin try if FCurrID < 1 then Exit; //// EXIT ///// //StreamSize := 0; SetSQLToFIBQuery(FQSelect, ' select /*settings,*/ id_last_list, build_id, '+fnNBBuildID+', id_from_opened from katalog '+ ' where (id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itProject)+''') '); //SettingsStream := TMemoryStream.Create; //SettingsStream.Position := 0; //FQuery_Select.FNSaveToStream('Settings', SettingsStream); //StreamSize := SettingsStream.Size; FIDLastList := FQSelect.FN(fnIDLastList).AsInteger; FBuildID := FQSelect.FN(fnBuildID).AsInteger; FNBBuildID := FQSelect.FN(fnNBBuildID).AsInteger; FIDFromOpened := FQSelect.FN(fnIDFromOpened).AsInteger; FQSelect.Close; //SettingsStream.Position := 0; //if StreamSize = sizeof(Setting) then // SettingsStream.ReadBuffer(Setting, sizeof(Setting)); //FreeAndNil(SettingsStream); Setting := GetProjectSettings(FCurrID); if FBuildID = 0 then Setting := GetDefaultProjectSettings; OldSetting := Setting; DefListSettings := GetDefListSettings(FCurrID); //04.04.2011 if DefListSettings.CADCaptionsKind = skExternalSCS then //04.04.2011 DefListSettings.SCSType := st_External //04.04.2011 else //04.04.2011 DefListSettings.SCSType := st_Internal; if DefListSettings.SCSType = st_External then DefListSettings.CADCaptionsKind := skExternalSCS; //04.04.2011 FGenerators := GetProjectGenerators(FCurrID); LoadCatalogByID(CurrID, false, false); //LoadProjectLists; //LoadMarkMasks; except on E: Exception do AddExceptionToLog('TSCSProject.LoadSettings: '+E.Message); end; end; procedure TSCSProject.LoadComponFilter; var ProjectFilterFile: String; FilterStream: TFileStream; begin DeleteFile(GetPathToProjectFilterTmp(false)); ProjectFilterFile := GetPathToProjectFilterTmp(true); FilterStream := GetFileStreamFromTableByID(tnCatalog, fnComponFilterBlock, ProjectFilterFile, FCurrID, FQSelect); FreeAndNil(FilterStream); if FileExists(ProjectFilterFile) then begin try FFilterBlock.LoadFromFile(ProjectFilterFile, ftComponent, nil, false); finally DeleteFile(ProjectFilterFile); end; end; end; // ##### Сохранение настроек проекта ##### procedure TSCSProject.Save; var SettingsStream: TStream; StreamSize: Integer; begin try if (FCurrID < 1) or (FReadOnly = true) then Exit; //// EXIT ///// inherited; SaveMarkMasks; TF_Main(FActiveForm).DM.UpdateCatalogFieldAsInteger(FCurrID, FIDLastList, fnID, fnIDLastList, FQueryMode); TF_Main(FActiveForm).DM.UpdateCatalogFieldAsInteger(FCurrID, CurrentProjBuildID, fnID, fnBuildID, FQueryMode); TF_Main(FActiveForm).DM.UpdateCatalogFieldAsInteger(FCurrID, CurrentNBBuildID, fnID, fnNBBuildID, FQueryMode); TF_Main(FActiveForm).DM.UpdateCatalogFieldAsInteger(FCurrID, FIDFromOpened, fnID, fnIDFromOpened, FQueryMode); //if CmpRecords(Integer(@OldSetting), Integer(@Setting), SizeOf(OldSetting), SizeOf(Setting)) then // Exit; //// EXIT //// { ChangeSQLQuery(FQuery_Operat, 'update katalog set '+ 'settings = :settings, '+ fnDefListSettings+' = :'+fnDefListSettings+', '+ fnGenerators+' = :'+fnGenerators+' '+ 'where (id = '''+IntToStr(FCurrID)+''') and (id_item_type = '''+IntToStr(itProject)+''') '); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(Setting, sizeof(Setting)); SettingsStream.Position := 0; FQuery_Operat.ParamLoadFromStream(fnSettings, SettingsStream); FQuery_Operat.ParamLoadFromBuffer(fnDefListSettings, DefListSettings, sizeof(DefListSettings)); FQuery_Operat.ParamLoadFromBuffer(fnGenerators, FGenerators, sizeof(FGenerators)); FQuery_Operat.ExecQuery; FQuery_Operat.Close; FreeAndNil(SettingsStream);} SetSQLToFIBQuery(FQOperat, 'update '+tnCatalog+' set '+ fnSettings+' = :'+fnSettings+', '+ fnDefListSettings+' = :'+fnDefListSettings+', '+ fnGenerators+' = :'+fnGenerators+' '+ 'where ('+fnID+' = '''+IntToStr(FCurrID)+''') and ('+fnIDItemType+' = '''+IntToStr(itProject)+''')', false); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(Setting, sizeof(Setting)); SettingsStream.Position := 0; SetParamAsStreamToQuery(FQOperat, fnSettings, SettingsStream); SetParamAsBufferToQuery(FQOperat, fnDefListSettings, DefListSettings, sizeof(DefListSettings)); SetParamAsBufferToQuery(FQOperat, fnGenerators, FGenerators, sizeof(FGenerators)); FQOperat.ExecQuery; FQOperat.Close; FreeAndNil(SettingsStream); if FActive then begin //*** Автосохранение даты/времени if OldSetting.AutoSaveDateTimeMinutes <> Setting.AutoSaveDateTimeMinutes then begin WriteUserNowDateTime; StartStopAutoSaveDateTime(false); StartStopAutoSaveDateTime(true); end; //*** Автосохранение проекта if OldSetting.IsAutoSaveProject <> Setting.IsAutoSaveProject then StartStopAutoSaveProject(Setting.IsAutoSaveProject) else if Setting.IsAutoSaveProject then if OldSetting.AutoSaveProjectMinutes <> Setting.AutoSaveProjectMinutes then begin StartStopAutoSaveProject(false); StartStopAutoSaveProject(true); end; end; OldSetting := Setting; except on E: Exception do AddExceptionToLog('TSCSProject.SaveSettings: '+E.Message); end; end; procedure TSCSProject.SaveComponFilter; var ProjectFilterFile: String; begin DeleteFile(GetPathToProjectFilterTmp(false)); ProjectFilterFile := GetPathToProjectFilterTmp(true); FFilterBlock.SaveToFile(ProjectFilterFile, ftComponent); if FileExists(ProjectFilterFile) then begin try SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCatalog, '('+fnID+' =:'+fnID+') and ('+fnIDItemType+' =:'+fnIDItemType+')', nil, fnComponFilterBlock), false); FQOperat.ParamByName(fnID).AsInteger := FCurrID; FQOperat.ParamByName(fnIDItemType).AsInteger := ItemType; FQOperat.ParamByName(fnComponFilterBlock).LoadFromFile(ProjectFilterFile); FQOperat.ExecQuery; FQOperat.Close; finally DeleteFile(ProjectFilterFile); end; end; end; function TSCSProject.SaveLists(ASaveCAD: Boolean): Boolean; var i: Integer; List: TSCSList; begin Result := true; for i := 0 to FProjectLists.Count - 1 do begin List := FProjectLists[i]; if Assigned(List) then if Not List.HotSave(ASaveCAD) then Result := false; end; //CloseAllTables; //SaveAllTables; end; procedure TSCSProject.SaveMainFields; var SettingsStream: TStream; StreamSize: Integer; SettingToSave: TProjectSettingRecord; begin try if (FCurrID < 1) or (FReadOnly = true) then Exit; //// EXIT ///// // Сохраняем наименование, индекс inherited Save; SaveMarkMasks; // Сохраняем служебное поле AutoSaveDateTimeMinutes SettingToSave := OldSetting; SettingToSave.AutoSaveDateTimeMinutes := Setting.AutoSaveDateTimeMinutes; SettingToSave.AutoSaveProjectMinutes := Setting.AutoSaveProjectMinutes; SettingToSave.IsAutoSaveProject := Setting.IsAutoSaveProject; SetSQLToFIBQuery(FQOperat, 'update '+tnCatalog+' set '+ fnSettings+' = :'+fnSettings+' '+ 'where ('+fnID+' = '''+IntToStr(FCurrID)+''') and ('+fnIDItemType+' = '''+IntToStr(itProject)+''')', false); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(SettingToSave, sizeof(SettingToSave)); SettingsStream.Position := 0; SetParamAsStreamToQuery(FQOperat, fnSettings, SettingsStream); FQOperat.ExecQuery; FQOperat.Close; FreeAndNil(SettingsStream); if FActive then begin //*** Автосохранение даты/времени if OldSetting.AutoSaveDateTimeMinutes <> Setting.AutoSaveDateTimeMinutes then begin WriteUserNowDateTime; StartStopAutoSaveDateTime(false); StartStopAutoSaveDateTime(true); end; //*** Автосохранение проекта if OldSetting.IsAutoSaveProject <> Setting.IsAutoSaveProject then StartStopAutoSaveProject(Setting.IsAutoSaveProject) else if Setting.IsAutoSaveProject then if OldSetting.AutoSaveProjectMinutes <> Setting.AutoSaveProjectMinutes then begin StartStopAutoSaveProject(false); StartStopAutoSaveProject(true); end; end; OldSetting.AutoSaveDateTimeMinutes := Setting.AutoSaveDateTimeMinutes; except on E: Exception do AddExceptionToLogEx('TSCSProject.SaveMainFields', E.Message); end; end; function TSCSProject.SaveProject(AAllowMsg: Boolean=true): Boolean; var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // i, BeforeSaveExceptCount, MessageModalRes, PrevExceptCount: Integer; ListsSaveCAD: Boolean; SCSList: TSCSList; DirToSaveLists, GoodProjDir: String; BadSavedListIDs, NewBadSavedListIDs: TIntList; IsAutoBackUp: Boolean; begin //SendFromClassesToDatFile; // SetProjectChanged(false); // Tolik -- 29/102/2016-- нех записываться во время процесса if (GIsProgress or (GIsProgressCount > 0)) then Exit; // Result := false; IsAutoBackUp := false; DirToSaveLists := ''; if FActive then begin BeginProgress(cSCSComponent_Msg9); try StartStopAutoSaveProject(false); GTempFilesInfo.Active := true; try OldTick := GetTickCount; FBadSavedListIDs.Clear; BeforeSaveExceptCount := GExceptionCount; {ClearOpenedListsCADStream; //} ListsSaveCAD := true; if SaveLists(ListsSaveCAD) then begin //SaveAllTables; if SendFromClassesToDatFile((BeforeSaveExceptCount=GExceptionCount) and (FBadSavedListIDs.Count=0)) then begin //2012-04-18 Save; //2012-04-18 Result := true; //*** Если некоторые из листов сохраняются с КАД ошибками if FBadSavedListIDs.Count > 0 then begin AAllowMsg := false; //2012-04-18 - не выводим сообщение о причине с антивирусом, так как больше вероятности что объекты битые PauseProgress(true); try MessageModalRes := MessageModal(cSCSComponent_Msg10_1, ApplicationName, MB_OK or MB_ICONINFORMATION); finally PauseProgress(false); end; if MessageModalRes = IDOK then begin NewBadSavedListIDs := TIntList.Create; //*** Освободить таблици MemTable FMemBase.EmptyAllTables; //*** Закрыть все CAD окна try PrevExceptCount := GExceptionCount; for i := 0 to FBadSavedListIDs.Count do begin CloseCad(FBadSavedListIDs[i]); if PrevExceptCount <> GExceptionCount then begin NewBadSavedListIDs.Add(FBadSavedListIDs[i]); PrevExceptCount := GExceptionCount; end; end; except end; // Попытаться плохие сохранить заново BadSavedListIDs := TIntList.Create; BadSavedListIDs.Assign(FBadSavedListIDs); FBadSavedListIDs.Clear; try for i := 0 to BadSavedListIDs.Count do begin SCSList := GetListBySCSID(BadSavedListIDs[i]); if SCSList <> nil then SCSList.HotSave(ListsSaveCAD); end; except end; FreeAndNil(BadSavedListIDs); FBadSavedListIDs.Assign(NewBadSavedListIDs, laOr); //2012-04-18 FBadSavedListIDs.Assign(NewBadSavedListIDs); FreeAndNil(NewBadSavedListIDs); SendFromClassesToDatFile(FBadSavedListIDs.Count = 0); if FBadSavedListIDs.Count = 0 then Result := true //*** Если опять тоже сомое, то предложить сохранить листы в файл else begin PauseProgress(true); try MessageModalRes := MessageModal(cSCSComponent_Msg10_2, ApplicationName, MB_YESNO or MB_ICONQUESTION); finally PauseProgress(false); end; if MessageModalRes = IDYES then begin DirToSaveLists := BrowseDialog(cSCSComponent_Msg10_3, ''); {2012-04-18 if DirToSaveLists <> '' then for i := 0 to FBadSavedListIDs.Count - 1 do begin SCSList := GetListBySCSID(FBadSavedListIDs[i]); if SCSList <> nil then begin try SCSList.SaveToStreamOrFile(nil, DirToSaveLists +'\'+ FileNameCorrect(SCSList.GetNameForVisible)+'.'+enList); except end; end; end;} end; end; end; end else begin Result := true; //13.04.2012 Если прошло все гладко, то скидываем проект на нычку if BeforeSaveExceptCount = GExceptionCount then IsAutoBackUp := true; end; if Result then Save; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; SetProjectChanged(false); //CloseAllTables; //try // SaveAllTables; //finally // OpenAllTables; //end; end; end; finally GTempFilesInfo.Active := false; StartStopAutoSaveProject(true); //2012-04-18 if DirToSaveLists <> '' then for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; if SCSList <> nil then begin try SCSList.SaveToStreamOrFile(nil, DirToSaveLists +'\'+ FileNameCorrect(SCSList.GetNameForVisible)+'.'+enList); except end; end; end; if IsAutoBackUp then begin GoodProjDir := AddCreateDirToPath(ExtractSaveProjectsDir, dnAutoBackup); GoodProjDir := AddCreateDirToPath(GoodProjDir, FileNameCorrect(Self.Name)+'_'+IntToStr(MarkID)); SaveToStreamOrFile(nil, GoodProjDir +'\'+YMDStr('-')+'_'+HmsStr(';')+'.'+enProj, false, true); end; end; finally EndProgress; end; if Not Result and AAllowMsg then AddExceptionToLog(cSCSComponent_Msg22_4, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_4); end; end; procedure TSCSProject.SaveSettings(ASettings: TProjectSettingRecord); var SettingsStream: TMemoryStream; begin SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCatalog, '('+fnID+' = '''+IntToStr(FCurrID)+''') and ('+fnIDItemType+' = '''+IntToStr(itProject)+''') ', nil, fnSettings), false); SettingsStream := TMemoryStream.Create; SettingsStream.Position := 0; SettingsStream.WriteBuffer(Setting, sizeof(Setting)); SettingsStream.Position := 0; FQOperat.ParamByName(fnSettings).LoadFromStream(SettingsStream); FQOperat.ExecQuery; //Tolik SettingsStream.Free; // end; // ##### Добавить Лист в Список ##### function TSCSProject.InsertListByID(AIDList: Integer): TSCSList; var NewList: TSCSList; begin Result := nil; try NewList := TSCSList.Create(ActiveForm); NewList.FTreeViewNode := nil; NewList.Parent := Self; FChildCatalogs.Add(NewList); NewList.Open(AIDList); //NewList.CurrID := AIDList; //ProjectLists.Insert(0, NewList); Result := NewList; except on E: Exception do AddExceptionToLog('TSCSProject.InsertListByID: '+E.Message); end; end; // ##### Удалить Лист из Списка ##### function TSCSProject.RemoveListByID(AIDList: Integer): Boolean; var RmList: TSCSList; begin Result := false; GProjectClose := True; // Tolik 21/05/2019 -- для рассоединения фигур можно воспользоваться и этим флажком ... try RmList := GetListBySCSID(AIDList); ProjectLists.Remove(RmList); if RmList = FCurrList then FCurrList := nil; if RmList <> nil then FreeAndNil(RmList); Result := true; except on E: Exception do AddExceptionToLog('TSCSProject.RemoveListByID: '+E.Message); end; GProjectClose := False; // Tolik 21/05/2019 end; { function TSCSProject.InsertProjectByID(AIDProj: Integer): TSCSProject; var NewProj: TSCSProject; begin try Result := nil; NewProj := TSCSList.Create(ActiveForm); NewProj.CurrID := AIDList; ProjectLists.Insert(0, NewList); Result := NewList; except on E: Exception do AddExceptionToLog('', E.Message); end; end; } function TSCSProject.GetDesignListByComponent(AComponent: TSCSComponent): TSCSList; var ObjectOwner: TSCSCatalog; begin Result := nil; if Assigned(AComponent) then begin ObjectOwner := AComponent.GetFirstParentCatalog; if Assigned(ObjectOwner) then Result := GetDesignListByIDFigure(ObjectOwner.SCSID); end; end; function TSCSProject.GetDesignListByIDFigure(AIDFigure: integer): TSCSList; var SCSFigure: TSCSCatalog; i: integer; List: TSCSList; begin Result := nil; SCSFigure := nil; if FActive then SCSFigure := GetCatalogFromReferencesBySCSID(AIDFigure); if Assigned(SCSFigure) then for i := 0 to FProjectLists.Count - 1 do begin List := FProjectLists[i]; if Assigned(List) then if List.Setting.ListType = lt_DesignBox then if List.Setting.IDFigureForDesignList = AIDFigure then begin Result := List; Break; ///// BREAK ///// end; end; end; function TSCSProject.GetDesignListsFromList(ASCSList: TSCSList): TSCSLists; var BasicList: TSCSList; i: Integer; DesignList: TSCSList; begin Result := TSCSLists.Create(false); if Assigned(ASCSList) then for i := 0 to FProjectLists.Count - 1 do begin DesignList := FProjectLists[i]; if Assigned(DesignList) then if DesignList.Setting.ListType = lt_DesignBox then if DesignList.Setting.IDListForDesignList = ASCSList.CurrID then Result.Add(DesignList); end; end; function TSCSProject.GetListByID(ASCSIDList: Integer): TSCSList; var i: integer; ProjList: TSCSList; begin Result := nil; for i := 0 to ProjectLists.Count - 1 do begin ProjList := TSCSList(ProjectLists[i]); if ProjList.ID = ASCSIDList then begin Result := ProjList; Break; //// BREAK //// end; end; end; function TSCSProject.GetListBySCSID(ASCSIDList: Integer): TSCSList; var i: integer; ProjList: TSCSList; begin Result := nil; for i := 0 to ProjectLists.Count - 1 do begin ProjList := TSCSList(ProjectLists[i]); if ProjList.CurrID = ASCSIDList then begin Result := ProjList; Break; //// BREAK //// end; end; end; function TSCSProject.SetCurrListByID(AIDList: Integer): TSCSList; begin CurrList := GetListBySCSID(AIDList); Result := CurrList; end; function TSCSProject.ComplexLoadFromDir(const ADirName: string): TOpenCatalogFromFileResult; var ProjData: TCatalog; SavedProjectOwner: TSCSProject; SavedMemBaseMode: TMemBaseMode; SavedNoSavedLists: TIDStringList; SavedFilters: TObjectlist; SavedFiltersOwnsObjects: Boolean; SavedSetting: TProjectSettingRecord; SavedDefListSettings: TListSettingRecord; SavedGenerators: TProjectGenerators; // Tolik 28/08/2019 - - //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // i: Integer; SCSList: TSCSList; begin Result := ocrFoulItemType; OldTick := GetTickCount; try //*** Загрузить данные проекта if LoadBufferFromFile(ProjData, SizeOf(ProjData), ADirName+'\'+fnObjData) then begin if ProjData.ItemType = itProject then begin SavedSetting := Setting; SavedDefListSettings := DefListSettings; SavedGenerators := FGenerators; SavedProjectOwner := FProjectOwner; SavedNoSavedLists := TIDStringList.Create; SavedNoSavedLists.Assign(FNoSaveListsToFiles); SavedFilters := TObjectlist.Create(false); SavedFilters.Assign(FFilters); SavedFiltersOwnsObjects := FFilters.OwnsObjects; FFilters.OwnsObjects := false; Clear; FProjectOwner := SavedProjectOwner; FBuildID := ProjData.BuildID; FNBBuildID := ProjData.NBBuildID; ID := ProjData.ID; ParentID := ProjData.Parent_ID; ListID := ProjData.List_ID; Name := ProjData.Name; NameShort := ProjData.NameShort; NameMark := ProjData.NameMark; IsUserName := ProjData.IsUserName; KolCompon := ProjData.Kol_Compon; ItemType := ProjData.ItemType; ItemsCount := ProjData.ItemsCount; MarkID := ProjData.MarkID; SCSID := ProjData.Scs_ID; SortID := ProjData.Sort_ID; IsIndexWithName := ProjData.IsIndexWithName; IndexPointObj := ProjData.IndexPointObj; IndexConnector := ProjData.IndexConnector; IndexLine := ProjData.IndexLine; //*** Загрузить свойства проекта //LoadBufferFromFile(Setting, SizeOf(Setting), ADirName+'\'+fnObjSettings); //*** Сохранить свойства листа по умолчанию //LoadBufferFromFile(DefListSettings, SizeOf(DefListSettings), ADirName+'\'+fnListDefSettings); //*** Сохранить генераторы //LoadBufferFromFile(FGenerators, SizeOf(FGenerators), ADirName+'\'+fnProjGenerators); Setting := SavedSetting; DefListSettings := SavedDefListSettings; FGenerators := SavedGenerators; //*** Загрузить объекты проекта FMemBase.FDirName := ADirName; SavedMemBaseMode := FMemBase.FMemBaseMode; FMemBase.FMemBaseMode := mbmFiles; FMemBase.FFileAccesFailCount := 0; try FMemBase.CloseAllTables; ////FMemBase.DeleteAllTables; //FMemBase.LoadAllTablesFromDir(ADirName); //FMemBase.LoadAllTablesFromFile(ADirName+'\'+fnObjContent); FMemBase.OpenAllTables; SendFromMemTablesToClasses(true); finally FMemBase.FMemBaseMode := SavedMemBaseMode; end; // Список не сохраненных листов в файл FNoSaveListsToFiles.Assign(SavedNoSavedLists); // Фильтры FFilters.Assign(SavedFilters); FFilters.OwnsObjects := SavedFiltersOwnsObjects; //*** Установить флаг - открыт ли лист на КАДе for i := 0 to FProjectLists.Count - 1 do begin SCSList := FProjectLists[i]; SCSList.FOpenedInCAD := CheckListExist(SCSList.SCSID); end; Result := ocrSuccessful; FreeAndNil(SavedNoSavedLists); FreeAndNil(SavedFilters); end; end else Result := orcFailAccess; if Result = orcFailAccess then AddExceptionToLog(cSCSComponent_Msg22_9, true); except on E: Exception do AddExceptionToLogEx('TSCSProject.ComplexLoadFromDir', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; function TSCSProject.ComplexSaveToDir(const ADirName: string; AAllowMsg: Boolean=true): Boolean; var // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // ProjData: TCatalog; SavedMemBaseMode: TMemBaseMode; ProcName: String; begin Result := false; ProcName := Self.ClassName + '.ComplexSaveToDir'; OldTick := GetTickCount; try if ADirName <> '' then if FActive then begin if DirectoryExists(ADirName) then FullRemoveDir(ADirName, true, true); if Not DirectoryExists(ADirName) then begin CreateDir(ADirName); if DirectoryExists(ADirName) then begin SaveLists(false); //*** Засыпать из классов в MemTabl-ы FMemBase.FDirName := ADirName; SavedMemBaseMode := FMemBase.FMemBaseMode; FMemBase.FMemBaseMode := mbmFiles; FMemBase.FFileAccesFailCount := 0; try SendFromClassesToMemTables(true); finally FMemBase.FMemBaseMode := SavedMemBaseMode; end; //OldTick := GetTickCount; {//24.09.2008 FMemBase.SaveAllTablesToDir(ADirName); //FMemBase.SaveAllTablesToFile(ADirName+'\'+fnObjContent); try FMemBase.DeleteAllTables; except end;} //*** Сохранить данные литса ProjData := GetAsTCatalog; ProjData.BuildID := CurrentProjBuildID; ProjData.NBBuildID := CurrentNBBuildID; try SaveBufferToFile(ProjData, SizeOf(ProjData), ADirName+'\'+fnObjData); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; //*** Сохранить свойства проекта try SaveBufferToFile(Setting, SizeOf(Setting), ADirName+'\'+fnObjSettings); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; //*** Сохранить свойства листа по умолчанию try SaveBufferToFile(DefListSettings, SizeOf(DefListSettings), ADirName+'\'+fnListDefSettings); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; //*** Сохранить генераторы try SaveBufferToFile(FGenerators, SizeOf(FGenerators), ADirName+'\'+fnProjGenerators); except on E: Exception do begin Inc(FMemBase.FFileAccesFailCount); AddExceptionToLogEx(ProcName, E.Message); end; end; Result := FMemBase.FFileAccesFailCount = 0; end; end; if Not Result and AAllowMsg then AddExceptionToLog(cSCSComponent_Msg22_6, true); //08.09.2011 MessageInfo(cSCSComponent_Msg22_6); end; except on E: Exception do AddExceptionToLogEx('TSCSProject.ComplexSaveToDir', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; function TSCSProject.SaveToStreamOrFile(AStream: TStream; const AFileName: String; AIsLightSaving: Boolean=false; aOnlyFromBlob: Boolean=false): Boolean; var i: Integer; List: TSCSList; MTKatalog: TSQLMemTable; UStream: TStream; // Tolik 28/08/219 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // TablesWasSavedToFile: Boolean; PackedStream, UnPackedStream: TFileStream; UnPackedTmpFile, ProjectFilterFile: String; begin Result := false; try if (Assigned(AStream)) or (AFileName <> '') then begin GTempFilesInfo.Active := true; try if FActive and Not aOnlyFromBlob then begin if SaveLists(AIsLightSaving=false) then begin if Not AIsLightSaving then SaveMarkMasks; SendFromClassesToMemTables(AIsLightSaving); TablesWasSavedToFile := FMemBase.SaveAllTablesToFile(GetPathToProjectTmp); try FMemBase.DeleteAllTables; except end; end; end else begin FCurrID := ID; if Not FActive then Load; TablesWasSavedToFile := SaveBlobFieldToFile(tnCatalog, fnPMBlock, GetPathToProjectTmp, ID, FQSelect); if Not FActive then begin LoadMarkMasks; LoadComponFilter; end; end; if TablesWasSavedToFile then begin MTKatalog := FMemBase.GetMTKatalog; try MTKatalog.Open; MTKatalog.Append; MTKatalog.FieldByName(fnID).AsInteger := ID; MTKatalog.FieldByName(fnParentID).AsInteger := ParentID; MTKatalog.FieldByName(fnListID).AsInteger := ListID; MTKatalog.FieldByName(fnName).AsString := Name; MTKatalog.FieldByName(fnNameShort).AsString := NameShort; MTKatalog.FieldByName(fnNameMark).AsString := NameMark; MTKatalog.FieldByName(fnIsUserName).AsInteger := IsUserName; MTKatalog.FieldByName(fnSortID).AsInteger := SortID; MTKatalog.FieldByName(fnKolCompon).AsInteger := KolCompon; MTKatalog.FieldByName(fnItemsCount).AsInteger := ItemsCount; MTKatalog.FieldByName(fnIDItemType).AsInteger := ItemType; MTKatalog.FieldByName(fnMarkID).AsInteger := MarkID; MTKatalog.FieldByName(fnIsIndexWithName).AsInteger := IsIndexWithName; MTKatalog.FieldByName(fnSCSID).AsInteger := SCSID; MTKatalog.FieldByName(fnIndexConn).AsInteger := IndexPointObj; MTKatalog.FieldByName(fnIndexJoiner).AsInteger := IndexConnector; MTKatalog.FieldByName(fnIndexLine).AsInteger := IndexLine; //*** Новые поля try MTKatalog.FieldByName(fnBuildID).AsInteger := CurrentProjBuildID; //FBuildID; except end; MTKatalog.FieldByName(fnNBBuildID).AsInteger := CurrentNBBuildID; //FNBBuildID; LoadBufferToMemTableBlobField(MTKatalog, fnSettings, Setting, SizeOf(Setting)); LoadBufferToMemTableBlobField(MTKatalog, fnDefListSettings, DefListSettings, SizeOf(DefListSettings)); LoadBufferToMemTableBlobField(MTKatalog, fnGenerators, FGenerators, SizeOf(FGenerators)); FMarkMasrksStream.Position := 0; if Not AIsLightSaving then TBlobField(MTKatalog.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(FMarkMasrksStream); TBlobField(MTKatalog.FieldByName(fnPMBlock)).LoadFromFile(GetPathToProjectTmp); //*** Фильтр if Not AIsLightSaving then begin DeleteFile(GetPathToProjectFilterTmp(false)); ProjectFilterFile := GetPathToProjectFilterTmp(true); FFilterBlock.SaveToFile(ProjectFilterFile, ftComponent); if FileExists(ProjectFilterFile) then begin TBlobField(MTKatalog.FieldByName(fnComponFilterBlock)).LoadFromFile(ProjectFilterFile); DeleteFile(ProjectFilterFile); end; end; //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnSettings, fnSettings); //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnDefListSettings, fnDefListSettings); //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnCompTypeMarkMasks, fnCompTypeMarkMasks); //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnCADBlock, fnCADBlock); //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnPMBlock, fnPMBlock); //StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnGenerators, fnGenerators); MTKatalog.Post; MTKatalog.Close; if Assigned(AStream) then begin UStream := TMemoryStream.Create; try MTKatalog.SaveTableToStream(UStream); PakStream(UStream, AStream); AStream.Position := 0; Result := true; finally UStream.Free; end; end else begin if AFileName <> '' then begin //OldTick := GetTickCount; //MTKatalog.SaveTableToFile(AFileName); //PakFile(AFileName, clBetter); if AIsLightSaving then begin MTKatalog.SaveTableToFile(AFileName); Result := true; end else begin if GTempFilesInfo.CheckIntegrity(cSCSComponent_Msg22_14) then begin DeleteFile(GetPathToUnPackedTmp(false)); UnPackedTmpFile := GetPathToUnPackedTmp(true); MTKatalog.SaveTableToFile(UnPackedTmpFile); GTempFilesInfo.Clear; GTempFilesInfo.Add(UnPackedTmpFile); if GTempFilesInfo.CheckIntegrity(cSCSComponent_Msg22_14) then begin UnPackedStream := TFileStream.Create(UnPackedTmpFile, fmOpenRead); PackedStream := TFileStream.Create(AFileName, fmCreate); try UnPackedStream.Position := 0; //PakStream(UnPackedStream, PackedStream, clWorse); PakStream(UnPackedStream, PackedStream); PackedStream.Position := 0; Result := true; finally FreeAndNil(UnPackedStream); FreeAndNil(PackedStream); DeleteFile(UnPackedTmpFile); end; end; end; end; //CurrTick := GetTickCount - OldTick; //CurrTick := GetTickCount - OldTick; end; end; finally DeleteFile(GetPathToProjectTmp); MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); end; end; finally GTempFilesInfo.Active := false; end; end; {if (Assigned(AStream)) or (AFileName <> '') then begin if FActive then SaveProject; MTKatalog := GetMTKatalog; try SetSQLToQuery(FQuery_Select, 'select * from '+tnCatalog+' where id = '''+IntToStr(ID)+''' '); MTKatalog.Open; MTKatalog.Append; MTKatalog.FieldByName(fnID).AsInteger := FQuery_Select.GetFNAsInteger(fnID); MTKatalog.FieldByName(fnParentID).AsInteger := FQuery_Select.GetFNAsInteger(fnParentID); MTKatalog.FieldByName(fnListID).AsInteger := FQuery_Select.GetFNAsInteger(fnListID); MTKatalog.FieldByName(fnName).AsString := FQuery_Select.GetFNAsString(fnName); MTKatalog.FieldByName(fnNameShort).AsString := FQuery_Select.GetFNAsString(fnNameShort); MTKatalog.FieldByName(fnNameMark).AsString := FQuery_Select.GetFNAsString(fnNameMark); MTKatalog.FieldByName(fnIsUserName).AsInteger := FQuery_Select.GetFNAsInteger(fnIsUserName); MTKatalog.FieldByName(fnSortID).AsInteger := FQuery_Select.GetFNAsInteger(fnSortID); MTKatalog.FieldByName(fnKolCompon).AsInteger := FQuery_Select.GetFNAsInteger(fnKolCompon); MTKatalog.FieldByName(fnItemsCount).AsInteger := FQuery_Select.GetFNAsInteger(fnItemsCount); MTKatalog.FieldByName(fnIDItemType).AsInteger := FQuery_Select.GetFNAsInteger(fnIDItemType); MTKatalog.FieldByName(fnMarkID).AsInteger := FQuery_Select.GetFNAsInteger(fnMarkID); MTKatalog.FieldByName(fnSCSID).AsInteger := FQuery_Select.GetFNAsInteger(fnSCSID); MTKatalog.FieldByName(fnIndexConn).AsInteger := FQuery_Select.GetFNAsInteger(fnIndexConn); MTKatalog.FieldByName(fnIndexJoiner).AsInteger := FQuery_Select.GetFNAsInteger(fnIndexJoiner); MTKatalog.FieldByName(fnIndexLine).AsInteger := FQuery_Select.GetFNAsInteger(fnIndexLine); //*** Новые поля try MTKatalog.FieldByName(fnBuildID).AsInteger := FQuery_Select.GetFNAsInteger(fnBuildID); except end; StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnSettings, fnSettings); StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnDefListSettings, fnDefListSettings); StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnCompTypeMarkMasks, fnCompTypeMarkMasks); StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnCADBlock, fnCADBlock); StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnPMBlock, fnPMBlock); StreamFromQueryToMemTable(FQuery_Select, MTKatalog, fnGenerators, fnGenerators); MTKatalog.Post; MTKatalog.Close; if Assigned(AStream) then begin try UStream := TMemoryStream.Create; MTKatalog.SaveTableToStream(UStream); PakStream(UStream, AStream); AStream.Position := 0; finally UStream.Free; end; end else begin if AFileName <> '' then begin MTKatalog.SaveTableToFile(AFileName); PakFile(AFileName, clBetter); end; end; finally MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); end; end; } except on E: Exception do AddExceptionToLog('TSCSProject.SaveToStreamOrFile: '+E.Message); end; end; function TSCSProject.LoadFromStreamOrFile(AStream: TStream; const AFileName: String; AAsNew: Boolean): TOpenCatalogFromFileResult; var MTKatalog: TSQLMemTable; SavedID: Integer; SavedActive: Boolean; SavedTreeViewNode: TTreeNode; OpenName, TmpFileName: String; FieldNames: TStringList; i, OpenID, OpenedIsIndexWithName: Integer; UStream: TStream; // Tolik 28/08/2019 //Old, Curr: Cardinal; Old, Curr: DWord; // function GetMTKatalogForLoad: TSQLMemTable; begin end; begin Result := ocrSuccessful; try if Not Assigned(AStream) and (AFileName <> '') and Not FileExists(AFileName) then Result := ocrFileNotFound; if (Result = ocrSuccessful) and (Assigned(AStream) or (AFileName <> '')) then begin Old := GetTickCount; SavedID := FCurrID; SavedActive := FActive; SavedTreeViewNode := FTreeViewNode; if FActive then Close; Clear; try MTKatalog := FMemBase.GetMTKatalog; FieldNames := TStringList.Create; try FBuildID := 0; FNBBuildID := 0; //*** Убрать не нужные поля MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnID)); MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnParentID)); //MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnProjectID)); MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnMarkID)); MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnSortID)); MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnSCSID)); MTKatalog.FieldDefs.Delete(MTKatalog.FieldDefs.IndexOf(fnCAD3D)); for i := 0 to MTKatalog.FieldDefs.Count - 1 do FieldNames.Add(MTKatalog.FieldDefs[i].Name); if AAsNew then FieldNames.Add(fnIDFromOpened); OpenName := ''; if Assigned(AStream) then begin UStream := TMemoryStream.Create; try UnPakStream(AStream, UStream); UStream.Position := 0; try MTKatalog.LoadTableFromStream(UStream); except Result := ocrBadFormat; end; finally UStream.Free; end; end else begin if AFileName <> '' then begin //TmpFileName := ExtractFileDir(Application.ExeName) + '\'+dnTemp+'\'+ ExtractFileName(AFileName); TmpFileName := GetPathToSCSTmpDir + '\'+ ExtractFileName(AFileName); if FileExists(TmpFileName) then if Not DeleteFile(TmpFileName) then TmpFileName := GetNoExistsFileNameForCopy(TmpFileName); if CopyFileTo(AFileName, TmpFileName) then begin UnPakFile(TmpFileName); try if CheckOneStrInFilePos(TmpFileName, GSQLMTSignatures, 0) then MTKatalog.LoadTableFromFile(TmpFileName) else Result := ocrBadFormat; except Result := ocrBadFormat; end; OpenName := ExtractFileNameOnly(TmpFileName); DeleteFile(TmpFileName); end; end; end; if Result = ocrSuccessful then MTKatalog.Open; if MTKatalog.Active then begin if MTKatalog.FieldByName(fnIDItemType).AsInteger <> itProject then Result := ocrFoulItemType else if MTKatalog.FieldDefs.IndexOf(fnBuildID) <> -1 then if MTKatalog.FieldByName(fnBuildID).AsInteger > CurrentProjBuildID then Result := orcIsOldRelease; end; if Result = ocrSuccessful then begin OpenID := MTKatalog.FieldByName(fnID).AsInteger; (* SQLBuilder(FQuery_Operat, qtUpdate, tnCatalog, 'id = '''+IntToStr(SavedID)+'''', FieldNames, false); //FQuery_Select.SetParamAsInteger(fnID, MTKatalog.FieldByName(fnID).AsInteger); //FQuery_Operat.SetParamAsInteger(fnParentID, MTKatalog.FieldByName(fnParentID).AsInteger); //FQuery_Operat.SetParamAsInteger(fnProjectID, SavedID); FQuery_Operat.SetParamAsInteger(fnListID, MTKatalog.FieldByName(fnListID).AsInteger); if OpenName <> '' then FQuery_Operat.SetParamAsString(fnName, OpenName) else FQuery_Operat.SetParamAsString(fnName, MTKatalog.FieldByName(fnName).AsString); FQuery_Operat.SetParamAsString(fnNameShort, MTKatalog.FieldByName(fnNameShort).AsString); FQuery_Operat.SetParamAsString(fnNameMark, MTKatalog.FieldByName(fnNameMark).AsString); FQuery_Operat.SetParamAsInteger(fnIsUserName, MTKatalog.FieldByName(fnIsUserName).AsInteger); //FQuery_Operat.SetParamAsInteger(fnSortID, MTKatalog.FieldByName(fnSortID).AsInteger); FQuery_Operat.SetParamAsInteger(fnKolCompon, MTKatalog.FieldByName(fnKolCompon).AsInteger); FQuery_Operat.SetParamAsInteger(fnItemsCount, MTKatalog.FieldByName(fnItemsCount).AsInteger); FQuery_Operat.SetParamAsInteger(fnIDItemType, MTKatalog.FieldByName(fnIDItemType).AsInteger); {if Not AAsNew then FQuery_Operat.SetParamAsInteger(fnMarkID, MTKatalog.FieldByName(fnMarkID).AsInteger) else FQuery_Operat.SetParamAsInteger(fnMarkID, TF_Main(FActiveForm).DM.GetCatalogMaxMarkID(itProject, FCurrID, qmPhisical)+1);} //FQuery_Select.SetParamAsInteger(fnSCSID, MTKatalog.FieldByName(fnSCSID).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexConn, MTKatalog.FieldByName(fnIndexConn).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexJoiner, MTKatalog.FieldByName(fnIndexJoiner).AsInteger); FQuery_Operat.SetParamAsInteger(fnIndexLine, MTKatalog.FieldByName(fnIndexLine).AsInteger); //*** добавленные поля в структуру позже. if MTKatalog.FieldDefs.IndexOf(fnBuildID) <> -1 then FBuildID := MTKatalog.FieldByName(fnBuildID).AsInteger; FQuery_Operat.SetParamAsInteger(fnBuildID, FBuildID); OpenedIsIndexWithName := biTrue; if MTKatalog.FieldDefs.IndexOf(fnIsIndexWithName) <> -1 then OpenedIsIndexWithName := MTKatalog.FieldByName(fnIsIndexWithName).AsInteger; FQuery_Operat.SetParamAsInteger(fnIsIndexWithName, OpenedIsIndexWithName); if MTKatalog.FieldDefs.IndexOf(fnDefListSettings) <> -1 then StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnDefListSettings, fnDefListSettings); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnSettings, fnSettings); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnCompTypeMarkMasks, fnCompTypeMarkMasks); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnCADBlock, fnCADBlock); StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnPMBlock, fnPMBlock); if MTKatalog.FieldDefs.IndexOf(fnGenerators) <> - 1 then StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnGenerators, fnGenerators); if MTKatalog.FieldDefs.IndexOf(fnComponFilterBlock) <> - 1 then StreamFromMemTableToQuery(MTKatalog, FQuery_Operat, fnComponFilterBlock, fnComponFilterBlock); if AAsNew then FQuery_Operat.SetParamAsInteger(fnIDFromOpened, OpenID); MTKatalog.Close; MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); FQuery_Operat.ExecQuery; *) SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnCatalog, 'id = '''+IntToStr(SavedID)+'''', FieldNames, ''), false); //FQuery_Select.SetParamAsInteger(fnID, MTKatalog.FieldByName(fnID).AsInteger); //FQuery_Operat.SetParamAsInteger(fnParentID, MTKatalog.FieldByName(fnParentID).AsInteger); //FQuery_Operat.SetParamAsInteger(fnProjectID, SavedID); FQOperat.ParamByName(fnListID).AsInteger := MTKatalog.FieldByName(fnListID).AsInteger; if OpenName <> '' then FQOperat.ParamByName(fnName).AsString := OpenName else FQOperat.ParamByName(fnName).AsString := MTKatalog.FieldByName(fnName).AsString; FQOperat.ParamByName(fnNameShort).AsString := MTKatalog.FieldByName(fnNameShort).AsString; FQOperat.ParamByName(fnNameMark).AsString := MTKatalog.FieldByName(fnNameMark).AsString; FQOperat.ParamByName(fnIsUserName).AsInteger := MTKatalog.FieldByName(fnIsUserName).AsInteger; //FQOperat.ParamByName(fnSortID).AsInteger := MTKatalog.FieldByName(fnSortID).AsInteger; FQOperat.ParamByName(fnKolCompon).AsInteger := MTKatalog.FieldByName(fnKolCompon).AsInteger; FQOperat.ParamByName(fnItemsCount).AsInteger := MTKatalog.FieldByName(fnItemsCount).AsInteger; FQOperat.ParamByName(fnIDItemType).AsInteger := MTKatalog.FieldByName(fnIDItemType).AsInteger; {if Not AAsNew then FQOperat.ParamByName(fnMarkID).AsInteger := MTKatalog.FieldByName(fnMarkID).AsInteger else FQOperat.ParamByName(fnMarkID).AsInteger := TF_Main(FActiveForm).DM.GetCatalogMaxMarkID(itProject, FCurrID, qmPhisical)+1;} //FQuery_Select.ParamByName(fnSCSID).AsInteger := MTKatalog.FieldByName(fnSCSID).AsInteger); FQOperat.ParamByName(fnIndexConn).AsInteger := MTKatalog.FieldByName(fnIndexConn).AsInteger; FQOperat.ParamByName(fnIndexJoiner).AsInteger := MTKatalog.FieldByName(fnIndexJoiner).AsInteger; FQOperat.ParamByName(fnIndexLine).AsInteger := MTKatalog.FieldByName(fnIndexLine).AsInteger; //*** добавленные поля в структуру позже. if MTKatalog.FieldDefs.IndexOf(fnBuildID) <> -1 then FBuildID := MTKatalog.FieldByName(fnBuildID).AsInteger; FQOperat.ParamByName(fnBuildID).AsInteger := FBuildID; if MTKatalog.FieldDefs.IndexOf(fnNBBuildID) <> -1 then FNBBuildID := MTKatalog.FieldByName(fnNBBuildID).AsInteger; FQOperat.ParamByName(fnNBBuildID).AsInteger := FNBBuildID; OpenedIsIndexWithName := biTrue; if MTKatalog.FieldDefs.IndexOf(fnIsIndexWithName) <> -1 then OpenedIsIndexWithName := MTKatalog.FieldByName(fnIsIndexWithName).AsInteger; FQOperat.ParamByName(fnIsIndexWithName).AsInteger := OpenedIsIndexWithName; if MTKatalog.FieldDefs.IndexOf(fnDefListSettings) <> -1 then StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnDefListSettings, fnDefListSettings); StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnSettings, fnSettings); StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnCompTypeMarkMasks, fnCompTypeMarkMasks); StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnCADBlock, fnCADBlock); StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnPMBlock, fnPMBlock); if MTKatalog.FieldDefs.IndexOf(fnGenerators) <> - 1 then StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnGenerators, fnGenerators); if MTKatalog.FieldDefs.IndexOf(fnComponFilterBlock) <> - 1 then StreamFromMemTableToFIBQuery(MTKatalog, FQOperat, fnComponFilterBlock, fnComponFilterBlock); if AAsNew then FQOperat.ParamByName(fnIDFromOpened).AsInteger := OpenID; MTKatalog.Close; MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); FQOperat.ExecQuery; FTreeViewNode := SavedTreeViewNode; end else begin FQOperat.Close; end; { Load; LoadAllTables; OpenAllTables; if AAsNew then with TF_Main(FActiveForm).DM do begin tSQL_Katalog.Filtered := false; for i := 0 to tSQL_Katalog.RecordCount - 1 do begin tSQL_Katalog.RecNo := i+1; tSQL_Katalog.Edit; tSQL_Katalog.FieldByName(fnProjectID).AsInteger := FCurrID; if tSQL_Katalog.FieldByName(fnParentID).AsInteger = OpenID then tSQL_Katalog.FieldByName(fnParentID).AsInteger := FCurrID; tSQL_Katalog.Post; end; tSQL_Component.Filtered := false; for i := 0 to tSQL_Component.RecordCount - 1 do begin tSQL_Component.RecNo := i+1; tSQL_Component.Edit; tSQL_Component.FieldByName(fnProjectID).AsInteger := FCurrID; tSQL_Component.Post; end; end; Save; CloseAllTables; SaveAllTables; } finally if Assigned(MTKatalog) then begin if MTKatalog.Active then MTKatalog.Close; if Result = ocrSuccessful then if MTKatalog.Exists then MTKatalog.DeleteTable(true); FreeAndNil(MTKatalog); end; FieldNames.Free; end; finally if SavedActive and (Result = ocrSuccessful) then Open(SavedID); end; Curr := GetTickCount - old; Curr := GetTickCount - old; end; except on E: Exception do AddExceptionToLog('TSCSProject.LoadFromStreamOrFile: '+E.Message); end; end; procedure TSCSProject.AfterNew(Sender: TObject); begin //SaveAllTables; //WriteUserDateTime(0, ''); //CloseAllTables; //DeleteAllTables; //CreateAllTables; //SaveAllTables; //OpenAsLoaded; //SendFromClassesToDatFile; //WriteUserDateTime(0, ''); //FMemBase.EmptyAllTables; //FMemBase.SaveAllTables; SendFromClassesToDatFile(true); end; procedure TSCSProject.AfterOpen(Sender: TObject); var INames: String; i, j, iCount: Integer; NodeDat: PObjectData; ListNode: TTreeNode; ProjectListsID: TList; begin try try Screen.Cursor := crHourGlass; TF_Main(ActiveForm).DM.FMemBaseActive := true; //CloseAllTables; //DeleteAllTables; //LoadAllTables; //OpenAllTables; //UpdateAfterOpenFromFileStream; //iCount := TF_Main(ActiveForm).DM.tSQL_InterfaceRelation.FieldDefs.Count; //INames := TF_Main(ActiveForm).DM.tSQL_InterfaceRelation.IndexFieldNames; //TF_Main(ActiveForm).DM.FMemBaseActive := true; //LoadProject; //CloseAllTables; //LoadMarkMasks; GCurrProjUnitOfMeasure := Setting.UnitOfMeasure; SendFromDatFileToClasses; UpdatePrices; SetPriceParamsToForm; SetFilterParamsToForm; //*** Изменение в TreeView with TF_Main(FActiveForm) do begin for i := 0 to Tree_Catalog.Items.Count - 1 do begin NodeDat := Tree_Catalog.Items[i].Data; if (NodeDat.ItemType = itProject) and (NodeDat.ObjectID = FCurrID) then begin Tree_Catalog.Selected := Tree_Catalog.Items[i]; AddNodes(Tree_Catalog.Items[i]); Tree_Catalog.Items[i].Expanded := true; TreeViewNode := Tree_Catalog.Items[i]; F_ProjMan.SetNodeState(Tree_Catalog.Items[i], NodeDat.ItemType, ekNone); end; end; //*** Пререйти на первый Лист if Assigned(CurrList) then begin ListNode := nil; if Assigned(CurrList.TreeViewNode) then ListNode := CurrList.TreeViewNode else ListNode := FindComponOrDirInTree(CurrList.ID, false); if Assigned(ListNode) then begin Tree_Catalog.Selected := ListNode; Tree_CatalogChange(Tree_Catalog, ListNode); //##ListNode.Expanded := true; end; end; EnableEditDel(itAuto); end; //*** Установить флаг FOpenedInCAD в да for i := 0 to FProjectLists.Count - 1 do FProjectLists[i].FOpenedInCAD := true; for i := 0 to FProjectLists.Count - 1 do begin for j := 0 to FProjectLists[i].ChildCatalogReferences.Count - 1 do begin if FProjectLists[i].ChildCatalogReferences[j].ListID <> FProjectLists[i].ListID then begin FProjectLists[i].ChildCatalogReferences[j].ListID := FProjectLists[i].ListID; {$IF Defined(BASEADM_SCS)} ShowMessage('Переприсвоили ListID'); {$IFEND} end; end; end; //FSCS_Main.SetMenuStatus(true); //22.08.2012 ProcessMessagesEx; //*** Подгрузить на КАД ProjectListsID := GetProjectLists(FCurrID); if Assigned(ProjectListsID) then begin if Assigned(FCurrList) then LoadNewProject(ProjectListsID, FCurrList.CurrID) else LoadNewProject(ProjectListsID, 0); FreeList(ProjectListsID); end; UpdateCADObjIconsFromUpdatedSpav; if ProjectNeedResave then begin if not GProjectChanged then // Tolik 28/08/2019 -- SetProjectChanged(True); end else SetProjectChanged(false); SetStatusFilteredConnectedObjToCAD(0); CorrectAfterFullOpen; //05.10.2010 GUndoList := TList.Create; finally StartStopAutoSaveProject(true); FSCS_Main.SetMenuStatus(true); {for i := 0 to FSCS_Main.MDIChildCount - 1 do begin TF_CAD(FSCS_Main.MDIChildren[i]).PCad.ResetRegions; end;} end; finally ProjectNeedResave := false; EndProgress; Screen.Cursor := crDefault; end; end; procedure TSCSProject.AfterClose(Sender: TObject); begin try try if Assigned(FTreeViewNode) then begin SetItemsFTreeNodeToNil; DeleteChildNodes(FTreeViewNode); TF_Main(FActiveForm).SetNodeState(FTreeViewNode, PObjectData(FTreeViewNode.Data).ItemType, ekNone); end; CurrList := nil; SetProjectChanged(false); SetFilterParamsToForm; //FTreeViewNode := nil; finally //KillTimer(FActiveForm.Handle, TimerIDProjectSaveDateTime); //WriteUserDateTime(0, ''); //KillTimer(FActiveForm.Handle, TimerIDProjectAutoSave); StartStopAutoSaveDateTime(false); WriteUserDateTime(0, ''); //StartStopAutoSaveProject(false); FSCS_Main.SetMenuStatus(false); // IGOR 2017-04-25 // нужно обнулять GCadForm потому что потом АВ так как EndProgress вызывает РЕфреш КАДа GCadForm := nil; end; finally EndProgress; end; end; procedure TSCSProject.BeforeNew(Sender: TObject); begin FBuildID := CurrentProjBuildID; FNBBuildID := CurrentNBBuildID; end; procedure TSCSProject.BeforeOpen(Sender: TObject); begin try BeginProgress; Clear; CurrList := nil; Setting := GetProjectSettings(FCurrID); finally StartStopAutoSaveDateTime(true); //StartStopAutoSaveProject(true); //WriteUserNowDateTime; //SetTimer(FActiveForm.Handle, TimerIDProjectSaveDateTime, GNBSettings.ProjectAutoSaveMinutes * 60 * 1000, @SaveProjectDateTime); //if GNBSettings.IsAutoSaveProjects = biTrue then // SetTimer(FActiveForm.Handle, TimerIDProjectAutoSave, GNBSettings.ProjectAutoSaveMinutes * 60 * 1000, @AutoSaveCurrentProject); end; end; procedure TSCSProject.BeforeClose(Sender: TObject); begin {Screen.Cursor := crHourGlass; BeginProgress; UnloadCurrentProject; //CloseAllTables; //if Not FReadOnlyMemBase then SaveAllTables; DeleteAllTables; ClearProject;} try if GUndoList <> nil then FreeAndNil(GUndoList); except end; StartStopAutoSaveProject(false); BeginProgress; SaveListsToFileFromNoSaved; //*** Выгружает проект и сохраняет листы по файлам UnloadCurrentProject; CloseAllLists; if Not(FIsDeleting) and Not(ReadOnly) then SendFromClassesToDatFile(true); // clear; ClearClasses; // CloseAllTables; // if Not FReadOnlyMemBase then // SaveAllTables; // DeleteAllTables; //ClearProject; TF_Main(ActiveForm).DM.FMemBaseActive := false; end; procedure TSCSProject.LoadMemTablesFromMemBase; var i, j, PackIdx: Integer; Info: TMemTableInfo; MemBaseTable: TSQLMemTable; PackFlds: TStringList; FieldDef: TFieldDef; begin PackFlds := CreateStringListSorted; for i := 0 to FMemTablesInfo.Count - 1 do begin Info := TMemTableInfo(FMemTablesInfo.Objects[i]); MemBaseTable := TF_Main(FActiveForm).DM.GetSQLMemTableByIndex(Info.FMemTable.Tag); if MemBaseTable <> nil then begin if Not MemBaseTable.Exists then TF_Main(FActiveForm).DM.CreateSQLMemTableByTagIdx(MemBaseTable.Tag); if Info.FMemTable.Active then Info.FMemTable.Close; if Info.FMemTable.Exists then Info.FMemTable.DeleteTable(false); Info.FMemTable.FieldDefs.Clear; PackFlds.Clear; //Assign FieldDefs for j := 0 to High(Info.FPackFields) do PackFlds.Add(Info.FPackFields[j]); for j := 0 to MemBaseTable.FieldDefs.Count - 1 do begin FieldDef := MemBaseTable.FieldDefs[j]; PackIdx := PackFlds.IndexOf(FieldDef.Name); if PackIdx = -1 then Info.FMemTable.FieldDefs.Add(FieldDef.Name, FieldDef.DataType, FieldDef.Size) else Info.FMemTable.FieldDefs.Add(Info.FPackFields[PackIdx], ftString, 255); end; //load data Info.FMemTable.CreateTable; Info.FMemTable.Active := true; if MemBaseTable.Active then begin MemBaseTable.First; while Not MemBaseTable.Eof do begin Info.FMemTable.Append; //for j := 0 to Hight(Info.FPackFields) - 1 do // Info.FMemTable.FieldByName(Info.FPackFields[j]).AsString := FStringsMan.GetStrByID(MemBaseTable.FieldByName(Info.FPackFields[j]).AsInteger, Info.FPackDicts[j]); for j := 0 to MemBaseTable.FieldDefs.Count - 1 do begin FieldDef := MemBaseTable.FieldDefs[j]; PackIdx := PackFlds.IndexOf(FieldDef.Name); if PackIdx = -1 then //Info.FMemTable.FieldByName(FieldDef.Name).Value := MemBaseTable.FieldByName(FieldDef.Name).Value Info.FMemTable.Fields[FieldDef.Index].Value := MemBaseTable.Fields[FieldDef.Index].Value else Info.FMemTable.Fields[FieldDef.Index].AsString := FStringsMan.GetStrByID(MemBaseTable.Fields[FieldDef.Index].AsInteger, Info.FPackDicts[PackIdx]); end; Info.FMemTable.Post; MemBaseTable.Next; end; end; end; end; PackFlds.Free; end; procedure TSCSProject.SaveMemTablesToMemBase; var i, j, PackIdx: Integer; Info: TMemTableInfo; MemBaseTable: TSQLMemTable; PackFlds: TStringList; FieldDef: TFieldDef; begin PackFlds := CreateStringListSorted; for i := 0 to FMemTablesInfo.Count - 1 do begin Info := TMemTableInfo(FMemTablesInfo.Objects[i]); MemBaseTable := TF_Main(FActiveForm).DM.GetSQLMemTableByIndex(Info.FMemTable.Tag); if MemBaseTable <> nil then begin PackFlds.Clear; for j := 0 to High(Info.FPackFields) do PackFlds.Add(Info.FPackFields[j]); //load data if Info.FMemTable.Active then begin Info.FMemTable.First; while Not Info.FMemTable.Eof do begin MemBaseTable.Append; for j := 0 to MemBaseTable.FieldDefs.Count - 1 do begin FieldDef := MemBaseTable.FieldDefs[j]; PackIdx := PackFlds.IndexOf(FieldDef.Name); if PackIdx = -1 then MemBaseTable.Fields[FieldDef.Index].Value := Info.FMemTable.Fields[FieldDef.Index].Value else MemBaseTable.Fields[FieldDef.Index].AsInteger := FStringsMan.GenStrID(Info.FMemTable.Fields[FieldDef.Index].AsString, Info.FPackDicts[PackIdx]); end; MemBaseTable.Post; Info.FMemTable.Next; end; end; end; end; PackFlds.Free; end; { TSCSResourceRel } // ##################### Класс TSCSResourceRel ################################# // ############################################################################# // ##### ##### constructor TSCSResourceRel.Create(AFormOwner: TForm; ANormType: TNormType); begin //FTableName := tnNormResourceRel; //FTableIndex := tiNormResourceRel; inherited Create(AFormOwner); //ActiveForm := AFormOwner; FNormType := ANormType; end; destructor TSCSResourceRel.Destroy; begin Clear; inherited; //Destroy; end; procedure TSCSResourceRel.Assign(AResourceRel: TSCSResourceRel; AFromNew: Boolean = false); begin FNormType := AResourceRel.FNormType; ID := AResourceRel.ID; //IDMaster := AResourceRel.IDMaster; //TableKind := AResourceRel.TableKind; Npp := AResourceRel.Npp; IDResource := AResourceRel.IDResource; IDNB := AResourceRel.IDNB; GuidNB := AResourceRel.GuidNB; TableKindNB := AResourceRel.TableKindNB; IDCompPropRel := AResourceRel.IDCompPropRel; Cypher := AResourceRel.Cypher; Name := AResourceRel.Name; ArtProducer := AResourceRel.ArtProducer; ArtDistributor := AResourceRel.ArtDistributor; GUIDProducer := AResourceRel.GUIDProducer; GUIDSuppliesKind := AResourceRel.GUIDSuppliesKind; Izm := AResourceRel.Izm; Price := AResourceRel.Price; AdditionalPrice := AResourceRel.AdditionalPrice; RType := AResourceRel.RType; Kolvo := AResourceRel.Kolvo; IsOn := AResourceRel.IsOn; Cost := AResourceRel.Cost; RValue := AResourceRel.RValue; ExpenseForLength := AResourceRel.ExpenseForLength; //ExpenseForSection := AResourceRel.ExpenseForSection; GUIDNBComponent := AResourceRel.GUIDNBComponent; IDNBComponent := AResourceRel.IDNBComponent; CountForPoint := AResourceRel.CountForPoint; StepOfPoint := AResourceRel.StepOfPoint; NewID := AResourceRel.NewID; NewIDResource := AResourceRel.NewIDResource; IsNew := AResourceRel.IsNew; IsModified := AResourceRel.IsModified; ServIsResource := AResourceRel.ServIsResource; if AFromNew then begin ID := AResourceRel.NewID; IDResource := AResourceRel.NewIDResource; end; end; procedure TSCSResourceRel.Clear; begin ID := 0; GuidNB := ''; IDMaster := 0; //TableKind := 0; IDResource := 0; IDCompPropRel := 0; Cypher := ''; Name := ''; ArtProducer := ''; ArtDistributor := ''; GUIDProducer := ''; GUIDSuppliesKind := ''; Izm := ''; Price := 0; AdditionalPrice := 0; RType := 0; Kolvo := 0; IsOn := 0; Cost := 0; RValue := 0; ExpenseForLength := 0; //ExpenseForSection := 0; GUIDNBComponent := ''; IDNBComponent := 0; CountForPoint := 0; StepOfPoint := 0; ServIsResource := true; end; procedure TSCSResourceRel.CalcCost; begin Cost := RoundCP((Price + AdditionalPrice) * Kolvo); end; procedure TSCSResourceRel.LoadResourceByID(AIDResourceRel: integer); var TNNormResourceRel: String; //TableName TNResource: String; //TableName FNameIDResource: String; //FieldName FNameIDMaster: String; //FieldName begin try case FNormType of ntNB: if FQueryMode = qmPhisical then begin TNNormResourceRel := 'nb_norm_resource_rel'; TNResource := 'nb_resources'; FNameIDMaster := 'id_nb_norm'; FNameIDResource := 'id_nb_resource'; SetSQLToFIBQuery(FQSelect, 'select * '+ 'from nb_norm_resource_rel, nb_resources '+ 'where (nb_norm_resource_rel.id = '''+IntToStr(AIDResourceRel)+''') and '+ ' (nb_resources.id = id_nb_resource) '); end; ntProj: begin TNNormResourceRel := 'norm_resource_rel'; TNResource := 'resources'; FNameIDMaster := FMasterField; //'id_master'; FNameIDResource := 'id_resource'; if FQueryMode = qmPhisical then SetSQLToFIBQuery(FQSelect, 'select * '+ 'from norm_resource_rel, resources '+ 'where (norm_resource_rel.id = '''+IntToStr(AIDResourceRel)+''') and '+ ' (resources.id = id_resource) '); end; end; case FQueryMode of qmPhisical: begin ID := FQSelect.FN( {TNNormResourceRel+}fnID ).AsInteger; IDMaster := FQSelect.FN( FNameIDMaster ).AsInteger; if FNormType = ntNb then begin IDNB := FQSelect.FN('ID1').AsInteger; GuidNB := FQSelect.FN(fnGuid+'1').AsString; end; if FNormType = ntProj then begin GuidNB := FQSelect.FN(fnGuidNB).AsString; MasterTableKind := FQSelect.FN('Table_kind').AsInteger; Npp := FQSelect.FN('Npp').AsInteger; IDNB := FQSelect.FN('ID_NB').AsInteger; TableKindNB := FQSelect.FN('Table_Kind_NB').AsInteger; ExpenseForLength := FQSelect.FN(fnExpenseForLength).AsDouble; //ExpenseForSection := FQSelect.FN(fnExpenseForSection).AsDouble; //GUIDNBComponent := FQSelect.FN(fnGuidNBComponent).AsString; IDNBComponent := FQSelect.FN(fnIDNBComponent).AsInteger; CountForPoint := FQSelect.FN(fnCountForPoint).AsDouble; StepOfPoint := FQSelect.FN(fnStepOfPoint).AsDouble; end; IDResource := FQSelect.FN(FNameIDResource ).AsInteger; Cypher := FQSelect.FN('cypher').AsString; Name := FQSelect.FN('name').AsString; Izm := FQSelect.FN('izm').AsString; Price := FQSelect.FN('price').AsDouble; AdditionalPrice := FQSelect.FN(fnAdditionalPrice).AsDouble; RType := FQSelect.FN('rtype').AsInteger; Kolvo := FQSelect.FN('kolvo').AsDouble; Cost := FQSelect.FN('Cost').AsDouble; IsOn := FQSelect.FN('ison').AsInteger; if FNormType = ntProj then begin if IDNBComponent <> 0 then GUIDNBComponent := GetStringFromTableByID(tnComponent, fnGuid, IDNBComponent, FQSelect); end; end; qmMemory: if FNormType = ntProj then with TF_Main(ActiveForm).DM do begin { if SetFilterToSQLMemTable(tSQL_NormResourceRel, 'id = '''+IntTostr(AIDResourceRel)+'''') then if Not tSQL_NormResourceRel.Eof then begin LoadResourceRelFromMemTable; if SetFilterToSQLMemTable(tSQL_Resources, 'id = '''+IntTostr(IDResource)+'''') then if Not tSQL_Resources.Eof then begin LoadResourceFromMemTable; end; end; } end; end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.LoadResourceByID: '+E.Message); end; end; procedure TSCSResourceRel.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); begin Price := GetPriceAfterChangeCurrency(Price, AOldCurrency, ANewCurrency); AdditionalPrice := GetPriceAfterChangeCurrency(AdditionalPrice, AOldCurrency, ANewCurrency); Cost := GetPriceAfterChangeCurrency(Cost, AOldCurrency, ANewCurrency); if ASave then UpdateResource; end; procedure TSCSResourceRel.LoadResourceFromMemTable(AStringsMan: TStringsMan); begin try with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GuidNB := tSQL_Resources.Fields[fiResource_GuidNB].AsString; Self.Cypher := tSQL_Resources.Fields[fiResource_Cypher].AsString; Self.Name := tSQL_Resources.Fields[fiResource_Name].AsString; Self.Izm := tSQL_Resources.Fields[fiResource_Izm].AsString; end else begin Self.GuidNB := AStringsMan.GetStrByID(tSQL_Resources.Fields[fiResource_GuidNB].AsInteger, AStringsMan.FResourceRelGuidNBStrings); Self.Cypher := AStringsMan.GetStrByID(tSQL_Resources.Fields[fiResource_Cypher].AsInteger, AStringsMan.FResourceRelCypherStrings); Self.Name := AStringsMan.GetStrByID(tSQL_Resources.Fields[fiResource_Name].AsInteger, AStringsMan.FResourceRelNameStrings); Self.Izm := AStringsMan.GetStrByID(tSQL_Resources.Fields[fiResource_Izm].AsInteger, AStringsMan.FIzmStrings); end; Self.IDNB := tSQL_Resources.Fields[fiResource_IDNB].AsInteger; Self.TableKindNB := tSQL_Resources.Fields[fiResource_TableKindNB].AsInteger; Self.Price := tSQL_Resources.Fields[fiResource_Price].AsFloat; Self.AdditionalPrice := tSQL_Resources.Fields[fiResource_AdditionalPrice].AsFloat; Self.RType := tSQL_Resources.Fields[fiResource_Rtype].AsInteger; { //IDNB := tSQL_Resources.FieldByName('ID_NB').AsInteger; GuidNB := tSQL_Resources.FieldByName(fnGuidNB).AsString; TableKindNB := tSQL_Resources.FieldByName(fnTableKindNB).AsInteger; Cypher := tSQL_Resources.FieldByName(fnCypher).AsString; Self.Name := tSQL_Resources.FieldByName(fnName).AsString; Izm := tSQL_Resources.FieldByName(fnIzm).AsString; Price := tSQL_Resources.FieldByName(fnPrice).AsFloat; AdditionalPrice := tSQL_Resources.FieldByName(fnAdditionalPrice).AsFloat; RType := tSQL_Resources.FieldByName(fnRtype).AsInteger; } end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.LoadResourceFromMemTable: '+E.Message); end; end; procedure TSCSResourceRel.LoadResourceRelFromMemTable(AStringsMan: TStringsMan); begin try with TF_Main(FActiveForm).DM do begin Self.ID := tSQL_NormResourceRel.Fields[fiNormResRel_ID].AsInteger; Self.MasterTableKind := tSQL_NormResourceRel.Fields[fiNormResRel_TableKind].AsInteger; Self.IDMaster := tSQL_NormResourceRel.Fields[fiNormResRel_IDMaster].AsInteger; //IDMaster := tSQL_NormResourceRel.FieldByName(fnIDMaster).AsInteger; Self.Npp := tSQL_NormResourceRel.Fields[fiNormResRel_Npp].AsInteger; Self.IDResource := tSQL_NormResourceRel.Fields[fiNormResRel_IDResource].AsInteger; Self.Kolvo := tSQL_NormResourceRel.Fields[fiNormResRel_Kolvo].AsFloat; Self.Cost := tSQL_NormResourceRel.Fields[fiNormResRel_Cost].AsFloat; Self.IsOn := tSQL_NormResourceRel.Fields[fiNormResRel_IsOn].AsInteger; if fiNormResRel_ExpenseForLength <> -1 then Self.ExpenseForLength := tSQL_NormResourceRel.Fields[fiNormResRel_ExpenseForLength].AsFloat; if fiNormResRel_GuidNBComponent <> -1 then Self.GUIDNBComponent := AStringsMan.GetStrByID(tSQL_NormResourceRel.Fields[fiNormResRel_GuidNBComponent].AsInteger, AStringsMan.FComponGuidNBStrings); if fiNormResRel_CountForPoint <> -1 then Self.CountForPoint := tSQL_NormResourceRel.Fields[fiNormResRel_CountForPoint].AsFloat; if fiNormResRel_StepOfPoint <> -1 then Self.StepOfPoint := tSQL_NormResourceRel.Fields[fiNormResRel_StepOfPoint].AsFloat; //if fiNormResRel_ExpenseForSection <> -1 then // Self.ExpenseForSection := tSQL_NormResourceRel.Fields[fiNormResRel_ExpenseForSection].AsFloat; if fiNormResRel_IDCompPropRel <> -1 then Self.IDCompPropRel := tSQL_NormResourceRel.Fields[fiNormResRel_IDCompPropRel].AsInteger; { ID := tSQL_NormResourceRel.FieldByName(fnID).AsInteger; MasterTableKind := tSQL_NormResourceRel.FieldByName(fnTableKind).AsInteger; IDMaster := tSQL_NormResourceRel.FieldByName(FMasterField).AsInteger; //IDMaster := tSQL_NormResourceRel.FieldByName(fnIDMaster).AsInteger; Npp := tSQL_NormResourceRel.FieldByName(fnNpp).AsInteger; IDResource := tSQL_NormResourceRel.FieldByName(fnIDResource).AsInteger; Kolvo := tSQL_NormResourceRel.FieldByName(fnKolvo).AsFloat; Cost := tSQL_NormResourceRel.FieldByName(fnCost).AsFloat; IsOn := tSQL_NormResourceRel.FieldByName(fnIsOn).AsInteger; } end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.LoadResourceRelFromMemTable: '+E.Message); end; end; procedure TSCSResourceRel.SaveResourceToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin try with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: begin tSQL_Resources.Append; tSQL_Resources.Fields[fiResource_ID].AsInteger := Self.IDResource; end; meEdit: begin tSQL_Resources.Filtered := false; if tSQL_Resources.Locate(fnID, Self.IDResource, []) then tSQL_Resources.Edit; end; end; if tSQL_Resources.State <> dsBrowse then begin tSQL_Resources.Fields[fiResource_GuidNB].AsInteger := AStringsMan.GenStrID(Self.GuidNB, AStringsMan.FResourceRelGuidNBStrings); tSQL_Resources.Fields[fiResource_IDNB].AsInteger := Self.IDNB; tSQL_Resources.Fields[fiResource_TableKindNB].AsInteger := Self.TableKindNB; tSQL_Resources.Fields[fiResource_Cypher].AsInteger := AStringsMan.GenStrID(Self.Cypher, AStringsMan.FResourceRelCypherStrings); tSQL_Resources.Fields[fiResource_Name].AsInteger := AStringsMan.GenStrID(Self.Name, AStringsMan.FResourceRelNameStrings); tSQL_Resources.Fields[fiResource_Izm].AsInteger := AStringsMan.GenStrID(Self.Izm, AStringsMan.FIzmStrings); tSQL_Resources.Fields[fiResource_Price].AsFloat := Self.Price; tSQL_Resources.Fields[fiResource_AdditionalPrice].AsFloat := Self.AdditionalPrice; tSQL_Resources.Fields[fiResource_Rtype].AsInteger := Self.RType; tSQL_Resources.Post; end; { case AMakeEdit of meMake: begin tSQL_Resources.Append; tSQL_Resources.FieldByName(fnID).AsInteger := IDResource; end; meEdit: begin tSQL_Resources.Filtered := false; if tSQL_Resources.Locate(fnID, IDResource, []) then tSQL_Resources.Edit; end; end; if tSQL_Resources.State <> dsBrowse then begin tSQL_Resources.FieldByName(fnGuidNB).AsString := GuidNB; tSQL_Resources.FieldByName(fnTableKindNB).AsInteger := TableKindNB; tSQL_Resources.FieldByName(fnCypher).AsString := Cypher; tSQL_Resources.FieldByName(fnName).AsString := Self.Name; tSQL_Resources.FieldByName(fnIzm).AsString := Izm; tSQL_Resources.FieldByName(fnPrice).AsFloat := Price; tSQL_Resources.FieldByName(fnAdditionalPrice).AsFloat := AdditionalPrice; tSQL_Resources.FieldByName(fnRtype).AsInteger := RType; tSQL_Resources.Post; end; } end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.SaveResourceToMemTable: '+E.Message); end; end; procedure TSCSResourceRel.SaveResourceRelToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin try with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: begin tSQL_NormResourceRel.Append; tSQL_NormResourceRel.Fields[fiNormResRel_ID].AsInteger := Self.ID; end; meEdit: begin tSQL_NormResourceRel.Filtered := false; if tSQL_NormResourceRel.Locate(fnID, Self.ID, []) then tSQL_NormResourceRel.Edit; end; end; if tSQL_NormResourceRel.State <> dsBrowse then begin tSQL_NormResourceRel.Fields[fiNormResRel_TableKind].AsInteger := Self.MasterTableKind; tSQL_NormResourceRel.Fields[fiNormResRel_IDMaster].AsInteger := Self.IDMaster; //IDMaster := tSQL_NormResourceRel.FieldByName(fnIDMaster).AsInteger; tSQL_NormResourceRel.Fields[fiNormResRel_Npp].AsInteger := Self.Npp; tSQL_NormResourceRel.Fields[fiNormResRel_IDResource].AsInteger := Self.IDResource; tSQL_NormResourceRel.Fields[fiNormResRel_Kolvo].AsFloat := Self.Kolvo; tSQL_NormResourceRel.Fields[fiNormResRel_Cost].AsFloat := Self.Cost; tSQL_NormResourceRel.Fields[fiNormResRel_IsOn].AsInteger := Self.IsOn; tSQL_NormResourceRel.Fields[fiNormResRel_ExpenseForLength].AsFloat := Self.ExpenseForLength; tSQL_NormResourceRel.Fields[fiNormResRel_GuidNBComponent].AsInteger := AStringsMan.GenStrID(Self.GUIDNBComponent, AStringsMan.FComponGuidNBStrings); tSQL_NormResourceRel.Fields[fiNormResRel_CountForPoint].AsFloat := Self.CountForPoint; tSQL_NormResourceRel.Fields[fiNormResRel_StepOfPoint].AsFloat := Self.StepOfPoint; tSQL_NormResourceRel.Fields[fiNormResRel_IDCompPropRel].AsInteger := Self.IDCompPropRel; tSQL_NormResourceRel.Post; end; { case AMakeEdit of meMake: begin tSQL_NormResourceRel.Append; tSQL_NormResourceRel.FieldByName(fnID).AsInteger := ID; end; meEdit: begin tSQL_NormResourceRel.Filtered := false; if tSQL_NormResourceRel.Locate(fnID, ID, []) then tSQL_NormResourceRel.Edit; end; end; if tSQL_NormResourceRel.State <> dsBrowse then begin tSQL_NormResourceRel.FieldByName(fnTableKind).AsInteger := MasterTableKind; tSQL_NormResourceRel.FieldByName(FMasterField).AsInteger := IDMaster; //IDMaster := tSQL_NormResourceRel.FieldByName(fnIDMaster).AsInteger; tSQL_NormResourceRel.FieldByName(fnNpp).AsInteger := Npp; tSQL_NormResourceRel.FieldByName(fnIDResource).AsInteger := IDResource; tSQL_NormResourceRel.FieldByName(fnKolvo).AsFloat := Kolvo; tSQL_NormResourceRel.FieldByName(fnCost).AsFloat := Cost; tSQL_NormResourceRel.FieldByName(fnIsOn).AsInteger := IsOn; tSQL_NormResourceRel.Post; end; } end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.SaveResourceRelToMemTable: '+E.Message); end; end; procedure TSCSResourceRel.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin SaveResourceToMemTable(AMakeEdit, AStringsMan); SaveResourceRelToMemTable(AMakeEdit, AStringsMan); end; procedure TSCSResourceRel.LoadResourceByFld(AFldName: String; AFldValue: Variant); begin end; procedure TSCSResourceRel.SaveData(AMakeEdit: TMakeEdit; ANewMasterID: Integer); var ResourcesFields: TStringList; NormResourceRelFields: TStringList; begin try case FQueryMode of qmPhisical: begin ResourcesFields := TStringList.Create; NormResourceRelFields := TStringList.Create; try //DefineQuery; if FNormType <> ntProj then begin ResourcesFields.free; // Tolik 15/05/2018 -- NormResourceRelFields.free; // Tolik 15/05/2018 -- Exit; /// EXIT /// end; ResourcesFields.Add(fnIDNB); ResourcesFields.Add(fnGUIDNB); ResourcesFields.Add('Table_Kind_NB'); ResourcesFields.Add('CYPHER'); ResourcesFields.Add('NAME'); ResourcesFields.Add('IZM'); ResourcesFields.Add('PRICE'); ResourcesFields.Add(fnAdditionalPrice); ResourcesFields.Add('RTYPE'); NormResourceRelFields.Add('NPP'); NormResourceRelFields.Add('KOLVO'); NormResourceRelFields.Add('ISON'); NormResourceRelFields.Add('COST'); NormResourceRelFields.Add('RVALUE'); NormResourceRelFields.Add(fnExpenseForLength); //NormResourceRelFields.Add(fnGuidNBComponent); NormResourceRelFields.Add(fnIDNBComponent); NormResourceRelFields.Add(fnCountForPoint); NormResourceRelFields.Add(fnStepOfPoint); case AMakeEdit of meMake: begin // IGOR - так лучше не делать при сетевом подключении дублирование полей сервер FireBird не хочет понимать! //ResourcesFields.Add(fnGuidNB); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnResources, '', ResourcesFields, ''), false); //FQOperat.ParamByName(fnGuidNB).AsString := GuidNB; end; meEdit: begin ResourcesFields.Add(fnID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnResources, fnID+' = :'+fnID, ResourcesFields, ''), false); FQOperat.ParamByName(fnID).AsInteger := IDResource; end; end; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDNB, IDNB); FQOperat.ParamByName(fnGuidNB).AsString := GUIDNB; FQOperat.ParamByName(fnTableKindNB).AsInteger := TableKindNB; FQOperat.ParamByName('CYPHER').AsString := Cypher; FQOperat.ParamByName('NAME').AsString := Name; FQOperat.ParamByName('IZM').AsString := Izm; FQOperat.ParamByName('PRICE').AsDouble := Price; FQOperat.ParamByName(fnAdditionalPrice).AsDouble := AdditionalPrice; FQOperat.ParamByName('RTYPE').AsInteger := RType; FQOperat.ExecQuery; FQOperat.Close; if AMakeEdit = meMake then begin //SetSQLToQuery(FQuery_Select, ' select MAX(ID) As max_id from resources '); //NewIDResource := FQuery_Select.GetFNAsInteger('max_id'); NewIDResource := GenIDFromTable(FQSelect, gnResourcesID, 0); IDResource := NewIDResource; //FQuery_Select.Close; end; //FQuery_Select.Close; //*** Сохранить связь ресурса с (нормой, ...) case AMakeEdit of meMake: begin NormResourceRelFields.Add(FMasterField); //NormResourceRelFields.Add('ID_MASTER'); NormResourceRelFields.Add('ID_RESOURCE'); NormResourceRelFields.Add('TABLE_KIND'); //SQLBuilder(FQuery_Operat, qtInsert, 'norm_resource_rel', '', NormResourceRelFields, false); //FQuery_Operat.SetParamAsInteger(FMasterField, ANewMasterID); // FQuery_Operat.SetParamAsInteger('ID_MASTER', ANewMasterID); //FQuery_Operat.SetParamAsInteger('ID_RESOURCE', NewIDResource); //FQuery_Operat.SetParamAsInteger('TABLE_KIND', MasterTableKind); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnNormResourceRel, '', NormResourceRelFields, ''), false); FQOperat.ParamByName(FMasterField).AsInteger := ANewMasterID; FQOperat.ParamByName('ID_RESOURCE').AsInteger := NewIDResource; FQOperat.ParamByName('TABLE_KIND').AsInteger := MasterTableKind; end; meEdit: begin NormResourceRelFields.Add('ID'); //SQLBuilder(FQuery_Operat, qtUpdate, 'norm_resource_rel', 'id = :id', NormResourceRelFields, false); //FQuery_Operat.SetParamAsInteger('ID', ID); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnNormResourceRel, 'id = :id', NormResourceRelFields, ''), false); FQOperat.ParamByName(fnID).AsInteger := ID; end; end; FQOperat.ParamByName('NPP').AsInteger := Npp; FQOperat.ParamByName('KOLVO').AsDouble := Kolvo; FQOperat.ParamByName('COST').AsDouble := Cost; FQOperat.ParamByName(fnExpenseForLength).AsDouble := ExpenseForLength; //FQOperat.ParamByName(fnGuidNBComponent).AsString := GUIDNBComponent; if IDNBComponent = 0 then FQOperat.ParamByName(fnIDNBComponent).Value := null else FQOperat.ParamByName(fnIDNBComponent).AsInteger := IDNBComponent; FQOperat.ParamByName(fnCountForPoint).AsDouble := CountForPoint; FQOperat.ParamByName(fnStepOfPoint).AsDouble := StepOfPoint; FQOperat.ParamByName('ISON').AsInteger := IsOn; FQOperat.ExecQuery; FQOperat.Close; if AMakeEdit = meMake then begin //SetSQLToQuery(FQuery_Select, ' select MAX(ID) As max_id from norm_resource_rel '); //NewID := FQuery_Select.GetFNAsInteger('max_id'); NewID := GenIDFromTable(FQSelect, gnNormResourceRelID, 0); ID := NewID; //FQuery_Select.Close; end; //FQuery_Select.Close; finally FreeAndNil(ResourcesFields); FreeAndNil(NormResourceRelFields); end; end; qmMemory: if AMakeEdit = meMake then begin NewIDResource := GenCurrProjTableID(giResourcesID); IDResource := NewIDResource; NewID := GenCurrProjTableID(giNormResourceRelID); ID := NewID; end; { <#MemTableClear#> with TF_Main(ActiveForm).DM do begin case AMakeEdit of meMake: begin tSQL_Resources.Append; tSQL_Resources.FieldByName(fnGuidNB).AsString := GuidNB; end; meEdit: begin if SetFilterToSQLMemTable(tSQL_Resources, 'id = '''+IntToStr(IDResource)+'''') then tSQL_Resources.Edit; end; end; if tSQL_Resources.State = dsBrowse then Exit; ///// EXIT ///// //tSQL_Resources.FieldByName('ID_NB').AsInteger := IDNB; tSQL_Resources.FieldByName('Table_Kind_NB').AsInteger := TableKindNB; tSQL_Resources.FieldByName('CYPHER').AsString := Cypher; tSQL_Resources.FieldByName('NAME').AsString := Self.Name; tSQL_Resources.FieldByName('IZM').AsString := Izm; tSQL_Resources.FieldByName('PRICE').AsFloat := Price; tSQL_Resources.FieldByName(fnAdditionalPrice).AsFloat := AdditionalPrice; tSQL_Resources.FieldByName('RTYPE').AsInteger := RType; tSQL_Resources.Post; if AMakeEdit = meMake then NewIDResource := tSQL_Resources.FieldByName(fnID).AsInteger; //*** Сохранить связь ресурса case AMakeEdit of meMake: begin tSQL_NormResourceRel.Append; tSQL_NormResourceRel.FieldByName(FMasterField).AsInteger := ANewMasterID; //tSQL_NormResourceRel.FieldByName('ID_MASTER').AsInteger := ANewMasterID; tSQL_NormResourceRel.FieldByName('ID_RESOURCE').AsInteger := NewIDResource; tSQL_NormResourceRel.FieldByName('TABLE_KIND').AsInteger := MasterTableKind; end; meEdit: begin if SetFilterToSQLMemTable(tSQL_NormResourceRel, 'id = '''+IntTostr(ID)+'''') then tSQL_NormResourceRel.Edit; end; end; if tSQL_NormResourceRel.State = dsBrowse then Exit; ///// EXIT ///// tSQL_NormResourceRel.FieldByName('NPP').AsInteger := Npp; tSQL_NormResourceRel.FieldByName('KOLVO').AsFloat := Kolvo; tSQL_NormResourceRel.FieldByName('COST').AsFloat := Cost; tSQL_NormResourceRel.FieldByName('ISON').AsInteger := IsOn; tSQL_NormResourceRel.Post; if AMakeEdit = meMake then NewID := tSQL_NormResourceRel.FieldByName(fnID).AsInteger; end;} end; except on E: Exception do AddExceptionToLog('TSCSResourceRel.SaveData: '+E.Message); end; end; procedure TSCSResourceRel.SaveResourceAsNew(ANewMasterID: Integer); begin SaveData(meMake, ANewMasterID); end; procedure TSCSResourceRel.UpdateResource; begin SaveData(meEdit, -1); end; procedure TSCSResourceRel.SaveByServiceFields(ANewMasterID: Integer); begin if IsNew then SaveData(meMake, ANewMasterID) else if IsModified then SaveData(meEdit, -1); end; { TSCSResourceGroup } constructor TSCSResourceGroup.Create(AFormOwner: TForm); begin inherited Create(AFormOwner, ntProj); FObjectList := TSCSObjectList.Create(false); end; destructor TSCSResourceGroup.Destroy; begin FreeAndNil(FObjectList); inherited; end; { TSCSNormPreyscurant } procedure TSCSNormPreyscurant.Assign(ANormPreyscurant: TSCSNormPreyscurant); begin Name := ANormPreyscurant.Name; Kolvo := ANormPreyscurant.Kolvo; PairKolvo := ANormPreyscurant.PairKolvo; InterfaceType := ANormPreyscurant.InterfaceType; SCSComponentGUID := ANormPreyscurant.SCSComponentGUID; RelationComponentGUID := ANormPreyscurant.RelationComponentGUID; SCSComponent := ANormPreyscurant.SCSComponent; RelationComponent := ANormPreyscurant.RelationComponent; ResourceRel := ANormPreyscurant.ResourceRel; end; constructor TSCSNormPreyscurant.Create; begin inherited; Name := ''; Kolvo := 0; PairKolvo := 0; InterfaceType := -1; SCSComponentGUID := ''; RelationComponentGUID := ''; SCSComponent := nil; RelationComponent := nil; ResourceRel := nil; end; destructor TSCSNormPreyscurant.Destroy; begin inherited; end; { TSCSNorm } // ######################### Класс TSCSNorm #################################### // ############################################################################# // // ##### ##### constructor TSCSNorm.Create(AFormOwner: TForm; ANormType: TNormType); begin //FTableName := tnNorms; //FTableIndex := tiNorms; inherited Create(AFormOwner); //ActiveForm := AFormOwner; FNormType := ANormType; FResources := TSCSResources.Create(true); FPreyscurants := TSCSObjectList.Create(true); //DefineQuery; //ActivateTransaction; //FQuery := (ActiveForm as TF_Main).DM.Query_TSCSCompon; end; destructor TSCSNorm.Destroy; begin Clear; FreeAndNil(FPreyscurants); FreeAndNil(FResources); inherited; //Destroy; end; procedure TSCSNorm.SetActiveForm(Value: TForm); var i: Integer; begin inherited; //TBasicSCSClass(Self).ActiveForm := Value; if Assigned(Resources) then for i := 0 to Resources.Count - 1 do TSCSResourceRel(Resources[i]).ActiveForm := Value; end; procedure TSCSNorm.Assign(ASCSNorm: TSCSNorm; AFromNew: Boolean = false); begin if Not Assigned(ASCSNorm) then Exit; //// EXIT ///// AssignOnlyNorm(ASCSNorm, AFromNew); AssignResources(ASCSNorm.Resources, AFromNew); end; procedure TSCSNorm.AssignOnlyNorm(ASCSNorm: TSCSNorm; AFromNew: Boolean = false); begin if Not Assigned(ASCSNorm) then Exit; //// EXIT ///// ID := ASCSNorm.ID; IDNB := ASCSNorm.IDNB; GuidNB := ASCSNorm.GuidNB; NewID := ASCSNorm.NewID; IDMaster := ASCSNorm.IDMaster; MasterTableKind := ASCSNorm.MasterTableKind; NPP := ASCSNorm.NPP; IsOn := ASCSNorm.IsOn; Kolvo := ASCSNorm.Kolvo; TotalCost := ASCSNorm.TotalCost; Cypher := ASCSNorm.Cypher; Name := ASCSNorm.Name; WorkKind := ASCSNorm.WorkKind; Izm_ := ASCSNorm.Izm_; LaborTime := ASCSNorm.LaborTime; PricePerTime := ASCSNorm.PricePerTime; Price := ASCSNorm.Price; Cost := ASCSNorm.Cost; IsFromInterface := ASCSNorm.IsFromInterface; ExpenseForLength := ASCSNorm.ExpenseForLength; //ExpenseForSection := ASCSNorm.ExpenseForSection; CountForPoint := ASCSNorm.CountForPoint; StepOfPoint := ASCSNorm.StepOfPoint; if AFromNew then ID := ASCSNorm.NewID; //*** Служебные поля //IsNew //IsModified end; procedure TSCSNorm.AssignResources(AResources: TSCSResources; AFromNew: Boolean = false); var i: Integer; ResourceRel: TSCSResourceRel; begin if Not Assigned(AResources) then Exit; //// EXIT ///// FResources.Clear; for i := 0 to AResources.Count - 1 do begin ResourceRel := TSCSResourceRel.Create(ActiveForm, ntProj); ResourceRel.IDMaster := ID; ResourceRel.MasterTableKind := ctkNorm; ResourceRel.Assign(AResources[i], AFromNew); ResourceRel.IDMaster := ID; ResourceRel.MasterTableKind := ctkNorm; if AFromNew then ResourceRel.IDMaster := NewID; FResources.Add(ResourceRel); end; end; // ##### ##### procedure TSCSNorm.Clear; begin FResources.Clear; FPreyscurants.Clear; ID := 0; IDNB := 0; NewID := 0; GuidNB := ''; IDCompPropRel := 0; Cypher := ''; Name := ''; WorkKind := ''; Izm_ := ''; LaborTime := 0; PricePerTime := 0; Price := 0; IsFromInterface := biFalse; ExpenseForLength := 0; CountForPoint := 0; StepOfPoint := 0; //ExpenseForSection := 0; //ClearListWithObjects(Resources); end; procedure TSCSNorm.LoadFromMemTable(AStringsMan: TStringsMan); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Norms; if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUIDNB := FMemTable.Fields[fiNorms_GUIDNB].AsString; Self.Cypher := FMemTable.Fields[fiNorms_Cypher].AsString; Self.Name := FMemTable.Fields[fiNorms_Name].AsString; Self.WorkKind := FMemTable.Fields[fiNorms_WorkKind].AsString; Self.Izm_ := FMemTable.Fields[fiNorms_Izm].AsString; end else begin Self.GUIDNB := AStringsMan.GetStrByID(FMemTable.Fields[fiNorms_GUIDNB].AsInteger, AStringsMan.FNormGuidNBStrings); Self.Cypher := AStringsMan.GetStrByID(FMemTable.Fields[fiNorms_Cypher].AsInteger, AStringsMan.FNormCypherStrings); Self.Name := AStringsMan.GetStrByID(FMemTable.Fields[fiNorms_Name].AsInteger, AStringsMan.FNormNameStrings); Self.WorkKind := AStringsMan.GetStrByID(FMemTable.Fields[fiNorms_WorkKind].AsInteger, AStringsMan.FNormWorkKindStrings); Self.Izm_ := AStringsMan.GetStrByID(FMemTable.Fields[fiNorms_Izm].AsInteger, AStringsMan.FIzmStrings); end; Self.ID := FMemTable.Fields[fiNorms_ID].AsInteger; Self.IDNB := FMemTable.Fields[fiNorms_IDNB].AsInteger; Self.MasterTableKind := FMemTable.Fields[fiNorms_TableKind].AsInteger; Self.IDMaster := FMemTable.Fields[fiNorms_IDMaster].AsInteger; //IDMaster := FMemTable.FieldByName('ID_Master').AsInteger; Self.Npp := FMemTable.Fields[fiNorms_Npp].AsInteger; Self.IsOn := FMemTable.Fields[fiNorms_IsOn].AsInteger; if fiNorms_LaborTime <> -1 then begin LaborTime := FMemTable.Fields[fiNorms_LaborTime].AsInteger; PricePerTime := FMemTable.Fields[fiNorms_PricePerTime].AsFloat; end; if fiNorms_Price <> -1 then Self.Price := FMemTable.Fields[fiNorms_Price].AsFloat; Self.Cost := FMemTable.Fields[fiNorms_Cost].AsFloat; Self.Kolvo := FMemTable.Fields[fiNorms_Kolvo].AsFloat; Self.TotalCost := FMemTable.Fields[fiNorms_TotalCost].AsFloat; if fiNorms_IsFromInterface <> -1 then Self.IsFromInterface := FMemTable.Fields[fiNorms_IsFromInterface].AsInteger; if fiNorms_ExpenseForLength <> -1 then Self.ExpenseForLength := FMemTable.Fields[fiNorms_ExpenseForLength].AsFloat; if fiNorms_CountForPoint <> -1 then Self.CountForPoint := FMemTable.Fields[fiNorms_CountForPoint].AsFloat; if fiNorms_StepOfPoint <> -1 then Self.StepOfPoint := FMemTable.Fields[fiNorms_StepOfPoint].AsFloat; if fiNorms_IDCompPropRel <> -1 then Self.IDCompPropRel := FMemTable.Fields[fiNorms_IDCompPropRel].AsInteger; end; { ID := FMemTable.FieldByName(fnID).AsInteger; //IDNB := FMemTable.FieldByName(fnIDNB).AsInteger; GUIDNB := FMemTable.FieldByName(fnGUIDNB).AsString; Cypher := FMemTable.FieldByName(fnCypher).AsString; MasterTableKind := FMemTable.FieldByName(fnTableKind).AsInteger; Name := FMemTable.FieldByName(fnName).AsString; WorkKind := FMemTable.FieldByName(fnWorkKind).AsString; Izm := FMemTable.FieldByName(fnIzm).AsString; IDMaster := FMemTable.FieldByName(FMasterField).AsInteger; //IDMaster := FMemTable.FieldByName('ID_Master').AsInteger; Npp := FMemTable.FieldByName(fnNpp).AsInteger; IsOn := FMemTable.FieldByName(fnIsOn).AsInteger; Cost := FMemTable.FieldByName(fnCost).AsFloat; Kolvo := FMemTable.FieldByName(fnKolvo).AsFloat; TotalCost := FMemTable.FieldByName(fnTotalCost).AsFloat; if FMemTable.FieldDefs.IndexOf(fnIsFromInterface) <> -1 then IsFromInterface := FMemTable.FieldByName(fnIsFromInterface).AsInteger; } except on E: Exception do AddExceptionToLog('TSCSNorm.LoadFromMemTable: '+E.Message); end; end; procedure TSCSNorm.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); var FMemTable: TSQLMemTable; begin try with TF_Main(FActiveForm).DM do begin FMemTable := TF_Main(FActiveForm).DM.tSQL_Norms; if FMemTable <> nil then // Tolik 26/04/2021 -- begin case AMakeEdit of meMake: begin FMemTable.Append; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, Self.ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.Fields[fiNorms_ID].AsInteger := Self.ID; FMemTable.Fields[fiNorms_GUIDNB].AsInteger := AStringsMan.GenStrID(Self.GuidNB, AStringsMan.FNormGuidNBStrings); FMemTable.Fields[fiNorms_IDNB].AsInteger := Self.IDNB; FMemTable.Fields[fiNorms_Cypher].AsInteger := AStringsMan.GenStrID(Self.Cypher, AStringsMan.FNormCypherStrings); FMemTable.Fields[fiNorms_TableKind].AsInteger := Self.MasterTableKind; FMemTable.Fields[fiNorms_Name].AsInteger := AStringsMan.GenStrID(Self.Name, AStringsMan.FNormNameStrings); FMemTable.Fields[fiNorms_WorkKind].AsInteger := AStringsMan.GenStrID(Self.WorkKind, AStringsMan.NormWorkKindStrings); FMemTable.Fields[fiNorms_Izm].AsInteger := AStringsMan.GenStrID(Self.Izm_, AStringsMan.FIzmStrings); FMemTable.Fields[fiNorms_IDMaster].AsInteger := Self.IDMaster; //IDMaster := FMemTable.FieldByName('ID_Master').AsInteger; FMemTable.Fields[fiNorms_Npp].AsInteger := Self.Npp; FMemTable.Fields[fiNorms_IsOn].AsInteger := Self.IsOn; FMemTable.Fields[fiNorms_LaborTime].AsInteger := LaborTime; FMemTable.Fields[fiNorms_PricePerTime].AsFloat := PricePerTime; FMemTable.Fields[fiNorms_Price].AsFloat := Self.Price; FMemTable.Fields[fiNorms_Cost].AsFloat := Self.Cost; FMemTable.Fields[fiNorms_Kolvo].AsFloat := Self.Kolvo; FMemTable.Fields[fiNorms_TotalCost].AsFloat := Self.TotalCost; FMemTable.Fields[fiNorms_IsFromInterface].AsInteger := Self.IsFromInterface; FMemTable.Fields[fiNorms_ExpenseForLength].AsFloat := Self.ExpenseForLength; FMemTable.Fields[fiNorms_CountForPoint].AsFloat := Self.CountForPoint; FMemTable.Fields[fiNorms_StepOfPoint].AsFloat := Self.StepOfPoint; FMemTable.Fields[fiNorms_IDCompPropRel].AsInteger := Self.IDCompPropRel; FMemTable.Post; end; end; end; { case AMakeEdit of meMake: begin FMemTable.Append; end; meEdit: begin FMemTable.Filtered := false; if FMemTable.Locate(fnID, ID, []) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin FMemTable.FieldByName(fnID).AsInteger := ID; FMemTable.FieldByName(fnGUIDNB).AsString := GUIDNB; FMemTable.FieldByName(fnCypher).AsString := Cypher; FMemTable.FieldByName(fnTableKind).AsInteger := MasterTableKind; FMemTable.FieldByName(fnName).AsString := Name; FMemTable.FieldByName(fnWorkKind).AsString := WorkKind; FMemTable.FieldByName(fnIzm).AsString := Izm; FMemTable.FieldByName(FMasterField).AsInteger := IDMaster; //IDMaster := FMemTable.FieldByName('ID_Master').AsInteger; FMemTable.FieldByName(fnNpp).AsInteger := Npp; FMemTable.FieldByName(fnIsOn).AsInteger := IsOn; FMemTable.FieldByName(fnCost).AsFloat := Cost; FMemTable.FieldByName(fnKolvo).AsFloat := Kolvo; FMemTable.FieldByName(fnTotalCost).AsFloat := TotalCost; FMemTable.FieldByName(fnIsFromInterface).AsInteger := IsFromInterface; FMemTable.Post; end; } except on E: Exception do AddExceptionToLog('TSCSNorm.SaveToMemTable: '+E.Message); end; end; procedure TSCSNorm.LoadNormByField(AFldByName: String; AFldValue: Variant; ALoadResources: Boolean); var SavedForm: TForm; TableName, OrderByFld, strFilter: String; begin SavedForm := ActiveForm; case FNormType of ntNB: if FQueryMode = qmPhisical then begin SavedForm := ActiveForm; ActiveForm := F_NormBase; TableName := 'nb_norms'; OrderByFld := 'id'; end else Exit; ///// EXIT ///// ntProj: begin TableName := 'norms'; OrderByFld := 'npp'; end; end; //FQuery := TF_Main(ActiveForm).DM.Query_TSCSCompon; //ActivateTransaction; //DefineQuery; strFilter := AFldByName +' = '''+VarToStr(AFldValue)+''''; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, 'select * from '+TableName+' where '+strFilter+' order by '+OrderByFld+' '); ID := FQSelect.FN('ID').AsInteger; Cypher := FQSelect.FN('Cypher').AsString; Name := FQSelect.FN('Name').AsString; WorkKind := FQSelect.FN('Work_Kind').AsString; Izm_ := FQSelect.FN('Izm').AsString; LaborTime := FQSelect.FN(fnLaborTime).AsInteger; PricePerTime := FQSelect.FN(fnPricePerTime).AsDouble; Price := FQSelect.FN(fnPrice).AsFloat; if FNormType = ntNB then begin IDNB := FQSelect.FN(fnID).AsInteger; GuidNB := FQSelect.FN(fnGuid).AsString; end; if FNormType = ntProj then begin MasterTableKind := FQSelect.FN('Table_Kind').AsInteger; IDMaster := FQSelect.FN(FMasterField).AsInteger; //IDMaster := FQSelect.FN('ID_Master').AsInteger; IDNB := FQSelect.FN(fnIDNB).AsInteger; GuidNB := FQSelect.FN(fnGuidNB).AsString; Npp := FQSelect.FN('Npp').AsInteger; IsOn := FQSelect.FN('IsOn').AsInteger; Cost := FQSelect.FN('Cost').AsDouble; Kolvo := FQSelect.FN('Kolvo').AsDouble; TotalCost := FQSelect.FN('Total_cost').AsDouble; ExpenseForLength := FQSelect.FN(fnExpenseForLength).AsDouble; CountForPoint := FQSelect.FN(fnCountForPoint).AsDouble; StepOfPoint := FQSelect.FN(fnStepOfPoint).AsDouble; //ExpenseForSection := FQSelect.FN(fnExpenseForSection).AsDouble; IsFromInterface := biFalse; end; FQSelect.Close; end; qmMemory: if FNormType = ntProj then begin { if SetFilterToSQLMemTable(FMemTable, strFilter) then begin FMemTable.IndexName := GetIndexByFldFomSQLMemTable(FMemTable, OrderByFld); if Not FMemTable.Eof then begin LoadFromMemTable; end; end; } //FMemTable.IndexName := ''; end else Exit; ///// EXIT ///// end; IsNew := false; IsModified := false; if ALoadResources then LoadResourcesByNormType(ID); if FNormType = ntNB then ActiveForm := SavedForm; end; procedure TSCSNorm.LoadResourcesByNormType(AID_Master: Integer); var TNNormResourceRel: String; //TableName TNResource: String; //TableName FNameIDResource: String; //FieldName FNameIDMaster: String; //FieldName ResourceRel: TSCSResourceRel; i: integer; strFilter: String; IDList: TIntList; begin IDList := TIntList.Create; case FNormType of ntNB: begin TNNormResourceRel := 'nb_norm_resource_rel'; TNResource := 'nb_resources'; FNameIDMaster := 'id_nb_norm'; FNameIDResource := 'id_nb_resource'; SetSQLToFIBQuery(FQSelect, ' select id '+ ' from nb_norm_resource_rel '+ ' where (id_nb_norm = '''+IntToStr(AID_Master)+''') '+ ' order by nb_norm_resource_rel.id '); IntFIBFieldToIntList(IDList, FQSelect, fnID); FQSelect.Close; end; ntProj: begin TNNormResourceRel := 'norm_resource_rel'; TNResource := 'resources'; FNameIDMaster := 'id_master'; FNameIDResource := 'id_resource'; //strFilter := '(id_master = '''+IntToStr(AID_Norm)+''') and (table_kind = '''+IntTostr(ctkNorm)+''')'; strFilter := '('+GetMasterFieldName(ctkNorm)+' = '''+IntToStr(AID_Master)+''') and (table_kind = '''+IntTostr(ctkNorm)+''')'; case FQueryMode of qmPhisical: begin SetSQLToFIBQuery(FQSelect, ' select id '+ ' from norm_resource_rel '+ ' where ' + strFilter + ' order by norm_resource_rel.npp '); IntFIBFieldToIntList(IDList, FQSelect, fnID); FQSelect.Close; end; qmMemory: with TF_Main(ActiveForm).DM do begin { SetFilterToSQLMemTable(tSQL_NormResourceRel, strFilter); tSQL_NormResourceRel.IndexName := GetIndexByFldFomSQLMemTable(tSQL_NormResourceRel, fnNpp); IntFieldToListFromSQLMemTable(IDList, tSQL_NormResourceRel, fnID); tSQL_NormResourceRel.IndexName := ''; } end; end; end; end; for i := 0 to IDList.Count - 1 do begin ResourceRel := TSCSResourceRel.Create(ActiveForm, FNormType); ResourceRel.ID := IDList[i]; Resources.Add(ResourceRel); ResourceRel.MasterTableKind := ctkNorm; ResourceRel.LoadResourceByID(ResourceRel.ID); end; IDList.Free; end; procedure TSCSNorm.SaveData(AMakeEdit: TMakeEdit; ANewMasterID: Integer); var strFilter: String; NormsFields: TStringList; begin try strFilter := 'id = '''+IntToStr(ID)+''''; case FQueryMode of qmPhisical: begin NormsFields := TStringList.Create; try //DefineQuery; //NormsFields.Add('ID'); NormsFields.Add(fnIDNB); NormsFields.Add('NPP'); NormsFields.Add('ISON'); NormsFields.Add('KOLVO'); NormsFields.Add('TOTAL_COST'); NormsFields.Add('CYPHER'); NormsFields.Add('NAME'); NormsFields.Add('WORK_KIND'); NormsFields.Add('IZM'); NormsFields.Add(fnLaborTime); NormsFields.Add(fnPricePerTime); NormsFields.Add(fnPrice); NormsFields.Add('COST'); NormsFields.Add(fnExpenseForLength); NormsFields.Add(fnCountForPoint); NormsFields.Add(fnStepOfPoint); //*** Сохранение норм case AMakeEdit of meMake: begin NormsFields.Add(fnGuidNB); NormsFields.Add(FMasterField); //NormsFields.Add('ID_Master'); NormsFields.Add('TABLE_KIND'); //SQLBuilder(FQuery_Operat, qtInsert, 'norms', '', NormsFields, false); //FQuery_Operat.SetParamAsString(fnGuidNB, GuidNB); //FQuery_Operat.SetParamAsInteger('TABLE_KIND', MasterTableKind); //FQuery_Operat.SetParamAsInteger(FMasterField, ANewMasterID); //FQuery_Operat.SetParamAsInteger('ID_MASTER', AID_NewMaster); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtInsert, tnNorms, '', NormsFields, ''), false); FQOperat.ParamByName(fnGuidNB).AsString := GuidNB; FQOperat.ParamByName('TABLE_KIND').AsInteger := MasterTableKind; FQOperat.ParamByName(FMasterField).AsInteger := ANewMasterID; end; meEdit: begin //SQLBuilder(FQuery_Operat, qtUpdate, 'norms', strFilter, NormsFields, false); SetSQLToFIBQuery(FQOperat, GetSQLByParams(qtUpdate, tnNorms, strFilter, NormsFields, ''), false); end; end; SetParamAsInteger0AsNullToQuery(FQOperat, fnIDNB, IDNB); FQOperat.ParamByName('NPP').AsInteger := NPP; FQOperat.ParamByName('ISON').AsInteger := IsOn; FQOperat.ParamByName('KOLVO').AsDouble := Kolvo; FQOperat.ParamByName('TOTAL_COST').AsDouble := TotalCost; FQOperat.ParamByName('CYPHER').AsString := Cypher; FQOperat.ParamByName('NAME').AsString := Name; FQOperat.ParamByName('WORK_KIND').AsString := WorkKind; FQOperat.ParamByName('IZM').AsString := Izm_; FQOperat.ParamByName(fnLaborTime).AsInteger := LaborTime; FQOperat.ParamByName(fnPricePerTime).AsDouble := PricePerTime; FQOperat.ParamByName(fnPrice).AsDouble := Price; FQOperat.ParamByName('COST').AsDouble := Cost; FQOperat.ParamByName(fnExpenseForLength).AsDouble := ExpenseForLength; FQOperat.ParamByName(fnCountForPoint).AsDouble := CountForPoint; FQOperat.ParamByName(fnStepOfPoint).AsDouble := StepOfPoint; FQOperat.ExecQuery; FQOperat.Close; //QueryOptionToSelect; if AMakeEdit = meMake then begin //SetSQLToQuery(FQuery_Select, ' select MAX(ID) As max_id from norms '); //NewID := FQuery_Select.GetFNAsInteger('max_id'); NewID := GenIDFromTable(FQSelect, gnGenNormsID, 0); ID := NewID; //FQuery_Select.Close; end; finally FreeAndNil(NormsFields); end; end; qmMemory: begin IDMaster := ANewMasterID; if AMakeEdit = meMake then begin NewID := GenCurrProjTableID(giNormsID); ID := NewID; end; {<#MemTableClear#> case AMakeEdit of meMake: begin FMemTable.Append; FMemTable.FieldByName(fnGuidNB).AsInteger := MasterTableKind; FMemTable.FieldByName('TABLE_KIND').AsInteger := MasterTableKind; FMemTable.FieldByName(FMasterField).AsInteger := ANewMasterID; //FMemTable.FieldByName('ID_MASTER').AsInteger := AID_NewMaster; end; meEdit: begin if SetFilterToSQLMemTable(FMemTable, strFilter) then FMemTable.Edit; end; end; if FMemTable.State <> dsBrowse then begin //FMemTable.FieldByName(fnIDNB).AsInteger := IDNB; FMemTable.FieldByName('NPP').AsInteger := NPP; FMemTable.FieldByName('ISON').AsInteger := IsOn; FMemTable.FieldByName('KOLVO').AsFloat := Kolvo; FMemTable.FieldByName('TOTAL_COST').AsFloat := TotalCost; FMemTable.FieldByName('CYPHER').AsString := Cypher; FMemTable.FieldByName('NAME').AsString := Name; FMemTable.FieldByName('WORK_KIND').AsString := WorkKind; FMemTable.FieldByName('IZM').AsString := Izm; FMemTable.FieldByName('COST').AsFloat := Cost; FMemTable.Post; if AMakeEdit = meMake then NewID := FMemTable.FieldByName(fnID).AsInteger; end; } end; end; except on E: Exception do AddExceptionToLog('TSCSNorm.SaveNorm: '+E.Message); end; end; // ##### Загружает норму ##### procedure TSCSNorm.LoadNorm(AID_Norm: Integer; ALoadResources: Boolean); begin LoadNormByField(fnID, AID_Norm, ALoadResources); end; procedure TSCSNorm.LoadNormByGUID(AGUIDNorm: String; ALoadResources: Boolean); begin LoadNormByField(fnGuid, AGUIDNorm, ALoadResources); end; procedure TSCSNorm.LoadNormFromSprNorm(ASprNorm: TNBNorm); begin Clear; ID := ASprNorm.ID; GuidNB := ASprNorm.GUID; Cypher := ASprNorm.Cypher; Name := ASprNorm.Name; Izm_ := ASprNorm.Izm; LaborTime := ASprNorm.LaborTime; PricePerTime := ASprNorm.PricePerTime; Price := ASprNorm.Price; end; // ##### Загружает ресурсы с нормативной базы ##### procedure TSCSNorm.LoadResources(AID_Norm: Integer); begin LoadResourcesByNormType(AID_Norm); //LoadResources(AID_Norm); end; procedure TSCSNorm.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency: TCurrency; ASave: Boolean); var ResourceRel: TSCSResourceRel; i: integer; begin PricePerTime := GetPriceAfterChangeCurrency(PricePerTime, AOldCurrency, ANewCurrency); Price := GetPriceAfterChangeCurrency(Price, AOldCurrency, ANewCurrency); Cost := GetPriceAfterChangeCurrency(Cost, AOldCurrency, ANewCurrency); TotalCost := GetPriceAfterChangeCurrency(TotalCost, AOldCurrency, ANewCurrency); if ASave then UpdateNorm; //*** Обновить ресурсы for i := 0 to FResources.Count - 1 do begin ResourceRel := FResources[i]; if Assigned(ResourceRel) then ResourceRel.RefreshPricesAfterChangeCurrency(AOldCurrency, ANewCurrency, ASave); end; end; procedure TSCSNorm.SaveNormAsNew(AID_NewMaster: Integer); var i: Integer; ResourceRel: TSCSResourceRel; begin SaveData(meMake, AID_NewMaster); //*** Сохранение ресурсов нормы for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources.Items[i]; ResourceRel.SaveResourceAsNew(NewID); end; end; procedure TSCSNorm.UpdateNorm; begin SaveData(meEdit, -1); end; procedure TSCSNorm.SaveByServiceFields(AID_NewMaster: Integer); var ResourceRel: TSCSResourceRel; i: Integer; begin try if isNew then SaveNormAsNew(AID_NewMaster) else if IsModified then UpdateNorm; if Not IsNew then for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources[i]; ResourceRel.SaveByServiceFields(ID); end; except on E: Exception do AddExceptionToLog('TSCSNorm.SaveByServiceFields: '+E.Message); end; end; //*** Методы для вычислений // ##### Вычисляет Единичную стоимость нормы ##### function TSCSNorm.CalcCost: Double; var ResourcesCost: Double; i: Integer; ResourceRel: TSCSResourceRel; begin Result := 0; ResourcesCost := 0; for i := 0 to Resources.Count - 1 do begin ResourceRel := Resources.Items[i]; if ResourceRel.IsOn = biTrue then begin ResourceRel.CalcCost; ResourcesCost := ResourcesCost + ResourceRel.Cost; end; end; Cost := Price; //23.09.2010 if ResourcesCost > 0 then Cost := Cost + ResourcesCost; //Cost := CurrCost; Result := Cost; end; // ##### Вычисляет общую стоимость нормы ##### function TSCSNorm.CalcTotalCost(ACalcCost: Boolean): Double; var CurrTotalCost: Double; begin Result := 0; CurrTotalCost := 0; if ACalcCost then CalcCost; CurrTotalCost := Cost * Kolvo; TotalCost := CurrTotalCost; Result := CurrTotalCost; end; { TSCSNormGroup } constructor TSCSNormGroup.Create(AFormOwner: TForm; ANormType: TNormType); begin inherited Create(AFormOwner, ANormType); FObjectList := TSCSObjectList.Create(false); end; destructor TSCSNormGroup.Destroy; begin FreeAndNil(FObjectList); inherited; end; { TSCSBase } constructor TSCSBase.Create(AFormOwner: TForm); begin try inherited Create(AFormOwner); //ActiveForm := AFormOwner; OpenErrorMessage := ''; DBMode := TF_Main(ActiveForm).GDBMode; //CurrList := nil; CurrProject := nil; SCSCatalog := nil; SCSComponent := nil; FNBSpravochnik := TSpravochnik.Create(AFormOwner, Self); except on E: Exception do AddExceptionToLog('TSCSBase.Create: '+E.Message); end; end; procedure TSCSBase.DefineActiveFromBase; begin FActive := TF_Main(FActiveForm).DM.Database_SCS.Connected; if FActive then begin DBName := TF_Main(FActiveForm).DM.Database_SCS.DBName; end; end; destructor TSCSBase.Destroy; begin try Self.Close(false); FreeAndNil(FNBSpravochnik); except on E: Exception do AddExceptionToLog('TSCSBase.Destroy: '+E.Message); end; inherited; //Destroy; end; function TSCSBase.CheckBaseInBusyMode(ABusyDate: TDate; ABusyTime: TTime): Boolean; var BaseNow, BusyDateTime, DeltaDateTime: TDateTime; begin Result := false; BaseNow := TF_Main(FActiveForm).DM.GetBaseNow; if (ABusyDate <> 0) or (ABusyTime <> 0) then begin if DayOf(ABusyDate) = 15 then Exit; ///// EXIT ///// BusyDateTime := ABusyDate + ABusyTime; DeltaDateTime := BaseNow - BusyDateTime; // Если разница меньше одного дня if Trunc(DeltaDateTime) = 0 then if (HourOf(DeltaDateTime)*60 + MinuteOf(DeltaDateTime)) <= BusyBaseTimeReserv then Result := true; end; end; procedure TSCSBase.SetActive(Value: Boolean); begin try case Value of true: Open(''); false: Self.Close; end; except on E: Exception do AddExceptionToLog('TSCSBase.SetActive: '+E.Message); end; end; function TSCSBase.Open(ADBPath: String = ''; AReconnect: Boolean = true; ANoCheckConnect: Boolean = true; ACheckBusy: Boolean = true): TOpenBaseResult; var DefDBPath, SettingsDBPath: String; DefRes, SettingsRes: TOpenBaseResult; function OpenWithPath(APath: String): TOpenBaseResult; var DriveChar: string; DriveType: Integer; PMSettings: TPMSettingRecord; NBSettings: TNBSettingRecord; NBType: Integer; IsNoProperBases, CanCheckFileIsUse, WasConnect, IsUserLogined: Boolean; FirstForm: TForm; BaseNow: TDateTime; begin Result := obrNoBases; DBName := APath; WasConnect := false; IsNoProperBases := false; FirstForm := nil; case TF_Main(FActiveForm).GDBMode of bkNormBase: FirstForm := F_NormBase; bkProjectManager: FirstForm := F_ProjMan; end; CanCheckFileIsUse := true; if (FirstForm <> nil) and TF_Main(FirstForm).GSCSBase.Active then CanCheckFileIsUse := false; //if CanCheckFileIsUse and CheckFileInUse(APath) then // Result := obrInUse //TerminateApplicationWithMessage('Файл базы данных используеться другим приложением') //else begin //DriveChar := ExtractFileDrive(APath); //DriveType := GetDriveType(PChar(DriveChar + '\')); //case DriveType of // //DRIVE_REMOTE: // //Result := obrRemoteBases; // DRIVE_REMOVABLE:; // DRIVE_FIXED:; // DRIVE_REMOTE:; // DRIVE_CDROM:; // DRIVE_RAMDISK:; //end; //if Not FileExists(APath) then //begin // Result := obrNoBases; // Exit; ///// EXIT ///// //end; //if DriveType <> DRIVE_REMOTE then with TF_Main(ActiveForm) do begin if AReconnect and DM.Database_SCS.Connected then DM.Database_SCS.Connected := false; if Not DM.Database_SCS.Connected then begin DM.Database_SCS.AliasName := ''; DM.Database_SCS.DBName := ''; DM.Database_SCS.AliasName := APath; DM.Database_SCS.DBName := APath; try SimpleOpen(false); //DM.Database_SCS.Connected := true; except //on E: Exception do AddExceptionToLog(': '+E.Message); on E: EFIBInterBaseError do begin //if E.IBErrorCode = 335544344 then begin Result := obrFoul; OpenErrorMessage := E.IBMessage; //AddExceptionToLog(E.IBMessage); Exit; ///// EXIT ///// end; end; on E: Exception do begin Result := obrFoul; OpenErrorMessage := E.Message; //AddExceptionToLog(''+E.Message); Exit; ///// EXIT ///// end; end; if Not DM.Database_SCS.Connected then begin Result := obrNoBases; Exit; ///// EXIT ///// end; WasConnect := true; //except // Result := obrInUse; // Exit; //end; end; try DefineBusyFieldsInBase(DM.Query_Select, DM.Query_Operat); //*** проверить, та ли база case DBMode of bkNormBase: begin // Поле fnUOM if Not CheckFieldInTable(tnSettings, fnUOM, DM.Query_Select) then begin DM.AddFieldToTable(tnSettings, fnUOM, ftInteger, 0); UpdateTableFieldAllRec(DM.Query_Operat, tnSettings, fnUOM, umM); end; NBType := DM.GetNBType; // Если финальная версия и тип базы не определен, то устанавливаем тип {$IF Defined(FINAL_SCS)} if NBType = nbtNone then begin SetNBType(CurrNBType, DM.Query_Select, DM.Query_Operat); NBType := DM.GetNBType;//CurrNBType; end; {$IFEND} NBSettings := DM.GetNBSettings; GNBSettings := NBSettings; if (CurrNBType <> nbtGeneral) and (NBType <> nbtGeneral) and (NBType <> CurrNBType) then begin if (CurrNBType = nbtTelecomRU) and (NBType = nbtSCSRU) then begin end else begin Result := obrFailProgramBaseType; Exit; ///// EXIT ///// end; end else if NBSettings.DBName <> bnNB then begin Result := obrNoProperBases; Exit; ///// EXIT ///// end else if ACheckBusy and CheckBaseInBusyMode(NBSettings.BusyDate, NBSettings.BusyTime) then begin Result := obrBusyMode; FBusyType := NBSettings.BusyType; Exit; ///// EXIT ///// end else if NBSettings.BuildID < CurrentNBBuildID then begin Result := obrOldStructure; Exit; ///// EXIT ///// end; end; bkProjectManager: begin PMSettings := DM.GetPMSettings; if PMSettings.DBName <> bnPM then begin Result := obrNoProperBases; Exit; ///// EXIT ///// end else if ACheckBusy and CheckBaseInBusyMode(PMSettings.BusyDate, PMSettings.BusyTime) then begin Result := obrBusyMode; FBusyType := PMSettings.BusyType; Exit; ///// EXIT ///// end; if IsUseProjLoginning then begin if Not CheckFieldInTable(tnSettings, fnUsr, DM.Query_Select) then DM.AddFieldToTable(tnSettings, fnUsr, ftBlob, 0); if Not CheckFieldInTable(tnCatalog, fnUsr, DM.Query_Select) then DM.AddFieldToTable(tnCatalog, fnUsr, ftBlob, 0); end; end; end; if ANoCheckConnect then if Result <> obrNoProperBases then begin if WasConnect then DM.ActiveAll(True); FNBSpravochnik.LoadFromNB; if DBMode = bkNormBase then begin GCurrencyM := DM.GetCurrencyByType(ctMain); GCurrencyS := DM.GetCurrencyByType(ctSecond); FUOM := GNBSettings.UOM; LoadLocalCurrencyFromDefault; end; end; except end; SCSComponent := nil; SCSCatalog := nil; FActive := true; if ANoCheckConnect then begin IsUserLogined := true; if IsUseProjLoginning then if DBMode = bkProjectManager then begin //*** Внести пользователя ADMIN, если список пользователей пуст if DM.UsersInfoPM.UsersInfo.Count = 0 then begin DM.UsersInfoPM.AddNewUserInfo(unAdmin, GetHash(unAdmin), rwrAdmin, rwrReadWrite); DM.SaveUsersInfoPMToBase; end; //IsUserLogined := (DM.UsersInfoPM.UsersInfo.Count = 1) and // (TUserInfo(DM.UsersInfoPM.UsersInfo[0]).FName = unAdmin) and // (TUserInfo(DM.UsersInfoPM.UsersInfo[0]).FPass = GetHash(unAdmin)); //IsUserLogined := DM.UsersInfoPM.IsDefAdminUser; //if Not IsUserLogined then //begin // IsUserLogined := LoginUserToPM(true, true); //LogInUser(DM.UsersInfoPM, FActiveForm, true, true); //end; IsUserLogined := LoginUserToPM(true, true); end; if IsUserLogined then begin SCSCatalog := TSCSCatalog.Create(ActiveForm); SCSComponent := TSCSComponent.Create(ActiveForm); if DBMode = bkProjectManager then begin //CurrList := TSCSList.Create(ActiveForm); CurrProject := TSCSProject.Create(ActiveForm); end; //*** Загрузка дерева try AddNodes(nil); AfterConnectToBase; except end; Tree_Catalog.Selected := Tree_Catalog.TopItem; if DBMode = bkNormBase then begin LoadTemplateGroups; LoadTemplatesToListView(tgtVirtualCompon, lvTemplates); end; SetCurrencyBriefToControls; SetControlsByUseLiteFunctional(GLiteVersion, GUseLiteFunctional, false); end; end; Result := obrSuccess; end; end; end; begin Result := obrFoul; try OpenErrorMessage := ''; DefDBPath := ''; SettingsDBPath := ''; with TF_Main(ActiveForm).DM do begin if ADBPath = '' then begin case DBMode of bkNormBase: DefDBPath := GetPathToDefNB; bkProjectManager: {$if Defined(ES_GRAPH_SC)} DefDBPath := exedir + '\' + DefPMPath; {$else} DefDBPath := extractfilepath(paramstr(0)) + '\' + DefPMPath; {$ifend} end; SettingsDBPath := ReadDBPath(DBMode); if SettingsDBPath <> '' then Result := OpenWithPath(SettingsDBPath); if Result <> obrSuccess then if DefDBPath <> '' then Result := OpenWithPath(DefDBPath); end else Result := OpenWithPath(ADBPath); if Not(FActive) and Database_SCS.Connected then begin //Database_SCS.Close; SimpleClose(false); end; end; except //on E: Exception do AddExceptionToLog('TSCSBase.Open', E.Message); end; end; procedure TSCSBase.Close(ADisconnect: Boolean = true); begin try if FActive then with TF_Main(FActiveForm) do begin if Assigned(SCSCatalog) then FreeAndNil(SCSCatalog); //if DBMode = bkNormBase then if Assigned(SCSComponent) then FreeAndNil(SCSComponent); SCSCatalog := nil; SCSComponent := nil; {if CurrList <> nil then begin CurrList.Free; CurrList := nil; end;} if CurrProject <> nil then begin FreeAndNil(CurrProject); CurrProject := nil; end; //*** Очичстить дерево DelAllNodes; if ADisconnect then begin if DBMode = bkNormBase then begin //GNBSettings.BuildID := CurrentBuildID; //GNBSettings.DisableEditing := BoolToInt(Act_mnuDisableEditTree.Checked); GNBSettings.NDS := GNDS; DM.SetNBSettings(GNBSettings); end; DM.ActiveAll(false); SimpleClose(false); //DM.Database_SCS.Connected := false; end; FActive := false; end; except on E: Exception do AddExceptionToLog('TSCSBase.Close: '+E.Message); end; end; procedure TSCSBase.SimpleClose(ADeactivate: Boolean); begin try //TF_Main(FActiveForm).DM.ActiveAll(false); if ADeactivate then TF_Main(FActiveForm).DM.ActiveAll(false); TF_Main(FActiveForm).DM.Database_SCS.Connected := false; //Application.ProcessMessages; //*** При любых раскладах, база уже не активная FActive := false; except on E: Exception do AddExceptionToLogExt(ClassName, 'SimpleClose', E.Message); end; end; procedure TSCSBase.SimpleOpen(AActivate: Boolean); var UserNames: TStringList; SavedLostConnectNB, SavedLostConnectPM: TFIBLostConnectEvent; begin SavedLostConnectNB := TF_Main(FActiveForm).FNormBase.DM.Database_SCS.OnLostConnect; SavedLostConnectPM := TF_Main(FActiveForm).FProjectMan.DM.Database_SCS.OnLostConnect; TF_Main(FActiveForm).FNormBase.DM.Database_SCS.OnLostConnect := nil; TF_Main(FActiveForm).FProjectMan.DM.Database_SCS.OnLostConnect := nil; try TF_Main(FActiveForm).DM.Database_SCS.ConnectParams.UserName := TF_Main(FActiveForm).DM.ConnectParams.UserName; TF_Main(FActiveForm).DM.Database_SCS.ConnectParams.Password := TF_Main(FActiveForm).DM.ConnectParams.Pass; TF_Main(FActiveForm).DM.Database_SCS.Connected := true; //Application.ProcessMessages; UserNames := TF_Main(FActiveForm).DM.Database_SCS.UserNames; finally TF_Main(FActiveForm).FNormBase.DM.Database_SCS.OnLostConnect := SavedLostConnectNB; TF_Main(FActiveForm).FProjectMan.DM.Database_SCS.OnLostConnect := SavedLostConnectPM; end; //if TF_Main(FActiveForm).GDBMode = bkNormBase then // DefineUseFieldsInBase(FActiveForm); //TF_Main(FActiveForm).DM.ActiveAll(true); if AActivate then begin TF_Main(FActiveForm).DM.ActiveAll(true); FNBSpravochnik.LoadFromNB; //*** База активна только в том случае, если активны DataSets FActive := true; end; //FNBSpravochnik.LoadComponentTypes; //FNBSpravochnik.LoadInterfaces; //FNBSpravochnik.LoadProperties; end; procedure TSCSBase.ShowConnPosForPM(ACapt: String); begin if TF_Main(FActiveForm).GDBMode = bkProjectManager then AddExceptionToLogEx('connection', ACapt); end; function TSCSBase.GetComponByIsLine(AIsLine: Integer): TSCSComponent; var IDCompon: Integer; begin Result := nil; IDCompon := TF_Main(FActiveForm).DM.GetComponIDByIsLine(AIsLine); if IDCompon > 0 then begin Result := TSCSComponent.Create(FActiveForm); Result.LoadComponentByID(IDCompon, false); end; end; function TSCSBase.GetComponByType(const ACompTypeSN: String): TSCSComponent; var SprComponentType: TNBComponentType; begin Result := nil; SprComponentType := FNBSpravochnik.GetComponentTypeObjBySysName(ACompTypeSN); if SprComponentType <> nil then begin Result := TSCSComponent.Create(FActiveForm); Result.Name := SprComponentType.ComponentType.Name; Result.GUIDComponentType := SprComponentType.ComponentType.GUID; Result.ComponentType := SprComponentType.ComponentType; Result.IsLine := GetIsLineByComponType(SprComponentType.ComponentType); Result.ISComplect := biFalse; Result.LoadPropertyesFromComponentType; end; end; { TSpravochnik } procedure TSpravochnik.Clear; begin ClearCurrencies; ClearComponentTypes; ClearInterfaces; ClearProperties; FNBNetTypes.Clear; FNBNorms.Clear; FNBObjectIcons.Clear; FNBProducers.Clear; //FNBProperties.Clear; FNBResources.Clear; FNBSuppliesKinds.Clear; FLastCurrency := nil; FLastComponentType := nil; FLastInterface := nil; FLastNetType := nil; FLastNorm := nil; FLastObjectIcon := nil; FLastProducer := nil; FLastProperty := nil; FLastResource := nil; FLastSuppliesKind := nil; FNewGUIDsComponentType.Clear; FNewGUIDsInterface.Clear; FNewGUIDsNetType.Clear; FNewGUIDsNorms.Clear; FNewGUIDsObjectIcons.Clear; FNewGUIDsProducers.Clear; FNewGUIDsProperties.Clear; FNewGUIDsResources.Clear; FNewGUIDsSuppliesKinds.Clear; end; procedure TSpravochnik.ClearNoListData; begin ClearCurrencies; //ClearComponentTypes; ClearInterfaces; ClearProperties; FNBNetTypes.Clear; FNBNorms.Clear; FNBObjectIcons.Clear; FNBProducers.Clear; //FNBProperties.Clear; FNBResources.Clear; FNBSuppliesKinds.Clear; FLastCurrency := nil; //FLastComponentType := nil; FLastInterface := nil; FLastNetType := nil; FLastNorm := nil; FLastObjectIcon := nil; FLastProducer := nil; FLastProperty := nil; FLastResource := nil; FLastSuppliesKind := nil; //FNewGUIDsComponentType.Clear; FNewGUIDsInterface.Clear; FNewGUIDsNetType.Clear; FNewGUIDsNorms.Clear; FNewGUIDsObjectIcons.Clear; FNewGUIDsProducers.Clear; FNewGUIDsProperties.Clear; FNewGUIDsResources.Clear; FNewGUIDsSuppliesKinds.Clear; end; constructor TSpravochnik.Create(AFormOwner: TForm; AOwnerObject: TBasicSCSClass); begin //FTableName := ''; //FTableIndex := -1; inherited Create(AFormOwner); FOwnerObject := AOwnerObject; FNBCurrencies := TSCSObjectList.Create(true); FNBComponentTypes := TSCSObjectList.Create(true); FNBInterfaces := TSCSObjectList.Create(true); FNBNetTypes := TSCSObjectList.Create(true); FNBNorms := TSCSObjectList.Create(true); FNBObjectIcons := TSCSObjectList.Create(true); FNBProducers := TSCSObjectList.Create(true); FNBProperties := TSCSObjectList.Create(true); FNBResources := TSCSObjectList.Create(true); FNBSuppliesKinds := TSCSObjectList.Create(true); FCurrencyGUIDs := TStringList.Create; FComponentTypeGUIDs := TStringList.Create; FComponentTypeGUIDs.Sorted := true; FInterfaceGUIDs := TStringList.Create; FInterfaceGUIDs.Sorted := true; FInterfaceIDs := TRapObjectList.Create; FPropertyGUIDS := TStringList.Create; FPropertyGUIDS.Sorted := true; FNewGUIDsComponentType := TStringList.Create; FNewGUIDsInterface := TStringList.Create; FNewGUIDsNetType := TStringList.Create; FNewGUIDsNorms := TStringList.Create; FNewGUIDsObjectIcons := TStringList.Create; FNewGUIDsProducers := TStringList.Create; FNewGUIDsProperties := TStringList.Create; FNewGUIDsResources := TStringList.Create; FNewGUIDsSuppliesKinds := TStringList.Create; end; destructor TSpravochnik.Destroy; begin Clear; FreeAndNil(FCurrencyGUIDs); FreeAndNil(FComponentTypeGUIDs); FreeAndNil(FInterfaceGUIDs); FreeAndNil(FInterfaceIDs); FreeAndNil(FPropertyGUIDS); FreeAndNil(FNBCurrencies); FreeAndNil(FNBComponentTypes); FreeAndNil(FNBInterfaces); FreeAndNil(FNBNetTypes); FreeAndNil(FNBNorms); FreeAndNil(FNBObjectIcons); FreeAndNil(FNBProducers); FreeAndNil(FNBProperties); FreeAndNil(FNBResources); FreeAndNil(FNBSuppliesKinds); FreeAndNil(FNewGUIDsComponentType); FreeAndNil(FNewGUIDsInterface); FreeAndNil(FNewGUIDsNetType); FreeAndNil(FNewGUIDsNorms); FreeAndNil(FNewGUIDsObjectIcons); FreeAndNil(FNewGUIDsProducers); FreeAndNil(FNewGUIDsProperties); FreeAndNil(FNewGUIDsResources); FreeAndNil(FNewGUIDsSuppliesKinds); inherited; end; procedure TSpravochnik.DefineDataFromOtherSpravByNewGUIDs(ASpravoshnick: TSpravochnik); var i, j, k: Integer; SelfComponentType: TNBComponentType; SelfInterface: TNBInterface; SelfInterfaceNorm: TNBInterfaceNorm; SelfNetType: TNBNetType; SelfNorm: TNBNorm; SelfObjectIcon: TNBObjectIcon; SelfProducer: TNBProducer; SelfPropert: TNBProperty; SelfPropValRel: TNBPropValRel; SelfPropValNormRes: TNBPropValNormRes; SelfResource: TNBResource; SelfSuppliesKind: TNBSuppliesKind; SprNetType: TNBNetType; SprNorm: TNBNorm; SprObjectIcon: TNBObjectIcon; SprProducer: TNBProducer; SprPropert: TNBProperty; SprResource: TNBResource; SprSuppliesKind: TNBSuppliesKind; CompTypeProperty: TNBCompTypeProperty; LookedGUIDsInterface: TStringList; Currency: TNBCurrency; procedure AddGUIDsAccordance(AGUIDInterface: String); var i: Integer; SprInterface: TNBInterface; SprInterfaceAccordance: TNBInterfaceAccordance; begin if LookedGUIDsInterface.IndexOf(AGUIDInterface) = -1 then begin LookedGUIDsInterface.Add(AGUIDInterface); SprInterface := ASpravoshnick.GetInterfaceByGUID(AGUIDInterface); if SprInterface <> nil then for i := 0 to SprInterface.FInterfaceAccordance.Count - 1 do begin SprInterfaceAccordance := TNBInterfaceAccordance(SprInterface.FInterfaceAccordance[i]); AddStringToStringListOnce(FNewGUIDsInterface, SprInterfaceAccordance.GUIDAccordance); AddGUIDsAccordance(SprInterfaceAccordance.GUIDAccordance); end; end; end; begin try LookedGUIDsInterface := TStringList.Create; // Интерфейсы // Закинуть соотв-е интерфейсы for i := 0 to FNewGUIDsInterface.Count - 1 do AddGUIDsAccordance(FNewGUIDsInterface[i]); // Допределить все интерфейсы for i := 0 to FNewGUIDsInterface.Count - 1 do begin SelfInterface := GetInterfaceWithAssign(FNewGUIDsInterface[i], ASpravoshnick, false, false); if (SelfInterface <> nil) and (FOwnerObject is TSCSProject) then begin // Вкинуть тип сети AddStringToStringListOnce(FNewGUIDsNetType, SelfInterface.GuidNetType); // Вкинуть нормы for j := 0 to SelfInterface.FInterfaceNorms.Count - 1 do begin SelfInterfaceNorm := TNBInterfaceNorm(SelfInterface.FInterfaceNorms[j]); AddStringToStringListOnce(FNewGUIDsNorms, SelfInterfaceNorm.GuidNBNorm); AddStringToStringListOnce(FNewGUIDsComponentType, SelfInterfaceNorm.GUIDComponentType); end; end; end; FNewGUIDsInterface.Clear; // Типы компонент for i := 0 to FNewGUIDsComponentType.Count - 1 do begin SelfComponentType := GetComponentTypeWithAssign(FNewGUIDsComponentType[i], ASpravoshnick); // Условное обознач-е AddStringToStringListOnce(FNewGUIDsObjectIcons, SelfComponentType.ComponentType.GUIDDesignIcon); // Вкинуть свойства типов компонент if (SelfComponentType <> nil) and (FOwnerObject is TSCSProject) then for j := 0 to SelfComponentType.FProperties.Count - 1 do begin CompTypeProperty := TNBCompTypeProperty(SelfComponentType.FProperties[j]); AddStringToStringListOnce(FNewGUIDsProperties, CompTypeProperty.PropertyData.GUIDProperty); AddStringToStringListOnce(FNewGUIDsProperties, CompTypeProperty.PropertyData.GUIDCrossProperty); end; end; FNewGUIDsComponentType.Clear; // Свойства for i := 0 to FNewGUIDsProperties.Count - 1 do if GetPropertyByGUID(FNewGUIDsProperties[i]) = nil then begin SprPropert := ASpravoshnick.GetPropertyByGUID(FNewGUIDsProperties[i]); if SprPropert <> nil then begin SelfPropert := TNBProperty.Create(FActiveForm); SelfPropert.Assign(SprPropert); AddProperty(SelfPropert); for j := 0 to SelfPropert.FPropValRelList.Count - 1 do begin SelfPropValRel := TNBPropValRel(SelfPropert.FPropValRelList[j]); for k := 0 to SelfPropValRel.FPropValNormResList.Count - 1 do begin SelfPropValNormRes := TNBPropValNormRes(SelfPropValRel.FPropValNormResList[k]); if SelfPropValNormRes.GuidNBRes <> '' then AddStringToStringListOnce(FNewGUIDsResources, SelfPropValNormRes.GuidNBRes) else if SelfPropValNormRes.GuidNBNorm <> '' then AddStringToStringListOnce(FNewGUIDsResources, SelfPropValNormRes.GuidNBNorm); end; end; end; end; FNewGUIDsProperties.Clear; // Типы сетей for i := 0 to FNewGUIDsNetType.Count - 1 do if GetNetTypeByGUID(FNewGUIDsNetType[i]) = nil then begin SprNetType := ASpravoshnick.GetNetTypeByGUID(FNewGUIDsNetType[i]); if SprNetType <> nil then begin SelfNetType := TNBNetType.Create(FActiveForm); SelfNetType.Assign(SprNetType); AddNetType(SelfNetType); end; end; FNewGUIDsNetType.Clear; // Нормы for i := 0 to FNewGUIDsNorms.Count - 1 do if GetNormByGUID(FNewGUIDsNorms[i]) = nil then begin SprNorm := ASpravoshnick.GetNormByGUID(FNewGUIDsNorms[i]); if SprNorm <> nil then begin SelfNorm := TNBNorm.Create(FActiveForm); SelfNorm.Assign(SprNorm); AddNorm(SelfNorm); end; end; FNewGUIDsNorms.Clear; // Условные обознасчения for i := 0 to FNewGUIDsObjectIcons.Count - 1 do if GetObjectIconByGUID(FNewGUIDsObjectIcons[i]) = nil then begin SprObjectIcon := ASpravoshnick.GetObjectIconByGUID(FNewGUIDsObjectIcons[i]); if SprObjectIcon <> nil then begin SelfObjectIcon := TNBObjectIcon.Create(FActiveForm); SelfObjectIcon.Assign(SprObjectIcon); AddObjectIcon(SelfObjectIcon); end; end; FNewGUIDsObjectIcons.Clear; // Производители for i := 0 to FNewGUIDsProducers.Count - 1 do if GetProducerByGUID(FNewGUIDsProducers[i]) = nil then begin SprProducer := ASpravoshnick.GetProducerByGUID(FNewGUIDsProducers[i]); if SprProducer <> nil then begin SelfProducer := TNBProducer.Create(FActiveForm); SelfProducer.Assign(SprProducer); AddProducer(SelfProducer); end; end; FNewGUIDsProducers.Clear; // Ресурсы for i := 0 to FNewGUIDsResources.Count - 1 do if GetResourceByGUID(FNewGUIDsResources[i]) = nil then begin SprResource := ASpravoshnick.GetResourceByGUID(FNewGUIDsResources[i]); if SprResource <> nil then begin SelfResource := TNBResource.Create(FActiveForm); SelfResource.Assign(SprResource); AddResource(SelfResource); Currency := GetCurrencyByGUID(TF_Main(ASpravoshnick.FActiveForm).GCurrencyM.GUID); if Currency <> nil then SelfResource.Price := GetPriceAfterChangeCurrency(SelfResource.Price, Currency.Data, TF_Main(FActiveForm).GCurrencyM); end; end; FNewGUIDsResources.Clear; // Виды поставок for i := 0 to FNewGUIDsSuppliesKinds.Count - 1 do if GetSuppliesKindByGUID(FNewGUIDsSuppliesKinds[i]) = nil then begin SprSuppliesKind := ASpravoshnick.GetSuppliesKindByGUID(FNewGUIDsSuppliesKinds[i]); if SprSuppliesKind <> nil then begin SelfSuppliesKind := TNBSuppliesKind.Create(FActiveForm); SelfSuppliesKind.Assign(SprSuppliesKind); AddSuppliesKind(SelfSuppliesKind); end; end; FNewGUIDsSuppliesKinds.Clear; FreeAndNil(LookedGUIDsInterface); except on E: Exception do AddExceptionToLogEx('TSpravochnik.DefineDataFromOtherSpravByNewGUIDs', E.Message); end; end; procedure TSpravochnik.DefineNewGUIDsFromOtherSprav(ASpravoshnick: TSpravochnik); var i: Integer; SprComponentType: TNBComponentType; SprInterface: TNBInterface; SprNetType: TNBNetType; SprNorm: TNBNorm; SprObjectIcon: TNBObjectIcon; SprProducer: TNBProducer; SprPropert: TNBProperty; SprResource: TNBResource; SprSuppliesKind: TNBSuppliesKind; begin for i := 0 to ASpravoshnick.FNBComponentTypes.Count - 1 do AddStringToStringListOnce(FNewGUIDsComponentType, TNBComponentType(ASpravoshnick.FNBComponentTypes[i]).ComponentType.GUID); for i := 0 to ASpravoshnick.FNBInterfaces.Count - 1 do AddStringToStringListOnce(FNewGUIDsInterface, TNBInterface(ASpravoshnick.FNBInterfaces[i]).GUID); for i := 0 to ASpravoshnick.FNBNetTypes.Count - 1 do AddStringToStringListOnce(FNewGUIDsNetType, TNBNetType(ASpravoshnick.FNBNetTypes[i]).GUID); for i := 0 to ASpravoshnick.FNBNorms.Count - 1 do AddStringToStringListOnce(FNewGUIDsNorms, TNBNorm(ASpravoshnick.FNBNorms[i]).GUID); for i := 0 to ASpravoshnick.FNBObjectIcons.Count - 1 do AddStringToStringListOnce(FNewGUIDsObjectIcons, TNBObjectIcon(ASpravoshnick.FNBObjectIcons[i]).GUID); for i := 0 to ASpravoshnick.FNBProducers.Count - 1 do AddStringToStringListOnce(FNewGUIDsProducers, TNBProducer(ASpravoshnick.FNBProducers[i]).GUID); for i := 0 to ASpravoshnick.FNBProperties.Count - 1 do AddStringToStringListOnce(FNewGUIDsProperties, TNBProperty(ASpravoshnick.FNBProperties[i]).PropertyData.GUID); for i := 0 to ASpravoshnick.FNBResources.Count - 1 do AddStringToStringListOnce(FNewGUIDsResources, TNBResource(ASpravoshnick.FNBResources[i]).GUID); for i := 0 to ASpravoshnick.FNBSuppliesKinds.Count - 1 do AddStringToStringListOnce(FNewGUIDsSuppliesKinds,TNBSuppliesKind(ASpravoshnick.FNBSuppliesKinds[i]).Data.GUID); end; function TSpravochnik.GetComponentTypeByID(AID: Integer): TComponentType; var i: Integer; NBComponentType: TNBComponentType; begin ZeroMemory(@Result, SizeOf(TComponentType)); for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if NBComponentType.ComponentType.ID = AID then begin Result := NBComponentType.ComponentType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetComponentTypeBySysName(const ASysName: String): TComponentType; var i: Integer; NBComponentType: TNBComponentType; begin ZeroMemory(@Result, SizeOf(TComponentType)); for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if NBComponentType.ComponentType.SysName = ASysName then begin Result := NBComponentType.ComponentType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetComponentTypeByGUID(const AGUID: String): TNBComponentType; var i: Integer; NBComponentType: TNBComponentType; IndexInList: Integer; begin Result := nil; if AGUID <> '' then begin {for i := 0 to FNBComponentTypes.Count - 1 do begin //NBComponentType := TNBComponentType(FNBComponentTypes[i]); NBComponentType := TNBComponentType(FNBComponentTypes.FItems.List^[i]); if NBComponentType.ComponentType.GUID = AGUID then begin Result := NBComponentType; Break; ///// BREAK ///// end; end;} IndexInList := FComponentTypeGUIDs.IndexOf(AGUID); if IndexInList <> -1 then Result := TNBComponentType(FComponentTypeGUIDs.Objects[IndexInList]); end; end; function TSpravochnik.GetComponentTypeByName(const AName: String): TNBComponentType; var i: Integer; NBComponentType: TNBComponentType; NameUpper: String; begin Result := nil; NameUpper := AnsiUpperCase(AName); for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if AnsiUpperCase(NBComponentType.ComponentType.Name) = NameUpper then begin Result := NBComponentType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetComponentTypeObjByID(const AID: Integer): TNBComponentType; var i: Integer; NBComponentType: TNBComponentType; begin Result := nil; for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if NBComponentType.ComponentType.ID = AID then begin Result := NBComponentType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetComponentTypeObjBySysName(const ASysName: String): TNBComponentType; var i: Integer; NBComponentType: TNBComponentType; begin Result := nil; for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if NBComponentType.ComponentType.SysName = ASysName then begin Result := NBComponentType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetInterfaceByGUID(const AGUID: String): TNBInterface; var //NBInterface: TNBInterface; //i: Integer; IndexInList: Integer; begin Result := nil; //if AGUID <> '' then // for i := 0 to FNBInterfaces.Count - 1 do // begin // NBInterface := TNBInterface(FNBInterfaces[i]); // if NBInterface.GUID = AGUID then // begin // Result := NBInterface; // Break; ///// BREAK ///// // end; // end; Result := nil; if AGUID <> '' then begin IndexInList := FInterfaceGUIDs.IndexOf(AGUID); if IndexInList <> -1 then Result := TNBInterface(FInterfaceGUIDs.Objects[IndexInList]); end; end; function TSpravochnik.GetInterfaceByName(const AName: String): TNBInterface; var //dexInList: Integer; NBInterface: TNBInterface; i: Integer; begin Result := nil; if AName <> '' then for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); if NBInterface.Name = AName then begin Result := NBInterface; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetInterfaceNameByID(AID: Integer): String; var NBInterface: TNBInterface; begin Result := ''; NBInterface := GetInterfaceByID(AID); if Assigned(NBInterface) then Result := NBInterface.Name; end; function TSpravochnik.GetInterfaceWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik; AAssignInterfAccordance, AAssignInterfNorms: Boolean): TNBInterface; var SelfInterfaceIndex: Integer; SelfInterface: TNBInterface; NBInterfaceIndex: Integer; NBInterface: TNBInterface; i: Integer; SelfInterfAccordance: TNBInterfaceAccordance; SelfInterfNorm: TNBInterfaceNorm; NBInterfNorm: TNBInterfaceNorm; NBInterfAccordance: TNBInterfaceAccordance; begin Result := nil; SelfInterface := nil; SelfInterfaceIndex := FInterfaceGUIDs.IndexOf(AGUID); if SelfInterfaceIndex <> -1 then begin SelfInterface := TNBInterface(FNBInterfaces[SelfInterfaceIndex]); if (SelfInterface = nil) or (SelfInterface.GUID <> AGUID) then SelfInterface := GetInterfaceByGUID(AGUID); //*** Синхронизировать нормы if (AAssignInterfNorms or AAssignInterfAccordance) and (SelfInterface <> nil) then begin NBInterface := nil; NBInterfaceIndex := ANBSpavochnik.FInterfaceGUIDs.IndexOf(AGUID); if NBInterfaceIndex <> -1 then NBInterface := TNBInterface(ANBSpavochnik.FNBInterfaces[NBInterfaceIndex]); if (NBInterface = nil) or (NBInterface.GUID <> AGUID) then NBInterface := ANBSpavochnik.GetInterfaceByGUID(AGUID); if NBInterface <> nil then begin // Соответствия интерфейсов - в том случаи, если есть оба интерфейса в текущем справочнике if AAssignInterfAccordance then for i := 0 to NBInterface.FInterfaceAccordance.Count - 1 do begin NBInterfAccordance := TNBInterfaceAccordance(NBInterface.FInterfaceAccordance[i]); SelfInterfAccordance := SelfInterface.GetInterfAccordanceByGUIDAccordance(NBInterfAccordance.GUIDAccordance); if (SelfInterfAccordance = nil) {and (GetInterfaceByGUID(NBInterfAccordance.GUIDAccordance) <> nil)} then begin SelfInterfAccordance := TNBInterfaceAccordance.Create(SelfInterface.FActiveForm); SelfInterfAccordance.Assign(NBInterfAccordance); SelfInterface.AddInterfaceAccordance(SelfInterfAccordance); end; end; // Нормы интерфейсов if AAssignInterfNorms then for i := 0 to NBInterface.FInterfaceNorms.Count - 1 do begin NBInterfNorm := TNBInterfaceNorm(NBInterface.FInterfaceNorms[i]); SelfInterfNorm := SelfInterface.GetInterfNormByGUIDNB(NBInterfNorm.GuidNBNorm); if SelfInterfNorm = nil then begin SelfInterfNorm := TNBInterfaceNorm.Create(SelfInterface.FActiveForm); SelfInterfNorm.Assign(NBInterfNorm); SelfInterface.AddInterfaceNorm(SelfInterfNorm); end; end; end; end; end else begin NBInterface := ANBSpavochnik.GetInterfaceByGUID(AGUID); if NBInterface <> nil then begin SelfInterface := TNBInterface.Create(FActiveForm); SelfInterface.AssignOnlyInterface(NBInterface); //*** для нового интерфейса подгружать все данные SelfInterface.AssignInterfaceAccordance(NBInterface.FInterfaceAccordance); SelfInterface.AssignInterfaceNorms(NBInterface.FInterfaceNorms); AddInterface(SelfInterface); end; end; Result := SelfInterface; end; function TSpravochnik.GetInterfacesForAccordance(AInterf: TNBInterface): TSCSObjectList; var i: Integer; NBInterface: TNBInterface; begin Result := TSCSObjectList.Create(false); for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); if (NBInterface <> AInterf) and (NBInterface.GetInterfAccordanceByIDAccordance(AInterf.ID) <> nil) then Result.Add(NBInterface); end; end; function TSpravochnik.GetNBComponentTypeByID(AID: Integer): TNBCOmponentType; var i: Integer; CurrCompType: TNBComponentType; begin Result := nil; for i := 0 to FNBComponentTypes.Count - 1 do begin CurrCompType := TNBComponentType(FNBComponentTypes[i]); if CurrCompType.ComponentType.ID = AID then begin Result := CurrCompType; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetNetTypeByGUID(const AGUID: String): TNBNetType; var i: integer; CurrNetType: TNBNetType; begin Result := nil; if AGUID <> '' then for i := 0 to FNBNetTypes.Count - 1 do begin CurrNetType := TNBNetType(FNBNetTypes[i]); if CurrNetType.GUID = AGUID then begin Result := CurrNetType; Break; //*** Break end; end; end; function TSpravochnik.GetNetTypeByID(const AID: Integer): TNBNetType; var i: integer; CurrNetType: TNBNetType; begin Result := nil; for i := 0 to FNBNetTypes.Count - 1 do begin CurrNetType := TNBNetType(FNBNetTypes[i]); if CurrNetType.ID = AID then begin Result := CurrNetType; Break; //*** Break end; end; end; function TSpravochnik.GetNormByGUID(const AGUID: String): TNBNorm; begin Result := nil; if AGUID <> '' then case TF_Main(FActiveForm).GDBMode of bkNormBase: begin Result := GetNormByGUIDFromList(AGUID); if Result = nil then begin SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNBNorms, fnGUID+' = :'+fnGUID, nil, fnAll)); FQSelect.Params[0].AsString := AGUID; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then begin Result := TNBNorm.Create(FActiveForm); AddNorm(Result); Result.ID := FQSelect.FN(fnID).AsInteger; Result.GUID := FQSelect.FN(fnGuid).AsString; Result.Cypher := FQSelect.FN(fnCypher).AsString; Result.Name := FQSelect.FN(fnName).AsString; Result.Izm := FQSelect.FN(fnIzm).AsString; //25.10.2013 Result.LaborTime := FQSelect.FN(fnLaborTime).AsInteger; Result.PricePerTime := FQSelect.FN(fnPricePerTime).AsFloat; //Result.TimeUOM := FQSelect.FN(fnTimeUOM).AsInteger; Result.Price := FQSelect.FN(fnPrice).AsFloat; Result.GUIDESmeta := FQSelect.FN(fnGuidESmeta).AsString; end; FQSelect.Close; end; end; bkProjectManager: Result := GetNormByGUIDFromList(AGUID); end; end; function TSpravochnik.GetNormByGUIDFromList(const AGUID: String): TNBNorm; var i: Integer; Norm: TNBNorm; begin Result := nil; if AGUID <> '' then for i := 0 to FNBNorms.Count - 1 do begin Norm := TNBNorm(FNBNorms[i]); if Norm.GUID = AGUID then begin Result := Norm; Break; //// BREAK //// end; end; end; function TSpravochnik.GetObjectIconByGUID(const AGUID: String): TNBObjectIcon; begin Result := nil; if AGUID <> '' then case TF_Main(FActiveForm).GDBMode of bkNormBase: begin Result := GetObjectIconByGUIDFromList(AGUID); if Result = nil then begin SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnObjectIcons, fnGUID+' = :'+fnGUID, nil, fnAll)); FQSelect.Params[0].AsString := AGUID; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then begin Result := TNBObjectIcon.Create(FActiveForm); AddObjectIcon(Result); Result.ID := FQSelect.FN(fnID).AsInteger; Result.GUID := FQSelect.FN(fnGuid).AsString; Result.Name := FQSelect.FN(fnName).AsString; SaveToStreamFromQr(FQSelect, TStream(Result.FProjBlk), fnProjBlk, false); SaveToStreamFromQr(FQSelect, TStream(Result.FProjBmp), fnProjBmp, false); SaveToStreamFromQr(FQSelect, TStream(Result.FActiveBlk), fnActiveBlk, false); SaveToStreamFromQr(FQSelect, TStream(Result.FActiveBmp), fnActiveBmp, false); end; FQSelect.Close; end; end; bkProjectManager: Result := GetObjectIconByGUIDFromList(AGUID); end; end; function TSpravochnik.GetObjectIconByGUIDFromList(const AGUID: String): TNBObjectIcon; var i: Integer; ObjectIcon: TNBObjectIcon; begin Result := nil; if AGUID <> '' then for i := 0 to FNBObjectIcons.Count - 1 do begin ObjectIcon := TNBObjectIcon(FNBObjectIcons[i]); if ObjectIcon.GUID = AGUID then begin Result := ObjectIcon; Break; //// BREAK //// end; end; end; function TSpravochnik.GetObjectIconByNameFromList(const AName: String): TNBObjectIcon; var i: Integer; ObjectIcon: TNBObjectIcon; begin Result := nil; if AName <> '' then for i := 0 to FNBObjectIcons.Count - 1 do begin ObjectIcon := TNBObjectIcon(FNBObjectIcons[i]); if ObjectIcon.Name = AName then begin Result := ObjectIcon; Break; //// BREAK //// end; end; end; function TSpravochnik.GetObjectIconByIconType(const AGUID: String; AIconType, AIconExt: Integer): TMemoryStream; var ObjectIcon: TNBObjectIcon; begin Result := nil; ObjectIcon := GetObjectIconByGUID(AGUID); if ObjectIcon <> nil then begin Result := GetObjectIconByObject(ObjectIcon, AIconType, AIconExt); end; end; function TSpravochnik.GetObjectIconByObject(AObjectIcon: TNBObjectIcon; AIconType, AIconExt: Integer): TMemoryStream; begin Result := TMemoryStream.Create; case AIconType of oitProjectible: case AIconExt of ieBLK: CopyStream(Result, AObjectIcon.ProjBlk); ieBMP: CopyStream(Result, AObjectIcon.ProjBmp); end; oitActive: case AIconExt of ieBLK: CopyStream(Result, AObjectIcon.ActiveBlk); ieBMP: CopyStream(Result, AObjectIcon.ActiveBmp); end; end; end; function TSpravochnik.GetProducerByGUID(const AGUID: STring): TNBProducer; var i: Integer; CurrProducer: TNBProducer; begin Result := nil; if AGUID <> '' then for i := 0 to FNBProducers.Count - 1 do begin CurrProducer := TNBProducer(FNBProducers[i]); if CurrProducer.GUID = AGUID then begin Result := CurrProducer; Break; //*** Break end; end; end; function TSpravochnik.GetProducerByID(AID: Integer): TNBProducer; var i: Integer; CurrProducer: TNBProducer; begin Result := nil; for i := 0 to FNBProducers.Count - 1 do begin CurrProducer := TNBProducer(FNBProducers[i]); if CurrProducer.ID = AID then begin Result := CurrProducer; Break; //*** Break end; end; end; function TSpravochnik.GetPropertyByGUID(const AGUID: STring): TNBProperty; var //i: Integer; //CurrProperty: TNBProperty; IndexInList: Integer; begin {//12.03.2009 Result := nil; if AGUID <> '' then for i := 0 to FNBProperties.Count - 1 do begin CurrProperty := TNBProperty(FNBProperties[i]); if CurrProperty.PropertyData.GUID = AGUID then begin Result := CurrProperty; Break; //*** Break end; end;} Result := nil; IndexInList := FPropertyGUIDS.IndexOf(AGUID); if IndexInList <> -1 then Result := TNBProperty(FPropertyGUIDS.Objects[IndexInList]); end; function TSpravochnik.GetPropertyByID(AID: Integer): TNBProperty; var i: Integer; CurrProperty: TNBProperty; begin Result := nil; for i := 0 to FNBProperties.Count - 1 do begin CurrProperty := TNBProperty(FNBProperties[i]); if CurrProperty.PropertyData.ID = AID then begin Result := CurrProperty; Break; //*** Break end; end; end; function TSpravochnik.GetPropertyByName(const AName: String): TNBProperty; var i: Integer; NBProperty: TNBProperty; NameUpper: String; begin Result := nil; NameUpper := AnsiUpperCase(AName); for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); if AnsiUpperCase(NBProperty.PropertyData.Name) = NameUpper then begin Result := NBProperty; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetPropertyBySysName(const ASysName: String): TNBProperty; var i: Integer; NBProperty: TNBProperty; begin Result := nil; for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); if NBProperty.PropertyData.SysName = ASysName then begin Result := NBProperty; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetComponentTypeWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik): TNBComponentType; var i, CompTypeIndex: Integer; NBComponentType, SelfComponentType: TNBComponentType; RoomHeight: Double; begin Result := nil; SelfComponentType := nil; CompTypeIndex := FComponentTypeGUIDs.IndexOf(AGUID); if CompTypeIndex <> -1 then begin //SelfComponentType := TNBComponentType(FNBComponentTypes[CompTypeIndex]); SelfComponentType := TNBComponentType(FComponentTypeGUIDs.Objects[CompTypeIndex]); if (SelfComponentType = nil) or (SelfComponentType.ComponentType.GUID <> AGUID) then SelfComponentType := GetComponentTypeByGUID(AGUID); end else begin NBComponentType := ANBSpavochnik.GetComponentTypeByGUID(AGUID); if NBComponentType <> nil then begin SelfComponentType := TNBComponentType.Create(FActiveForm); SelfComponentType.Assign(NBComponentType); AddComponentType(SelfComponentType); // Свойства для типа тоже должны попасть в справочник for i := 0 to SelfComponentType.FProperties.Count - 1 do GetPropertyWithAssign(TNBCompTypeProperty(SelfComponentType.FProperties[i]).PropertyData.GUIDProperty, ANBSpavochnik); end; end; //*** Высота не должна превышать высоту этажа RoomHeight := -1; if FOwnerObject <> nil then begin if FOwnerObject is TSCSList then RoomHeight := TSCSList(FOwnerObject).Setting.HeightRoom; if FOwnerObject is TSCSProject then RoomHeight := TSCSProject(FOwnerObject).DefListSettings.HeightRoom; end; if (RoomHeight > 0) and (SelfComponentType <> nil) then if (SelfComponentType.ComponentType.CoordZ <> -1) and (SelfComponentType.ComponentType.CoordZ > RoomHeight) then SelfComponentType.ComponentType.CoordZ := RoomHeight; Result := SelfComponentType; end; function TSpravochnik.GetCurrencyByID(const AID: Integer): TNBCurrency; var i: Integer; CurrCurrency: TNBCurrency; begin Result := nil; for i := 0 to FNBCurrencies.Count - 1 do begin CurrCurrency := TNBCurrency(FNBCurrencies[i]); if CurrCurrency.Data.ID = AID then begin Result := CurrCurrency; Break; //// BREAK //// end; end; end; function TSpravochnik.GetCurrencyCountry: TNBCurrency; var i: Integer; CurrCurrency: TNBCurrency; begin Result := nil; for i := 0 to FNBCurrencies.Count - 1 do begin CurrCurrency := TNBCurrency(FNBCurrencies[i]); if CurrCurrency.Data.IsCountry = biTrue then begin Result := CurrCurrency; Break; //// BREAK //// end; end; end; function TSpravochnik.GetCurrencyByGUID(const AGUID: string): TNBCurrency; var i: Integer; CurrCurrency: TNBCurrency; begin Result := nil; if AGUID <> '' then for i := 0 to FNBCurrencies.Count - 1 do begin CurrCurrency := TNBCurrency(FNBCurrencies[i]); if CurrCurrency.Data.GUID = AGUID then begin Result := CurrCurrency; Break; //// BREAK //// end; end; end; function TSpravochnik.GetCurrencyBySavedType(const AType: Integer): TNBCurrency; var i: Integer; CurrCurrency: TNBCurrency; begin Result := nil; for i := 0 to FNBCurrencies.Count - 1 do begin CurrCurrency := TNBCurrency(FNBCurrencies[i]); if CurrCurrency.SavedMain = AType then begin Result := CurrCurrency; Break; //// BREAK //// end; end; end; function TSpravochnik.GetCurrencyByType(const AType: Integer): TNBCurrency; var i: Integer; CurrCurrency: TNBCurrency; begin Result := nil; for i := 0 to FNBCurrencies.Count - 1 do begin CurrCurrency := TNBCurrency(FNBCurrencies[i]); if CurrCurrency.Data.Main = AType then begin Result := CurrCurrency; Break; //// BREAK //// end; end; end; function TSpravochnik.GetCurrencyDataByGUID(const AGUID: string): TCurrency; var SprCurrency: TNBCurrency; begin ZeroMemory(@Result, SizeOf(TCurrency)); SprCurrency := GetCurrencyByGUID(AGUID); if SprCurrency <> nil then Result := SprCurrency.Data; end; function TSpravochnik.GetCurrencyWithAssign(ANBCurrency: TNBCurrency; ANBSpavochnik: TSpravochnik): TNBCurrency; var SelfCurrency, SelfCurrencyM, NBCurrencyM, NBCurrencyFromSelfM: TNBCurrency; begin Result := nil; SelfCurrency := GetCurrencyByGUID(ANBCurrency.Data.GUID); if SelfCurrency = nil then begin SelfCurrency := TNBCurrency.Create(FActiveForm); SelfCurrency.Assign(ANBCurrency); SelfCurrency.Data.Main := ctSimple; AddCurrency(SelfCurrency); //*** Найти главную валюту со справочника SelfCurrencyM := GetCurrencyByType(ctMain); if SelfCurrencyM <> nil then begin //*** Найти главную валюту с НБ справочника NBCurrencyM := ANBSpavochnik.GetCurrencyByType(ctMain); //*** Найти с НБ справочника валюту, такуюю самую как SelfCurrencyM NBCurrencyFromSelfM := ANBSpavochnik.GetCurrencyByGUID(SelfCurrencyM.Data.GUID); if (NBCurrencyFromSelfM <> nil) and (NBCurrencyM <> nil) then begin if NBCurrencyM.Data.GUID <> NBCurrencyFromSelfM.Data.GUID then SelfCurrency.Data.Ratio := GetPriceAfterChangeCurrency(SelfCurrency.Data.Ratio, NBCurrencyM.Data, NBCurrencyFromSelfM.Data, valEpsilonCurrency); end; end; end; Result := SelfCurrency; end; function TSpravochnik.GetInterfaceByID(AID: Integer): TNBInterface; var NBInterface: TNBInterface; i: Integer; begin Result := nil; {for i := 0 to FNBInterfaces.Count - 1 do begin //NBInterface := TNBInterface(FNBInterfaces[i]); NBInterface := TNBInterface(FNBInterfaces.List.List^[i]); if NBInterface.ID = AID then begin Result := NBInterface; Break; ///// BREAK ///// end; end;} Result := TNBInterface(FInterfaceIDs.GetObject(AID)); end; function TSpravochnik.GetPropertyDataByID(AID: Integer): TPropertyData; var i: Integer; NBProperty: TNBProperty; begin ZeroMemory(@Result, SizeOf(TPropertyData)); for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); if NBProperty.PropertyData.ID = AID then begin Result := NBProperty.PropertyData; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetPropertyDataBySysName(const ASysName: String): TPropertyData; var i: Integer; NBProperty: TNBProperty; begin ZeroMemory(@Result, SizeOf(TPropertyData)); for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); if NBProperty.PropertyData.SysName = ASysName then begin Result := NBProperty.PropertyData; Break; ///// BREAK ///// end; end; end; function TSpravochnik.GetPropertyWithAssign(const AGUID: String; ANBSpavochnik: TSpravochnik): TNBProperty; var SelfProp: TNBProperty; NBProp: TNBProperty; begin Result := nil; SelfProp := GetPropertyByGUID(AGUID); if SelfProp = nil then begin NBProp := ANBSpavochnik.GetPropertyByGUID(AGUID); if NBProp <> nil then begin SelfProp := TNBProperty.Create(FActiveForm); SelfProp.Assign(NBProp); AddProperty(SelfProp); end; end; Result := SelfProp; end; function TSpravochnik.GetResourceByGUID(const AGUID: String): TNBResource; begin Result := nil; if AGUID <> '' then case TF_Main(FActiveForm).GDBMode of bkNormBase: begin Result := GetResourceByGUIDFromList(AGUID); if Result = nil then begin SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNBResources, fnGUID+' = :'+fnGUID, nil, fnAll)); FQSelect.Params[0].AsString := AGUID; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then begin Result := TNBResource.Create(FActiveForm); AddResource(Result); Result.ID := FQSelect.FN(fnID).AsInteger; Result.GUID := FQSelect.FN(fnGuid).AsString; Result.Cypher := FQSelect.FN(fnCypher).AsString; Result.Name := FQSelect.FN(fnName).AsString; Result.Izm := FQSelect.FN(fnIzm).AsString; Result.Price := FQSelect.FN(fnPrice).AsDouble; Result.RType := FQSelect.FN(fnRType).AsInteger; end; FQSelect.Close; end; end; bkProjectManager: Result := GetResourceByGUIDFromList(AGUID); end; end; function TSpravochnik.GetResourceByGUIDFromList(const AGUID: String): TNBResource; var i: Integer; CurrResource: TNBResource; begin Result := nil; if AGUID <> '' then for i := 0 to FNBResources.Count - 1 do begin CurrResource := TNBResource(FNBResources[i]); if CurrResource.GUID = AGUID then begin Result := CurrResource; Break; //// BREAK //// end; end; end; function TSpravochnik.GetSuppliesKindByGUID(const AGUID: String): TNBSuppliesKind; var i: Integer; CurrSuppliesKind: TNBSuppliesKind; begin Result := nil; if AGUID <> '' then for i := 0 to FNBSuppliesKinds.Count - 1 do begin CurrSuppliesKind := TNBSuppliesKind(FNBSuppliesKinds[i]); if CurrSuppliesKind.Data.GUID = AGUID then begin Result := CurrSuppliesKind; Break; //// BREAK //// end; end; end; function TSpravochnik.GetSuppliesKindByID(AID: Integer): TNBSuppliesKind; var i: Integer; CurrSuppliesKind: TNBSuppliesKind; begin Result := nil; if AID <> 0 then for i := 0 to FNBSuppliesKinds.Count - 1 do begin CurrSuppliesKind := TNBSuppliesKind(FNBSuppliesKinds[i]); if CurrSuppliesKind.Data.ID = AID then begin Result := CurrSuppliesKind; Break; //// BREAK //// end; end; end; procedure TSpravochnik.LoadFromNB; var // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin try if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin OldTick := GetTickCount; Clear; LoadCurrencies; LoadComponentTypes; LoadInterfaces; LoadNetTypes; LoadProducers; LoadProperties; LoadSuppliesKinds; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; except on E: Exception do AddExceptionToLogEx('TSpravochnik.LoadFromNB', E.Message); end; end; procedure TSpravochnik.LoadCurrencies; var NBCurrency: TNBCurrency; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin FNBCurrencies.Clear; //Tolik FQSelect.close; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnCurrency, '', nil, fnAll)); FQSelect.Prepare; FQSelect.ExecQuery; // while Not FQSelect.Eof do begin NBCurrency := TNBCurrency.Create(FActiveForm); NBCurrency.Data := GetCurrencyFromQuery(FQSelect); AddCurrency(NBCurrency); FQSelect.Next; end; end; end; procedure TSpravochnik.LoadCurrenciesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; NBCurrency: TNBCurrency; begin AStrings.Clear; for i := 0 to FNBCurrencies.Count - 1 do begin NBCurrency := TNBCurrency(FNBCurrencies[i]); AddGUIDIDToStrings(NBCurrency.Data.Name, NBCurrency.Data.GUID, NBCurrency.Data.ID, AStrings); end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadComponentTypes; var NBComponentType: TNBComponentType; NBCompTypeProperty: TNBCompTypeProperty; CacheGUIDs: TIDStringList; i, j: Integer; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin CacheGUIDs := TIDStringList.Create; ClearComponentTypes; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnComponentTypes, '', nil, fnAll)); while Not FQSelect.Eof do begin NBComponentType := TNBComponentType.Create(FActiveForm); NBComponentType.ComponentType := GetComponentTypeFromQuery(FQSelect); AddComponentType(NBComponentType); FQSelect.Next; end; //*** Подгрузить GUIDObjectIcon SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnObjectIcons, fnID+' = :'+fnID, nil, fnGUID)); CacheGUIDs.Clear; for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); if NBComponentType.ComponentType.IDDesignIcon <> 0 then begin NBComponentType.ComponentType.GUIDDesignIcon := CacheGUIDs.GetStringByID(NBComponentType.ComponentType.IDDesignIcon); if NBComponentType.ComponentType.GUIDDesignIcon = '' then begin FQSelect.Close; FQSelect.Params[0].AsInteger := NBComponentType.ComponentType.IDDesignIcon; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBComponentType.ComponentType.GUIDDesignIcon := FQSelect.Fields[0].AsString; //FQSelect.FN(fnGUID).AsString; if NBComponentType.ComponentType.GUIDDesignIcon <> '' then CacheGUIDs.Add(NBComponentType.ComponentType.IDDesignIcon, NBComponentType.ComponentType.GUIDDesignIcon); end; end; end; //*** Загрузить свойства типов компонент SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnCompTypePropRelation, fnIDComponentType+' = :'+fnIDComponentType, nil, fnAll)); for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); FQSelect.Close; FQSelect.ParamByName(fnIDComponentType).AsInteger := NBComponentType.ComponentType.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin NBCompTypeProperty := TNBCompTypeProperty.Create(FActiveForm); if FQSelect.FN(fnIDProperty).AsInteger > 0 then begin //NBCompTypeProperty.PropertyData := get NBCompTypeProperty.GuidComponentType := NBComponentType.ComponentType.GUID; NBCompTypeProperty.PropertyData.ID := FQSelect.FN(fnID).AsInteger; NBCompTypeProperty.PropertyData.Guid := FQSelect.FN(fnGUID).AsString; NBCompTypeProperty.PropertyData.IDMaster := FQSelect.FN(fnIDComponentType).AsInteger; NBCompTypeProperty.PropertyData.ID_Property := FQSelect.FN(fnIDProperty).AsInteger; NBCompTypeProperty.PropertyData.Value := FQSelect.FN(fnPValue).AsString; NBCompTypeProperty.PropertyData.IsDefault := FQSelect.FN(fnisStandart).AsInteger; NBCompTypeProperty.PropertyData.GUIDProperty := ''; //TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, Propert.ID_Property, qmPhisical); NBCompTypeProperty.PropertyData.TakeIntoConnect := FQSelect.FN(fnTakeIntoConnect).AsInteger; NBCompTypeProperty.PropertyData.TakeIntoJoin := FQSelect.FN(fnTakeIntoJoin).AsInteger; //NBCompTypeProperty.PropertyData.IsTakeJoinforPoint := FQSelect.FN(fnIsTakeJoinForPoints).AsInteger; //NBCompTypeProperty.PropertyData.IsCrossControl := FQSelect.FN(fnIsCrossControl).AsInteger; //NBCompTypeProperty.PropertyData.IDCrossProperty := FQSelect.FN(fnIDCrossProperty).AsInteger; //NBCompTypeProperty.PropertyData.GUIDCrossProperty := TF_Main(ActiveForm).DM.GetStringFromTableByID(tnProperties, fnGuid, NBCompTypeProperty.PropertyData.IDCrossProperty, qmPhisical); NBCompTypeProperty.PropertyData.IsNew := false; NBCompTypeProperty.PropertyData.IsModified := false; NBComponentType.AddProperty(NBCompTypeProperty); end; FQSelect.Next; end; end; //*** Найти GUID-ы пропертей нормативной базы SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnProperties, fnID+' = :'+fnID, nil, fnGuid)); CacheGUIDs.Clear; for i := 0 to FNBComponentTypes.Count - 1 do begin NBComponentType := TNBComponentType(FNBComponentTypes[i]); for j := 0 to NBComponentType.FProperties.Count - 1 do begin NBCompTypeProperty := TNBCompTypeProperty(NBComponentType.FProperties[j]); NBCompTypeProperty.PropertyData.GUIDProperty := CacheGUIDs.GetStringByID(NBCompTypeProperty.PropertyData.ID_Property); if NBCompTypeProperty.PropertyData.GUIDProperty = '' then begin FQSelect.Close; //FQSelect.ParamByName(fnID).AsInteger := NBCompTypeProperty.PropertyData.ID_Property; FQSelect.Params[0].AsInteger := NBCompTypeProperty.PropertyData.ID_Property; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBCompTypeProperty.PropertyData.GUIDProperty := FQSelect.Fields[0].AsString; //FQSelect.FN(fnGuid).AsString; if NBCompTypeProperty.PropertyData.GUIDProperty <> '' then CacheGUIDs.Add(NBCompTypeProperty.PropertyData.ID_Property, NBCompTypeProperty.PropertyData.GUIDProperty); end; end; end; // FOR FreeAndNil(CacheGUIDs); end; end; procedure TSpravochnik.LoadComponentTypesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; ComponentType: TNBComponentType; begin AStrings.Clear; for i := 0 to FNBComponentTypes.Count - 1 do begin ComponentType := TNBComponentType(FNBComponentTypes[i]); AddGUIDIDToStrings(ComponentType.ComponentType.Name, ComponentType.ComponentType.GUID, ComponentType.ComponentType.ID, AStrings); end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadInterfaces; var i, j: Integer; NBInterface: TNBInterface; NBInterfAccord: TNBInterface; NBInterfaceNorm: TNBInterfaceNorm; NBInterfaceACcordance: TNBInterfaceACcordance; CacheGUIDs: TIDStringList; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin CacheGUIDs := TIDStringList.Create; ClearInterfaces; //*** Загрузить интерфейсы в чистом виде SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnInterface, '', nil, fnAll)); while Not FQSelect.Eof do begin NBInterface := TNBInterface.Create(FActiveForm); NBInterface.ID := FQSelect.FN(fnID).AsInteger; NBInterface.GUID := FQSelect.FN(fnGUID).AsString; NBInterface.Name := FQSelect.FN(fnName).AsString; NBInterface.IDNetType := FQSelect.FN(fnIDNetType).AsInteger; NBInterface.SortID := FQSelect.FN(fnSortID).AsInteger; NBInterface.ConstructiveWidth := FQSelect.FN(fnConstructiveWidth).AsFloat; NBInterface.Description := FQSelect.FN(fnDescription).AsString; NBInterface.IsVisible := FQSelect.FN(fnIsVisible).AsInteger; NBInterface.IsUniversal := FQSelect.FN(fnIsUniversal).AsInteger; AddInterface(NBInterface); FQSelect.Next; end; //*** найти GUIDы для IDNetType SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNetType, fnID+' = :'+fnID, nil, fnGuid), false); CacheGUIDs.Clear; for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); NBInterface.GuidNetType := CacheGUIDs.GetStringByID(NBInterface.IDNetType); if NBInterface.GuidNetType = '' then begin FQSelect.Close; FQSelect.Params[0].AsInteger := NBInterface.IDNetType; //FQSelect.SetParamAsInteger(fnID, NBInterface.IDNetType); FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBInterface.GuidNetType := FQSelect.Fields[0].AsString; //FQuery_Select.GetFNAsString(fnGuid); if NBInterface.GuidNetType <> '' then CacheGUIDs.Add(NBInterface.IDNetType, NBInterface.GUIDNetType); end; end; //*** Загрузить нормы интерфейсов SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnInterfaceNorms, fnIDInterface+' = :'+fnIDInterface, nil, fnAll), false); for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); FQSelect.Close; FQSelect.ParamByName(fnIDInterface).AsInteger := NBInterface.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin if FQSelect.FN(fnIDNBNorm).AsInteger > 0 then begin NBInterfaceNorm := TNBInterfaceNorm.Create(FActiveForm); NBInterfaceNorm.ID := FQSelect.FN(fnID).AsInteger; NBInterfaceNorm.GUID := FQSelect.FN(fnGUID).AsString; NBInterfaceNorm.GuidInterface := NBInterface.GUID; NBInterfaceNorm.IDInterface := FQSelect.FN(fnIDInterface).AsInteger; NBInterfaceNorm.GuidNBNorm := ''; NBInterfaceNorm.IDNBNorm := FQSelect.FN(fnIDNBNorm).AsInteger; NBInterfaceNorm.Expense := FQSelect.FN(fnExpense).AsDouble; NBInterfaceNorm.IDComponentType := FQSelect.FN(fnIDComponentType).AsInteger; NBInterfaceNorm.InterfaceIsBusy := FQSelect.FN(fnInterfaceIsBusy).AsInteger; NBInterfaceNorm.KoefLengthForCompl := FQSelect.FN(fnKoefLengthForCompl).AsDouble; NBInterface.AddInterfaceNorm(NBInterfaceNorm); end; FQSelect.Next; end; end; //*** найти GUIDы для GuidNBNorm SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNBNorms, fnID+' = :'+fnID, nil, fnGUID), false); CacheGUIDs.Clear; for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); for j := 0 to NBInterface.FInterfaceNorms.Count - 1 do begin NBInterfaceNorm := TNBInterfaceNorm(NBInterface.FInterfaceNorms[j]); NBInterfaceNorm.GuidNBNorm := CacheGUIDs.GetStringByID(NBInterfaceNorm.IDNBNorm); if NBInterfaceNorm.GuidNBNorm = '' then begin FQSelect.Close; //FQSelect.ParamByName(fnID).AsInteger := NBInterfaceNorm.IDNBNorm; FQSelect.Params[0].AsInteger := NBInterfaceNorm.IDNBNorm; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBInterfaceNorm.GuidNBNorm := FQSelect.Fields[0].AsString; //FQSelect.FN(fnGUID).AsString; if NBInterfaceNorm.GuidNBNorm <> '' then CacheGUIDs.Add(NBInterfaceNorm.IDNBNorm, NBInterfaceNorm.GuidNBNorm); end; end; end; //*** найти GUIDы для GuidComponentType SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnComponentTypes, fnID+' = :'+fnID, nil, fnGUID), false); CacheGUIDs.Clear; for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); for j := 0 to NBInterface.FInterfaceNorms.Count - 1 do begin NBInterfaceNorm := TNBInterfaceNorm(NBInterface.FInterfaceNorms[j]); if NBInterfaceNorm.IDComponentType > 0 then begin NBInterfaceNorm.GUIDComponentType := CacheGUIDs.GetStringByID(NBInterfaceNorm.IDComponentType); if NBInterfaceNorm.GUIDComponentType = '' then begin FQSelect.Close; //FQSelect.ParamByName(fnID).AsInteger := NBInterfaceNorm.IDComponentType; FQSelect.Params[0].AsInteger := NBInterfaceNorm.IDComponentType; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBInterfaceNorm.GUIDComponentType := FQSelect.Fields[0].AsString; //FQSelect.FN(fnGUID).AsString; if NBInterfaceNorm.GUIDComponentType <> '' then CacheGUIDs.Add(NBInterfaceNorm.IDComponentType, NBInterfaceNorm.GUIDComponentType); end; end; end; end; //*** Загрузить соответствующие интерфейсы SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnInterfaceAccordance, fnIDInterface+' = :'+fnIDInterface, nil, fnAll), false); for i := 0 to FNBInterfaces.Count - 1 do begin NBInterface := TNBInterface(FNBInterfaces[i]); FQSelect.Close; FQSelect.ParamByName(fnIDInterface).AsInteger := NBInterface.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin NBInterfaceACcordance := TNBInterfaceACcordance.Create(FActiveForm); NBInterfaceACcordance.ID := FQSelect.FN(fnID).AsInteger; NBInterfaceACcordance.GUID := FQSelect.FN(fnGUID).AsString; NBInterfaceACcordance.GUIDInterface := NBInterface.GUID; NBInterfaceACcordance.IDInterface := FQSelect.FN(fnIDInterface).AsInteger; NBInterfaceACcordance.InterfComponIsLine := FQSelect.FN(fnInterfComponIsLine).AsInteger; NBInterfaceACcordance.IDAccordance := FQSelect.FN(fnIDAccordance).AsInteger; NBInterfaceACcordance.AccordComponIsLine := FQSelect.FN(fnAccordComponIsLine).AsInteger; NBInterfaceACcordance.Kolvo := FQSelect.FN(fnKolvo).AsInteger; NBInterface.AddInterfaceAccordance(NBInterfaceACcordance); //*** GUID соответсвующего интерфейса NBInterfAccord := GetInterfaceByID(NBInterfaceACcordance.IDAccordance); if NBInterfAccord <> nil then NBInterfaceACcordance.GUIDAccordance := NBInterfAccord.GUID; FQSelect.Next; end; end; //*** Загрузить GUID FreeAndNil(CacheGUIDs); end; end; procedure TSpravochnik.LoadInterfacesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; Interf: TNBInterface; begin AStrings.Clear; for i := 0 to FNBInterfaces.Count - 1 do begin Interf := TNBInterface(FNBInterfaces[i]); AddGUIDIDToStrings(Interf.Name, Interf.GUID, Interf.ID, AStrings); end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadNetTypes; var NBNetType: TNBNetType; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin FNBNetTypes.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNetType, '', nil, fnAll)); while Not FQSelect.Eof do begin NBNetType := TNBNetType.Create(FActiveForm); NBNetType.ID := FQSelect.FN(fnID).AsInteger; NBNetType.GUID := FQSelect.FN(fnGuid).AsString; NBNetType.Name := FQSelect.FN(fnName).AsString; AddNetType(NBNetType); FQSelect.Next; end; end; end; procedure TSpravochnik.LoadNetTypesToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; NetType: TNBNetType; begin AStrings.Clear; for i := 0 to FNBNetTypes.Count - 1 do begin NetType := TNBNetType(FNBNetTypes[i]); AddGUIDIDToStrings(NetType.Name, NetType.GUID, NetType.ID, AStrings); end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadProducers; var NBProducer: TNBProducer; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin FNBProducers.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnProducers, '', nil, fnAll)); while Not FQSelect.Eof do begin NBProducer := TNBProducer.Create(FActiveForm); NBProducer.ID := FQSelect.FN(fnID).AsInteger; NBProducer.GUID := FQSelect.FN(fnGuid).AsString; NBProducer.Name := FQSelect.FN(fnName).AsString; NBProducer.Description := FQSelect.FN(fnDescription).AsString; AddProducer(NBProducer); FQSelect.Next; end; end; end; procedure TSpravochnik.LoadProducersToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; Producer: TNBProducer; begin AStrings.Clear; for i := 0 to FNBProducers.Count - 1 do begin Producer := TNBProducer(FNBProducers[i]); AddGUIDIDToStrings(Producer.Name, Producer.GUID, Producer.ID, AStrings); end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadProperties; var NBProperty: TNBProperty; i, j: Integer; NBPropValRel: TNBPropValRel; NBPropValNormRes: TNBPropValNormRes; PropValNormResList: TList; CacheGUIDs: TIDStringList; IsFindGUIDNBComponent, IsFindGUIDNBRes, IsFindGUIDNBNorm: Boolean; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin ClearProperties; //12.03.2009 FNBProperties.Clear; PropValNormResList := TList.Create; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnProperties, '', nil, fnAll)); while Not FQSelect.Eof do begin NBProperty := TNBProperty.Create(FActiveForm); NBProperty.PropertyData := GetPropertyDataFromQuery(FQSelect); AddProperty(NBProperty); FQSelect.Next; end; // Подгружаем все связи значений свойств со свойствами SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnPropValRel, fnIDProperty+' = :'+fnIDProperty, nil, fnAll), false); for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); FQSelect.Close; FQSelect.Params[0].AsInteger := NBProperty.PropertyData.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin NBPropValRel := TNBPropValRel.Create(FActiveForm); NBPropValRel.GuidProperty := NBProperty.PropertyData.GUID; NBPropValRel.ID := FQSelect.FN(fnID).AsInteger; NBPropValRel.GUID := FQSelect.FN(fnGUID).AsString; NBPropValRel.IDProperty := FQSelect.FN(fnIDProperty).AsInteger; NBPropValRel.PValue := FQSelect.FN(fnPValue).AsString; NBPropValRel.MinValue := FQSelect.FN(fnMinValue).AsString; NBPropValRel.MaxValue := FQSelect.FN(fnMaxValue).AsString; NBProperty.AddPropValRel(NBPropValRel); FQSelect.Next; end; end; IsFindGUIDNBComponent := false; IsFindGUIDNBRes := false; IsFindGUIDNBNorm := false; // Подгружаем все связи значений свойств с аксессуарами SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnPropValNormRes, fnIDPropValRel+' = :'+fnIDPropValRel, nil, fnAll), false); for i := 0 to FNBProperties.Count - 1 do begin NBProperty := TNBProperty(FNBProperties[i]); for j := 0 to NBProperty.FPropValRelList.Count - 1 do begin NBPropValRel := TNBPropValRel(NBProperty.FPropValRelList[j]); FQSelect.Close; FQSelect.Params[0].AsInteger := NBPropValRel.ID; FQSelect.ExecQuery; while Not FQSelect.Eof do begin NBPropValNormRes := TNBPropValNormRes.Create(FActiveForm); NBPropValNormRes.GuidPropValRel := NBPropValRel.GUID; NBPropValNormRes.ID := FQSelect.FN(fnID).AsInteger; NBPropValNormRes.GUID := FQSelect.FN(fnGUID).AsString; NBPropValNormRes.IDPropValRel := FQSelect.FN(fnIDPropValRel).AsInteger; NBPropValNormRes.IDNBComponent := FQSelect.FN(fnIDNBComponent).AsInteger; NBPropValNormRes.IDNBRes := FQSelect.FN(fnIDNBRES).AsInteger; NBPropValNormRes.IDNBNorm := FQSelect.FN(fnIDNBNorm).AsInteger; NBPropValNormRes.Kolvo := FQSelect.FN(fnKolvo).AsFloat; NBPropValNormRes.ExpenseForLength := FQSelect.FN(fnExpenseForLength).AsFloat; NBPropValNormRes.CountForPoint := FQSelect.FN(fnCountForPoint).AsFloat; NBPropValNormRes.StepOfPoint := FQSelect.FN(fnStepOfPoint).AsFloat; NBPropValRel.AddPropValNormRes(NBPropValNormRes); PropValNormResList.Add(NBPropValNormRes); if NBPropValNormRes.IDNBComponent <> 0 then IsFindGUIDNBComponent := true; if NBPropValNormRes.IDNBRes <> 0 then IsFindGUIDNBRes := true; if NBPropValNormRes.IDNBNorm <> 0 then IsFindGUIDNBNorm := true; FQSelect.Next; end; end; end; if IsFindGUIDNBComponent or IsFindGUIDNBRes or IsFindGUIDNBNorm then begin CacheGUIDs := TIDStringList.Create; if IsFindGUIDNBComponent then begin CacheGUIDs.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnComponent, fnID+' = :'+fnID, nil, fnGUID), false); for i := 0 to PropValNormResList.Count - 1 do begin NBPropValNormRes := TNBPropValNormRes(PropValNormResList[i]); NBPropValNormRes.GuidNBComponent := CacheGUIDs.GetStringByID(NBPropValNormRes.IDNBComponent); if NBPropValNormRes.GuidNBComponent = '' then begin FQSelect.Close; FQSelect.Params[0].AsInteger := NBPropValNormRes.IDNBComponent; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBPropValNormRes.GuidNBComponent := FQSelect.Fields[0].AsString; if NBPropValNormRes.GuidNBComponent <> '' then CacheGUIDs.Add(NBPropValNormRes.IDNBComponent, NBPropValNormRes.GuidNBComponent); end; end; end; if IsFindGUIDNBRes then begin CacheGUIDs.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNBResources, fnID+' = :'+fnID, nil, fnGUID), false); for i := 0 to PropValNormResList.Count - 1 do begin NBPropValNormRes := TNBPropValNormRes(PropValNormResList[i]); NBPropValNormRes.GuidNBRes := CacheGUIDs.GetStringByID(NBPropValNormRes.IDNBRes); if NBPropValNormRes.GuidNBRes = '' then begin FQSelect.Close; FQSelect.Params[0].AsInteger := NBPropValNormRes.IDNBRes; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBPropValNormRes.GuidNBRes := FQSelect.Fields[0].AsString; if NBPropValNormRes.GuidNBRes <> '' then CacheGUIDs.Add(NBPropValNormRes.IDNBRes, NBPropValNormRes.GuidNBRes); end; end; end; if IsFindGUIDNBNorm then begin CacheGUIDs.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnNBNorms, fnID+' = :'+fnID, nil, fnGUID), false); for i := 0 to PropValNormResList.Count - 1 do begin NBPropValNormRes := TNBPropValNormRes(PropValNormResList[i]); NBPropValNormRes.GuidNBNorm := CacheGUIDs.GetStringByID(NBPropValNormRes.IDNBNorm); if NBPropValNormRes.GuidNBNorm = '' then begin FQSelect.Close; FQSelect.Params[0].AsInteger := NBPropValNormRes.IDNBNorm; FQSelect.ExecQuery; if FQSelect.RecordCount > 0 then NBPropValNormRes.GuidNBNorm := FQSelect.Fields[0].AsString; if NBPropValNormRes.GuidNBNorm <> '' then CacheGUIDs.Add(NBPropValNormRes.IDNBNorm, NBPropValNormRes.GuidNBNorm); end; end; end; FreeAndNil(CacheGUIDs); end; PropValNormResList.Free; end; end; procedure TSpravochnik.LoadPropertiesToStrings(AStrings: TStrings; AFirstEmpty: Boolean; ASort: Boolean=true); var i: integer; Propert: TNBProperty; begin AStrings.Clear; for i := 0 to FNBProperties.Count - 1 do begin Propert := TNBProperty(FNBProperties[i]); AddGUIDIDToStrings(Propert.PropertyData.Name, Propert.PropertyData.GUID, Propert.PropertyData.ID, AStrings); end; if ASort then SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.LoadSuppliesKinds; var NBSuppliesKind: TNBSuppliesKind; begin if (TF_Main(FActiveForm).GDBMode = bkNormBase) and (TF_Main(FActiveForm).GFormMode = fmNormal) then begin FNBSuppliesKinds.Clear; SetSQLToFIBQuery(FQSelect, GetSQLByParams(qtSelect, tnSuppliesKinds, '', nil, fnAll)); while Not FQSelect.Eof do begin NBSuppliesKind := TNBSuppliesKind.Create(FActiveForm); NBSuppliesKind.Data := GetSuppliesKindFromQuery(FQSelect); AddSuppliesKind(NBSuppliesKind); FQSelect.Next; end; end; end; procedure TSpravochnik.LoadSuppliesKindsToStrings(AStrings: TStrings; AFirstEmpty: Boolean); var i: integer; SuppliesKind: TNBSuppliesKind; begin AStrings.Clear; for i := 0 to FNBSuppliesKinds.Count - 1 do begin SuppliesKind := TNBSuppliesKind(FNBSuppliesKinds[i]); if CheckIsTradUOM(TF_Main(FActiveForm).FUOM) then AddGUIDIDToStrings(SuppliesKind.Data.NameTradUOM, SuppliesKind.Data.GUID, SuppliesKind.Data.ID, AStrings) else AddGUIDIDToStrings(SuppliesKind.Data.Name, SuppliesKind.Data.GUID, SuppliesKind.Data.ID, AStrings) end; SortStrings(AStrings); if AFirstEmpty then AddGUIDIDToStrings('', '', 0, AStrings, 0); end; procedure TSpravochnik.Assign(ASpravochnik: TSpravochnik); begin AssignCurrencies(ASpravochnik.FNBCurrencies); AssignComponentTypes(ASpravochnik.FNBComponentTypes); AssignInterfaces(ASpravochnik.FNBInterfaces); AssignNetTypes(ASpravochnik.FNBNetTypes); AssignNorms(ASpravochnik.FNBNorms); AssignObjectIcons(ASpravochnik.FNBObjectIcons); AssignProducers(ASpravochnik.FNBProducers); AssignProperties(ASpravochnik.FNBProperties); AssignResources(ASpravochnik.FNBResources); AssignSuppliesKinds(ASpravochnik.FNBSuppliesKinds); end; procedure TSpravochnik.AssignNoListData(ASpravochnik: TSpravochnik); begin AssignCurrencies(ASpravochnik.FNBCurrencies); //AssignComponentTypes(ASpravochnik.FNBComponentTypes); AssignInterfaces(ASpravochnik.FNBInterfaces); AssignNetTypes(ASpravochnik.FNBNetTypes); AssignNorms(ASpravochnik.FNBNorms); AssignObjectIcons(ASpravochnik.FNBObjectIcons); AssignProducers(ASpravochnik.FNBProducers); AssignProperties(ASpravochnik.FNBProperties); AssignResources(ASpravochnik.FNBResources); AssignSuppliesKinds(ASpravochnik.FNBSuppliesKinds); end; procedure TSpravochnik.AssignCurrencies(ACurrencies: TSCSObjectList); var i: Integer; SelfCurrency: TNBCurrency; begin ClearCurrencies; for i := 0 to ACurrencies.Count - 1 do begin SelfCurrency := TNBCurrency.Create(FActiveForm); SelfCurrency.Assign(TNBCurrency(ACurrencies[i])); AddCurrency(SelfCurrency); end; end; procedure TSpravochnik.AssignComponentTypes( AComponentTypes: TSCSObjectList; AGUIDAsNew: Boolean=true); var i: Integer; SelfComponentType: TNBComponentType; begin //FNBComponentTypes.Clear; ClearComponentTypes; for i := 0 to AComponentTypes.Count - 1 do begin SelfComponentType := TNBComponentType.Create(FActiveForm); SelfComponentType.Assign(TNBComponentType(AComponentTypes[i])); AddComponentType(SelfComponentType); if AGUIDAsNew then AddStringToStringListOnce(Self.FNewGUIDsComponentType, SelfComponentType.ComponentType.GUID); end; end; procedure TSpravochnik.AssignInterfaces(AInterfaces: TSCSObjectList); var i: Integer; SelfInterface: TNBInterface; begin ClearInterfaces; //FNBInterfaces.Clear; for i := 0 to AInterfaces.Count - 1 do begin SelfInterface := TNBInterface.Create(FActiveForm); SelfInterface.Assign(TNBInterface(AInterfaces[i])); AddInterface(SelfInterface); end; end; procedure TSpravochnik.AssignNetTypes(ANetTypes: TSCSObjectList); var i: Integer; SelfNetType: TNBNetType; begin FNBNetTypes.Clear; for i := 0 to ANetTypes.Count - 1 do begin SelfNetType := TNBNetType.Create(FActiveForm); SelfNetType.Assign(TNBNetType(ANetTypes[i])); AddNetType(SelfNetType); end; end; procedure TSpravochnik.AssignNorms(ANorms: TSCSObjectList); var i: Integer; SelfNorm: TNBNorm; begin FNBResources.Clear; for i := 0 to ANorms.Count - 1 do begin SelfNorm := TNBNorm.Create(FActiveForm); SelfNorm.Assign(TNBNorm(ANorms[i])); AddNorm(SelfNorm); end; end; procedure TSpravochnik.AssignObjectIcons(AObjectIcons: TSCSObjectList); var i: Integer; SelfObjectIcon: TNBObjectIcon; begin FNBObjectIcons.Clear; for i := 0 to AObjectIcons.Count - 1 do begin SelfObjectIcon := TNBObjectIcon.Create(FActiveForm); SelfObjectIcon.Assign(TNBObjectIcon(AObjectIcons[i])); AddObjectIcon(SelfObjectIcon); end; end; procedure TSpravochnik.AssignProducers(AProducers: TSCSObjectList); var i: Integer; SelfProducer: TNBProducer; begin FNBProducers.Clear; for i := 0 to AProducers.Count - 1 do begin SelfProducer := TNBProducer.Create(FActiveForm); SelfProducer.Assign(TNBProducer(AProducers[i])); AddProducer(SelfProducer); end; end; procedure TSpravochnik.AssignProperties(AProperties: TSCSObjectList); var i: Integer; SelfProperty: TNBProperty; begin ClearProperties; //12.03.2009 FNBProperties.Clear; for i := 0 to AProperties.Count - 1 do begin SelfProperty := TNBProperty.Create(FActiveForm); SelfProperty.Assign(TNBProperty(AProperties[i])); AddProperty(SelfProperty); end; end; procedure TSpravochnik.AssignResources(AResources: TSCSObjectList); var i: Integer; SelfResource: TNBResource; begin FNBResources.Clear; for i := 0 to AResources.Count - 1 do begin SelfResource := TNBResource.Create(FActiveForm); SelfResource.Assign(TNBResource(AResources[i])); AddResource(SelfResource); end; end; procedure TSpravochnik.AssignSuppliesKinds(ASuppliesKinds: TSCSObjectList); var i: Integer; SelfSuppliesKind: TNBSuppliesKind; begin FNBSuppliesKinds.Clear; for i := 0 to ASuppliesKinds.Count - 1 do begin SelfSuppliesKind := TNBSuppliesKind.Create(FActiveForm); SelfSuppliesKind.Assign(TNBSuppliesKind(ASuppliesKinds[i])); AddSuppliesKind(SelfSuppliesKind); end; end; function TSpravochnik.CreateCompTypeByStandartGUID(const ASysName, AGUID: string): TNBComponentType; var SprProperty: TNBProperty; procedure AddPropertyToCompType(ASprProperty: TNBProperty; ACompTypePropGUID: String); var CompTypeProperty: TNBCompTypeProperty; begin CompTypeProperty := TNBCompTypeProperty.Create(FActiveForm); Result.AddProperty(CompTypeProperty); CompTypeProperty.AssignFromNBProperty(ASprProperty); CompTypeProperty.PropertyData.Guid := ACompTypePropGUID; CompTypeProperty.GuidComponentType := Result.ComponentType.GUID; CompTypeProperty.PropertyData.IDMaster := Result.ComponentType.ID; end; begin Result := GetComponentTypeObjBySysName(ASysName); //GetComponentTypeByGUID(AGUID); if Result = nil then begin if ASysName = ctsnHouse then //if AGUID = guidCompTypeHouse then begin Result := TNBComponentType.Create(FActiveForm); Result.ComponentType.GUID := guidCompTypeHouse; Result.ComponentType.Name := cBaseCommon50_1; Result.ComponentType.NamePlural := cBaseCommon50_2; Result.ComponentType.SysName := ASysName; //ctsnHouse; Result.ComponentType.MarkMask := mteCompon; Result.ComponentType.PortKind := pkMultiport; Result.ComponentType.ActiveState := psPassive; Result.ComponentType.IsLine := biFalse; SprProperty := CreatePropertyByStandartGUID(pnCooperative, guidPropCooperative, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeHousePropCooperative); SprProperty := CreatePropertyByStandartGUID(pnHEO, guidPropHEO, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeHousePropHEO); SprProperty := CreatePropertyByStandartGUID(pnAgreed, guidPropAgreed, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeHousePropAgreed); end else //if AGUID = guidCompTypeApproach then if ASysName = ctsnApproach then begin Result := TNBComponentType.Create(FActiveForm); Result.ComponentType.GUID := guidCompTypeApproach; Result.ComponentType.Name := cBaseCommon50_3; Result.ComponentType.NamePlural := cBaseCommon50_4; Result.ComponentType.SysName := ASysName; //ctsnApproach; Result.ComponentType.MarkMask := mteCompon; Result.ComponentType.PortKind := pkPort; Result.ComponentType.ActiveState := psPassive; Result.ComponentType.IsLine := biFalse; SprProperty := CreatePropertyByStandartGUID(pnBoxInstalled, guidPropBoxInstalled, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropBoxInstalled); SprProperty := CreatePropertyByStandartGUID(pnPresencePower200WFromNetwork, guidPropPresencePower200WFromNetwork, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropPresencePower200WFromNetwork); SprProperty := CreatePropertyByStandartGUID(pnCableSetToBox, guidPropCableSetToBox1, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropCableSetToBox1); SprProperty := CreatePropertyByStandartGUID(pnCableSetToBox, guidPropCableSetToBox2, true); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropCableSetToBox2); SprProperty := CreatePropertyByStandartGUID(pnCableSetToBox, guidPropCableSetToBox3, true); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropCableSetToBox3); SprProperty := CreatePropertyByStandartGUID(pnFiberOpticWelded, guidPropFiberOpticWelded, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropFiberOpticWelded); SprProperty := CreatePropertyByStandartGUID(pnEquipmentInstalled, guidPropEquipmentInstalled, false); if SprProperty <> nil then AddPropertyToCompType(SprProperty, guidCompTypeApproachPropEquipmentInstalled); end; if Result <> nil then AddComponentType(Result); end; end; function TSpravochnik.CreatePropertyByStandartGUID(const ASysName, AGUID: string; ACheckGUID: Boolean): TNBProperty; var PropNum: integer; begin Result := GetPropertyBySysName(ASysName); //GetPropertyByGUID(AGUID); if ACheckGUID then if Result <> nil then if GetPropertyByGUID(AGUID) = nil then Result := nil; if Result = nil then begin //if AGUID = guidPropCooperative then if ASysName = pnCooperative then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtString; Result.PropertyData.SysName := pnCooperative; Result.PropertyData.Name := cBaseCommon51; Result.PropertyData.ISComponConn := biTrue; end else //if AGUID = guidPropHEO then if ASysName = pnHEO then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtString; Result.PropertyData.SysName := pnHEO; Result.PropertyData.Name := cBaseCommon52; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnAgreed then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnAgreed; Result.PropertyData.Name := cRepMsg185; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnBoxInstalled then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnBoxInstalled; Result.PropertyData.Name := cRepMsg186; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnPresencePower200WFromNetwork then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnPresencePower200WFromNetwork; Result.PropertyData.Name := cRepMsg187; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnCableSetToBox then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnCableSetToBox; Result.PropertyData.Name := cRepMsg188; Result.PropertyData.ISComponConn := biTrue; PropNum := 0; if AGUID = guidPropCableSetToBox1 then PropNum := 1 else if AGUID = guidPropCableSetToBox2 then PropNum := 2 else if AGUID = guidPropCableSetToBox3 then PropNum := 3; if PropNum <> 0 then Result.PropertyData.Name := Result.PropertyData.Name +' '+intToStr(PropNum); end else if ASysName = pnFiberOpticWelded then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnFiberOpticWelded; Result.PropertyData.Name := cRepMsg189; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnEquipmentInstalled then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := pnEquipmentInstalled; Result.PropertyData.Name := cRepMsg190; Result.PropertyData.ISComponConn := biTrue; end else if ASysName = pnDefect then begin Result := TNBProperty.Create(FActiveForm); Result.PropertyData.GUID := AGUID; Result.PropertyData.IDDataType := dtBoolean; Result.PropertyData.SysName := ASysName; Result.PropertyData.Name := cBaseCommon53; Result.PropertyData.ISComponConn := biTrue; Result.PropertyData.ISComponLine := biTrue; Result.PropertyData.IsForWholeComponent := biTrue; end; if Result.PropertyData.IDDataType = dtBoolean then Result.PropertyData.DefValue := bssFalse; if Result <> nil then AddProperty(Result); end; end; function TSpravochnik.CreateInterfaceByStandartGUID(const AGUID: string): TNBInterface; begin Result := GetInterfaceByGUID(AGUID); if Result = nil then begin if AGUID = guidUniversalInterface then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_1; Result.IsUniversal := biTrue; end else if AGUID = guidUniversalPort then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_2; Result.IsUniversal := biTrue; end else if AGUID = guidUniversalWire then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_3; Result.IsUniversal := biTrue; end else if AGUID = guidUniversalOutConstr then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_4; Result.IsUniversal := biTrue; end else if AGUID = guidUniversalInConstr then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_5; Result.IsUniversal := biTrue; end else if AGUID = guidUniversalChannelSide then begin Result := TNBInterface.Create(FActiveForm); Result.Name := cSCSComponent_Msg21_6; Result.IsUniversal := biTrue; end; if Result <> nil then begin Result.GUID := AGUID; Result.Description := Result.Name; Result.IsVisible := biFalse; Result.Save(meMake); AddInterface(Result); end; end; end; function TSpravochnik.AddCurrency(ACurrency: TNBCurrency): Integer; begin ACurrency.FOwner := Self; Result := FNBCurrencies.Add(ACurrency); FCurrencyGUIDs.Add(ACurrency.Data.GUID); end; function TSpravochnik.AddComponentType(AComponentType: TNBComponentType): Integer; begin AComponentType.FOwner := Self; Result := FNBComponentTypes.Add(AComponentType); FComponentTypeGUIDs.AddObject(AComponentType.ComponentType.GUID, AComponentType); end; function TSpravochnik.AddInterface(AInterface: TNBInterface): Integer; begin AInterface.FOwner := Self; Result := FNBInterfaces.Add(AInterface); FInterfaceGUIDs.AddObject(AInterface.GUID, AInterface); FInterfaceIDs.Insert(AInterface, @AInterface.ID); end; function TSpravochnik.AddNetType(ANetType: TNBNetType): Integer; begin ANetType.FOwner := Self; Result := FNBNetTypes.Add(ANetType); end; function TSpravochnik.AddNorm(ANorm: TNBNorm): Integer; begin ANorm.FOwner := Self; Result := FNBNorms.Add(ANorm); end; function TSpravochnik.AddObjectIcon(AObjectIcon: TNBObjectIcon): Integer; begin AObjectIcon.FOwner := Self; Result := FNBObjectIcons.Add(AObjectIcon); end; function TSpravochnik.AddProducer(AProducer: TNBProducer): Integer; begin AProducer.FOwner := Self; Result := FNBProducers.Add(AProducer); end; function TSpravochnik.AddProperty(AProperty: TNBProperty): Integer; begin AProperty.FOwner := Self; Result := FNBProperties.Add(AProperty); FPropertyGUIDS.AddObject(AProperty.PropertyData.GUID, AProperty); end; function TSpravochnik.AddResource(AResource: TNBResource): Integer; begin AResource.FOwner := Self; Result := FNBResources.Add(AResource); end; function TSpravochnik.AddSuppliesKind(ASuppliesKind: TNBSuppliesKind): Integer; begin ASuppliesKind.FOwner := Self; Result := FNBSuppliesKinds.Add(ASuppliesKind); end; procedure TSpravochnik.ClearCurrencies; begin FCurrencyGUIDs.Clear; FNBCurrencies.Clear; end; procedure TSpravochnik.ClearComponentTypes; begin FComponentTypeGUIDs.Clear; FNBComponentTypes.Clear; end; procedure TSpravochnik.ClearInterfaces; begin FInterfaceGUIDs.Clear; FInterfaceIDs.Clear; FNBInterfaces.Clear; end; procedure TSpravochnik.ClearProperties; begin FNBProperties.Clear; FPropertyGUIDS.Clear; end; { TNBSpravochnickElement } procedure TNBSpravochnickElement.Clear; begin IDCatalog := 0; CatalogItemType := 0; end; constructor TNBSpravochnickElement.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FOwner := nil; end; { TNBCurrency } procedure TNBCurrency.Assign(ACurrency: TNBCurrency); begin Data := ACurrency.Data; end; function TNBCurrency.CheckEqualRatio(ACurrency: TNBCurrency): Boolean; begin Result := true; if (Abs(Self.Data.Ratio - ACurrency.Data.Ratio) > cnstCmpPriceDelta) or (Self.Data.Kolvo <> ACurrency.Data.Kolvo) then Result := false; end; constructor TNBCurrency.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); ZeroMemory(@Data, SizeOf(TCurrency)); SavedMain := -1; IsModified := false; end; procedure TNBCurrency.LoadFromMemTable; begin with TF_Main(FActiveForm).DM do begin Self.IDCatalog := tSQL_Currency.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_Currency.FieldByName(fnIDItemType).AsInteger; Data.ID := tSQL_Currency.FieldByName(fnID).AsInteger; Data.Guid := tSQL_Currency.FieldByName(fnGUID).AsString; Data.Name := tSQL_Currency.FieldByName(fnName).AsString; Data.NameBrief := tSQL_Currency.FieldByName(fnNameBrief).AsString; Data.Kolvo := tSQL_Currency.FieldByName(fnKolvo).AsInteger; Data.Ratio := tSQL_Currency.FieldByName(fnRatio).AsFloat; Data.Main := tSQL_Currency.FieldByName(fnMain).AsInteger; Data.IsCountry := tSQL_Currency.FieldByName(fnIsCountry).AsInteger; end; end; procedure TNBCurrency.SaveToMemTable(AMakeEdit: TMakeEdit); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_Currency.Append; meEdit: if tSQL_Currency.Locate(fnID, Data.ID, []) then tSQL_Currency.Edit; end; if tSQL_Currency.State <> dsBrowse then begin tSQL_Currency.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_Currency.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_Currency.FieldByName(fnID).AsInteger := Data.ID; tSQL_Currency.FieldByName(fnGUID).AsString := Data.Guid; tSQL_Currency.FieldByName(fnName).AsString := Data.Name; tSQL_Currency.FieldByName(fnNameBrief).AsString := Data.NameBrief; tSQL_Currency.FieldByName(fnKolvo).AsInteger := Data.Kolvo; tSQL_Currency.FieldByName(fnRatio).AsFloat := Data.Ratio; tSQL_Currency.FieldByName(fnMain).AsInteger := Data.Main; tSQL_Currency.FieldByName(fnIsCountry).AsInteger := Data.IsCountry; tSQL_Currency.Post; end; end; end; { TNBComponentType } function TNBComponentType.AddProperty( ACompTypeProperty: TNBCompTypeProperty): Integer; begin ACompTypeProperty.FOwner := Self; Result := FProperties.Add(ACompTypeProperty); end; procedure TNBComponentType.Assign(AComponentType: TNBComponentType); begin AssignOnlyComponentType(AComponentType); AssignCompTypeProperties(AComponentType.FProperties); end; procedure TNBComponentType.AssignCompTypeProperties( AProperties: TSCSObjectList); var i: Integer; SelfProperty: TNBCompTypeProperty; begin FProperties.Clear; for i := 0 to AProperties.Count - 1 do begin SelfProperty := TNBCompTypeProperty.Create(FActiveForm); SelfProperty.Assign(TNBCompTypeProperty(AProperties[i])); AddProperty(SelfProperty); end; end; procedure TNBComponentType.AssignCompTypeNewProperties(AProperties: TSCSObjectList; ANBSprav: TSpravochnik); var i: Integer; SrcProperty, SelfProperty: TNBCompTypeProperty; CurrPropGuids: TStringList; SprProp: TNBProperty; begin CurrPropGuids := CreateStringListSorted; for i := 0 to FProperties.Count - 1 do CurrPropGuids.Add(TNBCompTypeProperty(FProperties[i]).PropertyData.GUIDProperty); for i := 0 to AProperties.Count - 1 do begin SrcProperty := TNBCompTypeProperty(AProperties[i]); if CurrPropGuids.IndexOf(SrcProperty.PropertyData.GUIDProperty) = -1 then begin // Подгружаем свойство в справочник SprProp := FOwner.GetPropertyWithAssign(SrcProperty.PropertyData.GUIDProperty, ANBSprav); if SprProp <> nil then begin SelfProperty := TNBCompTypeProperty.Create(FActiveForm); SelfProperty.Assign(SrcProperty); AddProperty(SelfProperty); end else EmptyProcedure; end; end; CurrPropGuids.Free; end; procedure TNBComponentType.AssignOnlyComponentType( AComponentType: TNBComponentType); begin ComponentType := AComponentType.ComponentType; end; procedure TNBComponentType.Clear; begin inherited; FProperties.Clear; ZeroMemory(@ComponentType, SizeOf(TComponentType)); IsModified := false; IsSelected := false; PropsCount := 0; ClearMarkTemplateObjects; end; procedure TNBComponentType.ClearMarkTemplateObjects; begin if MarkTemplateObjects <> nil then FreeAndNil(MarkTemplateObjects); MarkTemplateObjects := nil; end; function TNBComponentType.DefineMarkTemplateObjects: TObjectList; begin if MarkTemplateObjects = nil then begin MarkTemplateObjects := TObjectList.Create(true); LoadMarkTemplateObjectsToList(ComponentType.MarkMask, MarkTemplateObjects); end; Result := MarkTemplateObjects; end; constructor TNBComponentType.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FProperties := TSCSObjectList.Create(true); Clear; end; destructor TNBComponentType.Destroy; begin Clear; FreeAndNil(FProperties); inherited; end; function TNBComponentType.GetPropertyBySN(const ASN: String): TNBCompTypeProperty; var i: Integer; CompTypeProperty: TNBCompTypeProperty; Prop: TNBProperty; begin Result := nil; for i := 0 to FProperties.Count - 1 do begin Prop := nil; CompTypeProperty := TNBCompTypeProperty(FProperties[i]); if CompTypeProperty.PropertyData.SysName = '' then Prop := FOwner.GetPropertyByGUID(CompTypeProperty.PropertyData.GUIDProperty); if (CompTypeProperty.PropertyData.SysName = ASN) or (Assigned(Prop) and (Prop.PropertyData.SysName = ASN)) then begin Result := TNBCompTypeProperty(FProperties[i]); Break; //// BREAK //// end; end; end; procedure TNBComponentType.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin ComponentType.GUID := tSQL_ComponentTypes.FieldByName(fnGuid).AsString; if tSQL_ComponentTypes.FieldDefs.IndexOf(fnSysName) <> -1 then ComponentType.SysName := tSQL_ComponentTypes.FieldByName(fnSysName).AsString; if tSQL_ComponentTypes.FieldDefs.IndexOf(fnGUIDDesignIcon) <> -1 then ComponentType.GUIDDesignIcon := tSQL_ComponentTypes.FieldByName(fnGUIDDesignIcon).AsString; end else begin ComponentType.GUID := AStringsMan.GetStrByID(tSQL_ComponentTypes.FieldByName(fnGuid).AsInteger, AStringsMan.ComponentTypeGUIDStrings); if tSQL_ComponentTypes.FieldDefs.IndexOf(fnSysName) <> -1 then ComponentType.SysName := AStringsMan.GetStrByID(tSQL_ComponentTypes.FieldByName(fnSysName).AsInteger, AStringsMan.CompTypeSysNameStrings); if tSQL_ComponentTypes.FieldDefs.IndexOf(fnGUIDDesignIcon) <> -1 then ComponentType.GUIDDesignIcon := AStringsMan.GetStrByID(tSQL_ComponentTypes.FieldByName(fnGUIDDesignIcon).AsInteger, AStringsMan.ObjectIconGUIDStrings); end; ComponentType.ID := tSQL_ComponentTypes.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_ComponentTypes.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_ComponentTypes.FieldByName(fnIDItemType).AsInteger; ComponentType.Name := tSQL_ComponentTypes.FieldByName(fnName).AsString; ComponentType.NamePlural := tSQL_ComponentTypes.FieldByName(fnNamePlural).AsString; ComponentType.MarkMask := tSQL_ComponentTypes.FieldByName(fnMarkMask).AsString; ComponentType.PortKind := tSQL_ComponentTypes.FieldByName(fnPortKind).AsInteger; ComponentType.ActiveState := tSQL_ComponentTypes.FieldByName(fnActiveState).AsInteger; ComponentType.IDDesignIcon := tSQL_ComponentTypes.FieldByName(fnIDDesignIcon).AsInteger; ComponentType.IsLine := tSQL_ComponentTypes.FieldByName(fnIsLine).AsInteger; ComponentType.IsStandart := tSQL_ComponentTypes.FieldByName(fnisStandart).AsInteger; ComponentType.CoordZ := tSQL_ComponentTypes.FieldByName(fnCoordZ).AsFloat; if tSQL_ComponentTypes.FieldDefs.IndexOf(fnCanUseAsPoint) <> -1 then ComponentType.CanUseAsPoint := tSQL_ComponentTypes.FieldByName(fnCanUseAsPoint).AsInteger; if tSQL_ComponentTypes.FieldDefs.IndexOf(fnComponentIndex) <> -1 then ComponentType.ComponentIndex := tSQL_ComponentTypes.FieldByName(fnComponentIndex).AsInteger; PropsCount := tSQL_ComponentTypes.FieldByName(fnPropsCount).AsInteger; end; end; procedure TNBComponentType.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_ComponentTypes.Append; meEdit: if tSQL_ComponentTypes.Locate(fnID, ComponentType.ID, []) then tSQL_ComponentTypes.Edit; end; if tSQL_ComponentTypes.State <> dsBrowse then begin tSQL_ComponentTypes.FieldByName(fnID).AsInteger := ComponentType.ID; tSQL_ComponentTypes.FieldByName(fnIDCatalog).AsInteger := IDCatalog; tSQL_ComponentTypes.FieldByName(fnIDItemType).AsInteger := CatalogItemType; tSQL_ComponentTypes.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(ComponentType.GUID, AStringsMan.ComponentTypeGUIDStrings); tSQL_ComponentTypes.FieldByName(fnName).AsString := ComponentType.Name; tSQL_ComponentTypes.FieldByName(fnNamePlural).AsString := ComponentType.NamePlural; tSQL_ComponentTypes.FieldByName(fnSysName).AsInteger := AStringsMan.GenStrID(ComponentType.SysName, AStringsMan.CompTypeSysNameStrings); tSQL_ComponentTypes.FieldByName(fnMarkMask).AsString := ComponentType.MarkMask; tSQL_ComponentTypes.FieldByName(fnPortKind).AsInteger := ComponentType.PortKind; tSQL_ComponentTypes.FieldByName(fnActiveState).AsInteger := ComponentType.ActiveState; tSQL_ComponentTypes.FieldByName(fnIDDesignIcon).AsInteger := ComponentType.IDDesignIcon; tSQL_ComponentTypes.FieldByName(fnGUIDDesignIcon).AsInteger := AStringsMan.GenStrID(ComponentType.GUIDDesignIcon, AStringsMan.ObjectIconGUIDStrings); tSQL_ComponentTypes.FieldByName(fnIsLine).AsInteger := ComponentType.IsLine; tSQL_ComponentTypes.FieldByName(fnisStandart).AsInteger := ComponentType.IsStandart; tSQL_ComponentTypes.FieldByName(fnCoordZ).AsFloat := ComponentType.CoordZ; tSQL_ComponentTypes.FieldByName(fnCanUseAsPoint).AsInteger := ComponentType.CanUseAsPoint; tSQL_ComponentTypes.FieldByName(fnComponentIndex).AsInteger := ComponentType.ComponentIndex; tSQL_ComponentTypes.FieldByName(fnPropsCount).AsInteger := PropsCount; tSQL_ComponentTypes.Post; end; end; end; procedure TNBComponentType.Save(AMakeEdit: TMakeEdit); begin TF_Main(FActiveForm).DM.SaveComponentType(AMakeEdit, @ComponentType); end; { TNBInterface } function TNBInterface.AddInterfaceAccordance( AInterfaceAccordance: TNBInterfaceAccordance): Integer; begin AInterfaceAccordance.FOwner := Self; Result := FInterfaceAccordance.Add(AInterfaceAccordance); end; function TNBInterface.AddInterfaceNorm( AInterfaceNorm: TNBInterfaceNorm): Integer; begin AInterfaceNorm.FOwner := Self; Result := FInterfaceNorms.Add(AInterfaceNorm); end; procedure TNBInterface.Assign(AInterface: TNBInterface); begin AssignOnlyInterface(AInterface); AssignInterfaceNorms(AInterface.FInterfaceNorms); AssignInterfaceAccordance(AInterface.FInterfaceAccordance); end; procedure TNBInterface.AssignInterfaceAccordance( AInterfaceAccordance: TSCSObjectList); var i: Integer; SelfInterfaceAccordance: TNBInterfaceAccordance; begin FInterfaceAccordance.Clear; for i := 0 to AInterfaceAccordance.Count - 1 do begin SelfInterfaceAccordance := TNBInterfaceAccordance.Create(FActiveForm); SelfInterfaceAccordance.Assign(TNBInterfaceAccordance(AInterfaceAccordance[i])); AddInterfaceAccordance(SelfInterfaceAccordance); end; end; procedure TNBInterface.AssignInterfaceNorms( AInterfaceNorms: TSCSObjectList); var i: Integer; SelfInterfaceNorm: TNBInterfaceNorm; begin FInterfaceNorms.Clear; for i := 0 to AInterfaceNorms.Count - 1 do begin SelfInterfaceNorm := TNBInterfaceNorm.Create(FActiveForm); SelfInterfaceNorm.Assign(TNBInterfaceNorm(AInterfaceNorms[i])); AddInterfaceNorm(SelfInterfaceNorm); end; end; procedure TNBInterface.AssignOnlyInterface(AInterface: TNBInterface); begin ID := AInterface.ID; GUID := AInterface.GUID; Name := AInterface.Name; GuidNetType := AInterface.GuidNetType; IDNetType := AInterface.IDNetType; SortID := AInterface.SortID; ConstructiveWidth := AInterface.ConstructiveWidth; Description := AInterface.Description; IsVisible := AInterface.IsVisible; IsUniversal := AInterface.IsUniversal; end; procedure TNBInterface.Clear; begin FInterfaceNorms.Clear; FInterfaceAccordance.Clear; ID := 0; GUID := ''; Name := ''; GuidNetType := ''; IDNetType := 0; SortID := 0; ConstructiveWidth := 0; Description := ''; IsVisible := biTrue; IsUniversal := biFalse; InterfNormsCount := 0; IsModified := false; end; constructor TNBInterface.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FInterfaceNorms := TSCSObjectList.Create(true); FInterfaceAccordance := TSCSObjectList.Create(true); Clear; end; destructor TNBInterface.Destroy; begin FInterfaceNorms.Free; FInterfaceAccordance.Free; inherited; end; function TNBInterface.GetInterfAccordanceByGUIDAccordance(const AGUID: String): TNBInterfaceAccordance; var InterfAccordance: TNBInterfaceAccordance; i: Integer; begin Result := nil; for i := 0 to FInterfaceAccordance.Count - 1 do begin InterfAccordance := TNBInterfaceAccordance(FInterfaceAccordance[i]); if InterfAccordance.GUIDAccordance = AGUID then begin Result := InterfAccordance; Break; //// BREAK //// end; end; end; function TNBInterface.GetInterfAccordanceByIDAccordance(AID: Integer): TNBInterfaceAccordance; var InterfAccordance: TNBInterfaceAccordance; i: Integer; begin Result := nil; for i := 0 to FInterfaceAccordance.Count - 1 do begin InterfAccordance := TNBInterfaceAccordance(FInterfaceAccordance[i]); if InterfAccordance.IDAccordance = AID then begin Result := InterfAccordance; Break; //// BREAK //// end; end; end; function TNBInterface.GetInterfNormByGUIDNB(const AGUID: String): TNBInterfaceNorm; var i: Integer; InterfNorm: TNBInterfaceNorm; begin Result := nil; for i := 0 to FInterfaceNorms.Count - 1 do begin InterfNorm := TNBInterfaceNorm(FInterfaceNorms[i]); if InterfNorm.GuidNBNorm = AGUID then begin Result := InterfNorm; Break; //// BREAK //// end; end; end; procedure TNBInterface.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_Interface.FieldByName(fnGuid).AsString; Self.GuidNetType := tSQL_Interface.FieldByName(fnGuidNetType).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_Interface.FieldByName(fnGuid).AsInteger, AStringsMan.FInterfaceGUIDStrings); Self.GuidNetType := AStringsMan.GetStrByID(tSQL_Interface.FieldByName(fnGuidNetType).AsInteger, AStringsMan.FNetTypeGUIDStrings); end; Self.ID := tSQL_Interface.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_Interface.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_Interface.FieldByName(fnIDItemType).AsInteger; Self.Name := tSQL_Interface.FieldByName(fnName).AsString; Self.IDNetType := tSQL_Interface.FieldByName(fnIDNetType).AsInteger; Self.SortID := tSQL_Interface.FieldByName(fnSortID).AsInteger; Self.ConstructiveWidth := tSQL_Interface.FieldByName(fnConstructiveWidth).AsFloat; if tSQL_Interface.FieldDefs.IndexOf(fnDescription) <> -1 then Self.Description := tSQL_Interface.FieldByName(fnDescription).AsString; if tSQL_Interface.FieldDefs.IndexOf(fnIsUniversal) <> -1 then Self.IsUniversal := tSQL_Interface.FieldByName(fnIsUniversal).AsInteger; if tSQL_Interface.FieldDefs.IndexOf(fnInterfAccordanceCount) <> -1 then InterfAccordanceCount := tSQL_Interface.FieldByName(fnInterfAccordanceCount).AsInteger; InterfNormsCount := tSQL_Interface.FieldByName(fnInterfNormsCount).AsInteger; end; end; procedure TNBInterface.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_Interface.Append; meEdit: if tSQL_Interface.Locate(fnID, ID, []) then tSQL_Interface.Edit; end; if tSQL_Interface.State <> dsBrowse then begin tSQL_Interface.FieldByName(fnID).AsInteger := Self.ID; tSQL_Interface.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_Interface.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_Interface.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FInterfaceGUIDStrings); tSQL_Interface.FieldByName(fnName).AsString := Self.Name; tSQL_Interface.FieldByName(fnGuidNetType).AsInteger := AStringsMan.GenStrID(Self.GuidNetType, AStringsMan.FNetTypeGUIDStrings); tSQL_Interface.FieldByName(fnIDNetType).AsInteger := Self.IDNetType; tSQL_Interface.FieldByName(fnSortID).AsInteger := Self.SortID; tSQL_Interface.FieldByName(fnConstructiveWidth).AsFloat := Self.ConstructiveWidth; tSQL_Interface.FieldByName(fnDescription).AsString := Self.Description; tSQL_Interface.FieldByName(fnIsUniversal).AsInteger := Self.IsUniversal; tSQL_Interface.FieldByName(fnInterfAccordanceCount).AsInteger := Self.InterfAccordanceCount; tSQL_Interface.FieldByName(fnInterfNormsCount).AsInteger := Self.InterfNormsCount; tSQL_Interface.Post; end; end; end; procedure TNBInterface.Save(AMakeEdit: TMakeEdit); var InterfaceInfo: TInterfaceInfo; begin ZeroMemory(@InterfaceInfo, SizeOf(TInterfaceInfo)); InterfaceInfo.ID := ID; InterfaceInfo.GUID := GUID; InterfaceInfo.Name := Name; InterfaceInfo.IDNetType := IDNetType; InterfaceInfo.ConstructiveWidth := ConstructiveWidth; InterfaceInfo.Description := Description; InterfaceInfo.IsVisible := IsVisible; //biTrue; InterfaceInfo.IsUniversal := IsUniversal; TF_Main(FActiveForm).DM.SaveInterface(meMake, @InterfaceInfo); if AMakeEdit = meMake then ID := InterfaceInfo.ID; end; { TNBInterfaceNorm } procedure TNBInterfaceNorm.Assign(AInterfaceNorm: TNBInterfaceNorm); begin ID := AInterfaceNorm.ID; GUID := AInterfaceNorm.GUID; GuidInterface := AInterfaceNorm.GuidInterface; IDInterface := AInterfaceNorm.IDInterface; GuidNBNorm := AInterfaceNorm.GuidNBNorm; IDNBNorm := AInterfaceNorm.IDNBNorm; GUIDComponentType := AInterfaceNorm.GUIDComponentType; IDComponentType := AInterfaceNorm.IDComponentType; Expense := AInterfaceNorm.Expense; InterfaceIsBusy := AInterfaceNorm.InterfaceIsBusy; KoefLengthForCompl := AInterfaceNorm.KoefLengthForCompl; end; constructor TNBInterfaceNorm.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); ID := 0; GUID := ''; GuidInterface := ''; IDInterface := 0; GuidNBNorm := ''; IDNBNorm := 0; GUIDComponentType := ''; IDComponentType := 0; Expense := 0; InterfaceIsBusy := 0; KoefLengthForCompl := 0; IsModified := false; FOwner := nil; end; { TNBInterfaceACorrdance } procedure TNBInterfaceACcordance.Assign( AInterfaceACcordance: TNBInterfaceACcordance); begin ID := AInterfaceACcordance.ID; GUID := AInterfaceACcordance.GUID; GuidInterface := AInterfaceACcordance.GuidInterface; IDInterface := AInterfaceACcordance.IDInterface; InterfComponIsLine := AInterfaceACcordance.InterfComponIsLine; GUIDAccordance := AInterfaceACcordance.GUIDAccordance; IDAccordance := AInterfaceACcordance.IDAccordance; AccordComponIsLine := AInterfaceACcordance.AccordComponIsLine; Kolvo := AInterfaceACcordance.Kolvo; end; constructor TNBInterfaceACcordance.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); ID := 0; GUID := ''; GUIDInterface := ''; IDInterface := 0; InterfComponIsLine := 0; GUIDAccordance := ''; IDAccordance := 0; AccordComponIsLine := 0; Kolvo := 0; IsModified := false; FOwner := nil; end; procedure TNBInterfaceACcordance.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GuidInterface := tSQL_InterfaceAccordance.FieldByName(fnGUIDInterface).AsString; Self.GUIDAccordance := tSQL_InterfaceAccordance.FieldByName(fnGUIDAccordance).AsString; end else begin Self.GuidInterface := AStringsMan.GetStrByID(tSQL_InterfaceAccordance.FieldByName(fnGUIDInterface).AsInteger, AStringsMan.FInterfaceGUIDStrings); Self.GUIDAccordance := AStringsMan.GetStrByID(tSQL_InterfaceAccordance.FieldByName(fnGUIDAccordance).AsInteger, AStringsMan.FInterfaceGUIDStrings); end; Self.ID := tSQL_InterfaceAccordance.FieldByName(fnID).AsInteger; Self.GUID := tSQL_InterfaceAccordance.FieldByName(fnGUID).AsString; Self.IDInterface := tSQL_InterfaceAccordance.FieldByName(fnIDInterface).AsInteger; Self.InterfComponIsLine := tSQL_InterfaceAccordance.FieldByName(fnInterfComponIsLine).AsInteger; Self.IDAccordance := tSQL_InterfaceAccordance.FieldByName(fnIDAccordance).AsInteger; Self.AccordComponIsLine := tSQL_InterfaceAccordance.FieldByName(fnAccordComponIsLine).AsInteger; Self.Kolvo := tSQL_InterfaceAccordance.FieldByName(fnKolvo).AsInteger; end; end; procedure TNBInterfaceACcordance.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_InterfaceAccordance.Append; meEdit: if tSQL_InterfaceAccordance.Locate(fnID, ID, []) then tSQL_InterfaceAccordance.Edit; end; if tSQL_InterfaceAccordance.State <> dsBrowse then begin tSQL_InterfaceAccordance.FieldByName(fnID).AsInteger := Self.ID; tSQL_InterfaceAccordance.FieldByName(fnGUID).AsString := Self.GUID; tSQL_InterfaceAccordance.FieldByName(fnGUIDInterface).AsInteger := AStringsMan.GenStrID(Self.GuidInterface, AStringsMan.FInterfaceGUIDStrings); tSQL_InterfaceAccordance.FieldByName(fnIDInterface).AsInteger := Self.IDInterface; tSQL_InterfaceAccordance.FieldByName(fnInterfComponIsLine).AsInteger := Self.InterfComponIsLine; tSQL_InterfaceAccordance.FieldByName(fnGUIDAccordance).AsInteger := AStringsMan.GenStrID(Self.GUIDAccordance, AStringsMan.FInterfaceGUIDStrings); tSQL_InterfaceAccordance.FieldByName(fnIDAccordance).AsInteger := Self.IDAccordance; tSQL_InterfaceAccordance.FieldByName(fnAccordComponIsLine).AsInteger := Self.AccordComponIsLine; tSQL_InterfaceAccordance.FieldByName(fnKolvo).AsInteger := Self.Kolvo; tSQL_InterfaceAccordance.Post; end; end; end; procedure TNBInterfaceACcordance.Save(AMakeEdit: TMakeEdit); var InterfaceAccordanceInfo: TInterfaceAccordanceInfo; begin ZeroMemory(@InterfaceAccordanceInfo, SizeOf(TInterfaceAccordanceInfo)); InterfaceAccordanceInfo.ID := ID; InterfaceAccordanceInfo.GUID := GUID; InterfaceAccordanceInfo.IDInterface := IDInterface; InterfaceAccordanceInfo.InterfComponIsLine := InterfComponIsLine; InterfaceAccordanceInfo.IDAccordance := IDAccordance; InterfaceAccordanceInfo.AccordComponIsLine := AccordComponIsLine; InterfaceAccordanceInfo.Kolvo := Kolvo; TF_Main(FActiveForm).DM.SaveInterfaceAccordance(AMakeEdit, @InterfaceAccordanceInfo); if AMakeEdit = meMake then ID := InterfaceAccordanceInfo.ID; end; { TNBNetType } procedure TNBNetType.Assign(ANetType: TNBNetType); begin ID := ANetType.ID; GUID := ANetType.GUID; Name := ANetType.Name; end; procedure TNBNetType.Clear; begin ID := 0; GUID := ''; Name := ''; IsModified := false; end; constructor TNBNetType.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBNetType.Destroy; begin inherited; end; procedure TNBNetType.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_NetType.FieldByName(fnGuid).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_NetType.FieldByName(fnGuid).AsInteger, AStringsMan.FNetTypeGUIDStrings); end; Self.ID := tSQL_NetType.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_NetType.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_NetType.FieldByName(fnIDItemType).AsInteger; Self.Name := tSQL_NetType.FieldByName(fnName).AsString; end; end; procedure TNBNetType.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_NetType.Append; meEdit: if tSQL_NetType.Locate(fnID, ID, []) then tSQL_NetType.Edit; end; if tSQL_NetType.State <> dsBrowse then begin tSQL_NetType.FieldByName(fnID).AsInteger := Self.ID; tSQL_NetType.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_NetType.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_NetType.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FNetTypeGUIDStrings); tSQL_NetType.FieldByName(fnName).AsString := Self.Name; tSQL_NetType.Post; end; end; end; procedure TNBNetType.Save(AMakeEdit: TMakeEdit); var NetType: TNetType; begin ZeroMemory(@NetType, SizeOf(TNetType)); NetType.GUID := GUID; NetType.Name := Name; TF_Main(FActiveForm).DM.SaveNetType(meMake, @NetType); if AMakeEdit = meMake then ID := NetType.ID; end; { TNBNorm } procedure TNBNorm.Assign(ANorm: TNBNorm); begin ID := ANorm.ID; GUID := ANorm.GUID; Cypher := ANorm.Cypher; Name := ANorm.Name; Izm := ANorm.Izm; Price := ANorm.Price; GUIDESmeta := ANorm.GUIDESmeta; LaborTime := ANorm.LaborTime; PricePerTime := ANorm.PricePerTime; //TimeUOM := ANorm.TimeUOM; end; procedure TNBNorm.Clear; begin ID := 0; GUID := ''; Cypher := ''; Name := ''; Izm := ''; Price := 0; GUIDESmeta := ''; LaborTime := 0; PricePerTime := 0; TimeUOM := 0; IsModified := false; IsApplyDataForAllSame := false; end; constructor TNBNorm.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBNorm.Destroy; begin Clear; inherited; end; procedure TNBNorm.LoadFromMemTable(AStringsMan: TStringsMan); var //Fld: TField; FIndex: Integer; begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_NBNorms.FieldByName(fnGuid).AsString; Self.Cypher := tSQL_NBNorms.FieldByName(fnCypher).AsString; Self.Name := tSQL_NBNorms.FieldByName(fnName).AsString; Self.Izm := tSQL_NBNorms.FieldByName(fnIzm).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_NBNorms.FieldByName(fnGuid).AsInteger, AStringsMan.FNormGuidNBStrings); Self.Cypher := AStringsMan.GetStrByID(tSQL_NBNorms.FieldByName(fnCypher).AsInteger, AStringsMan.FNormCypherStrings); Self.Name := AStringsMan.GetStrByID(tSQL_NBNorms.FieldByName(fnName).AsInteger, AStringsMan.FNormNameStrings); Self.Izm := AStringsMan.GetStrByID(tSQL_NBNorms.FieldByName(fnIzm).AsInteger, AStringsMan.FIzmStrings); end; Self.ID := tSQL_NBNorms.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_NBNorms.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_NBNorms.FieldByName(fnIDItemType).AsInteger; //25.10.2013 FIndex := tSQL_NBNorms.FieldDefs.IndexOf(fnLaborTime); if FIndex <> -1 then begin Self.LaborTime := tSQL_NBNorms.Fields[FIndex].AsInteger; Self.PricePerTime := tSQL_NBNorms.FieldByName(fnPricePerTime).AsFloat; //Self.TimeUOM := tSQL_NBNorms.FieldByName(fnTimeUOM).AsInteger; end; FIndex := tSQL_NBNorms.FieldDefs.IndexOf(fnPrice); if FIndex <> -1 then //Self.Price := tSQL_NBNorms.FieldByName(fnPrice).AsFloat; Self.Price := tSQL_NBNorms.Fields[FIndex].AsFloat; Self.GUIDESmeta := tSQL_NBNorms.FieldByName(fnGuidESmeta).AsString; end; end; procedure TNBNorm.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_NBNorms.Append; meEdit: if tSQL_NBNorms.Locate(fnID, ID, []) then tSQL_NBNorms.Edit; end; if tSQL_NBNorms.State <> dsBrowse then begin tSQL_NBNorms.FieldByName(fnID).AsInteger := Self.ID; tSQL_NBNorms.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_NBNorms.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_NBNorms.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FNormGuidNBStrings); tSQL_NBNorms.FieldByName(fnCypher).AsInteger := AStringsMan.GenStrID(Self.Cypher, AStringsMan.FNormCypherStrings); tSQL_NBNorms.FieldByName(fnName).AsInteger := AStringsMan.GenStrID(Self.Name, AStringsMan.FNormNameStrings); tSQL_NBNorms.FieldByName(fnIzm).AsInteger := AStringsMan.GenStrID(Self.Izm, AStringsMan.FIzmStrings); //25.10.2013 tSQL_NBNorms.FieldByName(fnLaborTime).AsInteger := Self.LaborTime; tSQL_NBNorms.FieldByName(fnPricePerTime).AsFloat := Self.PricePerTime; //tSQL_NBNorms.FieldByName(fnTimeUOM).AsInteger := Self.TimeUOM; tSQL_NBNorms.FieldByName(fnPrice).AsFloat := Self.Price; tSQL_NBNorms.FieldByName(fnGuidESmeta).AsString := Self.GUIDESmeta; tSQL_NBNorms.Post; end; end; end; procedure TNBNorm.Save(AMakeEdit: TMakeEdit); var NormInfo: TNormInfo; begin ZeroMemory(@NormInfo, SizeOf(TNormInfo)); NormInfo.ID := ID; NormInfo.GUID := GUID; NormInfo.Cypher := Cypher; NormInfo.Name := Name; NormInfo.Izm := Izm; NormInfo.Price := Price; NormInfo.LaborTime := LaborTime; NormInfo.PricePerTime := PricePerTime; //NormInfo.TimeUOM := TimeUOM; TF_Main(FActiveForm).DM.SaveNorm(AMakeEdit, @NormInfo); if AMakeEdit = meMake then ID := NormInfo.ID; end; { TNBObjectIcon } procedure TNBObjectIcon.Assign(ANBObjectIcon: TNBObjectIcon); begin ID := ANBObjectIcon.ID; GUID := ANBObjectIcon.GUID; Name := ANBObjectIcon.Name; CopyStream(FProjBlk, ANBObjectIcon.FProjBlk); CopyStream(FProjBmp, ANBObjectIcon.FProjBmp); CopyStream(FActiveBlk, ANBObjectIcon.FActiveBlk); CopyStream(FActiveBmp, ANBObjectIcon.FActiveBmp); end; procedure TNBObjectIcon.Clear; begin ID := 0; GUID := ''; Name := ''; FProjBlk.Clear; FProjBmp.Clear; FActiveBlk.Clear; FActiveBmp.Clear; IsModified := false; end; constructor TNBObjectIcon.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FProjBlk := TMemoryStream.Create; FProjBmp := TMemoryStream.Create; FActiveBlk := TMemoryStream.Create; FActiveBmp := TMemoryStream.Create; end; destructor TNBObjectIcon.Destroy; begin Clear; FreeAndNil(FProjBlk); FreeAndNil(FProjBmp); FreeAndNil(FActiveBlk); FreeAndNil(FActiveBmp); inherited; end; procedure TNBObjectIcon.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_ObjectIcons.FieldByName(fnGuid).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_ObjectIcons.FieldByName(fnGuid).AsInteger, AStringsMan.FObjectIconGUIDStrings); end; Self.ID := tSQL_ObjectIcons.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_ObjectIcons.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_ObjectIcons.FieldByName(fnIDItemType).AsInteger; Self.Name := tSQL_ObjectIcons.FieldByName(fnName).AsString; SaveToStreamFromSQLMT(tSQL_ObjectIcons, Self.ProjBlk, fnProjBlk); SaveToStreamFromSQLMT(tSQL_ObjectIcons, Self.ProjBmp, fnProjBmp); SaveToStreamFromSQLMT(tSQL_ObjectIcons, Self.ActiveBlk, fnActiveBlk); SaveToStreamFromSQLMT(tSQL_ObjectIcons, Self.ActiveBmp, fnActiveBmp); end; end; procedure TNBObjectIcon.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_ObjectIcons.Append; meEdit: if tSQL_ObjectIcons.Locate(fnID, ID, []) then tSQL_ObjectIcons.Edit; end; if tSQL_ObjectIcons.State <> dsBrowse then begin tSQL_ObjectIcons.FieldByName(fnID).AsInteger := Self.ID; tSQL_ObjectIcons.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_ObjectIcons.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_ObjectIcons.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FObjectIconGUIDStrings); tSQL_ObjectIcons.FieldByName(fnName).AsString := Self.Name; LoadFromStreamToSQLMT(tSQL_ObjectIcons, Self.ProjBlk, fnProjBlk); LoadFromStreamToSQLMT(tSQL_ObjectIcons, Self.ProjBmp, fnProjBmp); LoadFromStreamToSQLMT(tSQL_ObjectIcons, Self.ActiveBlk, fnActiveBlk); LoadFromStreamToSQLMT(tSQL_ObjectIcons, Self.ActiveBmp, fnActiveBmp); tSQL_ObjectIcons.Post; end; end; end; procedure TNBObjectIcon.Save(AMakeEdit: TMakeEdit); var ObjectIconInfo: TObjectIconInfo; begin ZeroMemory(@ObjectIconInfo, SizeOf(TObjectIconInfo)); ObjectIconInfo.ID := ID; ObjectIconInfo.GUID := GUID; ObjectIconInfo.Name := Name; ObjectIconInfo.ProjBlk := FProjBlk; ObjectIconInfo.ProjBmp := FProjBmp; ObjectIconInfo.ActiveBlk := FActiveBlk; ObjectIconInfo.ActiveBmp := FActiveBmp; TF_Main(FActiveForm).DM.SaveObjectIcon(AMakeEdit, @ObjectIconInfo); if AMakeEdit = meMake then ID := ObjectIconInfo.ID; end; { TNBProducer } procedure TNBProducer.Assign(AProducer: TNBProducer); begin ID := AProducer.ID; GUID := AProducer.GUID; Name := AProducer.Name; Description := AProducer.Description; end; procedure TNBProducer.Clear; begin ID := 0; GUID := ''; Name := ''; Description := ''; end; constructor TNBProducer.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBProducer.Destroy; begin Clear; inherited; end; procedure TNBProducer.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_Producers.FieldByName(fnGuid).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_Producers.FieldByName(fnGuid).AsInteger, AStringsMan.FProducerGUIDStrings); end; Self.ID := tSQL_Producers.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_Producers.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_Producers.FieldByName(fnIDItemType).AsInteger; Self.Name := tSQL_Producers.FieldByName(fnName).AsString; Self.Description := tSQL_Producers.FieldByName(fnDescription).AsString; end; end; procedure TNBProducer.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_Producers.Append; meEdit: if tSQL_Producers.Locate(fnID, ID, []) then tSQL_Producers.Edit; end; if tSQL_Producers.State <> dsBrowse then begin tSQL_Producers.FieldByName(fnID).AsInteger := Self.ID; tSQL_Producers.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_Producers.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_Producers.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FProducerGUIDStrings); tSQL_Producers.FieldByName(fnName).AsString := Self.Name; tSQL_Producers.FieldByName(fnDescription).AsString := Self.Description; tSQL_Producers.Post; end; end; end; procedure TNBProducer.Save(AMakeEdit: TMakeEdit); var Producer: TProducer; begin ZeroMemory(@Producer, SizeOf(TProducer)); Producer.ID := ID; Producer.GUID := GUID; Producer.Name := Name; Producer.Description := Description; TF_Main(FActiveForm).DM.SaveProducer(AMakeEdit, @Producer); if AMakeEdit = meMake then ID := Producer.ID; end; { TNBProperty } function TNBProperty.AddPropValRel(APropValRel: TNBPropValRel): Integer; begin APropValRel.FOwner := Self; Result := FPropValRelList.Add(APropValRel); end; procedure TNBProperty.Assign(AProperty: TNBProperty); begin AssignOnlyProperty(AProperty); AssignPropValRel(AProperty.FPropValRelList); end; procedure TNBProperty.AssignOnlyProperty(AProperty: TNBProperty); begin PropertyData := AProperty.PropertyData; end; procedure TNBProperty.AssignPropValRel(APropValRelList: TSCSObjectList); var i: Integer; PropValRel: TNBPropValRel; begin FPropValRelList.Clear; for i := 0 to APropValRelList.Count - 1 do begin PropValRel := TNBPropValRel.Create(FActiveForm); PropValRel.Assign(TNBPropValRel(APropValRelList[i])); AddPropValRel(PropValRel); end; end; procedure TNBProperty.AssignToPProperty(AProperty: PProperty); begin AProperty.ID_Property := Self.PropertyData.ID; AProperty.Name_ := Self.PropertyData.Name; AProperty.SysName := Self.PropertyData.SysName; AProperty.Value := Self.PropertyData.DefValue; AProperty.IsDefault := Self.PropertyData.IsStandart; AProperty.GUIDProperty := Self.PropertyData.GUID; AProperty.IsForWholeComponent := Self.PropertyData.IsForWholeComponent; AProperty.IDDataType := Self.PropertyData.IDDataType; //22.09.2010 end; procedure TNBProperty.Clear; begin ZeroMemory(@PropertyData, SizeOf(TPropertyData)); FPropValRelList.Clear; PropValRelCount := 0; IsModified := false; end; constructor TNBProperty.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FPropValRelList := TSCSObjectList.Create(true); Clear; end; destructor TNBProperty.Destroy; begin Clear; FreeAndNil(FPropValRelList); inherited; end; procedure TNBProperty.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.PropertyData.GUID := tSQL_Properties.FieldByName(fnGUID).AsString; end else begin Self.PropertyData.GUID := AStringsMan.GetStrByID(tSQL_Properties.FieldByName(fnGUID).AsInteger, AStringsMan.FPropertyGUIDStrings); end; Self.PropertyData.ID := tSQL_Properties.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_Properties.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_Properties.FieldByName(fnIDItemType).AsInteger; Self.PropertyData.IDDataType := tSQL_Properties.FieldByName(fnIDDataType).AsInteger; Self.PropertyData.Name := tSQL_Properties.FieldByName(fnName).AsString; Self.PropertyData.SysName := tSQL_Properties.FieldByName(fnSysName).AsString; Self.PropertyData.Izm := tSQL_Properties.FieldByName(fnIzm).AsString; Self.PropertyData.ValueReq := tSQL_Properties.FieldByName(fnValueReq).AsInteger; Self.PropertyData.MinValue := tSQL_Properties.FieldByName(fnMinValue).AsFloat; Self.PropertyData.MaxValue := tSQL_Properties.FieldByName(fnMaxValue).AsFloat; Self.PropertyData.DefValue := tSQL_Properties.FieldByName(fnDefValue).AsString; Self.PropertyData.Description := tSQL_Properties.FieldByName(fnDescription).AsString; Self.PropertyData.IsStandart := tSQL_Properties.FieldByName(fnIsStandart).AsInteger; Self.PropertyData.SortID := tSQL_Properties.FieldByName(fnSortID).AsInteger; Self.PropertyData.ISProject := tSQL_Properties.FieldByName(fnISProject).AsInteger; Self.PropertyData.ISFolder := tSQL_Properties.FieldByName(fnISFolder).AsInteger; Self.PropertyData.ISList := tSQL_Properties.FieldByName(fnISList).AsInteger; Self.PropertyData.ISRoom := tSQL_Properties.FieldByName(fnISRoom).AsInteger; Self.PropertyData.ISSCSLine := tSQL_Properties.FieldByName(fnISSCSLine).AsInteger; Self.PropertyData.ISSCSConnector := tSQL_Properties.FieldByName(fnISSCSConnector).AsInteger; Self.PropertyData.ISComponLine := tSQL_Properties.FieldByName(fnISComponLine).AsInteger; Self.PropertyData.ISComponConn := tSQL_Properties.FieldByName(fnISComponConn).AsInteger; Self.PropertyData.IsForWholeComponent := tSQL_Properties.FieldByName(fnIsForWholeComponent).AsInteger; if tSQL_Properties.FieldDefs.IndexOf(fnIsValueRelToObj) <> -1 then Self.PropertyData.IsValueRelToObj := tSQL_Properties.FieldByName(fnIsValueRelToObj).AsInteger; if tSQL_Properties.FieldDefs.IndexOf(fnPropValRelCount) <> -1 then Self.PropValRelCount := tSQL_Properties.FieldByName(fnPropValRelCount).AsInteger; end; end; procedure TNBProperty.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_Properties.Append; meEdit: if tSQL_Properties.Locate(fnID, PropertyData.ID, []) then tSQL_Properties.Edit; end; if tSQL_Properties.State <> dsBrowse then begin tSQL_Properties.FieldByName(fnID).AsInteger := Self.PropertyData.ID; tSQL_Properties.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_Properties.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_Properties.FieldByName(fnGUID).AsInteger := AStringsMan.GenStrID(Self.PropertyData.GUID, AStringsMan.FPropertyGUIDStrings); tSQL_Properties.FieldByName(fnIDDataType).AsInteger := Self.PropertyData.IDDataType; tSQL_Properties.FieldByName(fnName).AsString := Self.PropertyData.Name; tSQL_Properties.FieldByName(fnSysName).AsString := Self.PropertyData.SysName; tSQL_Properties.FieldByName(fnIzm).AsString := Self.PropertyData.Izm; tSQL_Properties.FieldByName(fnValueReq).AsInteger := Self.PropertyData.ValueReq; tSQL_Properties.FieldByName(fnMinValue).AsFloat := Self.PropertyData.MinValue; tSQL_Properties.FieldByName(fnMaxValue).AsFloat := Self.PropertyData.MaxValue; tSQL_Properties.FieldByName(fnDefValue).AsString := Self.PropertyData.DefValue; tSQL_Properties.FieldByName(fnDescription).AsString := Self.PropertyData.Description; tSQL_Properties.FieldByName(fnIsStandart).AsInteger := Self.PropertyData.IsStandart; tSQL_Properties.FieldByName(fnSortID).AsInteger := Self.PropertyData.SortID; tSQL_Properties.FieldByName(fnISProject).AsInteger := Self.PropertyData.ISProject; tSQL_Properties.FieldByName(fnISFolder).AsInteger := Self.PropertyData.ISFolder; tSQL_Properties.FieldByName(fnISList).AsInteger := Self.PropertyData.ISList; tSQL_Properties.FieldByName(fnISRoom).AsInteger := Self.PropertyData.ISRoom; tSQL_Properties.FieldByName(fnISSCSLine).AsInteger := Self.PropertyData.ISSCSLine; tSQL_Properties.FieldByName(fnISSCSConnector).AsInteger := Self.PropertyData.ISSCSConnector; tSQL_Properties.FieldByName(fnISComponLine).AsInteger := Self.PropertyData.ISComponLine; tSQL_Properties.FieldByName(fnISComponConn).AsInteger := Self.PropertyData.ISComponConn; tSQL_Properties.FieldByName(fnIsForWholeComponent).AsInteger := Self.PropertyData.IsForWholeComponent; tSQL_Properties.FieldByName(fnIsValueRelToObj).AsInteger := Self.PropertyData.IsValueRelToObj; tSQL_Properties.FieldByName(fnPropValRelCount).AsInteger := Self.PropValRelCount; tSQL_Properties.Post; end; end; end; procedure TNBProperty.Save(AMakeEdit: TMakeEdit); begin TF_Main(FActiveForm).DM.SaveProperty(AMakeEdit, @PropertyData); end; { TNBPropValRel } function TNBPropValRel.AddPropValNormRes(APropValNormRes: TNBPropValNormRes): Integer; begin APropValNormRes.FOwner := Self; Result := FPropValNormResList.Add(APropValNormRes); end; procedure TNBPropValRel.Assign(APropValRel: TNBPropValRel); begin AssignOnlyPropValRel(APropValRel); AssignPropValNormRes(APropValRel.FPropValNormResList); end; procedure TNBPropValRel.AssignOnlyPropValRel(APropValRel: TNBPropValRel); begin ID := APropValRel.ID; GUID := APropValRel.GUID; IDProperty := APropValRel.IDProperty; GuidProperty := APropValRel.GuidProperty; PValue := APropValRel.PValue; MinValue := APropValRel.MinValue; MaxValue := APropValRel.MaxValue; end; procedure TNBPropValRel.AssignPropValNormRes(APropValNormResList: TSCSObjectList); var i: Integer; PropValNormRes: TNBPropValNormRes; begin FPropValNormResList.Clear; for i := 0 to APropValNormResList.Count - 1 do begin PropValNormRes := TNBPropValNormRes.Create(FActiveForm); PropValNormRes.Assign(TNBPropValNormRes(APropValNormResList[i])); AddPropValNormRes(PropValNormRes); end; end; procedure TNBPropValRel.Clear; begin ID := 0; GUID := ''; IDProperty := 0; GuidProperty := ''; PValue := ''; MinValue := ''; MaxValue := ''; PropValNormResCount := 0; FOwner := nil; IsModified := false; FPropValNormResList.Clear; end; constructor TNBPropValRel.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); FPropValNormResList := TSCSObjectList.Create(true); Clear; end; destructor TNBPropValRel.Destroy; begin Clear; FreeAndNil(FPropValNormResList); inherited; end; procedure TNBPropValRel.Save(AMakeEdit: TMakeEdit); var PropValRelData: TPropValRelData; begin ZeroMemory(@PropValRelData, SizeOf(TPropValRelData)); PropValRelData.ID := ID; PropValRelData.GUID := GUID; PropValRelData.IDProperty := IDProperty; PropValRelData.GuidProperty := GuidProperty; PropValRelData.PValue := PValue; PropValRelData.MinValue := MinValue; PropValRelData.MinValue := MinValue; TF_Main(FActiveForm).DM.SavePropValRel(AMakeEdit, @PropValRelData); if AMakeEdit = meMake then ID := PropValRelData.ID; end; procedure TNBPropValRel.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_PropValRel.FieldByName(fnGUID).AsString; Self.GuidProperty := tSQL_PropValRel.FieldByName(fnGuidProperty).AsString; Self.PValue := tSQL_PropValRel.FieldByName(fnPValue).AsString; Self.MinValue := tSQL_PropValRel.FieldByName(fnMinValue).AsString; Self.MaxValue := tSQL_PropValRel.FieldByName(fnMaxValue).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_PropValRel.FieldByName(fnGUID).AsInteger, AStringsMan.FPropValRelGUIDStrings); Self.GuidProperty := AStringsMan.GetStrByID(tSQL_PropValRel.FieldByName(fnGuidProperty).AsInteger, AStringsMan.FPropertyGUIDStrings); Self.PValue := AStringsMan.GetStrByID(tSQL_PropValRel.FieldByName(fnPValue).AsInteger, AStringsMan.FPropertyValueStrings); Self.MinValue := AStringsMan.GetStrByID(tSQL_PropValRel.FieldByName(fnMinValue).AsInteger, AStringsMan.FPropertyValueStrings); Self.MaxValue := AStringsMan.GetStrByID(tSQL_PropValRel.FieldByName(fnMaxValue).AsInteger, AStringsMan.FPropertyValueStrings); end; Self.ID := tSQL_PropValRel.FieldByName(fnID).AsInteger; Self.IDProperty := tSQL_PropValRel.FieldByName(fnIDProperty).AsInteger; Self.PropValNormResCount := tSQL_PropValRel.FieldByName(fnPropValNormResCount).AsInteger; end; end; procedure TNBPropValRel.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_PropValRel.Append; meEdit: if tSQL_PropValRel.Locate(fnGUID, Self.GUID, []) then tSQL_PropValRel.Edit; end; if tSQL_PropValRel.State <> dsBrowse then begin {if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin tSQL_PropValRel.FieldByName(fnGUID).AsString := Self.GUID; tSQL_PropValRel.FieldByName(fnGuidProperty).AsString := Self.GuidProperty; tSQL_PropValRel.FieldByName(fnPValue).AsString := Self.PValue; tSQL_PropValRel.FieldByName(fnMinValue).AsString := Self.MinValue; tSQL_PropValRel.FieldByName(fnMaxValue).AsString := Self.MaxValue; end else begin tSQL_PropValRel.FieldByName(fnGUID).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FPropValRelGUIDStrings); tSQL_PropValRel.FieldByName(fnGuidProperty).AsInteger := AStringsMan.GenStrID(Self.GuidProperty, AStringsMan.FPropertyGUIDStrings); tSQL_PropValRel.FieldByName(fnPValue).AsInteger := AStringsMan.GenStrID(Self.PValue, AStringsMan.FPropertyValueStrings); tSQL_PropValRel.FieldByName(fnMinValue).AsInteger := AStringsMan.GenStrID(Self.MinValue, AStringsMan.FPropertyValueStrings); tSQL_PropValRel.FieldByName(fnMaxValue).AsInteger := AStringsMan.GenStrID(Self.MaxValue, AStringsMan.FPropertyValueStrings); end;} tSQL_PropValRel.FieldByName(fnGUID).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FPropValRelGUIDStrings); tSQL_PropValRel.FieldByName(fnGuidProperty).AsInteger := AStringsMan.GenStrID(Self.GuidProperty, AStringsMan.FPropertyGUIDStrings); tSQL_PropValRel.FieldByName(fnPValue).AsInteger := AStringsMan.GenStrID(Self.PValue, AStringsMan.FPropertyValueStrings); tSQL_PropValRel.FieldByName(fnMinValue).AsInteger := AStringsMan.GenStrID(Self.MinValue, AStringsMan.FPropertyValueStrings); tSQL_PropValRel.FieldByName(fnMaxValue).AsInteger := AStringsMan.GenStrID(Self.MaxValue, AStringsMan.FPropertyValueStrings); tSQL_PropValRel.FieldByName(fnID).AsInteger := Self.ID; tSQL_PropValRel.FieldByName(fnIDProperty).AsInteger := Self.IDProperty; tSQL_PropValRel.FieldByName(fnPropValNormResCount).AsInteger := Self.PropValNormResCount; tSQL_PropValRel.Post; end; end; end; { TNBPropValNormRes } procedure TNBPropValNormRes.Assign(APropValNormRes: TNBPropValNormRes); begin ID := APropValNormRes.ID; GUID := APropValNormRes.GUID; IDPropValRel := APropValNormRes.IDPropValRel; GuidPropValRel := APropValNormRes.GuidPropValRel; IDNBComponent := APropValNormRes.IDNBComponent; GuidNBComponent := APropValNormRes.GuidNBComponent; IDNBRes := APropValNormRes.IDNBRes; GuidNBRes := APropValNormRes.GuidNBRes; IDNBNorm := APropValNormRes.IDNBNorm; GuidNBNorm := APropValNormRes.GuidNBNorm; Kolvo := APropValNormRes.Kolvo; ExpenseForLength := APropValNormRes.ExpenseForLength; CountForPoint := APropValNormRes.CountForPoint; StepOfPoint := APropValNormRes.StepOfPoint; end; procedure TNBPropValNormRes.Clear; begin ID := 0; GUID := ''; IDPropValRel := 0; GuidPropValRel := ''; IDNBComponent := 0; GuidNBComponent := ''; IDNBRes := 0; GuidNBRes := ''; IDNBNorm := 0; GuidNBNorm := ''; Kolvo := 0; ExpenseForLength := 0; CountForPoint := 0; StepOfPoint := 0; FOwner := nil; IsModified := false; end; constructor TNBPropValNormRes.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBPropValNormRes.Destroy; begin Clear; inherited; end; procedure TNBPropValNormRes.Save(AMakeEdit: TMakeEdit); var PropValNormResData: TPropValNormResData; begin ZeroMemory(@PropValNormResData, SizeOf(TPropValNormResData)); PropValNormResData.ID := ID; PropValNormResData.GUID := GUID; PropValNormResData.IDPropValRel := IDPropValRel; PropValNormResData.GuidPropValRel := GuidPropValRel; PropValNormResData.IDNBComponent := IDNBComponent; PropValNormResData.GuidNBComponent := GuidNBComponent; PropValNormResData.IDNBRes := IDNBRes; PropValNormResData.GuidNBRes := GuidNBRes; PropValNormResData.IDNBNorm := IDNBNorm; PropValNormResData.GuidNBNorm := GuidNBNorm; PropValNormResData.Kolvo := Kolvo; PropValNormResData.ExpenseForLength := ExpenseForLength; PropValNormResData.CountForPoint := CountForPoint; PropValNormResData.StepOfPoint := StepOfPoint; TF_Main(FActiveForm).DM.SavePropValNormRes(AMakeEdit, @PropValNormResData); if AMakeEdit = meMake then ID := PropValNormResData.ID; end; procedure TNBPropValNormRes.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GuidPropValRel := tSQL_PropValNormRes.FieldByName(fnGuidPropValRel).AsString; Self.GuidNBComponent := tSQL_PropValNormRes.FieldByName(fnGuidNBComponent).AsString; Self.GuidNBRes := tSQL_PropValNormRes.FieldByName(fnGuidNBRES).AsString; Self.GuidNBNorm := tSQL_PropValNormRes.FieldByName(fnGuidNBNorm).AsString; end else begin Self.GuidPropValRel := AStringsMan.GetStrByID(tSQL_PropValNormRes.FieldByName(fnGuidPropValRel).AsInteger, AStringsMan.FPropValRelGUIDStrings); Self.GuidNBComponent := AStringsMan.GetStrByID(tSQL_PropValNormRes.FieldByName(fnGuidNBComponent).AsInteger, AStringsMan.FComponGuidNBStrings); Self.GuidNBRes := AStringsMan.GetStrByID(tSQL_PropValNormRes.FieldByName(fnGuidNBRES).AsInteger, AStringsMan.FResourceRelGuidNBStrings); Self.GuidNBNorm := AStringsMan.GetStrByID(tSQL_PropValNormRes.FieldByName(fnGuidNBNorm).AsInteger, AStringsMan.FNormGuidNBStrings); end; Self.ID := tSQL_PropValNormRes.FieldByName(fnID).AsInteger; Self.GUID := tSQL_PropValNormRes.FieldByName(fnGUID).AsString; Self.IDPropValRel := tSQL_PropValNormRes.FieldByName(fnIDPropValRel).AsInteger; Self.IDNBComponent := tSQL_PropValNormRes.FieldByName(fnIDNBComponent).AsInteger; Self.IDNBRes := tSQL_PropValNormRes.FieldByName(fnIDNBRES).AsInteger; Self.IDNBNorm := tSQL_PropValNormRes.FieldByName(fnIDNBNorm).AsInteger; Self.Kolvo := tSQL_PropValNormRes.FieldByName(fnKolvo).AsFloat; Self.ExpenseForLength := tSQL_PropValNormRes.FieldByName(fnExpenseForLength).AsFloat; Self.CountForPoint := tSQL_PropValNormRes.FieldByName(fnCountForPoint).AsFloat; Self.StepOfPoint := tSQL_PropValNormRes.FieldByName(fnStepOfPoint).AsFloat; end; end; procedure TNBPropValNormRes.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_PropValNormRes.Append; meEdit: if tSQL_PropValNormRes.Locate(fnGUID, Self.GUID, []) then tSQL_PropValNormRes.Edit; end; if tSQL_PropValNormRes.State <> dsBrowse then begin {if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin tSQL_PropValNormRes.FieldByName(fnGuidPropValRel).AsString := Self.GuidPropValRel; tSQL_PropValNormRes.FieldByName(fnGuidNBComponent).AsString := Self.GuidNBComponent; tSQL_PropValNormRes.FieldByName(fnGuidNBRES).AsString := Self.GuidNBRes; tSQL_PropValNormRes.FieldByName(fnGuidNBNorm).AsString := Self.GuidNBNorm; end else begin tSQL_PropValNormRes.FieldByName(fnGuidPropValRel).AsInteger := AStringsMan.GenStrID(Self.GuidPropValRel, AStringsMan.FPropValRelGUIDStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBComponent).AsInteger := AStringsMan.GenStrID(Self.GuidNBComponent, AStringsMan.FComponGuidNBStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBRES).AsInteger := AStringsMan.GenStrID(Self.GuidNBRes, AStringsMan.FResourceRelGuidNBStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBNorm).AsInteger := AStringsMan.GenStrID(Self.GuidNBNorm, AStringsMan.FNormGuidNBStrings); end;} tSQL_PropValNormRes.FieldByName(fnGuidPropValRel).AsInteger := AStringsMan.GenStrID(Self.GuidPropValRel, AStringsMan.FPropValRelGUIDStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBComponent).AsInteger := AStringsMan.GenStrID(Self.GuidNBComponent, AStringsMan.FComponGuidNBStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBRES).AsInteger := AStringsMan.GenStrID(Self.GuidNBRes, AStringsMan.FResourceRelGuidNBStrings); tSQL_PropValNormRes.FieldByName(fnGuidNBNorm).AsInteger := AStringsMan.GenStrID(Self.GuidNBNorm, AStringsMan.FNormGuidNBStrings); tSQL_PropValNormRes.FieldByName(fnID).AsInteger := Self.ID; tSQL_PropValNormRes.FieldByName(fnGUID).AsString := Self.GUID; tSQL_PropValNormRes.FieldByName(fnIDPropValRel).AsInteger := Self.IDPropValRel; tSQL_PropValNormRes.FieldByName(fnIDNBComponent).AsInteger := Self.IDNBComponent; tSQL_PropValNormRes.FieldByName(fnIDNBRES).AsInteger := Self.IDNBRes; tSQL_PropValNormRes.FieldByName(fnIDNBNorm).AsInteger := Self.IDNBNorm; tSQL_PropValNormRes.FieldByName(fnKolvo).AsFloat := Self.Kolvo; tSQL_PropValNormRes.FieldByName(fnExpenseForLength).AsFloat := Self.ExpenseForLength; tSQL_PropValNormRes.FieldByName(fnCountForPoint).AsFloat := Self.CountForPoint; tSQL_PropValNormRes.FieldByName(fnStepOfPoint).AsFloat := Self.StepOfPoint; tSQL_PropValNormRes.Post; end; end; end; { TNBResource } procedure TNBResource.Assign(AResource: TNBResource); begin ID := AResource.ID; GUID := AResource.GUID; Cypher := AResource.Cypher; Name := AResource.Name; Izm := AResource.Izm; Price := AResource.Price; RType := AResource.RType; end; procedure TNBResource.Clear; begin ID := 0; GUID := ''; Cypher := ''; Name := ''; Izm := ''; Price := 0; RType := 0; IsModified := false; IsApplyDataForAllSame := false; end; constructor TNBResource.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBResource.Destroy; begin Clear; inherited; end; procedure TNBResource.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GUID := tSQL_NBResources.FieldByName(fnGuid).AsString; Self.Cypher := tSQL_NBResources.FieldByName(fnCypher).AsString; Self.Name := tSQL_NBResources.FieldByName(fnName).AsString; Self.Izm := tSQL_NBResources.FieldByName(fnIzm).AsString; end else begin Self.GUID := AStringsMan.GetStrByID(tSQL_NBResources.FieldByName(fnGuid).AsInteger, AStringsMan.FResourceRelGuidNBStrings); Self.Cypher := AStringsMan.GetStrByID(tSQL_NBResources.FieldByName(fnCypher).AsInteger, AStringsMan.FResourceRelCypherStrings); Self.Name := AStringsMan.GetStrByID(tSQL_NBResources.FieldByName(fnName).AsInteger, AStringsMan.FResourceRelNameStrings); Self.Izm := AStringsMan.GetStrByID(tSQL_NBResources.FieldByName(fnIzm).AsInteger, AStringsMan.FIzmStrings); end; Self.ID := tSQL_NBResources.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_NBResources.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_NBResources.FieldByName(fnIDItemType).AsInteger; Self.Price := tSQL_NBResources.FieldByName(fnPrice).AsFloat; Self.RType := tSQL_NBResources.FieldByName(fnRType).AsInteger; end; end; procedure TNBResource.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_NBResources.Append; meEdit: if tSQL_NBResources.Locate(fnID, ID, []) then tSQL_NBResources.Edit; end; if tSQL_NBResources.State <> dsBrowse then begin tSQL_NBResources.FieldByName(fnID).AsInteger := Self.ID; tSQL_NBResources.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_NBResources.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_NBResources.FieldByName(fnGuid).AsInteger := AStringsMan.GenStrID(Self.GUID, AStringsMan.FResourceRelGuidNBStrings); tSQL_NBResources.FieldByName(fnCypher).AsInteger := AStringsMan.GenStrID(Self.Cypher, AStringsMan.FResourceRelCypherStrings); tSQL_NBResources.FieldByName(fnName).AsInteger := AStringsMan.GenStrID(Self.Name, AStringsMan.FResourceRelNameStrings); tSQL_NBResources.FieldByName(fnIzm).AsInteger := AStringsMan.GenStrID(Self.Izm, AStringsMan.FIzmStrings); tSQL_NBResources.FieldByName(fnPrice).AsFloat := Self.Price; tSQL_NBResources.FieldByName(fnRType).AsInteger := Self.RType; tSQL_NBResources.Post; end; end; end; procedure TNBResource.Save(AMakeEdit: TMakeEdit); var ResourceInfo: TResourceInfo; begin ZeroMemory(@ResourceInfo, SizeOf(TResourceInfo)); ResourceInfo.ID := ID; ResourceInfo.GUID := GUID; ResourceInfo.Cypher := Cypher; ResourceInfo.Name := Name; ResourceInfo.Izm := Izm; ResourceInfo.Price := Price; ResourceInfo.RType := RType; TF_Main(FActiveForm).DM.SaveResource(AMakeEdit, @ResourceInfo); if AMakeEdit = meMake then ID := ResourceInfo.ID; end; { TNBSuppliesKind } procedure TNBSuppliesKind.Assign(ASuppliesKind: TNBSuppliesKind); begin Data := ASuppliesKind.Data; end; procedure TNBSuppliesKind.Clear; begin ZeroMemory(@Data, SizeOf(TSuppliesKind)); IsModified := false; end; constructor TNBSuppliesKind.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); Clear; end; destructor TNBSuppliesKind.Destroy; begin Clear; inherited; end; procedure TNBSuppliesKind.LoadFromMemTable(AStringsMan: TStringsMan); var NBSuppliesKind: TNBSuppliesKind; begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.Data.GUID := tSQL_SuppliesKinds.FieldByName(fnGUID).AsString; end else begin Self.Data.GUID := AStringsMan.GetStrByID(tSQL_SuppliesKinds.FieldByName(fnGUID).AsInteger, AStringsMan.FSuppliesKindGUIDStrings);; end; Self.Data.ID := tSQL_SuppliesKinds.FieldByName(fnID).AsInteger; Self.IDCatalog := tSQL_SuppliesKinds.FieldByName(fnIDCatalog).AsInteger; Self.CatalogItemType := tSQL_SuppliesKinds.FieldByName(fnIDItemType).AsInteger; Self.Data.Name := tSQL_SuppliesKinds.FieldByName(fnName).AsString; Self.Data.Izm := tSQL_SuppliesKinds.FieldByName(fnIzm).AsString; Self.Data.UnitKolvo := tSQL_SuppliesKinds.FieldByName(fnUnitKolvo).AsFloat; if tSQL_SuppliesKinds.FieldDefs.IndexOf(fnNameTradUOM) <> -1 then begin Self.Data.NameTradUOM := tSQL_SuppliesKinds.FieldByName(fnNameTradUOM).AsString; Self.Data.IzmTradUOM := tSQL_SuppliesKinds.FieldByName(fnIzmTradUOM).AsString; Self.Data.UnitKolvoTradUOM := tSQL_SuppliesKinds.FieldByName(fnUnitKolvoTradUOM).AsFloat; end else begin NBSuppliesKind := TF_Main(FActiveForm).FNormBase.GSCSBase.NBSpravochnik.GetSuppliesKindByGUID(Self.Data.GUID); if NBSuppliesKind <> nil then begin Self.Data.NameTradUOM := NBSuppliesKind.Data.NameTradUOM; Self.Data.IzmTradUOM := NBSuppliesKind.Data.IzmTradUOM; Self.Data.UnitKolvoTradUOM := NBSuppliesKind.Data.UnitKolvoTradUOM; end; end; end; end; procedure TNBSuppliesKind.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_SuppliesKinds.Append; meEdit: if tSQL_SuppliesKinds.Locate(fnID, Self.Data.ID, []) then tSQL_SuppliesKinds.Edit; end; if tSQL_SuppliesKinds.State <> dsBrowse then begin tSQL_SuppliesKinds.FieldByName(fnID).AsInteger := Self.Data.ID; tSQL_SuppliesKinds.FieldByName(fnIDCatalog).AsInteger := Self.IDCatalog; tSQL_SuppliesKinds.FieldByName(fnIDItemType).AsInteger := Self.CatalogItemType; tSQL_SuppliesKinds.FieldByName(fnGUID).AsInteger := AStringsMan.GenStrID(Self.Data.GUID, AStringsMan.FSuppliesKindGUIDStrings); tSQL_SuppliesKinds.FieldByName(fnName).AsString := Self.Data.Name; tSQL_SuppliesKinds.FieldByName(fnNameTradUOM).AsString := Self.Data.NameTradUOM; tSQL_SuppliesKinds.FieldByName(fnIzm).AsString := Self.Data.Izm; tSQL_SuppliesKinds.FieldByName(fnIzmTradUOM).AsString := Self.Data.IzmTradUOM; tSQL_SuppliesKinds.FieldByName(fnUnitKolvo).AsFloat := Self.Data.UnitKolvo; tSQL_SuppliesKinds.FieldByName(fnUnitKolvoTradUOM).AsFloat := Self.Data.UnitKolvoTradUOM; tSQL_SuppliesKinds.Post; end; end; end; procedure TNBSuppliesKind.Save(AMakeEdit: TMakeEdit); begin TF_Main(FActiveForm).DM.SaveSuppliesKind(AMakeEdit, @Data); end; { TMemBase } procedure TMemBase.CloseAllTables; var CurrTable: TSQLMemTable; i: Integer; begin if FMemBaseMode = mbmSQLMemTable then with TF_Main(FCatalog.ActiveForm).DM do begin for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Active then begin CurrTable.Close; end; end; FMemBaseActive := false; end; end; constructor TMemBase.Create(ACatalogOwner: TSCSCatalogExtended); var DefMasSize: Integer; begin inherited Create; FCatalog := ACatalogOwner; //FLoaded := false; FOwnedStreams := TObjectList.Create(true); FMemBaseMode := mbmSQLMemTable; FDirName := ''; DefMasSize := 300; FBuffList := TObjectList.Create(true); FCatalogBuff := CreateBuffer(DefMasSize, SizeOf(TCatalogData), 'bcat', 'bcat.blb'); FCatRelBuff := CreateBuffer(DefMasSize, SizeOf(TCatalogRelationData), 'bcatrel'); FCatalogPropsBuff := CreateBuffer(DefMasSize, SizeOf(TCatalogPropData), 'bcatp'); FComponBuff := CreateBuffer(DefMasSize, SizeOf(TComponData), 'bcompon'); FComponPropsBuff := CreateBuffer(DefMasSize, SizeOf(TComponPropData), 'bcompp'); FCompRelBuff := CreateBuffer(DefMasSize, SizeOf(TCompRelData), 'bcomprel'); FConnectedComponsBuff := CreateBuffer(DefMasSize, SizeOf(TConnectedComponsData), 'bconndci'); FCableCanalConnectorBuff := CreateBuffer(DefMasSize, SizeOf(TCableCanalConnectorData), 'bcabchnconn'); FInterfRelBuff := CreateBuffer(DefMasSize, SizeOf(TInterfRelData), 'binterfrel'); FIOfIRelBuff := CreateBuffer(DefMasSize, SizeOf(TIOfIRelData), 'biofirel'); FInterfPosConnectionData := CreateBuffer(DefMasSize, SizeOf(TInterfPosConnectionData), 'biposconn'); FNormBuff := CreateBuffer(DefMasSize, SizeOf(TNormData), 'bnorm'); FObjectsBlobsBuff := CreateBuffer(DefMasSize, SizeOf(TObjectBlobData), 'bobjectsblobs', 'bobjectsblobs.blb'); FPortInterfRelBuff := CreateBuffer(DefMasSize, SizeOf(TPortInterfRelData), 'bportirel'); FResourceRelBuff := CreateBuffer(DefMasSize, SizeOf(TResourceRelData), 'bresrel'); FStringsManBuff := CreateBuffer(DefMasSize, SizeOf(TStringsManData), 'bstrman'); FSprCurrencyBuff := CreateBuffer(DefMasSize, SizeOf(TCurrencyData), 'bsprcurr'); FSprCompTypeBuff := CreateBuffer(DefMasSize, SizeOf(TComponentTypeData), 'bsprcomptype'); FSprCompTypePropBuff := CreateBuffer(DefMasSize, SizeOf(TComponTypePropData), 'bsprcomptypep'); FSprInterfaceBuff := CreateBuffer(DefMasSize, SizeOf(TInterfaceData), 'bsprinterf'); FSprInterfAccordanceBuff := CreateBuffer(DefMasSize, SizeOf(TInterfaceAccordanceData), 'bsprinterfacc'); FSprInterfNormBuff := CreateBuffer(DefMasSize, SizeOf(TInterfaceNormData), 'bsprinterfnorm'); FSprNetTypeBuff := CreateBuffer(DefMasSize, SizeOf(TNetTypeData), 'bsprnettype'); FSprNormBuff := CreateBuffer(DefMasSize, SizeOf(TNBNormData), 'bsprnorm'); FSprObjectIconBuff := CreateBuffer(DefMasSize, SizeOf(TObjectIconData), 'bsprobjicon', 'bsprobjicon.blb'); FSprProducerBuff := CreateBuffer(DefMasSize, SizeOf(TProducerData), 'bsprproduc'); FSprPropertyBuff := CreateBuffer(DefMasSize, SizeOf(TPropertyBuffData), 'bsprprop'); FSprPropValRelBuff := CreateBuffer(DefMasSize, SizeOf(TPropValRelBuffData), 'bsprpropvalrel'); FSprPropValNormResBuff := CreateBuffer(DefMasSize, SizeOf(TPropValNormResBuffData), 'bsprpropvalnormres'); FSprResourceBuff := CreateBuffer(DefMasSize, SizeOf(TResourceData), 'bsprres'); FSprSuppliesKindBuff := CreateBuffer(DefMasSize, SizeOf(TSuppliesKindData), 'bsprsuppkind'); end; procedure TMemBase.CreateAllTables; var SQLScript: String; begin if FMemBaseMode = mbmSQLMemTable then with TF_Main(FCatalog.ActiveForm).DM do begin //qSQLMQuery.GetCurrentRecordID. qSQL_QueryTSCSOperat.Close; SQLScript := ''; if Not tSQL_Katalog.Exists then SQLScript := SQLScript + 'CREATE TABLE KATALOG (ID INTEGER, '+ 'PARENT_ID INTEGER, '+ //'PROJECT_ID INTEGER, '+ 'LIST_ID INTEGER, '+ 'NAME INTEGER, '+ 'NAME_SHORT INTEGER, '+ 'NAME_MARK VARCHAR(200), '+ 'ISUSER_NAME INTEGER, '+ 'SORT_ID INTEGER DEFAULT 0, '+ 'KOL_COMPON INTEGER DEFAULT 0, '+ 'ITEMS_COUNT INTEGER DEFAULT 0, '+ 'PROPS_COUNT INTEGER DEFAULT 0, '+ 'NORMS_COUNT INTEGER DEFAULT 0, '+ 'RESOURCES_COUNT INTEGER DEFAULT 0, '+ 'ID_ITEM_TYPE INTEGER, '+ 'MARK_ID INTEGER, '+ 'SCS_ID INTEGER, '+ fnIsIndexWithName +' '+ scelInteger+', '+ 'INDEX_CONN INTEGER DEFAULT 0, '+ 'INDEX_LINE INTEGER DEFAULT 0, '+ 'INDEX_JOINER INTEGER DEFAULT 0, '+ 'SETTINGS BLOB, '+ 'COMPTYPE_MARK_MASKS BLOB,'+ 'CAD_BLOCK BLOB,'+ fnCAD3D+' BLOB,'+ 'PM_BLOCK BLOB); '; if Not tSQL_CatalogPropRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE CATALOG_PROP_RELATION ( '+ 'ID INTEGER, '+ 'ID_CATALOG INTEGER, '+ 'ID_PROPERTY INTEGER, '+ 'GUID_PROPERTY INTEGER, '+ 'PVALUE INTEGER, '+ 'ISDEFAULT INTEGER, '+ 'SORT_ID INTEGER ); '; if Not tSQL_CatalogRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE CATALOG_RELATION ( '+ 'ID_CATALOG INTEGER, '+ 'ID_COMPONENT INTEGER); '; if Not tSQL_Component.Exists then SQLScript := SQLScript + 'CREATE TABLE COMPONENT ( '+ 'ID INTEGER, '+ 'GUID_NB INTEGER, '+ 'NAME INTEGER, '+ 'NAME_SHORT INTEGER, '+ 'NAME_MARK VARCHAR(200), '+ 'MARK_ID INTEGER, '+ //'MARK_Str VARCHAR(50), '+ 'CYPHER INTEGER, '+ 'IZM INTEGER, '+ 'NOTICE INTEGER, '+ 'DESCRIPTION BLOB, '+ 'ISUSER_MARK INTEGER DEFAULT 0, '+ fnIsMarkInCaptions+' SMALLINT DEFAULT 0, '+ 'PICTURE BLOB, '+ 'COLOR INTEGER, '+ 'ISLINE SMALLINT DEFAULT 1, '+ 'ISCOMPLECT SMALLINT DEFAULT 1, '+ fnIsTemplate+' '+scelSmallInt+snCommaS+ 'PRICE_SUPPLY FLOAT DEFAULT 0, '+ 'PRICE FLOAT DEFAULT 0, '+ 'PRICE_CALC FLOAT DEFAULT 0, '+ 'USER_LENGTH FLOAT DEFAULT 0, '+ 'MAX_LENGTH FLOAT, '+ 'HASNDS SMALLINT DEFAULT 1, '+ 'ID_COMPONENT_TYPE INTEGER, '+ 'ID_SYMBOL INTEGER, '+ 'ID_OBJECT_ICON INTEGER, '+ 'ID_PRODUCER INTEGER, '+ 'ID_SUPPLIES_KIND INTEGER, '+ 'ID_SUPPLIER INTEGER, '+ 'ID_NET_TYPE INTEGER, '+ 'GUID_COMPONENT_TYPE INTEGER, '+ 'GUID_SYMBOL INTEGER, '+ 'GUID_OBJECT_ICON INTEGER, '+ 'GUID_PRODUCER INTEGER, '+ 'GUID_SUPPLIES_KIND INTEGER, '+ 'GUID_SUPPLIER INTEGER, '+ 'GUID_NET_TYPE INTEGER, '+ 'OBJECT_ICON_STEP FLOAT DEFAULT 0, '+ 'ID_CURRENCY INTEGER, '+ 'ARTICUL_DISTRIBUTOR INTEGER, '+ 'ARTICUL_PRODUCER INTEGER, '+ 'SORT_ID INTEGER DEFAULT 0, '+ 'WHOLE_ID INTEGER DEFAULT 0 NOT NULL, '+ 'ISDISMOUNT INTEGER DEFAULT 0, '+ 'ISUSEDISMOUNTED INTEGER DEFAULT 0, '+ fnUseKindInProj+' INTEGER DEFAULT 0, '+ 'KOL_COMPLECT INTEGER DEFAULT 0, '+ 'CABLE_CANAL_CONNECTORS_CNT INTEGER DEFAULT 0, '+ 'INTERF_COUNT INTEGER DEFAULT 0, '+ 'JOINS_COUNT INTEGER DEFAULT 0, '+ 'NORMS_COUNT INTEGER DEFAULT 0, '+ 'PROPS_COUNT INTEGER DEFAULT 0, '+ 'RESOURCES_COUNT INTEGER DEFAULT 0, '+ 'ID_NORMBASE INTEGER, '+ 'OBJECT_ID INTEGER, '+ 'LIST_ID INTEGER DEFAULT 0, '+ fnIDRelatedCompon+' INTEGER DEFAULT 0,'+ fnComeFrom+' INTEGER'+ '); '; //' PROJECT_ID INTEGER ); '+ if Not tSQL_ComponentRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE COMPONENT_RELATION ( '+ 'ID INTEGER, '+ 'ID_COMPONENT INTEGER, '+ 'ID_CHILD INTEGER, '+ 'KOLVO INTEGER, '+ 'SORT_ID INTEGER, '+ 'CONNECT_TYPE INTEGER, '+ 'REL_TYPE SMALLINT DEFAULT 0, '+ 'FIXED SMALLINT DEFAULT 0); '; if Not tSQL_CompPropRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE COMP_PROP_RELATION ( '+ 'ID INTEGER, '+ 'ID_COMPONENT INTEGER, '+ 'ID_PROPERTY INTEGER, '+ 'GUID_PROPERTY INTEGER, '+ 'PVALUE INTEGER, '+ 'ISDEFAULT INTEGER, '+ 'SORT_ID INTEGER, '+ 'TAKE_INTO_JOIN INTEGER DEFAULT 0, '+ 'TAKE_INTO_CONNECT INTEGER DEFAULT 0, '+ 'ISTAKE_JOIN_FOR_POINTS INTEGER DEFAULT 0, '+ 'ISCROSS_CONTROL INTEGER DEFAULT 0, '+ 'ID_CROSS_PROPERTY INTEGER DEFAULT 0, '+ 'GUID_CROSS_PROPERTY INTEGER); '; if Not tSQL_CableCanalConnectors.Exists then SQLScript := SQLScript + 'CREATE TABLE CABLE_CANAL_CONNECTORS ( '+ 'ID INTEGER, '+ 'ID_COMPONENT INTEGER, '+ 'ID_NB_CONNECTOR INTEGER, '+ 'GUID_NB_CONNECTOR INTEGER, '+ 'CONNECTOR_TYPE INTEGER); '; if Not tSQL_ConnectedComponents.Exists then SQLScript := SQLScript + 'CREATE TABLE CONNECTED_COMPONENTS ( '+ 'ID INTEGER, '+ 'COMPON_WHOLE_ID INTEGER DEFAULT 0, '+ 'ID_CONNECT_OBJECT INTEGER DEFAULT 0, '+ 'ID_CONNECT_COMPON INTEGER, '+ 'ID_SIDE_COMPON INTEGER, '+ 'TYPE_CONNECT INTEGER ); '; if Not tSQL_InterfaceRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE INTERFACE_RELATION ( '+ 'ID INTEGER, '+ 'ID_COMPONENT INTEGER, '+ 'ID_INTERFACE INTEGER, '+ 'GUID_INTERFACE INTEGER, '+ 'NPP INTEGER DEFAULT 0, '+ 'TYPEI SMALLINT DEFAULT 1, '+ 'KIND INTEGER, '+ 'ISPORT INTEGER DEFAULT 0, '+ 'ISUSER_PORT INTEGER DEFAULT 0, '+ 'NPP_PORT INTEGER, '+ 'ID_CONNECTED INTEGER DEFAULT 0, '+ 'GENDER INTEGER DEFAULT 0, '+ 'MULTIPLE INTEGER DEFAULT 0, '+ 'ISBUSY INTEGER, '+ 'VALUEI FLOAT, '+ 'COORDZ FLOAT DEFAULT 0, '+ 'SORT_ID INTEGER DEFAULT 0, '+ 'NUM_PAIR INTEGER DEFAULT 0, '+ 'COLOR INTEGER DEFAULT 0, '+ 'ID_ADVERSE INTEGER, '+ 'SIDE INTEGER, '+ 'NOTICE INTEGER, '+ 'KOLVO INTEGER DEFAULT 0, '+ 'KOLVO_BUSY INTEGER DEFAULT 0, '+ 'SIGN_TYPE INTEGER DEFAULT 0, '+ fnConnToAnyGender+ ' SMALLINT, '+ fnSideSection+' INTEGER, '+ 'IOFI_REL_COUNT INTEGER DEFAULT 0, '+ 'PORT_INTERF_REL_COUNT INTEGER DEFAULT 0); '; if Not tSQL_InterfOfInterfRelation.Exists then SQLScript := SQLScript + 'CREATE TABLE INTERFOFINTERF_RELATION ( '+ 'ID INTEGER, '+ 'ID_INTERF_REL INTEGER, '+ 'ID_INTERF_TO INTEGER, '+ 'ID_COMP_REL INTEGER, '+ fnIDIOfIRelMain+' INTEGER, '+ 'CON_POSITION INTEGER, '+ 'CONNECT_KIND INTEGER, '+ fnPosConnectionsCount+' '+scelInteger+' ); '; if Not tSQL_Norms.Exists then SQLScript := SQLScript + 'CREATE TABLE NORMS ( '+ 'ID INTEGER, '+ 'ID_NB INTEGER, '+ 'GUID_NB INTEGER, '+ 'ID_MASTER INTEGER, '+ fnIDCompPropRel+' '+scelInteger+', '+ 'TABLE_KIND INTEGER, '+ 'NPP INTEGER, '+ 'ISON INTEGER DEFAULT 1, '+ 'KOLVO FLOAT DEFAULT 1, '+ 'TOTAL_COST FLOAT, '+ 'CYPHER INTEGER, '+ 'NAME INTEGER, '+ 'WORK_KIND INTEGER, '+ 'IZM INTEGER, '+ 'ZARPLAT FLOAT, '+ //29.10.2013 fnLaborTime+' '+scelInteger+', '+ fnPricePerTime+' '+scelFloat+', '+ 'PRICE FLOAT, '+ 'COST FLOAT, '+ 'ISFROM_INTERFACE INTEGER, '+ fnExpenseForLength + ' FLOAT, '+ fnCountForPoint + ' FLOAT, '+ fnStepOfPoint + ' FLOAT '+ '); '; if Not tSQL_NormResourceRel.Exists then SQLScript := SQLScript + 'CREATE TABLE NORM_RESOURCE_REL ( '+ 'ID INTEGER, '+ 'ID_MASTER INTEGER, '+ 'TABLE_KIND INTEGER DEFAULT 0, '+ 'NPP INTEGER, '+ 'ID_RESOURCE INTEGER, '+ fnIDCompPropRel+' '+scelInteger+', '+ 'KOLVO FLOAT, '+ 'ISON INTEGER DEFAULT 1, '+ 'COST FLOAT, '+ 'RVALUE FLOAT, '+ fnExpenseForLength + ' FLOAT, '+ fnGuidNBComponent + ' INTEGER, '+ fnCountForPoint + ' FLOAT, '+ fnStepOfPoint + ' FLOAT '+ '); '; if Not tSQL_Resources.Exists then SQLScript := SQLScript + 'CREATE TABLE RESOURCES ( '+ 'ID INTEGER, '+ 'ID_NB INTEGER DEFAULT 0, '+ 'GUID_NB INTEGER, '+ 'TABLE_KIND_NB INTEGER DEFAULT 0, '+ 'CYPHER INTEGER, '+ 'NAME INTEGER, '+ 'IZM INTEGER, '+ 'PRICE FLOAT, '+ 'ADDITIONAL_PRICE FLOAT, '+ 'RTYPE INTEGER ); '+ GetScriptForCreatePortInterfaceRelation + GetScriptForCreateInterfPosConnection + GetScriptForCreateObjectsBlobs + GetScriptForCreateSpravochniks + GetScriptForCreateCADObjects+ GetScriptForCreateStringsMan+ GetScriptForCreateFilters; if SQLScript <> '' then begin qSQL_QueryTSCSOperat.SQL.Text := SQLScript; try //qSQL_QueryTSCSOperat.Open; qSQL_QueryTSCSOperat.ExecSQL; except on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end; end; FMemBaseLoaded := true; end; //07.01.2014 //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(fnWorkersAmount, ftInteger); // tSQL_NormsComplete.FieldDefs.Add(fnStartDate, ftDate); // tSQL_NormsComplete.FieldDefs.Add(fnEndDate, ftDate); // end; // tSQL_NormsComplete.CreateTable; //end; CreateSQLMemTableByTagIdx(tiNormsComplete); end; end; procedure TMemBase.DeleteAllIndexes; var CurrTable: TSQLMemTable; i, j: Integer; HaveNoPrimaryIndex: Boolean; begin with TF_Main(FCatalog.ActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); //CurrTable.DeleteAllIndexes; HaveNoPrimaryIndex := true; while HaveNoPrimaryIndex do begin HaveNoPrimaryIndex := false; for j := 0 to CurrTable.IndexDefs.Count - 1 do if Not(ixPrimary in CurrTable.IndexDefs[j].Options) then begin HaveNoPrimaryIndex := true; CurrTable.IndexDefs.Delete(j); Break; ///// BREAK ///// end; end; end; end; procedure TMemBase.DeleteAllTables; var CurrTable: TSQLMemTable; i, j: Integer; tempstr: string; tempstrs: TStringList; TableNames: TStringList; timecount: integer; TablesToDelete: TSQLMemTable; SQLMemBase: TSQLMemDatabase; // begin try if FMemBaseMode = mbmSQLMemTable then begin //DeleteAllIndexes; with TF_Main(FCatalog.ActiveForm).DM do begin //if tSQL_Katalog.Exists then // tSQL_Katalog.DeleteTable(true); {for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists then begin //CurrTable.DeleteAllIndexes; //CurrTable.DeleteTable(true); CurrTable.DeleteTable(false); //CurrTable.rem end; end;} TablesToDelete := nil; (* for i := SQLMemTsbles.Count - 1 downto 0 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); try if CurrTable.Exists then begin if CurrTable.TableName = 'COMPONENT_RELATION' then begin //qSQL_QueryTSCSOperat.SQL.Text := ' ALTER TABLE COMPONENT_RELATION DROP FOREIGN KEY FK_COMPONENT_RELATION; '; //try // qSQL_QueryTSCSOperat.Open; // qSQL_QueryTSCSOperat.Close; //except // on E: Exception do ShowMessage(E.Message); //end; end; if CurrTable.TableName = 'INTERFACE_RELATION' then begin CurrTable.DeleteAllIndexes; CurrTable.ForeignKeyDefs.Clear; end; if CurrTable.TableName = 'PORT_INTERFACE_RELATION' then begin CurrTable.DeleteAllIndexes; //qSQL_QueryTSCSOperat.SQL.Text := ' ALTER TABLE PORT_INTERFACE_RELATION DROP CONSTRAINT FK_PORTINTERF_RELATION; '; //try // qSQL_QueryTSCSOperat.Open; // qSQL_QueryTSCSOperat.Close; //except // on E: Exception do ShowMessage(E.Message); //end; CurrTable.ForeignKeyDefs.Clear; CurrTable.DeleteTable(true); end; try CurrTable.DeleteTable(False); except CurrTable.DeleteAllIndexes; CurrTable.ForeignKeyDefs.Clear; CurrTable.DeleteTable(false); end; end; except on E: Exception do ShowMessage(E.Message); end; end; *) for i := SQLMemTsbles.Count - 1 downto 0 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists then begin //CurrTable.DeleteAllIndexes; //CurrTable.DeleteTable(true); //CurrTable.Close; if CurrTable.Tag = tiKatalog then //CurrTable. //CloseDatabase(CurrTable.Database); tempstr := CurrTable.TableName; //CurrTable.Database.TableExists(tnCatalog); try timecount := 0; while CurrTable.Exists do begin CurrTable.DeleteTable(False); if CurrTable.Exists then begin //CurrTable.SaveTableToFile('c:\bug.smt'); //RepairLog := ''; //CurrTable.RepairTable(RepairLog, true); //CurrTable.RestructureTable; TableNames := TStringList.Create; CurrTable.GetTableNames(TableNames); for j := 0 to TableNames.Count - 1 do begin if TableNames[j] = CurrTable.TableName then CurrTable.DeleteTable(False); if Not CurrTable.Exists then Break; //// BREAK //// end; FreeAndNil(TableNames); end; timecount := timecount + 1; if timecount > 20 then break; end; except end; if CurrTable.Exists then begin TablesToDelete := CurrTable; CurrTable.Open; try if CurrTable.RecordCount > 0 then begin try CurrTable.Last; while Not CurrTable.Bof do CurrTable.Delete; except end; end; finally CurrTable.Close; end; //qSQL_QueryTSCSOperat.SQL.Text := 'DROP TABLE '+CurrTable.TableName+' RESTRICT'; //try // qSQL_QueryTSCSOperat.Open; // qSQL_QueryTSCSOperat.Close; //except //end; // try // CurrTable.RenameTable(tempstr + DateTimeToStr(now)); // except // end; end; end; end; {if TablesToDelete <> nil then begin SQLMemBase := TablesToDelete.OpenDatabase; //tempstrs := TStringList.Create; //tempstrs.Text := SQLMemBase.ExportDatabaseToSQL; //tempstrs.SaveToFile('c:\sqldb.sql'); //FreeAndNil(tempstrs); SQLMemBase.FlushFileBuffers; TablesToDelete.CloseDatabase(SQLMemBase); TablesToDelete.DeleteTable; end;} FMemBaseLoaded := false; //*** Пересоздать объекты if FMemBaseCreated then begin FreeSQLMemTables; CreateSQLMemTables; end; end; end; except on E: Exception do AddExceptionToLogEx('TMemBase.DeleteAllTables', E.Message); end; end; destructor TMemBase.Destroy; begin FreeAndNil(FBuffList); FreeAndNil(FOwnedStreams); inherited; end; procedure TMemBase.EmptyAllTables; begin CloseAllTables; DeleteAllTables; CreateAllTables; end; function TMemBase.AppendStreamToBuff(ABuff: TTableBufferInfo; AStream: TStream; AOwnedStream: Boolean): Integer; var StreamSize: Integer; //Stream: TMemoryStream; begin Result := -1; StreamSize := AStream.Size; if StreamSize > 0 then if ABuff.FStreamList <> nil then begin //Stream := TMemoryStream.Create; //Stream.CopyFrom(AStream, 0); ABuff.FStreamListLastID := ABuff.FStreamListLastID + 1; ABuff.FStreamList.Add(AStream, ABuff.FStreamListLastID); Result := ABuff.FStreamListLastID; end; if AOwnedStream then FOwnedStreams.Add(AStream); end; function TMemBase.CreateBuffer(AMaxRecCount, ARecSize: Integer; AFName: String; AFNameStreams: String): TTableBufferInfo; begin Result := TTableBufferInfo.Create; // Tolik 08/05/2019 -- Result.FBuffer := Nil; // Result.FName := AFName; Result.FNameStreams := AFNameStreams; Result.MaxRecCount := AMaxRecCount; Result.RecSize := ARecSize; Result.FFileStream := nil; Result.FStreamList := nil; Result.FStreamListLastID := 0; Result.BuffCount := 0; Result.RemainsRecCount := 0; FBuffList.Add(Result); end; procedure TMemBase.CloseBuffer(ABuff: TTableBufferInfo); begin if ABuff.FBuffer <> nil then FreeMem(ABuff.FBuffer); ABuff.FBuffer := nil; ABuff.RecCount := 0; if Assigned(ABuff.FFileStream) then FreeAndNil(ABuff.FFileStream); if Assigned(ABuff.FStreamList) then FreeAndNil(ABuff.FStreamList); end; procedure TMemBase.CloseBuffers; var i: integer; begin for i := 0 to FBuffList.Count - 1 do CloseBuffer(TTableBufferInfo(FBuffList[i])); end; procedure TMemBase.GetStreamFromBuff(ABuff: TTableBufferInfo; AStreamCode: Integer; AStream: TStream); var Stream: TStream; i: Integer; begin if AStreamCode <> -1 then if ABuff.FStreamList <> nil then begin for i := ABuff.FStreamList.StreamsCodes.Count - 1 downto 0 do //if Integer(ABuff.FStreamList.StreamsCodes.FItems.List^[i]) = AStreamCode then if ABuff.FStreamList.StreamsCodes[i] = AStreamCode then begin // Копируем данные Stream := TStream(ABuff.FStreamList.Streams[i]); if Stream <> nil then begin AStream.Position := 0; AStream.CopyFrom(Stream, 0); AStream.Position := 0; end; // Удаляем элемент из списка ABuff.FStreamList.StreamsCodes.Delete(i); ABuff.FStreamList.Streams.Delete(i); Break; //// BREAK //// end; end; end; function TMemBase.OpenBuffer(ABuff: TTableBufferInfo; AMode: Word): Boolean; var FilePath: String; StreamSize: Integer; //ProcName: String; begin Result := true; //ProcName := 'TMemBase.OpenBuffer'; GetMem(ABuff.FBuffer, ABuff.RecSize*ABuff.MaxRecCount); ABuff.RecCount := 0; FilePath := FDirName+'\'+ABuff.FName; if AMode = fmCreate then begin if FileExists(ABuff.FName) then if Not DeleteFile(ABuff.FName) then Result := false; if Result then begin ABuff.FFileStream := TFileStream.Create(FilePath, AMode); if ABuff.FNameStreams <> '' then ABuff.FStreamList := TStreamList.Create(0, false); // параметр=false потому, что суда будут запихаться стримы объектов Result := FileExists(FilePath); end; end else if AMode = fmOpenRead then begin ABuff.FFileStream := SafeOpenFileStream(FilePath, AMode, 'TMemBase.OpenBuffer'); if ABuff.FFileStream <> nil then begin StreamSize := ABuff.FFileStream.Size; ABuff.BuffCount := StreamSize div (ABuff.MaxRecCount * ABuff.RecSize); // Остаток оставшихся записей ABuff.RemainsRecCount := 0; if (StreamSize - (ABuff.BuffCount * ABuff.MaxRecCount * ABuff.RecSize)) > 0 then ABuff.RemainsRecCount := (StreamSize-(ABuff.BuffCount * ABuff.MaxRecCount * ABuff.RecSize)) div ABuff.RecSize; // Открываем связанный список стримов if ABuff.FNameStreams <> '' then begin ABuff.FStreamList := TStreamList.Create(0, true); // параметр=true потому, что суда будут запихаться стримы созданные внутри объекта при чтении ABuff.FStreamList.LoadFromFile(FDirName+'\'+ABuff.FNameStreams); ABuff.FStreamList.RotateList; end; end else begin Result := false; end; end; if Not Result then Inc(FFileAccesFailCount); end; procedure TMemBase.OpenBuffers(AMode: Word); var i: integer; begin for i := 0 to FBuffList.Count - 1 do OpenBuffer(TTableBufferInfo(FBuffList[i]), AMode); end; procedure TMemBase.LoadBuffFromFile(ABuff: TTableBufferInfo); begin ABuff.FFileStream.ReadBuffer(ABuff.FBuffer^, ABuff.MaxRecCount * ABuff.RecSize); end; procedure TMemBase.LoadCatalogs(ACatalogs: TSCSCatalogs); var i, j: Integer; CatalogData: TCatalogData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SCSList: TSCSList; SCSCatalog: TSCSCatalog; Stream: TMemoryStream; begin if CatalogData.ItemType = itList then begin SCSList := TSCSList.Create(FCatalog.FActiveForm); SCSList.ID := CatalogData.ID; SCSList.ParentID := CatalogData.ParentID; SCSList.Name := FCatalog.FStringsMan.GetStrByID(CatalogData.Name, FCatalog.FStringsMan.FCataogNameStrings); SCSList.SortID := CatalogData.SortID; SCSList.KolCompon := CatalogData.KolCompon; SCSList.ItemsCount := CatalogData.ItemsCount; //07.11.2013 //SCSCatalog.PropsCount := CatalogData.PropsCount; //SCSCatalog.NormsCount := CatalogData.NormsCount; //SCSCatalog.ResourcesCount := CatalogData.ResourcesCount; //20.05.2014 SCSList.PropsCount := CatalogData.PropsCount; SCSList.NormsCount := CatalogData.NormsCount; SCSList.ResourcesCount := CatalogData.ResourcesCount; SCSList.ListID := CatalogData.ListID; SCSList.NameShort := FCatalog.FStringsMan.GetStrByID(CatalogData.NameShort, FCatalog.FStringsMan.FCataogNameShortStrings); SCSList.NameMark := CatalogData.NameMark; SCSList.IsUserName := CatalogData.IsUserName; SCSList.MarkID := CatalogData.MarkID; SCSList.ItemType := CatalogData.ItemType; SCSList.SCSID := CatalogData.ScsID; SCSList.IsIndexWithName := CatalogData.IsIndexWithName; SCSList.IndexPointObj := CatalogData.IndexPointObj; SCSList.IndexLine := CatalogData.IndexLine; SCSList.IndexConnector := CatalogData.IndexConnector; GetStreamFromBuff(BuffInfo, CatalogData.ListSetting, SCSList.FSettingStream); SCSList.FSettingStream.Position := 0; SCSList.FSettingStream.ReadBuffer(SCSList.Setting, SizeOf(SCSList.Setting)); ACatalogs.Add(SCSList); end else begin SCSCatalog := TSCSCatalog.Create(FCatalog.FActiveForm); SCSCatalog.ID := CatalogData.ID; SCSCatalog.ParentID := CatalogData.ParentID; SCSCatalog.Name := FCatalog.FStringsMan.GetStrByID(CatalogData.Name, FCatalog.StringsMan.FCataogNameStrings); SCSCatalog.SortID := CatalogData.SortID; SCSCatalog.KolCompon := CatalogData.KolCompon; SCSCatalog.ItemsCount := CatalogData.ItemsCount; SCSCatalog.PropsCount := CatalogData.PropsCount; //07.11.2013 SCSCatalog.NormsCount := CatalogData.NormsCount; SCSCatalog.ResourcesCount := CatalogData.ResourcesCount; SCSCatalog.ListID := CatalogData.ListID; SCSCatalog.NameShort := FCatalog.FStringsMan.GetStrByID(CatalogData.NameShort, FCatalog.FStringsMan.FCataogNameShortStrings); SCSCatalog.NameMark := CatalogData.NameMark; SCSCatalog.IsUserName := CatalogData.IsUserName; SCSCatalog.MarkID := CatalogData.MarkID; SCSCatalog.ItemType := CatalogData.ItemType; SCSCatalog.SCSID := CatalogData.ScsID; SCSCatalog.IsIndexWithName := CatalogData.IsIndexWithName; SCSCatalog.IndexPointObj := CatalogData.IndexPointObj; SCSCatalog.IndexLine := CatalogData.IndexLine; SCSCatalog.IndexConnector := CatalogData.IndexConnector; if SCSCatalog.ItemType = itRoom then begin SCSCatalog.CreateRoomSetting; Stream := TMemoryStream.Create; Stream.LoadFromFile(FDirName+'\'+CatalogData.RoomSetting); Stream.Position := 0; Stream.ReadBuffer(SCSCatalog.FRoomSetting^, SizeOf(TRoomSettingRecord)); FreeAndNil(Stream); end; ACatalogs.Add(SCSCatalog); end; end; begin try BuffInfo := FCatalogBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin CatalogData := TCatalogData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(CatalogData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCatalogs', E.Message); end; end; procedure TMemBase.LoadCatRels(ACatRels: TList); var i, j: Integer; CatalogRelationData: TCatalogRelationData; procedure LoadToList; var ptrCatRel: PCatalogRelation; begin GetMem(ptrCatRel, SizeOf(TCatalogRelation)); ptrCatRel.IDCatalog := CatalogRelationData.IDCatalog; ptrCatRel.IDComponent := CatalogRelationData.IDComponent; ACatRels.Add(ptrCatRel); end; begin try CloseBuffer(FCatRelBuff); OpenBuffer(FCatRelBuff, fmOpenRead); for i := 0 to FCatRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FCatRelBuff); for j := 0 to FCatRelBuff.MaxRecCount - 1 do begin CatalogRelationData := TCatalogRelationData(Pointer(Integer(FCatRelBuff.FBuffer) + (j*FCatRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FCatRelBuff.RemainsRecCount - 1 do begin FCatRelBuff.FFileStream.ReadBuffer(CatalogRelationData, FCatRelBuff.RecSize); LoadToList; end; CloseBuffer(FCatRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCatRels', E.Message); end; end; procedure TMemBase.LoadCatalogProps(AProps: TList); var i, j: Integer; CatalogPropData: TCatalogPropData; procedure LoadToList; var ptrProperty: PProperty; begin New(ptrProperty); ZeroMemory(ptrProperty, SizeOf(TProperty)); ptrProperty.Value := FCatalog.FStringsMan.GetStrByID(CatalogPropData.Value, FCatalog.FStringsMan.PropertyValueStrings); ptrProperty.GUIDProperty := FCatalog.FStringsMan.GetStrByID(CatalogPropData.GUIDProperty, FCatalog.FStringsMan.PropertyGUIDStrings); ptrProperty.ID := CatalogPropData.ID; ptrProperty.IDMaster := CatalogPropData.IDCatalog; ptrProperty.ID_Property := CatalogPropData.IDProperty; ptrProperty.IsDefault := CatalogPropData.IsDefault; AProps.Add(ptrProperty); end; begin try CloseBuffer(FCatalogPropsBuff); OpenBuffer(FCatalogPropsBuff, fmOpenRead); for i := 0 to FCatalogPropsBuff.BuffCount - 1 do begin //FCatalogPropsBuff.FFileStream.ReadBuffer(FCatalogPropsBuff.FBuffer^, FCatalogPropsBuff.MaxRecCount * FCatalogPropsBuff.RecSize); LoadBuffFromFile(FCatalogPropsBuff); for j := 0 to FCatalogPropsBuff.MaxRecCount - 1 do begin CatalogPropData := TCatalogPropData(Pointer(Integer(FCatalogPropsBuff.FBuffer) + (j*FCatalogPropsBuff.RecSize))^); LoadToList; end; end; for i := 0 to FCatalogPropsBuff.RemainsRecCount - 1 do begin FCatalogPropsBuff.FFileStream.ReadBuffer(CatalogPropData, FCatalogPropsBuff.RecSize); LoadToList; end; CloseBuffer(FCatalogPropsBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCatalogProps', E.Message); end; end; procedure TMemBase.LoadCompons(ACompons: TSCSComponents); var i, j: Integer; ComponData: TComponData; procedure LoadToList; var SCSCompon: TSCSComponent; begin SCSCompon := TSCSComponent.Create(FCatalog.FActiveForm); SCSCompon.ID := ComponData.ID; SCSCompon.GuidNB := FCatalog.FStringsMan.GetStrByID(ComponData.GuidNB, FCatalog.FStringsMan.FComponGuidNBStrings); SCSCompon.NAME := FCatalog.FStringsMan.GetStrByID(ComponData.Name, FCatalog.FStringsMan.FComponNameStrings); SCSCompon.NameShort := FCatalog.FStringsMan.GetStrByID(ComponData.NameShort, FCatalog.FStringsMan.FComponNameShortStrings); SCSCompon.Cypher := FCatalog.FStringsMan.GetStrByID(ComponData.Cypher, FCatalog.FStringsMan.FComponCypherStrings); SCSCompon.Izm := FCatalog.FStringsMan.GetStrByID(ComponData.Izm, FCatalog.FStringsMan.FIzmStrings); SCSCompon.Notice := FCatalog.FStringsMan.GetStrByID(ComponData.Notice, FCatalog.FStringsMan.ComponNoticeStrings); if ComponData.Description <> '' then begin SCSCompon.Description.LoadFromFile(FDirName+'\'+ComponData.Description); SCSCompon.Description.Position := 0; end; if ComponData.Picture <> '' then begin SCSCompon.Picture.LoadFromFile(FDirName+'\'+ComponData.Picture); SCSCompon.Picture.Position := 0; end; SCSCompon.Color := ComponData.Color; SCSCompon.IsLine := ComponData.IsLine; SCSCompon.ISComplect := ComponData.ISComplect; SCSCompon.PriceSupply := ComponData.PriceSupply; SCSCompon.PRICE := ComponData.PRICE; SCSCompon.PRICE_CALC := ComponData.PriceCalc; SCSCompon.UserLength := ComponData.UserLength; SCSCompon.MaxLength := ComponData.MaxLength; SCSCompon.HASNDS := ComponData.HASNDS; SCSCompon.ArticulDistributor := FCatalog.FStringsMan.GetStrByID(ComponData.ArticulDistributor, FCatalog.FStringsMan.FComponArticulStrings); SCSCompon.ArticulProducer := FCatalog.FStringsMan.GetStrByID(ComponData.ArticulProducer, FCatalog.FStringsMan.FComponArticulStrings); SCSCompon.ID_ComponentType := ComponData.IDComponentType; SCSCompon.IDSymbol := ComponData.IDSymbol; SCSCompon.IDObjectIcon := ComponData.IDObjectIcon; SCSCompon.ObjectIconStep := ComponData.ObjectIconStep; SCSCompon.ID_Producer := ComponData.IDProducer; SCSCompon.ID_CURRENCY := ComponData.IDCurrency; SCSCompon.IDSuppliesKind := ComponData.IDSuppliesKind; SCSCompon.ID_SUPPLIER := ComponData.IDSupplier; SCSCompon.IDNetType := ComponData.IDNetType; SCSCompon.SortID := ComponData.SortID; SCSCompon.KolComplect := ComponData.KolComplect; SCSCompon.CableCanalConnectorsCnt := ComponData.CableCanalConnectorsCnt; SCSCompon.InterfCount := ComponData.InterfCount; SCSCompon.JoinsCount := ComponData.JoinsCount; SCSCompon.NormsCount := ComponData.NormsCount; SCSCompon.PropsCount := ComponData.PropsCount; SCSCompon.ResourcesCount := ComponData.ResourcesCount; SCSCompon.IDNormBase := ComponData.IDNormbase; SCSCompon.ObjectID := ComponData.ObjectID; SCSCompon.ListID := ComponData.ListID; SCSCompon.IDRelatedCompon := ComponData.IDRelatedCompon; SCSCompon.Whole_ID := ComponData.WholeID; SCSCompon.IsDismount := ComponData.IsDismount; SCSCompon.IsUseDismounted := ComponData.IsUseDismounted; SCSCompon.UseKindInProj := ComponData.UseKindInProj; SCSCompon.NameMark := ComponData.NameMark; SCSCompon.MarkID := ComponData.MarkID; SCSCompon.IsUserMark := ComponData.IsUserMark; SCSCompon.IsMarkInCaptions := ComponData.IsMarkInCaptions; SCSCompon.ComeFrom := ComponData.ComeFrom; SCSCompon.IsTemplate := ComponData.IsTemplate; SCSCompon.GUIDComponentType := FCatalog.FStringsMan.GetStrByID(ComponData.GuidComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); SCSCompon.GUIDSymbol := FCatalog.FStringsMan.GetStrByID(ComponData.GuidSymbol, FCatalog.FStringsMan.FObjectIconGUIDStrings); SCSCompon.GUIDObjectIcon := FCatalog.FStringsMan.GetStrByID(ComponData.GuidObjectIcon, FCatalog.FStringsMan.FObjectIconGUIDStrings); SCSCompon.GUIDProducer := FCatalog.FStringsMan.GetStrByID(ComponData.GuidProducer, FCatalog.FStringsMan.FProducerGUIDStrings); SCSCompon.GUIDSuppliesKind := FCatalog.FStringsMan.GetStrByID(ComponData.GuidSuppliesKind, FCatalog.FStringsMan.FSuppliesKindGUIDStrings); SCSCompon.GUIDSupplier := FCatalog.FStringsMan.GetStrByID(ComponData.GuidSupplier, FCatalog.FStringsMan.FSupplierGUIDStrings); SCSCompon.GUIDNetType := FCatalog.FStringsMan.GetStrByID(ComponData.GuidNetType, FCatalog.FStringsMan.FNetTypeGUIDStrings); ACompons.Add(SCSCompon); end; begin try CloseBuffer(FComponBuff); OpenBuffer(FComponBuff, fmOpenRead); for i := 0 to FComponBuff.BuffCount - 1 do begin LoadBuffFromFile(FComponBuff); for j := 0 to FComponBuff.MaxRecCount - 1 do begin ComponData := TComponData(Pointer(Integer(FComponBuff.FBuffer) + (j*FComponBuff.RecSize))^); LoadToList; end; end; for i := 0 to FComponBuff.RemainsRecCount - 1 do begin FComponBuff.FFileStream.ReadBuffer(ComponData, FComponBuff.RecSize); LoadToList; end; CloseBuffer(FComponBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCompons', E.Message); end; end; procedure TMemBase.LoadComponProps(AProps: TList); var i, j: Integer; ComponPropData: TComponPropData; procedure LoadToList; var ptrProperty: PProperty; begin New(ptrProperty); ZeroMemory(ptrProperty, SizeOf(TProperty)); ptrProperty.Value := FCatalog.FStringsMan.GetStrByID(ComponPropData.Value, FCatalog.FStringsMan.PropertyValueStrings); ptrProperty.GUIDProperty := FCatalog.FStringsMan.GetStrByID(ComponPropData.GUIDProperty, FCatalog.FStringsMan.PropertyGUIDStrings); ptrProperty.GUIDCrossProperty := FCatalog.FStringsMan.GetStrByID(ComponPropData.GUIDCrossProperty , FCatalog.FStringsMan.PropertyGUIDStrings); ptrProperty.ID := ComponPropData.ID; ptrProperty.IDMaster := ComponPropData.IDComponent; ptrProperty.ID_Property := ComponPropData.IDProperty; ptrProperty.TakeIntoConnect := ComponPropData.TakeIntoConnect; ptrProperty.TakeIntoJoin := ComponPropData.TakeIntoJoin; ptrProperty.IsTakeJoinforPoint := ComponPropData.IsTakeJoinforPoint; ptrProperty.IsCrossControl := ComponPropData.IsCrossControl; ptrProperty.IDCrossProperty := ComponPropData.IDCrossProperty; AProps.Add(ptrProperty); end; begin try CloseBuffer(FComponPropsBuff); OpenBuffer(FComponPropsBuff, fmOpenRead); for i := 0 to FComponPropsBuff.BuffCount - 1 do begin //FComponPropsBuff.FFileStream.ReadBuffer(FComponPropsBuff.FBuffer^, FComponPropsBuff.MaxRecCount * FComponPropsBuff.RecSize); LoadBuffFromFile(FComponPropsBuff); for j := 0 to FComponPropsBuff.MaxRecCount - 1 do begin ComponPropData := TComponPropData(Pointer(Integer(FComponPropsBuff.FBuffer) + (j*FComponPropsBuff.RecSize))^); LoadToList; end; end; for i := 0 to FComponPropsBuff.RemainsRecCount - 1 do begin FComponPropsBuff.FFileStream.ReadBuffer(ComponPropData, FComponPropsBuff.RecSize); LoadToList; end; CloseBuffer(FComponPropsBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCatalogProps', E.Message); end; end; procedure TMemBase.LoadCompRels(AComplects, AConnections: TList); var i, j: Integer; CompRelData: TCompRelData; procedure LoadToList; var ptrCompRel: PComplect; begin GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := CompRelData.ID; ptrCompRel.ID_Component := CompRelData.IDComponent; ptrCompRel.ID_Child := CompRelData.IDChild; ptrCompRel.Kolvo := CompRelData.Kolvo; ptrCompRel.ConnectType := CompRelData.ConnectType; ptrCompRel.RelType := CompRelData.RelType; ptrCompRel.Fixed := CompRelData.Fixed; ptrCompRel.SortID := CompRelData.SortID; case ptrCompRel.ConnectType of cntComplect: AComplects.Add(ptrCompRel); cntUnion: AConnections.Add(ptrCompRel); end; end; begin try CloseBuffer(FCompRelBuff); OpenBuffer(FCompRelBuff, fmOpenRead); for i := 0 to FCompRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FCompRelBuff); for j := 0 to FCompRelBuff.MaxRecCount - 1 do begin CompRelData := TCompRelData(Pointer(Integer(FCompRelBuff.FBuffer) + (j*FCompRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FCompRelBuff.RemainsRecCount - 1 do begin FCompRelBuff.FFileStream.ReadBuffer(CompRelData, FCompRelBuff.RecSize); LoadToList; end; CloseBuffer(FCompRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCompRels', E.Message); end; end; procedure TMemBase.LoadConnectedComponsInfo(AConnectedComponsList: TConnectedComponsList); var i, j: Integer; ConnectedComponsData: TConnectedComponsData; procedure LoadToList; var ConnectedComponsInfo: TConnectedComponsInfo; begin ZeroMemory(@ConnectedComponsInfo, SizeOf(TConnectedComponsInfo)); ConnectedComponsInfo.ID := ConnectedComponsData.ID; ConnectedComponsInfo.ComponWholeID := ConnectedComponsData.ComponWholeID; ConnectedComponsInfo.IDConnectObject := ConnectedComponsData.IDConnectObject; ConnectedComponsInfo.IDConnectCompon := ConnectedComponsData.IDConnectCompon; ConnectedComponsInfo.IDSideCompon := ConnectedComponsData.IDSideCompon; ConnectedComponsInfo.TypeConnect := ConnectedComponsData.TypeConnect; AConnectedComponsList.Add(ConnectedComponsInfo); end; begin try CloseBuffer(FConnectedComponsBuff); OpenBuffer(FConnectedComponsBuff, fmOpenRead); for i := 0 to FConnectedComponsBuff.BuffCount - 1 do begin LoadBuffFromFile(FConnectedComponsBuff); for j := 0 to FConnectedComponsBuff.MaxRecCount - 1 do begin ConnectedComponsData := TConnectedComponsData(Pointer(Integer(FConnectedComponsBuff.FBuffer) + (j*FConnectedComponsBuff.RecSize))^); LoadToList; end; end; for i := 0 to FConnectedComponsBuff.RemainsRecCount - 1 do begin FConnectedComponsBuff.FFileStream.ReadBuffer(ConnectedComponsData, FConnectedComponsBuff.RecSize); LoadToList; end; CloseBuffer(FConnectedComponsBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadConnectedComponsInfo', E.Message); end; end; procedure TMemBase.LoadCableCanalConnectors(ACableCanalConnectors: TList); var i, j: Integer; CableCanalConnectorData: TCableCanalConnectorData; procedure LoadToList; var ptrCableCanalConnector: PCableCanalConnector; begin GetMem(ptrCableCanalConnector, SizeOf(TCableCanalConnector)); ptrCableCanalConnector.ID := CableCanalConnectorData.ID; ptrCableCanalConnector.IDCableCanal := CableCanalConnectorData.IDCableCanal; ptrCableCanalConnector.IDNBConnector := CableCanalConnectorData.IDNBConnector; ptrCableCanalConnector.GuidNBConnector := FCatalog.FStringsMan.GetStrByID(CableCanalConnectorData.GuidNBConnector, FCatalog.FStringsMan.NBConnectorGuidStrings); ptrCableCanalConnector.ConnectorType := CableCanalConnectorData.ConnectorType; ACableCanalConnectors.Add(ptrCableCanalConnector); end; begin try CloseBuffer(FCableCanalConnectorBuff); OpenBuffer(FCableCanalConnectorBuff, fmOpenRead); for i := 0 to FCableCanalConnectorBuff.BuffCount - 1 do begin LoadBuffFromFile(FCableCanalConnectorBuff); for j := 0 to FCableCanalConnectorBuff.MaxRecCount - 1 do begin CableCanalConnectorData := TCableCanalConnectorData(Pointer(Integer(FCableCanalConnectorBuff.FBuffer) + (j*FCableCanalConnectorBuff.RecSize))^); LoadToList; end; end; for i := 0 to FCableCanalConnectorBuff.RemainsRecCount - 1 do begin FCableCanalConnectorBuff.FFileStream.ReadBuffer(CableCanalConnectorData, FCableCanalConnectorBuff.RecSize); LoadToList; end; CloseBuffer(FCableCanalConnectorBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadCableCanalConnectors', E.Message); end; end; procedure TMemBase.LoadInterfRels(AInterfRels: TSCSInterfaces); var i, j: Integer; InterfRelData: TInterfRelData; procedure LoadToList; var SCSInterfRel: TSCSInterface; begin SCSInterfRel := TSCSInterface.Create(FCatalog.FActiveForm); SCSInterfRel.ID := InterfRelData.ID; SCSInterfRel.Npp := InterfRelData.Npp; SCSInterfRel.ID_Interface := InterfRelData.IDInterface; SCSInterfRel.ID_Component := InterfRelData.IDComponent; SCSInterfRel.TypeI := InterfRelData.TypeI; SCSInterfRel.Kind := InterfRelData.Kind; SCSInterfRel.IsPort := InterfRelData.IsPort; SCSInterfRel.IsUserPort := InterfRelData.IsUserPort; SCSInterfRel.NppPort := InterfRelData.NppPort; SCSInterfRel.IDConnected := InterfRelData.IDConnected; SCSInterfRel.Gender := InterfRelData.Gender; SCSInterfRel.Multiple := InterfRelData.Multiple; SCSInterfRel.IsBusy := InterfRelData.IsBusy; SCSInterfRel.NumPair := InterfRelData.NumPair; SCSInterfRel.Color := InterfRelData.Color; SCSInterfRel.IDAdverse := InterfRelData.IDAdverse; SCSInterfRel.Side := InterfRelData.Side; SCSInterfRel.Notice := FCatalog.FStringsMan.GetStrByID(InterfRelData.Notice, FCatalog.FStringsMan.FInterfaceNoticeStrings); SCSInterfRel.Kolvo := InterfRelData.Kolvo; SCSInterfRel.KolvoBusy := InterfRelData.KolvoBusy; SCSInterfRel.SignType := InterfRelData.SignType; SCSInterfRel.ConnToAnyGender := InterfRelData.ConnToAnyGender; SCSInterfRel.SideSection := FCatalog.FStringsMan.GetStrByID(InterfRelData.SideSection, FCatalog.FStringsMan.FInterfaceSideSectionStrings); SCSInterfRel.GUIDInterface := FCatalog.FStringsMan.GetStrByID(InterfRelData.GUIDInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); SCSInterfRel.IOfIRelCount := InterfRelData.IOfIRelCount; SCSInterfRel.PortInterfRelCount := InterfRelData.PortInterfRelCount; SCSInterfRel.ValueI := InterfRelData.ValueI; SCSInterfRel.CoordZ := InterfRelData.CoordZ; AInterfRels.Add(SCSInterfRel); end; begin try CloseBuffer(FInterfRelBuff); OpenBuffer(FInterfRelBuff, fmOpenRead); for i := 0 to FInterfRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FInterfRelBuff); for j := 0 to FInterfRelBuff.MaxRecCount - 1 do begin InterfRelData := TInterfRelData(Pointer(Integer(FInterfRelBuff.FBuffer) + (j*FInterfRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FInterfRelBuff.RemainsRecCount - 1 do begin FInterfRelBuff.FFileStream.ReadBuffer(InterfRelData, FInterfRelBuff.RecSize); LoadToList; end; CloseBuffer(FInterfRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadInterfRels', E.Message); end; end; procedure TMemBase.LoadIOfIRels(AIOfIRels: TSCSObjectList); var i, j: Integer; IOfIRelData: TIOfIRelData; procedure LoadToList; var SCSIOfIRel: TSCSIOfIRel; begin SCSIOfIRel := TSCSIOfIRel.Create(nil); SCSIOfIRel.ID := IOfIRelData.ID; SCSIOfIRel.IDInterfRel := IOfIRelData.IDInterfRel; SCSIOfIRel.IDInterfTo := IOfIRelData.IDInterfTo; SCSIOfIRel.IDCompRel := IOfIRelData.IDCompRel; SCSIOfIRel.IDIOfIRelMain := IOfIRelData.IDIOfIRelMain; SCSIOfIRel.PosConnectionsCount := IOfIRelData.PosConnectionsCount; AIOfIRels.Add(SCSIOfIRel); end; begin try CloseBuffer(FIOfIRelBuff); OpenBuffer(FIOfIRelBuff, fmOpenRead); for i := 0 to FIOfIRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FIOfIRelBuff); for j := 0 to FIOfIRelBuff.MaxRecCount - 1 do begin IOfIRelData := TIOfIRelData(Pointer(Integer(FIOfIRelBuff.FBuffer) + (j*FIOfIRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FIOfIRelBuff.RemainsRecCount - 1 do begin FIOfIRelBuff.FFileStream.ReadBuffer(IOfIRelData, FIOfIRelBuff.RecSize); LoadToList; end; CloseBuffer(FIOfIRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadIOfIRels', E.Message); end; end; procedure TMemBase.LoadInterfPosConnections(AInterfPosConnections: TSCSObjectList); var i, j: Integer; InterfPosConnectionData: TInterfPosConnectionData; procedure LoadToList; var InterfPosConnection: TSCSInterfPosConnection; begin InterfPosConnection := TSCSInterfPosConnection.Create(nil, true); InterfPosConnection.ID := InterfPosConnectionData.ID; InterfPosConnection.IDIOIRel := InterfPosConnectionData.IDIOIRel; InterfPosConnection.SelfInterfPosition.FromPos := InterfPosConnectionData.SelfFromPos; InterfPosConnection.SelfInterfPosition.ToPos := InterfPosConnectionData.SelfToPos; InterfPosConnection.ConnInterfPosition.FromPos := InterfPosConnectionData.ConnFromPos; InterfPosConnection.ConnInterfPosition.ToPos := InterfPosConnectionData.ConnToPos; AInterfPosConnections.Add(InterfPosConnection); end; begin try CloseBuffer(FInterfPosConnectionData); OpenBuffer(FInterfPosConnectionData, fmOpenRead); for i := 0 to FInterfPosConnectionData.BuffCount - 1 do begin LoadBuffFromFile(FInterfPosConnectionData); for j := 0 to FInterfPosConnectionData.MaxRecCount - 1 do begin InterfPosConnectionData := TInterfPosConnectionData(Pointer(Integer(FInterfPosConnectionData.FBuffer) + (j*FInterfPosConnectionData.RecSize))^); LoadToList; end; end; for i := 0 to FInterfPosConnectionData.RemainsRecCount - 1 do begin FInterfPosConnectionData.FFileStream.ReadBuffer(InterfPosConnectionData, FInterfPosConnectionData.RecSize); LoadToList; end; CloseBuffer(FInterfPosConnectionData); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadInterfPosConnections', E.Message); end; end; procedure TMemBase.LoadPortInterfRels(APortInterfRels: TList); var i, j: Integer; PortInterfRelData: TPortInterfRelData; procedure LoadToList; var ptrPortInterfRel: PPortInterfRel; begin GetMem(ptrPortInterfRel, SizeOf(TPortInterfRel)); ptrPortInterfRel.ID := PortInterfRelData.ID; ptrPortInterfRel.RelType := PortInterfRelData.RelType; ptrPortInterfRel.IDPort := PortInterfRelData.IDPort; ptrPortInterfRel.IDInterfRel := PortInterfRelData.IDInterfRel; ptrPortInterfRel.UnitInterfKolvo := PortInterfRelData.UnitInterfKolvo; APortInterfRels.Add(ptrPortInterfRel); end; begin try CloseBuffer(FPortInterfRelBuff); OpenBuffer(FPortInterfRelBuff, fmOpenRead); for i := 0 to FPortInterfRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FPortInterfRelBuff); for j := 0 to FPortInterfRelBuff.MaxRecCount - 1 do begin PortInterfRelData := TPortInterfRelData(Pointer(Integer(FPortInterfRelBuff.FBuffer) + (j*FPortInterfRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FPortInterfRelBuff.RemainsRecCount - 1 do begin FPortInterfRelBuff.FFileStream.ReadBuffer(PortInterfRelData, FPortInterfRelBuff.RecSize); LoadToList; end; CloseBuffer(FPortInterfRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadPortInterfRels', E.Message); end; end; procedure TMemBase.LoadNorms(ANorms: TSCSNorms); var i, j: Integer; NormData: TNormData; procedure LoadToList; var SCSNorm: TSCSNorm; begin SCSNorm := TSCSNorm.Create(FCatalog.FActiveForm, ntProj); SCSNorm.ID := NormData.ID; SCSNorm.GuidNB := FCatalog.FStringsMan.GetStrByID(NormData.GuidNB, FCatalog.FStringsMan.FNormGuidNBStrings); SCSNorm.IDNB := NormData.IDNB; SCSNorm.Cypher := FCatalog.FStringsMan.GetStrByID(NormData.Cypher, FCatalog.FStringsMan.FNormCypherStrings); SCSNorm.MasterTableKind := NormData.MasterTableKind; SCSNorm.Name := FCatalog.FStringsMan.GetStrByID(NormData.Name, FCatalog.FStringsMan.FNormNameStrings); SCSNorm.WorkKind := FCatalog.FStringsMan.GetStrByID(NormData.WorkKind, FCatalog.FStringsMan.NormWorkKindStrings); SCSNorm.Izm_ := FCatalog.FStringsMan.GetStrByID(NormData.Izm, FCatalog.FStringsMan.FIzmStrings); SCSNorm.IDMaster := NormData.IDMaster; SCSNorm.IDCompPropRel := NormData.IDCompPropRel; SCSNorm.Npp := NormData.Npp; SCSNorm.IsOn := NormData.IsOn; SCSNorm.LaborTime := NormData.LaborTime; SCSNorm.PricePerTime := NormData.PricePerTime; SCSNorm.Price := NormData.Price; SCSNorm.Cost := NormData.Cost; SCSNorm.Kolvo := NormData.Kolvo; SCSNorm.TotalCost := NormData.TotalCost; SCSNorm.IsFromInterface := NormData.IsFromInterface; SCSNorm.ExpenseForLength := NormData.ExpenseForLength; SCSNorm.CountForPoint := NormData.CountForPoint; SCSNorm.StepOfPoint := NormData.StepOfPoint; //SCSNorm.ExpenseForSection := NormData.ExpenseForSection; ANorms.Add(SCSNorm); end; begin try CloseBuffer(FNormBuff); OpenBuffer(FNormBuff, fmOpenRead); for i := 0 to FNormBuff.BuffCount - 1 do begin LoadBuffFromFile(FNormBuff); for j := 0 to FNormBuff.MaxRecCount - 1 do begin NormData := TNormData(Pointer(Integer(FNormBuff.FBuffer) + (j*FNormBuff.RecSize))^); LoadToList; end; end; for i := 0 to FNormBuff.RemainsRecCount - 1 do begin FNormBuff.FFileStream.ReadBuffer(NormData, FNormBuff.RecSize); LoadToList; end; CloseBuffer(FNormBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadNorms', E.Message); end; end; procedure TMemBase.LoadObjectsBlobs(AObjectsBlobs: TObjectsBlobs); var i, j: Integer; ObjectBlobData: TObjectBlobData; BuffInfo: TTableBufferInfo; procedure LoadToList; var ObjectsBlob: TObjectsBlob; Stream: TMemoryStream; begin ObjectsBlob := TObjectsBlob.Create(FCatalog.FActiveForm); ObjectsBlob.ID := ObjectBlobData.ID; ObjectsBlob.TableKind := ObjectBlobData.TableKind; ObjectsBlob.DataKind := ObjectBlobData.DataKind; Stream := TMemoryStream.Create; GetStreamFromBuff(BuffInfo, ObjectBlobData.ObjIDs, Stream); ObjectsBlob.LoadObjIDsFromStream(Stream); Stream.Free; GetStreamFromBuff(BuffInfo, ObjectBlobData.ObjectData, ObjectsBlob.ObjectData); AObjectsBlobs.AddObjectsBlob(ObjectsBlob); end; begin try BuffInfo := FObjectsBlobsBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ObjectBlobData := TObjectBlobData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ObjectBlobData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadObjectsBlobs', E.Message); end; end; procedure TMemBase.LoadResourceRels(AResoureRels: TSCSResources); var i, j: Integer; ResourceRelData: TResourceRelData; procedure LoadToList; var SCSResourceRel: TSCSResourceRel; begin SCSResourceRel := TSCSResourceRel.Create(FCatalog.FActiveForm, ntProj); SCSResourceRel.IDResource := ResourceRelData.IDResource; SCSResourceRel.GuidNB := FCatalog.FStringsMan.GetStrByID(ResourceRelData.GuidNB, FCatalog.FStringsMan.FResourceRelGuidNBStrings); SCSResourceRel.IDNB := ResourceRelData.IDNB; SCSResourceRel.TableKindNB := ResourceRelData.TableKindNB; SCSResourceRel.Cypher := FCatalog.FStringsMan.GetStrByID(ResourceRelData.Cypher, FCatalog.FStringsMan.FResourceRelCypherStrings); SCSResourceRel.Name := FCatalog.FStringsMan.GetStrByID(ResourceRelData.Name, FCatalog.FStringsMan.FResourceRelNameStrings); SCSResourceRel.Izm := FCatalog.FStringsMan.GetStrByID(ResourceRelData.Izm, FCatalog.FStringsMan.FIzmStrings); SCSResourceRel.Price := ResourceRelData.Price; SCSResourceRel.AdditionalPrice := ResourceRelData.AdditionalPrice; SCSResourceRel.RType := ResourceRelData.RType; SCSResourceRel.ID := ResourceRelData.ID; SCSResourceRel.MasterTableKind := ResourceRelData.MasterTableKind; SCSResourceRel.IDMaster := ResourceRelData.IDMaster; SCSResourceRel.IDCompPropRel := ResourceRelData.IDCompPropRel; SCSResourceRel.Npp := ResourceRelData.Npp; SCSResourceRel.Kolvo := ResourceRelData.Kolvo; SCSResourceRel.Cost := ResourceRelData.Cost; SCSResourceRel.IsOn := ResourceRelData.IsOn; SCSResourceRel.ExpenseForLength := ResourceRelData.ExpenseForLength; //SCSResourceRel.ExpenseForSection := ResourceRelData.ExpenseForSection; SCSResourceRel.GUIDNBComponent := FCatalog.FStringsMan.GetStrByID(ResourceRelData.GUIDNBComponent, FCatalog.FStringsMan.FComponGuidNBStrings); SCSResourceRel.CountForPoint := ResourceRelData.CountForPoint; SCSResourceRel.StepOfPoint := ResourceRelData.StepOfPoint; AResoureRels.Add(SCSResourceRel); end; begin try CloseBuffer(FResourceRelBuff); OpenBuffer(FResourceRelBuff, fmOpenRead); for i := 0 to FResourceRelBuff.BuffCount - 1 do begin LoadBuffFromFile(FResourceRelBuff); for j := 0 to FResourceRelBuff.MaxRecCount - 1 do begin ResourceRelData := TResourceRelData(Pointer(Integer(FResourceRelBuff.FBuffer) + (j*FResourceRelBuff.RecSize))^); LoadToList; end; end; for i := 0 to FResourceRelBuff.RemainsRecCount - 1 do begin FResourceRelBuff.FFileStream.ReadBuffer(ResourceRelData, FResourceRelBuff.RecSize); LoadToList; end; CloseBuffer(FResourceRelBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadResourceRels', E.Message); end; end; procedure TMemBase.LoadSprCompTypes(ASprCompTypes: TSCSObjectList); var i, j: Integer; ComponentTypeData: TComponentTypeData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprCompType: TNBComponentType; begin SprCompType := TNBComponentType.Create(FCatalog.FActiveForm); SprCompType.IDCatalog := ComponentTypeData.IDCatalog; SprCompType.CatalogItemType := ComponentTypeData.CatalogItemType; SprCompType.ComponentType.ID := ComponentTypeData.ID; SprCompType.ComponentType.GUID := FCatalog.FStringsMan.GetStrByID(ComponentTypeData.GUID, FCatalog.FStringsMan.ComponentTypeGUIDStrings); SprCompType.ComponentType.Name := ComponentTypeData.Name; SprCompType.ComponentType.NamePlural := ComponentTypeData.NamePlural; SprCompType.ComponentType.SysName := FCatalog.FStringsMan.GetStrByID(ComponentTypeData.SysName, FCatalog.FStringsMan.CompTypeSysNameStrings); SprCompType.ComponentType.MarkMask := ComponentTypeData.MarkMask; SprCompType.ComponentType.PortKind := ComponentTypeData.PortKind; SprCompType.ComponentType.ActiveState := ComponentTypeData.ActiveState; SprCompType.ComponentType.IDDesignIcon := ComponentTypeData.IDDesignIcon; SprCompType.ComponentType.GUIDDesignIcon := FCatalog.FStringsMan.GetStrByID(ComponentTypeData.GUIDDesignIcon, FCatalog.FStringsMan.ObjectIconGUIDStrings); SprCompType.ComponentType.IsLine := ComponentTypeData.IsLine; SprCompType.ComponentType.IsStandart := ComponentTypeData.IsStandart; SprCompType.ComponentType.CoordZ := ComponentTypeData.CoordZ; SprCompType.ComponentType.CanUseAsPoint := ComponentTypeData.CanUseAsPoint; SprCompType.ComponentType.ComponentIndex := ComponentTypeData.ComponentIndex; SprCompType.PropsCount := ComponentTypeData.PropsCount; if SprCompType.IDCatalog = FCatalog.FIDFromOpened then SprCompType.IDCatalog := FCatalog.ID; ASprCompTypes.Add(SprCompType); end; begin try BuffInfo := FSprCompTypeBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ComponentTypeData := TComponentTypeData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ComponentTypeData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprCompTypes', E.Message); end; end; procedure TMemBase.LoadSprCompTypeProps(ASprCompTypeProps: TSCSObjectList); var i, j: Integer; ComponTypePropData: TComponTypePropData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprCompTypeProp: TNBCompTypeProperty; begin SprCompTypeProp := TNBCompTypeProperty.Create(FCatalog.FActiveForm); SprCompTypeProp.GuidComponentType := FCatalog.FStringsMan.GetStrByID(ComponTypePropData.GuidComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); SprCompTypeProp.PropertyData.Guid := ComponTypePropData.Guid; SprCompTypeProp.PropertyData.ID := ComponTypePropData.ID; SprCompTypeProp.PropertyData.IDMaster := ComponTypePropData.IDComponType; SprCompTypeProp.PropertyData.ID_Property := ComponTypePropData.IDProperty; SprCompTypeProp.PropertyData.GUIDProperty := FCatalog.FStringsMan.GetStrByID(ComponTypePropData.GUIDProperty, FCatalog.FStringsMan.FPropertyGUIDStrings); SprCompTypeProp.PropertyData.TakeIntoConnect := ComponTypePropData.TakeIntoConnect; SprCompTypeProp.PropertyData.TakeIntoJoin := ComponTypePropData.TakeIntoJoin; SprCompTypeProp.PropertyData.Value := FCatalog.FStringsMan.GetStrByID(ComponTypePropData.Value, FCatalog.FStringsMan.FPropertyValueStrings); SprCompTypeProp.PropertyData.IsDefault := ComponTypePropData.IsStandart; ASprCompTypeProps.Add(SprCompTypeProp); end; begin try BuffInfo := FSprCompTypePropBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ComponTypePropData := TComponTypePropData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ComponTypePropData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprCompTypeProps', E.Message); end; end; procedure TMemBase.LoadSprCurrencies(ASprCurrencies: TSCSObjectList); var i, j: Integer; CurrencyData: TCurrencyData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprCurrency: TNBCurrency; begin SprCurrency := TNBCurrency.Create(FCatalog.FActiveForm); SprCurrency.IDCatalog := CurrencyData.IDCatalog; SprCurrency.CatalogItemType := CurrencyData.CatalogItemType; SprCurrency.Data.ID := CurrencyData.ID; SprCurrency.Data.Guid := CurrencyData.GUID; SprCurrency.Data.Name := CurrencyData.Name; SprCurrency.Data.NameBrief := CurrencyData.NameBrief; SprCurrency.Data.Kolvo := CurrencyData.Kolvo; SprCurrency.Data.Ratio := CurrencyData.Ratio; SprCurrency.Data.Main := CurrencyData.Main; SprCurrency.Data.IsCountry := CurrencyData.IsCountry; if SprCurrency.IDCatalog = FCatalog.FIDFromOpened then SprCurrency.IDCatalog := FCatalog.ID; ASprCurrencies.Add(SprCurrency); end; begin try BuffInfo := FSprCurrencyBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin CurrencyData := TCurrencyData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(CurrencyData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprCurrencies', E.Message); end; end; procedure TMemBase.LoadSprInterfaces(ASprInterfaces: TSCSObjectList); var i, j: Integer; InterfaceData: TInterfaceData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprInterface: TNBInterface; begin SprInterface := TNBInterface.Create(FCatalog.FActiveForm); SprInterface.IDCatalog := InterfaceData.IDCatalog; SprInterface.CatalogItemType := InterfaceData.CatalogItemType; SprInterface.ID := InterfaceData.ID; SprInterface.GUID := FCatalog.FStringsMan.GetStrByID(InterfaceData.GUID, FCatalog.FStringsMan.FInterfaceGUIDStrings); SprInterface.Name := InterfaceData.Name; SprInterface.GuidNetType := FCatalog.FStringsMan.GetStrByID(InterfaceData.GUIDNetType, FCatalog.FStringsMan.FNetTypeGUIDStrings); SprInterface.IDNetType := InterfaceData.IDNetType; SprInterface.SortID := InterfaceData.SortID; SprInterface.ConstructiveWidth := InterfaceData.ConstructiveWidth; SprInterface.Description := InterfaceData.Description; SprInterface.IsUniversal := InterfaceData.IsUniversal; SprInterface.InterfAccordanceCount := InterfaceData.InterfAccordanceCount; SprInterface.InterfNormsCount := InterfaceData.InterfNormsCount; if SprInterface.IDCatalog = FCatalog.FIDFromOpened then SprInterface.IDCatalog := FCatalog.ID; ASprInterfaces.Add(SprInterface); end; begin try BuffInfo := FSprInterfaceBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin InterfaceData := TInterfaceData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(InterfaceData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprInterfaces', E.Message); end; end; procedure TMemBase.LoadSprInterfAccordances(ASprInterfAccordances: TSCSObjectList); var i, j: Integer; InterfaceAccordanceData: TInterfaceAccordanceData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprInterfAccordance: TNBInterfaceAccordance; begin SprInterfAccordance := TNBInterfaceAccordance.Create(FCatalog.FActiveForm); SprInterfAccordance.ID := InterfaceAccordanceData.ID; SprInterfAccordance.GUID := InterfaceAccordanceData.GUID; SprInterfAccordance.GuidInterface := FCatalog.FStringsMan.GetStrByID(InterfaceAccordanceData.GUIDInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); SprInterfAccordance.IDInterface := InterfaceAccordanceData.IDInterface; SprInterfAccordance.InterfComponIsLine := InterfaceAccordanceData.InterfComponIsLine; SprInterfAccordance.GUIDAccordance := FCatalog.FStringsMan.GetStrByID(InterfaceAccordanceData.GUIDInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); SprInterfAccordance.IDAccordance := InterfaceAccordanceData.IDAccordance; SprInterfAccordance.AccordComponIsLine := InterfaceAccordanceData.AccordComponIsLine; SprInterfAccordance.Kolvo := InterfaceAccordanceData.Kolvo; ASprInterfAccordances.Add(SprInterfAccordance); end; begin try BuffInfo := FSprInterfAccordanceBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin InterfaceAccordanceData := TInterfaceAccordanceData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(InterfaceAccordanceData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprInterfAccordances', E.Message); end; end; procedure TMemBase.LoadSprInterfNorms(ASprInterfNorms: TSCSObjectList); var i, j: Integer; InterfaceNormData: TInterfaceNormData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprInterfNorm: TNBInterfaceNorm; begin SprInterfNorm := TNBInterfaceNorm.Create(FCatalog.FActiveForm); SprInterfNorm.ID := InterfaceNormData.ID; SprInterfNorm.GUID := InterfaceNormData.GUID; SprInterfNorm.GuidInterface := FCatalog.FStringsMan.GetStrByID(InterfaceNormData.GuidInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); SprInterfNorm.IDInterface := InterfaceNormData.IDInterface; SprInterfNorm.GuidNBNorm := FCatalog.FStringsMan.GetStrByID(InterfaceNormData.GUIDNBNorm, FCatalog.FStringsMan.FNormGuidNBStrings); SprInterfNorm.IDNBNorm := InterfaceNormData.IDNBNorm; SprInterfNorm.Expense := InterfaceNormData.Expense; SprInterfNorm.InterfaceIsBusy := InterfaceNormData.InterfaceIsBusy; SprInterfNorm.GUIDComponentType := FCatalog.FStringsMan.GetStrByID(InterfaceNormData.GUIDComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); SprInterfNorm.IDComponentType := InterfaceNormData.IDComponentType; SprInterfNorm.KoefLengthForCompl := InterfaceNormData.KoefLengthForCompl; ASprInterfNorms.Add(SprInterfNorm); end; begin try BuffInfo := FSprInterfNormBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin InterfaceNormData := TInterfaceNormData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(InterfaceNormData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprInterfNorms', E.Message); end; end; procedure TMemBase.LoadSprNetTypes(ASprNetTypes: TSCSObjectList); var i, j: Integer; NetTypeData: TNetTypeData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprNetType: TNBNetType; begin SprNetType := TNBNetType.Create(FCatalog.FActiveForm); SprNetType.IDCatalog := NetTypeData.IDCatalog; SprNetType.CatalogItemType := NetTypeData.CatalogItemType; SprNetType.ID := NetTypeData.ID; SprNetType.GUID := FCatalog.FStringsMan.GetStrByID(NetTypeData.GUID, FCatalog.FStringsMan.FNetTypeGUIDStrings); SprNetType.Name := NetTypeData.Name; if SprNetType.IDCatalog = FCatalog.FIDFromOpened then SprNetType.IDCatalog := FCatalog.ID; ASprNetTypes.Add(SprNetType); end; begin try BuffInfo := FSprNetTypeBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin NetTypeData := TNetTypeData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(NetTypeData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprNetTypes', E.Message); end; end; procedure TMemBase.LoadSprNorms(ASprNorms: TSCSObjectList); var i, j: Integer; NormData: TNBNormData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprNorm: TNBNorm; begin SprNorm := TNBNorm.Create(FCatalog.FActiveForm); SprNorm.IDCatalog := NormData.IDCatalog; SprNorm.CatalogItemType := NormData.CatalogItemType; SprNorm.ID := NormData.ID; SprNorm.GUID := FCatalog.FStringsMan.GetStrByID(NormData.GUID, FCatalog.FStringsMan.FNormGuidNBStrings); SprNorm.Cypher := FCatalog.FStringsMan.GetStrByID(NormData.Cypher, FCatalog.FStringsMan.FNormCypherStrings); SprNorm.Name := FCatalog.FStringsMan.GetStrByID(NormData.Name, FCatalog.FStringsMan.FNormNameStrings); SprNorm.Izm := FCatalog.FStringsMan.GetStrByID(NormData.Izm, FCatalog.FStringsMan.FIzmStrings); //25.10.2013 SprNorm.LaborTime := NormData.LaborTime; SprNorm.PricePerTime := NormData.PricePerTime; //SprNorm.TimeUOM := NormData.TimeUOM; SprNorm.Price := NormData.Price; SprNorm.GUIDESmeta := NormData.GUIDESmeta; if SprNorm.IDCatalog = FCatalog.FIDFromOpened then SprNorm.IDCatalog := FCatalog.ID; ASprNorms.Add(SprNorm); end; begin try BuffInfo := FSprNormBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin NormData := TNBNormData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(NormData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprNorms', E.Message); end; end; procedure TMemBase.LoadSprObjectIcons(ASprObjectIcons: TSCSObjectList); var i, j: Integer; ObjectIconData: TObjectIconData; BuffInfo: TTableBufferInfo; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // procedure LoadToList; var SprObjectIcon: TNBObjectIcon; begin SprObjectIcon := TNBObjectIcon.Create(FCatalog.FActiveForm); SprObjectIcon.IDCatalog := ObjectIconData.IDCatalog; SprObjectIcon.CatalogItemType := ObjectIconData.CatalogItemType; SprObjectIcon.ID := ObjectIconData.ID; SprObjectIcon.GUID := FCatalog.FStringsMan.GetStrByID(ObjectIconData.GUID, FCatalog.FStringsMan.FObjectIconGUIDStrings); SprObjectIcon.Name := ObjectIconData.Name; GetStreamFromBuff(BuffInfo, ObjectIconData.ProjBlk, SprObjectIcon.ProjBlk); GetStreamFromBuff(BuffInfo, ObjectIconData.ProjBmp, SprObjectIcon.ProjBmp); GetStreamFromBuff(BuffInfo, ObjectIconData.ActiveBlk, SprObjectIcon.ActiveBlk); GetStreamFromBuff(BuffInfo, ObjectIconData.ActiveBmp, SprObjectIcon.ActiveBmp); { if ObjectIconData.ProjBlk <> '' then begin SprObjectIcon.ProjBlk.LoadFromFile(FDirName+'\'+ObjectIconData.ProjBlk); SprObjectIcon.ProjBlk.Position := 0; end; if ObjectIconData.ProjBmp <> '' then begin SprObjectIcon.ProjBmp.LoadFromFile(FDirName+'\'+ObjectIconData.ProjBmp); SprObjectIcon.ProjBmp.Position := 0; end; if ObjectIconData.ActiveBlk <> '' then begin SprObjectIcon.ActiveBlk.LoadFromFile(FDirName+'\'+ObjectIconData.ActiveBlk); SprObjectIcon.ActiveBlk.Position := 0; end; if ObjectIconData.ActiveBmp <> '' then begin SprObjectIcon.ActiveBmp.LoadFromFile(FDirName+'\'+ObjectIconData.ActiveBmp); SprObjectIcon.ActiveBmp.Position := 0; end;} if SprObjecticon.IDCatalog = FCatalog.FIDFromOpened then SprObjecticon.IDCatalog := FCatalog.ID; ASprObjectIcons.Add(SprObjectIcon); end; begin OldTick := GetTickCount; try BuffInfo := FSprObjectIconBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ObjectIconData := TObjectIconData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ObjectIconData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprObjectIcons', E.Message); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TMemBase.LoadSprProducers(ASprProducers: TSCSObjectList); var i, j: Integer; ProducerData: TProducerData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprProducer: TNBProducer; begin SprProducer := TNBProducer.Create(FCatalog.FActiveForm); SprProducer.IDCatalog := ProducerData.IDCatalog; SprProducer.CatalogItemType := ProducerData.CatalogItemType; SprProducer.ID := ProducerData.ID; SprProducer.GUID := FCatalog.FStringsMan.GetStrByID(ProducerData.GUID, FCatalog.FStringsMan.FProducerGUIDStrings); SprProducer.Name := ProducerData.Name; SprProducer.Description := ProducerData.Description; if SprProducer.IDCatalog = FCatalog.FIDFromOpened then SprProducer.IDCatalog := FCatalog.ID; ASprProducers.Add(SprProducer); end; begin try BuffInfo := FSprProducerBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ProducerData := TProducerData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ProducerData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprProducers', E.Message); end; end; procedure TMemBase.LoadSprProperties(ASprProperties: TSCSObjectList); var i, j: Integer; PropertyData: TPropertyBuffData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprProperty: TNBProperty; begin SprProperty := TNBProperty.Create(FCatalog.FActiveForm); SprProperty.IDCatalog := PropertyData.IDCatalog; SprProperty.CatalogItemType := PropertyData.CatalogItemType; SprProperty.PropertyData.ID := PropertyData.ID; SprProperty.PropertyData.GUID := FCatalog.FStringsMan.GetStrByID(PropertyData.GUID, FCatalog.FStringsMan.FPropertyGUIDStrings); SprProperty.PropertyData.IDDataType := PropertyData.IDDataType; SprProperty.PropertyData.Name := PropertyData.Name; SprProperty.PropertyData.SysName := PropertyData.SysName; SprProperty.PropertyData.Izm := PropertyData.Izm; SprProperty.PropertyData.ValueReq := PropertyData.ValueReq; SprProperty.PropertyData.MinValue := PropertyData.MinValue; SprProperty.PropertyData.MaxValue := PropertyData.MaxValue; SprProperty.PropertyData.DefValue := PropertyData.DefValue; SprProperty.PropertyData.Description := PropertyData.Description; SprProperty.PropertyData.IsStandart := PropertyData.IsStandart; SprProperty.PropertyData.SortID := PropertyData.SortID; SprProperty.PropertyData.ISProject := PropertyData.ISProject; SprProperty.PropertyData.ISFolder := PropertyData.ISFolder; SprProperty.PropertyData.ISList := PropertyData.ISList; SprProperty.PropertyData.ISRoom := PropertyData.ISRoom; SprProperty.PropertyData.ISSCSLine := PropertyData.ISSCSLine; SprProperty.PropertyData.ISSCSConnector := PropertyData.ISSCSConnector; SprProperty.PropertyData.ISComponLine := PropertyData.ISComponLine; SprProperty.PropertyData.ISComponConn := PropertyData.ISComponConn; SprProperty.PropertyData.IsForWholeComponent := PropertyData.IsForWholeComponent; SprProperty.PropertyData.IsValueRelToObj := PropertyData.IsValueRelToObj; SprProperty.PropValRelCount := PropertyData.PropValRelCount; if SprProperty.IDCatalog = FCatalog.FIDFromOpened then SprProperty.IDCatalog := FCatalog.ID; ASprProperties.Add(SprProperty); end; begin try BuffInfo := FSprPropertyBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin PropertyData := TPropertyBuffData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(PropertyData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprProperties', E.Message); end; end; procedure TMemBase.LoadSprPropValRels(ASprPropValRels: TSCSObjectList); var i, j: Integer; PropValRelData: TPropValRelBuffData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprPropValRel: TNBPropValRel; begin SprPropValRel := TNBPropValRel.Create(FCatalog.FActiveForm); SprPropValRel.GUID := FCatalog.FStringsMan.GetStrByID(PropValRelData.GUID, FCatalog.FStringsMan.FPropValRelGUIDStrings); SprPropValRel.GuidProperty := FCatalog.FStringsMan.GetStrByID(PropValRelData.GuidProperty, FCatalog.FStringsMan.FPropertyGUIDStrings); SprPropValRel.PValue := FCatalog.FStringsMan.GetStrByID(PropValRelData.PValue, FCatalog.FStringsMan.FPropertyValueStrings); SprPropValRel.MinValue := FCatalog.FStringsMan.GetStrByID(PropValRelData.MinValue, FCatalog.FStringsMan.FPropertyValueStrings); SprPropValRel.MaxValue := FCatalog.FStringsMan.GetStrByID(PropValRelData.MaxValue, FCatalog.FStringsMan.FPropertyValueStrings); SprPropValRel.ID := PropValRelData.ID; SprPropValRel.IDProperty := PropValRelData.IDProperty; SprPropValRel.PropValNormResCount := PropValRelData.PropValNormResCount; ASprPropValRels.Add(SprPropValRel); end; begin try BuffInfo := FSprPropValRelBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin PropValRelData := TPropValRelBuffData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(PropValRelData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprPropValRels', E.Message); end; end; procedure TMemBase.LoadSprPropValNormRes(ASprPropValNormRes: TSCSObjectList); var i, j: Integer; PropValNormResData: TPropValNormResBuffData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprPropValNormRes: TNBPropValNormRes; begin SprPropValNormRes := TNBPropValNormRes.Create(FCatalog.FActiveForm); SprPropValNormRes.GuidPropValRel := FCatalog.FStringsMan.GetStrByID(PropValNormResData.GuidPropValRel, FCatalog.FStringsMan.FPropValRelGUIDStrings); SprPropValNormRes.GuidNBComponent := FCatalog.FStringsMan.GetStrByID(PropValNormResData.GuidNBComponent, FCatalog.FStringsMan.FComponGuidNBStrings); SprPropValNormRes.GuidNBRes := FCatalog.FStringsMan.GetStrByID(PropValNormResData.GuidNBRES, FCatalog.FStringsMan.FResourceRelGuidNBStrings); SprPropValNormRes.GuidNBNorm := FCatalog.FStringsMan.GetStrByID(PropValNormResData.GuidNBNorm, FCatalog.FStringsMan.FNormGuidNBStrings); SprPropValNormRes.ID := PropValNormResData.ID; SprPropValNormRes.GUID := PropValNormResData.GUID; SprPropValNormRes.IDPropValRel := PropValNormResData.IDPropValRel; SprPropValNormRes.IDNBComponent := PropValNormResData.IDNBComponent; SprPropValNormRes.IDNBRes := PropValNormResData.IDNBRES; SprPropValNormRes.IDNBNorm := PropValNormResData.IDNBNorm; SprPropValNormRes.Kolvo := PropValNormResData.Kolvo; SprPropValNormRes.ExpenseForLength := PropValNormResData.ExpenseForLength; SprPropValNormRes.CountForPoint := PropValNormResData.CountForPoint; SprPropValNormRes.StepOfPoint := PropValNormResData.StepOfPoint; ASprPropValNormRes.Add(SprPropValNormRes); end; begin try BuffInfo := FSprPropValNormResBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin PropValNormResData := TPropValNormResBuffData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(PropValNormResData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprPropValNormRes', E.Message); end; end; procedure TMemBase.LoadSprResources(ASprResources: TSCSObjectList); var i, j: Integer; ResourceData: TResourceData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprResource: TNBResource; begin SprResource := TNBResource.Create(FCatalog.FActiveForm); SprResource.IDCatalog := ResourceData.IDCatalog; SprResource.CatalogItemType := ResourceData.CatalogItemType; SprResource.ID := ResourceData.ID; SprResource.GUID := FCatalog.FStringsMan.GetStrByID(ResourceData.GUID, FCatalog.FStringsMan.FResourceRelGuidNBStrings); SprResource.Cypher := FCatalog.FStringsMan.GetStrByID(ResourceData.Cypher, FCatalog.FStringsMan.FResourceRelCypherStrings); SprResource.Name := FCatalog.FStringsMan.GetStrByID(ResourceData.Name, FCatalog.FStringsMan.FResourceRelNameStrings); SprResource.Izm := FCatalog.FStringsMan.GetStrByID(ResourceData.Izm, FCatalog.FStringsMan.FIzmStrings); SprResource.Price := ResourceData.Price; SprResource.RType := ResourceData.RType; if SprResource.IDCatalog = FCatalog.FIDFromOpened then SprResource.IDCatalog := FCatalog.ID; ASprResources.Add(SprResource); end; begin try BuffInfo := FSprResourceBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin ResourceData := TResourceData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(ResourceData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprResources', E.Message); end; end; procedure TMemBase.LoadSprSuppliesKinds(ASprSuppliesKinds: TSCSObjectList); var i, j: Integer; SuppliesKindData: TSuppliesKindData; BuffInfo: TTableBufferInfo; procedure LoadToList; var SprSuppliesKind: TNBSuppliesKind; begin SprSuppliesKind := TNBSuppliesKind.Create(FCatalog.FActiveForm); SprSuppliesKind.IDCatalog := SuppliesKindData.IDCatalog; SprSuppliesKind.CatalogItemType := SuppliesKindData.CatalogItemType; SprSuppliesKind.Data.ID := SuppliesKindData.ID; SprSuppliesKind.Data.GUID := FCatalog.FStringsMan.GetStrByID(SuppliesKindData.GUID, FCatalog.FStringsMan.FSuppliesKindGUIDStrings); SprSuppliesKind.Data.Name := SuppliesKindData.Name; SprSuppliesKind.Data.NameTradUOM := SuppliesKindData.NameTradUOM; SprSuppliesKind.Data.Izm := SuppliesKindData.Izm; SprSuppliesKind.Data.IzmTradUOM := SuppliesKindData.IzmTradUOM; SprSuppliesKind.Data.UnitKolvo := SuppliesKindData.UnitKolvo; SprSuppliesKind.Data.UnitKolvoTradUOM := SuppliesKindData.UnitKolvoTradUOM; if SprSuppliesKind.IDCatalog = FCatalog.FIDFromOpened then SprSuppliesKind.IDCatalog := FCatalog.ID; ASprSuppliesKinds.Add(SprSuppliesKind); end; begin try BuffInfo := FSprSuppliesKindBuff; CloseBuffer(BuffInfo); OpenBuffer(BuffInfo, fmOpenRead); for i := 0 to BuffInfo.BuffCount - 1 do begin LoadBuffFromFile(BuffInfo); for j := 0 to BuffInfo.MaxRecCount - 1 do begin SuppliesKindData := TSuppliesKindData(Pointer(Integer(BuffInfo.FBuffer) + (j*BuffInfo.RecSize))^); LoadToList; end; end; for i := 0 to BuffInfo.RemainsRecCount - 1 do begin BuffInfo.FFileStream.ReadBuffer(SuppliesKindData, BuffInfo.RecSize); LoadToList; end; CloseBuffer(BuffInfo); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadSprSuppliesKinds', E.Message); end; end; procedure TMemBase.LoadStringsManInfos(AStringsManInfos: TList); var i, j: Integer; StringsManData: TStringsManData; procedure LoadToList; var ptrStringsManInfo: PStringsManInfo; begin GetMem(ptrStringsManInfo, SizeOf(TStringsManInfo)); ptrStringsManInfo.ID := StringsManData.ID; ptrStringsManInfo.StrType := StringsManData.StrType; ptrStringsManInfo.Name := StringsManData.Name; AStringsManInfos.Add(ptrStringsManInfo); end; begin try CloseBuffer(FStringsManBuff); OpenBuffer(FStringsManBuff, fmOpenRead); for i := 0 to FStringsManBuff.BuffCount - 1 do begin LoadBuffFromFile(FStringsManBuff); for j := 0 to FStringsManBuff.MaxRecCount - 1 do begin StringsManData := TStringsManData(Pointer(Integer(FStringsManBuff.FBuffer) + (j*FStringsManBuff.RecSize))^); LoadToList; end; end; for i := 0 to FStringsManBuff.RemainsRecCount - 1 do begin FStringsManBuff.FFileStream.ReadBuffer(StringsManData, FStringsManBuff.RecSize); LoadToList; end; CloseBuffer(FStringsManBuff); except on E: Exception do AddExceptionToLogEx('TMemBase.LoadStringsManInfos', E.Message); end; end; procedure TMemBase.SaveBuffToFile(ABuff: TTableBufferInfo); begin if ABuff.RecCount > 0 then ABuff.FFileStream.WriteBuffer(ABuff.FBuffer^, ABuff.RecCount * ABuff.RecSize); ABuff.RecCount := 0; end; procedure TMemBase.SaveBuffsToFiles; var i: integer; TableBufferInfo: TTableBufferInfo; begin for i := 0 to FBuffList.Count - 1 do begin TableBufferInfo := TTableBufferInfo(FBuffList[i]); SaveBuffToFile(TableBufferInfo); if TableBufferInfo.FNameStreams <> '' then TableBufferInfo.FStreamList.SaveToFile(FDirName+'\'+TableBufferInfo.FNameStreams); end; end; procedure TMemBase.SaveCatalogToBuff(ACatalog: TSCSCatalog); var CatalogData: TCatalogData; BuffInfo: TTableBufferInfo; Stream: TMemoryStream; SCSList: TSCSList; begin BuffInfo := FCatalogBuff; if ACatalog is TSCSList then begin SCSList := TSCSList(ACatalog); CatalogData.ID := SCSList.ID; CatalogData.ParentID := SCSList.ParentID; CatalogData.Name := FCatalog.FStringsMan.GenStrID(SCSList.Name, FCatalog.FStringsMan.FCataogNameStrings); CatalogData.SortID := SCSList.SortID; CatalogData.KolCompon := SCSList.KolCompon; CatalogData.ItemsCount := SCSList.ItemsCount; //07.11.2013 //CatalogData.PropsCount := ACatalog.PropsCount; //CatalogData.NormsCount := ACatalog.NormsCount; //CatalogData.ResourcesCount := ACatalog.ResourcesCount; //20.05.2014 CatalogData.PropsCount := SCSList.PropsCount; CatalogData.NormsCount := SCSList.NormsCount; CatalogData.ResourcesCount := SCSList.ResourcesCount; CatalogData.ListID := SCSList.ListID; CatalogData.NameShort := FCatalog.FStringsMan.GenStrID(SCSList.NameShort, FCatalog.FStringsMan.FCataogNameShortStrings); CatalogData.NameMark := SCSList.NameMark; CatalogData.IsUserName := SCSList.IsUserName; CatalogData.MarkID := SCSList.MarkID; CatalogData.ItemType := SCSList.ItemType; CatalogData.ScsID := SCSList.SCSID; CatalogData.IsIndexWithName := SCSList.IsIndexWithName; CatalogData.IndexPointObj := SCSList.IndexPointObj; CatalogData.IndexLine := SCSList.IndexLine; CatalogData.IndexConnector := SCSList.IndexConnector; SCSList.SaveSettingsToStream; CatalogData.ListSetting := AppendStreamToBuff(BuffInfo, SCSList.FSettingStream, false); //FMarkMasrksStream.Position := 0; //TBlobField(FMemTable.FieldByName(fnCompTypeMarkMasks)).LoadFromStream(FMarkMasrksStream); //FMarkMasrksStream.Position := 0; end else begin CatalogData.ID := ACatalog.ID; CatalogData.ParentID := ACatalog.ParentID; CatalogData.Name := FCatalog.FStringsMan.GenStrID(ACatalog.Name, FCatalog.StringsMan.FCataogNameStrings); CatalogData.SortID := ACatalog.SortID; CatalogData.KolCompon := ACatalog.KolCompon; CatalogData.ItemsCount := ACatalog.ItemsCount; CatalogData.PropsCount := ACatalog.PropsCount; //07.11.2013 CatalogData.NormsCount := ACatalog.NormsCount; CatalogData.ResourcesCount := ACatalog.ResourcesCount; CatalogData.ListID := ACatalog.ListID; CatalogData.NameShort := FCatalog.FStringsMan.GenStrID(ACatalog.NameShort, FCatalog.FStringsMan.FCataogNameShortStrings); CatalogData.NameMark := ACatalog.NameMark; CatalogData.IsUserName := ACatalog.IsUserName; CatalogData.MarkID := ACatalog.MarkID; CatalogData.ItemType := ACatalog.ItemType; CatalogData.ScsID := ACatalog.SCSID; CatalogData.IsIndexWithName := ACatalog.IsIndexWithName; CatalogData.IndexPointObj := ACatalog.IndexPointObj; CatalogData.IndexLine := ACatalog.IndexLine; CatalogData.IndexConnector := ACatalog.IndexConnector; if ACatalog.ItemType = itRoom then if ACatalog.FRoomSetting <> nil then begin Stream := TMemoryStream.Create; Stream.WriteBuffer(ACatalog.FRoomSetting^, SizeOf(TRoomSettingRecord)); Stream.Position := 0; CatalogData.RoomSetting := GetUniqueFileName('', enBlb); Stream.SaveToFile(FDirName+'\'+CatalogData.RoomSetting); FreeAndNil(Stream); end; end; TCatalogData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := CatalogData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveCatRelToBuff(AIDCatalog, AIDComponent: Integer); var CatalogRelationData: TCatalogRelationData; begin CatalogRelationData.IDCatalog := AIDCatalog; CatalogRelationData.IDComponent := AIDComponent; TCatalogRelationData(Pointer(Integer(FCatRelBuff.FBuffer) + (FCatRelBuff.RecSize*FCatRelBuff.RecCount))^) := CatalogRelationData; FCatRelBuff.RecCount := FCatRelBuff.RecCount + 1; if FCatRelBuff.RecCount = FCatRelBuff.MaxRecCount then SaveBuffToFile(FCatRelBuff); end; procedure TMemBase.SaveCatalogPropToBuff(AProp: PProperty); var CatalogPropData: TCatalogPropData; begin CatalogPropData.ID := AProp.ID; CatalogPropData.IDProperty := AProp.ID_Property; CatalogPropData.GUIDProperty := FCatalog.FStringsMan.GenStrID(AProp.GUIDProperty, FCatalog.FStringsMan.PropertyGUIDStrings); CatalogPropData.IDCatalog := AProp.IDMaster; CatalogPropData.Value := FCatalog.FStringsMan.GenStrID(AProp.Value, FCatalog.FStringsMan.PropertyValueStrings); CatalogPropData.IsDefault := AProp.IsDefault; TCatalogPropData(Pointer(Integer(FCatalogPropsBuff.FBuffer) + (FCatalogPropsBuff.RecSize*FCatalogPropsBuff.RecCount))^) := CatalogPropData; FCatalogPropsBuff.RecCount := FCatalogPropsBuff.RecCount + 1; if FCatalogPropsBuff.RecCount = FCatalogPropsBuff.MaxRecCount then SaveBuffToFile(FCatalogPropsBuff); end; procedure TMemBase.SaveComponToBuff(ACompon: TSCSComponent); var ComponData: TComponData; StreamSize: Integer; BlobFileName: string; begin ComponData.ID := ACompon.ID; ComponData.GuidNB := FCatalog.FStringsMan.GenStrID(ACompon.GuidNB, FCatalog.FStringsMan.FComponGuidNBStrings); ComponData.Name := FCatalog.FStringsMan.GenStrID(ACompon.NAME, FCatalog.FStringsMan.FComponNameStrings); ComponData.NameShort := FCatalog.FStringsMan.GenStrID(ACompon.NameShort, FCatalog.FStringsMan.FComponNameShortStrings); ComponData.Cypher := FCatalog.FStringsMan.GenStrID(ACompon.Cypher, FCatalog.FStringsMan.FComponCypherStrings); ComponData.Izm := FCatalog.FStringsMan.GenStrID(ACompon.Izm, FCatalog.FStringsMan.FIzmStrings); ComponData.Notice := FCatalog.FStringsMan.GenStrID(ACompon.Notice, FCatalog.FStringsMan.ComponNoticeStrings); StreamSize := ACompon.Description.Size; if StreamSize = 0 then ComponData.Description := '' else begin ComponData.Description := GetUniqueFileName('', enBlb); ACompon.Description.SaveToFile(FDirName+'\'+ComponData.Description); end; StreamSize := ACompon.Picture.Size; if StreamSize = 0 then ComponData.Picture := '' else begin ComponData.Picture := GetUniqueFileName('', enBlb); ACompon.Picture.SaveToFile(FDirName+'\'+ComponData.Picture); end; ComponData.Color := ACompon.Color; ComponData.IsLine := ACompon.IsLine; ComponData.ISComplect := ACompon.ISComplect; ComponData.PriceSupply := ACompon.PriceSupply; ComponData.PRICE := ACompon.PRICE; ComponData.PriceCalc := ACompon.PRICE_CALC; ComponData.UserLength := ACompon.UserLength; ComponData.MaxLength := ACompon.MaxLength; ComponData.HASNDS := ACompon.HASNDS; ComponData.ArticulDistributor := FCatalog.FStringsMan.GenStrID(ACompon.ArticulDistributor, FCatalog.FStringsMan.FComponArticulStrings); ComponData.ArticulProducer := FCatalog.FStringsMan.GenStrID(ACompon.ArticulProducer, FCatalog.FStringsMan.FComponArticulStrings); ComponData.IDComponentType := ACompon.ID_ComponentType; ComponData.IDSymbol := ACompon.IDSymbol; ComponData.IDObjectIcon := ACompon.IDObjectIcon; ComponData.ObjectIconStep := ACompon.ObjectIconStep; ComponData.IDProducer := ACompon.ID_Producer; ComponData.IDCurrency := ACompon.ID_CURRENCY; ComponData.IDSuppliesKind := ACompon.IDSuppliesKind; ComponData.IDSupplier := ACompon.ID_SUPPLIER; ComponData.IDNetType := ACompon.IDNetType; ComponData.SortID := ACompon.SortID; ComponData.KolComplect := ACompon.KolComplect; ComponData.CableCanalConnectorsCnt := ACompon.CableCanalConnectorsCnt; ComponData.InterfCount := ACompon.InterfCount; ComponData.JoinsCount := ACompon.JoinsCount; ComponData.NormsCount := ACompon.NormsCount; ComponData.PropsCount := ACompon.PropsCount; ComponData.ResourcesCount := ACompon.ResourcesCount; ComponData.IDNormbase := ACompon.IDNormBase; ComponData.ObjectID := ACompon.ObjectID; ComponData.ListID := ACompon.ListID; ComponData.IDRelatedCompon := ACompon.IDRelatedCompon; ComponData.WholeID := ACompon.Whole_ID; ComponData.IsDismount := ACompon.IsDismount; ComponData.IsUseDismounted := ACompon.IsUseDismounted; ComponData.UseKindInProj := ACompon.UseKindInProj; ComponData.NameMark := ACompon.NameMark; ComponData.MarkID := ACompon.MarkID; ComponData.IsUserMark := ACompon.IsUserMark; ComponData.IsMarkInCaptions := ACompon.IsMarkInCaptions; ComponData.ComeFrom := ACompon.ComeFrom; ComponData.IsTemplate := ACompon.IsTemplate; ComponData.GuidComponentType := FCatalog.FStringsMan.GenStrID(ACompon.GUIDComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); ComponData.GuidSymbol := FCatalog.FStringsMan.GenStrID(ACompon.GUIDSymbol, FCatalog.FStringsMan.FObjectIconGUIDStrings); ComponData.GuidObjectIcon := FCatalog.FStringsMan.GenStrID(ACompon.GUIDObjectIcon, FCatalog.FStringsMan.FObjectIconGUIDStrings); ComponData.GuidProducer := FCatalog.FStringsMan.GenStrID(ACompon.GUIDProducer, FCatalog.FStringsMan.FProducerGUIDStrings); ComponData.GuidSuppliesKind := FCatalog.FStringsMan.GenStrID(ACompon.GUIDSuppliesKind, FCatalog.FStringsMan.FSuppliesKindGUIDStrings); ComponData.GuidSupplier := FCatalog.FStringsMan.GenStrID(ACompon.GUIDSupplier, FCatalog.FStringsMan.FSupplierGUIDStrings); ComponData.GuidNetType := FCatalog.FStringsMan.GenStrID(ACompon.GUIDNetType, FCatalog.FStringsMan.FNetTypeGUIDStrings); TComponData(Pointer(Integer(FComponBuff.FBuffer) + (FComponBuff.RecSize*FComponBuff.RecCount))^) := ComponData; FComponBuff.RecCount := FComponBuff.RecCount + 1; if FComponBuff.RecCount = FComponBuff.MaxRecCount then SaveBuffToFile(FComponBuff); end; procedure TMemBase.SaveComponPropToBuff(AProp: PProperty); var ComponPropData: TComponPropData; begin ComponPropData.ID := AProp.ID; ComponPropData.IDProperty := AProp.ID_Property; ComponPropData.GUIDProperty := FCatalog.FStringsMan.GenStrID(AProp.GUIDProperty, FCatalog.FStringsMan.PropertyGUIDStrings); ComponPropData.IDComponent := AProp.IDMaster; ComponPropData.TakeIntoConnect := AProp.TakeIntoConnect; ComponPropData.TakeIntoJoin := AProp.TakeIntoJoin; ComponPropData.IsTakeJoinforPoint := AProp.IsTakeJoinforPoint; ComponPropData.IsCrossControl := AProp.IsCrossControl; ComponPropData.IDCrossProperty := AProp.IDCrossProperty; ComponPropData.GUIDCrossProperty := FCatalog.FStringsMan.GenStrID(AProp.GUIDCrossProperty, FCatalog.FStringsMan.PropertyGUIDStrings); ComponPropData.Value := FCatalog.FStringsMan.GenStrID(AProp.Value, FCatalog.FStringsMan.PropertyValueStrings); TComponPropData(Pointer(Integer(FComponPropsBuff.FBuffer) + (FComponPropsBuff.RecSize*FComponPropsBuff.RecCount))^) := ComponPropData; FComponPropsBuff.RecCount := FComponPropsBuff.RecCount + 1; if FComponPropsBuff.RecCount = FComponPropsBuff.MaxRecCount then SaveBuffToFile(FComponPropsBuff); end; procedure TMemBase.SaveCompRelToBuff(ACompRel: PComplect); var CompRelData: TCompRelData; begin CompRelData.ID := ACompRel.ID; CompRelData.IDComponent := ACompRel.ID_Component; CompRelData.IDChild := ACompRel.ID_Child; CompRelData.Kolvo := ACompRel.Kolvo; CompRelData.ConnectType := ACompRel.ConnectType; CompRelData.RelType := ACompRel.RelType; CompRelData.Fixed := ACompRel.Fixed; CompRelData.SortID := ACompRel.SortID; TCompRelData(Pointer(Integer(FCompRelBuff.FBuffer) + (FCompRelBuff.RecSize*FCompRelBuff.RecCount))^) := CompRelData; FCompRelBuff.RecCount := FCompRelBuff.RecCount + 1; if FCompRelBuff.RecCount = FCompRelBuff.MaxRecCount then SaveBuffToFile(FCompRelBuff); end; procedure TMemBase.SaveConnectedComponsToBuff(AConnectedComponsInfo: TConnectedComponsInfo); var ConnectedComponsData: TConnectedComponsData; begin ConnectedComponsData.ID := AConnectedComponsInfo.ID; ConnectedComponsData.ComponWholeID := AConnectedComponsInfo.ComponWholeID; ConnectedComponsData.IDConnectObject := AConnectedComponsInfo.IDConnectObject; ConnectedComponsData.IDConnectCompon := AConnectedComponsInfo.IDConnectCompon; ConnectedComponsData.IDSideCompon := AConnectedComponsInfo.IDSideCompon; ConnectedComponsData.TypeConnect := AConnectedComponsInfo.TypeConnect; TConnectedComponsData(Pointer(Integer(FConnectedComponsBuff.FBuffer) + (FConnectedComponsBuff.RecSize*FConnectedComponsBuff.RecCount))^) := ConnectedComponsData; FConnectedComponsBuff.RecCount := FConnectedComponsBuff.RecCount + 1; if FConnectedComponsBuff.RecCount = FConnectedComponsBuff.MaxRecCount then SaveBuffToFile(FConnectedComponsBuff); end; procedure TMemBase.SaveCableCanalConnectorToBuff(ACableCanalConnector: PCableCanalConnector); var CableCanalConnectorData: TCableCanalConnectorData; begin CableCanalConnectorData.ID := ACableCanalConnector.ID; CableCanalConnectorData.IDCableCanal := ACableCanalConnector.IDCableCanal; CableCanalConnectorData.IDNBConnector := ACableCanalConnector.IDNBConnector; CableCanalConnectorData.GuidNBConnector := FCatalog.FStringsMan.GenStrID(ACableCanalConnector.GuidNBConnector, FCatalog.FStringsMan.NBConnectorGuidStrings); CableCanalConnectorData.ConnectorType := ACableCanalConnector.ConnectorType; TCableCanalConnectorData(Pointer(Integer(FCableCanalConnectorBuff.FBuffer) + (FCableCanalConnectorBuff.RecSize*FCableCanalConnectorBuff.RecCount))^) := CableCanalConnectorData; FCableCanalConnectorBuff.RecCount := FCableCanalConnectorBuff.RecCount + 1; if FCableCanalConnectorBuff.RecCount = FCableCanalConnectorBuff.MaxRecCount then SaveBuffToFile(FCableCanalConnectorBuff); end; procedure TMemBase.SaveInterfRelToBuff(AInterf: TSCSInterface); var InterfRelData: TInterfRelData; begin InterfRelData.ID := AInterf.ID; InterfRelData.Npp := AInterf.Npp; InterfRelData.IDInterface := AInterf.ID_Interface; InterfRelData.IDComponent := AInterf.ID_Component; InterfRelData.TypeI := AInterf.TypeI; InterfRelData.Kind := AInterf.Kind; InterfRelData.IsPort := AInterf.IsPort; InterfRelData.IsUserPort := AInterf.IsUserPort; InterfRelData.NppPort := AInterf.NppPort; InterfRelData.IDConnected := AInterf.IDConnected; InterfRelData.Gender := AInterf.Gender; InterfRelData.Multiple := AInterf.Multiple; InterfRelData.IsBusy := AInterf.IsBusy; InterfRelData.NumPair := AInterf.NumPair; InterfRelData.Color := AInterf.Color; InterfRelData.IDAdverse := AInterf.IDAdverse; InterfRelData.Side := AInterf.Side; InterfRelData.Notice := FCatalog.FStringsMan.GenStrID(AInterf.Notice, FCatalog.FStringsMan.FInterfaceNoticeStrings); InterfRelData.Kolvo := AInterf.Kolvo; InterfRelData.KolvoBusy := AInterf.KolvoBusy; InterfRelData.SignType := AInterf.SignType; InterfRelData.ConnToAnyGender := AInterf.ConnToAnyGender; InterfRelData.SideSection := FCatalog.FStringsMan.GenStrID(AInterf.SideSection, FCatalog.FStringsMan.FInterfaceSideSectionStrings); InterfRelData.GUIDInterface := FCatalog.FStringsMan.GenStrID(AInterf.GUIDInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); InterfRelData.IOfIRelCount := AInterf.IOfIRelCount; InterfRelData.PortInterfRelCount := AInterf.PortInterfRelCount; InterfRelData.ValueI := AInterf.ValueI; InterfRelData.CoordZ := AInterf.CoordZ; TInterfRelData(Pointer(Integer(FInterfRelBuff.FBuffer) + (FInterfRelBuff.RecSize*FInterfRelBuff.RecCount))^) := InterfRelData; FInterfRelBuff.RecCount := FInterfRelBuff.RecCount + 1; if FInterfRelBuff.RecCount = FInterfRelBuff.MaxRecCount then SaveBuffToFile(FInterfRelBuff); end; procedure TMemBase.SaveIOfIRelToBuff(AIOfIRel: TSCSIOfIRel); var IOfIRelData: TIOfIRelData; begin IOfIRelData.ID := AIOfIRel.ID; IOfIRelData.IDInterfRel := AIOfIRel.IDInterfRel; IOfIRelData.IDInterfTo := AIOfIRel.IDInterfTo; IOfIRelData.IDCompRel := AIOfIRel.IDCompRel; IOfIRelData.IDIOfIRelMain := AIOfIRel.IDIOfIRelMain; IOfIRelData.PosConnectionsCount := AIOfIRel.PosConnectionsCount; TIOfIRelData(Pointer(Integer(FIOfIRelBuff.FBuffer) + (FIOfIRelBuff.RecSize*FIOfIRelBuff.RecCount))^) := IOfIRelData; FIOfIRelBuff.RecCount := FIOfIRelBuff.RecCount + 1; if FIOfIRelBuff.RecCount = FIOfIRelBuff.MaxRecCount then SaveBuffToFile(FIOfIRelBuff); end; procedure TMemBase.SaveInterfPosConnectionToBuff(AInterfPosConnection: TSCSInterfPosConnection); var InterfPosConnectionData: TInterfPosConnectionData; begin InterfPosConnectionData.ID := AInterfPosConnection.ID; InterfPosConnectionData.IDIOIRel := AInterfPosConnection.IDIOIRel; InterfPosConnectionData.SelfFromPos := AInterfPosConnection.SelfInterfPosition.FromPos; InterfPosConnectionData.SelfToPos := AInterfPosConnection.SelfInterfPosition.ToPos; InterfPosConnectionData.ConnFromPos := AInterfPosConnection.ConnInterfPosition.FromPos; InterfPosConnectionData.ConnToPos := AInterfPosConnection.ConnInterfPosition.ToPos; TInterfPosConnectionData(Pointer(Integer(FInterfPosConnectionData.FBuffer) + (FInterfPosConnectionData.RecSize*FInterfPosConnectionData.RecCount))^) := InterfPosConnectionData; FInterfPosConnectionData.RecCount := FInterfPosConnectionData.RecCount + 1; if FInterfPosConnectionData.RecCount = FInterfPosConnectionData.MaxRecCount then SaveBuffToFile(FInterfPosConnectionData); end; procedure TMemBase.SaveNormToBuff(ANorm: TSCSNorm); var NormData: TNormData; begin NormData.ID := ANorm.ID; NormData.GuidNB := FCatalog.FStringsMan.GenStrID(ANorm.GuidNB, FCatalog.FStringsMan.FNormGuidNBStrings); NormData.IDNB := ANorm.IDNB; NormData.Cypher := FCatalog.FStringsMan.GenStrID(ANorm.Cypher, FCatalog.FStringsMan.FNormCypherStrings); NormData.MasterTableKind := ANorm.MasterTableKind; NormData.Name := FCatalog.FStringsMan.GenStrID(ANorm.Name, FCatalog.FStringsMan.FNormNameStrings); NormData.WorkKind := FCatalog.FStringsMan.GenStrID(ANorm.WorkKind, FCatalog.FStringsMan.NormWorkKindStrings); NormData.Izm := FCatalog.FStringsMan.GenStrID(ANorm.Izm_, FCatalog.FStringsMan.FIzmStrings); NormData.IDMaster := ANorm.IDMaster; NormData.IDCompPropRel := ANorm.IDCompPropRel; NormData.Npp := ANorm.Npp; NormData.IsOn := ANorm.IsOn; NormData.LaborTime := ANorm.LaborTime; NormData.PricePerTime := ANorm.PricePerTime; NormData.Price := ANorm.Price; NormData.Cost := ANorm.Cost; NormData.Kolvo := ANorm.Kolvo; NormData.TotalCost := ANorm.TotalCost; NormData.IsFromInterface := ANorm.IsFromInterface; NormData.ExpenseForLength := ANorm.ExpenseForLength; //NormData.ExpenseForSection := ANorm.ExpenseForSection; NormData.CountForPoint := ANorm.CountForPoint; NormData.StepOfPoint := ANorm.StepOfPoint; TNormData(Pointer(Integer(FNormBuff.FBuffer) + (FNormBuff.RecSize*FNormBuff.RecCount))^) := NormData; FNormBuff.RecCount := FNormBuff.RecCount + 1; if FNormBuff.RecCount = FNormBuff.MaxRecCount then SaveBuffToFile(FNormBuff); end; procedure TMemBase.SaveObjectsBlobsToBuff(AObjectsBlob: TObjectsBlob); var ObjectBlobData: TObjectBlobData; BuffInfo: TTableBufferInfo; Stream: TMemoryStream; StreamSize: Integer; begin BuffInfo := FObjectsBlobsBuff; ObjectBlobData.ID := AObjectsBlob.ID; ObjectBlobData.TableKind := AObjectsBlob.TableKind; ObjectBlobData.DataKind := AObjectsBlob.DataKind; Stream := TMemoryStream.Create; AObjectsBlob.SaveObjIDsToStream(Stream); ObjectBlobData.ObjIDs := AppendStreamToBuff(BuffInfo, Stream, true); //Stream.Free; ObjectBlobData.ObjectData := AppendStreamToBuff(BuffInfo, AObjectsBlob.ObjectData, false); TObjectBlobData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ObjectBlobData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SavePortInterfRelToBuff(APortInterfRel: PPortInterfRel); var PortInterfRelData: TPortInterfRelData; begin PortInterfRelData.ID := APortInterfRel.ID; PortInterfRelData.RelType := APortInterfRel.RelType; PortInterfRelData.IDPort := APortInterfRel.IDPort; PortInterfRelData.IDInterfRel := APortInterfRel.IDInterfRel; PortInterfRelData.UnitInterfKolvo := APortInterfRel.UnitInterfKolvo; TPortInterfRelData(Pointer(Integer(FPortInterfRelBuff.FBuffer) + (FPortInterfRelBuff.RecSize*FPortInterfRelBuff.RecCount))^) := PortInterfRelData; FPortInterfRelBuff.RecCount := FPortInterfRelBuff.RecCount + 1; if FPortInterfRelBuff.RecCount = FPortInterfRelBuff.MaxRecCount then SaveBuffToFile(FPortInterfRelBuff); end; procedure TMemBase.SaveResourceRelToBuff(AResoureRel: TSCSResourceRel); var ResourceRelData: TResourceRelData; begin ResourceRelData.IDResource := AResoureRel.IDResource; ResourceRelData.GuidNB := FCatalog.FStringsMan.GenStrID(AResoureRel.GuidNB, FCatalog.FStringsMan.FResourceRelGuidNBStrings); ResourceRelData.IDNB := AResoureRel.IDNB; ResourceRelData.TableKindNB := AResoureRel.TableKindNB; ResourceRelData.Cypher := FCatalog.FStringsMan.GenStrID(AResoureRel.Cypher, FCatalog.FStringsMan.FResourceRelCypherStrings); ResourceRelData.Name := FCatalog.FStringsMan.GenStrID(AResoureRel.Name, FCatalog.FStringsMan.FResourceRelNameStrings); ResourceRelData.Izm := FCatalog.FStringsMan.GenStrID(AResoureRel.Izm, FCatalog.FStringsMan.FIzmStrings); ResourceRelData.Price := AResoureRel.Price; ResourceRelData.AdditionalPrice := AResoureRel.AdditionalPrice; ResourceRelData.RType := AResoureRel.RType; ResourceRelData.ID := AResoureRel.ID; ResourceRelData.MasterTableKind := AResoureRel.MasterTableKind; ResourceRelData.IDMaster := AResoureRel.IDMaster; ResourceRelData.IDCompPropRel := AResoureRel.IDCompPropRel; ResourceRelData.Npp := AResoureRel.Npp; ResourceRelData.Kolvo := AResoureRel.Kolvo; ResourceRelData.Cost := AResoureRel.Cost; ResourceRelData.IsOn := AResoureRel.IsOn; ResourceRelData.ExpenseForLength := AResoureRel.ExpenseForLength; //ResourceRelData.ExpenseForSection := AResoureRel.ExpenseForSection; ResourceRelData.GUIDNBComponent := FCatalog.FStringsMan.GenStrID(AResoureRel.GUIDNBComponent, FCatalog.FStringsMan.FComponGuidNBStrings); ResourceRelData.CountForPoint := AResoureRel.CountForPoint; ResourceRelData.StepOfPoint := AResoureRel.StepOfPoint; TResourceRelData(Pointer(Integer(FResourceRelBuff.FBuffer) + (FResourceRelBuff.RecSize*FResourceRelBuff.RecCount))^) := ResourceRelData; FResourceRelBuff.RecCount := FResourceRelBuff.RecCount + 1; if FResourceRelBuff.RecCount = FResourceRelBuff.MaxRecCount then SaveBuffToFile(FResourceRelBuff); end; procedure TMemBase.SaveSprCompTypeToBuff(ASprCompType: TNBComponentType); var ComponentTypeData: TComponentTypeData; BuffInfo: TTableBufferInfo; begin ComponentTypeData.ID := ASprCompType.ComponentType.ID; ComponentTypeData.IDCatalog := ASprCompType.IDCatalog; ComponentTypeData.CatalogItemType := ASprCompType.CatalogItemType; ComponentTypeData.GUID := FCatalog.FStringsMan.GenStrID(ASprCompType.ComponentType.GUID, FCatalog.FStringsMan.ComponentTypeGUIDStrings); ComponentTypeData.Name := ASprCompType.ComponentType.Name; ComponentTypeData.NamePlural := ASprCompType.ComponentType.NamePlural; ComponentTypeData.SysName := FCatalog.FStringsMan.GenStrID(ASprCompType.ComponentType.SysName, FCatalog.FStringsMan.CompTypeSysNameStrings); ComponentTypeData.MarkMask := ASprCompType.ComponentType.MarkMask; ComponentTypeData.PortKind := ASprCompType.ComponentType.PortKind; ComponentTypeData.ActiveState := ASprCompType.ComponentType.ActiveState; ComponentTypeData.IDDesignIcon := ASprCompType.ComponentType.IDDesignIcon; ComponentTypeData.GUIDDesignIcon := FCatalog.FStringsMan.GenStrID(ASprCompType.ComponentType.GUIDDesignIcon, FCatalog.FStringsMan.ObjectIconGUIDStrings); ComponentTypeData.IsLine := ASprCompType.ComponentType.IsLine; ComponentTypeData.IsStandart := ASprCompType.ComponentType.IsStandart; ComponentTypeData.CoordZ := ASprCompType.ComponentType.CoordZ; ComponentTypeData.CanUseAsPoint := ASprCompType.ComponentType.CanUseAsPoint; ComponentTypeData.ComponentIndex := ASprCompType.ComponentType.ComponentIndex; ComponentTypeData.PropsCount := ASprCompType.PropsCount; BuffInfo := FSprCompTypeBuff; TComponentTypeData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ComponentTypeData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprCompTypePropToBuff(ASprCompTypeProp: TNBCompTypeProperty); var ComponTypePropData: TComponTypePropData; BuffInfo: TTableBufferInfo; begin ComponTypePropData.GuidComponentType := FCatalog.FStringsMan.GenStrID(ASprCompTypeProp.GuidComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); ComponTypePropData.Guid := ASprCompTypeProp.PropertyData.Guid; ComponTypePropData.ID := ASprCompTypeProp.PropertyData.ID; ComponTypePropData.IDComponType := ASprCompTypeProp.PropertyData.IDMaster; ComponTypePropData.IDProperty := ASprCompTypeProp.PropertyData.ID_Property; ComponTypePropData.GUIDProperty := FCatalog.FStringsMan.GenStrID(ASprCompTypeProp.PropertyData.GUIDProperty, FCatalog.FStringsMan.FPropertyGUIDStrings); ComponTypePropData.TakeIntoConnect := ASprCompTypeProp.PropertyData.TakeIntoConnect; ComponTypePropData.TakeIntoJoin := ASprCompTypeProp.PropertyData.TakeIntoJoin; ComponTypePropData.Value := FCatalog.FStringsMan.GenStrID(ASprCompTypeProp.PropertyData.Value, FCatalog.FStringsMan.FPropertyValueStrings); ComponTypePropData.IsStandart := ASprCompTypeProp.PropertyData.IsDefault; BuffInfo := FSprCompTypePropBuff; TComponTypePropData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ComponTypePropData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprCurrencyToBuff(ASprCurrency: TNBCurrency); var CurrencyData: TCurrencyData; BuffInfo: TTableBufferInfo; begin CurrencyData.IDCatalog := ASprCurrency.IDCatalog; CurrencyData.CatalogItemType := ASprCurrency.CatalogItemType; CurrencyData.ID := ASprCurrency.Data.ID; CurrencyData.GUID := ASprCurrency.Data.Guid; CurrencyData.Name := ASprCurrency.Data.Name; CurrencyData.NameBrief := ASprCurrency.Data.NameBrief; CurrencyData.Kolvo := ASprCurrency.Data.Kolvo; CurrencyData.Ratio := ASprCurrency.Data.Ratio; CurrencyData.Main := ASprCurrency.Data.Main; CurrencyData.IsCountry := ASprCurrency.Data.IsCountry; BuffInfo := FSprCurrencyBuff; TCurrencyData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := CurrencyData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprInterfaceToBuff(ASprInterface: TNBInterface); var InterfaceData: TInterfaceData; BuffInfo: TTableBufferInfo; begin InterfaceData.ID := ASprInterface.ID; InterfaceData.IDCatalog := ASprInterface.IDCatalog; InterfaceData.CatalogItemType := ASprInterface.CatalogItemType; InterfaceData.GUID := FCatalog.FStringsMan.GenStrID(ASprInterface.GUID, FCatalog.FStringsMan.FInterfaceGUIDStrings); InterfaceData.Name := ASprInterface.Name; InterfaceData.GUIDNetType := FCatalog.FStringsMan.GenStrID(ASprInterface.GuidNetType, FCatalog.FStringsMan.FNetTypeGUIDStrings); InterfaceData.IDNetType := ASprInterface.IDNetType; InterfaceData.SortID := ASprInterface.SortID; InterfaceData.ConstructiveWidth := ASprInterface.ConstructiveWidth; InterfaceData.Description := ASprInterface.Description; InterfaceData.IsUniversal := ASprInterface.IsUniversal; InterfaceData.InterfAccordanceCount := ASprInterface.InterfAccordanceCount; InterfaceData.InterfNormsCount := ASprInterface.InterfNormsCount; BuffInfo := FSprInterfaceBuff; TInterfaceData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := InterfaceData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprInterfAccordanceToBuff(ASprInterfAccordance: TNBInterfaceAccordance); var InterfaceAccordanceData: TInterfaceAccordanceData; BuffInfo: TTableBufferInfo; begin InterfaceAccordanceData.ID := ASprInterfAccordance.ID; InterfaceAccordanceData.GUID := ASprInterfAccordance.GUID; InterfaceAccordanceData.GUIDInterface := FCatalog.FStringsMan.GenStrID(ASprInterfAccordance.GuidInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); InterfaceAccordanceData.IDInterface := ASprInterfAccordance.IDInterface; InterfaceAccordanceData.InterfComponIsLine := ASprInterfAccordance.InterfComponIsLine; InterfaceAccordanceData.GUIDInterface := FCatalog.FStringsMan.GenStrID(ASprInterfAccordance.GUIDAccordance, FCatalog.FStringsMan.FInterfaceGUIDStrings); InterfaceAccordanceData.IDAccordance := ASprInterfAccordance.IDAccordance; InterfaceAccordanceData.AccordComponIsLine := ASprInterfAccordance.AccordComponIsLine; InterfaceAccordanceData.Kolvo := ASprInterfAccordance.Kolvo; BuffInfo := FSprInterfAccordanceBuff; TInterfaceAccordanceData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := InterfaceAccordanceData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprInterfNormToBuff(ASprInterfNorm: TNBInterfaceNorm); var InterfaceNormData: TInterfaceNormData; BuffInfo: TTableBufferInfo; begin InterfaceNormData.ID := ASprInterfNorm.ID; InterfaceNormData.GUID := ASprInterfNorm.GUID; InterfaceNormData.GuidInterface := FCatalog.FStringsMan.GenStrID(ASprInterfNorm.GuidInterface, FCatalog.FStringsMan.FInterfaceGUIDStrings); InterfaceNormData.IDInterface := ASprInterfNorm.IDInterface; InterfaceNormData.GUIDNBNorm := FCatalog.FStringsMan.GenStrID(ASprInterfNorm.GuidNBNorm, FCatalog.FStringsMan.FNormGuidNBStrings); InterfaceNormData.IDNBNorm := ASprInterfNorm.IDNBNorm; InterfaceNormData.Expense := ASprInterfNorm.Expense; InterfaceNormData.InterfaceIsBusy := ASprInterfNorm.InterfaceIsBusy; InterfaceNormData.GUIDComponentType := FCatalog.FStringsMan.GenStrID(ASprInterfNorm.GUIDComponentType, FCatalog.FStringsMan.FComponentTypeGUIDStrings); InterfaceNormData.IDComponentType := ASprInterfNorm.IDComponentType; InterfaceNormData.KoefLengthForCompl := ASprInterfNorm.KoefLengthForCompl; BuffInfo := FSprInterfNormBuff; TInterfaceNormData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := InterfaceNormData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprNetTypeToBuff(ASprNetType: TNBNetType); var NetTypeData: TNetTypeData; BuffInfo: TTableBufferInfo; begin NetTypeData.IDCatalog := ASprNetType.IDCatalog; NetTypeData.CatalogItemType := ASprNetType.CatalogItemType; NetTypeData.ID := ASprNetType.ID; NetTypeData.GUID := FCatalog.FStringsMan.GenStrID(ASprNetType.GUID, FCatalog.FStringsMan.FNetTypeGUIDStrings); NetTypeData.Name := ASprNetType.Name; BuffInfo := FSprNetTypeBuff; TNetTypeData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := NetTypeData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprNormToBuff(ASprNorm: TNBNorm); var NormData: TNBNormData; BuffInfo: TTableBufferInfo; begin NormData.IDCatalog := ASprNorm.IDCatalog; NormData.CatalogItemType := ASprNorm.CatalogItemType; NormData.ID := ASprNorm.ID; NormData.GUID := FCatalog.FStringsMan.GenStrID(ASprNorm.GUID, FCatalog.FStringsMan.FNormGuidNBStrings); NormData.Cypher := FCatalog.FStringsMan.GenStrID(ASprNorm.Cypher, FCatalog.FStringsMan.FNormCypherStrings); NormData.Name := FCatalog.FStringsMan.GenStrID(ASprNorm.Name, FCatalog.FStringsMan.FNormNameStrings); NormData.Izm := FCatalog.FStringsMan.GenStrID(ASprNorm.Izm, FCatalog.FStringsMan.FIzmStrings); //25.10.2013 NormData.LaborTime := ASprNorm.LaborTime; NormData.PricePerTime := ASprNorm.PricePerTime; //NormData.TimeUOM := ASprNorm.TimeUOM; NormData.Price := ASprNorm.Price; NormData.GUIDESmeta := ASprNorm.GUIDESmeta; BuffInfo := FSprNormBuff; TNBNormData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := NormData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprObjectIconToBuff(ASprObjectIcon: TNBObjectIcon); var ObjectIconData: TObjectIconData; BuffInfo: TTableBufferInfo; //StreamSize: Integer; begin BuffInfo := FSprObjectIconBuff; ObjectIconData.IDCatalog := ASprObjectIcon.IDCatalog; ObjectIconData.CatalogItemType := ASprObjectIcon.CatalogItemType; ObjectIconData.ID := ASprObjectIcon.ID; ObjectIconData.GUID := FCatalog.FStringsMan.GenStrID(ASprObjectIcon.GUID, FCatalog.FStringsMan.FObjectIconGUIDStrings); ObjectIconData.Name := ASprObjectIcon.Name; //StreamSize := ASprObjectIcon.ProjBlk.Size; ObjectIconData.ProjBlk := AppendStreamToBuff(BuffInfo, ASprObjectIcon.ProjBlk, false); ObjectIconData.ProjBmp := AppendStreamToBuff(BuffInfo, ASprObjectIcon.ProjBmp, false); ObjectIconData.ActiveBlk := AppendStreamToBuff(BuffInfo, ASprObjectIcon.ActiveBlk, false); ObjectIconData.ActiveBmp := AppendStreamToBuff(BuffInfo, ASprObjectIcon.ActiveBmp, false); {if StreamSize = 0 then ObjectIconData.ProjBlk := '' else begin ObjectIconData.ProjBlk := GetUniqueFileName('', enBlb); ASprObjectIcon.ProjBlk.SaveToFile(FDirName+'\'+ObjectIconData.ProjBlk); end; StreamSize := ASprObjectIcon.ProjBmp.Size; if StreamSize = 0 then ObjectIconData.ProjBmp := '' else begin ObjectIconData.ProjBmp := GetUniqueFileName('', enBlb); ASprObjectIcon.ProjBmp.SaveToFile(FDirName+'\'+ObjectIconData.ProjBmp); end; StreamSize := ASprObjectIcon.ActiveBlk.Size; if StreamSize = 0 then ObjectIconData.ActiveBlk := '' else begin ObjectIconData.ActiveBlk := GetUniqueFileName('', enBlb); ASprObjectIcon.ActiveBlk.SaveToFile(FDirName+'\'+ObjectIconData.ActiveBlk); end; StreamSize := ASprObjectIcon.ActiveBmp.Size; if StreamSize = 0 then ObjectIconData.ActiveBmp := '' else begin ObjectIconData.ActiveBmp := GetUniqueFileName('', enBlb); ASprObjectIcon.ActiveBmp.SaveToFile(FDirName+'\'+ObjectIconData.ActiveBmp); end; } TObjectIconData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ObjectIconData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprProducerToBuff(ASprProducer: TNBProducer); var ProducerData: TProducerData; BuffInfo: TTableBufferInfo; begin ProducerData.IDCatalog := ASprProducer.IDCatalog; ProducerData.CatalogItemType := ASprProducer.CatalogItemType; ProducerData.ID := ASprProducer.ID; ProducerData.GUID := FCatalog.FStringsMan.GenStrID(ASprProducer.GUID, FCatalog.FStringsMan.FProducerGUIDStrings); ProducerData.Name := ASprProducer.Name; ProducerData.Description := ASprProducer.Description; BuffInfo := FSprProducerBuff; TProducerData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ProducerData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprPropertyToBuff(ASprProperty: TNBProperty); var PropertyData: TPropertyBuffData; BuffInfo: TTableBufferInfo; begin PropertyData.IDCatalog := ASprProperty.IDCatalog; PropertyData.CatalogItemType := ASprProperty.CatalogItemType; PropertyData.ID := ASprProperty.PropertyData.ID; PropertyData.GUID := FCatalog.FStringsMan.GenStrID(ASprProperty.PropertyData.GUID, FCatalog.FStringsMan.FPropertyGUIDStrings); PropertyData.IDDataType := ASprProperty.PropertyData.IDDataType; PropertyData.Name := ASprProperty.PropertyData.Name; PropertyData.SysName := ASprProperty.PropertyData.SysName; PropertyData.Izm := ASprProperty.PropertyData.Izm; PropertyData.ValueReq := ASprProperty.PropertyData.ValueReq; PropertyData.MinValue := ASprProperty.PropertyData.MinValue; PropertyData.MaxValue := ASprProperty.PropertyData.MaxValue; PropertyData.DefValue := ASprProperty.PropertyData.DefValue; PropertyData.Description := ASprProperty.PropertyData.Description; PropertyData.IsStandart := ASprProperty.PropertyData.IsStandart; PropertyData.SortID := ASprProperty.PropertyData.SortID; PropertyData.ISProject := ASprProperty.PropertyData.ISProject; PropertyData.ISFolder := ASprProperty.PropertyData.ISFolder; PropertyData.ISList := ASprProperty.PropertyData.ISList; PropertyData.ISRoom := ASprProperty.PropertyData.ISRoom; PropertyData.ISSCSLine := ASprProperty.PropertyData.ISSCSLine; PropertyData.ISSCSConnector := ASprProperty.PropertyData.ISSCSConnector; PropertyData.ISComponLine := ASprProperty.PropertyData.ISComponLine; PropertyData.ISComponConn := ASprProperty.PropertyData.ISComponConn; PropertyData.IsForWholeComponent := ASprProperty.PropertyData.IsForWholeComponent; PropertyData.IsValueRelToObj := ASprProperty.PropertyData.IsValueRelToObj; PropertyData.PropValRelCount := ASprProperty.PropValRelCount; BuffInfo := FSprPropertyBuff; TPropertyBuffData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := PropertyData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprPropValRelToBuff(ASprPropValRel: TNBPropValRel); var PropValRelData: TPropValRelBuffData; BuffInfo: TTableBufferInfo; begin PropValRelData.GUID := FCatalog.FStringsMan.GenStrID(ASprPropValRel.GUID, FCatalog.FStringsMan.FPropValRelGUIDStrings); PropValRelData.GuidProperty := FCatalog.FStringsMan.GenStrID(ASprPropValRel.GuidProperty, FCatalog.FStringsMan.FPropertyGUIDStrings); PropValRelData.PValue := FCatalog.FStringsMan.GenStrID(ASprPropValRel.PValue, FCatalog.FStringsMan.FPropertyValueStrings); PropValRelData.MinValue := FCatalog.FStringsMan.GenStrID(ASprPropValRel.MinValue, FCatalog.FStringsMan.FPropertyValueStrings); PropValRelData.MaxValue := FCatalog.FStringsMan.GenStrID(ASprPropValRel.MaxValue, FCatalog.FStringsMan.FPropertyValueStrings); PropValRelData.ID := ASprPropValRel.ID; PropValRelData.IDProperty := ASprPropValRel.IDProperty; PropValRelData.PropValNormResCount := ASprPropValRel.PropValNormResCount; BuffInfo := FSprPropValRelBuff; TPropValRelBuffData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := PropValRelData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprPropValNormResToBuff(ASprPropValNormRes: TNBPropValNormRes); var PropValNormResData: TPropValNormResBuffData; BuffInfo: TTableBufferInfo; begin PropValNormResData.GuidPropValRel := FCatalog.FStringsMan.GenStrID(ASprPropValNormRes.GuidPropValRel, FCatalog.FStringsMan.FPropValRelGUIDStrings); PropValNormResData.GuidNBComponent := FCatalog.FStringsMan.GenStrID(ASprPropValNormRes.GuidNBComponent, FCatalog.FStringsMan.FComponGuidNBStrings); PropValNormResData.GuidNBRES := FCatalog.FStringsMan.GenStrID(ASprPropValNormRes.GuidNBRes, FCatalog.FStringsMan.FResourceRelGuidNBStrings); PropValNormResData.GuidNBNorm := FCatalog.FStringsMan.GenStrID(ASprPropValNormRes.GuidNBNorm, FCatalog.FStringsMan.FNormGuidNBStrings); PropValNormResData.ID := ASprPropValNormRes.ID; PropValNormResData.GUID := ASprPropValNormRes.GUID; PropValNormResData.IDPropValRel := ASprPropValNormRes.IDPropValRel; PropValNormResData.IDNBComponent := ASprPropValNormRes.IDNBComponent; PropValNormResData.IDNBRES := ASprPropValNormRes.IDNBRes; PropValNormResData.IDNBNorm := ASprPropValNormRes.IDNBNorm; PropValNormResData.Kolvo := ASprPropValNormRes.Kolvo; PropValNormResData.ExpenseForLength := ASprPropValNormRes.ExpenseForLength; PropValNormResData.CountForPoint := ASprPropValNormRes.CountForPoint; PropValNormResData.StepOfPoint := ASprPropValNormRes.StepOfPoint; BuffInfo := FSprPropValNormResBuff; TPropValNormResBuffData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := PropValNormResData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprResourceToBuff(ASprResource: TNBResource); var ResourceData: TResourceData; BuffInfo: TTableBufferInfo; begin ResourceData.IDCatalog := ASprResource.IDCatalog; ResourceData.CatalogItemType := ASprResource.CatalogItemType; ResourceData.ID := ASprResource.ID; ResourceData.GUID := FCatalog.FStringsMan.GenStrID(ASprResource.GUID, FCatalog.FStringsMan.FResourceRelGuidNBStrings); ResourceData.Cypher := FCatalog.FStringsMan.GenStrID(ASprResource.Cypher, FCatalog.FStringsMan.FResourceRelCypherStrings); ResourceData.Name := FCatalog.FStringsMan.GenStrID(ASprResource.Name, FCatalog.FStringsMan.FResourceRelNameStrings); ResourceData.Izm := FCatalog.FStringsMan.GenStrID(ASprResource.Izm, FCatalog.FStringsMan.FIzmStrings); ResourceData.Price := ASprResource.Price; ResourceData.RType := ASprResource.RType; BuffInfo := FSprResourceBuff; TResourceData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := ResourceData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveSprSuppliesKindToBuff(ASprSuppliesKind: TNBSuppliesKind); var SuppliesKindData: TSuppliesKindData; BuffInfo: TTableBufferInfo; begin SuppliesKindData.IDCatalog := ASprSuppliesKind.IDCatalog; SuppliesKindData.CatalogItemType := ASprSuppliesKind.CatalogItemType; SuppliesKindData.ID := ASprSuppliesKind.Data.ID; SuppliesKindData.GUID := FCatalog.FStringsMan.GenStrID(ASprSuppliesKind.Data.GUID, FCatalog.FStringsMan.FSuppliesKindGUIDStrings); SuppliesKindData.Name := ASprSuppliesKind.Data.Name; SuppliesKindData.NameTradUOM := ASprSuppliesKind.Data.NameTradUOM; SuppliesKindData.Izm := ASprSuppliesKind.Data.Izm; SuppliesKindData.IzmTradUOM := ASprSuppliesKind.Data.IzmTradUOM; SuppliesKindData.UnitKolvo := ASprSuppliesKind.Data.UnitKolvo; SuppliesKindData.UnitKolvoTradUOM := ASprSuppliesKind.Data.UnitKolvoTradUOM; BuffInfo := FSprSuppliesKindBuff; TSuppliesKindData(Pointer(Integer(BuffInfo.FBuffer) + (BuffInfo.RecSize*BuffInfo.RecCount))^) := SuppliesKindData; BuffInfo.RecCount := BuffInfo.RecCount + 1; if BuffInfo.RecCount = BuffInfo.MaxRecCount then SaveBuffToFile(BuffInfo); end; procedure TMemBase.SaveStringsManInfoBuff(AStringsManInfo: PStringsManInfo); var StringsManData: TStringsManData; begin StringsManData.ID := AStringsManInfo.ID; StringsManData.StrType := AStringsManInfo.StrType; StringsManData.Name := AStringsManInfo.Name; TStringsManData(Pointer(Integer(FStringsManBuff.FBuffer) + (FStringsManBuff.RecSize*FStringsManBuff.RecCount))^) := StringsManData; FStringsManBuff.RecCount := FStringsManBuff.RecCount + 1; if FStringsManBuff.RecCount = FStringsManBuff.MaxRecCount then SaveBuffToFile(FStringsManBuff); end; function TMemBase.GetMTKatalog: TSQLMemTable; begin Result := nil; Result := TSQLMemTable.Create(nil); Result.FieldDefs.Add(fnID, ftInteger); Result.FieldDefs.Add(fnParentID, ftInteger); //Result.FieldDefs.Add(fnProjectID, ftInteger); Result.FieldDefs.Add(fnListID, ftInteger); Result.FieldDefs.Add(fnName, ftString, 255); Result.FieldDefs.Add(fnNameShort, ftString, 200); Result.FieldDefs.Add(fnNameMark, ftString, 200); Result.FieldDefs.Add(fnIsUserName, ftInteger); Result.FieldDefs.Add(fnSortID, ftInteger); Result.FieldDefs.Add(fnKolCompon, ftInteger); Result.FieldDefs.Add(fnItemsCount, ftInteger); Result.FieldDefs.Add(fnIDItemType, ftInteger); Result.FieldDefs.Add(fnMarkID, ftInteger); Result.FieldDefs.Add(fnIsIndexWithName, ftInteger); Result.FieldDefs.Add(fnSCSID, ftInteger); Result.FieldDefs.Add(fnIndexConn, ftInteger); Result.FieldDefs.Add(fnIndexJoiner, ftInteger); Result.FieldDefs.Add(fnIndexLine, ftInteger); Result.FieldDefs.Add(fnSettings, ftBlob); Result.FieldDefs.Add(fnDefListSettings, ftBlob); Result.FieldDefs.Add(fnCompTypeMarkMasks, ftBlob); Result.FieldDefs.Add(fnCADBlock, ftBlob); Result.FieldDefs.Add(fnCAD3D, ftBlob); Result.FieldDefs.Add(fnPMBlock, ftBlob); Result.FieldDefs.Add(fnGenerators, ftBlob); Result.FieldDefs.Add(fnBuildID, ftInteger); Result.FieldDefs.Add(fnNBBuildID, ftInteger); Result.FieldDefs.Add(fnComponFilterBlock, ftBlob); end; function TMemBase.GetScriptForCreateCADObjects: String; begin { Result := ' '+ 'CREATE TABLE CAD_NORM_STRUCT ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CATALOG INTEGER DEFAULT 0, '+ 'ID_ITEM_TYPE INTEGER DEFAULT 0, '+ 'NPP VARCHAR(10), '+ 'NAME VARCHAR(255), '+ 'IZM VARCHAR(20), '+ 'KOLVO VARCHAR(50)); '+ 'CREATE TABLE CAD_NORM_COLUMN ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CAD_NORM_STRUCT INTEGER DEFAULT 0, '+ 'NAME VARCHAR(255), '+ 'CHILD_COLUMNS BLOB); '+ 'CREATE TABLE CAD_CROSS_OBJECT ( '+ 'ID INTEGER DEFAULT 0, '+ 'OBJECT_ID INTEGER DEFAULT 0, '+ 'LIST_ID INTEGER DEFAULT 0, '+ 'COMPON_TYPE_SYSNAME VARCHAR(50), '+ 'COMPON_NAME_MARK VARCHAR(255), '+ 'NAME_SHORT VARCHAR(200)); '+ 'CREATE TABLE CAD_CROSS_OBJECT_ELEMENT ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CAD_CROSS_OBJECT INTEGER DEFAULT 0, '+ 'ID_INTERFACE INTEGER DEFAULT 0, '+ 'NPP VARCHAR(255), '+ 'CABLE_CAPACITY INTEGER DEFAULT 0, '+ 'CABLE_NAME_MARK VARCHAR(255), '+ 'CABLE_DIAMETER FLOAT DEFAULT 0, '+ 'SIGN_TYPE INTEGER DEFAULT 0, '+ 'CONNECTING_TRACE_ID INTEGER DEFAULT 0, '+ 'ANGLE FLOAT DEFAULT 0, '+ 'IN_POINT_X FLOAT DEFAULT 0, '+ 'IN_POINT_Y FLOAT DEFAULT 0 '+ '); '; } Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_CADNormStruct.Exists then Result := Result + ' '+ 'CREATE TABLE CAD_NORM_STRUCT ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CATALOG INTEGER DEFAULT 0, '+ 'ID_ITEM_TYPE INTEGER DEFAULT 0, '+ 'NPP VARCHAR(10), '+ 'NAME VARCHAR(255), '+ 'IZM INTEGER, '+ 'KOLVO VARCHAR(50)); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_CADNormColumn.Exists then Result := Result + 'CREATE TABLE CAD_NORM_COLUMN ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CAD_NORM_STRUCT INTEGER DEFAULT 0, '+ 'NAME VARCHAR(255), '+ 'CHILD_COLUMNS BLOB); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_CADCrossObject.Exists then Result := Result + 'CREATE TABLE CAD_CROSS_OBJECT ( '+ 'ID INTEGER DEFAULT 0, '+ 'OBJECT_ID INTEGER DEFAULT 0, '+ 'LIST_ID INTEGER DEFAULT 0, '+ 'COMPON_TYPE_SYSNAME INTEGER, '+ 'COMPON_NAME_MARK VARCHAR(255), '+ 'NAME_SHORT INTEGER); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_CADCrossObjectElement.Exists then Result := Result + 'CREATE TABLE CAD_CROSS_OBJECT_ELEMENT ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_CAD_CROSS_OBJECT INTEGER DEFAULT 0, '+ 'ID_INTERFACE INTEGER DEFAULT 0, '+ 'NPP VARCHAR(255), '+ 'CABLE_CAPACITY INTEGER DEFAULT 0, '+ 'CABLE_NAME_MARK INTEGER, '+ 'CABLE_DIAMETER FLOAT DEFAULT 0, '+ 'SIGN_TYPE INTEGER DEFAULT 0, '+ 'CONNECTING_TRACE_ID INTEGER DEFAULT 0, '+ 'ANGLE FLOAT DEFAULT 0, '+ 'IN_POINT_X FLOAT DEFAULT 0, '+ 'IN_POINT_Y FLOAT DEFAULT 0 '+ '); '; end; function TMemBase.GetScriptForCreateFilters: String; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_Filters.Exists then begin Result := Result + 'CREATE TABLE '+tnFilters+' ( '+ fnID+' INTEGER DEFAULT 0, '+ fnFilterType+' SMALLINT DEFAULT 0, '+ fnFilterValue +' BLOB, '+ fnUseInCad+' BOOLEAN '+ '); '; end else begin if TF_Main(FCatalog.FActiveForm).DM.tSQL_Filters.FieldDefs.IndexOf(fnUseInCad) = -1 then //TF_Main(FCatalog.FActiveForm).DM.tSQL_Filters.FieldDefs.Add(fnUseInCad, ftBoolean); Result := Result + 'ALTER TABLE '+tnFilters+' ADD ('+fnUseInCad+' BOOLEAN);'; end; end; function TMemBase.GetScriptForCreateInterfPosConnection: String; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_InterfPosConnection.Exists then Result := ' '+ 'CREATE TABLE INTERF_POS_CONNECTION ( '+ 'ID INTEGER DEFAULT 0, '+ 'ID_IOFI_REL INTEGER DEFAULT 0, '+ 'SELF_FROM_POS INTEGER DEFAULT 0, '+ 'SELF_TO_POS INTEGER DEFAULT 0, '+ 'CONN_FROM_POS INTEGER DEFAULT 0, '+ 'CONN_TO_POS INTEGER DEFAULT 0); ' ; end; function TMemBase.GetScriptForCreateObjectsBlobs: String; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_ObjectsBlobs.Exists then Result := ' '+ 'CREATE TABLE '+tnObjectsBlobs+' ( '+ fnID+' INTEGER, '+ fnTableKind+' INTEGER, '+ fnObjIDs+' BLOB, '+ fnDataKind+' INTEGER, '+ fnObjectData+' BLOB); ' ; end; function TMemBase.GetScriptForCreatePortInterfaceRelation: String; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_PortInterfaceRelation.Exists then Result := 'CREATE TABLE PORT_INTERFACE_RELATION ( '+ //18.10.2007 'ID AUTOINC, '+ 'ID INTEGER, '+ 'REL_TYPE INTEGER, '+ 'ID_PORT INTEGER, '+ 'ID_INTERF_REL INTEGER, '+ 'UNIT_INTERF_KOLVO INTEGER); '; // ' ALTER TABLE PORT_INTERFACE_RELATION ADD PRIMARY KEY PK_PORT_INTERF_REL (ID); '; // ' ALTER TABLE PORT_INTERFACE_RELATION ADD FOREIGN KEY FK_PORTINTERF_RELATION (ID_PORT) REFERENCES INTERFACE_RELATION MATCH FULL ON DELETE CASCADE ON UPDATE CASCADE; '; // ' CREATE INDEX PORT_INTERF_REL_IDX1 ON PORT_INTERFACE_RELATION (ID_INTERF_REL); '; end; function TMemBase.GetScriptForCreateSpravochniks: String; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_ComponentTypes.Exists then Result := Result + ' '+ 'CREATE TABLE COMPONENT_TYPES ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255), '+ 'NAME_PLURAL VARCHAR(255), '+ 'SYSNAME INTEGER, '+ 'PORT_KIND INTEGER DEFAULT 0, '+ 'ACTIVE_STATE INTEGER DEFAULT 0, '+ 'ISLINE INTEGER DEFAULT 0, '+ 'ISSTANDART INTEGER DEFAULT 0, '+ 'MARK_MASK VARCHAR(200), '+ 'ID_DESIGN_ICON INTEGER, '+ 'GUIDDesignIcon INTEGER, '+ 'COORDZ FLOAT, '+ 'PROPS_COUNT INTEGER, '+ 'COMPONENT_INDEX INTEGER, '+ fnCanUseAsPoint+' SHORTINT'+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_CompTypePropRelation.Exists then Result := Result + 'CREATE TABLE COMP_TYPE_PROP_RELATION ( '+ 'ID INTEGER NOT NULL, '+ 'GUID VARCHAR(40), '+ 'GUID_COMPONENT_TYPE INTEGER, '+ 'GUID_PROPERTY INTEGER, '+ 'ID_COMPONENT_TYPE INTEGER, '+ 'ID_PROPERTY INTEGER, '+ 'PVALUE INTEGER, '+ 'TAKE_INTO_CONNECT INTEGER DEFAULT 0, '+ 'TAKE_INTO_JOIN INTEGER, '+ 'ISSTANDART INTEGER DEFAULT 0 '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_Interface.Exists then Result := Result + 'CREATE TABLE INTERFACE ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255), '+ 'GUID_NET_TYPE INTEGER, '+ 'ID_NET_TYPE INTEGER, '+ 'DESCRIPTION VARCHAR(255), '+ 'SORT_ID INTEGER, '+ 'CONSTRUCTIVE_WIDTH FLOAT, '+ fnIsUniversal +' '+scelSmallInt +', '+ 'INTERF_ACCORDANCE_COUNT INTEGER, '+ 'INTERF_NORMS_COUNT INTEGER'+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_InterfaceNorms.Exists then Result := Result + 'CREATE TABLE INTERFACE_NORMS ( '+ 'ID INTEGER NOT NULL, '+ 'GUID VARCHAR(40), '+ 'GUID_INTERFACE INTEGER, '+ 'ID_INTERFACE INTEGER, '+ 'GUID_NB_NORM INTEGER, '+ 'ID_NB_NORM INTEGER, '+ 'GUID_COMPONENT_TYPE INTEGER, '+ 'ID_COMPONENT_TYPE INTEGER, '+ 'EXPENSE FLOAT, '+ 'INTERFACE_ISBUSY INTEGER DEFAULT 0, '+ 'KOEF_LENGTH_FOR_COMPL FLOAT '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_InterfaceAccordance.Exists then Result := Result + 'CREATE TABLE INTERFACE_ACCORDANCE ( '+ 'ID INTEGER NOT NULL, '+ 'GUID VARCHAR(40), '+ 'GUID_INTERFACE INTEGER, '+ 'ID_INTERFACE INTEGER, '+ 'INTERF_COMPON_ISLINE INTEGER, '+ 'GUID_ACCORDANCE INTEGER, '+ 'ID_ACCORDANCE INTEGER, '+ 'ACCORD_COMPON_ISLINE INTEGER, '+ 'KOLVO INTEGER DEFAULT 1 '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_Currency.Exists then Result := Result + 'CREATE TABLE CURRENCY ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID VARCHAR(40), '+ 'NAME VARCHAR(255), '+ 'NAME_BRIEF VARCHAR(255), '+ 'KOLVO INTEGER, '+ 'RATIO FLOAT, '+ 'MAIN SMALLINT DEFAULT 0, '+ 'SORT_ID INTEGER, '+ 'ISCOUNTRY INTEGER '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_NetType.Exists then Result := Result + 'CREATE TABLE NET_TYPE ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255) '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_NBNorms.Exists then Result := Result + 'CREATE TABLE NB_NORMS ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'CYPHER INTEGER, '+ 'NAME INTEGER, '+ 'IZM INTEGER, '+ //25.10.2013 fnLaborTime+' '+scelInteger+', '+ fnPricePerTime+' '+scelFloat+', '+ //fnTimeUOM+' '+scelInteger+', '+ 'PRICE FLOAT, '+ 'GUID_ESMETA VARCHAR(40) '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_ObjectIcons.Exists then Result := Result + 'CREATE TABLE OBJECT_ICONS ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255), '+ 'PROJ_BLK BLOB, '+ 'PROJ_BMP BLOB, '+ 'ACTIVE_BLK BLOB, '+ 'ACTIVE_BMP BLOB '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_Producers.Exists then Result := Result + 'CREATE TABLE PRODUCERS ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255), '+ 'DESCRIPTION VARCHAR(255) '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_Properties.Exists then Result := Result + 'CREATE TABLE PROPERTIES ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'ID_DATA_TYPE INTEGER, '+ 'NAME VARCHAR(255), '+ 'SYSNAME VARCHAR(200), '+ 'IZM VARCHAR(255), '+ 'VALUE_REQ SMALLINT DEFAULT 1, '+ 'MIN_VALUE FLOAT, '+ 'MAX_VALUE FLOAT, '+ 'DEF_VALUE VARCHAR(255), '+ 'DESCRIPTION VARCHAR(255), '+ 'ISSTANDART SMALLINT DEFAULT 0, '+ 'SORT_ID INTEGER, '+ 'ISPROJECT INTEGER DEFAULT 0, '+ 'ISFOLDER INTEGER DEFAULT 0, '+ 'ISLIST INTEGER DEFAULT 0, '+ 'ISROOM INTEGER DEFAULT 0, '+ 'ISSCSLINE INTEGER DEFAULT 0, '+ 'ISSCSCONNECTOR INTEGER DEFAULT 0, '+ 'ISCOMPONLINE INTEGER DEFAULT 0, '+ 'ISCOMPONCONN INTEGER DEFAULT 0, '+ 'IS_FOR_WHOLE_COMPONENT INTEGER DEFAULT 1, '+ fnIsValueRelToObj+' '+scelSmallInt+', '+ fnPropValRelCount+' '+scelInteger+' '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_PropValRel.Exists then Result := Result + scelCreate+' '+scelTable+' '+tnPropValRel+' ('+ fnID+' '+scelInteger+', '+ fnGUID+' '+scelInteger+', '+ fnIDProperty+' '+scelInteger+', '+ fnGuidProperty+' '+scelInteger+', '+ fnPValue+' '+scelInteger+', '+ fnMinValue+' '+scelInteger+', '+ fnMaxValue+' '+scelInteger+', '+ fnPropValNormResCount+' '+scelInteger+' '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_PropValNormRes.Exists then Result := Result + scelCreate+' '+scelTable+' '+tnPropValNormRes+' ('+ fnID+' '+scelInteger+', '+ fnGUID+' '+scelVarchar40+', '+ fnIDPropValRel+' '+scelInteger+', '+ fnGuidPropValRel+' '+scelInteger+', '+ fnIDNBComponent+' '+scelInteger+', '+ fnGuidNBComponent+' '+scelInteger+', '+ fnIDNBRES+' '+scelInteger+', '+ fnGuidNBRES+' '+scelInteger+', '+ fnIDNBNorm+' '+scelInteger+', '+ fnGuidNBNorm+' '+scelInteger+', '+ fnKOLVO+' '+scelFloat+', '+ fnCOST+' '+scelFloat+', '+ fnExpenseForLength+' '+scelFloat+', '+ fnCountForPoint+' '+scelFloat+', '+ fnStepOfPoint+' '+scelFloat+' '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_NBResources.Exists then Result := Result + 'CREATE TABLE NB_RESOURCES ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'CYPHER INTEGER, '+ 'NAME INTEGER, '+ 'IZM INTEGER, '+ 'PRICE FLOAT, '+ 'RTYPE INTEGER '+ '); '; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_SuppliesKinds.Exists then Result := Result + 'CREATE TABLE SUPPLIES_KINDS ( '+ 'ID INTEGER NOT NULL, '+ 'ID_CATALOG INTEGER, '+ 'ID_ITEM_TYPE INTEGER, '+ 'GUID INTEGER, '+ 'NAME VARCHAR(255), '+ fnNameTradUOM+' VARCHAR(255), '+ 'IZM VARCHAR(255), '+ fnIzmTradUOM+' VARCHAR(255), '+ 'UNIT_KOLVO FLOAT, '+ fnUnitKolvoTradUOM+' FLOAT '+ '); '; end; function TMemBase.GetScriptForCreateStringsMan: string; begin Result := ''; if Not TF_Main(FCatalog.FActiveForm).DM.tSQL_StringsMan.Exists then Result := Result + ' '+ 'CREATE TABLE '+tnStringsMan+' ( '+ fnID+' INTEGER, '+ fnStrType+' SHORTINT, '+ fnName+' VARCHAR(255)'+ '); '; end; procedure TMemBase.LoadAllTables; var PackedStream, UnPackedStream: TStream; Size: Integer; BlockFieldName, PackedTmpFile, UnPackedTmpFile: String; // Tolik 28/08/2019 -- //oldTick, CurrTick: Cardinal; oldTick, CurrTick: DWord; // begin if FMemBaseMode = mbmSQLMemTable then begin with TF_Main(FCatalog.ActiveForm).DM do begin BlockFieldName := fnPMBlock; if FCatalog is TSCSProject then case TSCSProject(FCatalog).FOpenProjectMode of opmStandart: BlockFieldName := fnPMBlock; opmReserv: BlockFieldName := fnCADBlock; opmBeatens: BlockFieldName := fnBeatenBlock; end; oldTick := GetTickCount; DeleteFile(GetPathToUnPackedTmp(false)); DeleteFile(GetPathToPackedTmp(false)); PackedTmpFile := GetPathToPackedTmp(true); UnPackedTmpFile := GetPathToUnPackedTmp(true); //Stream := TMemoryStream.Create; //Stream := TFileStream.Create('Unpack.tmp', fmCreate); PackedStream := U_BaseCommon.GetFileStreamFromTableByID(tnCatalog, BlockFieldName, PackedTmpFile, FCatalog.CurrID, FCatalog.FQSelect); //PStream := U_BaseCommon.GetStreamFromTableByID(tnCatalog, BlockFieldName, FCatalog.CurrID, FCatalog.FQSelect); UnPackedStream := TFileStream.Create(UnPackedTmpFile, fmCreate); try PackedStream.Position := 0; PackedStream.Position := 0; UnPakStream(PackedStream, UnPackedStream); CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; UnPackedStream.Position := 0; Size := UnPackedStream.Size; //LoadAllTablesFromStream(UnPackedStream); FreeAndNil(UnPackedStream); LoadAllTablesFromFile(UnPackedTmpFile); //Size := Stream.Size; //if Size > 0 then //begin // tSQL_Katalog.LoadAllTablesFromStream(Stream); // // FMemBaseLoaded := true; // UpdateStructure; //FLoaded := true; { with TF_Main(ActiveForm).DM do begin qSQL_QueryTSCSOperat.Close; //qSQL_QueryTSCSOperat.SQL.Text := 'alter table component add(notice char(255)); '+ // 'alter table interface_relation add(notice char(255)); '; qSQL_QueryTSCSOperat.SQL.Text := 'alter table norms add(ID_NB INTEGER); '; try qSQL_QueryTSCSOperat.Open; except on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; raise; end; end; qSQL_QueryTSCSOperat.Close; end; } //end //else //begin // FCatalog.FActive := false; //FLoaded := false; //FMemBaseActive := false; //end; //TF_Main(ActiveForm).DM.qSQL_QuerySelect.r finally FreeAndNil(PackedStream); if UnPackedStream <> nil then FreeAndNil(UnPackedStream); DeleteFile(PackedTmpFile); DeleteFile(UnPackedTmpFile); end; end; end; end; procedure TMemBase.LoadAllTablesFromDir(ADirName: string); var i: Integer; CurrTable: TSQLMemTable; TableFName: string; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // begin OldTick := GetTickCount; with TF_Main(FCatalog.FActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if Not CurrTable.Active then begin if CurrTable.Exists then CurrTable.DeleteTable; TableFName := ADirName + '\'+ 't' + CurrTable.TableName + '.dat'; if FileExists(TableFName) then CurrTable.LoadTableFromFile(TableFName); end; end; TF_Main(FCatalog.FActiveForm).DM.FMemBaseLoaded := true; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; procedure TMemBase.LoadAllTablesFromFile(AFileName: string); var // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // StreamList: TStreamList; ReadTogether: Boolean; FileStream: TFileStream; CurrTable: TSQLMemTable; TableFName, TempDir: String; //FileNames: TStringList; begin try OldTick := GetTickCount; if FileExists(AFileName) then begin StreamList := TStreamList.Create(guidProjMemTables, true); try ReadTogether := true; if StreamList.ReadFileHeader(AFileName, Length(guidProjMemTables)) then if StreamList.FileCodeStr = guidProjMemTables then ReadTogether := false else StreamList.ReadFileEnd; if ReadTogether then begin // вычитываем все таблици вместе TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.LoadAllTablesFromFile(AFileName); end else begin // вычитываем каждую таблицу отдельно TempDir := ExtractSCSTempDir; while Not StreamList.EOF do begin {// считываем таблицу во временный файл TableFName := TempDir + GetUniqueFileName('', enDat); FileStream := TFileStream.Create(TableFName, fmCreate); StreamList.ReadStreamFromFile(FileStream, false); CurrTable := TF_Main(FCatalog.FActiveForm).DM.GetSQLMemTableByIndex(StreamList.ReadedStreamCode); if CurrTable <> nil then begin FileStream.Position := 0; CurrTable.LoadTableFromStream(FileStream); end; FreeAndNil(FileStream); DeleteFile(TableFName); } // считываем таблицу во временный файл TableFName := TempDir + GetUniqueFileName('', enDat); FileStream := TFileStream.Create(TableFName, fmCreate); StreamList.ReadStreamFromFile(FileStream, false); FreeAndNil(FileStream); CurrTable := TF_Main(FCatalog.FActiveForm).DM.GetSQLMemTableByIndex(StreamList.ReadedStreamCode); if CurrTable <> nil then begin try { if (CurrTable.Exists) then begin CurrTable.DeleteTable; CurrTable.LoadTableFromFile(TableFName); CurrTable.Open; end else} CurrTable.LoadTableFromFile(TableFName); except try CurrTable.LoadTableFromFile(TableFName); except CurrTable.LoadTableFromFile(TableFName); end; end; end; DeleteFile(TableFName); end; end; TF_Main(FCatalog.FActiveForm).DM.FMemBaseLoaded := true; UpdateStructure; finally FreeAndNil(StreamList); end; end else FCatalog.Active := false; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do AddExceptionToLogEx('TMemBase.LoadAllTablesFromFile', E.Message); end; end; procedure TMemBase.LoadAllTablesFromStream(AStream: TStream); var StreamSize: Integer; begin StreamSize := AStream.Size; if StreamSize > 0 then begin AStream.Position := 0; //TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.Database.DeleteDatabase; if TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.Database <> nil then if TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.Database.Exists then TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.Database.DeleteDatabase; TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.LoadAllTablesFromStream(AStream); TF_Main(FCatalog.FActiveForm).DM.FMemBaseLoaded := true; UpdateStructure; end else FCatalog.Active := false; end; procedure TMemBase.OpenAllTables; var QSelect: TSCSQuery; LastID: Integer; strSQL: String; CurrTable: TSQLMemTable; i: Integer; procedure CheckUpdateFieds(ATable: TSQLMemTable; AFieldName: String; AFieldType: TFieldType; ASize: Integer); begin if Assigned(ATable) then begin if ATable.FieldDefs.IndexOf(AFieldName) = -1 then begin ATable.FieldDefs.Add(AFieldName, AFieldType, ASize); end; end; end; begin //if FLoaded then if FMemBaseMode = mbmSQLMemTable then begin with TF_Main(FCatalog.ActiveForm).DM do if FMemBaseLoaded then begin for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists and Not CurrTable.Active then CurrTable.Open; end; FMemBaseActive := true; //UpdateValues; { if (FGenerators.LastGen_KatalogID = 0) and (FGenerators.LastGen_KatalogSCSID = 0) then begin tSQL_Katalog.Append; tSQL_Katalog.Post; FGenerators.LastGen_KatalogID := tSQL_Katalog.FieldByName(fnID).AsInteger; FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; end; if FGenerators.LastGen_KatalogID = 0 then FGenerators.LastGen_KatalogID := GetLastIDFromMemTable(tSQL_Katalog); if FGenerators.LastGen_KatalogSCSID = 0 then begin tSQL_Katalog.Append; tSQL_Katalog.Post; FGenerators.LastGen_KatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; end; //if FGenerators.LastGen_CatalogRelationID = 0 then // FGenerators.LastGen_CatalogRelationID := GetLastIDFromMemTable(tSQL_CatalogRelation); if FGenerators.LastGen_ComponentID = 0 then FGenerators.LastGen_ComponentID := GetLastIDFromMemTable(tSQL_Component); if FGenerators.LastGen_CatalogPropRelationID = 0 then FGenerators.LastGen_CatalogPropRelationID := GetLastIDFromMemTable(tSQL_CatalogPropRelation); if FGenerators.LastGen_ComponentRelationID = 0 then FGenerators.LastGen_ComponentRelationID := GetLastIDFromMemTable(tSQL_ComponentRelation); if FGenerators.LastGen_CompPropRelationID = 0 then FGenerators.LastGen_CompPropRelationID := GetLastIDFromMemTable(tSQL_CompPropRelation); if FGenerators.LastGen_CableCanalConnectorsID = 0 then FGenerators.LastGen_CableCanalConnectorsID := GetLastIDFromMemTable(tSQL_CableCanalConnectors); if FGenerators.LastGen_ConnectedComponentsID = 0 then FGenerators.LastGen_ConnectedComponentsID := GetLastIDFromMemTable(tSQL_ConnectedComponents); if FGenerators.LastGen_InterfaceRelationID = 0 then FGenerators.LastGen_InterfaceRelationID := GetLastIDFromMemTable(tSQL_InterfaceRelation); if FGenerators.LastGen_InterfOfInterfRelationID = 0 then FGenerators.LastGen_InterfOfInterfRelationID := GetLastIDFromMemTable(tSQL_InterfOfInterfRelation); if FGenerators.LastGen_PortInterfaceRelationID = 0 then FGenerators.LastGen_PortInterfaceRelationID := GetLastIDFromMemTable(tSQL_PortInterfaceRelation); if FGenerators.LastGen_NormsID = 0 then FGenerators.LastGen_NormsID := GetLastIDFromMemTable(tSQL_Norms); if FGenerators.LastGen_NormResourceRelID = 0 then FGenerators.LastGen_NormResourceRelID := GetLastIDFromMemTable(tSQL_NormResourceRel); if FGenerators.LastGen_ResourcesID = 0 then FGenerators.LastGen_ResourcesID := GetLastIDFromMemTable(tSQL_Resources); } //*** Индексы полей DefineFieldIndexesForKatalog; DefineFieldIndexesForCatRel; DefineFieldIndexesForCatPropRel; DefineFieldIndexesForComponent; DefineFieldIndexesForCompRel; DefineFieldIndexesForCompPropRel; DefineFieldIndexesForCableCanalConnectors; DefineFieldIndexesForConnectedComponents; DefineFieldIndexesForInterfaceRelation; DefineFieldIndexesForIOfIRel; DefineFieldIndexesForPortInterfRel; DefineFieldIndexesForInterfPosConnection; DefineFieldIndexesForNorms; DefineFieldIndexesForNormResRel; DefineFieldIndexesForResource; DefineFieldIndexesForCADNormStruct; DefineFieldIndexesForCADNormColumn; DefineFieldIndexesForStringsMan; { //*** Добавление новых полей if Not FieldExistsInTable(tSQL_Component, fnNotice) then begin tSQL_Component.Close; tSQL_Component.FieldDefs.Add(fnNotice, ftString, 255); tSQL_Component.Open; end; if Not FieldExistsInTable(tSQL_InterfaceRelation, fnNotice) then begin tSQL_InterfaceRelation.Close; tSQL_InterfaceRelation.FieldDefs.Add(fnNotice, ftString, 255); tSQL_InterfaceRelation.Open; end; } { tSQL_Katalog.Append; tSQL_Katalog.Post; FLastKatalogID := tSQL_Katalog.FieldByName(fnID).AsInteger; FLastKatalogSCSID := tSQL_Katalog.FieldByName(fnSCSID).AsInteger; tSQL_Katalog.Delete; FLastCableCanalConnectorID := GetLastIDFromMemTable(tSQL_CableCanalConnectors); FLastComponentID := GetLastIDFromMemTable(tSQL_Component); FLastCompRelID := GetLastIDFromMemTable(tSQL_ComponentRelation); FLastInterfRelID := GetLastIDFromMemTable(tSQL_InterfaceRelation); FLastInterfOfInterfRel := GetLastIDFromMemTable(tSQL_InterfOfInterfRelation); FLastComponPropRelID := GetLastIDFromMemTable(tSQL_CompPropRelation); FLastPortInterfRelID := GetLastIDFromMemTable(tSQL_PortInterfaceRelation); } end; end; end; function TMemBase.SaveAllTables: Boolean; var //Stream: TStream; //TmpProjectFilePath: String; PackedTmpFile, UnPackedTmpFile: String; PackedStream, UnPackedStream: TStream; begin Result := false; if FMemBaseMode = mbmSQLMemTable then begin with TF_Main(FCatalog.ActiveForm).DM do begin SetSQLToFIBQuery(Query_TSCSOperat, ' update katalog set PM_BLOCK = :PM_BLOCK where id = '''+IntTostr(Fcatalog.FCurrID)+''' ', false); {TmpProjectFilePath := ExtractFileDir(Application.ExeName); if DirectoryExists(TmpProjectFilePath +'\'+ dnTemp) then TmpProjectFilePath := TmpProjectFilePath +'\'+ dnTemp else begin if CreateDir(TmpProjectFilePath +'\'+ dnTemp) then TmpProjectFilePath := TmpProjectFilePath +'\'+ dnTemp; end; TmpProjectFilePath := TmpProjectFilePath + '\~Project.bin'; TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(TmpProjectFilePath);} UnPackedStream := nil; PackedStream := nil; DeleteFile(GetPathToUnPackedTmp(false)); DeleteFile(GetPathToPackedTmp(false)); UnPackedTmpFile := GetPathToUnPackedTmp(true); PackedTmpFile := GetPathToPackedTmp(true); if SaveAllTablesToFile(UnPackedTmpFile) then begin UnPackedStream := TFileStream.Create(UnPackedTmpFile, fmOpenRead); PackedStream := TFileStream.Create(PackedTmpFile, fmCreate); try if GTempFilesInfo.CheckIntegrity(cSCSComponent_Msg22_14) then begin UnPackedStream.Position := 0; //PakStream(UnPackedStream, PackedStream, clWorse); PakStream(UnPackedStream, PackedStream); PackedStream.Position := 0; Query_TSCSOperat.ParamByName(fnPMBlock).LoadFromStream(PackedStream); Query_TSCSOperat.ExecQuery; Query_TSCSOperat.Close; Result := true; end; finally FreeAndNil(PackedStream); FreeAndNil(UnPackedStream); DeleteFile(PackedTmpFile); DeleteFile(UnPackedTmpFile); end; end; { TmpProjectFilePath := GetPathToProjectTmp; if SaveAllTablesToFile(TmpProjectFilePath) then begin PakFile(TmpProjectFilePath, clWorse); Stream := TFileStream.Create(TmpProjectFilePath, fmOpenRead); try Stream.Position := 0; Query_TSCSOperat.ParamByName(fnPMBlock).LoadFromStream(Stream); Query_TSCSOperat.ExecQuery; Query_TSCSOperat.Close; finally FreeAndNil(Stream); end; DeleteFile(TmpProjectFilePath); end; } { Stream := TMemoryStream.Create; try Stream.Position := 0; TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(ExtractFileDir(Application.ExeName)+'\Stream.bin'); TF_Main(ActiveForm).DM.tSQL_Katalog.SaveAllTablesToStream(Stream); Stream.Position := 0; FQuery_Operat.ParamLoadFromStream('PM_BLOCK', Stream); FQuery_Operat.ExecQuery; FQuery_Operat.Close; finally FreeAndNil(Stream); end; } end; end; end; function TMemBase.SaveAllTablesToDir(ADirName: string): Boolean; var i: Integer; CurrTable: TSQLMemTable; TableFName: string; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // begin Result := false; OldTick := GetTickCount; if DirectoryExists(ADirName) then with TF_Main(FCatalog.FActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists and Not CurrTable.Active then begin TableFName := ADirName + '\'+ 't' + CurrTable.TableName + '.dat'; if FileExists(TableFName) then DeleteFile(TableFName); CurrTable.SaveTableToFile(TableFName); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; Result := true; end; function TMemBase.SaveAllTablesToFile(const AFileName: String; ATogether: Boolean): Boolean; var SaveTableTryCount: Integer; // Количество попыток сохранения таблицы SaveTableTryIdx: Integer; // Индекс попытки сохранения FileDir, TableFName, TempDir: String; DirExists: Boolean; // Tolik 28/08/2019 -- //CurrTick, OldTick: Cardinal; CurrTick, OldTick: DWord; // i: Integer; StreamList: TStreamList; FileStream: TFileStream; CurrTable: TSQLMemTable; FileNames: TStringList; SaveFail: Boolean; begin Result := false; try SaveTableTryCount := 3; SaveFail := false; FileDir := ExtractFileDir(AFileName); DirExists := false; if DirectoryExists(FileDir) then DirExists := true else if CreateDir(FileDir) then DirExists := true; OldTick := GetTickCount; if DirExists then begin if ATogether then begin TF_Main(FCatalog.FActiveForm).DM.tSQL_Katalog.SaveAllTablesToFile(AFileName); end else begin TempDir := ExtractSCSTempDir; StreamList := TStreamList.Create(guidProjMemTables, true); FileNames := TStringList.Create; // экспортируем таблици в файлы, и вносим их в список StreamList with TF_Main(FCatalog.FActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Exists and Not CurrTable.Active then begin TableFName := GetNoExistsFileNameForCopy(TempDir + 't' + CurrTable.TableName + '.dat'); FileNames.Add(TableFName); for SaveTableTryIdx := 1 to SaveTableTryCount do begin CurrTable.SaveTableToFile(TableFName); if Not FileExists(TableFName) or (FileSizeByName(TableFName) <= 0) then begin AddExceptionToLog(cSCSComponent_Msg22_1+' '+CurrTable.TableName +' '+TableFName+'; '+cSCSComponent_Msg22_2+' '+IntToStr(SaveTableTryIdx), false); if SaveTableTryIdx = SaveTableTryCount then begin SaveFail := true; Break; //// BREAK //// end; end else Break; //// BREAK //// end; FileStream := TFileStream.Create(TableFName, fmOpenRead); StreamList.Add(FileStream, CurrTable.Tag); end; end; // сохраняем в файл if Not SaveFail then begin for SaveTableTryIdx := 1 to SaveTableTryCount do begin StreamList.SaveToFile(AFileName); GTempFilesInfo.Add(AFileName); if Not FileExists(AFileName) or (FileSizeByName(AFileName) <= 0) then begin AddExceptionToLog(cSCSComponent_Msg22_3+' '+AFileName+'; '+cSCSComponent_Msg22_2+' '+IntToStr(SaveTableTryIdx), false); if SaveTableTryIdx = SaveTableTryCount then begin SaveFail := true; Break; //// BREAK //// end; end else Break; //// BREAK //// end; end; if Not SaveFail then if Not GTempFilesInfo.CheckFilesIntegrity(FileNames, cSCSComponent_Msg22_14) then begin SaveFail := true; end; // удаляем временные файлы FreeAndNil(StreamList); for i := 0 to FileNames.Count - 1 do DeleteFile(FileNames[i]); FreeAndNil(FileNames); end; if Not SaveFail and FileExists(AFileName) then Result := true; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; except on E: Exception do AddExceptionToLog('TMemBase.SaveAllTablesToFile: '+E.Message); end; end; procedure TMemBase.UnSortingTables; var CurrTable: TSQLMemTable; i: Integer; begin with TF_Main(FCatalog.FActiveForm).DM do for i := 0 to SQLMemTsbles.Count - 1 do begin CurrTable := TSQLMemTable(SQLMemTsbles[i]); if CurrTable.Filtered then CurrTable.Filtered := false; if CurrTable.IndexName <> '' then CurrTable.IndexName := ''; end; end; procedure TMemBase.UpdateStructure; var UpdateSQL: String; BuildID: Integer; begin UpdateSQL := ''; BuildID := FCatalog.FBuildID; with TF_Main(FCatalog.ActiveForm).DM do begin try qSQL_QueryTSCSOperat.Close; if BuildID = 0 then begin UpdateSQL := GetSQLForAddFieldToTable(tnComponent, fnCypher, ftString, 200, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnResources, fnAdditionalPrice, ftFloat, -1, qmMemory); Inc(BuildID); end; if BuildID = 1 then begin UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGuidNB, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDComponentType, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDSymbol, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDObjectIcon, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDProducer, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDSupplier, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGUIDNetType, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCatalogPropRelation, fnGuidProperty, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCableCanalConnectors, fnGuidNBConnector, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnCompPropRelation, fnGuidProperty, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnInterfaceRelation, fnGuidInterface, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnNorms, fnGuidNB, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnResources, fnGuidNB, ftString, cnstGUIDLength, qmMemory); Inc(BuildID); end; if BuildID = 2 then begin UpdateSQL := UpdateSQL +' '+GetScriptForCreatePortInterfaceRelation; Inc(BuildID); end; if BuildID = 3 then begin try qSQL_QueryTSCSOperat.Close; qSQL_QueryTSCSOperat.SQL.Text := 'drop table '+tnCatalogMarkMask+' CASCADE '; qSQL_QueryTSCSOperat.Open; except end; qSQL_QueryTSCSOperat.Close; Inc(BuildID); end; if BuildID = 4 then begin UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnComponent, fnGuidSuppliesKind, ftString, cnstGUIDLength, qmMemory); UpdateSQL := UpdateSQL +' '+ GetSQLForAddFieldToTable(tnNorms, fnIsFromInterface, ftInteger, cnstGUIDLength, qmMemory); end; if UpdateSQL <> '' then begin qSQL_QueryTSCSOperat.SQL.Text := UpdateSQL; qSQL_QueryTSCSOperat.Open; end; except {on E: ESQLMemException do begin if (E.NativeError <> 20001) then begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end; end else begin qSQL_QueryTSCSOperat.Active := false; //FActive := false; raise; end;} end; end; end; procedure TMemBase.BeginWrite; begin FFileAccesFailCount := 0; if FMemBaseMode = mbmFiles then begin CloseBuffers; OpenBuffers(fmCreate); FOwnedStreams.Clear; end; end; procedure TMemBase.EndWrite; begin if FMemBaseMode = mbmFiles then begin SaveBuffsToFiles; CloseBuffers; FOwnedStreams.Clear; end; end; { TStringsMan } procedure TStringsMan.AddStrToList(AStr: string; AID: Integer; AList: TStringList); var ItemIndex: integer; begin if Not AList.Find(AStr, ItemIndex) then AList.AddObject(AStr, TObject(AID)); end; procedure TStringsMan.Clear; begin FCataogNameStrings.Clear; FCataogNameShortStrings.Clear; FComponGuidNBStrings.Clear; FComponNameStrings.Clear; FComponNameShortStrings.Clear; FComponCypherStrings.Clear; FComponNoticeStrings.Clear; FComponArticulStrings.Clear; FComponentTypeGUIDStrings.Clear; FObjectIconGUIDStrings.Clear; FProducerGUIDStrings.Clear; FSuppliesKindGUIDStrings.Clear; FSupplierGUIDStrings.Clear; FNetTypeGUIDStrings.Clear; FIzmStrings.Clear; FInterfaceGUIDStrings.Clear; FInterfaceNoticeStrings.Clear; FInterfaceSideSectionStrings.Clear; FPropertyGUIDStrings.Clear; FPropertyValueStrings.Clear; FPropValRelGUIDStrings.Clear; FNBConnectorGuidStrings.Clear; FNormGuidNBStrings.Clear; FNormCypherStrings.Clear; FNormNameStrings.Clear; FNormWorkKindStrings.Clear; FResourceRelGuidNBStrings.Clear; FResourceRelCypherStrings.Clear; FResourceRelNameStrings.Clear; FCompTypeSysNameStrings.Clear; end; constructor TStringsMan.Create(ACatalogOwner: TSCSCatalogExtended); begin inherited create; FCatalog := ACatalogOwner; FProject := FCatalog.GetProject; FCataogNameStrings := CreateStringList; FCataogNameShortStrings := CreateStringList; FComponGuidNBStrings := CreateStringList; FComponNameStrings := CreateStringList; FComponNameShortStrings := CreateStringList; FComponCypherStrings := CreateStringList; FComponNoticeStrings := CreateStringList; FComponArticulStrings := CreateStringList; FComponentTypeGUIDStrings := CreateStringList; FObjectIconGUIDStrings := CreateStringList; FProducerGUIDStrings := CreateStringList; FSuppliesKindGUIDStrings := CreateStringList; FSupplierGUIDStrings := CreateStringList; FNetTypeGUIDStrings := CreateStringList; FIzmStrings := CreateStringList; FInterfaceGUIDStrings := CreateStringList; FInterfaceNoticeStrings := CreateStringList; FInterfaceSideSectionStrings := CreateStringList; FPropertyGUIDStrings := CreateStringList; FPropertyValueStrings := CreateStringList; FPropValRelGUIDStrings := CreateStringList; FNBConnectorGuidStrings := CreateStringList; FNormGuidNBStrings := CreateStringList; FNormCypherStrings := CreateStringList; FNormNameStrings := CreateStringList; FNormWorkKindStrings := CreateStringList; FResourceRelGuidNBStrings := CreateStringList; FResourceRelCypherStrings := CreateStringList; FResourceRelNameStrings := CreateStringList; FCompTypeSysNameStrings := CreateStringList; end; destructor TStringsMan.Destroy; begin FreeAndNil(FCataogNameStrings); FreeAndNil(FCataogNameShortStrings); FreeAndNil(FComponGuidNBStrings); FreeAndNil(FComponNameStrings); FreeAndNil(FComponNameShortStrings); FreeAndNil(FComponCypherStrings); FreeAndNil(FComponNoticeStrings); FreeAndNil(FComponArticulStrings); FreeAndNil(FComponentTypeGUIDStrings); FreeAndNil(FObjectIconGUIDStrings); FreeAndNil(FProducerGUIDStrings); FreeAndNil(FSuppliesKindGUIDStrings); FreeAndNil(FSupplierGUIDStrings); FreeAndNil(FNetTypeGUIDStrings); FreeAndNil(FIzmStrings); FreeAndNil(FInterfaceGUIDStrings); FreeAndNil(FInterfaceNoticeStrings); FreeAndNil(FInterfaceSideSectionStrings); FreeAndNil(FPropertyGUIDStrings); FreeAndNil(FPropertyValueStrings); FreeAndNil(FPropValRelGUIDStrings); FreeAndNil(FNBConnectorGuidStrings); FreeAndNil(FNormGuidNBStrings); FreeAndNil(FNormCypherStrings); FreeAndNil(FNormNameStrings); FreeAndNil(FNormWorkKindStrings); FreeAndNil(FResourceRelGuidNBStrings); FreeAndNil(FResourceRelCypherStrings); FreeAndNil(FResourceRelNameStrings); FreeAndNil(FCompTypeSysNameStrings); inherited; end; function TStringsMan.GenStrID(const AStr: string; AStringList: TStringList): Integer; var ItemIndex: Integer; //NewID: Integer; begin Result := 0; if AStringList.Find(AStr, ItemIndex) then Result := Integer(AStringList.Objects[ItemIndex]) else begin Result := Fproject.GenIDByGeneratorIndex(giStringID); AStringList.AddObject(AStr, TObject(Result)); //if Assigned(Fproject) then //begin // NewID := Fproject.GenIDByGeneratorIndex(giStringID); // AStringList.AddObject(AStr, TObject(NewID)); // Result := NewID; //end //else // raise Exception.Create(cSCSComponent_Msg16); end; end; function TStringsMan.GetStrByID(AID: Integer; AStringList: TStringList): string; var ItemIndex: Integer; begin Result := ''; ItemIndex := AStringList.IndexOfObject(TObject(AID)); if ItemIndex <> -1 then Result := AStringList[ItemIndex]; end; procedure TStringsMan.OnBeforeLoad; begin Clear; FProject := FCatalog.GetProject; end; function TStringsMan.CreateStringList: TStringList; begin Result := TStringList.Create; Result.Sorted := true; end; procedure AddNewSprGUIDsToProjectFromComponent(AComponent: TSCSComponent; ASpravochnik: TSpravochnik); var i, j: Integer; NewComponents: TSCSComponents; SCSCompon: TSCSComponent; ComponListOwner: TSCSList; ptrProperty: PProperty; begin if AComponent.FProjectOwner <> nil then begin ComponListOwner := AComponent.GetListOwner; NewComponents := TSCSComponents.Create(false); NewComponents.Assign(AComponent.FChildReferences, laCopy); NewComponents.Insert(0, AComponent); for i := 0 to NewComponents.Count - 1 do begin SCSCompon := NewComponents[i]; if ComponListOwner <> nil then AddStringToStringListOnce(ComponListOwner.FSpravochnik.FNewGUIDsComponentType, SCSCompon.GUIDComponentType); AddStringToStringListOnce(ASpravochnik.FNewGUIDsComponentType, SCSCompon.GUIDComponentType); AddStringToStringListOnce(ASpravochnik.FNewGUIDsNetType, SCSCompon.GUIDNetType); AddStringToStringListOnce(ASpravochnik.FNewGUIDsObjectIcons, SCSCompon.GUIDObjectIcon); AddStringToStringListOnce(ASpravochnik.FNewGUIDsProducers, SCSCompon.GUIDProducer); AddStringToStringListOnce(ASpravochnik.FNewGUIDsSuppliesKinds, SCSCompon.GUIDSuppliesKind); AddStringToStringListOnce(ASpravochnik.FNewGUIDsObjectIcons, SCSCompon.GUIDSymbol); for j := 0 to SCSCompon.FInterfaces.Count - 1 do AddStringToStringListOnce(ASpravochnik.FNewGUIDsInterface, SCSCompon.FInterfaces[j].GUIDInterface); for j := 0 to SCSCompon.FProperties.Count - 1 do begin ptrProperty := SCSCompon.FProperties[j]; AddStringToStringListOnce(ASpravochnik.FNewGUIDsProperties, ptrProperty.GUIDProperty); AddStringToStringListOnce(ASpravochnik.FNewGUIDsProperties, ptrProperty.GUIDCrossProperty); end; for j := 0 to SCSCompon.FNormsResources.FNorms.Count - 1 do AddStringToStringListOnce(ASpravochnik.FNewGUIDsNorms, SCSCompon.FNormsResources.FNorms[j].GuidNB); for j := 0 to SCSCompon.FNormsResources.FResources.Count - 1 do AddStringToStringListOnce(ASpravochnik.FNewGUIDsResources, SCSCompon.FNormsResources.FResources[j].GuidNB); end; FreeAndNil(NewComponents); end; end; function AddPreyscurantToNorm(ANorm: TSCSNorm; APreyscurant: TSCSComponent; AInterfaceType: Integer): TSCSNormPreyscurant; begin Result := nil; Result := TSCSNormPreyscurant.Create; Result.Name := APreyscurant.Name; Result.InterfaceType := itConstructive; Result.SCSComponentGUID := APreyscurant.GuidNB; Result.SCSComponent := APreyscurant; Result.Kolvo := ANorm.Kolvo; //1; Result.PairKolvo := 0; if Result.SCSComponent.IsLine = biTrue then begin //NormPreyscurant.Kolvo := TraceLength; //NormPreyscurant.SCSComponent.Length; Result.PairKolvo := GetComponPairCount(Result.SCSComponent); end; ANorm.FPreyscurants.Add(Result); end; function AddPropertyToComponFromSprBySysName(ACompon: TSCSComponent; ASpravochnik: TSpravochnik; const APropSysName, AValue: String): PProperty; var SprProperty: TNBProperty; begin Result := nil; SprProperty := ASpravochnik.GetPropertyBySysName(APropSysName); if SprProperty <> nil then begin // Если компонент создан то добавляем свойство с генерацией ID if ACompon.ID <> 0 then Result := ACompon.GetPropertyAsNew else Result := ACompon.AddProperty(0, '', dtNone, biFalse, biFalse, biFalse, '', '', ''); SprProperty.AssignToPProperty(Result); Result.Guid := CreateGUID; Result.Value := AValue; end; end; procedure AddPropsToComponFromSprBySN(ACompon: TSCSComponent; const APropSN: String; AValue: String=''); var PropGUID: String; Prop: TNBProperty; Val: String; begin if ACompon.GetPropertyBySysName(APropSN) = nil then begin // Подтягиваем в справочник проекта из НБ Val := AValue; Prop := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(APropSN); if Prop <> nil then begin ACompon.ProjectOwner.Spravochnik.GetPropertyWithAssign(Prop.PropertyData.GUID, F_NormBase.GSCSBase.NBSpravochnik); if Val = '' then Val := Prop.PropertyData.DefValue; end; AddPropertyToComponFromSprBySysName(ACompon, ACompon.ProjectOwner.Spravochnik, APropSN, Val); end; end; procedure AddPropsToComponFromSprBySysNames(ACompon: TSCSComponent; APropSysNames: TStringList; const AValue: String); var i: Integer; //PropGUID: String; //Prop: TNBProperty; begin //01.07.2011 //for i := 0 to APropSysNames.Count - 1 do // if ACompon.GetPropertyBySysName(APropSysNames[i]) = nil then // begin // // Подтягиваем в справочник проекта из НБ // Prop := F_NormBase.GSCSBase.NBSpravochnik.GetPropertyBySysName(APropSysNames[i]); // if Prop <> nil then // ACompon.ProjectOwner.Spravochnik.GetPropertyWithAssign(Prop.PropertyData.GUID, F_NormBase.GSCSBase.NBSpravochnik); // AddPropertyToComponFromSprBySysName(ACompon, ACompon.ProjectOwner.Spravochnik, APropSysNames[i], AValue); // end; for i := 0 to APropSysNames.Count - 1 do AddPropsToComponFromSprBySN(ACompon, APropSysNames[i], AValue); end; procedure AfterLoadListSetting(var aSetting: TListSettingRecord); begin //09.10.2012 - перенесено из TSCSList.LoadFromMemTable if aSetting.CADCaptionsKind = skExternalSCS then aSetting.SCSType := st_External else aSetting.SCSType := st_Internal; if aSetting.CADNewTraceLengthType = Ord(tltNone) then begin // Tolik 05/02/2021 -- {if aSetting.SCSType = st_Internal then aSetting.CADNewTraceLengthType := Ord(tltAuto) else if aSetting.SCSType = st_External then aSetting.CADNewTraceLengthType := Ord(tltUser); } aSetting.CADNewTraceLengthType := Ord(tltAuto); // end; // 2014-04-06 Переприсвоим все буленовские значения, потому что бывает что // со стрима в булиан приходит не 01 а к примеру $72 (х.з. почему но так по ходу сохранилось) // и если в булл не 01 а чт-то иное - криво начинает работать Actions. Код: // procedure TCustomAction.SetChecked(Value: Boolean);.... // ... if Value <> FChecked then - здесь не проходит проверка // Сделать бы такое и для настроек проекта... if aSetting.CADShowRaise then aSetting.CADShowRaise := True else aSetting.CADShowRaise := False; if aSetting.GroupListObjectsByType then aSetting.GroupListObjectsByType := True else aSetting.GroupListObjectsByType := False; if aSetting.ControlJoinByNetType then aSetting.ControlJoinByNetType := True else aSetting.ControlJoinByNetType := False; if aSetting.ControlComplectByProducer then aSetting.ControlComplectByProducer := True else aSetting.ControlComplectByProducer := False; if aSetting.ShowLineObjectLength then aSetting.ShowLineObjectLength := True else aSetting.ShowLineObjectLength := False; if aSetting.ShowLineObjectNote then aSetting.ShowLineObjectNote := True else aSetting.ShowLineObjectNote := False; if aSetting.ShowConnObjectNote then aSetting.ShowConnObjectNote := True else aSetting.ShowConnObjectNote := False; if aSetting.ShowLineObjectCaption then aSetting.ShowLineObjectCaption := True else aSetting.ShowLineObjectCaption := False; if aSetting.ShowConnObjectCaption then aSetting.ShowConnObjectCaption := True else aSetting.ShowConnObjectCaption := False; if aSetting.PutCableInTrace then aSetting.PutCableInTrace := True else aSetting.PutCableInTrace := False; if aSetting.ControlComplectByProperties then aSetting.ControlComplectByProperties := True else aSetting.ControlComplectByProperties := False; if aSetting.ControlJoinByProperties then aSetting.ControlJoinByProperties := True else aSetting.ControlJoinByProperties := False; if aSetting.KeepLineTypesRules then aSetting.KeepLineTypesRules := True else aSetting.KeepLineTypesRules := False; if aSetting.CADShowRuler then aSetting.CADShowRuler := True else aSetting.CADShowRuler := False; if aSetting.CADShowGrid then aSetting.CADShowGrid := True else aSetting.CADShowGrid := False; if aSetting.CADShowGuides then aSetting.CADShowGuides := True else aSetting.CADShowGuides := False; if aSetting.CADSnapGrid then aSetting.CADSnapGrid := True else aSetting.CADSnapGrid := False; if aSetting.CADSnapGuides then aSetting.CADSnapGuides := True else aSetting.CADSnapGuides := False; if aSetting.CADSnapNearObject then aSetting.CADSnapNearObject := True else aSetting.CADSnapNearObject := False; if aSetting.UseComponTypeHeights then aSetting.UseComponTypeHeights := True else aSetting.UseComponTypeHeights := False; if aSetting.CADShowCabinetsNumbers then aSetting.CADShowCabinetsNumbers := True else aSetting.CADShowCabinetsNumbers := False; if aSetting.CADLinesCaptionsFontBold then aSetting.CADLinesCaptionsFontBold := True else aSetting.CADLinesCaptionsFontBold := False; if aSetting.CADCrossATSFontBold then aSetting.CADCrossATSFontBold := True else aSetting.CADCrossATSFontBold := False; if aSetting.CADDistribCabFontBold then aSetting.CADDistribCabFontBold := True else aSetting.CADDistribCabFontBold := False; if aSetting.ShowNameInDesignList then aSetting.ShowNameInDesignList := True else aSetting.ShowNameInDesignList := False; if aSetting.ShowNameShortInDesignList then aSetting.ShowNameShortInDesignList := True else aSetting.ShowNameShortInDesignList := False; if aSetting.ShowNameMarkInDesignList then aSetting.ShowNameMarkInDesignList := True else aSetting.ShowNameMarkInDesignList := False; if aSetting.CanSetCorkBetweenTraces then aSetting.CanSetCorkBetweenTraces := True else aSetting.CanSetCorkBetweenTraces := False; if aSetting.AutoCadMouse then aSetting.AutoCadMouse := True else aSetting.AutoCadMouse := False; if aSetting.ScaleByCursor then aSetting.ScaleByCursor := True else aSetting.ScaleByCursor := False; if aSetting.CADAutoPosTraceBetweenRM then aSetting.CADAutoPosTraceBetweenRM := True else aSetting.CADAutoPosTraceBetweenRM := False; if aSetting.CADShowMainStamp then aSetting.CADShowMainStamp := True else aSetting.CADShowMainStamp := False; if aSetting.CADShowUpperStamp then aSetting.CADShowUpperStamp := True else aSetting.CADShowUpperStamp := False; if aSetting.CADShowSideStamp then aSetting.CADShowSideStamp := True else aSetting.CADShowSideStamp := False; if aSetting.CADAllowSuppliesKind then aSetting.CADAllowSuppliesKind := True else aSetting.CADAllowSuppliesKind := False; if aSetting.CADShowCabinetsBounds then aSetting.CADShowCabinetsBounds := True else aSetting.CADShowCabinetsBounds := False; if aSetting.CADStampForPrinter then aSetting.CADStampForPrinter := True else aSetting.CADStampForPrinter := False; if aSetting.CADShowRaiseDrawFigure then aSetting.CADShowRaiseDrawFigure := True else aSetting.CADShowRaiseDrawFigure := False; end; procedure ApplyChangeComponMarkID(AComponent: TSCSComponent; ADefToCAD, ADefToCADNameMark: Boolean; ANoDefineCompons: TSCSComponents); var SCSCatalog: TSCSCatalog; SCSObject: TSCSCatalog; begin SCSCatalog := AComponent.GetFirstParentCatalog; if ADefToCAD then begin TF_Main(AComponent.FActiveForm).DefineConnectorObjectNodeName(SCSCatalog); TF_Main(AComponent.FActiveForm).F_ChoiceConnectSide.RefreshApproachInCAD(AComponent); end; TF_Main(AComponent.FActiveForm).F_ChoiceConnectSide.DefineComponTrunkAfterChangeInFuture(AComponent, true); AComponent.NameMark := TF_Main(AComponent.FActiveForm).MakeNameMarkComponent(AComponent, SCSCatalog, true); if Assigned(AComponent.TreeViewNode) then AComponent.TreeViewNode.Text := TF_Main(AComponent.FActiveForm).GetNameNode(AComponent.TreeViewNode, AComponent, true, true); if AComponent.FProjectOwner.Setting.MarkMode = mmTemplate then begin if AComponent.IsTop then TF_Main(AComponent.FActiveForm).F_ChoiceConnectSide.DefineChildComponsMarksByTop(AComponent, ANoDefineCompons); end; if ADefToCADNameMark then begin SCSObject := AComponent.GetFirstParentCatalog; if SCSObject <> nil then TF_Main(AComponent.FActiveForm).F_ChoiceConnectSide.DefineObjectParamsByServFldsInFuture(SCSObject, [dopMark]); end; end; procedure ChangeCADCrossObject(AList: TSCSList; AObjectID: Integer; ANewCADCrossObject: TCADCrossObject); var CurrCadCrossObject: TCadCrossObject; begin if ANewCADCrossObject <> nil then begin CurrCadCrossObject := AList.GetCADCrossObjectByObjectID(AObjectID); if CurrCadCrossObject <> nil then AList.CADCrossObjects.Remove(CurrCadCrossObject); if ANewCADCrossObject <> nil then AList.CADCrossObjects.Add(ANewCADCrossObject); end; end; procedure ChangeChldComponPropFloat(ACompon: TSCSComponent; AChldType: Integer; const APropSN: string; AVal: Double; AKoeff: PDouble); var ChildObj: TSCSComponent; begin ChildObj := GetChildComponByIsLine(ACompon, AChldType); if ChildObj <> nil then begin if AKoeff <> nil then AVal := AVal * AKoeff^; ChildObj.setPropertyValueAsFloat(APropSN, AVal); end; end; function CheckCanLoadInterfIOfIRelsFromBase(AInterface: TSCSInterface): Boolean; begin Result := (AInterface.TypeI = itConstructive) or (AInterface.FQueryMode <> qmPhisical); end; function CheckCanLoadInterfInternalConnectionsFromBase(AInterface: TSCSInterface): Boolean; begin Result := (AInterface.TypeI = itFunctional) or (AInterface.FQueryMode <> qmPhisical); end; function CheckCanLookComponInReportCable(AComponent: TSCSComponent; ACanHaveDismountAccount: Boolean): Boolean; begin Result := (AComponent.IsDismount = biFalse) or Not ACanHaveDismountAccount; end; function CheckCanLookComponInReportRsrc(AComponent: TSCSComponent; ACanHaveActiveComponents, ACanHaveDismountAccount: Boolean): Boolean; var SignType: Integer; begin Result := false; SignType := AComponent.GetPropertyValueAsInteger(pnSignType); //if (SignType = oitProjectible) or // (ACanHaveActiveComponents or (ACanHaveDismountAccount and // (AComponent.IsDismount = biTrue) and // (AComponent.IsUseDismounted = biTrue)) ) then // Result := true; if AComponent.IsDismount = biFalse then begin if (SignType = oitProjectible) or ACanHaveActiveComponents then Result := true; end else if ACanHaveDismountAccount and (AComponent.IsDismount = biTrue) and (AComponent.IsUseDismounted = biTrue) then Result := true; end; function CheckCanUsePropInCompon(const APropSysName: string; ACompon: TSCSComponent): Boolean; var PropList: TStringList; TopCompon: TSCSComponent; begin Result := true; // свойства которые могут быть на стене в кир.стене, но не на комнате if ACompon.ComponentType.SysName = ctsnArhWall then begin PropList := CreateStringListSorted; PropList.Add(pnPlinthVolume); //PropList.Add(pnBasementVolumeunderGround); PropList.Add(pnTrenchVolume); PropList.Add(pnBasementVolume); PropList.Add(pnPlinthThickness); PropList.Add(pnBasementThickness); if PropList.IndexOf(APropSysName) <> -1 then begin TopCompon := ACompon.GetTopComponent; if Assigned(TopCompon) and (TopCompon.IsLine <> ctArhBrickWall) then Result := false; end; PropList.Free; end; end; function CheckEqualInterfaces(AInterfaces1, AInterfaces2: TSCSInterfaces; APortOwner1, APortOwner2: TSCSInterface; ASameCountForBoth, AByIsBusy: Boolean; AptrCount: PInteger = nil): Boolean; var InterfKolvo1, InterfKolvo2, InterfBusyKolvo1, InterfBusyKolvo2: Integer; begin Result := false; if AptrCount <> nil then AptrCount^ := 0; InterfKolvo1 := 0; InterfKolvo2 := 0; //*** Проверить Есть ли все интерфейсы Для обох списков if CheckInterfacesInListByGUIDInterface(AInterfaces1, AInterfaces2) and CheckInterfacesInListByGUIDInterface(AInterfaces2, AInterfaces1) then begin InterfKolvo1 := GetInterfKolvoFromList(AInterfaces1, APortOwner1, @InterfBusyKolvo1); InterfKolvo2 := GetInterfKolvoFromList(AInterfaces2, APortOwner2, @InterfBusyKolvo2); if (InterfKolvo1 > 0) and (InterfKolvo2 > 0) then begin if ASameCountForBoth then begin if InterfKolvo1 = InterfKolvo2 then if (AByIsBusy = false) or (InterfBusyKolvo1=InterfBusyKolvo2) then Result := true; end else if (AByIsBusy = false) or (InterfBusyKolvo1=InterfBusyKolvo2) then Result := true; if AptrCount <> nil then begin if InterfKolvo1 = InterfKolvo2 then AptrCount^ := InterfKolvo1 else if InterfKolvo1 < InterfKolvo2 then AptrCount^ := InterfKolvo1 else if InterfKolvo2 < InterfKolvo1 then AptrCount^ := InterfKolvo2; end; end; end; end; { function CheckEqualInterfaces(AInterfaces1, AInterfaces2: TSCSInterfaces; ASameCountForBoth, AByIsBusy: Boolean; AptrCount: PInteger = nil): Boolean; var i: Integer; Interf1, Interf2: TSCSinterface; IsEqual: Boolean; InterfCount: Integer; begin Result := false; if AptrCount <> nil then AptrCount^ := 0; InterfCount := -1; if AInterfaces1.Count = AInterfaces2.Count then InterfCount := AInterfaces1.Count else if Not ASameCountForBoth then begin if AInterfaces1.Count < AInterfaces2.Count then InterfCount := AInterfaces1.Count else InterfCount := AInterfaces2.Count; end; if InterfCount > 0 then begin IsEqual := true; for i := 0 to InterfCount - 1 do begin Interf1 := AInterfaces1[i]; Interf2 := AInterfaces2[i]; if (Interf1.GUIDInterface = Interf2.GUIDInterface) and ((AByIsBusy = false) or (Interf1.IsBusy = Interf2.IsBusy)) then begin if AptrCount <> nil then AptrCount^ := AptrCount^ + 1; end else begin IsEqual := false; Break; //// BREAK //// end; end; Result := IsEqual; end; end; } function CheckExistsSpravComponInNBWithCopy(ASrcForm: TForm; AGuidNBComponent, AMessg: String): Boolean; var IDNBComponent: Integer; SprComponent: TSCSComponent; begin Result := false; IDNBComponent := F_NormBase.DM.GetIntFromTable(tnComponent, fnID, fnGUID, AGuidNBComponent, qmPhisical); if IDNBComponent > 0 then Result := true else begin // Если активный менеджер проектов, то предложить экспортировать его в НБ if TF_Main(ASrcForm).GDBMode = bkProjectManager then if TF_Main(ASrcForm).CheckWriteNB(false) then begin SprComponent := TF_Main(ASrcForm).GSCSBase.CurrProject.GetSprComponentByGUID(AGuidNBComponent); if SprComponent <> nil then if MessageModal(AMessg, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin if TF_Main(ASrcForm).GSCSBase.CurrProject.DefineNBDir then if CopyComponentFromPMToNB(ASrcForm, F_NormBase, SprComponent, TF_Main(ASrcForm).GSCSBase.CurrProject.NBDirID) <> 0 then Result := true; end; end; end; end; function CheckComponHaveInternalConnection(AComponent: TSCSComponent): Boolean; var ComponentList: TSCSComponents; SCSComponent, JoinedComponent: TSCSComponent; i, j: Integer; begin Result := false; ComponentList := TSCSComponents.Create(false); ComponentList.Add(AComponent); ComponentList.AddItems(AComponent.FChildReferences); for i := 0 to ComponentList.Count - 1 do begin SCSComponent := ComponentList[i]; for j := 0 to SCSComponent.FJoinedComponents.Count - 1 do if SCSComponent.FJoinedComponents[j].ObjectID = SCSComponent.ObjectID then begin Result := true; Break; //// BREAK //// end; if Result then Break; //// BREAK //// end; FreeAndNil(ComponentList); end; function CheckConnectedComponObjectsInCAD(AComponent1, AComponent2: TSCSComponent): Boolean; var Object1, Object2: TSCSCatalog; //Side1, Side2: integer; begin Result := false; Object1 := nil; Object2 := nil; if Assigned(AComponent1) then Object1 := AComponent1.GetFirstParentCatalog; if Assigned(AComponent2) then Object2 := AComponent2.GetFirstParentCatalog; if Assigned(Object1) and Assigned(Object2) then Result := CheckConnectedObjectsInCAD(Object1, Object2); //if Assigned(Object1) and Assigned(Object2) then //begin // GetSidesByConnectedFigures(Object1.ListID, Object2.ListID, Object1.SCSID, Object2.SCSID, Side1, Side2); // if (Side1 > -1) and (Side2 > -1) then // Result := true; //end; end; function CheckConnectedObjectsInCAD(AObject1, AObject2: TSCSCatalog): Boolean; var Side1, Side2: integer; begin Result := false; if Assigned(AObject1) and Assigned(AObject2) then begin GetSidesByConnectedFigures(AObject1.ListID, AObject2.ListID, AObject1.SCSID, AObject2.SCSID, Side1, Side2); if (Side1 > -1) and (Side2 > -1) then Result := true; end; end; function CheckHaveComponentInternalInterfConnection(AComponent: TSCSComponent): Boolean; var i, j: Integer; Interf: TSCSInterface; ptrInterfInternalConnection: PPortInterfRel; begin Result := false; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; for j := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrInterfInternalConnection := Interf.FPortInterfRels[j]; if ptrInterfInternalConnection.RelType = rtInterfInternalConn then begin Result := true; Break; //// BREAK //// end; end; if Result then Break; //// BREAK //// end; end; function CheckHaveComponentDismountedInList(AComponents: TSCSComponents): Boolean; var i: Integer; begin Result := false; for i := 0 to AComponents.Count - 1 do if AComponents[i].IsDismount = biTrue then begin Result := true; Break; //// BREAK //// end; end; function CheckHaveLineComponOnlyNoPairInterfaces(AComponent: TSCSComponent): Boolean; var i: Integer; Interf: TSCSInterface; begin Result := false; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := TSCSInterface(AComponent.FInterfaces.FItems.List^[i]); if Interf.TypeI = itFunctional then begin if Interf.IDAdverse = 0 then Result := true else begin Result := false; Break; //// BREAK //// end; end; end; end; function CheckHaveWholeComponentDismounted(ACatalog: TSCSCatalog; AWholeIDs: TIntList): Boolean; var i: Integer; TopCatalog: TSCSCatalog; SCSCompnent: TSCSComponent; begin Result := false; TopCatalog := ACatalog.GetTopParentCatalog; if TopCatalog <> nil then for i := 0 to AWholeIDs.Count - 1 do begin SCSCompnent := TopCatalog.GetComponentFromReferences(AWholeIDs[i]); if SCSCompnent <> nil then if SCSCompnent.IsDismount = biTrue then begin Result := true; Break; //// BREAK //// end; end; end; function CheckInterfReadyToConnect(AInterface: TSCSInterface; ASide, AConnectType: Integer; ACanConnBusyMultiple: Boolean): Boolean; var //DBMode: TDBKind; InterfIsBusy: Integer; begin Result := false; //DBMode := TF_Main(AInterface.FActiveForm).GDBMode; if Not AInterface.ServDisabled then if ((AConnectType = cntUnion) and (AInterface.TypeI = itFunctional) ) or ((AConnectType = cntComplect) and (AInterface.TypeI = itConstructive)) then if ((ASide > -1) and ((AInterface.Side = ASide) or (AInterface.Side = 0))) or (ASide = -1) then begin InterfIsBusy := AInterface.IsBusy; //*** Если конструктив в НБ имеет соединение, то считать его занятым if (AInterface.IsBusy = biFalse) and (TF_Main(AInterface.FActiveForm).GDBMode = bkNormBase) then if (AInterface.TypeI = itConstructive) and (AInterface.FIOfIRelOut.Count > 0) then InterfIsBusy := biTrue; if (InterfIsBusy <> biTrue) or //(AInterface.Kolvo > AInterface.KolvoBusy) or ((AInterface.Multiple = biTrue) and ACanConnBusyMultiple) then begin Result := true; end; end; end; function CheckIsLineObjectInList(AObjects: TSCSCatalogs; AWithCompons: Boolean): Boolean; var i: Integer; SCSObject: TSCSCatalog; begin Result := false; for i := 0 to AObjects.Count - 1 do begin SCSObject := AObjects[i]; if SCSObject.ItemType = itSCSLine then if Not AWithCompons or (SCSObject.ComponentReferences.Count > 0) then begin Result := true; Break; //// BREAK //// end; end; end; function CheckJoinedComponToIsLine(AComponent: TSCSComponent; AToIsLine: Integer; ARecursive: Boolean): Boolean; var i: Integer; JoinedComponent: TSCSComponent; ChildComponent: TSCSComponent; begin Result := false; for i := 0 to AComponent.FJoinedComponents.Count - 1 do if AComponent.FJoinedComponents[i].IsLine = AToIsLine then begin Result := true; Break; //// BREAK //// end; if ARecursive then if Result = false then for i := 0 to AComponent.ChildComplects.Count - 1 do begin ChildComponent := AComponent.ChildComplects[i]; Result := CheckJoinedComponToIsLine(ChildComponent, AToIsLine, ARecursive); if Result then Break; //// BREAK //// end; end; function checkJoinedComponents(AComponent1, AComponent2: TSCSComponent; AOnlyInSides: Boolean): Boolean; var i, j: Integer; Components1, Components2: TSCSComponents; Compon1, Compon2: TSCSComponent; function GetWholeComponents(AComponent: TSCSComponent): TSCSComponents; begin Result := nil; if AComponent.IsLine = biFalse then begin Result := TSCSComponents.Create(false); Result.Add(AComponent); end else if AComponent.FProjectOwner <> nil then Result := AComponent.FProjectOwner.GetComponentsByWholeID(AComponent.Whole_ID); end; function CheckJoinedComponentsInSides(APointComponent, ALineComponent: TSCSComponent): Boolean; var i: Integer; JoinedToPoint: TSCSComponent; begin Result := false; for i := 0 to APointComponent.JoinedComponents.Count - 1 do begin JoinedToPoint := APointComponent.JoinedComponents[i]; if (JoinedToPoint.ID = ALineComponent.FirstIDCompon) or (JoinedToPoint.ID = ALineComponent.LastIDCompon) then begin Result := true; Break; //// BREAK //// end; end; end; begin Result := false; if (AComponent1 = nil) or (AComponent2 = nil) then Exit; ///// EXIT ///// if AOnlyInSides then begin if (AComponent1.IsLine = biFalse) and (AComponent2.IsLine = biTrue) then Result := CheckJoinedComponentsInSides(AComponent1, AComponent2) else if (AComponent1.IsLine = biTrue) and (AComponent2.IsLine = biFalse) then Result := CheckJoinedComponentsInSides(AComponent2, AComponent1) else if (AComponent1.IsLine = biFalse) and (AComponent2.IsLine = biFalse) then begin if AComponent1.JoinedComponents.IndexOf(AComponent2) <> -1 then Result := true; end else if (AComponent1.IsLine = biTrue) and (AComponent2.IsLine = biTrue) then Result := AComponent1.JoinedComponents.IndexOf(AComponent2) <> -1; end else begin Components1 := GetWholeComponents(AComponent1); Components2 := GetWholeComponents(AComponent2); if (Components1 <> nil) and (Components2 <> nil) then begin for i := 0 to Components1.Count - 1 do begin Compon1 := Components1[i]; if Compon1.JoinedComponents.Count > 0 then for j := 0 to Components2.Count - 1 do begin Compon2 := Components2[j]; if Compon2.JoinedComponents.Count > 0 then if Compon1.JoinedComponents.IndexOf(Compon2) <> -1 then begin Result := true; // Tolik -- 07/02/2017 -- if Components1 <> nil then FreeAndNil(Components1); if Components2 <> nil then FreeAndNil(Components2); // Exit; ///// EXIT ///// end; end; end; end; if Components1 <> nil then FreeAndNil(Components1); if Components2 <> nil then FreeAndNil(Components2); end; end; function CheckJoinedComponToComponFromObject(ACompon: TSCSComponent; AObject: TSCSCatalog): Boolean; var i: Integer; JoinedComponent: TSCSComponent; begin Result := false; if Assigned(ACompon) and Assigned(AObject) then for i := 0 to ACompon.FJoinedComponents.Count - 1 do begin JoinedComponent := TSCSComponent(ACompon.FJoinedComponents.FItems.List^[i]); if JoinedComponent.GetFirstParentCatalog = AObject then begin Result := True; Break; //// BREAK //// end; end; end; function CheckJoinedComponToComponWithChilds(ASCSComponentWithChilds, ACheckCompon: TSCSComponent): Boolean; var i: Integer; ChildComponent: TSCSComponent; begin Result := false; if ASCSComponentWithChilds <> ACheckCompon then begin if ASCSComponentWithChilds.FJoinedComponents.IndexOf(ACheckCompon) <> -1 then Result := true else begin for i := 0 to ASCSComponentWithChilds.FChildReferences.Count - 1 do begin ChildComponent := TSCSComponent(ASCSComponentWithChilds.FChildReferences.FItems.List^[i]); if ChildComponent.FJoinedComponents.IndexOf(ACheckCompon) <> -1 then Result := true; end; end; end; end; function CheckJoinedToSameByWholeID(AComponent: TSCSComponent): Boolean; var i: integer; begin Result := false; for i := 0 to AComponent.FJoinedComponents.Count - 1 do if AComponent.FJoinedComponents[0].Whole_ID = AComponent.Whole_ID then begin Result := true; Break; //// BREAK //// end; end; function CheckJoinCollectComponWithComponList(ACollectCompon: TSCSComponent; AComponList: TSCSComponents): TCheckCollectComponJoinToComponsRes; var CollectCompons, ComponListToJoin, ComponsFromListToCheckJoin, ComponsFromListThatCanJoinToCollect, ResProperCompons: TSCSComponents; i, j: Integer; CollectCompon, ComponFromList: TSCSComponent; begin Result := nil; try CollectCompons := GetComponStructuredChilds(ACollectCompon, true); ComponListToJoin := TSCSComponents.Create(false); ComponListToJoin.Assign(AComponList, laCopy); ComponsFromListToCheckJoin := TSCSComponents.Create(false); ComponsFromListThatCanJoinToCollect := TSCSComponents.Create(false); for i := 0 to CollectCompons.Count - 1 do begin CollectCompon := CollectCompons[i]; // Определяем все компоненты из списка которые могут подключится к CollectCompon ComponsFromListThatCanJoinToCollect.Clear; for j := 0 to ComponListToJoin.Count - 1 do begin ComponFromList := ComponListToJoin[i]; ComponsFromListToCheckJoin.Clear; ComponsFromListToCheckJoin.AddItems(ComponsFromListThatCanJoinToCollect); ComponsFromListToCheckJoin.Add(ComponFromList); if CollectCompon.CheckJoinToListCompons(ComponsFromListToCheckJoin).CanConnect then ComponsFromListThatCanJoinToCollect.Add(ComponFromList); end; // если есть компоненты которые могут подключится, то записываем из в результат if ComponsFromListThatCanJoinToCollect.Count > 0 then begin ResProperCompons := TSCSComponents.Create(false); ResProperCompons.AddItems(ComponsFromListThatCanJoinToCollect); if Result = nil then Result := TCheckCollectComponJoinToComponsRes.Create; Result.FComponsFromCollect.Add(CollectCompon); Result.FListOfListProperCompons.Add(ResProperCompons); ComponListToJoin.RemoveByList(ComponsFromListThatCanJoinToCollect); if ComponListToJoin.Count = 0 then begin Result.FCanJoin := true; Break; //// BREAK //// end; end; end; FreeAndNil(ComponsFromListToCheckJoin); FreeAndNil(ComponsFromListThatCanJoinToCollect); FreeAndNil(ComponListToJoin); FreeAndNil(CollectCompons); except on E: Exception do AddExceptionToLogEx('CheckJoinCollectComponWithComponList', E.Message); end; end; function CheckJoinComponsByObjects(ACompon1, ACompon2: TSCSComponent): Boolean; begin Result := CheckJoinComponsWithoutObjSides(ACompon1, ACompon2) or CheckConnectedComponObjectsInCAD(ACompon1, ACompon2); end; function CheckJoinComponsWithoutInterf(ACompon1, ACompon2: TSCSComponent): Boolean; //19.05.2011 begin Result := ((ACompon1.IsLine in [ctArhRoofHip, ctArhRoofHipCorner]) and (ACompon2.IsLine in [ctArhRoofHip, ctArhRoofHipCorner])) or ((ACompon1.IsLine in [ctArhRoofHip, ctArhRoofSeg]) and (ACompon2.IsLine in [ctArhRoofHip, ctArhRoofSeg])); end; function CheckJoinComponsWithoutObjSides(ACompon1, ACompon2: TSCSComponent): Boolean; begin Result := ((ACompon1.IsLine in [ctArhRoofHip, ctArhRoofHipCorner]) and (ACompon2.IsLine in [ctArhRoofHip, ctArhRoofHipCorner])) or ((ACompon1.IsLine in [ctArhRoofHip, ctArhRoofSeg]) and (ACompon2.IsLine in [ctArhRoofHip, ctArhRoofSeg])); end; function CheckJoinComponentToWithComplects(AComponent, AComponentWithComplects: TSCSComponent; ASide1, ASide2: Integer): Boolean; var SCSComponents: TSCSComponents; SCSComponent: TSCSComponent; i: Integer; begin Result := false; SCSComponents := TSCSComponents.Create(false); SCSComponents.Add(AComponentWithComplects); SCSComponents.Assign(AComponentWithComplects.FChildReferences, laOr); for i := 0 to SCSComponents.Count - 1 do begin SCSComponent := SCSComponents[i]; if AComponent.CheckJoinTo(SCSComponent, ASide1, ASide2).CanConnect then begin Result := True; Break; //// BREAK //// end; end; SCSComponents.Free; end; function CheckJoinedComponToIncomingInterface(AJoinedComponent, AComponent: TSCSComponent): Boolean; var InterfLists: TInterfLists; i, j: Integer; Interf: TSCSInterface; ptrinterfInternalConn: PPortInterfRel; begin Result := false; InterfLists := AComponent.GetInterfacesThatConnectComponent(AJoinedComponent); for i := 0 to InterfLists.InterfList1.Count - 1 do begin Interf := InterfLists.InterfList1[i]; for j := 0 to Interf.FPortInterfRels.Count - 1 do begin ptrinterfInternalConn := Interf.FPortInterfRels[j]; if ptrinterfInternalConn.RelType = rtInterfInternalConn then begin Result := true; Break; //// BREAK //// end; end; if Result then Break; //// BREAK //// end; FreeAndNil(InterfLists.InterfList1); FreeAndNil(InterfLists.InterfList2); end; function CheckJoinedInterfByPos(AInterf1, AInterf2: TSCSInterface; APosFrom1, APosTo1, APosFrom2, APosTo2: Integer; APtrPosKolvo: PInteger=nil): Boolean; var //InterfInfoWithPos: TInterfInfo; //InterfInfo: TInterfInfo; IOfIRel: TSCSIOfIRel; InterfWithPositionList: TObjectList; InterfWithPosition, InterfPosition: TSCSInterfPosition; InterfWithPos, Interf: TSCSInterface; PosFrom, PosTo, InterfPosFrom, InterfPosTo, i, j: Integer; begin Result := false; if (AInterf1 <> nil) and (AInterf2 <> nil) then if AInterf1.ConnectedInterfaces.IndexOf(AInterf2) <> -1 then if (APosFrom1 = 0) and (APosTo1 = 0) and (APosFrom2 = 0) and (APosTo2 = 0) then begin Result := true; if APtrPosKolvo <> nil then begin IOfIRel := nil; IOfIRel := AInterf1.GetIOfIByIDInterfTo(AInterf2.ID); if IOfIRel = nil then IOfIRel := AInterf2.GetIOfIByIDInterfTo(AInterf1.ID); if IOfIRel <> nil then APtrPosKolvo^ := GetIOfIRelPosCount(IOfIRel); end; end else // Если подключение идет по позициям begin InterfWithPos := AInterf1; Interf := AInterf2; PosFrom := APosFrom1; PosTo := APosTo1; InterfPosFrom := APosFrom2; InterfPosTo := APosTo2; // Если пара позиций APosFrom APosTo = 0, то это это интерфейс кабеля if (APosFrom1 = 0) and (APosTo1 = 0) and (APosFrom2 <> 0) and (APosTo2 <> 0) then begin ExchangeObjects(InterfWithPos, Interf); PosFrom := APosFrom2; PosTo := APosTo2; InterfPosFrom := 1; //23.12.2011 APosFrom1; InterfPosTo := AInterf1.Kolvo; //23.12.2011 APosTo1; end else //23.12.2011 if (APosFrom1 <> 0) and (APosTo1 <> 0) and (APosFrom2 = 0) and (APosTo2 = 0) then begin InterfPosFrom := 1; InterfPosTo := AInterf2.Kolvo;; end; {//20.10.2011 for i := PosFrom to PosTo do begin InterfWithPositionList := GetInterfPositionByNum(i, InterfWithPos.BusyPositions); for j := 0 to InterfWithPositionList.Count - 1 do begin InterfWithPosition := TSCSInterfPosition(InterfWithPositionList[j]); IOfIRel := nil; if InterfWithPosition <> nil then begin if InterfWithPosition.InterfPosConnectionOwner <> nil then IOfIRel := InterfWithPosition.InterfPosConnectionOwner.Owner; end; if IOfIRel <> nil then if ((IOfIRel.InterfaceOwner = InterfWithPos) and (IOfIRel.InterfaceTo = Interf)) or ((IOfIRel.InterfaceOwner = Interf) and (IOfIRel.InterfaceTo = InterfWithPos)) then begin Result := true; if APtrPosKolvo <> nil then APtrPosKolvo^ := GetIOfIRelPosCount(IOfIRel); Break; //// BREAK //// end; end; FreeAndNil(InterfWithPositionList); end; InterfPositionList.Free;} for i := 0 to InterfWithPos.BusyPositions.Count - 1 do begin InterfWithPosition := TSCSInterfPosition(InterfWithPos.BusyPositions[i]); if IsPosRangesIntersect(InterfWithPosition.FromPos, InterfWithPosition.ToPos, PosFrom, PosTo) then begin for j := 0 to Interf.BusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(Interf.BusyPositions[j]); if IsPosRangesIntersect(InterfPosition.FromPos, InterfPosition.ToPos, InterfPosFrom, InterfPosTo) then begin if (InterfWithPosition.FInterfPosConnectionOwner <> nil) and (InterfWithPosition.FInterfPosConnectionOwner = InterfPosition.FInterfPosConnectionOwner) then Result := true; end; end; if Result then Break; //// BREAK //// end; end; end; end; (* function ConnectComponsByParams(AConnectComponParams: PConnectComponParams): TConnectInterfRes; var i, j: Integer; MoveCount: Integer; InterfList1: TSCSInterfaces; InterfList2: TSCSInterfaces; InterfDat1: TSCSInterface; InterfDat2: TSCSInterface; PrevInterfDat2: TSCSInterface; EmptyPositions1: TSCSInterfPositions; EmptyPositions2: TSCSInterfPositions; ConnComponent: TSCSComponent; ConnComponentInterfList: TSCSInterfaces; ConnComponentObjectOwner: TSCSCatalog; ConnComponentListOwner: TSCSList; LineComponent: TSCSComponent; LineComponentInterfList: TSCSInterfaces; LineComponentObjectOwner: TSCSCatalog; LineComponentListOwner: TSCSList; PosOfConnectingTrace: Integer; PosInterface: TSCSinterface; ConnectKind: TConnectKind; CanCheckToConnect: Boolean; CanConnBusyMultiple: Boolean; CanWhile: Boolean; CanConn: Boolean; ConnectInterfCount: Integer; UseJoinInfoLists: Boolean; ptrCompRel: PComplect; ChannelInterface: TSCSInterface; CableInterface: TSCSInterface; IDComponRel: Integer; CheckInterfRes: TCheckInterfForUnionResult; NoInterfAccordanceList: TList; ptrNoInterfAccord: PInterfaceAccordance; CActionName: String; FProjectOwner: TSCSProject; function AddInterfaceToUsed(AInterface: TSCSInterface): Boolean; var ComponOwner: TSCSComponent; CatalogOwner: TSCSCatalog; InterfInEndPoint: Boolean; begin Result := false; InterfInEndPoint := false; ComponOwner := AInterface.ComponentOwner; CatalogOwner := nil; if ComponOwner <> nil then CatalogOwner := ComponOwner.GetFirstParentCatalog; if (CatalogOwner <> nil) and (GEndPoint <> nil) then if CatalogOwner.SCSID = GEndPoint.ID then InterfInEndPoint := true; if Not InterfInEndPoint then FProjectOwner.FUsedInterfaces.Add(AInterface); end; function CheckInterfReadyToConnect(AInterface: TSCSInterface; ASide: Integer): Boolean; begin Result := false; if Not AInterface.ServDisabled then if ((AConnectComponParams.ConnectType = cntUnion) and (AInterface.TypeI = itFunctional) ) or ((AConnectComponParams.ConnectType = cntComplect) and (AInterface.TypeI = itConstructive)) then if ((ASide > -1) and ((AInterface.Side = ASide) or (AInterface.Side = 0))) or (ASide = -1) then //if (AInterface.IsBusy = biFalse) or ((AInterface.Multiple = biTrue) and CanConnBusyMultiple) then if (AInterface.Kolvo > AInterface.KolvoBusy) or ((AInterface.Multiple = biTrue) and CanConnBusyMultiple) then begin Result := true; //*** Интерфейс в списке используемых if Assigned(FProjectOwner) then if FProjectOwner.FUsedInterfaces.IndexOf(AInterface) <> -1 then Result := false; end; end; procedure DefineIDComponRel; var TopCatalog: TSCSCatalog; begin if IDComponRel = -1 then begin case AConnectComponParams.SelfComponent.FQueryMode of qmPhisical: IDComponRel := TF_Main(AConnectComponParams.SelfComponent.FActiveForm).AppendToComponRel(AConnectComponParams.SelfComponent.ID, AConnectComponParams.Component.ID, 1, AConnectComponParams.ConnectType); qmMemory: begin TopCatalog := AConnectComponParams.SelfComponent.GetTopParentCatalog; if TopCatalog <> nil then if TopCatalog is TSCSProject then IDComponRel := TSCSProject(TopCatalog).GenIDByGeneratorIndex(giComponentRelationID, 1); end; end; end; //if IDComponRel = -1 then //IDComponRel := TF_Main(ActiveForm).AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); end; procedure RemoveMultipleInterfaces(AInterfaceList: TSCSInterfaces); var i: Integer; SCSInterface: TSCSInterface; begin i := 0; while i <= AInterfaceList.Count - 1 do begin SCSInterface := AInterfaceList[i]; if SCSInterface.Multiple = biTrue then AInterfaceList.Delete(i) else Inc(i); end; end; begin IDComponRel := AConnectComponParams.IDCompRel; Result.CanConnect := false; Result.ConnectInterfCount := 0; Result.NewIDCompRel := 0; Result.CompRel := nil; if Not Assigned(AConnectComponParams.Component) then Exit; ////// EXIT ///// try CanWhile := true; CanCheckToConnect := true; UseJoinInfoLists := false; FProjectOwner := AConnectComponParams.SelfComponent.FProjectOwner; //*** Проверка на возможность соединения компонентов по // параметрам, (тип сети, цвет...) if (AConnectComponParams.ConnectType = cntUnion) and (FProjectOwner <> nil) and (FProjectOwner.IsAutoTracing) and (AConnectComponParams.SelfComponent.IsLine <> AConnectComponParams.Component.IsLine) then UseJoinInfoLists := true; if UseJoinInfoLists then begin if FProjectOwner.FCanJoinComponsInfo.FindJoinComponsInfo(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)) then begin if FJoinedComponents.IndexOf(AComponent) = -1 then CanCheckToConnect := false else Exit; ///// EXIT ///// end else if FProjectOwner.FNotJoinComponsInfo.FindJoinComponsInfo(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)) then Exit; ///// EXIT ///// end; if CanCheckToConnect then if Not ACanWithNoParams and Not TF_Main(FActiveForm).CanConnCompon(Self, AComponent, AConnectType, smtNone) then begin if UseJoinInfoLists then FProjectOwner.FNotJoinComponsInfo.AddRecord(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)); Exit; //// EXIT //// end else if UseJoinInfoLists then FProjectOwner.FCanJoinComponsInfo.AddRecord(Self.ID, AComponent.ID, Integer(TF_Main(FActiveForm).GDBMode), Integer(TF_Main(AComponent.FActiveForm).GDBMode)); CanConn := false; ConnectInterfCount := 0; CanConnBusyMultiple := ACanConnBusyMultiple; if CanConnBusyMultiple = false then if (Self.IsLine = biFalse) or (AComponent.IsLine = biFalse) then if AConnectType = cntUnion then CanConnBusyMultiple := true; ConnectKind := cnkVarious; case AConnectType of cntComplect: ConnectKind := cnkVarious; cntUnion: ConnectKind := cnkVarious or cnkMaleMale; end; ConnComponent := nil; ConnComponentInterfList := nil; ConnComponentObjectOwner := nil; ConnComponentListOwner := nil; LineComponent := nil; LineComponentInterfList := nil; LineComponentObjectOwner := nil; LineComponentListOwner := nil; InterfList1 := TSCSInterfaces.Create(false); InterfList2 := TSCSInterfaces.Create(false); try if ASelfInterfaces = nil then InterfList1.Assign(Self.Interfaces, laCopy) else InterfList1.Assign(ASelfInterfaces, laCopy); if AComponInterfaces = nil then InterfList2.Assign(AComponent.Interfaces, laCopy) else InterfList2.Assign(AComponInterfaces, laCopy); //*** Определить точ-й и линейный компоненты для кросса if (IsLine = biFalse) and (AComponent.IsLine = biTrue) then begin ConnComponent := Self; LineComponent := AComponent; ConnComponentInterfList := InterfList1; LineComponentInterfList := InterfList2; end else if (IsLine = biTrue) and (AComponent.IsLine = biFalse) then begin ConnComponent := AComponent; LineComponent := Self; ConnComponentInterfList := InterfList2; LineComponentInterfList := InterfList1; end; if (ConnComponent <> nil) and (LineComponent <> nil) then if IsTrunkComponent(ConnComponent) then if (TF_Main(ConnComponent.FActiveForm).GDBMode = bkProjectManager) and (TF_Main(LineComponent.FActiveForm).GDBMode = bkProjectManager) then begin ConnComponentObjectOwner := ConnComponent.GetFirstParentCatalog; LineComponentObjectOwner := LineComponent.GetFirstParentCatalog; if (ConnComponentObjectOwner <> nil) and (LineComponentObjectOwner <> nil) then begin ConnComponentListOwner := ConnComponentObjectOwner.GetListOwner; LineComponentListOwner := LineComponentObjectOwner.GetListOwner; if (ConnComponentListOwner <> nil) and (LineComponentListOwner <> nil) then begin PosOfConnectingTrace := GetPosOfConnectingTrace(LineComponentObjectOwner.ListID, LineComponentObjectOwner.SCSID); if PosOfConnectingTrace <> -1 then PosInterface := GetInterfaceFromConnObjectByTrunkPos(ConnComponentObjectOwner.GetListOwner, ConnComponentObjectOwner, PosOfConnectingTrace); if PosInterface <> nil then begin ConnComponentInterfList.Clear; ConnComponentInterfList.Add(PosInterface); end; end; end; end; if (AConnectType = cntComplect) and (Self.IsLine = biTrue) and (AComponent.IsLine = biTrue) then begin if CheckCanalHaveCable(AComponent, ChannelInterface, CableInterface) then begin if ASimulation = false then begin {GUIDMaleInterface := ''; //*** Интерфейс Папа (комплектующей) CableInterface := AComponent.GetInterfaceByTypeAndGender([itConstructive], [gtMale], biTrue); if CableInterface <> nil then GUIDMaleInterface := CableInterface.GUIDInterface; //*** Интерфейс Мама (собственный) CanalInterface := Self.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, GUIDMaleInterface); if (CanalInterface = nil) and (GUIDMaleInterface <> '') then CanalInterface := Self.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, '', true); } if (ChannelInterface <> nil) and (CableInterface <> nil) then begin DefineIDComponRel; EmptyPositions1 := nil; EmptyPositions2 := nil; if TF_Main(FActiveForm).GDBMode = bkProjectManager then EmptyPositions1 := ChannelInterface.GetEmptyPositions; if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then EmptyPositions2 := CableInterface.GetEmptyPositions; TF_Main(ActiveForm).ConnectInterfaces(ChannelInterface, CableInterface, IDComponRel, AConnectType, EmptyPositions1, EmptyPositions2); if EmptyPositions1 <> nil then FreeAndNil(EmptyPositions1); if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); end; end; Inc(ConnectInterfCount); CanConn := true; end; //*** Выкинуть из списков интерфейсы, которые предназначены для сечения RemoveMultipleInterfaces(InterfList1); RemoveMultipleInterfaces(InterfList2); end; //*** Продолжить обычное соединение begin NoInterfAccordanceList := TList.Create; while CanWhile do begin CanWhile := false; for i := 0 to InterfList1.Count - 1 do begin InterfDat1 := InterfList1.Items[i]; if Not CheckInterfReadyToConnect(InterfDat1, ASideCompon1) then Continue; ///// CONTINUE ///// EmptyPositions1 := nil; if TF_Main(FActiveForm).GDBMode = bkProjectManager then begin EmptyPositions1 := InterfDat1.GetEmptyPositions; if EmptyPositions1.Kolvo = 0 then begin FreeAndNil(EmptyPositions1); Continue; ///// CONTINUE ///// end; end; //*** Найти свободный интерфейс с таким же количеством - поставить их первыми if (Not ASimulation) and (InterfDat1.KolvoBusy = 0) then begin MoveCount := 0; for j := 0 to InterfList2.Count - 1 do begin InterfDat2 := InterfList2.Items[j]; if Not CheckInterfReadyToConnect(InterfDat2, ASideCompon2) then Continue; ///// CONTINUE ///// if (InterfDat2.KolvoBusy = 0) and (InterfDat2.Kolvo = InterfDat1.Kolvo) then //*** Не менять позициями одинаковые интерфейсы if (j > MoveCount) then begin PrevInterfDat2 := InterfList2[MoveCount]; if InterfDat2.Kolvo <> PrevInterfDat2.Kolvo then begin InterfList2.Remove(InterfDat2); InterfList2.Insert(MoveCount, InterfDat2); Inc(MoveCount); end; end; end; end; for j := 0 to InterfList2.Count - 1 do begin InterfDat2 := InterfList2.Items[j]; if Not CheckInterfReadyToConnect(InterfDat2, ASideCompon2) then Continue; ///// CONTINUE ///// EmptyPositions2 := nil; if TF_Main(AComponent.FActiveForm).GDBMode = bkProjectManager then begin EmptyPositions2 := InterfDat2.GetEmptyPositions; if EmptyPositions2.Kolvo = 0 then begin FreeAndNil(EmptyPositions2); Continue; //// CONTINUE //// end; end; if Not CheckInterfAccordInList(NoInterfAccordanceList, InterfDat1.ID_Interface, InterfDat2.ID_Interface, InterfDat1.IsLineCompon, InterfDat2.IsLineCompon) then begin CheckInterfRes := CheckInterfForUnion(InterfDat1, InterfDat2, FActiveForm, AComponent.ActiveForm, ConnectKind, AConnectType); if CheckInterfRes = chrSuccess then begin if ASimulation = false then begin DefineIDComponRel; //*** Если патч-корд, то проверить не соединен ли он половиной интерфейсами if AConnectType = cntUnion then if ComponentType.SysName = ctsnPatchCord then begin if CheckConnectedByHalfEqualInterfaces(AComponent, IDComponRel, cntUnion, false) then CheckInterfRes := chrFail; end else if AComponent.IsCrossComponent then if CheckConnectedByHalfEqualInterfaces(Self, IDComponRel, cntUnion, false) then CheckInterfRes := chrFail; if CheckInterfRes = chrSuccess then begin RegroupInterfPositionsToConnect(EmptyPositions1, EmptyPositions2); TF_Main(ActiveForm).ConnectInterfaces(InterfDat1, InterfDat2, IDComponRel, AConnectType, EmptyPositions1, EmptyPositions2); if (FProjectOwner <> nil) and FProjectOwner.IsAutoTracing then begin AddInterfaceToUsed(InterfDat1); AddInterfaceToUsed(InterfDat2); //FProjectOwner.FUsedInterfaces.Add(InterfDat1); //FProjectOwner.FUsedInterfaces.Add(InterfDat2); end; end; end; if CheckInterfRes = chrSuccess then begin InterfList1.Delete(i); InterfList2.Delete(j); CanWhile := true; CanConn := true; ConnectInterfCount := ConnectInterfCount + 1; if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); Break; //// BREAK //// end; end else if CheckInterfRes = chrFailInterfaces then begin GetMem(ptrNoInterfAccord, SizeOf(TInterfaceAccordance)); ptrNoInterfAccord.IDInterface1 := InterfDat1.ID_Interface; ptrNoInterfAccord.IDInterface2 := InterfDat2.ID_Interface; ptrNoInterfAccord.IsLine1 := InterfDat1.IsLineCompon; ptrNoInterfAccord.IsLine2 := InterfDat2.IsLineCompon; NoInterfAccordanceList.Add(ptrNoInterfAccord); end; end; if EmptyPositions2 <> nil then FreeAndNil(EmptyPositions2); end; if EmptyPositions1 <> nil then FreeAndNil(EmptyPositions1); if CanWhile then Break; end; end; FreeList(NoInterfAccordanceList); end; if Not CanConn then begin CanConn := ACanWithNoInterfaces; if Not ACanWithNoInterfaces and (ConnectInterfCount = 0) then begin CActionName := ''; case AConnectType of cntComplect: CActionName := 'укомплектоваться в'; cntUnion: CActionName := 'подключиться с'; end; ShowMessageByType(0, smtNone, 'Компонент "'+AComponent.GetNameForVisible+'" не может '+CActionName+ ' "'+GetNameForVisible+'" потому, что не совпадают их свободные интерфейсы.', ApplicationName, MB_ICONINFORMATION or MB_OK); end; end; if ASimulation = false then begin if CanConn or ((AComponent.ComponentType.SysName = ctsnPatchCord) and (AConnectType = cntComplect)) then with TF_Main(ActiveForm) do begin CanConn := true; if AIDCompRel = -1 then begin DefineIDComponRel; Result.NewIDCompRel := IDComponRel; //AppendToComponRel(Self.ID, AComponent.ID, 1, AConnectType); GetMem(ptrCompRel, SizeOf(TComplect)); ptrCompRel.ID := Result.NewIDCompRel; ptrCompRel.ID_Component := Self.ID; ptrCompRel.ID_Child := AComponent.ID; ptrCompRel.Kolvo := 1; ptrCompRel.ConnectType := AConnectType; case AConnectType of cntComplect: begin if FTreeViewNode <> nil then TF_Main(FActiveForm).DefineChildNodes(FTreeViewNode); //ptrComplect := GetComplectByIDChild(AComponent.ID); //if ptrComplect = nil then //begin ptrCompRel.SortID := GenNewCompRelSortID(FActiveForm, Self.ID); FComplects.Add(ptrCompRel); //end; //if FChildComplects.IndexOf(AComponent) = -1 then // FChildComplects.Add(AComponent); //AComponent.Parent := Self; AddToChild(AComponent); AComponent.IDCompRel := ptrCompRel.ID; //AComponent.SortID := ptrCompRel.SortID; //Result.CompRel := ptrCompRel; if Assigned(Self.TreeViewNode) and Assigned(AComponent.TreeViewNode) then begin //TF_Main(ActiveForm).OnAddDeleteNode(AComponent.TreeViewNode, AComponent, false); try TF_Main(FActiveForm).MoveNodeTo(AComponent.TreeViewNode, Self.TreeViewNode, naAddChild); finally TF_Main(FActiveForm).OnAddDeleteNode(AComponent.TreeViewNode, AComponent, true); end; end; if Assigned(AComponent.TreeViewNode) then begin PObjectData(AComponent.TreeViewNode.Data).ID_CompRel := ptrCompRel.ID; PObjectData(AComponent.TreeViewNode.Data).ComponKind := ckCompl; SetSortID(AComponent.TreeViewNode); end; F_ChoiceConnectSide.OnAfterConnectCompons(Self, AComponent); end; cntUnion: begin FConnections.Add(ptrCompRel); AddToJoined(AComponent); F_ChoiceConnectSide.OnAfterJoinCompons(Self, AComponent, ASideCompon1, ASideCompon2); end; end; Result.CompRel := ptrCompRel; end else begin ptrCompRel := GetComplectByID(AIDCompRel); if ptrCompRel <> nil then if AConnectType = cntComplect then begin Result.CompRel := ptrCompRel; Inc(ptrCompRel.Kolvo); if TF_Main(FActiveForm).GDBMode = bkNormBase then TF_Main(FActiveForm).DM.UpdateCompRelFieldAsInteger(ptrCompRel.ID, ptrCompRel.Kolvo, fnKolvo); end; end; NotifyChange; end else if (AIDCompRel = -1) and (IDComponRel <> -1) then if FQueryMode = qmPhisical then TF_Main(FActiveForm).DM.DeleteCompRelByID(IDComponRel); end; Result.CanConnect := CanConn; Result.ConnectInterfCount := ConnectInterfCount; finally FreeAndNil(InterfList1); FreeAndNil(InterfList2); end; except on E: Exception do AddExceptionToLog('ConnectComponsByParams: '+E.Message); end; end; *) function CheckHaveObjectIconOtherType(AObject: TSCSCatalog; ACurrIconType: Integer; var AObjectIconOtherType: TMemoryStream; var AGUIDObjectIconOtherType: string): Boolean; var i: Integer; ComponIconType: Integer; ChildComponent: TSCSComponent; begin Result := false; AObjectIconOtherType := nil; AGUIDObjectIconOtherType := ''; for i := 0 to AObject.FComponentReferences.Count - 1 do begin ChildComponent := AObject.FComponentReferences[i]; ComponIconType := ChildComponent.GetPropertyValueAsInteger(pnSignType); if ComponIconType <> ACurrIconType then begin Result := true; AObjectIconOtherType := ChildComponent.GetObjectIconBlk; AGUIDObjectIconOtherType := ChildComponent.GUIDObjectIcon; Break; //// BREAK //// end; end; end; function CheckInterfJoinedToInterfFromListAsInterfnal(AInterface: TSCSInterface; AInterfList, AInterfConnectList: TSCSInterfaces; AComponConnectToInterf: TSCSComponent; ACheckInterfacesConnectToSameCompon: Boolean): Boolean; var i, IndexInList: Integer; InterfFromList, ConnectedToInterfFromList: TSCSInterface; begin Result := false; for i := 0 to AInterfList.Count - 1 do begin InterfFromList := AInterfList[i]; IndexInList := InterfFromList.FInternalConnected.IndexOf(AInterface); if IndexInList <> -1 then begin Result := true; // Проверяем, интерфейс+внутриподключенный к нему инетрфейс подключаются к одному и тому же компоненту if ACheckInterfacesConnectToSameCompon then if (AComponConnectToInterf <> nil) and (AInterfConnectList <> nil) then begin ConnectedToInterfFromList := AInterfConnectList[IndexInList]; if ConnectedToInterfFromList.ComponentOwner <> AComponConnectToInterf then Result := false; end; if Result then Break; //// BREAK //// end; end; end; function CheckInterfacesInListByGUIDInterface(AInterfList, AList: TSCSInterfaces): Boolean; var i, j: Integer; Interf1, Interf2: TSCSInterface; FindedInterf: Boolean; begin Result := true; for i := 0 to AInterfList.Count - 1 do begin Interf1 := AInterfList[i]; FindedInterf := false; for j := 0 to AList.Count - 1 do if AList[j].GUIDInterface = Interf1.GUIDInterface then begin FindedInterf := true; Break; //// BREAK //// end; if Not FindedInterf then begin Result := false; Break; //// BREAK //// end; end; end; function CheckNumInPositionList(ANum: Integer; APositions: TList): Boolean; var i: Integer; InterfPosition: TSCSInterfPosition; begin Result := false; for i := 0 to APositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(APositions.List^[i]); if (InterfPosition.FromPos <= ANum) and (ANum <= InterfPosition.ToPos) then begin Result := true; Break; //// BREAK //// end; end; end; function CopyComponentFromPMToNB(ASrcForm, ATrgForm: TForm; AComponent: TSCSComponent; AIDDestDir: Integer): Integer; var DestTreeNodeForTop, DestTreeNodeForComplects, CurrDestTreeNode, ChildTreeNode, NBTopComponentNode: TTreeNode; i, j, IDNBTopComponent, IDNBChild, IndexOfSameComponent: Integer; ChildComponI, ChildComponJ: TSCSComponent; SrcCompons: TSCSComponents; NewComponIDs: TIntList; function GetComponNewIDBySrc(ASrcComponent: TSCSComponent): Integer; var ComponIndex: Integer; begin Result := -1; ComponIndex := SrcCompons.IndexOf(ASrcComponent); if ComponIndex <> -1 then Result := NewComponIDs[ComponIndex]; end; procedure ComplectChildCompons(ASrcComponent: TSCSComponent; ANewIDComponent, AIDParentCompRel: Integer); var i, j, IDNBChild, IDTopComponent, NewIDCompRel, LastIDCompRel, CurrGroupedCount: Integer; ChildComponentI, ChildComponentJ: TSCSComponent; GropedComponents: TSCSComponents; begin if ANewIDComponent <> -1 then begin //*** Сгруппированные компоненты количеством GropedComponents := TSCSComponents.Create(false); for i := 0 to ASrcComponent.FChildComplects.Count - 1 do begin ChildComponentI := ASrcComponent.FChildComplects[i]; if (GropedComponents.IndexOf(ChildComponentI) = -1) and Not IsCableComponent(ChildComponentI) then begin IDNBChild := -1; IDNBChild := GetComponNewIDBySrc(ChildComponentI); if IDNBChild <> -1 then begin CurrGroupedCount := 0; for j := 0 to ASrcComponent.FChildComplects.Count - 1 do begin ChildComponentJ := ASrcComponent.FChildComplects[j]; if ChildComponentJ <> ChildComponentI then if ChildComponentJ.GuidNB = ChildComponentI.GuidNB then begin Inc(CurrGroupedCount); GropedComponents.Add(ChildComponentJ); end; end; //*** Определить ID верхней компоненты, на тот случай, если комплектация выше не произошла IDTopComponent := IDNBTopComponent; if AIDParentCompRel = 0 then IDTopComponent := ANewIDComponent; NewIDCompRel := 0; LastIDCompRel := GenIDFromTable(TF_Main(ATrgForm).DM.Query_Select, gnComponentRelationID, 0); if TF_Main(ATrgForm).AddComplectToComponByIDs(ANewIDComponent, IDNBChild, 1 + CurrGroupedCount, IDTopComponent, AIDParentCompRel, false, true) then NewIDCompRel := GenIDFromTable(TF_Main(ATrgForm).DM.Query_Select, gnComponentRelationID, 0); if NewIDCompRel <> 0 then if NewIDCompRel = LastIDCompRel then NewIDCompRel := LastIDCompRel; ComplectChildCompons(ChildComponentI, IDNBChild, NewIDCompRel); end; end; end; FreeAndNil(GropedComponents); end; end; procedure SetNoExistsGUID(AIDCompon: Integer; AGUIDCompon: String); var ComponNode: TTreeNode; SCSCompon: TSCSComponent; begin //*** если нет ID с таким гуидом, то установить этот if TF_Main(ATrgForm).DM.GetIntFromTableByGUID(tnComponent, fnID, AGUIDCompon, qmPhisical) = 0 then begin TF_Main(ATrgForm).DM.UpdateStrTableFieldByID(tnComponent, fnGuid, AIDCompon, AGUIDCompon, qmPhisical); //*** Поменялся гуид - определить новое состояние ветви ComponNode := TF_Main(ATrgForm).FindTreeNodeByDat(AIDCompon, [itComponLine, itComponCon]); if ComponNode <> nil then begin SCSCompon := TSCSComponent.Create(ATrgForm); SCSCompon.LoadComponentByID(AIDCompon, false); TF_Main(ATrgForm).SetNodeState(ComponNode, PObjectData(ComponNode.Data).ItemType, ekNone, SCSCompon); FreeAndNil(SCSCompon); end; end; end; begin Result := -1; DestTreeNodeForComplects := nil; if Assigned(ASrcForm) and Assigned(ATrgForm) and Assigned(AComponent) then if (TF_Main(ASrcForm).GDBMode = bkProjectManager) and (TF_Main(ATrgForm).GDBMode = bkNormBase) then begin DestTreeNodeForTop := TF_Main(ATrgForm).FindComponOrDirInTree(AIDDestDir, false); if (DestTreeNodeForTop <> nil) and (PObjectData(DestTreeNodeForTop.Data).ItemType = itDir) then begin BeginProgress; try //*** Если есть комплектующие, то создать для них папку if (DestTreeNodeForTop <> nil) and (AComponent.FChildComplects.Count > 0) then DestTreeNodeForComplects := TF_Main(ATrgForm).MakeDir(cfBase, DestTreeNodeForTop, '('+cSCSComponent_Msg13+' '+AComponent.Name+')', itDir, nil); //*** Копировать верхний компонент IDNBTopComponent := TF_Main(ATrgForm).CopyComponentFromNbToPm(ASrcForm, ATrgForm, nil, DestTreeNodeForTop, AComponent.ID, ckCompon, false, true); Result := IDNBTopComponent; NBTopComponentNode := TF_Main(ATrgForm).FindComponOrDirInTree(IDNBTopComponent, true); if NBTopComponentNode <> nil then begin PObjectData(NBTopComponentNode.Data).ChildNodesCount := 0; NBTopComponentNode.HasChildren := false; end; SetNoExistsGUID(IDNBTopComponent, AComponent.GuidNB); TF_Main(ATrgForm).DM.UpdateIntTableFieldByID(tnComponent, fnKolComplect, IDNBTopComponent, 0, qmPhisical); if DestTreeNodeForComplects <> nil then begin PObjectData(DestTreeNodeForComplects.Data).ChildNodesCount := 0; DestTreeNodeForComplects.HasChildren := false; SrcCompons := TSCSComponents.Create(false); NewComponIDs := TIntList.Create; //*** Копировать комплектующие в НБ for i := 0 to AComponent.FChildReferences.Count - 1 do begin ChildComponI := AComponent.FChildReferences[i]; IndexOfSameComponent := -1; IDNBChild := -1; for j := 0 to i - 1 do begin ChildComponJ := AComponent.FChildReferences[j]; if ChildComponJ.GuidNB = ChildComponI.GuidNB then begin IDNBChild := GetComponNewIDBySrc(ChildComponJ); //IndexOfSameComponent := SrcCompons.IndexOf(ChildComponJ); //if IndexOfSameComponent <> -1 then // IDNBChild := NewComponIDs[IndexOfSameComponent]; Break; //// BREAK //// end; end; //*** Если не найден скопированный аналогичный компонент, то копируем его if IDNBChild = -1 then begin IDNBChild := TF_Main(ATrgForm).CopyComponentFromNbToPm(ASrcForm, ATrgForm, nil, DestTreeNodeForComplects, ChildComponI.ID, ckCompon, false, true); SetNoExistsGUID(IDNBChild, ChildComponI.GuidNB); TF_Main(ATrgForm).DM.UpdateIntTableFieldByID(tnComponent, fnKolComplect, IDNBChild, 0, qmPhisical); ChildTreeNode := TF_Main(ATrgForm).FindComponOrDirInTree(IDNBChild, true, qmPhisical); if ChildTreeNode <> nil then begin PObjectData(ChildTreeNode.Data).ChildNodesCount := 0; ChildTreeNode.HasChildren := false; end; end; if IDNBChild <> -1 then begin SrcCompons.Add(ChildComponI); NewComponIDs.Add(IDNBChild); end; end; //*** Связать комплектующие ComplectChildCompons(AComponent, IDNBTopComponent, 0); FreeAndNil(SrcCompons); FreeAndNil(NewComponIDs); end; if NBTopComponentNode <> nil then TF_Main(ATrgForm).Tree_Catalog.Selected := NBTopComponentNode; finally EndProgress; end; end; end; end; function CopyComponentToPMSCSObject(ASrcComponent: TSCSComponent; AObject: TSCSCatalog; AWithComplects: Boolean): TSCSComponent; var IDNewComponent: Integer; begin Result := nil; if (TF_Main(AObject.FActiveForm).GDBMode = bkProjectManager) and (ASrcComponent <> nil) then begin if AObject.FTreeViewNode = nil then TF_Main(AObject.FActiveForm).FindComponOrDirInTree(AObject.ID, false); if AObject.FTreeViewNode <> nil then begin IDNewComponent := TF_Main(AObject.FActiveForm).CopyComponentFromNbToPm(ASrcComponent.FActiveForm, AObject.FActiveForm, nil, AObject.TreeViewNode, ASrcComponent.ID, ckCompon, false, Not AWithComplects); if IDNewComponent > 0 then Result := TF_Main(AObject.FActiveForm).GSCSBase.CurrProject.GetComponentFromReferences(IDNewComponent); end; end; end; function CheckPortNoHaveBusyInterfaces(APort: TSCSInterface): Boolean; var i, InterfEmptyKolvo, InterfEmptyPairKolvo: Integer; ptrPortInterfRel: PPortInterfRel; PortInterface: TSCSInterface; begin Result := true; for i := 0 to APort.FPortInterfaces.Count - 1 do begin PortInterface := TSCSinterface(APort.FPortInterfaces.FItems.List^[i]); //APort.FPortInterfaces[i]; ptrPortInterfRel := APort.GetPortInterfRelByInterfID(PortInterface.ID); if ptrPortInterfRel <> nil then begin InterfEmptyKolvo := PortInterface.Kolvo - PortInterface.KolvoBusy; if InterfEmptyKolvo > 0 then begin //*** Узнать свободное количество пар интерфейсов для количественного порта, InterfEmptyPairKolvo := InterfEmptyKolvo div ptrPortInterfRel.UnitInterfKolvo; if InterfEmptyPairKolvo = 0 then begin Result := false; Break; //// BREAK //// end; end; end; end; {for i := 0 to APort.FPortInterfaces.Count - 1 do if APort.FPortInterfaces[i].IsBusy <> biFalse then begin Result := false; Break; //// BREAK //// end;} end; // Проверяет пересекается ли диапазон с диапазоном позиции function CheckPosIntersectRange(InterfPosition: TSCSInterfPosition; ARFrom, ARTo: integer): Boolean; begin Result := false; if (ARFrom = 0) and (ARTo = 0) then Result := true else Result := IsPosRangesIntersect(InterfPosition.FromPos, InterfPosition.ToPos, ARFrom, ARTo); end; function CheckUInterfConnectToCompType(AUInterfIdx: Integer; const ACompTypeSN: String): Boolean; var CompTypes: TStringList; begin Result := true; CompTypes := TStringList(GUniversalInterfaces.Objects[AUInterfIdx]); if CompTypes <> nil then Result := CompTypes.IndexOf(ACompTypeSN) <> -1; end; procedure ClearComponIOfIRels(AComponent: TSCSComponent); var i: integer; begin for i := 0 to AComponent.FInterfaces.Count - 1 do AComponent.FInterfaces[i].ClearIOfIRels; end; procedure ClearTVNodeFieldInChildObjects(AObject: TSCSComponCatalogClass; AClearInObject: Boolean); var i: integer; ChildComponent: TSCSComponent; ChildCatalog: TSCSCatalog; begin if AObject is TSCSComponent then begin if AClearInObject then TSCSComponent(AObject).FTreeViewNode := nil; for i := 0 to TSCSComponent(AObject).FChildReferences.Count - 1 do TSCSComponent(AObject).FChildReferences[i].FTreeViewNode := nil; end else if AObject is TSCSCatalog then begin if AClearInObject then TSCSCatalog(AObject).FTreeViewNode := nil; for i := 0 to TSCSCatalog(AObject).FChildCatalogReferences.Count - 1 do TSCSCatalog(AObject).FChildCatalogReferences[i].FTreeViewNode := nil; for i := 0 to TSCSCatalog(AObject).FComponentReferences.Count - 1 do TSCSCatalog(AObject).FComponentReferences[i].FTreeViewNode := nil; end; end; function CmpPropValues(AProp1, AProp2: PProperty): Boolean; var Strings1, Strings2: TStringList; begin Result := false; // Если нету строкового списка if (AProp1.IDDataType <> dtStringList) and (AProp2.IDDataType <> dtStringList) then begin Result := AProp1.Value = AProp2.Value; //AProp1.Value <> AProp2.Value; end else begin if (AProp1.IDDataType = dtStringList) and (AProp2.IDDataType <> dtStringList) then Result := CheckStrInStringsText(AProp2.Value, AProp1.Value) else if (AProp1.IDDataType <> dtStringList) and (AProp2.IDDataType = dtStringList) then Result := CheckStrInStringsText(AProp1.Value, AProp2.Value) else begin Strings1 := TStringList.Create; Strings1.Text := AProp1.Value; Strings2 := TStringList.Create; Strings2.Text := AProp2.Value; Result := CheckStringsHaveSameItems(Strings1, Strings2); Strings1.Free; Strings2.Free; end; end; end; function CompareCCEsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(PCableCanalConnector(Item1)^.ID, PCableCanalConnector(Item2)^.ID); end; function CompareCompRelsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(PComplect(Item1)^.ID, PComplect(Item2)^.ID); end; function CompareCompRelsBySortID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(PComplect(Item1)^.SortID, PComplect(Item2)^.SortID); end; function CompareIOfIRelsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TSCSIOfIRel(Item1).ID, TSCSIOfIRel(Item2).ID); end; function CompareInterfPosConnectionsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TSCSInterfPosConnection(Item1).ID, TSCSInterfPosConnection(Item2).ID); end; function CompareNormsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TSCSNorm(Item1).ID, TSCSNorm(Item2).ID); end; function ComparePortInterfRelsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(PPortInterfRel(Item1)^.ID, PPortInterfRel(Item2)^.ID); end; function ComparePropsByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(PProperty(Item1)^.ID, PProperty(Item2)^.ID); end; function CompareResourcessByID(Item1, Item2: Pointer): Integer; begin Result := CompareInt(TSCSResourceRel(Item1).ID, TSCSResourceRel(Item2).ID); end; function CorrectComponLinksBeforeSaveToNB(AComponent: TSCSComponent; ASrcForm, ATrgForm: TForm; ATrgDir: TSCSCatalog): Boolean; var SCSComponents: TSCSComponents; SCSCompon: TSCSComponent; SCSInterface: TSCSInterface; ptrProperty: PProperty; ptrCableChannelConnector: PCableCanalConnector; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; NBSpravochnik, ProjSpravochnik: TSpravochnik; ProjInterfAccordanceList: TObjectList; Currency: TNBCurrency; TrgDirNode, ConnectorsDirNode: TTreeNode; GUIDListComponType, GUIDListNetType, GUIDListNorms, GUIDListObjectIcon, GUIDListProducer, GUIDListSupplier, GUIDListSuppliesKind: TIDStringList; GUIDListResources, GUIDListResourceCompons, GUIDListInterface, GUIDListProperty, GUIDListNBConnector, GUIDListOtherCompons: TIDStringList; NewNBProperties: TRapList; i, j: integer; function AddGuidToList(AIDStringList: TIDStringList; AGUID: String; ATableIndexInNBSprav: Integer): Boolean; var CanAddGUID: Boolean; i, j: Integer; NBInterface, SprInterface: TNBInterface; SprComponentType: TNBComponentType; SprInterfaceAccord: TNBInterfaceAccordance; SprInterfaceNorm: TNBInterfaceNorm; SprProperty: TNBProperty; SprPropValRel: TNBPropValRel; SprPropValNormRes: TNBPropValNormRes; begin Result := false; if AGUID <> '' then if AIDStringList.IndexOfByString(AGUID) = -1 then begin CanAddGUID := true; if (ATableIndexInNBSprav = tiComponent) and (AGUID = AComponent.GuidNB) then CanAddGUID := false; if CanAddGUID then begin AIDStringList.Add(0, AGUID); Result := true; //*** накинуть остальные справ. данные, связ-е с тек-м справочником case ATableIndexInNBSprav of tiComponentTypes: begin SprComponentType := ProjSpravochnik.GetComponentTypeByGUID(AGUID); if SprComponentType <> nil then begin AddGuidToList(GUIDListObjectIcon, SprComponentType.ComponentType.GUIDDesignIcon, tiObjectIcons); for i := 0 to SprComponentType.FProperties.Count - 1 do AddGuidToList(GUIDListProperty, TNBCompTypeProperty(SprComponentType.FProperties[i]).PropertyData.GUIDProperty, tiProperties); end; end; tiInterface: begin SprInterface := ProjSpravochnik.GetInterfaceByGUID(AGUID); if SprInterface <> nil then begin //TNBInterfaceAccordance(SprInterface.FInterfaceAccordance[i]).g AddGuidToList(GUIDListNetType, SprInterface.GuidNetType, tiNetType); for i := 0 to SprInterface.FInterfaceAccordance.Count - 1 do begin SprInterfaceAccord := TNBInterfaceAccordance(SprInterface.FInterfaceAccordance[i]); NBInterface := NBSpravochnik.GetInterfaceByGUID(SprInterfaceAccord.GuidInterface); //*** добавлять в том случаи если нет такого интерфейса if NBInterface = nil then begin //*** нужно докинуть интерфейс в НБ, если такого нет AddGuidToList(GUIDListInterface, SprInterfaceAccord.GUIDAccordance, tiInterface); //*** внести инфу о этом соответствии if ProjInterfAccordanceList.IndexOf(SprInterfaceAccord) = -1 then ProjInterfAccordanceList.Add(SprInterfaceAccord); end; end; for i := 0 to SprInterface.FInterfaceNorms.Count - 1 do begin SprInterfaceNorm := TNBInterfaceNorm(SprInterface.FInterfaceNorms[i]); AddGuidToList(GUIDListNorms, SprInterfaceNorm.GuidNBNorm, tiNBNorms); AddGuidToList(GUIDListComponType, SprInterfaceNorm.GUIDComponentType, tiComponentTypes); end; end; end; tiProperties: begin SprProperty := ProjSpravochnik.GetPropertyByGUID(AGUID); if SprProperty <> nil then for i := 0 to SprProperty.FPropValRelList.Count - 1 do begin SprPropValRel := TNBPropValRel(SprProperty.FPropValRelList[i]); for j := 0 to SprPropValRel.FPropValNormResList.Count - 1 do begin SprPropValNormRes := TNBPropValNormRes(SprPropValRel.FPropValNormResList[j]); if SprPropValNormRes.GuidNBComponent <> '' then AddGuidToList(GUIDListOtherCompons, SprPropValNormRes.GuidNBComponent, tiComponent) else if SprPropValNormRes.GuidNBRes <> '' then AddGuidToList(GUIDListResources, SprPropValNormRes.GuidNBRes, tiNBResources) else if SprPropValNormRes.GuidNBNorm <> '' then AddGuidToList(GUIDListNorms, SprPropValNormRes.GuidNBNorm, tiNBNorms); end; end; end; end; end; end; end; function GetIDByGUID(AIDStringList: TIDStringList; AGUID: String): Integer; begin Result := 0; if AGUID <> '' then begin Result := AIDStringList.GetIDByString(AGUID); if Result = -1 then Result := 0; end; end; procedure DefineIDsForGUIDs(AIDGUIDList: TIDStringList; ATableIndexInNBSprav: Integer); var Query: TpFIBQuery; NBComponentType: TNBComponentType; NBComponentTypeProp: TNBCompTypeProperty; NBNetType: TNBNetType; NBNorm: TNBNorm; NBInterface, NBInterfAccord: TNBInterface; NBInterfaceAccordance: TNBInterfaceAccordance; NBInterfaceNorm: TNBInterfaceNorm; NBObjectIcon: TNBObjectIcon; NBProducer: TNBProducer; NBProperty: TNBProperty; NBPropValRel: TNBPropValRel; NBPropValNormRes: TNBPropValNormRes; NBResource: TNBResource; NBSuppliesKind: TNBSuppliesKind; NBConnectorID: Integer; SprComponentType: TNBComponentType; SprComponentTypeProp: TNBCompTypeProperty; SprNetType: TNBNetType; SprNorm: TNBNorm; SprInterface: TNBInterface; SprInterfaceAccordance: TNBInterfaceAccordance; SprInterfaceNorm: TNBInterfaceNorm; SprObjectIcon: TNBObjectIcon; SprProducer: TNBProducer; SprProperty: TNBProperty; SprPropValRel: TNBPropValRel; SprPropValNormRes: TNBPropValNormRes; SprResource: TNBResource; SprSuppliesKind: TNBSuppliesKind; SprCableChannelConnector: TSCSComponent; DirTypeName, TableName: String; i, j: Integer; begin DirTypeName := cSCSComponent_Msg12 + ' "'+ TF_Main(ASrcForm).GSCSBase.CurrProject.GetNameForVisible+'"'; case ATableIndexInNBSprav of tiComponentTypes: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBComponentType := NBSpravochnik.GetComponentTypeByGUID(AIDGUIDList.Strings[i]); if NBComponentType <> nil then AIDGUIDList.IDs[i] := NBComponentType.ComponentType.ID else begin SprComponentType := ProjSpravochnik.GetComponentTypeByGUID(AIDGUIDList.Strings[i]); if SprComponentType <> nil then begin NBComponentType := TNBComponentType.Create(NBSpravochnik.FActiveForm); NBComponentType.AssignOnlyComponentType(SprComponentType); //*** поправить ссылки NBComponentType.ComponentType.IDComponTemplate := 0; NBComponentType.ComponentType.IDDesignIcon := GetIDByGUID(GUIDListObjectIcon, NBComponentType.ComponentType.GUIDDesignIcon); if NBComponentType.ComponentType.IDDesignIcon = 0 then NBComponentType.ComponentType.GUIDDesignIcon := ''; NBSpravochnik.AddComponentType(NBComponentType); NBComponentType.Save(meMake); AIDGUIDList.IDs[i] := NBComponentType.ComponentType.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditComponentType, DirTypeName, NBComponentType.ComponentType.ID); //*** Свойства типа компоненты for j := 0 to SprComponentType.FProperties.Count - 1 do begin SprComponentTypeProp := TNBCompTypeProperty(SprComponentType.FProperties[j]); //*** Если есть такое свойство в нормативке, то добавляем его на тип компоненты NBProperty := NBSpravochnik.GetPropertyByGUID(SprComponentTypeProp.PropertyData.GUIDProperty); if NBProperty <> nil then begin NBComponentTypeProp := TNBCompTypeProperty.Create(NBSpravochnik.FActiveForm); NBComponentTypeProp.Assign(SprComponentTypeProp); NBComponentTypeProp.PropertyData.IDMaster := NBComponentType.ComponentType.ID; NBComponentTypeProp.PropertyData.ID_Property := NBProperty.PropertyData.ID; NBComponentType.AddProperty(NBComponentTypeProp); TF_Main(ATrgForm).DM.SavePropertyRelation(meMake, pkCompTypePropRel, @NBComponentTypeProp.PropertyData); end; end; end; end; end; end; tiNetType: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBNetType := NBSpravochnik.GetNetTypeByGUID(AIDGUIDList.Strings[i]); if NBNetType <> nil then AIDGUIDList.IDs[i] := NBNetType.ID else begin SprNetType := ProjSpravochnik.GetNetTypeByGUID(AIDGUIDList.Strings[i]); if SprNetType <> nil then begin NBNetType := TNBNetType.Create(NBSpravochnik.FActiveForm); NBNetType.Assign(SprNetType); NBSpravochnik.AddNetType(NBNetType); NBNetType.Save(meMake); AIDGUIDList.IDs[i] := NBNetType.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditNetType, DirTypeName, NBNetType.ID); end; end; end; end; tiNBNorms: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBNorm := NBSpravochnik.GetNormByGUID(AIDGUIDList.Strings[i]); if NBNorm <> nil then AIDGUIDList.IDs[i] := NBNorm.ID else begin SprNorm := ProjSpravochnik.GetNormByGUID(AIDGUIDList.Strings[i]); if SprNorm <> nil then begin NBNorm := TNBNorm.Create(NBSpravochnik.FActiveForm); NBNorm.Assign(SprNorm); NBSpravochnik.AddNorm(NBNorm); NBNorm.Save(meMake); AIDGUIDList.IDs[i] := NBNorm.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditNBNorm, DirTypeName, NBNorm.ID); end; end; end; end; tiNBResources: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBResource := NBSpravochnik.GetResourceByGUID(AIDGUIDList.Strings[i]); if NBResource <> nil then AIDGUIDList.IDs[i] := NBResource.ID else begin SprResource := ProjSpravochnik.GetResourceByGUID(AIDGUIDList.Strings[i]); if SprResource <> nil then begin NBResource := TNBResource.Create(NBSpravochnik.FActiveForm); NBResource.Assign(SprResource); NBSpravochnik.AddResource(NBResource); //*** преобразуем цену по валюте проекта if Currency <> nil then NBResource.Price := GetPriceAfterChangeCurrency(NBResource.Price, Currency.Data, TF_Main(ATrgForm).GCurrencyM); NBResource.Save(meMake); AIDGUIDList.IDs[i] := NBResource.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditNBResource, DirTypeName, NBResource.ID); end; end; end; end; tiInterface: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBInterface := NBSpravochnik.GetInterfaceByGUID(AIDGUIDList.Strings[i]); if NBInterface <> nil then AIDGUIDList.IDs[i] := NBInterface.ID else begin SprInterface := ProjSpravochnik.GetInterfaceByGUID(AIDGUIDList.Strings[i]); if SprInterface <> nil then begin NBInterface := TNBInterface.Create(NBSpravochnik.FActiveForm); NBInterface.AssignOnlyInterface(SprInterface); //*** тип сети интерфейса NBInterface.IDNetType := GetIDByGUID(GUIDListNetType, NBInterface.GuidNetType); if NBInterface.IDNetType = 0 then NBInterface.GuidNetType := ''; NBSpravochnik.AddInterface(NBInterface); NBInterface.Save(meMake); AIDGUIDList.IDs[i] := NBInterface.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditInterface, DirTypeName, NBInterface.ID); //*** Нормы интерфейса for j := 0 to SprInterface.FInterfaceNorms.Count - 1 do begin SprInterfaceNorm := TNBInterfaceNorm(SprInterface.FInterfaceNorms[j]); //*** Если есть такая норма в нормативке, то добавляем ее на интерфейс NBNorm := NBSpravochnik.GetNormByGUID(SprInterfaceNorm.GuidNBNorm); if NBNorm <> nil then begin NBInterfaceNorm := TNBInterfaceNorm.Create(NBSpravochnik.FActiveForm); NBInterfaceNorm.Assign(SprInterfaceNorm); NBInterfaceNorm.IDInterface := NBInterface.ID; NBInterfaceNorm.GuidInterface := NBInterface.GUID; NBInterfaceNorm.IDNBNorm := NBNorm.ID; NBInterfaceNorm.IDComponentType := GetIDByGUID(GUIDListComponType, NBInterfaceNorm.GUIDComponentType); if NBInterfaceNorm.IDComponentType = 0 then NBInterfaceNorm.GUIDComponentType := ''; NBInterface.AddInterfaceNorm(NBInterfaceNorm); NBInterfaceNorm.Save(meMake); end; end; end; end; end; end; tiInterfaceAccordance: begin for i := 0 to ProjInterfAccordanceList.Count - 1 do begin SprInterfaceAccordance := TNBInterfaceAccordance(ProjInterfAccordanceList[i]); //*** Найти связ-е интерфнйсы из спр НБ NBInterface := NBSpravochnik.GetInterfaceByGUID(SprInterfaceAccordance.GuidInterface); NBInterfAccord := NBSpravochnik.GetInterfaceByGUID(SprInterfaceAccordance.GUIDAccordance); if (NBInterface <> nil) and (NBInterfAccord <> nil) then //*** Ели нет такой связи if NBInterface.GetInterfAccordanceByGUIDAccordance(SprInterfaceAccordance.GUIDAccordance) = nil then begin NBInterfaceAccordance := TNBInterfaceAccordance.Create(NBSpravochnik.FActiveForm); NBInterfaceAccordance.Assign(SprInterfaceAccordance); NBInterfaceAccordance.IDInterface := NBInterface.ID; NBInterfaceAccordance.IDAccordance := NBInterfAccord.ID; NBInterface.AddInterfaceAccordance(NBInterfaceAccordance); NBInterfaceAccordance.Save(meMake); end; end; end; tiObjectIcons: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBObjectIcon := NBSpravochnik.GetObjectIconByGUID(AIDGUIDList.Strings[i]); if NBObjectIcon <> nil then AIDGUIDList.IDs[i] := NBObjectIcon.ID else begin SprObjectIcon := ProjSpravochnik.GetObjectIconByGUID(AIDGUIDList.Strings[i]); if SprObjectIcon <> nil then begin NBObjectIcon := TNBObjectIcon.Create(NBSpravochnik.FActiveForm); NBObjectIcon.Assign(SprObjectIcon); NBSpravochnik.AddObjectIcon(NBObjectIcon); NBObjectIcon.Save(meMake); AIDGUIDList.IDs[i] := NBObjectIcon.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditObjectIcon, DirTypeName, NBObjectIcon.ID); end; end; end; end; tiProperties: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBProperty := NBSpravochnik.GetPropertyByGUID(AIDGUIDList.Strings[i]); if NBProperty <> nil then AIDGUIDList.IDs[i] := NBProperty.PropertyData.ID else begin SprProperty := ProjSpravochnik.GetPropertyByGUID(AIDGUIDList.Strings[i]); if SprProperty <> nil then begin NBProperty := TNBProperty.Create(NBSpravochnik.FActiveForm); NBProperty.Assign(SprProperty); NBSpravochnik.AddProperty(NBProperty); NBProperty.Save(meMake); AIDGUIDList.IDs[i] := NBProperty.PropertyData.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditProperty, DirTypeName, NBProperty.PropertyData.ID); NewNBProperties.Add(NBProperty); end; end; end; end; tiProducer: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBProducer := NBSpravochnik.GetProducerByGUID(AIDGUIDList.Strings[i]); if NBProducer <> nil then AIDGUIDList.IDs[i] := NBProducer.ID else begin SprProducer := ProjSpravochnik.GetProducerByGUID(AIDGUIDList.Strings[i]); if SprProducer <> nil then begin NBProducer := TNBProducer.Create(NBSpravochnik.FActiveForm); NBProducer.Assign(SprProducer); NBSpravochnik.AddProducer(NBProducer); NBProducer.Save(meMake); AIDGUIDList.IDs[i] := NBProducer.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditProducer, DirTypeName, NBProducer.ID); end; end; end; end; tiSuppliesKind: begin for i := 0 to AIDGUIDList.Count - 1 do begin NBSuppliesKind := NBSpravochnik.GetSuppliesKindByGUID(AIDGUIDList.Strings[i]); if NBSuppliesKind <> nil then AIDGUIDList.IDs[i] := NBSuppliesKind.Data.ID else begin SprSuppliesKind := ProjSpravochnik.GetSuppliesKindByGUID(AIDGUIDList.Strings[i]); if SprSuppliesKind <> nil then begin NBSuppliesKind := TNBSuppliesKind.Create(NBSpravochnik.FActiveForm); NBSuppliesKind.Assign(SprSuppliesKind); NBSpravochnik.AddSuppliesKind(NBSuppliesKind); NBSuppliesKind.Save(meMake); AIDGUIDList.IDs[i] := NBSuppliesKind.Data.ID; TF_Main(ATrgForm).DM.InsertToDirTypeItemByDirTypeName(ditSuppliesKinds, DirTypeName, NBSuppliesKind.Data.ID); end; end; end end; else begin TableName := GetTableNameByTableIndex(ATableIndexInNBSprav); if TableName <> '' then begin //*** Определить запрос для нахождения ID из таблици Query := TF_Main(ATrgForm).DM.Query_Select; SetSQLToFIBQuery(Query, GetSQlByParams(qtSelect, TableName, fnGUID+' = :'+fnGuid, nil, fnID), false); for i := 0 to AIDGUIDList.Count - 1 do begin Query.Close; //*** GUID Query.Params[0].AsString := AIDGUIDList.Strings[i]; Query.ExecQuery; if Query.RecordCount > 0 then AIDGUIDList.IDs[i] := Query.Fields[0].AsInteger; Query.Close; end; {//*** для элементов каб каналов определить не нашедшие в нормативной базе if ATableIndexInNBSprav = tiCableCanalConnectors then for i := 0 to AIDGUIDList.Count - 1 do begin NBConnectorID := AIDGUIDList.IDs[i]; //*** если его нет в нормативке, то ищем в проекте if NBConnectorID = 0 then begin SprCableChannelConnector := TF_Main(ASrcForm).GSCSBase.CurrProject.GetSprComponentByGUID(AIDGUIDList.Strings[i]); if SprCableChannelConnector <> nil then begin //*** определить папку для элементов каб канала if ConnectorsDirNode = nil then begin TrgDirNode := ATrgDir.TreeViewNode; if TrgDirNode = nil then TrgDirNode := TF_Main(ATrgForm).FindComponOrDirInTree(ATrgDir.ID, false); if TrgDirNode <> nil then ConnectorsDirNode := TF_Main(ATrgForm).MakeDir(cfBase, TrgDirNode, '('+cSCSComponent_Msg14+' '+AComponent.Name+')', itDir, nil); end; if ConnectorsDirNode <> nil then begin NBConnectorID := CopyComponentFromPMToNB(ASrcForm, ATrgForm, SprCableChannelConnector, PObjectData(ConnectorsDirNode.Data).ObjectID); if NBConnectorID <> 0 then AIDGUIDList.IDs[i] := NBConnectorID; end; end; end; end; } end; end; end; end; procedure DefineComponIDsForGUIDs(AIDGUIDList: TIDStringList; ADirNameForCompons: String); var Query: TpFIBQuery; i: Integer; NBConnectorID: Integer; SprComponent: TSCSComponent; ComponDirNode: TTreeNode; begin //выяснить, какие компоненты существуют в НБ Query := TF_Main(ATrgForm).DM.Query_Select; SetSQLToFIBQuery(Query, GetSQlByParams(qtSelect, tnComponent, fnGUID+' = :'+fnGuid, nil, fnID), false); for i := 0 to AIDGUIDList.Count - 1 do begin Query.Close; //*** GUID Query.Params[0].AsString := AIDGUIDList.Strings[i]; Query.ExecQuery; if Query.RecordCount > 0 then AIDGUIDList.IDs[i] := Query.Fields[0].AsInteger; Query.Close; end; ComponDirNode := nil; // Не существующие компоненты копируем в указанную папку НБ for i := 0 to AIDGUIDList.Count - 1 do begin NBConnectorID := AIDGUIDList.IDs[i]; //*** если его нет в нормативке, то ищем в проекте if NBConnectorID = 0 then begin SprComponent := TF_Main(ASrcForm).GSCSBase.CurrProject.GetSprComponentByGUID(AIDGUIDList.Strings[i]); if SprComponent <> nil then if SprComponent.GuidNB <> AComponent.GuidNB then begin //*** определить папку для элементов каб канала if ComponDirNode = nil then begin TrgDirNode := ATrgDir.TreeViewNode; if TrgDirNode = nil then TrgDirNode := TF_Main(ATrgForm).FindComponOrDirInTree(ATrgDir.ID, false); if TrgDirNode <> nil then ComponDirNode := TF_Main(ATrgForm).MakeDir(cfBase, TrgDirNode, '('+ADirNameForCompons+' '+AComponent.Name+')', itDir, nil); end; if ComponDirNode <> nil then begin NBConnectorID := CopyComponentFromPMToNB(ASrcForm, ATrgForm, SprComponent, PObjectData(ComponDirNode.Data).ObjectID); if NBConnectorID <> 0 then AIDGUIDList.IDs[i] := NBConnectorID; end; end; end; end; end; procedure AssignRelatedObjectsForNew(ATableIndexInNBSprav: Integer); var i, j, k, l, NBObjectID: Integer; NBProperty, SprProperty: TNBProperty; NBPropValRel, SprPropValRel: TNBPropValRel; NBPropValNormRes, SprPropValNormRes: TNBPropValNormRes; begin case ATableIndexInNBSprav of tiProperties: for i := 0 to NewNBProperties.Count - 1 do begin NBProperty := TNBProperty(NewNBProperties[i]); SprProperty := ProjSpravochnik.GetPropertyByGUID(NBProperty.PropertyData.GUID); if SprProperty <> nil then begin for j := 0 to SprProperty.FPropValRelList.Count - 1 do begin SprPropValRel := TNBPropValRel(SprProperty.FPropValRelList[j]); NBPropValRel := TNBPropValRel.Create(NBSpravochnik.FActiveForm); NBPropValRel.Assign(SprPropValRel); NBPropValRel.IDProperty := NBProperty.PropertyData.ID; NBPropValRel.GuidProperty := NBProperty.PropertyData.GUID; NBProperty.AddPropValRel(NBPropValRel); NBPropValRel.Save(meMake); for k := 0 to SprPropValRel.FPropValNormResList.Count - 1 do begin SprPropValNormRes := TNBPropValNormRes(SprPropValRel.FPropValNormResList[k]); NBPropValNormRes := nil; NBObjectID := 0; if SprPropValNormRes.GuidNBComponent <> '' then NBObjectID := GetIDByGUID(GUIDListOtherCompons, SprPropValNormRes.GuidNBComponent) //TF_Main(ATrgForm).DM.GetIntFromTable(tnComponent, fnID, fnGUID, SprPropValNormRes.GuidNBComponent, qmPhisical); else if SprPropValNormRes.GuidNBRes <> '' then NBObjectID := GetIDByGUID(GUIDListResources, SprPropValNormRes.GuidNBRes) else if SprPropValNormRes.GuidNBNorm <> '' then NBObjectID := GetIDByGUID(GUIDListNorms, SprPropValNormRes.GuidNBNorm); if NBObjectID <> 0 then begin NBPropValNormRes := TNBPropValNormRes.Create(NBSpravochnik.FActiveForm); NBPropValNormRes.Assign(SprPropValNormRes); if SprPropValNormRes.GuidNBComponent <> '' then NBPropValNormRes.IDNBComponent := NBObjectID else if SprPropValNormRes.GuidNBRes <> '' then NBPropValNormRes.IDNBRes := NBObjectID else if SprPropValNormRes.GuidNBNorm <> '' then NBPropValNormRes.IDNBNorm := NBObjectID; NBPropValNormRes.IDPropValRel := NBPropValRel.ID; NBPropValNormRes.GuidPropValRel := NBPropValRel.GUID; NBPropValRel.AddPropValNormRes(NBPropValNormRes); NBPropValNormRes.Save(meMake); end; end; end; end; end; end; end; begin Result := true; try SCSComponents := TSCSComponents.Create(false); GUIDListComponType := TIDStringList.Create; GUIDListNetType := TIDStringList.Create; GUIDListObjectIcon := TIDStringList.Create; GUIDListProducer := TIDStringList.Create; GUIDListSupplier := TIDStringList.Create; GUIDListSuppliesKind := TIDStringList.Create; GUIDListInterface := TIDStringList.Create; GUIDListProperty := TIDStringList.Create; GUIDListNBConnector := TIDStringList.Create; GUIDListNorms := TIDStringList.Create; GUIDListResources := TIDStringList.Create; GUIDListResourceCompons := TIDStringList.Create; GUIDListOtherCompons := TIDStringList.Create; NewNBProperties := TRapList.Create; //*** Составить общий список компонент SCSComponents.Assign(AComponent.FChildReferences); SCSComponents.Insert(0, AComponent); NBSpravochnik := TF_Main(ATrgForm).GSCSBase.FNBSpravochnik; ProjSpravochnik := TF_Main(ASrcForm).GSCSBase.CurrProject.FSpravochnik; ProjInterfAccordanceList := TObjectList.Create(false); //*** найти такую валюту в НБ, кот-я явл-ся главной на проекте Currency := NBSpravochnik.GetCurrencyByGUID(TF_Main(ASrcForm).GCurrencyM.GUID); TrgDirNode := nil; ConnectorsDirNode := nil; //*** Закинуть Гуиды в списки for i := 0 to SCSComponents.Count - 1 do begin SCSCompon := SCSComponents[i]; AddGuidToList(GUIDListComponType, SCSCompon.GUIDComponentType, tiComponentTypes); AddGuidToList(GUIDListNetType, SCSCompon.GUIDNetType, tiNetType); AddGuidToList(GUIDListObjectIcon, SCSCompon.GUIDObjectIcon, tiObjectIcons); AddGuidToList(GUIDListProducer, SCSCompon.GUIDProducer, tiProducer); AddGuidToList(GUIDListSupplier, SCSCompon.GUIDSupplier, tiSupplier); AddGuidToList(GUIDListSuppliesKind, SCSCompon.GUIDSuppliesKind, tiSuppliesKind); AddGuidToList(GUIDListObjectIcon, SCSCompon.GUIDSymbol, tiObjectIcons); for j := 0 to SCSCompon.FInterfaces.Count - 1 do begin SCSInterface := SCSCompon.FInterfaces[j]; AddGuidToList(GUIDListInterface, SCSInterface.GUIDInterface, tiInterface); end; for j := 0 to SCSCompon.FProperties.Count - 1 do begin ptrProperty := SCSCompon.FProperties[j]; AddGuidToList(GUIDListProperty, ptrProperty.GUIDProperty, tiProperties); AddGuidToList(GUIDListProperty, ptrProperty.GUIDCrossProperty, tiProperties); end; for j := 0 to SCSCompon.FCableCanalConnector.Count - 1 do AddGuidToList(GUIDListNBConnector, PCableCanalConnector(SCSCompon.FCableCanalConnector[j]).GuidNBConnector, tiCableCanalConnectors); for j := 0 to SCSCompon.FNormsResources.FNorms.Count - 1 do begin SCSNorm := SCSCompon.FNormsResources.FNorms[j]; if SCSNorm.IsFromInterface = biFalse then AddGuidToList(GUIDListNorms, SCSNorm.GuidNB, tiNBNorms); end; for j := 0 to SCSCompon.FNormsResources.FResources.Count - 1 do begin AddGuidToList(GUIDListResources, SCSCompon.FNormsResources.FResources[j].GuidNB, tiNBResources); AddGuidToList(GUIDListResourceCompons, SCSCompon.FNormsResources.FResources[j].GUIDNBComponent, tiComponent); end; end; //*** Найти ID для - вызов должен быть именно в таком порядке DefineIDsForGUIDs(GUIDListNetType, tiNetType); DefineIDsForGUIDs(GUIDListNorms, tiNBNorms); DefineIDsForGUIDs(GUIDListProperty, tiProperties); DefineIDsForGUIDs(GUIDListObjectIcon, tiObjectIcons); DefineIDsForGUIDs(GUIDListComponType, tiComponentTypes); DefineIDsForGUIDs(GUIDListProducer, tiProducer); DefineIDsForGUIDs(GUIDListSupplier, tiSupplier); DefineIDsForGUIDs(GUIDListSuppliesKind, tiSuppliesKind); DefineIDsForGUIDs(GUIDListInterface, tiInterface); DefineIDsForGUIDs(nil, tiInterfaceAccordance); //DefineIDsForGUIDs(GUIDListNBConnector, tiComponent); DefineIDsForGUIDs(GUIDListResources, tiNBResources); //DefineIDsForGUIDs(GUIDListNBConnector, tiCableCanalConnectors); //DefineIDsForGUIDs(GUIDListResourceCompons, tiComponent); DefineComponIDsForGUIDs(GUIDListResourceCompons, cSCSComponent_Msg14_1); DefineComponIDsForGUIDs(GUIDListNBConnector, cSCSComponent_Msg14); DefineComponIDsForGUIDs(GUIDListOtherCompons, cSCSComponent_Msg14_2); AssignRelatedObjectsForNew(tiProperties); //*** Прописать ссылки обратно for i := 0 to SCSComponents.Count - 1 do begin SCSCompon := SCSComponents[i]; SCSCompon.ID_ComponentType := GetIDByGUID(GUIDListComponType, SCSCompon.GUIDComponentType); SCSCompon.IDNetType := GetIDByGUID(GUIDListNetType, SCSCompon.GUIDNetType); SCSCompon.IDObjectIcon := GetIDByGUID(GUIDListObjectIcon, SCSCompon.GUIDObjectIcon); SCSCompon.ID_Producer := GetIDByGUID(GUIDListProducer, SCSCompon.GUIDProducer); SCSCompon.ID_Supplier := GetIDByGUID(GUIDListSupplier, SCSCompon.GUIDSupplier); SCSCompon.IDSuppliesKind := GetIDByGUID(GUIDListSuppliesKind, SCSCompon.GUIDSuppliesKind); SCSCompon.IDSymbol := GetIDByGUID(GUIDListObjectIcon, SCSCompon.GUIDSymbol); for j := 0 to SCSCompon.FInterfaces.Count - 1 do begin SCSInterface := SCSCompon.FInterfaces[j]; SCSInterface.ID_Interface := GetIDByGUID(GUIDListInterface, SCSInterface.GUIDInterface); end; for j := 0 to SCSCompon.FProperties.Count - 1 do begin ptrProperty := SCSCompon.FProperties[j]; ptrProperty.ID_Property := GetIDByGUID(GUIDListProperty, ptrProperty.GUIDProperty); ptrProperty.IDCrossProperty := GetIDByGUID(GUIDListProperty, ptrProperty.GUIDCrossProperty); end; for j := 0 to SCSCompon.FCableCanalConnector.Count - 1 do begin ptrCableChannelConnector := SCSCompon.FCableCanalConnector[j]; ptrCableChannelConnector.IDNBConnector := GetIDByGUID(GUIDListNBConnector, ptrCableChannelConnector.GuidNBConnector); end; for j := 0 to SCSCompon.FNormsResources.FNorms.Count - 1 do begin SCSNorm := SCSCompon.FNormsResources.FNorms[j]; SCSNorm.IDNB := GetIDByGUID(GUIDListNorms, SCSNorm.GuidNB); end; for j := 0 to SCSCompon.FNormsResources.FResources.Count - 1 do begin SCSResourceRel := SCSCompon.FNormsResources.FResources[j]; SCSResourceRel.IDNB := GetIDByGUID(GUIDListResources, SCSResourceRel.GuidNB); SCSResourceRel.IDNBComponent := GetIDByGUID(GUIDListResourceCompons, SCSResourceRel.GUIDNBComponent); end; end; FreeAndNil(ProjInterfAccordanceList); FreeAndNil(NewNBProperties); FreeAndNil(GUIDListComponType); FreeAndNil(GUIDListNetType); FreeAndNil(GUIDListObjectIcon); FreeAndNil(GUIDListProducer); FreeAndNil(GUIDListSupplier); FreeAndNil(GUIDListSuppliesKind); FreeAndNil(GUIDListInterface); FreeAndNil(GUIDListProperty); FreeAndNil(GUIDListNBConnector); FreeAndNil(GUIDListNorms); FreeAndNil(GUIDListResources); FreeAndNil(GUIDListResourceCompons); FreeAndNil(GUIDListOtherCompons); FreeAndNil(SCSComponents); except on E: Exception do AddExceptionToLogEx('CorrectComponLinksBeforeSaveToNB', E.Message); end; end; procedure CreateInterfacesInComponToConnect(ATrgCompon, AComponToConnect: TSCSComponent; ATrgSide, ASrcSide, AConnectType: Integer); var i, j: Integer; SrcInterface, TrgInterface: TSCSinterface; SrcInterfaces, TrgInterfaces: TRapList; SrcKolvoNeed, TrgKolvo: Integer; CheckInterfRes: TCheckInterfForUnionResult; begin try SrcInterfaces := TRapList.Create; TrgInterfaces := TRapList.Create; for i := 0 to AComponToConnect.FInterfaces.Count - 1 do begin SrcInterface := AComponToConnect.FInterfaces[i]; if CheckInterfReadyToConnect(SrcInterface, ASrcSide, AConnectType, true) then SrcInterfaces.Add(SrcInterface); end; for i := 0 to ATrgCompon.FInterfaces.Count - 1 do begin TrgInterface := ATrgCompon.FInterfaces[i]; if CheckInterfReadyToConnect(TrgInterface, ATrgSide, AConnectType, true) then TrgInterfaces.Add(TrgInterface); end; // Смотрим есть ли в компоненты интерфейсы для подключения for i := 0 to SrcInterfaces.Count - 1 do begin SrcInterface := TSCSInterface(SrcInterfaces[i]); SrcKolvoNeed := 1; if SrcInterface.Multiple = biFalse then SrcKolvoNeed := SrcInterface.Kolvo - SrcInterface.KolvoBusy; TrgKolvo := 0; for j := 0 to TrgInterfaces.Count - 1 do begin TrgInterface := TSCSInterface(TrgInterfaces[j]); if SrcInterface.GUIDInterface = TrgInterface.GUIDInterface then begin CheckInterfRes := CheckInterfForUnion(SrcInterface, TrgInterface, SrcInterface.FActiveForm, TrgInterface.FActiveForm, AConnectType, nil, nil); if CheckInterfRes = chrSuccess then begin // Этот интерфейс не рассматриваем для других SrcInterface TrgInterfaces[j] := nil; if TrgInterface.Kolvo > TrgInterface.KolvoBusy then TrgKolvo := TrgKolvo + (TrgInterface.Kolvo - TrgInterface.KolvoBusy); if TrgKolvo >= SrcKolvoNeed then Break; //// BREAK //// end; end; end; TrgInterfaces.Pack; if TrgKolvo < SrcKolvoNeed then begin // Создаем интерфейс TrgInterface := TSCSInterface.Create(ATrgCompon.FActiveForm); //ATrgCompon.GetInterfaceAsNew; TrgInterface.AssignOnlyInterface(SrcInterface); TrgInterface.ID := GenCurrProjTableID(giInterfaceRelationID); TrgInterface.ComponentOwner := ATrgCompon; ATrgCompon.Interfaces.Add(TrgInterface); TrgInterface.IsLineCompon := ATrgCompon.IsLine; TrgInterface.IsBusy := biFalse; TrgInterface.Kolvo := SrcKolvoNeed - TrgKolvo; TrgInterface.KolvoBusy := 0; if TrgInterface.Gender = gtFemale then TrgInterface.Gender := gtMale else if TrgInterface.Gender = gtMale then TrgInterface.Gender := gtFemale; TrgInterface.IDAdverse := 0; TrgInterface.CoordZ := 0; TrgInterface.SideSection := ''; TrgInterface.Side := ATrgSide; end; end; FreeAndNil(SrcInterfaces); FreeAndNil(TrgInterfaces); except on E: Exception do AddExceptionToLogEx('CreateInterfacesInComponToConnect', E.Message); end; end; procedure DecInterfPositionsKolvo(ANewKolvo: Integer; AInterfPositions: TSCSInterfPositions); var i, CurrPosCount, TotalPosCount: Integer; CurrPosition: TSCSInterfPosition; SparePosCount: Integer; // лишнее количество позиций begin if AInterfPositions.FKolvo > ANewKolvo then begin TotalPosCount := 0; //*** Убрать лишние позиции for i := AInterfPositions.FPositions.Count - 1 downto 0 do begin CurrPosition := TSCSInterfPosition(AInterfPositions.FPositions[i]); CurrPosCount := CurrPosition.ToPos - (CurrPosition.FromPos-1); TotalPosCount := TotalPosCount + CurrPosCount; if TotalPosCount > ANewKolvo then begin SparePosCount := TotalPosCount - ANewKolvo; CurrPosition.ToPos := CurrPosition.ToPos - SparePosCount; AInterfPositions.FKolvo := AInterfPositions.FKolvo - SparePosCount; TotalPosCount := TotalPosCount - SparePosCount; if CurrPosition.ToPos < CurrPosition.FromPos then begin CurrPosition.Free; AInterfPositions.FPositions[i] := nil; end; end; end; AInterfPositions.FPositions.Pack; end; end; function DefineChildCatalogFromPath(ARoot: TSCSCatalog; APath: TStringList): TSCSCatalog; var ChildCatalog: TSCSCatalog; PathNext: TStringlist; begin Result := nil; if APath.Count > 0 then begin if ARoot.ChildCatalogs.Count = 0 then ARoot.LoadChildCatalogs(false, false, false); ChildCatalog := GetChildCatalogByName(ARoot, APath[0], false); if ChildCatalog = nil then begin // Создаем каталог ChildCatalog := F_NormBase.CreateNBCatalog(ARoot, APath[0]); end; if ChildCatalog <> nil then begin if APath.Count > 1 then begin PathNext := TStringlist.Create; PathNext.Assign(APath); PathNext.Delete(0); Result := DefineChildCatalogFromPath(ChildCatalog, PathNext); FreeAndNil(PathNext); end else Result := ChildCatalog; end; end else Result := ARoot; end; procedure DefineChildObjectsFullness(AObject: TSCSCatalog; AItemType: Integer); var CholdObject: TSCSCatalog; i: Integer; begin for i := 0 to AObject.ChildCatalogReferences.Count - 1 do begin CholdObject := AObject.ChildCatalogReferences[i]; if (AItemType = -1) or (CholdObject.ItemType = AItemType) then F_ProjMan.F_ChoiceConnectSide.DefineObjectStatus(CholdObject); end; end; procedure DefineComponConstructiveInterfacesIsBusy(AComponent: TSCSComponent); var i: Integer; Interfac: TSCSInterface; begin try for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces[i]; if Interfac.TypeI = itConstructive then if Interfac.IsBusy = biFalse then if Assigned(Interfac.IOfIRelOut) then if Interfac.IOfIRelOut.Count > 0 then begin Interfac.IsBusy := biTrue; Interfac.KolvoBusy := Interfac.Kolvo; end; end; except on E: Exception do AddExceptionToLogEx('DefineComponConstructiveInterfacesIsBusy', E.Message); end; end; procedure DefineComponNormResByProperty(AComponent: TSCSComponent; AProperty: PProperty; ASave: Boolean = true; ADeletedNormIDs: TIntList = nil; ADeletedResIDs: TIntList = nil); var SprProperty: TNBProperty; i, j: Integer; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; PropValRel: TNBPropValRel; PropValNormRes: TNBPropValNormRes; IsProperValue: Boolean; IntMinValue, IntMaxValue, PropIntValue, FloatMinValue, FloatMaxValue, PropFloatValue: Double; ComponObject: TSCSCatalog; IDComponObject, IDNBCatalog: Integer; ResourcesFromNB: TRapList; NBQSelect: TpFIBQuery; ComponFieldNames: TStringList; IsLoadedSQLSelectCompon: Boolean; SprComponent: TSCSComponent; OldCurrency, NewCurrency: TCurrency; begin try if ADeletedNormIDs <> nil then ADeletedNormIDs.Clear; if ADeletedResIDs <> nil then ADeletedResIDs.Clear; if AComponent.FProjectOwner <> nil then begin SprProperty := AComponent.FProjectOwner.FSpravochnik.GetPropertyByGUID(AProperty.GUIDProperty); if SprProperty <> nil then if SprProperty.PropertyData.IsValueRelToObj = biTrue then begin ResourcesFromNB := nil; IsLoadedSQLSelectCompon := false; ComponFieldNames := nil; NBQSelect := TF_Main(AComponent.FActiveForm).FNormBase.DM.Query_Select; // Удаляем нормы, от этого свойства i := 0; while i <= AComponent.FNormsResources.FNorms.Count - 1 do begin SCSNorm := AComponent.FNormsResources.FNorms[i]; if (SCSNorm.IDCompPropRel <> 0) and (SCSNorm.IDCompPropRel = AProperty.ID) then begin AComponent.FNormsResources.FNorms.Delete(i); if ADeletedNormIDs <> nil then ADeletedNormIDs.Add(SCSNorm.ID); FreeAndNil(SCSNorm); end else i := i + 1; end; // Удаляем ресурсы, пришедшие от свойств i := 0; while i <= AComponent.FNormsResources.FResources.Count - 1 do begin SCSResourceRel := AComponent.FNormsResources.FResources[i]; if (SCSResourceRel.IDCompPropRel <> 0) and (SCSResourceRel.IDCompPropRel = AProperty.ID) then begin AComponent.FNormsResources.FResources.Delete(i); if ADeletedResIDs <> nil then ADeletedResIDs.Add(SCSResourceRel.ID); FreeAndNil(SCSResourceRel); end else i := i + 1; end; // Создаем аксессуары, ресурсы и нормы от значения свойства for i := 0 to SprProperty.FPropValRelList.Count - 1 do begin PropValRel := TNBPropValRel(SprProperty.FPropValRelList.List.List^[i]); // Проверяем, подходит ли значение IsProperValue := false; if (PropValRel.MinValue <> '') and (PropValRel.MaxValue <> '') then begin case SprProperty.PropertyData.IDDataType of dtInteger: begin IntMinValue := StrToIntDef(PropValRel.MinValue, 0); IntMaxValue := StrToIntDef(PropValRel.MaxValue, 0); PropIntValue := StrToIntDef(AProperty.Value, 0); if (IntMinValue <= PropIntValue) and (PropIntValue <= IntMaxValue) then IsProperValue := true end; dtFloat, dtDate: begin FloatMinValue := StrToFloatDefU(PropValRel.MinValue, 0); FloatMaxValue := StrToFloatDefU(PropValRel.MaxValue, 0); PropFloatValue := StrToFloatDefU(AProperty.Value, 0); if (FloatMinValue <= PropFloatValue) and (PropFloatValue <= FloatMaxValue) then IsProperValue := true; end; end; end else if PropValRel.PValue <> '' then begin case SprProperty.PropertyData.IDDataType of dtFloat: if Abs(StrToFloatDefU(PropValRel.PValue, 0) - StrToFloatDefU(AProperty.Value, 0)) < 0.001 then IsProperValue := true; else if AProperty.Value = PropValRel.PValue then IsProperValue := true; end; end; if IsProperValue then for j := 0 to PropValRel.FPropValNormResList.Count - 1 do begin PropValNormRes := TNBPropValNormRes(PropValRel.FPropValNormResList[j]); if (PropValNormRes.GuidNBComponent <> '') or (PropValNormRes.GuidNBRes <> '') then begin SCSResourceRel := nil; if PropValNormRes.GuidNBComponent <> '' then begin if ComponFieldNames = nil then begin ComponFieldNames := TStringList.Create; ComponFieldNames.Add(fnID); ComponFieldNames.Add(fnCypher); ComponFieldNames.Add(fnName); ComponFieldNames.Add(fnIzm); ComponFieldNames.Add(fnPrice); SetSQLToFIBQuery(NBQSelect, GetSQLByParams(qtSelect, tnComponent, fnGUID+' = :'+fnGUID, ComponFieldNames, ''), false); end else NBQSelect.Close; NBQSelect.Params[0].AsString := PropValNormRes.GuidNBComponent; NBQSelect.ExecQuery; if NBQSelect.RecordCount > 0 then begin SCSResourceRel := TSCSResourceRel.Create(AComponent.FActiveForm, ntProj); SCSResourceRel.IDNBComponent := NBQSelect.Fields[0].AsInteger; SCSResourceRel.Cypher := NBQSelect.Fields[1].AsString; SCSResourceRel.Name := NBQSelect.Fields[2].AsString; SCSResourceRel.Izm := NBQSelect.Fields[3].AsString; SCSResourceRel.Price := NBQSelect.Fields[4].AsFloat; if ResourcesFromNB = nil then ResourcesFromNB := TRapList.Create; ResourcesFromNB.Add(SCSResourceRel); end else begin SprComponent := AComponent.FProjectOwner.GetSprComponentByGUID(PropValNormRes.GuidNBComponent); if SprComponent <> nil then begin SCSResourceRel := TSCSResourceRel.Create(AComponent.FActiveForm, ntProj); SCSResourceRel.IDNBComponent := SprComponent.IDNormBase; SCSResourceRel.Cypher := SprComponent.Cypher; SCSResourceRel.Name := SprComponent.Name; SCSResourceRel.Izm := SprComponent.Izm; SCSResourceRel.Price := SprComponent.Price; end; end; if SCSResourceRel <> nil then begin SCSResourceRel.GUIDNBComponent := PropValNormRes.GuidNBComponent; SCSResourceRel.GuidNB := SCSResourceRel.GUIDNBComponent; end; end else if PropValNormRes.GuidNBRes <> '' then begin AddExceptionToLogEx('', cNoWriteCode); end; if SCSResourceRel <> nil then begin SCSResourceRel.IDCompPropRel := AProperty.ID; SCSResourceRel.NormType := ntProj; SCSResourceRel.IDMaster := AComponent.ID; SCSResourceRel.TableKindNB := ctkNBResources; SCSResourceRel.IsOn := biTrue; SCSResourceRel.IDResource := 0; SCSResourceRel.AdditionalPrice := 0; SCSResourceRel.RType := rtPrice; SCSResourceRel.Kolvo := PropValNormRes.Kolvo; SCSResourceRel.ExpenseForLength := PropValNormRes.ExpenseForLength; SCSResourceRel.StepOfPoint := PropValNormRes.StepOfPoint; SCSResourceRel.CountForPoint := PropValNormRes.CountForPoint; if (AComponent.IsLine = biFalse) and (SCSResourceRel.Kolvo = 0) then begin SCSResourceRel.Kolvo := 1; SCSResourceRel.ExpenseForLength := 0; SCSResourceRel.StepOfPoint := 0; SCSResourceRel.CountForPoint := 0; end; AComponent.FNormsResources.FResources.Add(SCSResourceRel); if ASave then SCSResourceRel.SaveResourceAsNew(AComponent.ID); end; end else if PropValNormRes.GuidNBRes <> '' then begin end else if PropValNormRes.GuidNBNorm <> '' then begin AddExceptionToLogEx('', cNoWriteCode); end; end; end; // Переопределяем цены ресурсов, пришедших из НБ if ResourcesFromNB <> nil then begin ComponObject := AComponent.GetFirstParentCatalog; IDComponObject := 0; if ComponObject <> nil then IDComponObject := ComponObject.ID; for i := 0 to ResourcesFromNB.Count - 1 do begin SCSResourceRel := TSCSResourceRel(ResourcesFromNB[i]); IDNBCatalog := TF_Main(AComponent.FActiveForm).FNormBase.DM.GetCatRelCatalogIDByComponIDFromLists(SCSResourceRel.IDNBComponent); DefineCurrenciesBetweenObjects(SCSResourceRel.IDNBComponent, IDNBCatalog, IDComponObject, TF_Main(AComponent.FActiveForm).FNormBase, AComponent.FActiveForm, OldCurrency, NewCurrency); if (OldCurrency.ID <> 0) and (NewCurrency.ID <> 0) then SCSResourceRel.Price := GetPriceAfterChangeCurrency(SCSResourceRel.Price, OldCurrency, NewCurrency); end; FreeAndNil(ResourcesFromNB); end; FreeAndNil(ComponFieldNames); end; end; except on E: Exception do AddExceptionToLogEx('DefineComponNormResByProperty', E.Message); end; end; procedure DefineComponPriceOnCopyToOtherBase(ACompon: TSCSComponent; ASrcObject, ATrgObject: TSCSCatalog; ASrcForm, ATrgForm: TForm); var TrgLevelObjectID: Integer; TrgCurrensyM, SrcCurrensyM, SrcCurrensyMFromTrg: TCurrency; ptrTrgCurrensyM, ptrSrcCurrensyM: PObjectCurrencyRel; ptrSrcCurrensyMFromTrg: PObjectCurrencyRel; SprTrgCurrensyM, SprSrcCurrensyM, SprSrcCurrensyMFromTrg, NBCurrency: TNBCurrency; ProjectOwner: TSCSCatalog; begin if ASrcForm <> ATrgForm then begin ZeroMemory(@TrgCurrensyM, SizeOf(TCurrency)); ZeroMemory(@SrcCurrensyM, SizeOf(TCurrency)); ZeroMemory(@SrcCurrensyMFromTrg, SizeOf(TCurrency)); //*** Из НБ в МП if (TF_Main(ASrcForm).GDBMode = bkNormBase) and (TF_Main(ATrgForm).GDBMode = bkProjectManager) then begin //*** Подрихтовать цену под текущую валюту, если комплектующая // if ACompon.GetParentComponent <> nil then // ACompon.Price_Calc := TF_Main(ASrcForm).GetComponPrice(ACompon.OldID, ACompon.IDCompRel, ACompon.idto); ProjectOwner := ATrgObject.GetProject; if ProjectOwner is TSCSProject then begin //*** Определить SrcCurrensyM ptrSrcCurrensyM := TF_Main(ASrcForm).DM.GetComponCurrencyByMainFld(ACompon.ID, ctMain); if ptrSrcCurrensyM <> nil then begin SrcCurrensyM := ptrSrcCurrensyM.Data; FreeMem(ptrSrcCurrensyM); end; if SrcCurrensyM.GUID <> '' then begin //*** Определить TrgCurrensyM SprTrgCurrensyM := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByType(ctMain); if SprTrgCurrensyM <> nil then TrgCurrensyM := SprTrgCurrensyM.Data; if SrcCurrensyM.GUID <> TrgCurrensyM.GUID then begin // Определяем SrcCurrensyMFromTrg и TrgCurrensyM SprSrcCurrensyMFromTrg := nil; // По справочнику валют проекта if GSCSIni.NB.CurrencyConvertionNB2PM = cckByTarget then begin //*** Определить SrcCurrensyMFromTrg NBCurrency := TF_Main(ASrcForm).GSCSBase.FNBSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); if NBCurrency <> nil then SprSrcCurrensyMFromTrg := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyWithAssign( NBCurrency, TF_Main(ASrcForm).GSCSBase.FNBSpravochnik); //SprSrcCurrensyMFromTrg := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); if SprSrcCurrensyMFromTrg <> nil then SrcCurrensyMFromTrg := SprSrcCurrensyMFromTrg.Data; end else // По справочнику валют папки НБ if GSCSIni.NB.CurrencyConvertionNB2PM = cckBySource then begin // валюта проекта из валют папки компонентов ptrSrcCurrensyM := TF_Main(ASrcForm).DM.GetComponCurrencyByCurrencyGUID(ACompon.ID, TrgCurrensyM.GUID); if ptrSrcCurrensyM <> nil then begin TrgCurrensyM := ptrSrcCurrensyM^.Data; FreeMem(ptrSrcCurrensyM); end else TrgCurrensyM := SrcCurrensyM; SrcCurrensyMFromTrg := SrcCurrensyM; end; end; end; end; end else //*** Из МП в НБ if (TF_Main(ASrcForm).GDBMode = bkProjectManager) and (TF_Main(ATrgForm).GDBMode = bkNormBase) and (ASrcObject <> nil) then begin ProjectOwner := ASrcObject.GetProject; TrgLevelObjectID := TF_Main(ATrgForm).DM.GetParentCatalogIDByLevel(ATrgObject.ID, dirCurrencyLevel); if (ProjectOwner is TSCSProject) and (TrgLevelObjectID > 0) then begin //*** Определить SrcCurrensyM SprSrcCurrensyM := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByType(ctMain); if SprSrcCurrensyM <> nil then SrcCurrensyM := SprSrcCurrensyM.Data; if SrcCurrensyM.GUID <> '' then begin //*** Определить TrgCurrensyM ptrTrgCurrensyM := TF_Main(ATrgForm).DM.GetObjectCurrencyByMainFld(TrgLevelObjectID, ctMain); if ptrTrgCurrensyM <> nil then begin TrgCurrensyM := ptrTrgCurrensyM.Data; FreeMem(ptrTrgCurrensyM); end; if SrcCurrensyM.GUID <> TrgCurrensyM.GUID then begin NBCurrency := TF_Main(ATrgForm).GSCSBase.FNBSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); //*** Определить SrcCurrensyMFromTrg if NBCurrency <> nil then begin ptrSrcCurrensyMFromTrg := TF_Main(ATrgForm).DM.GetObjectCurrencyByIDCurrency(TrgLevelObjectID, NBCurrency.Data.ID); if ptrSrcCurrensyMFromTrg <> nil then begin SrcCurrensyMFromTrg := ptrSrcCurrensyMFromTrg.Data; FreeMem(ptrSrcCurrensyMFromTrg); end; end; end; end; end; end; if (TrgCurrensyM.GUID <> '') and (SrcCurrensyMFromTrg.GUID <> '') then ACompon.RefreshPricesAfterChangeCurrency(SrcCurrensyMFromTrg, TrgCurrensyM, false, false); end; end; procedure DefineCurrenciesBetweenObjects(AComponID, ASrcObjectID, ATrgObjectID: Integer; ASrcForm, ATrgForm: TForm; var AOldCurrency, ANewCurrency: TCurrency); var TrgLevelObjectID: Integer; TrgCurrensyM, SrcCurrensyM, SrcCurrensyMFromTrg: TCurrency; ptrTrgCurrensyM, ptrSrcCurrensyM, ptrSrcCurrensyMFromTrg: PObjectCurrencyRel; SprTrgCurrensyM, SprSrcCurrensyM, SprSrcCurrensyMFromTrg: TNBCurrency; ProjectOwner: TSCSCatalog; NBCurrency: TNBCurrency; begin ZeroMemory(@AOldCurrency, SizeOf(TCurrency)); ZeroMemory(@ANewCurrency, SizeOf(TCurrency)); if ASrcForm <> ATrgForm then begin ZeroMemory(@TrgCurrensyM, SizeOf(TCurrency)); ZeroMemory(@SrcCurrensyM, SizeOf(TCurrency)); ZeroMemory(@SrcCurrensyMFromTrg, SizeOf(TCurrency)); //*** Из НБ в МП if (TF_Main(ASrcForm).GDBMode = bkNormBase) and (TF_Main(ATrgForm).GDBMode = bkProjectManager) then begin //*** Подрихтовать цену под текущую валюту, если комплектующая // if ACompon.GetParentComponent <> nil then // ACompon.Price_Calc := TF_Main(ASrcForm).GetComponPrice(ACompon.OldID, ACompon.IDCompRel, ACompon.idto); ProjectOwner := TF_Main(ATrgForm).GSCSBase.CurrProject; //ATrgObject.GetProject; if ProjectOwner is TSCSProject then begin //*** Определить SrcCurrensyM ptrSrcCurrensyM := nil; if ASrcObjectID <> 0 then ptrSrcCurrensyM := TF_Main(ASrcForm).DM.GetCatalogCurrencyByMainFld(ASrcObjectID, ctMain) else if AComponID <> 0 then ptrSrcCurrensyM := TF_Main(ASrcForm).DM.GetComponCurrencyByMainFld(AComponID, ctMain); if ptrSrcCurrensyM <> nil then begin SrcCurrensyM := ptrSrcCurrensyM.Data; FreeMem(ptrSrcCurrensyM); end; if SrcCurrensyM.GUID <> '' then begin //*** Определить TrgCurrensyM SprTrgCurrensyM := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByType(ctMain); if SprTrgCurrensyM <> nil then TrgCurrensyM := SprTrgCurrensyM.Data; if SrcCurrensyM.GUID <> TrgCurrensyM.GUID then begin SprSrcCurrensyMFromTrg := nil; //*** Определить SrcCurrensyMFromTrg NBCurrency := TF_Main(ASrcForm).GSCSBase.FNBSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); if NBCurrency <> nil then SprSrcCurrensyMFromTrg := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyWithAssign( NBCurrency, TF_Main(ASrcForm).GSCSBase.FNBSpravochnik); //SprSrcCurrensyMFromTrg := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); if SprSrcCurrensyMFromTrg <> nil then SrcCurrensyMFromTrg := SprSrcCurrensyMFromTrg.Data; end; end; end; end else //*** Из МП в НБ if (TF_Main(ASrcForm).GDBMode = bkProjectManager) and (TF_Main(ATrgForm).GDBMode = bkNormBase) and (ASrcObjectID <> 0) then begin ProjectOwner := TF_Main(ATrgForm).GSCSBase.CurrProject; //ASrcObject.GetProject; TrgLevelObjectID := TF_Main(ATrgForm).DM.GetParentCatalogIDByLevel(ATrgObjectID, dirCurrencyLevel); if (ProjectOwner is TSCSProject) and (TrgLevelObjectID > 0) then begin //*** Определить SrcCurrensyM SprSrcCurrensyM := TSCSProject(ProjectOwner).FSpravochnik.GetCurrencyByType(ctMain); if SprSrcCurrensyM <> nil then SrcCurrensyM := SprSrcCurrensyM.Data; if SrcCurrensyM.GUID <> '' then begin //*** Определить TrgCurrensyM ptrTrgCurrensyM := TF_Main(ATrgForm).DM.GetObjectCurrencyByMainFld(TrgLevelObjectID, ctMain); if ptrTrgCurrensyM <> nil then begin TrgCurrensyM := ptrTrgCurrensyM.Data; FreeMem(ptrTrgCurrensyM); end; if SrcCurrensyM.GUID <> TrgCurrensyM.GUID then begin NBCurrency := TF_Main(ATrgForm).GSCSBase.FNBSpravochnik.GetCurrencyByGUID(SrcCurrensyM.GUID); //*** Определить SrcCurrensyMFromTrg if NBCurrency <> nil then begin ptrSrcCurrensyMFromTrg := TF_Main(ATrgForm).DM.GetObjectCurrencyByIDCurrency(TrgLevelObjectID, NBCurrency.Data.ID); if ptrSrcCurrensyMFromTrg <> nil then begin SrcCurrensyMFromTrg := ptrSrcCurrensyMFromTrg.Data; FreeMem(ptrSrcCurrensyMFromTrg); end; end; end; end; end; end; if (TrgCurrensyM.GUID <> '') and (SrcCurrensyMFromTrg.GUID <> '') then begin //ACompon.RefreshPricesAfterChangeCurrency(SrcCurrensyMFromTrg, TrgCurrensyM, false, false); AOldCurrency := SrcCurrensyMFromTrg; ANewCurrency := TrgCurrensyM; end; end; end; procedure DefinePriceCalcInChildComponInNB(AComponent: TSCSComponent; ANBForm: TForm); var ChildComonent: TSCSComponent; i: integer; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // begin OldTick := GetTickCount; if TF_Main(ANBForm).GDBMode = bkNormBase then for i := 0 to AComponent.FChildReferences.Count - 1 do begin ChildComonent := AComponent.FChildReferences[i]; ChildComonent.Price_Calc := TF_Main(ANBForm).GetComponPrice(ChildComonent.ID, ChildComonent.IDCompRel, AComponent.ID); //DefineStep(ChildComonent); end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; function DefineFemaleMaleCompons(ACompon1, ACompon2: TSCSComponent; var AFemaleCompon, AMaleCompon: TSCSComponent; var AFemaleInterf, AMaleInterf: TSCSInterface): Boolean; var Compon1FemaleInterf, Compon2FemaleInterf: TSCSInterface; FemaleComponent, MaleComponent: TSCSComponent; MaleInterface, FemaleInterface: TSCSInterface; begin Result := false; AFemaleCompon := nil; AMaleCompon := nil; AFemaleInterf := nil; AMaleInterf := nil; FemaleComponent := nil; MaleComponent := nil; MaleInterface := nil; FemaleInterface := nil; //*** Найти конструктивы Мама с максимальным сечением Compon1FemaleInterf := ACompon1.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, '', true); Compon2FemaleInterf := ACompon2.GetInterfaceByTypeAndGender([itConstructive], [gtFemale], biTrue, '', true); //*** Определить компонент, который будет папой if (Compon1FemaleInterf <> nil) and (Compon2FemaleInterf <> nil) then begin //*** у кого объем больше, тот и будет мамой if Compon1FemaleInterf.ValueI > Compon2FemaleInterf.ValueI then MaleComponent := ACompon2 else MaleComponent := ACompon1; end else begin if Compon1FemaleInterf = nil then MaleComponent := ACompon1 else if Compon2FemaleInterf = nil then MaleComponent := ACompon2; end; //*** Если компонент папа определен, то находим маму if MaleComponent <> nil then begin if MaleComponent = ACompon1 then begin if Compon2FemaleInterf <> nil then FemaleComponent := ACompon2; end else if MaleComponent = ACompon2 then begin if Compon1FemaleInterf <> nil then FemaleComponent := ACompon1; end; end; //*** Если компонент мама и папа найдены, определить их конструктивные интерфейсы if (MaleComponent <> nil) and (FemaleComponent <> nil) then begin FemaleComponent.CheckCanalHaveCable(MaleComponent, FemaleInterface, MaleInterface); Result := true; end; AFemaleCompon := FemaleComponent; AMaleCompon := MaleComponent; AFemaleInterf := FemaleInterface; AMaleInterf := MaleInterface; end; procedure DefineNoExistsInterfPosConnection(AIOfIRel: TSCSIOfIRel); var InterfPosConnection: TSCSInterfPosConnection; begin if AIOfIRel.FPosConnections.Count = 0 then if (AIOfIRel.InterfaceOwner <> nil) and (AIOfIRel.InterfaceTo <> nil) and (AIOfIRel.InterfaceOwner.Kolvo = AIOfIRel.InterfaceTo.Kolvo) then begin InterfPosConnection := TSCSInterfPosConnection.Create(AIOfIRel, true); AIOfIRel.FPosConnections.Add(InterfPosConnection); InterfPosConnection.ID := -1; InterfPosConnection.IDIOIRel := AIOfIRel.ID; if AIOfIRel.FInterfaceOwner.FComponentOwner.FProjectOwner <> nil then InterfPosConnection.ID := AIOfIRel.FInterfaceOwner.FComponentOwner.FProjectOwner.GenIDByGeneratorIndex(giInterfPosConnectionID); InterfPosConnection.FSelfInterfPosition.FromPos := 1; InterfPosConnection.FSelfInterfPosition.ToPos := AIOfIRel.InterfaceOwner.Kolvo; //InterfPosConnection.FSelfInterfPosition.InterfOwner := IOfIRel.InterfaceOwner; //IOfIRel.InterfaceOwner.FBusyPositions.Add(InterfPosConnection.FSelfInterfPosition); InterfPosConnection.FConnInterfPosition.FromPos := 1; InterfPosConnection.FConnInterfPosition.ToPos := AIOfIRel.InterfaceTo.Kolvo; //InterfPosConnection.FConnInterfPosition.InterfOwner := IOfIRel.InterfaceTo; //IOfIRel.InterfaceTo.FBusyPositions.Add(InterfPosConnection.FConnInterfPosition); //*** Установить количество занятых интерфейсов if AIOfIRel.InterfaceOwner.KolvoBusy = 0 then AIOfIRel.InterfaceOwner.KolvoBusy := 1; if AIOfIRel.InterfaceTo.KolvoBusy = 0 then AIOfIRel.InterfaceTo.KolvoBusy := 1; SetLinkToInterfPosConnection(InterfPosConnection, AIOfIRel.InterfaceOwner, AIOfIRel.InterfaceTo); end; end; procedure DefineJoiningComponentsByTrunk(var ACompon1, ACompon2: TSCSComponent; ASideCompon1, ASideCompon2: Integer); var LineComponent, ConnComponent: TSCSComponent; ConnComponentObjectOwner, LineComponentObjectOwner: TSCSCatalog; ConnComponentListOwner, LineComponentListOwner: TSCSList; CADCrossObject: TCADCrossObject; PosOfConnectingTrace, ComponIDFromCAD, i, j, LineComponentSide, ConnComponentSide: Integer; ComponentList: TSCSComponents; CurrComponFromPos, CheckingComponent, DefinedPointComponent: TSCSComponent; // JoinParams ReverseParams, CanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams: Boolean; begin LineComponent := nil; ConnComponent := nil; LineComponentSide := -1; ConnComponentSide := -1; ConnComponentObjectOwner := nil; LineComponentObjectOwner := nil; ConnComponentListOwner := nil; LineComponentListOwner := nil; DefinedPointComponent := nil; ComponIDFromCAD := -1; CurrComponFromPos := nil; CanConnBusyMultiple := false; CanJoinWithNoInterfaces := false; CanJoinWithNoParams := false; if Assigned(ACompon1) and Assigned(ACompon2) then begin ReverseParams := false; if (ACompon1.IsLine = biFalse) and (ACompon2.IsLine = biTrue) then begin ConnComponent := ACompon1; LineComponent := ACompon2; ConnComponentSide := ASideCompon1; LineComponentSide := ASideCompon2; end else if (ACompon1.IsLine = biTrue) and (ACompon2.IsLine = biFalse) then begin ReverseParams := true; ConnComponent := ACompon2; LineComponent := ACompon1; ConnComponentSide := ASideCompon2; LineComponentSide := ASideCompon1; end; if Assigned(ConnComponent) and Assigned(LineComponent) then begin {if IsTrunkComponent(ConnComponent) then if (TF_Main(ConnComponent.FActiveForm).GDBMode = bkProjectManager) and (TF_Main(LineComponent.FActiveForm).GDBMode = bkProjectManager) then begin ConnComponentObjectOwner := ConnComponent.GetFirstParentCatalog; LineComponentObjectOwner := LineComponent.GetFirstParentCatalog; if //Not(ConnComponent.Parent is TSCSComponent) and (ConnComponentObjectOwner <> nil) and (LineComponentObjectOwner <> nil) then begin ConnComponentListOwner := ConnComponentObjectOwner.GetListOwner; LineComponentListOwner := LineComponentObjectOwner.GetListOwner; if (ConnComponentListOwner <> nil) and (LineComponentListOwner <> nil) then begin PosOfConnectingTrace := GetPosOfConnectingTrace(LineComponentObjectOwner.ListID, LineComponentObjectOwner.SCSID); if PosOfConnectingTrace <> -1 then begin //*** Найти подходящий компонент в позиции CADCrossObject := ConnComponentListOwner.GetCADCrossObjectByObjectID(ConnComponentObjectOwner.ID); if CADCrossObject <> nil then begin if PosOfConnectingTrace <= CADCrossObject.Elements.Count - 1 then ComponIDFromCAD := TCADCrossObjectElement(CADCrossObject.Elements[PosOfConnectingTrace]).IDComponent; if ComponIDFromCAD <> -1 then CurrComponFromPos := ConnComponentObjectOwner.FComponentReferences.GetComponenByID(ComponIDFromCAD); if CurrComponFromPos <> nil then begin ComponentList := TSCSComponents.Create(false); ComponentList.Add(CurrComponFromPos); ComponentList.Assign(CurrComponFromPos.FChildReferences, laOr); for i := 0 to ComponentList.Count - 1 do begin CheckingComponent := ComponentList[i]; //if CheckingComponent.CheckJoinTo(LineComponent, ConnComponentSide, LineComponentSide).CanConnect then if CheckingComponent.ConnectWith(LineComponent, ConnComponentSide, LineComponentSide, -1, -1, cntUnion, true, CanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, nil, nil).CanConnect then begin DefinedPointComponent := CheckingComponent; Break; //// BREAK //// end; end; //*** Если не нашлась компонннта для подключения, то оставаться на текущей позиции if DefinedPointComponent = nil then DefinedPointComponent := CurrComponFromPos; //*** Найден компонент в позиции, от. модет подключиться if DefinedPointComponent <> nil then begin if Not ReverseParams then ACompon1 := DefinedPointComponent else ACompon2 := DefinedPointComponent; end; FreeAndNil(ComponentList); end; end; end; end; end; end;} CurrComponFromPos := GetComponFromComplexObjByLine(ConnComponent, LineComponent); if CurrComponFromPos <> nil then begin ComponentList := TSCSComponents.Create(false); ComponentList.Add(CurrComponFromPos); ComponentList.Assign(CurrComponFromPos.FChildReferences, laOr); for i := 0 to ComponentList.Count - 1 do begin CheckingComponent := ComponentList[i]; //if CheckingComponent.CheckJoinTo(LineComponent, ConnComponentSide, LineComponentSide).CanConnect then if CheckingComponent.ConnectWith(LineComponent, ConnComponentSide, LineComponentSide, -1, -1, cntUnion, true, CanConnBusyMultiple, CanJoinWithNoInterfaces, CanJoinWithNoParams, nil, nil).CanConnect then begin DefinedPointComponent := CheckingComponent; Break; //// BREAK //// end; end; //*** Если не нашлась компонннта для подключения, то оставаться на текущей позиции if DefinedPointComponent = nil then DefinedPointComponent := CurrComponFromPos; //*** Найден компонент в позиции, от. модет подключиться if DefinedPointComponent <> nil then begin if DefinedPointComponent.FJoinedComponents.IndexOf(LineComponent) <> -1 then DefinedPointComponent := nil; if Not ReverseParams then ACompon1 := DefinedPointComponent else ACompon2 := DefinedPointComponent; end; FreeAndNil(ComponentList); end; end; end; end; procedure DefineObjectsForPointFigureRelations(APointFigureRelations: TObjectList; ASCSList: TSCSList); var SCSProject, SCSCatalog: TSCSCatalog; PointFigureRelation: TPointFigureRelation; i, j: Integer; SortCache: TRapObjectList; begin try SCSProject := ASCSList.GetTopParentCatalog; if SCSProject <> nil then begin SortCache := TRapObjectList.Create; for i := 0 to APointFigureRelations.Count - 1 do begin //PointFigureRelation := TPointFigureRelation(APointFigureRelations[i]); PointFigureRelation := TPointFigureRelation(APointFigureRelations.List^[i]); PointFigureRelation.FirstPointObject := SCSProject.GetCatalogFromReferencesBySCSIDUseSortCache(PointFigureRelation.FirstPointFigure, SortCache); PointFigureRelation.LastPointObject := SCSProject.GetCatalogFromReferencesBySCSIDUseSortCache(PointFigureRelation.LastPointFigure, SortCache); for j := 0 to PointFigureRelation.Traces.Count - 1 do begin SCSCatalog := SCSProject.GetCatalogFromReferencesBySCSIDUseSortCache(PointFigureRelation.Traces[j], SortCache); if SCSCatalog <> nil then PointFigureRelation.TracesObjects.Add(SCSCatalog) else raise Exception.Create('Trace id '+IntToStr(PointFigureRelation.Traces[j])+' fail'); end; end; SortCache.Free; end; except on E: Exception do AddExceptionToLogEx('DefineObjectsForPointFigureRelations', E.Message); end; end; procedure DefinePointObjectsForLineCompon(ALineComponent: TSCSComponent; var APointFrom, APointTo: TSCSCatalog); var Project: TSCSProject; CanExchPoinObjectsByInterfCount: Boolean; IDCurrConnObj1, IDCurrConnObj2, IDConnObj1, IDConnObj2, IDConnObjTmp1, IDConnObjTmp2, IDLineObjFrom, IDLineObjTo: Integer; LineComponFrom, LineComponTo: TSCSComponent; ObjLineFrom, ObjLineTo: TSCSCatalog; FigureIDsBetweenEndLines: TIntList; function GetObjectOwnerSCSID(AConCompon: TSCSComponent): Integer; var ObjetOwner: TSCSCatalog; begin Result := -1; ObjetOwner := nil; if AConCompon <> nil then ObjetOwner := AConCompon.GetFirstParentCatalog; if ObjetOwner <> nil then Result := ObjetOwner.SCSID; end; function CheckObjIDCanUse(AObjID: Integer): Boolean; begin Result := true; if AObjID < 1 then Result := false else if (IDCurrConnObj1 > 0) and (IDCurrConnObj2 > 0) then if (AObjID <> IDCurrConnObj1) and (AObjID <> IDCurrConnObj2) then Result := false; if FigureIDsBetweenEndLines <> nil then if FigureIDsBetweenEndLines.IndexOf(AObjID) <> -1 then Result := false; end; begin APointFrom := nil; APointTo := nil; FigureIDsBetweenEndLines := nil; Project := ALineComponent.FProjectOwner; if Project <> nil then begin if (ALineComponent.FirstConnectedConnCompon = nil) and (ALineComponent.FirstIDConnectedConnCompon <> 0) then ALineComponent.FirstConnectedConnCompon := Project.GetComponentFromReferences(ALineComponent.FirstIDConnectedConnCompon); if (ALineComponent.LastConnectedConnCompon = nil) and (ALineComponent.LastIDConnectedConnCompon <> 0) then ALineComponent.LastConnectedConnCompon := Project.GetComponentFromReferences(ALineComponent.LastIDConnectedConnCompon); end; IDCurrConnObj1 := GetObjectOwnerSCSID(ALineComponent.FirstConnectedConnCompon); IDCurrConnObj2 := GetObjectOwnerSCSID(ALineComponent.LastConnectedConnCompon); LineComponFrom := nil; LineComponTo := nil; IDConnObj1 := -1; IDConnObj2 := -1; IDConnObjTmp1 := -1; IDConnObjTmp2 := -1; IDLineObjFrom := -1; IDLineObjTo := -1; ObjLineFrom := nil; ObjLineTo := nil; LineComponFrom := Project.GetComponentFromReferences(ALineComponent.FirstIDCompon); LineComponTo := Project.GetComponentFromReferences(ALineComponent.LastIDCompon); if Assigned(LineComponFrom) then ObjLineFrom := LineComponFrom.GetFirstParentCatalog; if Assigned(LineComponTo) then ObjLineTo := LineComponTo.GetFirstParentCatalog; if Assigned(ObjLineFrom) then IDLineObjFrom := ObjLineFrom.SCSID; if Assigned(ObjLineTo) then IDLineObjTo := ObjLineTo.SCSID; if IDCurrConnObj1 <> IDCurrConnObj2 then //28.01.2011 begin //*** Список объектов между двумя трассами if (ObjLineFrom <> nil) and (ObjLineTo <> nil) then FigureIDsBetweenEndLines := GetFigureIDsBetweenOnWholeComponent(ALineComponent); //*** Для стороны "откуда" IDConnObjTmp1 := -1; IDConnObjTmp2 := -1; if ObjLineFrom <> nil then GetConnObjectsByLine(ObjLineFrom.ListID, IDLineObjFrom, IDConnObjTmp1, IDConnObjTmp2); if CheckObjIDCanUse(IDConnObjTmp1) then IDConnObj1 := IDConnObjTmp1; if CheckObjIDCanUse(IDConnObjTmp2) then IDConnObj2 := IDConnObjTmp2; //*** Для стороны "куда" IDConnObjTmp1 := -1; IDConnObjTmp2 := -1; if ObjLineTo <> nil then GetConnObjectsByLine(ObjLineTo.ListID, IDLineObjTo, IDConnObjTmp1, IDConnObjTmp2); if CheckObjIDCanUse(IDConnObjTmp1) then if (IDConnObj1 = -1) and (IDConnObjTmp1 <> IDConnObj2) then IDConnObj1 := IDConnObjTmp1 else if (IDConnObj2 = -1) and (IDConnObjTmp1 <> IDConnObj1) then IDConnObj2 := IDConnObjTmp1; if CheckObjIDCanUse(IDConnObjTmp2) then if (IDConnObj2 = -1) and (IDConnObjTmp2 <> IDConnObj1) then IDConnObj2 := IDConnObjTmp2 else if (IDConnObj1 = -1) and (IDConnObjTmp2 <> IDConnObj2) then IDConnObj1 := IDConnObjTmp2; end else //28.01.2011 - если конечный объект один и тот же - например трассы соединяют разные кроссы одной АТС, или подъезды одного дома begin IDConnObj1 := IDCurrConnObj1; IDConnObj2 := IDCurrConnObj2; end; APointFrom := Project.GetCatalogFromReferencesBySCSID(IDConnObj1); APointTo := Project.GetCatalogFromReferencesBySCSID(IDConnObj2); if Assigned(ALineComponent.FirstConnectedConnCompon) then begin if ALineComponent.FirstConnectedConnCompon.GetFirstParentCatalog <> APointFrom then ExchangeObjects(APointFrom, APointTo); end else if Assigned(ALineComponent.LastConnectedConnCompon) then begin if ALineComponent.LastConnectedConnCompon.GetFirstParentCatalog <> APointTo then ExchangeObjects(APointTo, APointFrom); end else if CheckConnectedObjectsInCAD(APointFrom, ObjLineTo) then ExchangeObjects(APointTo, APointFrom); //*** По количеству интерфейсов определить начальный и конечный объекты, // не учитывая подключения к ним кабеля CanExchPoinObjectsByInterfCount := false; if Assigned(APointFrom) and Assigned(APointTo) then begin if APointFrom.GetInterfaceCount([itFunctional]) > APointTo.GetInterfaceCount([itFunctional]) then CanExchPoinObjectsByInterfCount := true; end else if Assigned(APointFrom) and Not Assigned(APointTo) then CanExchPoinObjectsByInterfCount := true; if CanExchPoinObjectsByInterfCount then begin ExchangeObjects(APointTo, APointFrom); ExchangeIntegers(ALineComponent.FirstIDCompon, ALineComponent.LastIDCompon); ExchangeIntegers(ALineComponent.FirstIDConnectedConnCompon, ALineComponent.LastIDConnectedConnCompon); ExchangeObjects(ALineComponent.FirstConnectedConnCompon, ALineComponent.LastConnectedConnCompon); end; if FigureIDsBetweenEndLines <> nil then FreeAndNil(FigureIDsBetweenEndLines); end; procedure DeleteComponNormResByIDCompPropRel(AComponent: TSCSComponent; AIDCompPropRel: Integer); var SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; i: Integer; begin if AIDCompPropRel <> 0 then begin i := 0; while i <= AComponent.FNormsResources.FNorms.Count - 1 do begin SCSNorm := AComponent.FNormsResources.FNorms[i]; if (SCSNorm.IDCompPropRel = AIDCompPropRel) then begin AComponent.FNormsResources.FNorms.Delete(i); FreeAndNil(SCSNorm); end else i := i + 1; end; // Удаляем ресурсы, пришедшие от свойств i := 0; while i <= AComponent.FNormsResources.FResources.Count - 1 do begin SCSResourceRel := AComponent.FNormsResources.FResources[i]; if (SCSResourceRel.IDCompPropRel = AIDCompPropRel) then begin AComponent.FNormsResources.FResources.Delete(i); FreeAndNil(SCSResourceRel); end else i := i + 1; end; end; end; procedure DeleteComponObjectsForNB(AComponent: TSCSComponent; ARecursive: Boolean); var i: Integer; procedure DeleteSimpleComponObjectsForNB(ACompon: TSCScomponent); var i: Integer; SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; begin // Удаляем нормы, пришедшие от интерфейсов и от свойств i := 0; while i <= ACompon.FNormsResources.FNorms.Count - 1 do begin SCSNorm := ACompon.FNormsResources.FNorms[i]; if (SCSNorm.IsFromInterface = biTrue) or (SCSNorm.IDCompPropRel <> 0) then begin ACompon.FNormsResources.FNorms.Delete(i); FreeAndNil(SCSNorm); end else Inc(i); end; // Удаляем ресурсы, пришедшие от свойств i := 0; while i <= ACompon.FNormsResources.FResources.Count - 1 do begin SCSResourceRel := ACompon.FNormsResources.FResources[i]; if (SCSResourceRel.IDCompPropRel <> 0) then begin ACompon.FNormsResources.FResources.Delete(i); FreeAndNil(SCSResourceRel); end else Inc(i); end; end; begin DeleteSimpleComponObjectsForNB(AComponent); if ARecursive then for i := 0 to AComponent.FChildReferences.Count - 1 do DeleteSimpleComponObjectsForNB(AComponent.FChildReferences[i]); end; function ExtendTemplateInterface(AInterf: TSCSInterface; AAddCount: Integer; ANewValue: PDouble): Boolean; var PropPortCount: PProperty; PortCount, PortWireCount, WireCount, AddCount, AddPortCount: Integer; InterfInSection, InterfOutSection: TSCSInterface; ParentCompon: TSCSComponent; NewValueSm2, ValueMm2: Double; begin Result := false; try {if (AInterf1.ComponentOwner <> nil) and (AInterf2.ComponentOwner <> nil) then begin ExtendTemplateInterf(AInterf1); ExtendTemplateInterf(AInterf2); end;} if AInterf.ComponentOwner <> nil then if (AInterf.ComponentOwner.IsTemplate = biTrue) and GCanExtendInterfPosInVirtualCompons then begin AddCount := AAddCount; // Жила if AInterf.GUIDInterface = guidUniversalWire then begin // Для точ. компонента if AInterf.ComponentOwner.IsLine = biFalse then begin PortCount := 0; PropPortCount := AInterf.ComponentOwner.GetPropertyBySysName(pnPortCount); if PropPortCount <> nil then PortCount := StrToIntDef(PropPortCount.Value, 0); PortWireCount := AInterf.ComponentOwner.GetPropertyValueAsInteger(pnPortWireCount); if (PortWireCount <> 0) and (PortCount <> 0) then begin // Узнаем добавляемое кол-во портов AddPortCount := RoundUp(AddCount / PortWireCount); // Сохраняем свойство - кол-во портов if PropPortCount <> nil then AInterf.ComponentOwner.SetPropertyValueAsString(PropPortCount, IntToStr(PortCount + AddPortCount)); // количество интерфейсов кратно количеству жил на порт AddCount := AddPortCount * PortWireCount; end; AInterf.Kolvo := AInterf.Kolvo + AddCount; end else begin AInterf.Kolvo := AInterf.Kolvo + AddCount; if AInterf.ParallelInterface <> nil then AInterf.ParallelInterface.Kolvo := AInterf.Kolvo; // Количество жил AInterf.ComponentOwner.SetPropertyValueAsString(pnPortCount, IntToStr(AInterf.Kolvo), false); end; AInterf.DefineIsBusy; if AInterf.ParallelInterface <> nil then AInterf.ParallelInterface.DefineIsBusy; end else // Внутреннее сечение if AInterf.GUIDInterface = guidUniversalInConstr then if (ANewValue <> nil) and (AInterf.ValueI <> ANewValue^) then begin NewValueSm2 := ANewValue^; AInterf.ValueI := NewValueSm2; // Заносим в свойство в mm2 ValueMm2 := FloatInUOM(AInterf.ValueI, umSM, umMM, 2); AInterf.ComponentOwner.SetPropertyValueAsFloat(pnInSection, ValueMm2, false); // Если внешнее сечение меньше внутреннего, то делаем его таким как внутреннее InterfOutSection := GetComponInterfBySprGUID(AInterf.ComponentOwner, guidUniversalOutConstr); if InterfOutSection <> nil then if InterfOutSection.ValueI < AInterf.ValueI then begin InterfOutSection.ValueI := AInterf.ValueI; // Заносим в свойство "Внутреннее сечение" в mm2 AInterf.ComponentOwner.SetPropertyValueAsFloat(pnOutSection, ValueMm2, false); end; // Также нужно расширить внутренее сечение парента (например гофра в трубке) if AInterf.ComponentOwner.FParent <> nil then if AInterf.ComponentOwner.FParent is TSCSComponent then begin ParentCompon := TSCSComponent(AInterf.ComponentOwner.FParent); InterfInSection := GetComponInterfBySprGUID(ParentCompon, guidUniversalInConstr); if InterfInSection <> nil then ExtendTemplateInterface(InterfInSection, 0, ANewValue); end; end; Result := true; end; except on E: Exception do AddExceptionToLogEx('ExtendTemplateInterface', E.Message); end; end; function HaveComponentSameInterfaces(ACheckingComponent, AComponentWithInterfaces: TSCSComponent; AInterfType: Integer): Boolean; var Interf1, Interf2: TSCSInterface; i, j: Integer; FindedSame: Boolean; Lookedinterfaces: TSCSInterfaces; begin Result := true; Lookedinterfaces := TSCSInterfaces.Create(false); for i := 0 to ACheckingComponent.FInterfaces.Count - 1 do begin Interf1 := ACheckingComponent.FInterfaces[i]; if Interf1.TypeI <> AInterfType then Continue; ///// CONTINUE ///// FindedSame := false; for j := 0 to AComponentWithInterfaces.FInterfaces.Count - 1 do begin Interf2 := AComponentWithInterfaces.FInterfaces[j]; if Interf2.TypeI <> AInterfType then Continue; ///// CONTINUE ///// if LookedInterfaces.IndexOf(Interf2) = -1 then if Interf1.ID_Interface = Interf2.ID_Interface then begin FindedSame := true; LookedInterfaces.Add(Interf2); Break; ///// BREAK ///// end; end; if Not FindedSame then begin Result := false; Break; ///// BREAK ///// end; end; Lookedinterfaces.Free; end; function GenComponMarkIDByAreaObject(AComponent: TSCSComponent; AAreaObject: TSCSCatalog; AChildReferencesInArea: Boolean; APointComplIndexingMode: TPointComplIndexingMode): Integer; procedure LookMarkIDs(ACatalog: TSCSCatalog); var i, j: integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; ComponList: TSCSComponents; begin for i := 0 to ACatalog.FChildCatalogs.Count - 1 do begin SCSCatalog := ACatalog.FChildCatalogs[i]; if (SCSCatalog.ItemType = itSCSConnector) or (SCSCatalog.ItemType = itArhContainer) then begin ComponList := nil; if APointComplIndexingMode = pcimInProject then ComponList := SCSCatalog.FComponentReferences else if (APointComplIndexingMode = pcimInCompon) or (APointComplIndexingMode = pcimInTopCompon) then ComponList := SCSCatalog.FSCSComponents; if ComponList <> nil then for j := 0 to ComponList.Count - 1 do begin SCSComponent := ComponList[j]; if SCSComponent.MarkID > Result then if SCSComponent.GUIDComponentType = AComponent.GUIDComponentType then Result := SCSComponent.MarkID; end; end; if AChildReferencesInArea then LookMarkIDs(SCSCatalog); end; end; var ii: integer; begin Result := 0; LookMarkIDs(AAreaObject); // продолжить индексы компонент {$if Not Defined(ES_GRAPH_SC)} if (Result = 0) and (F_ProjMan.GSCSBase.CurrProject.Setting.PointComonIndexingMode = cimInList) and (APointComplIndexingMode = pcimInProject) then begin if AAreaObject is TSCSList then begin for ii := 0 to TSCSList(AAreaObject).FSpravochnik.FNBComponentTypes.Count - 1 do begin if AComponent.GUIDComponentType = TNBComponentType(TSCSList(AAreaObject).FSpravochnik.FNBComponentTypes[ii]).ComponentType.GUID then begin Result := TNBComponentType(TSCSList(AAreaObject).FSpravochnik.FNBComponentTypes[ii]).ComponentType.ComponentIndex; break; end; end; end; end; {$IFEND} Result := Result + 1; end; function GetCableCanalFullnessKoef(ACableChannel: TSCSComponent; ACable: TSCSComponent = nil): Double; var ListOwner: TSCSList; //ObjectOwner: TSCSCatalog; FullnessKoef: Double; strFullnessKoef: string; begin Result := 0; try FullnessKoef := 0; strFullnessKoef := ACableChannel.GetPropertyValueBySysName(pnCableChannelFullnessKoef); // Не найдено свойство if strFullnessKoef = '' then FullnessKoef := -1 else FullnessKoef := StrToFloatU(CorrectStrToFloat(strFullnessKoef)); if FullnessKoef = -1 then begin ListOwner := nil; ListOwner := ACableChannel.GetListOwner; if ListOwner = nil then ListOwner := ACable.GetListOwner; if ListOwner <> nil then FullnessKoef := ListOwner.Setting.CableCanalFullnessKoef; end; Result := FullnessKoef; { ObjectOwner := ACableChannel.GetFirstParentCatalog; if ObjectOwner = nil then if ACable <> nil then ObjectOwner := ACable.GetFirstParentCatalog; if ObjectOwner <> nil then begin strFullnessKoef := ObjectOwner.GetPropertyValueBySysName(pnCableChannelFullnessKoef); // Не найдено свойство if strFullnessKoef = '' then FullnessKoef := -1 else FullnessKoef := StrToFloat_My(strFullnessKoef); if FullnessKoef = -1 then begin ListOwner := ObjectOwner.GetListOwner; if ListOwner <> nil then FullnessKoef := ListOwner.Setting.CableCanalFullnessKoef; end; end; Result := FullnessKoef;} except on E: Exception do AddExceptionToLogEx('GetCableCanalFullnessKoef', E.Message); end; end; function GetCatalogAreaObject(ACatalog: TSCSCatalog): TSCSCatalog; var CurrObject: TSCSCatalog; begin Result := nil; CurrObject := ACatalog; while CurrObject <> nil do begin if (CurrObject.ItemType = itRoom) or (CurrObject.ItemType = itList) then begin Result := CurrObject; Break; //// BREAK //// end; if CurrObject.FParent is TSCSCatalog then CurrObject := TSCSCatalog(CurrObject.FParent) else CurrObject := nil; end; end; function GetCatalogItemsNames(ACatalog: TSCSCatalog; AItemTypes: TintSet): String; procedure StepChildItems(AParent: TSCSCatalog); var i: Integer; ChildCatalog: TSCSCatalog; begin for i := 0 to AParent.ChildCatalogs.Count - 1 do begin ChildCatalog := AParent.ChildCatalogs[i]; if (AItemTypes = []) or (ChildCatalog.ItemType in AItemTypes) then begin if Result <> '' then Result := Result + ', '; Result := Result + ChildCatalog.GetNameForVisible; end; StepChildItems(ChildCatalog); end; end; begin Result := ''; StepChildItems(ACatalog); end; function GetCatalogTopComponCountByWithoutType(ACatalog: TSCSCatalog; ACompTypeSysName: String): Integer; var i: Integer; SCSComponent: TSCSComponent; begin Result := 0; for i := 0 to ACatalog.FSCSComponents.Count - 1 do begin SCSComponent := ACatalog.FSCSComponents[i]; if SCSComponent.ComponentType.SysName <> ACompTypeSysName then Inc(Result); end; end; function GetCatalogComponCountWithoutDisabledTypes(ACatalog: TSCSCatalog; ADisabledTypes: TStringList; AEnoughOne: Boolean): Integer; var i: Integer; SCSComponent: TSCSComponent; begin Result := 0; for i := 0 to ACatalog.FComponentReferences.Count - 1 do if ADisabledTypes.IndexOf(ACatalog.FComponentReferences[i].ComponentType.SysName) = -1 then begin Inc(Result); if AEnoughOne then Break; //// BREAK //// end; end; function GetCatalogComponentsJoinedToNoPoint(ACatalog: TSCSCatalog): TSCSComponents; var i: Integer; SCSComponent: TSCSComponent; begin Result := TSCSComponents.Create(false); for i := 0 to ACatalog.FComponentReferences.Count - 1 do begin SCSComponent := ACatalog.FComponentReferences[i]; if CheckJoinedComponToIsLine(SCSComponent, biTrue, false) then Result.Add(SCSComponent); end; end; function GetCatalogPortByAnalogInterfaces(ACatalog: TSCSCatalog; AAnalogPort: TSCSInterface; AAnalogInterfaces: TSCSInterfaces; AConnectOrder: TAutoTraceConnectOrderType; AWithEmptyInterfaces: Boolean): TSCSInterface; var ObjectComponents, ProperMultiPorts: TSCSComponents; //*** Мультипорты для подкл. - в начале на добитые. в конце девственые ComponList: TSCSComponents; MultiportPorts: TSCSInterfaces; ConnectedPort: TSCSInterface; CreatedObjectComponents, FindedMultiportConnectedToSameNumberPort, FindedEmptyMultiPort: Boolean; PortsConnectedToOtherNumCount: Integer; // Количество подкл-й портов интерфейсами к портам с другим номером PortsConnectedToSameNumCount: Integer; // Количество подкл-й портов интерфейсами к портам с таким же номером EmptyPortsPotentialToConnect: Integer; // Количество потенциальных портов для подк-я TopObjectComponent, PortMultiPortCompon, SCSComponent: TSCSComponent; ComponPort: TSCSInterface; ComponInterf, AnalogInterf: TSCSinterfaces; IsAnalogInterfaces: Boolean; i, j, k: Integer; begin Result := nil; ObjectComponents := nil; ProperMultiPorts := nil; ComponList := nil; MultiportPorts := nil; CreatedObjectComponents := false; //*** Определить порядок подк-х компонент // Если AAnalogPort = nil (или порядок в обычном режиме), то объект не конечный, и берем с него в обычном порядке // Иначе если объект конечный. // Тут нужно искать патч-панель к портам которй подкл-ны порты только с таким же номером, как и AAnalogPort // нужные панели поставим в начало списка компонент объекта if (AAnalogPort = nil) or (AConnectOrder = ctPMOrder) then begin ObjectComponents := ACatalog.FComponentReferences; end else begin ObjectComponents := TSCSComponents.Create(false); ProperMultiPorts := TSCSComponents.Create(false); ComponList := TSCSComponents.Create(false); MultiportPorts := TSCSInterfaces.Create(false); CreatedObjectComponents := true; //*** Перебераем мультипорты FindedMultiportConnectedToSameNumberPort := false; FindedEmptyMultiPort := false; for i := 0 to ACatalog.FComponentReferences.Count - 1 do begin SCSComponent := ACatalog.FComponentReferences[i]; if SCSComponent.ComponentType.PortKind = pkMultiPort then begin PortsConnectedToOtherNumCount := 0; PortsConnectedToSameNumCount := 0; EmptyPortsPotentialToConnect := 0; ComponList.Clear; ComponList.Assign(SCSComponent.FChildReferences); ComponList.Insert(0, SCSComponent); //*** Проанализировать все порты мультипорта, // на номер порта и возможность покл-интерфейсы к интерфейсам порта AAnalogPort for j := 0 to ComponList.Count - 1 do begin PortMultiPortCompon := ComponList[j]; for k := 0 to PortMultiPortCompon.FInterfaces.Count - 1 do begin ComponPort := PortMultiPortCompon.FInterfaces[k]; if (ComponPort.IsPort = biTrue) and (ComponPort.GUIDInterface = AAnalogPort.GUIDInterface) then begin //*** Если порт подк-н к другому порту if ComponPort.IDConnected <> 0 then begin ConnectedPort := SCSComponent.FProjectOwner.GetInterfaceByID(ComponPort.IDConnected); if (ConnectedPort = nil) or (ConnectedPort.NppPort <> AAnalogPort.NppPort) then begin inc(PortsConnectedToOtherNumCount); Break //// BREAK //// end else if (ConnectedPort <> nil) and (ConnectedPort.NppPort = AAnalogPort.NppPort) then Inc(PortsConnectedToSameNumCount); end else //*** Если интерфйсы портов одинаковы if CheckEqualInterfaces(ComponPort.FPortInterfaces, AAnalogInterfaces, ComponPort, nil, true, true) then begin Inc(EmptyPortsPotentialToConnect); //Break; //// BREAK //// end; end; end; if PortsConnectedToOtherNumCount > 0 then Break; //// BREAK //// if EmptyPortsPotentialToConnect > 0 then Break; //// BREAK //// end; //*** Нет подк-й к другим номерам if PortsConnectedToOtherNumCount = 0 then begin //*** Есть подкл-я к таким же номерам и есть куда подключать if (PortsConnectedToSameNumCount > 0) and (EmptyPortsPotentialToConnect > 0) then ProperMultiPorts.Insert(0, SCSComponent) else //*** Нет подкл-я к таким же номерам и есть куда подключать if (PortsConnectedToSameNumCount = 0) and (EmptyPortsPotentialToConnect > 0) then ProperMultiPorts.Add(SCSComponent); end; end; end; //*** Закинуть нужные мультипорты в начало списка for i := 0 to ProperMultiPorts.Count - 1 do begin ObjectComponents.Add(ProperMultiPorts[i]); for j := 0 to ProperMultiPorts[i].FChildReferences.Count - 1 do ObjectComponents.Add(ProperMultiPorts[i].FChildReferences[j]); //ObjectComponents.Assign(ProperMultiPorts[i].FChildReferences, laOr); end; //*** Вкинуть все остальные непопавшие в этот список компоненты //ObjectComponents.Assign(ACatalog.FComponentReferences, laOr); for i := 0 to ACatalog.FComponentReferences.Count - 1 do if ObjectComponents.IndexOf(ACatalog.FComponentReferences[i]) = -1 then ObjectComponents.Add(ACatalog.FComponentReferences[i]); end; for i := 0 to ObjectComponents.Count - 1 do begin SCSComponent := ObjectComponents[i]; for j := 0 to SCSComponent.FInterfaces.Count - 1 do begin ComponPort := SCSComponent.FInterfaces[j]; if ComponPort.IsPort = biTrue then if ((AAnalogPort = nil) or (ComponPort.GUIDInterface = AAnalogPort.GUIDInterface)) and CheckEqualInterfaces(ComponPort.FPortInterfaces, AAnalogInterfaces, ComponPort, nil, true, true) then begin //*** Если не имеет знач-е, есть ли в порту только свободные интерфейсы, // или если таковы имеются if Not AWithEmptyInterfaces or CheckPortNoHaveBusyInterfaces(ComponPort) then begin Result := ComponPort; Break; //// BREAK //// end; end; end; if Result <> nil then Break; //// BREAK //// end; if CreatedObjectComponents then begin FreeAndNil(ProperMultiPorts); FreeAndNil(MultiportPorts); FreeAndNil(ComponList); FreeAndNil(ObjectComponents); end; end; function GetCatalogListBySCSIDList(ACatalog: TSCSCatalog; ASCSIDList: TIntList): TSCSCatalogs; var i: Integer; SCSCatalog: TSCSCatalog; begin Result := TSCSCatalogs.Create(false); for i := 0 to ACatalog.FChildCatalogReferences.Count - 1 do begin SCSCatalog := ACatalog.FChildCatalogReferences[i]; if ASCSIDList.IndexOf(SCSCatalog.SCSID) <> -1 then Result.Add(SCSCatalog); end; end; function GetCatalogsEqualPortsByAnalogInterfaces(ACatalog1, ACatalog2: TSCSCatalog; AAnalogInterfaces: TSCSInterfaces; var APort1, APort2: TSCSInterface): Boolean; var AnalogInterfKolvo, InterfCnt1, InterfCnt2, PrevInterfCnt, i, j, k, l, DeltaInterfCount: Integer; SCSCompon1, SCSCompon2: TSCSComponent; Port1, Port2: TSCSInterface; Port1HaveNoBusyInterfaces, Port2HaveNoBusyInterfaces, ResPort1HaveNoBusyInterfaces, ResPort2HaveNoBusyInterfaces: Boolean; IsSameGUIDInPrevPorts, IsSameGUIDInPorts, CanVariousPorts, CanThisPorts: Boolean; begin Result := false; APort1 := nil; APort2 := nil; DeltaInterfCount := -1; PrevInterfCnt := 0; ResPort1HaveNoBusyInterfaces := false; ResPort2HaveNoBusyInterfaces := false; IsSameGUIDInPrevPorts := false; CanVariousPorts := true; AnalogInterfKolvo := GetInterfKolvoFromList(AAnalogInterfaces, nil, nil); for i := 0 to ACatalog1.FComponentReferences.Count - 1 do //for i := ACatalog1.FComponentReferences.Count - 1 downto 0 do begin SCSCompon1 := ACatalog1.FComponentReferences[i]; for j := 0 to SCSCompon1.FInterfaces.Count - 1 do begin Port1 := SCSCompon1.FInterfaces[j]; if (Port1.IsPort = biTrue) and CheckEqualInterfaces(Port1.FPortInterfaces, AAnalogInterfaces, Port1, nil, false, true, @InterfCnt1) then if (DeltaInterfCount = -1) or ((InterfCnt1 <> AnalogInterfKolvo) and (Abs(InterfCnt1 - AnalogInterfKolvo) < DeltaInterfCount)) then begin for k := 0 to ACatalog2.FComponentReferences.Count - 1 do //for k := ACatalog2.FComponentReferences.Count - 1 downto 0 do begin SCSCompon2 := ACatalog2.FComponentReferences[k]; for l := 0 to SCSCompon2.FInterfaces.Count - 1 do begin Port2 := SCSCompon2.FInterfaces[l]; if Port2.IsPort = biTrue then if ((Port1.GUIDInterface = Port2.GUIDInterface) or CanVariousPorts) and CheckEqualInterfaces(Port1.FPortInterfaces, Port2.FPortInterfaces, Port1, Port2, false, true) and CheckEqualInterfaces(Port2.FPortInterfaces, AAnalogInterfaces, Port2, nil, false, true, @InterfCnt2) then begin //*** Если количества не совпадают, определить минимальное if InterfCnt1 > InterfCnt2 then InterfCnt1 := InterfCnt2 else if InterfCnt2 > InterfCnt1 then InterfCnt2 := InterfCnt1; if (InterfCnt1 = InterfCnt2) then begin Port1HaveNoBusyInterfaces := CheckPortNoHaveBusyInterfaces(Port1); Port2HaveNoBusyInterfaces := CheckPortNoHaveBusyInterfaces(Port2); IsSameGUIDInPorts := (Port1.GUIDInterface = Port2.GUIDInterface); //*** Если Количество интерфейсов в портах больше предыдущего // или на пред порту были заняты интерфейсы(или не определено что занятые), а в текущих свободные {if (InterfCnt1 > PrevInterfCnt) or (Not ResPort1HaveNoBusyInterfaces and Port1HaveNoBusyInterfaces) or (Not ResPort2HaveNoBusyInterfaces and Port2HaveNoBusyInterfaces) then begin DeltaInterfCount := Abs(InterfCnt2 - AAnalogInterfaces.Count); APort1 := Port1; APort2 := Port2; PrevInterfCnt := InterfCnt1; ResPort1HaveNoBusyInterfaces := Port1HaveNoBusyInterfaces; ResPort2HaveNoBusyInterfaces := Port2HaveNoBusyInterfaces; Result := true; end; } CanThisPorts := false; if ((InterfCnt1 > PrevInterfCnt) or (Not ResPort1HaveNoBusyInterfaces and Port1HaveNoBusyInterfaces) or (Not ResPort2HaveNoBusyInterfaces and Port2HaveNoBusyInterfaces)) then CanThisPorts := true; // или если до этого порты бвли не одинаковы, а новые одинаковые if ((IsSameGUIDInPorts and Not IsSameGUIDInPrevPorts) and (InterfCnt1 > 0) and (InterfCnt2 > 0) and Port1HaveNoBusyInterfaces and Port2HaveNoBusyInterfaces) then begin CanThisPorts := true; CanVariousPorts := false; end; if CanThisPorts then begin DeltaInterfCount := Abs(InterfCnt2 - AnalogInterfKolvo); APort1 := Port1; APort2 := Port2; PrevInterfCnt := InterfCnt1; ResPort1HaveNoBusyInterfaces := Port1HaveNoBusyInterfaces; ResPort2HaveNoBusyInterfaces := Port2HaveNoBusyInterfaces; IsSameGUIDInPrevPorts := IsSameGUIDInPorts; Result := true; end; end; end; end; end; end; end; end; end; function GetCatalogsInOrderFromParent(AParentCatalog: TSCSCatalog; AItemType: Integer): TSCSCatalogs; procedure LoadStep(ACatalog: TSCSCatalog); var i: Integer; begin if ACatalog.ItemType = AItemType then Result.Add(ACatalog); for i := 0 to ACatalog.FChildCatalogs.Count - 1 do LoadStep(ACatalog.FChildCatalogs[i]); end; begin Result := TSCSCatalogs.Create(false); LoadStep(AParentCatalog); end; function GetCCESideCount(ACCE: TSCSComponent): Integer; var ConnectorType: Integer; begin Result := 0; ConnectorType := ACCE.GetPropertyValueAsInteger(pnCableCanalElemetType); case ConnectorType of contCork: // заглушка Result := 1; contAnglePlane: // Уголок Плоский Result := 2; contTjoin: // Тройник Result := 3; contAngleIn: // Уголок Внутренний Result := 2; contAngleOut: // Уголок Внешний Result := 2; contAdapter: // Адаптер Result := 2; contConnector: // Соединитель Result := 2; contWallCork: // Ввод в стену Result := 2; contCross: // Крестообразный соединитель Result := 4; end; end; function GetChildCatalogByName(ACatalog: TSCSCatalog; const AName: String; ACaseSensitive: Boolean): TSCScatalog; var Child: TSCSCatalog; i: Integer; NameUpper: String; begin Result := nil; NameUpper := AnsiUpperCase(AName); for i := 0 to ACatalog.FChildCatalogs.Count - 1 do begin Child := ACatalog.FChildCatalogs[i]; if (Child.Name = AName) or (Not ACaseSensitive and (AnsiUpperCase(Child.Name) = NameUpper)) then begin Result := Child; Break; //// BREAK //// end; end; end; function GetChildCatalogsInPlacingOrder(AParentCatalog: TSCSCatalog; AItemTypeFilter: TIntSet): TSCSCatalogs; procedure FindStep(ACurrParent: TSCSCatalog); var i: Integer; ChildCatalog: TSCSCatalog; begin for i := 0 to ACurrParent.FChildCatalogs.Count - 1 do begin ChildCatalog := TSCSCatalog(ACurrParent.FChildCatalogs.FItems.List^[i]); if (AItemTypeFilter = []) or (ChildCatalog.ItemType in AItemTypeFilter) then Result.Add(ChildCatalog); FindStep(ChildCatalog); end; end; begin Result := TSCSCatalogs.Create(false); FindStep(AParentCatalog); end; function GetChildComponByIsLine(ACompon: TSCSComponent; AIsLine: Integer): TSCSComponent; var i: Integer; Child: TSCSComponent; begin Result := nil; for i := 0 to ACompon.ChildComplects.Count - 1 do begin Child := ACompon.ChildComplects[i]; if Child.IsLine = AIsLine then begin Result := Child; Break; //// BREAK //// end; end; end; function GetComplexIdentificatorByConnectedTrace(AComplexCompon: TSCSComponent; AComplexComponObject, ATraceObject: TSCSCatalog): Integer; begin Result := -1; if IsTrunkComponent(AComplexCompon) then Result := GetPosOfConnectingTrace(ATraceObject.ListID, ATraceObject.SCSID) else if GetParentComponByCompTypeSysName(AComplexCompon, ctsnHouse) <> nil then begin Result := GetIDElementFromComplexObjByTrace(AComplexComponObject.ListID, AComplexComponObject.SCSID, ATraceObject.SCSID); end; end; function GetComponChildByIDCompRel(AComponent: TSCSComponent; AIDCompRel: Integer): TSCSComponent; var i: Integer; ChildComponent: TSCSComponent; begin Result := nil; for i := 0 to AComponent.FChildReferences.Count - 1 do begin ChildComponent := AComponent.FChildReferences[i]; if ChildComponent.IDCompRel = AIDCompRel then begin Result := ChildComponent; Break; //// BREAK //// end; end; end; function GetComponChildsTotalHeihhtU(AComponent: TSCSComponent; AIDCompRelToSkip: Integer): Integer; var i: Integer; ChildComplect: TSCSComponent; ChildHeightU: Integer; begin Result := 0; try //*** Подгрузить комплектуюшие если их нет if (AComponent.ChildComplects.Count = 0) and (TF_Main(AComponent.ActiveForm).GDBMode = bkNormBase) then begin AComponent.LoadChildComplectsQuick(false, false, false, AComponent.IDTopComponent, AComponent.IDCompRel); //*** Загрузить свойства этих комплектующих for i := 0 to AComponent.FChildComplects.Count - 1 do begin ChildComplect := AComponent.FChildComplects[i]; ChildComplect.LoadProperties; end; end; //*** Найти общую высоту в юнитах for i := 0 to AComponent.FChildComplects.Count - 1 do begin ChildComplect := AComponent.FChildComplects[i]; if AComponent.GetComplectByIDChild(ChildComplect.ID) <> nil then if ChildComplect.IDCompRel <> AIDCompRelToSkip then begin ChildHeightU := ChildComplect.GetPropertyValueAsInteger(pnHeightInUnits); if ChildComplect.Count > 0 then ChildHeightU := ChildHeightU * ChildComplect.Count; Result := Result + ChildHeightU; end; end; except on E: Exception do AddExceptionToLogEx('GetComponChildsTotalHeihhtU', E.Message); end; end; function GetComponConnectionByID(AComponent: TSCSComponent; AID: Integer): PComplect; var i: Integer; ptrConnection: PComplect; begin Result := nil; for i := 0 to AComponent.FConnections.Count - 1 do begin ptrConnection := AComponent.FConnections[i]; if ptrConnection.ID = AID then begin Result := ptrConnection; Break; //// BREAK //// end; end; end; function GetComponCountFromInterfList(AInterfList: TSCSInterfaces): Integer; var Interf: TSCSInterface; LookedCompons: TRapList; i: Integer; begin Result := 0; LookedCompons := TRapList.Create; for i := 0 to AInterfList.Count - 1 do begin Interf := TSCSInterface(AInterfList.List.List^[i]); if LookedCompons.IndexOf(Interf.ComponentOwner) = -1 then LookedCompons.Add(Interf.ComponentOwner); end; Result := LookedCompons.Count; FreeAndNil(LookedCompons); end; function GetComponByGUIDFromList(AGUID: String; AList: TSCSComponents): TSCSComponent; var i: Integer; Compon: TSCSComponent; begin Result := nil; for i := 0 to AList.Count - 1 do begin Compon := AList[i]; if Compon.GUIDNB = AGUID then begin Result := Compon; Break; //// BREAK //// end; end; end; function GetComponentByOldIDFromCompon(ASCSCompon: TSCSComponent; AOldID: Integer): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; for i := 0 to ASCSCompon.FChildReferences.Count - 1 do begin SCSComponent := ASCSCompon.FChildReferences[i]; if SCSComponent.OldID = AOldID then begin Result := SCSComponent; Break; //// BREAK //// end; end; end; function GetComponentByOldIDFromObject(ASCSObject: TSCSCatalog; AOldID: Integer): TSCSComponent; var i: Integer; SCSComponent: TSCSComponent; begin Result := nil; for i := 0 to ASCSObject.FComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.FComponentReferences[i]; if SCSComponent.OldID = AOldID then begin Result := SCSComponent; Break; //// BREAK //// end; end; end; function GetComponFromComplexObjByLine(AConnComponent, ALineComponent: TSCSComponent): TSCSComponent; var //LineComponentSide: Integer; //ConnComponentSide: Integer; ConnComponentObjectOwner, LineComponentObjectOwner: TSCSCatalog; ConnComponentListOwner, LineComponentListOwner: TSCSList; //ReverseParams: Boolean; PosOfConnectingTrace, ComponIDFromCAD, IDComponByLine: Integer; CADCrossObject: TCADCrossObject; CurrComponFromPos: TSCSComponent; begin Result := nil; if (TF_Main(AConnComponent.FActiveForm).GDBMode = bkProjectManager) and (TF_Main(ALineComponent.FActiveForm).GDBMode = bkProjectManager) then begin if IsTrunkComponent(AConnComponent) then begin ConnComponentObjectOwner := AConnComponent.GetFirstParentCatalog; LineComponentObjectOwner := ALineComponent.GetFirstParentCatalog; if //Not(ConnComponent.Parent is TSCSComponent) and (ConnComponentObjectOwner <> nil) and (LineComponentObjectOwner <> nil) then begin ConnComponentListOwner := ConnComponentObjectOwner.GetListOwner; LineComponentListOwner := LineComponentObjectOwner.GetListOwner; if (ConnComponentListOwner <> nil) and (LineComponentListOwner <> nil) then begin PosOfConnectingTrace := GetPosOfConnectingTrace(LineComponentObjectOwner.ListID, LineComponentObjectOwner.SCSID); if PosOfConnectingTrace <> -1 then begin //*** Найти подходящий компонент в позиции CADCrossObject := ConnComponentListOwner.GetCADCrossObjectByObjectID(ConnComponentObjectOwner.ID); if CADCrossObject <> nil then begin if PosOfConnectingTrace <= CADCrossObject.Elements.Count - 1 then ComponIDFromCAD := TCADCrossObjectElement(CADCrossObject.Elements[PosOfConnectingTrace]).IDComponent; if ComponIDFromCAD <> -1 then CurrComponFromPos := ConnComponentObjectOwner.FComponentReferences.GetComponenByID(ComponIDFromCAD); if CurrComponFromPos <> nil then Result := CurrComponFromPos; end; end; end; end; end else // Если автотрассировка, то по трассе определяем какой именно подъезд(комплектующая) к ней подключена if GetParentComponByCompTypeSysName(AConnComponent, ctsnHouse) <> nil then begin ConnComponentObjectOwner := AConnComponent.GetFirstParentCatalog; LineComponentObjectOwner := ALineComponent.GetFirstParentCatalog; if (ConnComponentObjectOwner <> nil) and (LineComponentObjectOwner <> nil) then begin IDComponByLine := GetIDElementFromComplexObjByTrace(ConnComponentObjectOwner.ListID, ConnComponentObjectOwner.SCSID, LineComponentObjectOwner.SCSID); Result := ConnComponentObjectOwner.GetComponentFromReferences(IDComponByLine); //06.04.2012 - если if Result <> nil then if Result.ChildReferences.IndexOf(AConnComponent) <> -1 then Result := AConnComponent; end; end; end; end; function GetComponIdentificatorInComplex(AComponent: TSCSComponent): Integer; begin Result := -1; if IsTrunkComponent(AComponent) then Result := GetPosOfTopTrunkComplect(AComponent) else begin if AComponent.ComponentType.SysName = ctsnHouse then Result := 0 else if AComponent.ComponentType.SysName = ctsnApproach then begin Result := AComponent.ID; end; end; end; function GetComponIOfIRelsByIDCompRel(ASCSComponent: TSCSComponent; AIDCompRel: Integer): TList; var SCSComponent: TSCSComponent; SCSInterface: TSCSInterface; IofIRel: TSCSIOfIRel; i, j: Integer; begin Result := TList.Create; for i := 0 to ASCSComponent.Interfaces.Count - 1 do begin SCSInterface := ASCSComponent.Interfaces[i]; if Assigned(SCSInterface) then for j := 0 to SCSInterface.IOfIRelOut.Count - 1 do begin IofIRel := TSCSIOfIRel(SCSInterface.IOfIRelOut[j]); if IofIRel.IDCompRel = AIDCompRel then Result.Add(IofIRel); end; end; end; function GetComponInterfaceByTypeAndGender(ACompon: TSCSComponent; AType, AGender, AIsMultiple: Integer; AGUIDInterface: String): TSCSInterface; begin Result := ACompon.GetInterfaceByTypeAndGender([AType], [AGender], AIsMultiple, AGUIDInterface, false, false); end; function GetComponInterfacesByParams(AComponent: TSCSComponent; const AGUIDInterface: string; AIsPort: Integer=-1): TSCSInterface; var i: Integer; Interf: TSCSInterface; begin Result := nil; for i := 0 to AComponent.Finterfaces.Count - 1 do begin Interf := AComponent.Finterfaces[i]; if (AGUIDInterface = '') or (Interf.GUIDInterface = AGUIDInterface) then if (AIsPort = -1) or (Interf.IsPort = AIsPort) then begin Result := Interf; Break; //// BREAK //// end; end; end; function GetComponInterfacesBySide(AComponent: TSCSComponent; ASideNum, AIsBusy: Integer): TSCSInterfaces; var i: Integer; Interf: TSCSInterface; begin Result := TSCSInterfaces.Create(false); for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if (Interf.Side = ASideNum) and (Interf.IsBusy = AIsBusy) then Result.Add(Interf); end; end; function GetComponInterfacesThatPortNoHaveBusyInterfaces(AComponent: TSCSComponent): TSCSInterfaces; var i, j: Integer; Interf: TSCSInterface; NoHaveBusyInterfaces: Boolean; begin Result := TSCSInterfaces.Create(false); for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := TSCSInterface(AComponent.FInterfaces.FItems.List^[i]); //11.03.2009 AComponent.FInterfaces[i]; //*** Определить нет ли занятых интерфейсов на порту NoHaveBusyInterfaces := true; if Interf.FPortOwner <> nil then begin NoHaveBusyInterfaces := CheckPortNoHaveBusyInterfaces(Interf.FPortOwner); end; if NoHaveBusyInterfaces then Result.Add(Interf); end; end; function GetComponInterfaceCount(AComponent: TSCSComponent; AInterfTypes: TIntSet; AIsBusy: Integer = biNone): Integer; var i: Integer; Interf: TSCSInterface; begin Result := 0; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if (Interf.TypeI in AInterfTypes) and ((AIsBusy = biNone) or (Interf.IsBusy = AIsBusy)) then Result := Result + Interf.Kolvo; //Inc(Result); end; end; function GetComponInterfBySprGUID(ACompon: TSCSComponent; const ASprGUID: String): TSCSInterface; var i: Integer; Interf: TSCSInterface; begin Result := nil; for i := 0 to ACompon.FInterfaces.Count - 1 do begin Interf := TSCSInterface(ACompon.FInterfaces.List.List^[i]); if Interf.GUIDInterface = ASprGUID then begin Result := Interf; Break; //// BREAK //// end; end; end; function GetComponLastNumPair(AComponent: TSCSComponent): Integer; var i: Integer; Interf: TSCSInterface; begin Result := 0; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if Interf.NumPair > Result then Result := Interf.NumPair; end; end; function GetComponNormResourcesCountByCompPropRelID(ACompon: TSCSComponent; AIDCompPropRel: Integer): Integer; var SCSNorm: TSCSNorm; SCSResourceRel: TSCSResourceRel; i: Integer; begin Result := 0; if AIDCompPropRel <> 0 then begin for i := 0 to ACompon.FNormsResources.FNorms.Count - 1 do begin SCSNorm := ACompon.FNormsResources.FNorms[i]; if (SCSNorm.IDCompPropRel = AIDCompPropRel) then begin Result := Result + 1; end; end; // Удаляем ресурсы, пришедшие от свойств for i := 0 to ACompon.FNormsResources.FResources.Count - 1 do begin SCSResourceRel := ACompon.FNormsResources.FResources[i]; if (SCSResourceRel.IDCompPropRel = AIDCompPropRel) then begin Result := Result + 1; end; end; end; end; function GetComponMaxNumPair(AComponent: TSCSComponent): Integer; var i: Integer; Interf: TSCSInterface; MaxNumPair: Integer; begin Result := 0; MaxNumPair := 0; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if Interf.NumPair > MaxNumPair then MaxNumPair := Interf.NumPair; end; Result := MaxNumPair; end; function GetComponObjectOwnerByItemType(AComponent: TSCSComponent; AItemType: Integer): TSCSCatalog; var FirstObjectOwner: TSCSCatalog; begin Result := nil; if AComponent <> nil then begin FirstObjectOwner := AComponent.GetFirstParentCatalog; if FirstObjectOwner <> nil then Result := FirstObjectOwner.GetParentCatalogByItemType(AItemType); end; end; function GetComponOutDiametrInMetr(AComponent: TSCSComponent): Double; var StrOutDiametr: String; begin Result := 0; StrOutDiametr := AComponent.GetPropertyValueBySysName(pnOutDiametr); if StrOutDiametr <> '' then begin try Result := StrToFloat_My(StrOutDiametr); except Result := 0; end; if Result <> 0 then Result := FloatInUOM(Result, umMM, umM); end; if Result = 0 then begin // ищем внешнее сичение Result := AComponent.GetVolume(gtMale); // если ничего не найдено, то ищем внутреннее сечение if Result = 0 then Result := AComponent.GetVolume(gtFemale); // преобразуем сечение из площи круга в диаметр if Result <> 0 then begin // Радиус = sqrt(площадь / pi); Result := sqrt(Result / pi); //перегнать из см в м Result := FloatInUOM(Result, umSM, umM); end; end; end; function GetComponPairCount(ALineCompon: TSCSComponent): Integer; var SCSInterf: TSCSInterface; LookedNumPairs: TIntList; i: Integer; begin Result := 0; LookedNumPairs := TIntList.Create; for i := 0 to ALineCompon.Interfaces.Count - 1 do begin SCSInterf := ALineCompon.Interfaces[i]; if (SCSInterf.TypeI = itFunctional) and (LookedNumPairs.IndexOf(SCSInterf.NumPair) = -1) then begin //Inc(Result); Result := Result + SCSInterf.Kolvo; LookedNumPairs.Add(SCSInterf.NumPair); end; end; FreeAndNil(LookedNumPairs); end; function GetComponPartLengthWithReserv(AComponent: TSCSComponent; var AReserv: Double; ATakeIntoPortReserv, ATakeIntoThroghObjects: Boolean): Double; var ObjectOwner: TSCSCatalog; ListOwner: TSCSList; strLengthKoef: string; LengthKoef, TraceLength, CurrReserv, HeightThroughFloor, NormKoef: Double; FirstConnCompon, LastConnCompon: TSCSComponent; IDOtherFloorFigure, RaiseCount, i, j, NormNBGUIDIndex: Integer; ParentComponent: TSCSComponent; Interf: TSCSInterface; SprInterface: TNBInterface; SprInterfNorm: TNBInterfaceNorm; NormNBGUIDes, NormKoefs: TStringList; ComponNorm: TSCSNorm; begin Result := 0; TraceLength := 0; AReserv := 0; ObjectOwner := nil; ListOwner := nil; ObjectOwner := AComponent.GetFirstParentCatalog; if ObjectOwner <> nil then begin TraceLength := AComponent.UserLength; if (TraceLength = -1) or (TraceLength = 0) then TraceLength := ObjectOwner.GetPropertyValueAsFloat(pnLength); LengthKoef := 0; strLengthKoef := AComponent.GetPropertyValueBySysName(pnPercentCableLengthReserv); //ObjectOwner.GetPropertyValueBySysName(pnPercentCableLengthReserv); if strLengthKoef = '' then LengthKoef := -1 else LengthKoef := StrToFloatU(CorrectStrToFloat(strLengthKoef)); if LengthKoef < 0 then begin ListOwner := ObjectOwner.GetListOwner; if ListOwner <> nil then LengthKoef := ListOwner.Setting.LengthKoef; end; Result := TraceLength; if LengthKoef > 0 then Result := Round3(Result + TraceLength * LengthKoef/100); //*** Учет запаса на порту/мультипорту if ATakeIntoPortReserv then begin FirstConnCompon := GetJoinedMultiPortPortToComponentBySide(AComponent, 1); LastConnCompon := GetJoinedMultiPortPortToComponentBySide(AComponent, 2); AComponent.ApplyLengthData(Result, CurrReserv, FirstConnCompon, LastConnCompon); end; //*** Учет запаса кабеля сквозь точ-й компонент Result := Result + RoundCP(GetComponReservLengthFromThroughPointComponent(AComponent)); //*** Учет м-э перехода {if ATakeIntoThroghObjects then if IsBetweenFloorObject(ObjectOwner.ListID, ObjectOwner.SCSID, IDOtherFloorFigure) then begin if (AComponent.FProjectOwner.FIDsNearFloorFigures.IndexOf(ObjectOwner.SCSID) = -1) and (AComponent.FProjectOwner.FIDsNearFloorFigures.IndexOf(IDOtherFloorFigure) = -1) and (AComponent.FProjectOwner.FIDsOppositeNearFloorFigures.IndexOf(ObjectOwner.SCSID) = -1) and (AComponent.FProjectOwner.FIDsOppositeNearFloorFigures.IndexOf(IDOtherFloorFigure) = -1) then begin AComponent.FProjectOwner.FIDsNearFloorFigures.Add(ObjectOwner.SCSID); AComponent.FProjectOwner.FIDsOppositeNearFloorFigures.Add(IDOtherFloorFigure); end; HeightThroughFloor := AComponent.FProjectOwner.Setting.HeightThroughFloor; if HeightThroughFloor > 0 then begin //*** Для компоненты берем половину длины м-э перехода. Вторая половина пойдет компоненте на другом листе HeightThroughFloor := HeightThroughFloor / 2; //*** Процент запасса HeightThroughFloor := HeightThroughFloor + (HeightThroughFloor * LengthKoef/100); //if ListOwner = nil then // ListOwner := GetListOwner; //if ListOwner <> nil then // HeightThroughFloor := HeightThroughFloor + (HeightThroughFloor*ListOwner.Setting.LengthKoef/100); Result := Result + HeightThroughFloor; end; end; } //*** Учет м-э перехода if ATakeIntoThroghObjects then begin //*** Получить количество вершин, к которым подключена трасса RaiseCount := GetRaiseCountConnectedToFigure(ObjectOwner.ListID, ObjectOwner.SCSID); if RaiseCount > 0 then begin if AComponent.FProjectOwner.FIDsNearFloorFigures.IndexOf(ObjectOwner.SCSID) = -1 then AComponent.FProjectOwner.FIDsNearFloorFigures.Add(ObjectOwner.SCSID); HeightThroughFloor := AComponent.FProjectOwner.Setting.HeightThroughFloor; if HeightThroughFloor > 0 then begin //*** Для компоненты берем половину длины м-э перехода. Вторая половина пойдет компоненте на другом листе HeightThroughFloor := (HeightThroughFloor / 2) * RaiseCount; //*** Длину м-э прехода добавить к ждине трассы, так как TraceLength := TraceLength + HeightThroughFloor; //*** Процент запасса HeightThroughFloor := HeightThroughFloor + (HeightThroughFloor * LengthKoef/100); //if ListOwner = nil then // ListOwner := GetListOwner; //if ListOwner <> nil then // HeightThroughFloor := HeightThroughFloor + (HeightThroughFloor*ListOwner.Setting.LengthKoef/100); Result := Result + HeightThroughFloor; end; end; end; end; //*** Учет коэффициента из норм интерфейсов if (TraceLength > 0) and (AComponent.FProjectOwner <> nil) then begin ParentComponent := AComponent.GetParentComponent; if ParentComponent <> nil then begin NormNBGUIDes := nil; NormKoefs := nil; //*** Найти нормы с коэффициентом комплектующих больше нуля for i := 0 to ParentComponent.FInterfaces.Count - 1 do begin Interf := ParentComponent.FInterfaces[i]; if Interf.TypeI = itConstructive then begin SprInterface := AComponent.FProjectOwner.FSpravochnik.GetInterfaceByGUID(Interf.GUIDInterface); if SprInterface <> nil then for j := 0 to SprInterface.FInterfaceNorms.Count - 1 do begin SprInterfNorm := TNBInterfaceNorm(SprInterface.FInterfaceNorms[j]); if (SprInterfNorm.KoefLengthForCompl > 0) and (SprInterfNorm.GuidNBNorm <> '') then begin if NormNBGUIDes = nil then NormNBGUIDes := TStringList.Create; if NormKoefs = nil then NormKoefs := TStringList.Create; if NormNBGUIDes.IndexOf(SprInterfNorm.GuidNBNorm) = -1 then begin NormNBGUIDes.Add(SprInterfNorm.GuidNBNorm); NormKoefs.Add(FloatToStr(SprInterfNorm.KoefLengthForCompl)); end; end; end; end; end; if (NormNBGUIDes <> nil) and (NormNBGUIDes.Count > 0) then begin ParentComponent.DefineInterfaceNorms(false); ///*** Есть ли в компоненте такие нормыs for i:= 0 to ParentComponent.FNormsResources.FNorms.Count - 1 do begin ComponNorm := ParentComponent.FNormsResources.FNorms[i]; if ComponNorm.IsOn = biTrue then begin NormKoef := 0; NormNBGUIDIndex := NormNBGUIDes.IndexOf(ComponNorm.GuidNB); if NormNBGUIDIndex <> -1 then try NormKoef := RoundCP(StrToFloat_My(NormKoefs[NormNBGUIDIndex])); except end; if NormKoef > 0 then Result := Result + (TraceLength * NormKoef); end; end; end; if NormNBGUIDes <> nil then FreeAndNil(NormNBGUIDes); if NormKoefs <> nil then FreeAndNil(NormKoefs); end; end; //AReserv := AReserv + Result - TraceLength; AReserv := Abs(Result - TraceLength); end; function GetComponQuantityByParams(ACompon: TSCSComponent; AUseDismountAccount: Boolean): Double; var ExpenseForMetr, ReservLength: Double; begin Result := 0; case ACompon.IsLine of biFalse: begin Result := 1; if ((ACompon.ComponentType.SysName = ctsnCableChannelAccessory) or (ACompon.ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr := ACompon.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then begin ACompon.Length := GetComponPartLengthWithReserv(ACompon, ReservLength, true, true); Result := Round(ACompon.Length * ExpenseForMetr) end; end; end; biTrue: begin ACompon.Length := GetComponPartLengthWithReserv(ACompon, ReservLength, true, true); // Расход на ед.длины ExpenseForMetr := ACompon.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then Result := Round(ACompon.Length * ExpenseForMetr) else Result := RoundCP(ACompon.Length); end; end; //*** Если учитывать демонтаж, и компонент демонтирован, // то отнимать от общего количества, кол-во этой компоненты if AUseDismountAccount and (ACompon.IsDismount = biTrue) then if ACompon.IsUseDismounted = biTrue then Result := Result * -1 else Result := 0; end; procedure GetComponQtPriceInUOM(ACompon: TSCSComponent; AUOM: Integer; APrice, AQT: PDouble); begin if APrice <> nil then APrice^ := ACompon.Price; if AQT <> nil then AQT^ := ACompon.Length; // Цена компонента по СИ if CheckPriceTransformToUOMByCompType(@ACompon.ComponentType) then begin if AUOM <> umMetr then begin if APrice <> nil then APrice^ := FloatInUOM(ACompon.Price, AUOM, umMetr); if AQT <> nil then AQT^ := FloatInUOM(ACompon.Length, umMetr, AUOM); end; end; end; function GetComponReservLengthFromThroughPointComponent(ALineCompon: TSCSComponent): Double; var ListOwner: TSCSlist; LineComponOwner: TSCSCatalog; JoinedComponent: TSCSComponent; JoinedComponentOwner: TSCSCatalog; IDConnectorAtSide1, IDConnectorAtSide2: Integer; LinesSCSIDAtSide1, LinesSCSIDAtSide2: TIntList; ReservFromPointSide1, ReservFromPointSide2: Double; AcceptedReservFromPointSide1, AcceptedReservFromPointSide2: Boolean; i: integer; function GetReservThroughPointObject(AIDPointFigure: Integer): Double; var PointObject: TSCSCatalog; //*** промежуточный коннектор между кабелями PointObjectFirstComponent: TSCSComponent; begin Result := 0; if ListOwner <> nil then begin PointObject := ListOwner.GetCatalogFromReferencesBySCSID(AIDPointFigure); PointObjectFirstComponent := nil; if PointObject <> nil then PointObjectFirstComponent := PointObject.GetFirstComponent; if PointObjectFirstComponent <> nil then Result := PointObjectFirstComponent.GetPropertyValueAsFloat(pnReservThroughPointCompon); end; end; begin Result := 0; if ALineCompon.IsLine = biTrue then begin ListOwner := nil; IDConnectorAtSide1 := 0; IDConnectorAtSide2 := 0; LinesSCSIDAtSide1 := nil; LinesSCSIDAtSide2 := nil; ReservFromPointSide1 := 0; ReservFromPointSide2 := 0; AcceptedReservFromPointSide1 := false; AcceptedReservFromPointSide2 := false; for i := 0 to ALineCompon.FJoinedComponents.Count - 1 do begin JoinedComponent := ALineCompon.FJoinedComponents[i]; if JoinedComponent.IsLine = biTrue then begin if (LinesSCSIDAtSide1 = nil) and (LinesSCSIDAtSide2 = nil) then begin LineComponOwner := ALineCompon.GetFirstParentCatalog; if LineComponOwner <> nil then begin ListOwner := LineComponOwner.GetListOwner; LinesSCSIDAtSide1 := GetObjectsListForCork(LineComponOwner.ListID, LineComponOwner.SCSID, 1, IDConnectorAtSide1); LinesSCSIDAtSide2 := GetObjectsListForCork(LineComponOwner.ListID, LineComponOwner.SCSID, 2, IDConnectorAtSide2); ReservFromPointSide1 := GetReservThroughPointObject(IDConnectorAtSide1); ReservFromPointSide2 := GetReservThroughPointObject(IDConnectorAtSide2); //*** Если резервы не определены, то выход if (ReservFromPointSide1 <= 0) and (ReservFromPointSide2 <= 0) then Break; //// BREAK //// if ReservFromPointSide1 <= 0 then AcceptedReservFromPointSide1 := true; if ReservFromPointSide2 <= 0 then AcceptedReservFromPointSide2 := true; end; end; JoinedComponentOwner := JoinedComponent.GetFirstParentCatalog; //*** Смотрим через какую точку подключен JoinedComponent, соот-вно накидываем резерв if Not AcceptedReservFromPointSide1 and (LinesSCSIDAtSide1.IndexOf(JoinedComponentOwner.SCSID) <> -1) then begin Result := Result + ReservFromPointSide1 / 2; AcceptedReservFromPointSide1 := true; end; if Not AcceptedReservFromPointSide2 and (LinesSCSIDAtSide2.IndexOf(JoinedComponentOwner.SCSID) <> -1) then begin Result := Result + ReservFromPointSide2 / 2; AcceptedReservFromPointSide2 := true; end; if AcceptedReservFromPointSide1 and AcceptedReservFromPointSide2 then Break; //// BREAK //// end; end; if LinesSCSIDAtSide1 <> nil then FreeAndNil(LinesSCSIDAtSide1); if LinesSCSIDAtSide2 <> nil then FreeAndNil(LinesSCSIDAtSide2); end; end; function GetComponSideJoinedToCompon(AComponent, AJoinedComponent: TSCScomponent): Integer; var ComponObjOwner: TSCSCatalog; JoinedComponObjOwner: TSCSCatalog; ComponSide: Integer; JoinedComponSide: Integer; begin Result := -1; ComponObjOwner := AComponent.GetFirstParentCatalog; JoinedComponObjOwner := AJoinedComponent.GetFirstParentCatalog; if (ComponObjOwner <> nil) and (JoinedComponObjOwner <> nil) then begin GetSidesByConnectedFigures(ComponObjOwner.ListID, JoinedComponObjOwner.ListID, ComponObjOwner.SCSID, JoinedComponObjOwner.SCSID, ComponSide, JoinedComponSide); Result := ComponSide; end; end; function GetComponSideJoinedToComponByInterf(AComponent, AJoinedComponent: TSCScomponent): Integer; var i, j: Integer; Interf: TSCSInterface; begin Result := 0; for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; if Interf.ConnectedInterfaces.Count > 0 then begin for j := 0 to Interf.ConnectedInterfaces.Count - 1 do begin if Interf.ConnectedInterfaces[j].ComponentOwner = AJoinedComponent then begin Result := Interf.Side; Break; //// BREAK //// end; end; if Result <> 0 then Break; //// BREAK //// end; end; end; function GetComponStructuredChilds(AComponent: TSCSComponent; AIncludingTop: Boolean): TSCSComponents; procedure LoadComponent(ACompon: TSCSComponent; AStepIndex: Integer); var i: Integer; begin if AIncludingTop or (AStepIndex > 0) then Result.Add(ACompon); for i := 0 to ACompon.FChildComplects.Count - 1 do LoadComponent(ACompon.FChildComplects[i], AStepIndex + 1); end; begin Result := TSCSComponents.Create(false); LoadComponent(AComponent, 0); end; function GetComponTopByCTSysNames(AComponent: TSCSComponent; ACTSysNames: TStringList; ACanRetParamCompon: Boolean): TSCSComponent; var CurrTopCompon: TSCSComponent; begin Result := nil; if ACanRetParamCompon then Result := AComponent; if (AComponent <> nil) and (ACTSysNames <> nil) then if ACTSysNames.Count > 0 then begin CurrTopCompon := AComponent; while CurrTopCompon <> nil do begin if ACTSysNames.IndexOf(CurrTopCompon.ComponentType.SysName) <> -1 then Result := CurrTopCompon; CurrTopCompon := CurrTopCompon.GetParentComponent; end; end; end; procedure GetComponObjectsMark(AComponent: TSCSComponent; var ARoom, AList: TSCSCatalog; var ARoomMark, AListMark: String; ARoomNameShortSrcType: TRoomNameShortSrcType; ARoomNameShortDefault, ARoomNameShortIfNoRoom: string); var SCSCatalog: TSCSCatalog; begin ARoom := nil; AList := nil; ARoomMark := ''; AListMark := ''; // Получаем Объект SCSCatalog := AComponent.GetFirstParentCatalog; if SCSCatalog <> nil then begin // Получаем кабинет ARoom := SCSCatalog.GetParentCatalogByItemType(itRoom); ARoomMark := GetRoomNameShort(ARoom, ARoomNameShortSrcType, ARoomNameShortDefault, ARoomNameShortIfNoRoom); AList := SCSCatalog.GetListOwner; if AList <> nil then AListMark := IntToStr(AList.MarkID); end; end; function GetComponentTrunk(ASCSComponent: TSCSComponent): TCadCrossObject; var ComponentList: TSCSComponents; SCSComponent, ChildComponent, JoinedToChildComponent: TSCSComponent; ObjectOwner: TSCSCatalog; ListOwner: TSCSList; ProjectOwner: TSCSProject; NBComponentType: TNBComponentType; ComponMarkTemplate: String; i, j, k: Integer; Interf, JoinedInterface: TSCSinterface; CADCrossObjectElement, OldCADCrossObjectElement: TCADCrossObjectElement; OldCadCrossObject: TCadCrossObject; begin Result := nil; OldCadCrossObject := nil; if ASCSComponent.IsLine = biFalse then begin ProjectOwner := ASCSComponent.FProjectOwner; ListOwner := ASCSComponent.GetListOwner; ObjectOwner := ASCSComponent.GetFirstParentCatalog; if (ListOwner <> nil) and (ObjectOwner <> nil) then OldCadCrossObject := ListOwner.GetCADCrossObjectByObjectID(ObjectOwner.ID); ComponentList := TSCSComponents.Create(false); ComponentList.Add(ASCSComponent); ComponentList.Assign(ASCSComponent.FChildComplects, laOr); for i := 0 to ComponentList.Count - 1 do begin SCSComponent := ComponentList[i]; if i = 0 then begin ComponMarkTemplate := ''; if ListOwner <> nil then begin NBComponentType := ListOwner.FSpravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if NBComponentType <> nil then ComponMarkTemplate := NBComponentType.ComponentType.MarkMask; end; if ComponMarkTemplate <> '' then if Pos(mteNameShort, ComponMarkTemplate) <> 0 then Delete(ComponMarkTemplate, Pos(mteNameShort, ComponMarkTemplate), Length(mteNameShort)); Result := TCadCrossObject.Create; Result.ID := ProjectOwner.GenIDByGeneratorIndex(giCADCrossObjectID); Result.ObjectID := ObjectOwner.FID; Result.ListID := ObjectOwner.ListID; Result.ComponTypeSysName := SCSComponent.ComponentType.SysName; //Result.ComponNameMark := SCSComponent.NameMark; Result.ComponNameMark := TF_Main(SCSComponent.FActiveForm).MakeNameMarkComponent(SCSComponent, ObjectOwner, false, ComponMarkTemplate); Result.ComponNameShort := SCSComponent.NameShort; end; for j := 0 to SCSComponent.FChildReferences.Count - 1 do begin ChildComponent := SCSComponent.FChildComplects[j]; CADCrossObjectElement := TCADCrossObjectElement.Create; Result.Elements.Add(CADCrossObjectElement); CADCrossObjectElement.ID := ProjectOwner.GenIDByGeneratorIndex(giCADCrossObjectElementID); CADCrossObjectElement.IDCADCrossObject := Result.ID; CADCrossObjectElement.IDComponent := ChildComponent.ID; CADCrossObjectElement.SignType := ChildComponent.GetPropertyValueAsInteger(pnSignType); CADCrossObjectElement.Npp := ChildComponent.NameMark; //IntToStr(ChildComponent.MarkID); //*** емкость и диаметр кабеля суммируются все подключенные проектируемые пары CADCrossObjectElement.CableCapacity := 0; CADCrossObjectElement.CableDiameter := 0; for k := 0 to ChildComponent.FJoinedComponents.Count - 1 do begin JoinedToChildComponent := ChildComponent.FJoinedComponents[k]; if JoinedToChildComponent.IsLine = biTrue then begin //if JoinedToChildComponent.GetPropertyValueAsInteger(pnSignType) = oitProjectible then if JoinedToChildComponent.IsDismount = biFalse then begin CADCrossObjectElement.CableCapacity := CADCrossObjectElement.CableCapacity + GetComponPairCount(JoinedToChildComponent); CADCrossObjectElement.CableDiameter := CADCrossObjectElement.CableDiameter + Round2(JoinedToChildComponent.GetVolume(gtMale)); end; if CADCrossObjectElement.CableNameMark = '' then CADCrossObjectElement.CableNameMark := JoinedToChildComponent.NameShort; end; end; //*** Найти поключенную трассу к интерфейсу ` if OldCadCrossObject <> nil then for k := 0 to OldCadCrossObject.Elements.Count - 1 do begin OldCADCrossObjectElement := TCADCrossObjectElement(OldCadCrossObject.Elements[k]); if OldCADCrossObjectElement.IDComponent = CADCrossObjectElement.IDComponent then begin CADCrossObjectElement.ConnectingTraceID := OldCADCrossObjectElement.ConnectingTraceID; Break; //// BREAK //// end; end; end; //for j := 0 to SCSComponent.FInterfaces.Count - 1 do // begin // Interf := SCSComponent.FInterfaces[j]; // if Interf.TypeI = itFunctional then // begin // CADCrossObjectElement := TCADCrossObjectElement.Create; // Result.Elements.Add(CADCrossObjectElement); // CADCrossObjectElement.ID := ProjectOwner.GenIDByGeneratorIndex(giCADCrossObjectElementID); // CADCrossObjectElement.IDCADCrossObject := Result.ID; // CADCrossObjectElement.IDInterface := Interf.ID; // CADCrossObjectElement.SignType := Interf.SignType; // CADCrossObjectElement.Npp := Interf.Npp; // for k := 0 to Interf.FConnectedInterfaces.Count - 1 do // begin // JoinedInterface := Interf.FConnectedInterfaces[k]; // if JoinedInterface.ComponentOwner.IsLine = biTrue then // begin // CADCrossObjectElement.CableCapacity := GetComponPairCount(JoinedInterface.ComponentOwner); // CADCrossObjectElement.CableNameMark := JoinedInterface.ComponentOwner.NameShort; // CADCrossObjectElement.CableDiameter := Round2(JoinedInterface.ComponentOwner.GetVolume(gtMale)); // if CADCrossObjectElement.CableDiameter = 0 then // CADCrossObjectElement.CableDiameter := Round2(JoinedInterface.ComponentOwner.GetVolume(gtFeMale)); // Break; //// BREAK //// // end; // end; // //*** Найти поключенную трассу к интерфейсу // if OldCadCrossObject <> nil then // for k := 0 to OldCadCrossObject.Elements.Count - 1 do // begin // OldCADCrossObjectElement := TCADCrossObjectElement(OldCadCrossObject.Elements[k]); // if OldCADCrossObjectElement.IDInterface = CADCrossObjectElement.IDInterface then // begin // CADCrossObjectElement.ConnectingTraceID := OldCADCrossObjectElement.ConnectingTraceID; // Break; //// BREAK //// // end; // end; // end; // end; end; ComponentList.Free; end; end; function GetComponentsByIDList(AIDList: TIntList; ASrcCompons: TSCSComponents): TSCSComponents; var IDList: TIntList; i, j, ItemIndex: integer; SCSCompon: TSCSComponent; begin Result := TSCSComponents.Create(false); IDList := TIntList.Create; IDList.Assign(AIDList); for i := 0 to ASrcCompons.Count - 1 do begin SCSCompon := ASrcCompons[i]; ItemIndex := IDList.IndexOf(SCSCompon.ID); if ItemIndex <> -1 then begin Result.Add(SCSCompon); IDList.Delete(ItemIndex); if IDList.Count = 0 then Break; //// BREAK //// end; //for j := 0 to IDList.Count - 1 do // if IDList.IndexOf() end; FreeAndNil(IDList); end; function GetComponentsFromCatalogByNorm(ACatalog: TSCSCatalog; ANorm: TSCSNorm; ACanDuplicates: Boolean; aObjNorms: Boolean=true): TSCSObjectList; var i: integer; //SCSComponent: TSCSComponent; procedure AddObjToRes(aSCSObjCompon: TSCSComponCatalogClass); var i: Integer; begin if ACanDuplicates or (Result.IndexOf(aSCSObjCompon) = -1) then for i := 0 to aSCSObjCompon.FNormsResources.FNorms.Count - 1 do if aSCSObjCompon.FNormsResources.FNorms[i].GuidNB = ANorm.GuidNB then begin Result.Add(aSCSObjCompon); Break; //// BREAK //// end; end; begin Result := TSCSComponents.Create(false); for i := 0 to ACatalog.FComponentReferences.Count - 1 do AddObjToRes(ACatalog.FComponentReferences[i]); if aObjNorms then begin AddObjToRes(ACatalog); for i := 0 to ACatalog.FChildCatalogReferences.Count - 1 do AddObjToRes(ACatalog.FChildCatalogReferences[i]); end; end; function GetComonentsFromPrescurants(APreyscurants: TSCSObjectList; ACanDuplicates: Boolean): TSCSComponents; var i: Integer; Preyscurant: TSCSNormPreyscurant; begin Result := TSCSComponents.Create(false); for i := 0 to APreyscurants.Count - 1 do begin Preyscurant := TSCSNormPreyscurant(APreyscurants[i]); if Preyscurant.SCSComponent <> nil then if ACanDuplicates or (Result.IndexOf(Preyscurant.SCSComponent) = -1) then Result.Add(Preyscurant.SCSComponent); end; end; function GetComponUOM(ACompnent: TSCSComponent): String; begin Result := ''; if ACompnent.FProjectOwner <> nil then Result := GetNameUOMForCompon(ACompnent.Izm, @ACompnent.ComponentType, ACompnent.FProjectOwner.Setting.UnitOfMeasure); end; function GetConnectedInterfacesByConnectOrder(AInterface: TSCSInterface): TSCSInterfaces; var //BusyPositionsSorted: TRapObjectList; BusyPositionsSorted: TStringList; ItemIndex, i, j: Integer; BusyPosition: TSCSInterfPosition; begin Result := TSCSInterfaces.Create(false); // Строим сортированный список позиций интерфейсов в порядке создания BusyPositionsSorted := TStringList.Create; BusyPositionsSorted.Sorted := true; for i := 0 to AInterface.FBusyPositions.Count - 1 do begin BusyPosition := TSCSInterfPosition(AInterface.FBusyPositions.List^[i]); ItemIndex := BusyPositionsSorted.Add(IntToStr(BusyPosition.FInterfPosConnectionOwner.ID)); BusyPositionsSorted.Objects[ItemIndex] := BusyPosition; end; // По списку позиций находим подключенные интерфейсы for i := 0 to BusyPositionsSorted.Count - 1 do begin BusyPosition := TSCSInterfPosition(BusyPositionsSorted.Objects[i]); for j := 0 to (BusyPosition.ToPos - BusyPosition.FromPos) do begin if BusyPosition = BusyPosition.FInterfPosConnectionOwner.FSelfInterfPosition then Result.Add(BusyPosition.FInterfPosConnectionOwner.FConnInterfPosition.FInterfOwner) else if BusyPosition = BusyPosition.FInterfPosConnectionOwner.FConnInterfPosition then Result.Add(BusyPosition.FInterfPosConnectionOwner.FSelfInterfPosition.FInterfOwner); end; end; FreeAndNil(BusyPositionsSorted); end; function GetConnectKindByConnectionCompons(ACompon1, ACompon2: TSCSComponent; AConnectType: Integer): TConnectKind; begin Result := cnkVarious; case AConnectType of cntComplect: Result := cnkVarious; cntUnion: begin Result := cnkVarious or cnkMaleMale; if (ACompon1.IsLine = biFalse) and (ACompon2.IsLine = biFalse) then Result := Result or cnkFemaleFemale; end; end; end; function GetDepthJoinedConnComponByConnCompon(AConnComponent: TSCSComponent; AComponPath: TSCSComponents; AComponPathNameMarks: TStrings; AResComponJoinInterfaces, APrevComponJoinInterfaces: TSCSInterfaces; aPort: TSCSInterface=nil; aPortFromPos: Integer=0; aPortToPos: Integer=0; aFindToPort: Boolean=false): TSCSComponent; var ComponPath, lpAComponPath: TSCSComponents; LastPathSize: Integer; ComponFromPath, DepthJoinedConnCompon, lpDepthJoinedConnCompon: TSCSComponent; LookedInterf, lpResComponJoinInterfaces, lpPrevComponJoinInterfaces: TSCSInterfaces; //08.10.2013 - Last port data lpComponPathNameMarks: TStrings; procedure CreateLastPortLists; begin if lpAComponPath = nil then begin lpAComponPath := TSCSComponents.Create(false); lpComponPathNameMarks := TStrings.Create; lpResComponJoinInterfaces := TSCSInterfaces.Create(false); lpPrevComponJoinInterfaces := TSCSInterfaces.Create(false); end; end; function CanLookDepth(aCompon, aInternalJoined: TSCSComponent; aStepIdx: Integer): Boolean; var i: Integer; Interf: TSCSInterface; InterfLists: TInterfLists; begin Result := True; //05.10.2013 если ищем подключаемый к тому что пришел в основном параметре AConnComponent, проверяем чтобы интерфейс попадал на нужный порт if (aStepIdx = 1) and Assigned(aInternalJoined) then begin if (aPort <> nil) and (aPortFromPos <> 0) and (aPortToPos <> 0) then begin Result := False; if aPort.FConnectedInterfaces <> nil then for i := 0 to aPort.FConnectedInterfaces.Count - 1 do begin Interf := aPort.FConnectedInterfaces[i]; if Interf.ComponentOwner = aInternalJoined then if CheckJoinedInterfByPos(aPort, Interf, aPortFromPos, aPortToPos, 1, Interf.Kolvo) then begin Result := True; Break; //// BREAK //// end; end; end; end; if Result and Assigned(aCompon) and Assigned(aInternalJoined) then begin if Not aCompon.IsCrossComponent then begin InterfLists := aCompon.GetConnectedInterfacesToCompon(aInternalJoined); for i := 0 to InterfLists.InterfList1.Count - 1 do begin Interf := InterfLists.InterfList1[i]; if (Interf.PortInterfaces.Count > 0) or (Interf.InternalConnected.Count > 0) then Result := True else Result := false; Break; //// BREAK //// end; FreeInterfLists(InterfLists); end; end; end; procedure Step(AComponent: TSCSComponent; aStepIdx: Integer); var i, j: Integer; PrevComponFromPathList: TSCSComponent; ComponInterface, InterfInternalConnected: TSCSInterface; ConnectedInterfacesInCreateOrder: TSCSInterfaces; begin if AComponent.IsLine = biFalse then if ComponPath.IndexOf(AComponent) = -1 then begin PrevComponFromPathList := nil; if ComponPath.Count > 0 then PrevComponFromPathList := ComponPath[ComponPath.Count-1]; if CanLookDepth(PrevComponFromPathList, AComponent, aStepIdx) then begin ComponPath.Add(AComponent); //*** Если текущий путь длинее предыдущего, то перезаписываем результаты if ComponPath.Count > LastPathSize then begin LastPathSize := ComponPath.Count; DepthJoinedConnCompon := AComponent; //*** Выходной параметр в котором хранится путь к компоненте if (AComponPath <> nil) or (AComponPathNameMarks <> nil) then begin if AComponPath <> nil then AComponPath.Clear; if AComponPathNameMarks <> nil then AComponPathNameMarks.Clear; for i := 0 to ComponPath.Count - 1 do begin ComponFromPath := ComponPath[i]; if AComponPath <> nil then AComponPath.Add(ComponFromPath); if AComponPathNameMarks <> nil then AComponPathNameMarks.Add(ComponFromPath.NameMark); end; end; //*** Определить интерфейсы, которыми подключен компонент в глубине к предыдущему в пути ComponPath if (AResComponJoinInterfaces <> nil) or (APrevComponJoinInterfaces <> nil) then begin if AResComponJoinInterfaces <> nil then AResComponJoinInterfaces.Clear; if APrevComponJoinInterfaces <> nil then APrevComponJoinInterfaces.Clear; if PrevComponFromPathList <> nil then if PrevComponFromPathList.JoinedComponents.IndexOf(AComponent) <> -1 then for i := 0 to AComponent.FInterfaces.Count - 1 do begin ComponInterface := AComponent.FInterfaces[i]; if ComponInterface.FConnectedInterfaces.Count > 0 then begin ConnectedInterfacesInCreateOrder := GetConnectedInterfacesByConnectOrder(ComponInterface); LookedInterf.Clear; //for j := 0 to ComponInterface.FConnectedInterfaces.Count - 1 do for j := 0 to ConnectedInterfacesInCreateOrder.Count - 1 do begin //InterfInternalConnected := ComponInterface.FConnectedInterfaces[j]; InterfInternalConnected := TSCSInterface(ConnectedInterfacesInCreateOrder.List.List^[j]); if LookedInterf.IndexOf(InterfInternalConnected) = -1 then //24.03.2009 begin LookedInterf.Add(InterfInternalConnected); //24.03.2009 if InterfInternalConnected.FComponentOwner = PrevComponFromPathList then begin if AResComponJoinInterfaces <> nil then AResComponJoinInterfaces.Add(ComponInterface); if APrevComponJoinInterfaces <> nil then APrevComponJoinInterfaces.Add(InterfInternalConnected); //08.10.2013 - Если порт, то запоминаем данные для результата if aFindToPort and (ComponInterface.IsPort = biTrue) then begin CreateLastPortLists; if AComponPath <> nil then lpAComponPath.Assign(AComponPath); if AComponPathNameMarks <> nil then lpComponPathNameMarks.Assign(AComponPathNameMarks); if AResComponJoinInterfaces <> nil then lpResComponJoinInterfaces.Assign(AResComponJoinInterfaces); if APrevComponJoinInterfaces <> nil then lpPrevComponJoinInterfaces.Assign(APrevComponJoinInterfaces); lpDepthJoinedConnCompon := DepthJoinedConnCompon; end; Break; //// BREAK //// end; end; end; FreeAndNil(ConnectedInterfacesInCreateOrder); end; end; end; end; // ТЕЛО рекурсии for i := 0 to AComponent.JoinedComponents.Count - 1 do Step(AComponent.JoinedComponents[i], aStepIdx+1); ComponPath.Delete(ComponPath.Count-1); end; end; end; begin Result := nil; DepthJoinedConnCompon := nil; ComponPath := TSCSComponents.Create(false); LookedInterf := TSCSInterfaces.Create(false); //08.10.2013 - списки с результатом до последнего порта lpAComponPath := nil; lpComponPathNameMarks := nil; lpResComponJoinInterfaces := nil; lpPrevComponJoinInterfaces := nil; lpDepthJoinedConnCompon := nil; if aFindToPort and (aPort <> nil) then begin CreateLastPortLists; lpAComponPath.Add(AConnComponent); lpDepthJoinedConnCompon := AConnComponent; end; LastPathSize := 0; Step(AConnComponent, 0); if lpAComponPath <> nil then begin if AComponPath <> nil then AComponPath.Assign(lpAComponPath); if AComponPathNameMarks <> nil then AComponPathNameMarks.Assign(lpComponPathNameMarks); if AResComponJoinInterfaces <> nil then AResComponJoinInterfaces.Assign(lpResComponJoinInterfaces); if APrevComponJoinInterfaces <> nil then APrevComponJoinInterfaces.Assign(lpPrevComponJoinInterfaces); DepthJoinedConnCompon := lpDepthJoinedConnCompon; lpAComponPath.Free; lpComponPathNameMarks.Free; lpResComponJoinInterfaces.Free; lpPrevComponJoinInterfaces.Free; end; Result := DepthJoinedConnCompon; FreeAndNil(LookedInterf); FreeAndNil(ComponPath); end; function GetEmptyInterfCountFromPort(APort: TSCSInterface): Integer; var i, InterfEmptyKolvo, InterfEmptyPairKolvo: Integer; PortInterface: TSCSInterface; ptrPortInterfRel: PPortInterfRel; begin Result := 0; for i := 0 to APort.FPortInterfaces.Count - 1 do begin PortInterface := APort.FPortInterfaces[i]; ptrPortInterfRel := APort.GetPortInterfRelByInterfID(PortInterface.ID); if ptrPortInterfRel <> nil then begin InterfEmptyKolvo := PortInterface.Kolvo - PortInterface.KolvoBusy; if InterfEmptyKolvo >= ptrPortInterfRel.UnitInterfKolvo then Result := Result + ptrPortInterfRel.UnitInterfKolvo; end; end; end; function GetEndComponSideAtEnding(ALineComponent: TSCSComponent): Integer; var i, SideToJoinedComponent: Integer; JoinedComponent: TSCSComponent; begin Result := 1; if ALineComponent <> nil then if ALineComponent.IsLine = biTrue then begin for i := 0 to ALineComponent.JoinedComponents.Count - 1 do begin JoinedComponent := ALineComponent.JoinedComponents[i]; if JoinedComponent.Whole_ID = ALineComponent.Whole_ID then begin SideToJoinedComponent := GetComponSideJoinedToCompon(ALineComponent, JoinedComponent); if SideToJoinedComponent = 1 then Result := 2 else if SideToJoinedComponent = 2 then Result := 1; Break; //// BREAK //// end; end; end; end; function GetIOfIRelFromInterfByID(AInterface: TSCSInterface; AIDIOfIRel: Integer): TSCSIOfIRel; var i: Integer; IOfIRel: TSCSIOfIRel; begin Result := nil; for i := 0 to AInterface.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterface.FIOfIRelOut.FItemList.List^[i]); if IOfIRel.ID = AIDIOfIRel then begin Result := IOfIRel; Break; //// BREAK //// end; end; end; function GetInterfKolvoFromList(AList: TSCSInterfaces; APortOwner: TSCSInterface; ABusyKolvo: PInteger): Integer; var i: Integer; SCSInterface: TSCSInterface; ptrPortInterfRel: PPortInterfRel; begin Result := 0; if ABusyKolvo <> nil then ABusyKolvo^ := 0; for i := 0 to AList.Count - 1 do begin SCSInterface := AList[i]; ptrPortInterfRel := nil; if APortOwner <> nil then ptrPortInterfRel := APortOwner.GetPortInterfRelByInterfID(SCSInterface.ID); if ptrPortInterfRel = nil then begin Result := Result + SCSInterface.Kolvo; if ABusyKolvo <> nil then ABusyKolvo^ := ABusyKolvo^ + SCSInterface.KolvoBusy; {if AIsBusy = biNone then Result := Result + SCSInterface.Kolvo else if AIsBusy = biFalse then Result := Result + SCSInterface.Kolvo - SCSInterface.KolvoBusy else if AIsBusy = biTrue then Result := Result + SCSInterface.KolvoBusy;} end else begin Result := Result + ptrPortInterfRel.UnitInterfKolvo; if ABusyKolvo <> nil then //*** Если общих свободных интерфейсов меньше, чем на порте if (SCSInterface.Kolvo - SCSInterface.KolvoBusy) < ptrPortInterfRel.UnitInterfKolvo then ABusyKolvo^ := ABusyKolvo^ + ptrPortInterfRel.UnitInterfKolvo - (SCSInterface.Kolvo - SCSInterface.KolvoBusy); {if AIsBusy = biNone then Result := Result + ptrPortInterfRel.UnitInterfKolvo else if AIsBusy = biFalse then begin if (SCSInterface.Kolvo - SCSInterface.KolvoBusy) >= ptrPortInterfRel.UnitInterfKolvo then Result := Result + ptrPortInterfRel.UnitInterfKolvo end else if AIsBusy = biTrue then AddExceptionToLogEx('GetInterfKolvoFromList', 'Error');} end; end; end; function GetInterfPositionByNum(ANum: Integer; APositions: TList): TObjectList; var i, j: Integer; InterfPosition, PartInterfPosition: TSCSInterfPosition; begin Result := TObjectList.Create(false); for i := 0 to APositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(APositions.List^[i]); if (InterfPosition.FromPos <= ANum) and (ANum <= InterfPosition.ToPos) then begin if Result.IndexOf(InterfPosition) = -1 then Result.Add(InterfPosition); // Найти позиции, которые участвуют в подключении совместимых интерфейсов if InterfPosition.InterfPosConnectionOwner <> nil then if InterfPosition.InterfPosConnectionOwner.Owner <> nil then for j := 0 to APositions.Count - 1 do begin PartInterfPosition := TSCSInterfPosition(APositions.List^[j]); if (PartInterfPosition <> InterfPosition) and (PartInterfPosition.FromPos = 0) and (PartInterfPosition.ToPos = 0) then if PartInterfPosition.InterfPosConnectionOwner.Owner <> nil then if PartInterfPosition.InterfPosConnectionOwner.Owner.IDIOFIRelMain = InterfPosition.InterfPosConnectionOwner.Owner.ID then begin if Result.IndexOf(InterfPosition) = -1 then Result.Add(PartInterfPosition); end; end; // лучше продолжить цикл. так как в многократном интерфейсе м.б разные подключенные интерфейсы к одинаковым позициям //Break; //// BREAK //// end; end; { for i := 0 to APositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(APositions.List^[i]); if (InterfPosition.FromPos <= ANum) and (ANum <= InterfPosition.ToPos) then begin Result.Add(InterfPosition); // Найти позиции, которые участвуют в подключении совместимых интерфейсов if InterfPosition.InterfPosConnectionOwner <> nil then if InterfPosition.InterfPosConnectionOwner.Owner <> nil then for j := 0 to APositions.Count - 1 do begin PartInterfPosition := TSCSInterfPosition(APositions.List^[j]); if (PartInterfPosition <> InterfPosition) and (PartInterfPosition.FromPos = 0) and (PartInterfPosition.ToPos = 0) then if PartInterfPosition.InterfPosConnectionOwner.Owner <> nil then if PartInterfPosition.InterfPosConnectionOwner.Owner.IDIOFIRelMain = InterfPosition.InterfPosConnectionOwner.Owner.ID then Result.Add(PartInterfPosition); end; Break; //// BREAK //// end; end; } // Если ничего не найдено, проверяем совместимые интерфейсы {if Result = nil then begin InterfPosition := nil; for i := 0 to APositions.Count - 1 do begin PrevInterfPosition := InterfPosition; InterfPosition := TSCSInterfPosition(APositions.List^[i]); if (InterfPosition.FromPos = 0) and (InterfPosition.ToPos = 0) then if (PrevInterfPosition.FInterfOwner = InterfPosition.FInterfOwner) then if (InterfPosition.FromPos >= (ANum-1)) and (InterfPosition.ToPos <= (ANum-1)) then begin Result := InterfPosition; Break; //// BREAK //// end; end; end; } end; function GetInterfPositionsByRange(APositions: TList; aFrom, aTo: Integer): TSCSObjectList; var i: Integer; InterfPos: TSCSInterfPosition; begin Result := TSCSObjectList.Create(false); for i := 0 to APositions.Count - 1 do begin InterfPos := TSCSInterfPosition(APositions.List^[i]); if CheckPosIntersectRange(InterfPos, aFrom, aTo) then Result.Add(InterfPos); end; end; function GetIOfIRelPosCount(AIOfIRel: TSCSIOfIRel): Integer; var InterfPosConnection: TSCSInterfPosConnection; i: Integer; begin Result := 0; for i := 0 to AIOfIRel.PosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(AIOfIRel.PosConnections[i]); Result := Result + InterfPosConnection.SelfInterfPosition.ToPos - (InterfPosConnection.SelfInterfPosition.FromPos - 1); end; end; function GetIOfIRelThatConnectInterfaces(AInterf1, AInterf2: TSCSInterface; AFrom1, ATo1, AFrom2, ATo2: Integer): TSCSIOfIRel; var i, j: Integer; IOfIRel: TSCSIOfIRel; IsFinded: Boolean; InterfPosConnection: TSCSInterfPosConnection; function CheckInterfPosition(APosition: TSCSInterfPosition; AChFrom, AChTo: Integer): Boolean; begin Result := true; if (AChFrom <> -1) and (AChTo <> -1) and (AChFrom <> 0) and (AChTo <> 0) then begin //if (APosition.FFromPos <> AChFrom) or // (APosition.FToPos <> AChTo) then // Result := false; Result := false; if (APosition.FFromPos <= AChFrom) and (AChTo <= APosition.FToPos) then Result := true; end; end; begin Result := nil; IsFinded := false; for i := 0 to AInterf1.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterf1.FIOfIRelOut[i]); if IOfIRel.InterfaceTo = AInterf2 then begin IsFinded := false; for j := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[j]); if CheckInterfPosition(InterfPosConnection.SelfInterfPosition, AFrom1, ATo1) and CheckInterfPosition(InterfPosConnection.ConnInterfPosition, AFrom2, ATo2) then begin IsFinded := true; Break; //// BREAK //// end; end; if IsFinded then begin Result := IOfIRel; Break; //// BREAK //// end; end; end; if Result = nil then for i := 0 to AInterf2.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterf2.FIOfIRelOut[i]); if IOfIRel.InterfaceTo = AInterf1 then begin IsFinded := false; for j := 0 to IOfIRel.FPosConnections.Count - 1 do begin InterfPosConnection := TSCSInterfPosConnection(IOfIRel.FPosConnections[j]); if CheckInterfPosition(InterfPosConnection.SelfInterfPosition, AFrom2, ATo2) and CheckInterfPosition(InterfPosConnection.ConnInterfPosition, AFrom1, ATo1) then begin IsFinded := true; Break; //// BREAK //// end; end; if IsFinded then begin Result := IOfIRel; Break; //// BREAK //// end; end; end; end; function GetJoinedComponentsInternalObject(AComponent: TSCSComponent; ASrcToResult: Boolean): TSCSComponents; var LookedTopComponents: TSCSComponents; procedure Step(AStepComponent: TSCSComponent); var i: Integer; JoinedComponent: TSCSComponent; JoinedInternalComponents: TSCSComponents; begin LookedTopComponents.Add(AStepComponent.GetTopComponent); JoinedInternalComponents := nil; for i := 0 to AStepComponent.JoinedComponents.Count - 1 do begin JoinedComponent := AStepComponent.JoinedComponents[i]; if (JoinedComponent.ObjectID = AStepComponent.ObjectID) and (JoinedComponent <> AComponent) and (Result.IndexOf(JoinedComponent) = -1) {and (LookedTopComponents.IndexOf(JoinedComponent.GetTopComponent) = -1)} then begin if JoinedInternalComponents = nil then JoinedInternalComponents := TSCSComponents.Create(False); JoinedInternalComponents.Add(JoinedComponent); Result.Add(JoinedComponent); end; end; if JoinedInternalComponents <> nil then begin for i := 0 to JoinedInternalComponents.Count - 1 do Step(JoinedInternalComponents[i]); FreeAndNil(JoinedInternalComponents); end; end; begin Result := TSCSComponents.Create(false); if ASrcToResult then Result.Add(AComponent); LookedTopComponents := TSCSComponents.Create(false); Step(AComponent); FreeAndNil(LookedTopComponents); end; function GetJoinedComponentsThroughPoint(AComponent: TSCSComponent): TSCSComponents; var i, j, k, l: Integer; CurrJoined, JoinedThrough: TSCSComponent; CurrInterf, InternalJoinedInterf, JoinedToInternal, InternalConnectedinterf: TSCSInterface; InterfLists: TInterfLists; begin Result := TSCSComponents.Create(false); for i := 0 to AComponent.JoinedComponents.Count - 1 do begin CurrJoined := AComponent.JoinedComponents[i]; if CurrJoined.IsLine = biTrue then begin if Result.IndexOf(CurrJoined) = -1 then Result.Add(CurrJoined); end else begin //*** Найти интерфейсы, которыми идет подключение InterfLists := CurrJoined.GetInterfacesThatConnectComponent(AComponent); for j := 0 to InterfLists.InterfList1.Count - 1 do begin CurrInterf := TSCSInterface(InterfLists.InterfList1[j]); //*** Просмотреть внутри подключенные интерфейсы for k := 0 to CurrInterf.FInternalConnected.Count - 1 do begin InternalJoinedInterf := CurrInterf.FInternalConnected[k]; //*** Просмотреть внешние подключения к подключенному внутри for l := 0 to InternalJoinedInterf.FConnectedInterfaces.Count - 1 do begin JoinedToInternal := InternalJoinedInterf.FConnectedInterfaces[l]; if (JoinedToInternal.FComponentOwner <> nil) and (JoinedToInternal.FComponentOwner <> AComponent) then begin if Result.IndexOf(JoinedToInternal.FComponentOwner) = -1 then Result.Add(JoinedToInternal.FComponentOwner); end; end; end; end; InterfLists.InterfList1.Free; InterfLists.InterfList2.Free; end; end; end; function GetJoinedComponWithType(ACompon: TSCSComponent; ACompTypeSysName: String): TSCSComponent; var i: Integer; begin Result := nil; for i := 0 to ACompon.JoinedComponents.Count - 1 do if ACompon.JoinedComponents[i].ComponentType.SysName = ACompTypeSysName then begin Result := ACompon.JoinedComponents[i]; Break; //// BREAK //// end; end; function GetJoinedCountToComponWithChilds(ACompon: TSCSComponent): Integer; var i: Integer; TopComponent: TSCSComponent; procedure FindJoinedCountFromCompon(ASimpleCompon: TSCSComponent); var JoinedComponent: TSCSComponent; i: Integer; begin for i := 0 to ACompon.FJoinedComponents.Count - 1 do begin JoinedComponent := TSCSComponent(ACompon.FJoinedComponents.FItems.List^[i]); // соединение не должно быть внутрикомпонентным if JoinedComponent.GetTopComponent <> TopComponent then Result := Result + 1; end; end; begin Result := 0; TopComponent := ACompon.GetTopComponent; FindJoinedCountFromCompon(ACompon); for i := 0 to ACompon.ChildReferences.Count - 1 do FindJoinedCountFromCompon(TSCSComponent(ACompon.ChildReferences.FItems.List^[i])); end; function GetJoinedLineComponCount(AComponent: TSCSComponent): Integer; var i: Integer; begin Result := 0; for i := 0 to AComponent.FJoinedComponents.Count - 1 do begin if TSCSComponent(AComponent.FJoinedComponents.FItems.List^[i]).IsLine = biTrue then Result := Result + 1; end; end; function GetJoinedMultiPortPortToComponentBySide(AComponent: TSCSComponent; ASide: Integer): TSCSComponent; var i, ComponSide, JoinedComponSide: Integer; ComponObjectOwner: TSCSCatalog; JoinedComponent: TSCSComponent; JoinedComponentObjectOwner: TSCSCatalog; begin Result := nil; if AComponent.IsLine = biTrue then begin ComponObjectOwner := AComponent.GetFirstParentCatalog; for i := 0 to AComponent.FJoinedComponents.Count - 1 do begin JoinedComponent := AComponent.FJoinedComponents[i]; if JoinedComponent.IsLine = biFalse then begin JoinedComponentObjectOwner := JoinedComponent.GetFirstParentCatalog; GetSidesByConnectedFigures(ComponObjectOwner.ListID, JoinedComponentObjectOwner.ListID, ComponObjectOwner.SCSID, JoinedComponentObjectOwner.SCSID, ComponSide, JoinedComponSide); if ComponSide = ASide then begin Result := JoinedComponent; if Result.ComponentType.PortKind = pkMultiPort then Break; ////// BREAK ///// end; end; end; end; end; function GetJoinedTrunkComponent(AComponent: TSCSComponent): TSCSComponent; var JoinedComponent: TSCSComponent; i: Integer; begin Result := nil; for i := 0 to AComponent.FJoinedComponents.Count - 1 do begin JoinedComponent := AComponent.FJoinedComponents[i]; if IsTrunkComponent(JoinedComponent) then begin Result := JoinedComponent; Break; //// BREAK //// end; end; end; function GetNearComponentFromListIDs(AProject: TSCSProject; AListIDs: TIntList; AComponent: TSCSComponent; ALookingStep: Integer): TSCSComponent; var CurrComponIndex, NewComponIndex: Integer; begin Result := nil; CurrComponIndex := AListIDs.IndexOf(AComponent.ID); if CurrComponIndex <> -1 then begin NewComponIndex := CurrComponIndex + ALookingStep; if (NewComponIndex >= 0) and (NewComponIndex < AListIDs.Count) then Result := AProject.GetComponentFromReferences(AListIDs[NewComponIndex]); end; end; function GetSCSObjectIcons(AObjectComponent: TSCSComponent): TObjectList; var FirstComponent, CurrComponent, JoinedComponent, FirstInternalJoined, TopInternalComponent: TSCSComponent; ComponentList, InternalJoinedComponents: TSCSComponents; i, j: Integer; IconBLK: TMemoryStream; begin Result := nil; FirstComponent := AObjectComponent; //AObject.GetFirstComponent; FirstInternalJoined := nil; if FirstComponent <> nil then begin Result := TObjectList.Create(true); InternalJoinedComponents := GetJoinedComponentsInternalObject(FirstComponent, true); for i := 0 to InternalJoinedComponents.Count - 1 do begin //if InternalJoinedComponents[i] <> FirstComponent then begin IconBLK := InternalJoinedComponents[i].GetObjectIconBlk; if IconBLK <> nil then Result.Add(IconBLK); end; end; FreeAndNil(InternalJoinedComponents); end; end; function GetParentComponByCompTypeSysName(AComponent: TSCSComponent; const ACompTypeSysName: string): TSCSComponent; var TempComponent: TSCSComponent; SprCompType: TNBComponentType; begin Result := nil; if AComponent <> nil then begin TempComponent := AComponent; while TempComponent <> nil do begin SprCompType := AComponent.FProjectOwner.FSpravochnik.GetComponentTypeByGUID(TempComponent.GUIDComponentType); if SprCompType.ComponentType.SysName = ACompTypeSysName then begin Result := TempComponent; Break; //// BREAK //// end; TempComponent := TempComponent.GetParentComponent; end; end; end; function GetParentComponByIsLine(AComponent: TSCSComponent; AIsLine: Integer): TSCSComponent; var TempComponent: TSCSComponent; begin Result := nil; if AComponent <> nil then begin TempComponent := AComponent; while TempComponent <> nil do begin if TempComponent.IsLine = AIsLine then begin Result := TempComponent; Break; //// BREAK //// end; TempComponent := TempComponent.GetParentComponent; end; end; end; function GetParentComponByOneCompTypeSysName(AComponent: TSCSComponent; const ACompTypeSysNames: TStringlist): TSCSComponent; var TempComponent: TSCSComponent; SprCompType: TNBComponentType; begin Result := nil; if AComponent <> nil then begin TempComponent := AComponent; while TempComponent <> nil do begin SprCompType := AComponent.FProjectOwner.FSpravochnik.GetComponentTypeByGUID(TempComponent.GUIDComponentType); if ACompTypeSysNames.IndexOf(SprCompType.ComponentType.SysName) <> -1 then begin Result := TempComponent; Break; //// BREAK //// end; TempComponent := TempComponent.GetParentComponent; end; end; end; function GetNppPortByConnected(APort, ARelatedInterface, AConnectedInterface: TSCSInterface; AMaxNppPortFromPosition: Integer = -1; aPortFromPos: PInteger=nil; aPortToPos: PInteger=nil): Integer; var i, MinFromPos, MaxToPos, InterfKolvoInPortRel, NppPortFromPosition: Integer; ptrPortinterfRelation: PPortInterfRel; InterfPosition: TSCSInterfPosition; Positions: TList; begin Result := APort.NppPort; if aPortFromPos <> nil then aPortFromPos^ := 0; if aPortToPos <> nil then aPortToPos^ := 0; if (AConnectedInterface <> nil) {and (APort.Kolvo > 1)} then begin //Positions := aRelInterfConnPositions; //if Positions = nil then Positions := GetInterfPositionsByConnectedInterface(ARelatedInterface, AConnectedInterface); //*** Найти позицию с максимальным полем ToPos MinFromPos := 0; MaxToPos := 0; for i := 0 to Positions.Count - 1 do begin InterfPosition := TSCSInterfPosition(Positions[i]); if (InterfPosition.FromPos < MinFromPos) or (MinFromPos = 0) then MinFromPos := InterfPosition.FromPos; if InterfPosition.ToPos > MaxToPos then MaxToPos := InterfPosition.ToPos; end; //*** Количество интерфейсов на порту InterfKolvoInPortRel := 1; ptrPortinterfRelation := APort.GetPortInterfRelByInterfID(ARelatedInterface.ID); if ptrPortinterfRelation <> nil then InterfKolvoInPortRel := ptrPortInterfRelation.UnitInterfKolvo; {//24.03.2009 if (InterfKolvoInPortRel > 0) and (MaxToPos > 0) then begin NppPortFromPosition := Trunc(MaxToPos / InterfKolvoInPortRel); if (AMaxNppPortFromPosition <> -1) and (NppPortFromPosition > AMaxNppPortFromPosition) then NppPortFromPosition := AMaxNppPortFromPosition; if (MaxToPos mod InterfKolvoInPortRel) > 0 then NppPortFromPosition := NppPortFromPosition + 1; Result := (APort.NppPort - 1) + NppPortFromPosition; end;} Result := GetNppPortByRelatedInterfPos(APort, InterfKolvoInPortRel, MaxToPos); if aPortFromPos <> nil then begin aPortFromPos^ := Trunc(MinFromPos / InterfKolvoInPortRel); if (MinFromPos < InterfKolvoInPortRel) then aPortFromPos^ := aPortFromPos^ + 1 else if (MinFromPos mod InterfKolvoInPortRel) > 0 then aPortFromPos^ := aPortFromPos^ + 1; end; if aPortToPos <> nil then begin aPortToPos^ := Trunc(MaxToPos / InterfKolvoInPortRel); if (MaxToPos mod InterfKolvoInPortRel) > 0 then aPortToPos^ := aPortToPos^ + 1; end; //if aRelInterfConnPositions <> nil then FreeAndNil(Positions); end; end; function GetNppPortByRelatedInterfPos(APort: TSCSInterface; AInterfKolvoInPortRel, AInterfPos: Integer): Integer; var NppPortFromPosition: Integer; begin Result := APort.NppPort; if (AInterfKolvoInPortRel > 0) and (AInterfPos > 0) then begin NppPortFromPosition := Trunc(AInterfPos / AInterfKolvoInPortRel); //if (AMaxNppPortFromPosition <> -1) and (NppPortFromPosition > AMaxNppPortFromPosition) then // NppPortFromPosition := AMaxNppPortFromPosition; if (AInterfPos mod AInterfKolvoInPortRel) > 0 then NppPortFromPosition := NppPortFromPosition + 1; Result := (APort.NppPort - 1) + NppPortFromPosition; end; end; function GetNppPortsByConnected(APort, ARelatedInterface, AConnectedInterface: TSCSInterface): TIntList; var i, j, InterfKolvoInPortRel, NppPort: Integer; ptrPortinterfRelation: PPortInterfRel; InterfPosition: TSCSInterfPosition; Positions: TList; begin Result := TIntList.Create; if (AConnectedInterface <> nil) then begin //*** Количество интерфейсов на порту InterfKolvoInPortRel := 1; ptrPortinterfRelation := APort.GetPortInterfRelByInterfID(ARelatedInterface.ID); if ptrPortinterfRelation <> nil then InterfKolvoInPortRel := ptrPortInterfRelation.UnitInterfKolvo; Positions := GetInterfPositionsByConnectedInterface(ARelatedInterface, AConnectedInterface); //*** Найти все позиции портов for i := 0 to Positions.Count - 1 do begin InterfPosition := TSCSInterfPosition(Positions[i]); for j := InterfPosition.FromPos to InterfPosition.ToPos do begin NppPort := GetNppPortByRelatedInterfPos(APort, InterfKolvoInPortRel, j); if GetValueIndexFromSortedIntList(NppPort, Result) = -1 then InsertValueToSortetIntList(NppPort, Result); end; end; FreeAndNil(Positions); end; end; function GetNppPortByJoinedCompon(APort: TSCSInterface; AJoinedCompon: TSCSComponent): Integer; var i, j: Integer; PortNppByConnected: Integer; Portinterface, Joinedinterface: TSCSInterface; begin Result := APort.NppPort; PortNppByConnected := 0; // Перебераем интерфейсы порта for i := 0 to APort.PortInterfaces.Count - 1 do begin Portinterface := TSCSInterface(APort.PortInterfaces.FItems.List^[i]); if Portinterface.ConnectedInterfaces.Count > 0 then for j := 0 to Portinterface.ConnectedInterfaces.Count - 1 do begin Joinedinterface := TSCSInterface(Portinterface.ConnectedInterfaces.FItems.List^[j]); if Joinedinterface.ComponentOwner = AJoinedCompon then begin PortNppByConnected := GetNppPortByConnected(APort, Portinterface, Joinedinterface); if PortNppByConnected <> 0 then begin Result := PortNppByConnected; Break; //// BREAK //// end; end; end; if PortNppByConnected <> 0 then Break; //// BREAK //// end; end; // added by Tolik function GetPortsCount(aCompon: TSCSComponent; aSide: Integer; aRecursive: Boolean=false): Integer; var ComponList: TSCSComponents; ComponIdx, i, j, k, l, CurrInterfFrom, CurrInterfTo: Integer; Compon: TSCSComponent; Port: TSCSInterface; PortInterfRel: PPortInterfRel; ExistsEmpty: Boolean; SCSCatalog : TSCSCatalog; begin Result := 0; ComponList := TSCSComponents.create(false); {ComponList.assign(Comp);} if ARecursive then ComponList.Assign(aCompon.ChildReferences); ComponList.Insert(0, aCompon); // Составляем список портов for ComponIdx := 0 to ComponList.Count - 1 do begin Compon := ComponList[ComponIdx]; if Compon.Interfaces.Count > 0 then begin for i := 0 to Compon.Interfaces.Count - 1 do begin Port := Compon.Interfaces[i]; if Port.IsPort = biTrue then begin if Port.Kolvo <= 0 then Inc(Result) else Result := Result + Port.Kolvo; end; end; end; end; FreeAndNil(ComponList); end; // function GetPortsCountReadyToConnectByInterf(aCompon: TSCSComponent; aSide: Integer; aRecursive: Boolean=false): Integer; var ComponList: TSCSComponents; ComponIdx, i, j, k, l, CurrInterfFrom, CurrInterfTo: Integer; Compon: TSCSComponent; Port: TSCSInterface; PortInterfRel: PPortInterfRel; ExistsEmpty: Boolean; begin Result := 0; ComponList := TSCSComponents.Create(false); if ARecursive then ComponList.Assign(aCompon.ChildReferences); ComponList.Insert(0, aCompon); // Составляем список портов for ComponIdx := 0 to ComponList.Count - 1 do begin Compon := ComponList[ComponIdx]; for i := 0 to Compon.Interfaces.Count - 1 do begin Port := Compon.Interfaces[i]; if Port.IsPort = biTrue then if (Port.Side = 0) or (Port.Side = aSide) then // Если на портах есть интерфейсы, то разгруппировать эти порты if Port.PortInterfRels.Count > 0 then begin for j := 0 to Port.Kolvo - 1 do begin ExistsEmpty := false; for k := 0 to Port.PortInterfRels.Count - 1 do begin PortInterfRel := Port.PortInterfRels.List^[k]; if PortInterfRel.RelType = rtPortInterfRel then begin if PortInterfRel.Interf = nil then PortInterfRel.Interf := Compon.GetInterfaceByID(PortInterfRel.IDInterfRel); if PortInterfRel.Interf <> nil then begin CurrInterfFrom := (j * PortInterfRel.UnitInterfKolvo) + 1; CurrInterfTo := CurrInterfFrom + PortInterfRel.UnitInterfKolvo - 1; // Занятые и свободные позиции отдельно for l := CurrInterfFrom to CurrInterfTo do if Not CheckNumInPositionList(l, PortInterfRel.Interf.BusyPositions) then // Если позиции нет взанятых begin Inc(Result); ExistsEmpty := true; Break; //// BREAK //// end; // Если на порту найден свободный интерфейс, то остальные интерфейсы на порту не смотрим if ExistsEmpty then Break; //// BREAK //// end; end; end; end; end; end; end; FreeAndNil(ComponList); end; function GetParentComunicationCompon(ACompon: TSCSComponent): TSCSComponent; var TempComponent: TSCSComponent; SprCompType: TNBComponentType; begin Result := nil; if ACompon <> nil then begin TempComponent := ACompon; while TempComponent <> nil do begin SprCompType := ACompon.FProjectOwner.FSpravochnik.GetComponentTypeByGUID(TempComponent.GUIDComponentType); if IsComunicationCompon(TempComponent) then begin Result := TempComponent; Break; //// BREAK //// end; TempComponent := TempComponent.GetParentComponent; end; end; end; function GetPropValueAsBoolGrayedDef(AProperties: TList; const ASysName: string; ADef: Integer): Integer; var TrueCount, FalseCount, i: integer; ptrProperty: PProperty; begin Result := ADef; TrueCount := 0; FalseCount := 0; for i := 0 to AProperties.Count - 1 do begin ptrProperty := AProperties[i]; if ptrProperty.SysName = ASysName then begin if ptrProperty.Value = bssTrue then TrueCount := TrueCount + 1 else if ptrProperty.Value = bssFalse then FalseCount := FalseCount + 1; end; end; if (TrueCount > 0) and (FalseCount = 0) then Result := bigTrue else if (TrueCount = 0) and (FalseCount > 0) then Result := bigFalse else if (TrueCount > 0) and (FalseCount > 0) then Result := bigGray; end; function GetPointFigureRelationByPointObjects(APointFigureRelations: TObjectList; AFromPointComponent, AToPointComponent: TSCSComponent): TPointFigureRelation; var i, PosOfFromTrunkComplect, PosOfToTrunkComplect: Integer; PointFigureRelation: TPointFigureRelation; FromPointObject, ToPointObject: TSCSCatalog; function CheckPointFigureRelationByPointObjects(APointFigureRelation: TPointFigureRelation; AFirstCompon, ALastCompon: TSCSComponent; AFirstObject, ALastObject: TSCSCatalog; APosOfFirstLine, APosOfLastLine: Integer): Boolean; var FirstLineCatalog, LastLineCatalog: TSCSCatalog; begin Result := false; if (APointFigureRelation.FFirstPointObject = AFirstObject) and (APointFigureRelation.FLastPointObject = ALastObject) then begin Result := true; FirstLineCatalog := nil; LastLineCatalog := nil; if APointFigureRelation.FTracesObjects.Count > 0 then begin FirstLineCatalog := APointFigureRelation.FTracesObjects[0]; LastLineCatalog := APointFigureRelation.FTracesObjects[APointFigureRelation.FTracesObjects.Count - 1]; end; if APosOfFirstLine <> -1 then begin Result := false; if (FirstLineCatalog <> nil) and (GetComplexIdentificatorByConnectedTrace(AFirstCompon, AFirstObject, FirstLineCatalog) = APosOfFirstLine) then Result := true; end; if Result then if APosOfLastLine <> -1 then begin Result := false; if (LastLineCatalog <> nil) and (GetComplexIdentificatorByConnectedTrace(ALastCompon, ALastObject, LastLineCatalog) = APosOfLastLine) then Result := true; end; end; end; begin Result := nil; FromPointObject := AFromPointComponent.GetFirstParentCatalog; ToPointObject := AToPointComponent.GetFirstParentCatalog; PosOfFromTrunkComplect := -1; PosOfToTrunkComplect := -1; PosOfFromTrunkComplect := GetComponIdentificatorInComplex(AFromPointComponent); //GetPosOfTopTrunkComplect(AFromPointComponent); PosOfToTrunkComplect := GetComponIdentificatorInComplex(AToPointComponent); //GetPosOfTopTrunkComplect(AToPointComponent); if (FromPointObject <> nil) and (ToPointObject <> nil) then for i := 0 to APointFigureRelations.Count - 1 do begin PointFigureRelation := TPointFigureRelation(APointFigureRelations[i]); if CheckPointFigureRelationByPointObjects(PointFigureRelation, AFromPointComponent, AToPointComponent, FromPointObject, ToPointObject, PosOfFromTrunkComplect, PosOfToTrunkComplect) or CheckPointFigureRelationByPointObjects(PointFigureRelation, AToPointComponent, AFromPointComponent, ToPointObject, FromPointObject, PosOfToTrunkComplect, PosOfFromTrunkComplect) then begin Result := PointFigureRelation; Break; //// BREAK //// end; end; end; function GetPointObjectsByConnectedFropmPointRelations(APointFigureRelations: TObjectList; AConnectedPoint: TSCSCatalog): TSCSCatalogs; var i: Integer; PointFigureRelation: TPointFigureRelation; ConnectedLineObject: TSCSCatalog; begin Result := TSCSCatalogs.Create(false); for i := 0 to APointFigureRelations.Count - 1 do begin PointFigureRelation := TPointFigureRelation(APointFigureRelations[i]); if PointFigureRelation.FFirstPointObject = AConnectedPoint then if Result.indexOf(PointFigureRelation.FLastPointObject) = -1 then Result.Add(PointFigureRelation.FLastPointObject); if PointFigureRelation.FLastPointObject = AConnectedPoint then if Result.indexOf(PointFigureRelation.FFirstPointObject) = -1 then Result.Add(PointFigureRelation.FFirstPointObject); end; end; function GetPortCaption(APort: TSCSInterface; APortNum: integer): String; begin Result := ''; if APort.IsPort = biTrue then begin APort.LoadName; if APort.Kolvo = 1 then Result := cSCSComponent_Msg5_1 +IntToStr(APort.NppPort)+ '-"'+APort.Name+'"' else begin if APortNum <> -1 then Result := cSCSComponent_Msg5_1 +IntToStr(APortNum)+ '-"'+APort.Name+'"' else Result := cSCSComponent_Msg5_1 +IntToStr(APort.NppPort)+'-'+IntToStr(APort.NppPort+APort.Kolvo-1)+ '-"'+APort.Name+'"'; end; end; end; function GetPortPosRangeByInterfRange(AInterf: TSCSInterface; APosFrom, APosTo: Integer; var AOutPosFrom, AOutPosTo: Integer): Boolean; var ptrPortInterfRel: PPortInterfRel; begin Result := false; AOutPosFrom := 0; AOutPosTo := 0; if AInterf.PortOwner <> nil then begin ptrPortInterfRel := AInterf.PortOwner.GetPortInterfRelByInterfID(AInterf.ID); if (ptrPortInterfRel <> nil) and (ptrPortInterfRel.RelType = rtPortInterfRel) then begin AOutPosFrom := GetNppPortByRelatedInterfPos(AInterf.PortOwner, ptrPortInterfRel.UnitInterfKolvo, APosFrom); AOutPosTo := GetNppPortByRelatedInterfPos(AInterf.PortOwner, ptrPortInterfRel.UnitInterfKolvo, APosTo); Result := true; end; end; end; procedure GetPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer; var AOutPosFrom, AOutPosTo: Integer); begin AOutPosFrom := 0; AOutPosTo := 0; // ACheckPosFrom-ACheckPosTo входит в APosFrom-APosTo if (APosFrom <= ACheckPosFrom) and (ACheckPosTo <= APosTo) then begin AOutPosFrom := ACheckPosFrom; AOutPosTo := ACheckPosTo; end // APosFrom-APosTo входит в ACheckPosFrom-ACheckPosTo else if (ACheckPosFrom <= APosFrom) and (APosTo <= ACheckPosTo) then begin AOutPosFrom := APosFrom; AOutPosTo := APosTo; end // ACheckPosFrom входит в APosFrom-APosTo else if (APosFrom <= ACheckPosFrom) and (ACheckPosFrom <= APosTo) then begin AOutPosFrom := ACheckPosFrom; AOutPosTo := APosTo; end // ACheckPosTo входит в APosFrom-APosTo else if (APosFrom <= ACheckPosTo) and (ACheckPosTo <= APosTo) then begin AOutPosFrom := APosFrom; AOutPosTo := ACheckPosTo; end // APosFrom входит в ACheckPosFrom-ACheckPosTo else if (ACheckPosFrom <= APosFrom) and (APosFrom <= ACheckPosTo) then begin AOutPosFrom := APosFrom; AOutPosTo := ACheckPosTo; end // APosTo входит в ACheckPosFrom-ACheckPosTo else if (ACheckPosFrom <= APosTo) and (APosTo <= ACheckPosTo) then begin AOutPosFrom := ACheckPosFrom; AOutPosTo := APosTo; end end; function GetPosOfTopComplect(AComplect: TSCSComponent): Integer; var TopComplect: TSCSComponent; CurrTopComplect: TSCSComponent; begin Result := -1; //*** Найти верхнюю комплектующею TopComplect := nil; CurrTopComplect := AComplect; while CurrTopComplect <> nil do begin if CurrTopComplect.Parent is TSCSComponent then if CurrTopComplect.Parent.Parent is TSCSCatalog then begin TopComplect := CurrTopComplect; Break; //// BREAK //// end; if CurrTopComplect.Parent is TSCSComponent then CurrTopComplect := TSCSComponent(CurrTopComplect.Parent) else CurrTopComplect := nil; end; if TopComplect <> nil then Result := TSCSComponent(TopComplect.Parent).FChildComplects.IndexOf(TopComplect); end; function GetPosOfTopTrunkComplect(AComplect: TSCSComponent): Integer; begin Result := -1; if IsTrunkComponent(AComplect) then Result := GetPosOfTopComplect(AComplect); end; function GetPreyscurantFromNormByCompon(ANorm: TSCSNorm; APreyscurant: TSCSComponent): TSCSNormPreyscurant; var NormPreyscurant: TSCSNormPreyscurant; i: integer; begin Result := nil; for i := 0 to ANorm.FPreyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(ANorm.FPreyscurants[i]); if NormPreyscurant.SCSComponent = APreyscurant then begin Result := NormPreyscurant; Break; //// BREAK //// end; end; end; function GetInterfPositionsByConnectedInterface(AInterface, AConnectedInterf: TSCSInterface): TList; var i: Integer; InterfPosition: TSCSInterfPosition; begin Result := TList.Create; for i := 0 to AInterface.FBusyPositions.Count - 1 do begin InterfPosition := TSCSInterfPosition(AInterface.FBusyPositions[i]); if InterfPosition.InterfPosConnectionOwner <> nil then begin if (InterfPosition.InterfPosConnectionOwner.FSelfInterfPosition.InterfOwner = AConnectedInterf) and (InterfPosition.InterfPosConnectionOwner.FConnInterfPosition.InterfOwner = AInterface) then Result.Add(InterfPosition.InterfPosConnectionOwner.FConnInterfPosition) else if (InterfPosition.InterfPosConnectionOwner.FSelfInterfPosition.InterfOwner = AInterface) and (InterfPosition.InterfPosConnectionOwner.FConnInterfPosition.InterfOwner = AConnectedInterf) then Result.Add(InterfPosition.InterfPosConnectionOwner.FSelfInterfPosition); end; end; end; function GetPortInfoByJoinedCompons(aComponWithPort, AJoinedCompon: TSCSComponent; var aNppFrom, aNppTo: Integer): Boolean; var InterfLists: TInterfLists; Interf, Joinedinterf: TSCSInterface; i,j, interfCount, MinPos, MaxPos: Integer; Positions: TList; InterfPosition: TSCSInterfPosition; begin Result := false; aNppFrom := 0; aNppTo := 0; InterfLists := aComponWithPort.GetConnectedInterfacesToCompon(AJoinedCompon); if (InterfLists.InterfList1 <> nil) and (InterfLists.InterfList2 <> nil) then begin interfCount := Min(InterfLists.InterfList1.Count, InterfLists.InterfList2.Count); for i := 0 to InterfCount - 1 do begin Interf := InterfLists.InterfList1[i]; Joinedinterf := InterfLists.InterfList2[i]; if Interf.IsPort = biTrue then begin Positions := GetInterfPositionsByConnectedInterface(Interf, Joinedinterf); // Найти мин/макс позиции MinPos := 0; MaxPos := 0; for j := 0 to Positions.Count - 1 do begin InterfPosition := TSCSInterfPosition(Positions[j]); if InterfPosition.ToPos > MaxPos then MaxPos := InterfPosition.ToPos; if (InterfPosition.FromPos < MinPos) or (MinPos = 0) then MinPos := InterfPosition.FromPos; end; Positions.Free; if (MinPos <> 0) and (MaxPos <> 0) then begin aNppFrom := Interf.NppPort + MinPos - 1; aNppTo := Interf.NppPort + MaxPos - 1; Result := true; Break; //// BREAK //// end; end; end; end; FreeInterfLists(InterfLists); end; function GetRegroupedNBComponentByInternalConnections(AComponent: TSCSComponent; ANBConections: TSCSObjectList; AIDComponNewOwner: Integer; ANewCompRelPath: TIntList): TSCSComponents; var i, IDConnectedComponent, NppCurrComponent: Integer; RegroupedComponent, ConnectedComponent: TSCSComponent; ptrNBConnection: TSCSCrossConnection; begin Result := TSCSComponents.Create(true); //*** разгруппировка компонент for i := 0 to AComponent.Count - 1 do begin RegroupedComponent := TSCSComponent.Create(AComponent.FActiveForm); Result.Add(RegroupedComponent); RegroupedComponent.Assign(AComponent, false, false); RegroupComponInterfaces(RegroupedComponent); end; ConnectedComponent := TSCSComponent.Create(AComponent.FActiveForm); //*** забить интерфейсы на позициях for i := 0 to ANBConections.Count - 1 do begin ptrNBConnection := TSCSCrossConnection(ANBConections[i]); RegroupedComponent := nil; ConnectedComponent.Clear; //*** определить позицию текущей расматриваемой компоненты и ID подключенной IDConnectedComponent := -1; NppCurrComponent := -1; if ptrNBConnection.IDComponFrom = AComponent.ID then begin if {(ptrNBConnection.IDComponent = AIDComponNewOwner) or} CheckEqualIntLists(ptrNBConnection.FCompRelFromPath, ANewCompRelPath) then begin IDConnectedComponent := ptrNBConnection.IDComponTo; //NppCurrComponent := ptrNBConnection.NppTo; NppCurrComponent := ptrNBConnection.NppFrom; end; end else if ptrNBConnection.IDComponTo = AComponent.ID then begin if {(ptrNBConnection.IDComponent = AIDComponNewOwner) or} CheckEqualIntLists(ptrNBConnection.FCompRelToPath, ANewCompRelPath) then begin IDConnectedComponent := ptrNBConnection.IDComponFrom; //NppCurrComponent := ptrNBConnection.NppFrom; NppCurrComponent := ptrNBConnection.NppTo; end; end; if (IDConnectedComponent <> -1) and (NppCurrComponent <> -1) then begin if (NppCurrComponent >= 0) and (NppCurrComponent <= Result.Count - 1) then RegroupedComponent := Result[NppCurrComponent]; if RegroupedComponent <> nil then begin ConnectedComponent.LoadComponentByID(IDConnectedComponent, false); ConnectedComponent.LoadComponentType; ConnectedComponent.LoadInterfaces(-1, true); RegroupComponInterfaces(ConnectedComponent); ConnectedComponent.SetPortInterfRelInterfaces; RegroupedComponent.JoinToAsNoFinal(ConnectedComponent, -1, -1); end; end; end; FreeAndNil(ConnectedComponent); end; function GetRoomNameShort(ARoom: TSCSCatalog; ARoomNameShortSrcType: TRoomNameShortSrcType; ARoomNameShortDefault, ARoomNameShortIfNoRoom: string): String; begin Result := ''; if ARoom <> nil then begin if ARoom.NameShort <> '' then Result := ARoom.NameShort else if ARoomNameShortSrcType = rnssRoomName then Result := ARoom.Name + IntToStr(ARoom.MarkID) else if ARoomNameShortSrcType = rnssRoomDefStr then Result := ARoomNameShortDefault; end else begin Result := ARoomNameShortIfNoRoom; end; end; function GetTableKindBySCSTreeElType(aTreeElType: TSCSTreeElementType): Integer; begin Result := ctkNone; case aTreeElType of teCatalog: Result := ctkCatalog; teComponent: Result := ctkComponent; end; end; function GetTotalSectionFromTopCables(ATrace: TSCSCatalog): Double; var SCSComponent: TSCSComponent; i: Integer; begin Result := 0; for i := 0 to ATrace.FSCSComponents.Count - 1 do begin SCSComponent := ATrace.FSCSComponents[i]; if IsCableComponent(SCSComponent) then begin Result := Result + SCSComponent.GetVolume(gtMale, '', true); end; end; end; function GetVariousListsIDsByCompons(AComponents: TSCSComponents): TIntList; var i: integer; CurrListID: Integer; begin Result := TIntList.Create; for i := 0 to AComponents.Count - 1 do begin CurrListID := AComponents[i].ListID; if Result.IndexOf(CurrListID) = -1 then Result.Add(CurrListID); end; end; function GetVariousListsIDsByComponsWithWhole(ACatalog: TSCSCatalog; AComponents: TSCSComponents): TIntList; var i, j: Integer; LookedWholeIDs: TIntList; CurrCompon, PartComponent: TSCSComponent; WholeComponent: TSCSComponents; begin Result := TIntList.Create; LookedWholeIDs := TIntList.Create; for i := 0 to AComponents.Count - 1 do begin CurrCompon := AComponents[i]; if Result.IndexOf(CurrCompon.ListID) = -1 then Result.Add(CurrCompon.ListID); if CurrCompon.Whole_ID <> 0 then if LookedWholeIDs.IndexOf(CurrCompon.Whole_ID) = -1 then begin LookedWholeIDs.Add(CurrCompon.Whole_ID); WholeComponent := ACatalog.GetComponentsByWholeID(CurrCompon.Whole_ID); for j := 0 to WholeComponent.Count - 1 do begin PartComponent := WholeComponent[j]; if Result.IndexOf(PartComponent.ListID) = -1 then Result.Add(PartComponent.ListID); end; FreeAndNil(WholeComponent); end; end; FreeAndNil(LookedWholeIDs); end; function GetVariousListsIDsByComponWithWhole(ACatalog: TSCSCatalog; AComponent: TSCSComponent): TIntList; var ComponList: TSCSComponents; begin Result := nil; ComponList := TSCSComponents.Create(false); ComponList.Add(AComponent); Result := GetVariousListsIDsByComponsWithWhole(ACatalog, ComponList); FreeAndNil(ComponList); end; function GetVariousListsIDsByWholeID(AProject: TSCSProject; AWholeID: integer; ANoLookLists: TIntList): TIntList; var i, j: Integer; SCSList: TSCSList; begin Result := TIntList.Create; for i := 0 to AProject.FProjectLists.Count - 1 do begin SCSList := AProject.FProjectLists[i]; if (ANoLookLists = nil) or (ANoLookLists.IndexOf(SCSList.FCurrID) = -1) then for j := 0 to SCSList.FComponentReferences.Count - 1 do begin if SCSList.FComponentReferences[j].Whole_ID = AWholeID then begin Result.Add(SCSList.FCurrID); Break; //// BREAK //// end; end; end; end; function GetVariousListsIDsByObjects(AObjects: TSCSCatalogs; ATakeInRelatedLists: Boolean): TIntList; var i, j, OtherListID: Integer; SCSCatlog: TSCSCatalog; LookComponWholeID: Boolean; SCSComponent: TSCSComponent; ComponsWithWholeID: TSCSComponents; ListsWithWholeID: TIntList; begin Result := TIntList.Create; LookComponWholeID := true; ComponsWithWholeID := TSCSComponents.Create(false); for i := 0 to AObjects.Count - 1 do begin SCSCatlog := AObjects[i]; if Result.IndexOf(SCSCatlog.ListID) = -1 then Result.Add(SCSCatlog.ListID); // Получить ID листов, которые связаны с листом на котором находится SCSCatlog if ATakeInRelatedLists then begin OtherListID := GetOtherListRelatedToFigure(SCSCatlog.ListID, SCSCatlog.SCSID); if OtherListID <> -1 then if Result.IndexOf(OtherListID) = -1 then Result.Add(OtherListID); end; // добавить в список компоненты, в которых определн Whole_ID if LookComponWholeID then if SCSCatlog.ItemType = itSCSLine then for j := 0 to SCSCatlog.ComponentReferences.Count - 1 do begin SCSComponent := TSCSComponent(SCSCatlog.ComponentReferences.FItems.List^[j]); ComponsWithWholeID.Add(SCSComponent); end; end; if LookComponWholeID then if AObjects.Count > 0 then begin ListsWithWholeID := GetVariousListsIDsByComponsWithWhole(AObjects[0].FProjectOwner, ComponsWithWholeID); Result.Assign(ListsWithWholeID, laOr); FreeAndNil(ListsWithWholeID); end; FreeAndNil(ComponsWithWholeID); end; function GroupComponsByProps(ACompons: TSCSComponents; APropSN: TStringList): TObjectList; var i,j,k: integer; Compon, ComponFromGrp: TSCSComponent; ComponProp, ComponFromGrpProp: PProperty; GrpItem, TempGrpItem: TSCSComponents; IsSameProps: Boolean; PropName: String; function CheckComponProps(ACompon: TSCSComponent): Boolean; var i: Integer; begin Result := true; for i := 0 to APropSN.Count - 1 do begin if ACompon.GetPropertyBySysName(APropSN[i]) = nil then begin Result := false; Break; //// BREAK //// end; end; end; begin Result := nil; for i := 0 to ACompons.Count - 1 do begin Compon := ACompons[i]; //if CheckComponProps(Compon) then begin // Ищем группу компонентов подходящую по свойствам GrpItem := nil; if Result <> nil then for j := 0 to Result.Count - 1 do begin TempGrpItem := TSCSComponents(Result[j]); ComponFromGrp := TempGrpItem[0]; IsSameProps := true; for k := 0 to APropSN.Count - 1 do begin PropName := APropSN[k]; ComponProp := Compon.GetPropertyBySysName(PropName); ComponFromGrpProp := ComponFromGrp.GetPropertyBySysName(PropName); if (ComponProp <> nil) or (ComponFromGrpProp <> nil) then begin if ((ComponProp = nil) and (ComponFromGrpProp <> nil)) or ((ComponProp <> nil) and (ComponFromGrpProp = nil)) then IsSameProps := false else if ComponProp^.Value <> ComponFromGrpProp^.Value then IsSameProps := false; if Not IsSameProps then Break; //// BREAK //// end; end; if IsSameProps then begin GrpItem := TempGrpItem; Break; //// BREAK //// end; end; if GrpItem = nil then begin if Result = nil then Result := TObjectList.Create(true); GrpItem := TSCSComponents.Create(false); Result.Add(GrpItem); end; if GrpItem <> nil then GrpItem.Add(Compon); end; end; end; procedure GroupSamePreyscurantsByVariousPrice(AResources: TSCSResources; const APrecision: Integer); var i, j: Integer; ResourceI, ResourceJ: TSCSResourceRel; begin try i := 0; for i := 0 to AResources.Count - 1 do begin ResourceI := AResources[i]; if (ResourceI <> nil) and Not ResourceI.ServIsResource then for j := 0 to AResources.Count - 1 do begin ResourceJ := AResources[j]; if (ResourceJ <> nil) and Not ResourceJ.ServIsResource then begin if (ResourceI.Cypher = ResourceJ.Cypher) and (ResourceI.Name = ResourceJ.Name) and (ResourceI.Izm = ResourceJ.Izm) then if Not CmpFloatByPrecision(ResourceI.Price, ResourceJ.Price, APrecision) then begin if ResourceJ.Price > ResourceI.Price then ResourceI.Price := ResourceJ.Price; ResourceI.Kolvo := ResourceI.Kolvo + ResourceJ.Kolvo; FreeAndNil(ResourceJ); AResources[j] := nil; Break; //// BREAK //// end; end; end; end; AResources.Pack; except on E: Exception do AddExceptionToLogEx('GroupSameResourcesByVariousPrice', E.Message); end; end; procedure FreeInterfLists(var aInterfLists: TInterfLists); begin if Assigned(aInterfLists.InterfList1) then FreeAndNil(aInterfLists.InterfList1); if Assigned(aInterfLists.InterfList2) then FreeAndNil(aInterfLists.InterfList2); end; procedure LoadAllPortsFromComponToList(ACompon: TSCSComponent; ATrgList: TSCSInterfaces; AWithComplects: Boolean); var i: Integer; procedure LoadFromCompon(AFromCompon: TSCSComponent); var i: Integer; Interf: TSCSInterface; begin for i := 0 to AFromCompon.FInterfaces.Count - 1 do begin Interf := AFromCompon.FInterfaces[i]; if Interf.IsPort = biTrue then ATrgList.Add(Interf); end; end; begin LoadFromCompon(ACompon); if AWithComplects then for i := 0 to ACompon.FChildReferences.Count - 1 do LoadFromCompon(ACompon.FChildReferences[i]); end; procedure LoadChildComponObjectIconToList(ACompon: TSCSComponent; AIconList: TObjectList; AGUIDObjectIconTypeToSkip: string); var ChildCompon: TSCSComponent; IconBlk: TMemoryStream; begin ChildCompon := nil; if ACompon.FChildComplects.Count > 0 then ChildCompon := ACompon.FChildComplects[0]; if (ChildCompon <> nil) and ((AGUIDObjectIconTypeToSkip = '') or (ChildCompon.GUIDObjectIcon <> AGUIDObjectIconTypeToSkip)) then begin IconBlk := ChildCompon.GetObjectIconBlk; AIconList.Add(IconBlk); end; end; procedure IncBusyEmptyInterface(AInterface: TSCSInterface; var AEmptyCount, ABusyCount: Integer); begin if AInterface.IsBusy = biTrue then Inc(ABusyCount) else if AInterface.IsBusy = biFalse then Inc(AEmptyCount) else if AInterface.IsBusy = biNone then begin Inc(ABusyCount); Inc(AEmptyCount); end; end; function IsCableComponent(AComponent: TSCSComponent): Boolean; begin Result := (AComponent.ComponentType.SysName = ctsnCable) or (AComponent.ComponentType.SysName = ctsnOFCable) or (AComponent.ComponentType.SysName = ctsnWire); end; function IsComunicationCompon(AComponent: TSCSComponent): Boolean; var SprCompType: TNBComponentType; begin Result := false; SprCompType := AComponent.FProjectOwner.FSpravochnik.GetComponentTypeByGUID(AComponent.GUIDComponentType); // Принадлежит ли тип к ратч-панели или мультипорту if SprCompType <> nil then if IsPatchPanelSysName(SprCompType.ComponentType.SysName) or (SprCompType.ComponentType.PortKind = pkMultiport) then Result := true; end; function IsComunicationComponEx(AComponent: TSCSComponent): Boolean; var SprCompType: TNBComponentType; begin Result := false; SprCompType := AComponent.FProjectOwner.FSpravochnik.GetComponentTypeByGUID(AComponent.GUIDComponentType); // Принадлежит ли тип к ратч-панели или мультипорту if SprCompType <> nil then if (SprCompType.ComponentType.SysName = ctsnCupboard) or (SprCompType.ComponentType.SysName = ctsnBox) or IsPatchPanelSysName(SprCompType.ComponentType.SysName) or (SprCompType.ComponentType.PortKind = pkMultiport) then Result := true; end; function IsPatchPanelSysName(const ASysName: String): Boolean; begin //01.02.2011 Result := (ASysName = ctsn19InchPanel) or (ASysName = ctsnPatchPanel) or (ASysName = ctsnTerminalBloc); Result := GCompTypeSysNamePanels.IndexOf(ASysName) <> -1; end; function IsReadOnlyProp(AItemType: Integer; AProperty: PProperty): Boolean; begin Result := false; if AProperty <> nil then begin if AProperty.SysName = pnLength then Result := true else if AProperty.SysName = pnHeightRoom then Result := true else if AProperty.SysName = pnHeightCeiling then Result := true else if AProperty.SysName = pnHeightSocket then Result := true else if AProperty.SysName = pnHeightCorob then Result := true else if AProperty.SysName = pnHeightSide1 then Result := true else if AProperty.SysName = pnHeightSide2 then Result := true else if AProperty.SysName = pnLengthKoef then Result := true else if AProperty.SysName = pnPortReserv then Result := true else if AProperty.SysName = pnMultiPortReserv then Result := true else if AProperty.SysName = pnLengthProj then begin //10.05.2012 для ребра крыши блокируем редактирование длины проекции if AItemType = itArhRoofHip then Result := true; end; if Not Result then if GPropRequired.IndexOf(AProperty.SysName) <> -1 then Result := true; if Not Result then begin if IsComponItemType(AItemType) then begin if IsArchComponByItemType(AItemType) then begin if AProperty.SysName = pnSquare then Result := true else if (AProperty.SysName = pnWidth) or (AProperty.SysName = pnWidthOut) then begin //if AItemType in [itArhWall, itArhWallDivision] then if AItemType in [itArhWallDivision] then Result := true; end; end else begin if AProperty.SysName = pnCoordZ then Result := true; end; end else if IsCatalogItemType(AItemType) then begin if AProperty.SysName = pnCoordZ then Result := true; end; end; end; end; function IsPosRangesIntersect(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer): Boolean; var RFrom, RTo: Integer; begin Result := false; GetPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo, RFrom, RTo); if (RFrom <> 0) and (RTo <> 0) then Result := true; end; function IsSelectedComponFigure(aCompon: TSCSComponent): Boolean; var ComponObj: TSCSCatalog; begin Result := false; ComponObj := aCompon.GetFirstParentCatalog; if ComponObj <> nil then Result := IsSelectedFigure(ComponObj.ListID, ComponObj.SCSID); end; function IsTrunkComponent(AComponent: TSCSComponent): Boolean; var CurrComponent: TSCSComponent; begin Result := false; CurrComponent := AComponent; while CurrComponent <> nil do begin Result := CheckSysNameIsTrunk(CurrComponent.ComponentType.SysName); if Result = true then begin Break; //// BREAK //// end else begin if CurrComponent.FParent is TSCSComponent then CurrComponent := TSCSComponent(CurrComponent.FParent) else CurrComponent := nil; end; end; end; function IsVisibleInterfaceByFilter(AInterface: TSCSInterface; AFilterBlock: TFilterBlock): Boolean; var i: Integer; ChildFilterBlock: TFilterBlock; begin Result := false; if (AFilterBlock = nil) or Not AFilterBlock.IsOn then Result := true else begin for i := 0 to AFilterBlock.AllChildBlocks.Count - 1 do begin ChildFilterBlock := AFilterBlock.AllChildBlocks[i]; if (ChildFilterBlock.Condition <> nil) and (ChildFilterBlock.CheckIsOnUp) then begin // Если индек не определен, то определяем его if ChildFilterBlock.Condition.FieldIndex = 0 then begin if ChildFilterBlock.Condition.FieldName = fnGuidInterface then ChildFilterBlock.Condition.FieldIndex := ffFunctionalInterface else if ChildFilterBlock.Condition.FieldName = fnGuidPort then ChildFilterBlock.Condition.FieldIndex := ffPort else if ChildFilterBlock.Condition.FieldName = fnConnected then ChildFilterBlock.Condition.FieldIndex := ffConnected else if ChildFilterBlock.Condition.FieldName = fnNoConnected then ChildFilterBlock.Condition.FieldIndex := ffNoConnected; end; case ChildFilterBlock.Condition.FieldIndex of ffFunctionalInterface: begin if AInterface.IsPort = biFalse then ChildFilterBlock.Condition.FieldValue := AInterface.GUIDInterface else ChildFilterBlock.Condition.FieldValue := ''; end; ffPort: begin if AInterface.IsPort = biTrue then ChildFilterBlock.Condition.FieldValue := AInterface.GUIDInterface else ChildFilterBlock.Condition.FieldValue := ''; end; ffConnected: begin if AInterface.KolvoBusy > 0 then ChildFilterBlock.Condition.FieldValue := bsTrue else ChildFilterBlock.Condition.FieldValue := bsFalse; end; ffNoConnected: begin if AInterface.KolvoBusy > 0 then ChildFilterBlock.Condition.FieldValue := bsFalse else ChildFilterBlock.Condition.FieldValue := bsTrue; end; else ChildFilterBlock.Condition.FieldValue := ''; end; end; end; if AFilterBlock.Execute then Result := true; end; end; procedure LoadMarkTemplateObjectsToList(const ASrcTemplate: String; ATrgList: TList); var i, ObjectMinIndexLength, Letter, ObjectRadix, Len, ClosePos: Integer; //Len: Integer; CurrChar, PrevChar, ObjBeginBracket, ObjectPrefix: Char; CursorInObject, CursorInParamName, CursorInParamValue, CursorToSimpleText: Boolean; NewMark, SimpleText, ObjectParamName, ObjectParamValue, BlockContent: String; MarkTemplateObj, PrevMarkTemplateObj: TMarkTemplateObj; begin try ATrgList.Clear; CurrChar := #0; PrevChar := #0; CursorInObject := false; ObjBeginBracket := #0; SimpleText := ''; ObjectMinIndexLength := 0; Letter := biFalse; ObjectRadix := 0; i := 1; Len := Length(ASrcTemplate); while i <= Len do begin PrevChar := CurrChar; CurrChar := ASrcTemplate[i]; if Not CursorInObject then begin if CurrChar = '#' then begin ObjBeginBracket := #0; if PrevChar = '<' then begin ObjBeginBracket := PrevChar; SetLength(SimpleText, Length(SimpleText)-1); end; CursorInObject := true; CursorInParamName := false; CursorInParamValue := false; ObjectPrefix := #0; ObjectMinIndexLength := 0; Letter := biFalse; ObjectRadix := 0; ObjectParamName := ''; ObjectParamValue := ''; end else begin //Парсинг свойства if CurrChar = '[' then begin ClosePos := PosEx(']', ASrcTemplate, i+1); if ClosePos <> 0 then begin if PosEx('TAG_', ASrcTemplate, i+1) = i+1 then begin BlockContent := Copy(ASrcTemplate, i+5, ClosePos-i-5); if BlockContent <> '' then begin MarkTemplateObj := TMarkTemplateObj.Create; MarkTemplateObj.FTagPropName := BlockContent; MarkTemplateObj.FBeforeText := SimpleText; //MarkTemplateObj.FObjPrefix := #0; //MarkTemplateObj.FMinIndexLength := 0; //MarkTemplateObj.FLetter := biFalse; ATrgList.Add(MarkTemplateObj); SimpleText := ''; i := ClosePos + 1; Continue; //// CONTINUE //// end; end; end; end; SimpleText := SimpleText + CurrChar; end; end else begin CursorToSimpleText := false; if PrevChar = '#' then begin ObjectPrefix := CurrChar; // Если небыло откр скобки, то создаем объект и читаем обычный текст if ObjBeginBracket = #0 then CursorToSimpleText := true; end; // Если были откр скобки, и текущая скобка закрывающая то создаем объект и читаем обычный текст if ObjBeginBracket <> #0 then if CurrChar = '>' then CursorToSimpleText := true; // Если закончено чтение блока объекта, или шло чтение значения параметра после которого пробел // то значение параметра заносим в переменную if CursorToSimpleText or (CursorInParamValue and (CurrChar = ' ')) then begin ObjectParamName := AnsiUpperCase(ObjectParamName); if ObjectParamName = AnsiUpperCase(mtMinLength) then ObjectMinIndexLength := StrToIntDef(ObjectParamValue, 0) else if ObjectParamName = AnsiUpperCase(mtLetter) then Letter := StrToIntDef(ObjectParamValue, 0) else if ObjectParamName = AnsiUpperCase(mtRadix) then ObjectRadix := StrToIntDef(ObjectParamValue, 0) end; if ObjectPrefix <> #0 then if Not CursorToSimpleText then begin // пропускаем пробелы if CurrChar <> ' ' then begin if CurrChar = '=' then begin CursorInParamName := false; CursorInParamValue := true; end else if CursorInParamName then ObjectParamName := ObjectParamName + CurrChar else if CursorInParamValue then ObjectParamValue := ObjectParamValue + CurrChar; end else if CursorInObject then begin CursorInParamName := true; ObjectParamName := ''; ObjectParamValue := ''; end; end else begin MarkTemplateObj := TMarkTemplateObj.Create; MarkTemplateObj.FBeforeText := SimpleText; MarkTemplateObj.FObjPrefix := ObjectPrefix; MarkTemplateObj.FMinIndexLength := ObjectMinIndexLength; MarkTemplateObj.FLetter := Letter; MarkTemplateObj.FRadix := ObjectRadix; ATrgList.Add(MarkTemplateObj); CursorInObject := false; ObjBeginBracket := #0; SimpleText := ''; end; if PrevChar in ['#'] then CursorInParamName := true; end; Inc(i); end; // Если блоков больше 1, то из FBeforeText переносим в FAfterText, кроме 1-го элемента if ATrgList.Count > 1 then begin MarkTemplateObj := nil; for i := 0 to ATrgList.Count - 1 do begin PrevMarkTemplateObj := MarkTemplateObj; MarkTemplateObj := TMarkTemplateObj(ATrgList.List^[i]); if (i >= 1) and (PrevMarkTemplateObj <> nil) then begin PrevMarkTemplateObj.FAfterText := PrevMarkTemplateObj.FAfterText + MarkTemplateObj.FBeforeText; MarkTemplateObj.FBeforeText := ''; end; end; end; // Если после вычитки всех блоков остался текст if SimpleText <> '' then begin MarkTemplateObj := nil; if ATrgList.Count > 0 then MarkTemplateObj := TMarkTemplateObj(ATrgList.List^[ATrgList.Count-1]) else begin MarkTemplateObj := TMarkTemplateObj.Create; ATrgList.Add(MarkTemplateObj); end; MarkTemplateObj.FAfterText := SimpleText; end; except on E: Exception do AddExceptionToLog('LoadMarkTemplateObjectsToList: '+E.Message); end; end; procedure LoadPartIOfIRelsToList(AInterface: TSCSInterface; AMainIOfIRel: TSCSIOfIRel; AList: TRapList); var i: Integer; IOfIRel: TSCSIOfIRel; begin for i := 0 to AInterface.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(AInterface.FIOfIRelOut[i]); if (IOfIRel.IDIOFIRelMain = AMainIOfIRel.ID) or (AMainIOfIRel.IDIOFIRelMain = IOfIRel.ID) then if AList.IndexOf(IOfIRel) = -1 then AList.Add(IOfIRel); end; end; function MakeEditPropertyForWholeComponent(AMakeEdit: TMakeEdit; AComponent: TSCSComponent; AProperty: PProperty): Boolean; var MakeEdit: TMakeEdit; WholeComponents: TSCSComponents; i, SavedID: Integer; PartComponent: TSCSComponent; ptrPartProperty: PProperty; OldValue: String; begin Result := false; MakeEdit := AMakeEdit; if AComponent.FProjectOwner <> nil then if (AComponent.IsLine = biTrue) and (AProperty.IsForWholeComponent = biTrue) then begin WholeComponents := AComponent.FProjectOwner.GetComponentsByWholeID(AComponent.Whole_ID); for i := 0 to WholeComponents.Count - 1 do begin PartComponent := WholeComponents[i]; if PartComponent <> AComponent then begin ptrPartProperty := nil; if MakeEdit = meMake then ptrPartProperty := PartComponent.GetPropertyAsNew else if MakeEdit = meEdit then begin ptrPartProperty := PartComponent.GetPropertyBySysName(AProperty.SysName); if ptrPartProperty = nil then begin ptrPartProperty := PartComponent.GetPropertyAsNew; MakeEdit := meMake; end; end; if ptrPartProperty <> nil then begin OldValue := ptrPartProperty.Value; SavedID := ptrPartProperty.ID; ptrPartProperty^ := AProperty^; ptrPartProperty.ID := SavedID; ptrPartProperty.IDMaster := PartComponent.ID; PartComponent.SaveProperty(MakeEdit, ptrPartProperty); if OldValue <> ptrPartProperty.Value then DefineComponNormResByProperty(PartComponent, ptrPartProperty); TF_Main(PartComponent.FActiveForm).OnChangeComponPropertyVal(ptrPartProperty, PartComponent); Result := true; end; end; end; FreeAndNil(WholeComponents); end; end; function MakeMarkMaskForComponByBlocks(AProj, AList, ARoom, AObj, ATopCompon, AParentCompon, ACompon, APort: Integer; const AComponNameShort, ARoomSign: String; aComponObj: TSCSComponent; ABlocks: TObjectList): String; var i, StrDivPos: Integer; MarkTemplateObj: TMarkTemplateObj; PropSysName, PropVal: String; ComponProp: PProperty; // Tolik -- 19/09/2016-- ComponFigure, ObjFigure: Tfigure; ComponCatalog: TSCSCatalog; ObjCAD: TF_CAD; // begin Result := ''; for i := 0 to ABlocks.Count - 1 do begin MarkTemplateObj := TMarkTemplateObj(ABlocks.List^[i]); if MarkTemplateObj.FObjPrefix <> #0 then begin Result := Result + MarkTemplateObj.FBeforeText; case MarkTemplateObj.FObjPrefix of 'p': //, 'P': //*** Проект Result := Result + MarkTemplateObj.IndexToStr(AProj); //IntToStrF(AProj, MarkTemplateObj.FMinIndexLength); 'l': //, 'L': //*** Лист Result := Result + MarkTemplateObj.IndexToStr(AList); //IntToStrF(AList, MarkTemplateObj.FMinIndexLength); 'r': //, 'R': //*** Комната begin if (ARoomSign <> '') and (MarkTemplateObj.FLetter = biTrue) then Result := Result + ARoomSign else Result := Result + MarkTemplateObj.IndexToStr(ARoom); end; 'o': //, 'O': //*** Объект Result := Result + MarkTemplateObj.IndexToStr(AObj); //IntToStrF(AObj, MarkTemplateObj.FMinIndexLength); 'C': //*** Верхний компонент Result := Result + MarkTemplateObj.IndexToStr(ATopCompon); //IntToStrF(ATopCompon, MarkTemplateObj.FMinIndexLength); 'P': //*** Родительский компонент Result := Result + MarkTemplateObj.IndexToStr(AParentCompon); //IntToStrF(AParentCompon, MarkTemplateObj.FMinIndexLength); 'c': //, 'C': //*** Компонент Result := Result + MarkTemplateObj.IndexToStr(ACompon); //IntToStrF(ACompon, MarkTemplateObj.FMinIndexLength); 't': //, 'T': //*** Порт Result := Result + MarkTemplateObj.IndexToStr(APort); //IntToStrF(APort, MarkTemplateObj.FMinIndexLength); 's': //, 'S': Result := Result + AComponNameShort; end; Result := Result + MarkTemplateObj.FAfterText; end else begin if MarkTemplateObj.FTagPropName <> '' then begin PropVal := ''; if aComponObj = nil then PropVal := MarkTemplateObj.FTagPropName else begin if aComponObj.FParent = nil then PropVal := MarkTemplateObj.FTagPropName else begin PropSysName := MarkTemplateObj.FTagPropName; if PropSysName = 'G_LENGTH' then begin PropVal := FloatToStr(RoundCP(FloatInUOM(aComponObj.GetFirstParentCatalog.GetPropertyValueAsFloat(pnLength), umM, TF_Main(aComponObj.FActiveForm).FUOM))); end // Tolik -- 19/09/2016-- по просьбам трудящихся -- высота размещения else if PropSysName = 'G_HEIGHT' then begin //PropVal := FloatToStr(RoundCP(FloatInUOM(aComponObj.GetFirstParentCatalog.GetPropertyValueAsFloat(pnHeight), umM, TF_Main(aComponObj.FActiveForm).FUOM))); //PropVal := FloatToStr(RoundCP(FloatInUOM(aComponObj.GetFirstParentCatalog.GetPropertyValueAsFloat(pnHeightOfPlacing), umM, TF_Main(aComponObj.FActiveForm).FUOM))); ComponCatalog := aComponObj.GetFirstParentCatalog; if (ComponCatalog <> nil) and (ComponCatalog.IsLine = biFalse) then begin ObjCAD := GetListByID(ComponCatalog.ListID); if ObjCAD <> nil then begin ObjFigure := nil; ObjFigure := getFigureByID(ObjCad, ComponCatalog.SCSID); if ObjFigure <> nil then PropVal := FloatToStr(RoundCP(FloatInUOM(TConnectorObject(ObjFigure).ActualZOrder[1], umM, TF_Main(aComponObj.FActiveForm).FUOM))); end; end; end else if PropSysName = 'ADDTAG' then begin try PropVal := F_PRojMan.GSCSBase.CurrProject.Setting.TagAdd; except end; end else begin //if PropSysName = 'MT' then // PropSysName := 'MATERIAL'; ComponProp := aComponObj.GetPropertyBySysName(PropSysName); if ComponProp <> nil then begin case ComponProp^.IDDataType of dtString: begin StrDivPos := Pos(':', ComponProp^.Value); if StrDivPos > 1 then PropVal := Copy(ComponProp^.Value, 1, StrDivPos-1) else PropVal := ComponProp^.Value; end; dtFloat: PropVal := PropValToStr(ComponProp); dtBoolean: PropVal := BoolToStrL(IntToBool(StrToInt(ComponProp^.Value))); else PropVal := ComponProp^.Value; end; end; end; end; end; if PropVal <> '' then begin Result := Result + MarkTemplateObj.FBeforeText; Result := Result + PropVal; Result := Result + MarkTemplateObj.FAfterText; end; end; end; end; end; function MakeNameMarkForComponByPortNum(AObject, AList: TSCSCatalog; ACompon: TSCSComponent; APortNum: Integer; const AMarkMask: String; ATemplateObjects: TObjectList): String; var MRoom, MObj, MTopCompon, MParentCompon: Integer; Room: TSCSCatalog; TmpComponent: TSCSComponent; TemplateObjects: TObjectList; CreatedTemplateObjects: Boolean; MRoomSign: string; begin Result := ''; if AMarkMask <> '' then begin MTopCompon := 0; MParentCompon := 0; CreatedTemplateObjects := false; TemplateObjects := ATemplateObjects; if TemplateObjects = nil then begin TemplateObjects := TObjectList.Create(true); LoadMarkTemplateObjectsToList(AMarkMask, TemplateObjects); CreatedTemplateObjects := true; end; MRoom := 0; MRoomSign := ''; Room := AObject.GetParentCatalogByItemType(itRoom); if Assigned(Room) then begin if Room.NameShort <> '' then MRoomSign := Room.NameShort; MRoom := Room.MarkID; end else MRoomSign := '-'; MObj := -1; if AObject.IndexPointObj > 0 then MObj := AObject.IndexPointObj; if AObject.IndexConnector > 0 then MObj := AObject.IndexConnector; if AObject.IndexLine > 0 then MObj := AObject.IndexLine; // Индкс верхней компоненты if Pos(mteTopCompon, AMarkMask) <> 0 then begin TmpComponent := ACompon.GetTopComponent; if TmpComponent <> nil then MTopCompon := TmpComponent.MarkID; end; // Индкс родительского компонента if Pos(mteParentCompon, AMarkMask) <> 0 then begin TmpComponent := ACompon.GetParentComponent; if TmpComponent <> nil then MParentCompon := TmpComponent.MarkID; end; //Result := MakeMarkMaskForComponent(ACompon.FProjectOwner.MarkID, AList.MarkID, MRoom, MObj, MTopCompon, ACompon.MarkID, APortNum, ACompon.NameShort, ASprCompType.ComponentType.MarkMask); //ASprCompType.DefineMarkTemplateObjects; Result := MakeMarkMaskForComponByBlocks(AObject.FProjectOwner.MarkID, AList.MarkID, MRoom, MObj, MTopCompon, MParentCompon, ACompon.MarkID, APortNum, ACompon.NameShort, MRoomSign, ACompon, TemplateObjects); if CreatedTemplateObjects then TemplateObjects.Free; end; end; function MakeNameMarkThroughCableTIAEIA606A(ACable, AJoinedPoint: TSCSComponent): String; var ProjectOwner: TSCSProject; WholeLineCompon: TWholeLineCompon; ComunicationComponent1, ComunicationComponent2, ComunicationComponent, ConnectedConnCompon, LineJoinedToComunication: TSCSComponent; IDLineJoinedToComunication: Integer; SCSCatalog, RoomOwner, RoomOwner2, ListOwner, ListOwner2: TSCSCatalog; RoomMark, RoomMark2, ListMark, ListMark2, ComunicationPortMark: String; ComunicationPort: TSCSInterface; ComunicationPortNpp: Integer; LastConnectedConnCompon, FirstConnectedConnCompon: TSCSComponent; begin Result := ''; if ACable.IsLine = biTrue then begin WholeLineCompon := GetLineComponsInTraceFromBase(ACable, false); ProjectOwner := ACable.FProjectOwner; LastConnectedConnCompon := nil; FirstConnectedConnCompon := nil; if WholeLineCompon.LastIDConnectedConnCompon <> 0 then LastConnectedConnCompon := ProjectOwner.GetComponentFromReferences(WholeLineCompon.LastIDConnectedConnCompon); if WholeLineCompon.FirstIDConnectedConnCompon <> 0 then FirstConnectedConnCompon := ProjectOwner.GetComponentFromReferences(WholeLineCompon.FirstIDConnectedConnCompon); // Определить поделюченные комуникационные компоненты ComunicationComponent1 := nil; ComunicationComponent2 := nil; ComunicationComponent := nil; IDLineJoinedToComunication := -1; ConnectedConnCompon := nil; if (LastConnectedConnCompon <> nil) and (LastConnectedConnCompon <> AJoinedPoint) then ComunicationComponent1 := GetParentComunicationCompon(LastConnectedConnCompon); if (FirstConnectedConnCompon <> nil) and (FirstConnectedConnCompon <> AJoinedPoint) then ComunicationComponent2 := GetParentComunicationCompon(FirstConnectedConnCompon); RoomOwner := nil; ListOwner := nil; RoomMark := ''; ListMark := ''; RoomOwner2 := nil; ListOwner2 := nil; RoomMark2 := ''; ListMark2 := ''; if (ComunicationComponent1 <> nil) and (ComunicationComponent2 <> nil) then begin // Получаем объекты компоненты и их обозначения GetComponObjectsMark(ComunicationComponent1, RoomOwner, ListOwner, RoomMark, ListMark, ProjectOwner.Setting.RoomNameShortSrcType, ProjectOwner.Setting.RoomNameShortDefault, ProjectOwner.Setting.RoomNameShortIfNoRoom); GetComponObjectsMark(ComunicationComponent2, RoomOwner2, ListOwner2, RoomMark2, ListMark2, ProjectOwner.Setting.RoomNameShortSrcType, ProjectOwner.Setting.RoomNameShortDefault, ProjectOwner.Setting.RoomNameShortIfNoRoom); if (ListMark+RoomMark) < (ListMark2+RoomMark2) then Result := ListMark + RoomMark +'/'+ ListMark2 + RoomMark2 else Result := ListMark2 + RoomMark2 +'/'+ ListMark + RoomMark; Result := Result +'-'+IntToStr(ACable.MarkID); end else begin if ComunicationComponent1 <> nil then begin ComunicationComponent := ComunicationComponent1; IDLineJoinedToComunication := WholeLineCompon.LastIDCompon; ConnectedConnCompon := LastConnectedConnCompon; end else if ComunicationComponent2 <> nil then begin ComunicationComponent := ComunicationComponent2; IDLineJoinedToComunication := WholeLineCompon.FirstIDCompon; ConnectedConnCompon := FirstConnectedConnCompon; end; if ComunicationComponent <> nil then begin LineJoinedToComunication := ProjectOwner.GetComponentFromReferences(IDLineJoinedToComunication); // Получаем объекты компоненты и их обозначения GetComponObjectsMark(ComunicationComponent, RoomOwner, ListOwner, RoomMark, ListMark, ProjectOwner.Setting.RoomNameShortSrcType, ProjectOwner.Setting.RoomNameShortDefault, ProjectOwner.Setting.RoomNameShortIfNoRoom); // Получаем порт панели, к которой подключен кабель ComunicationPort := nil; ComunicationPortMark := ' '; if LineJoinedToComunication <> nil then ComunicationPort := ConnectedConnCompon.GetPortJoinedToLine(LineJoinedToComunication); if ComunicationPort <> nil then begin //ComunicationPortNpp := ComunicationPort.NppPort; ComunicationPortNpp := GetNppPortByJoinedCompon(ComunicationPort, LineJoinedToComunication); ComunicationPortMark := IntToStrF(ComunicationPortNpp, 2); end else ComunicationPortMark := IntToStrF(ConnectedConnCompon.MarkID, 2); Result := ListMark + RoomMark +'-'+ ComunicationComponent.NameMark + ComunicationPortMark; end; end; end; end; procedure MoveSCSTreeObject(ASrcObject, ATrgObject: TSCSComponCatalogClass); var SrcCatalog, SrcParentCatalog, TrgCatalog: TSCSCatalog; begin SrcCatalog := nil; TrgCatalog := nil; //*** Компонент в компонент if (ASrcObject is TSCSComponent) and (ATrgObject is TSCSComponent) then begin end else //*** Компонент в папку if (ASrcObject is TSCSComponent) and (ATrgObject is TSCSCatalog) then begin end else //*** Папка в Папку if (ASrcObject is TSCSCatalog) and ((ATrgObject is TSCSList) or (ATrgObject is TSCSCatalog) or (ATrgObject is TSCSComponent)) then begin SrcCatalog := TSCSCatalog(ASrcObject); SrcParentCatalog := TSCSCatalog(SrcCatalog.FParent); if ATrgObject is TSCSCatalog then TrgCatalog := TSCSCatalog(ATrgObject) else if ATrgObject is TSCSComponent then TrgCatalog := TSCSComponent(ATrgObject).GetFirstParentCatalog; if TrgCatalog <> nil then begin if SrcParentCatalog = TrgCatalog then Exit; ///// EXIT ///// if (TrgCatalog.FTreeViewNode <> nil) and (SrcCatalog.FTreeViewNode = nil) then SrcCatalog.FTreeViewNode := TF_Main(SrcCatalog.FActiveForm).FindComponOrDirInTree(SrcCatalog.ID, false); if SrcParentCatalog <> nil then SrcParentCatalog.RemoveChildCatalog(SrcCatalog); TrgCatalog.AddChildCatalog(SrcCatalog); if (SrcCatalog.FTreeViewNode <> nil) and (TrgCatalog.FTreeViewNode <> nil) then begin TF_Main(SrcCatalog.FActiveForm).MoveNodeTo(SrcCatalog.FTreeViewNode, TrgCatalog.FTreeViewNode, naAddChild); end; if SrcCatalog.FProjectOwner <> nil then begin SrcCatalog.FProjectOwner.ReindexPointComponentsAfterChangeCatalogOwner(SrcCatalog, SrcParentCatalog); RemarkObjectComponsAfterChangeRoom(SrcCatalog); end; // не нужно проверять, нужно для всех делать, иначе при удалении кабинета // для точечных не произойдет DefineObjectParams //if SrcCatalog.ItemType = itSCSLine then TF_Main(SrcCatalog.FActiveForm).F_ChoiceConnectSide.DefineObjectParamsInFuture(SrcCatalog); end; end; end; procedure MoveInterfWithCommonKolvoToBegin(ADestInterfaces, AInterfacesWithCommonKolvo: TSCSInterfaces); var i, j, LastInterfindex: Integer; InterfI, InterfJ: TSCSInterface; FindedProperInterf: Boolean; begin i := 0; LastInterfindex := ADestInterfaces.Count - 1; while i <= LastInterfindex do begin InterfI := TSCSInterface(ADestInterfaces.FItems.List^[i]); //ADestInterfaces[i]; //*** Найти однотипный интерфейс с таким же количеством FindedProperInterf := false; if InterfI.KolvoBusy = 0 then for j := 0 to AInterfacesWithCommonKolvo.Count - 1 do begin InterfJ := TSCSInterface(AInterfacesWithCommonKolvo.FItems.List^[j]); //AInterfacesWithCommonKolvo[j]; if (InterfJ.KolvoBusy = 0) and (InterfI.Kolvo = InterfJ.Kolvo) and TF_Main(InterfI.FActiveForm).CheckInterf(InterfI, InterfJ, cntNone, nil, nil) then begin FindedProperInterf := true; Break; //// BREAK //// end; end; if Not FindedProperInterf then begin //*** Переместить в конец ADestInterfaces.Delete(i); ADestInterfaces.Add(InterfI); LastInterfindex := LastInterfindex - 1; end else i := i + 1; end; end; procedure PrepareInterfPositionsByRegion(APositions: TSCSInterfPositions; AFrom, ATo: Integer); var i: Integer; CurrPosition, NewPosition: TSCSInterfPosition; PositionsToRemove: TRapList; begin try if AFrom <= ATo then begin PositionsToRemove := TRapList.Create; i := 0; while i <= APositions.FPositions.Count - 1 do begin CurrPosition := TSCSInterfPosition(APositions.FPositions[i]); // Если значение AFrom между CurrPosition.FromPos и CurrPosition.ToPos if (CurrPosition.FromPos < AFrom) and (AFrom <= CurrPosition.ToPos) then begin // NewPositionбудет находится перед AFrom NewPosition := TSCSInterfPosition.Create(CurrPosition.FInterfOwner); NewPosition.FromPos := CurrPosition.FromPos; NewPosition.ToPos := AFrom - 1; PositionsToRemove.Add(NewPosition); CurrPosition.FromPos := AFrom; APositions.FPositions.Insert(i, NewPosition); i := i+1; end; // Если значение ATo между CurrPosition.FromPos и CurrPosition.ToPos if (CurrPosition.FromPos <= ATo) and (ATo < CurrPosition.ToPos) then begin // NewPositionбудет находится после ATo NewPosition := TSCSInterfPosition.Create(CurrPosition.FInterfOwner); NewPosition.FromPos := ATo + 1; NewPosition.ToPos := CurrPosition.ToPos; CurrPosition.ToPos := ATo; APositions.FPositions.Insert(i+1, NewPosition); end; // (Если CurrPosition.FromPos и CurrPosition.ToPos меньше AFrom) ИЛИ // (Если CurrPosition.FromPos и CurrPosition.ToPos больше ATo) if ((CurrPosition.FromPos < AFrom) and (CurrPosition.ToPos < AFrom)) or ((CurrPosition.FromPos > ATo) and (CurrPosition.ToPos > ATo)) then begin if PositionsToRemove.IndexOf(CurrPosition) = -1 then PositionsToRemove.Add(CurrPosition); end; i := i + 1; end; for i := 0 to PositionsToRemove.Count - 1 do begin CurrPosition := TSCSInterfPosition(PositionsToRemove[i]); APositions.FPositions.Remove(CurrPosition); CurrPosition.Free; end; FreeAndNil(PositionsToRemove); APositions.DefineKolvo; end; except on E: Exception do AddExceptionToLogEx('PrepareInterfPositionsByRegion', E.Message); end; end; procedure RefreshCatalogComponsLengthInFuture(ALineObject: TSCSCatalog); var i: integer; begin if ALineObject.ItemType = itSCSLine then for i := 0 to ALineObject.FComponentReferences.Count - 1 do ALineObject.FComponentReferences[i].RefreshWholeLengthInFuture; end; procedure RefreshLengthInFutureJoinedToPointComponent(APointComponent: TSCSComponent); var i: Integer; JoinedComponent: TSCSComponent; begin if (APointComponent <> nil) and (APointComponent.IsLine = biFalse) then for i := 0 to APointComponent.FJoinedComponents.Count - 1 do begin JoinedComponent := APointComponent.FJoinedComponents[i]; if JoinedComponent.IsLine = biTrue then JoinedComponent.RefreshWholeLengthInFuture; end; end; procedure RefreshLengthInFutureNearPointObject(APointObject: TSCSCatalog); var ConnectedLineIDs: TIntList; ListOwner: TSCSList; LineObject: TSCSCatalog; i: Integer; begin if (APointObject <> nil) and (APointObject.ItemType = itSCSConnector) then begin ConnectedLineIDs := GetAllConnectedTracesID(APointObject.ListID, APointObject.SCSID); if ConnectedLineIDs.Count > 0 then begin ListOwner := APointObject.GetListOwner; if ListOwner <> nil then for i := 0 to ConnectedLineIDs.Count - 1 do begin LineObject := ListOwner.GetCatalogFromReferencesBySCSID(ConnectedLineIDs[i]); if LineObject <> nil then if Not LineObject.ServDeleting then RefreshCatalogComponsLengthInFuture(LineObject); end; end; FreeAndNil(ConnectedLineIDs); end; end; procedure RegroupComponInterfaces(AComponent: TSCSComponent); var i, j, OldInterfCount: Integer; Interf, NewInterf: TSCSInterface; begin i := 0; OldInterfCount := AComponent.FInterfaces.Count; while i <= OldInterfCount - 1 do begin Interf := AComponent.FInterfaces[i]; if Interf.Kolvo > 1 then begin for j := 1 to Interf.Kolvo - 1 do begin NewInterf := TSCSInterface.Create(Interf.FActiveForm); NewInterf.Assign(Interf, true); NewInterf.Kolvo := 1; // Tolik 09/02/2018 -- если не прописать владельца -- дальше писец, оставшиеся свободные никуда не подключаются if Interf.ComponentOwner = Nil then begin NewInterf.ComponentOwner := AComponent; AddExceptionToLogSilent('Interface Has NO OwnerComponent! Component.Name = ' + AComponent.Name + ', Interf.Npp = ' + Inttostr(Interf.Npp) + ', Interf.Side = ' + Inttostr(Interf.Side)); end else begin NewInterf.ComponentOwner := Interf.ComponentOwner; if Interf.ComponentOwner <> AComponent then AddExceptionToLogSilent('Interface Has Another OwnerComponent! Component.Name = ' + AComponent.Name + ', Interf.Npp = ' + Inttostr(Interf.Npp) + ', Interf.Side = ' + Inttostr(Interf.Side) + 'Interface.ComponentOwner.Name = ' + Interf.ComponentOwner.Name); end; // AComponent.FInterfaces.Add(NewInterf); end; Interf.Kolvo := 1; end; Inc(i); end; end; //*** Разбивает пары позиций по одинаковым количествам procedure RegroupInterfPositionsToConnect(AEmptyPositions1, AEmptyPositions2: TSCSInterfPositions); var SmallerPositions, LergerPositions: TSCSInterfPositions; PositionFromSmall, PositionFromLarge, DevidedRestPositionFromSmall, DevidedRestPositionFromLarge: TSCSInterfPosition; ReservedPositionsFromLarge: TList; KolvoFromSmall, KolvoFromLarge, KolvoRestFromLarge, i, j: Integer; FindedPositionFromLarge: Boolean; begin if (AEmptyPositions1 <> nil) and (AEmptyPositions2 <> nil) then begin SmallerPositions := nil; LergerPositions := nil; if AEmptyPositions1.Kolvo > AEmptyPositions2.Kolvo then begin SmallerPositions := AEmptyPositions2; LergerPositions := AEmptyPositions1; end else begin SmallerPositions := AEmptyPositions1; LergerPositions := AEmptyPositions2; end; if (SmallerPositions <> nil) and (LergerPositions <> nil) then begin ReservedPositionsFromLarge := TList.Create; //*** Разбить позиции по количествам i := 0; while i <= SmallerPositions.FPositions.Count - 1 do begin PositionFromSmall := TSCSInterfPosition(SmallerPositions.FPositions[i]); KolvoFromSmall := PositionFromSmall.ToPos - (PositionFromSmall.FromPos - 1); //*** Найти подходящиую по количеству позиции FindedPositionFromLarge := false; for j := i to LergerPositions.FPositions.Count - 1 do begin PositionFromLarge := TSCSInterfPosition(LergerPositions.FPositions[j]); if (PositionFromLarge.ToPos - (PositionFromLarge.FromPos - 1)) = KolvoFromSmall then begin FindedPositionFromLarge := true; if j <> i then begin LergerPositions.FPositions.Delete(j); LergerPositions.FPositions.Insert(i, PositionFromLarge); end; Break; //// BREAK //// end; end; if Not FindedPositionFromLarge then begin j := i; while j <= LergerPositions.FPositions.Count - 1 do begin PositionFromLarge := TSCSInterfPosition(LergerPositions.FPositions[j]); if ReservedPositionsFromLarge.IndexOf(PositionFromLarge) = -1 then begin KolvoFromLarge := PositionFromLarge.ToPos - (PositionFromLarge.FromPos - 1); KolvoRestFromLarge := KolvoFromLarge - KolvoFromSmall; //*** Если остается еще запас, то разделить его в отдельную структуру if KolvoRestFromLarge > 0 then begin DevidedRestPositionFromLarge := TSCSInterfPosition.Create(PositionFromLarge.InterfOwner); //GetZeroMem(DevidedRestPositionFromLarge, SizeOf(TInterfPosition)); //DevidedRestPositionFromLarge.InterfOwner := PositionFromLarge.InterfOwner; DevidedRestPositionFromLarge.FromPos := PositionFromLarge.ToPos - (KolvoRestFromLarge - 1); DevidedRestPositionFromLarge.ToPos := PositionFromLarge.ToPos; PositionFromLarge.ToPos := DevidedRestPositionFromLarge.FromPos - 1; LergerPositions.FPositions.Insert(j+1, DevidedRestPositionFromLarge); KolvoFromLarge := KolvoFromSmall; ReservedPositionsFromLarge.Add(PositionFromLarge); end else //***Если не хватает количества в PositionFromLarge, то разбиваем PositionFromSmall под него if KolvoRestFromLarge < 0 then begin DevidedRestPositionFromSmall := TSCSInterfPosition.Create(PositionFromSmall.InterfOwner); //GetZeroMem(DevidedRestPositionFromSmall, SizeOf(TInterfPosition)); //DevidedRestPositionFromSmall.InterfOwner := PositionFromSmall.InterfOwner; DevidedRestPositionFromSmall.FromPos := PositionFromSmall.ToPos - (Abs(KolvoRestFromLarge) - 1); DevidedRestPositionFromSmall.ToPos := PositionFromSmall.ToPos; PositionFromSmall.ToPos := DevidedRestPositionFromSmall.FromPos - 1; SmallerPositions.FPositions.Insert(i+1, DevidedRestPositionFromSmall); KolvoFromSmall := KolvoFromLarge; ReservedPositionsFromLarge.Add(PositionFromLarge); end else //*** Если количества одинаковы. то оставляем все как есть и двигаем дальше if KolvoRestFromLarge = 0 then begin ReservedPositionsFromLarge.Add(PositionFromLarge); end; Break; //// BREAK //// end; Inc(j); end; end; Inc(i); end; ReservedPositionsFromLarge.Free; //*** выкинуть позиции. которые не будут участвовать в соединении i := SmallerPositions.FPositions.Count; // !!!! Не Count - 1 while i <= LergerPositions.FPositions.Count - 1 do begin PositionFromLarge := TSCSInterfPosition(LergerPositions.FPositions[i]); LergerPositions.Kolvo := LergerPositions.Kolvo - (PositionFromLarge.ToPos - (PositionFromLarge.FromPos - 1)); FreeAndNil(PositionFromLarge); LergerPositions.FPositions.Delete(i); end; end; end; end; procedure RelateParallelInterfaces(AInterf1, AInterf2: TSCSInterface); begin AInterf1.IDAdverse := AInterf2.ID; AInterf2.IDAdverse := AInterf1.ID; AInterf1.ParallelInterface := AInterf2; AInterf2.ParallelInterface := AInterf1; if (AInterf1.Side = 0) and (AInterf2.Side = 0) then begin AInterf1.Side := 1; AInterf2.Side := 2; end; end; procedure RemarkComponent(AComponent: TSCSComponent); begin //if (AComponent.FProjectOwner <> nil) and (AComponent.FProjectOwner.Setting.MarkMode = mmTIAEIA606A) then begin ApplyChangeComponMarkID(ACOmponent, false, true, nil); end; end; procedure RemarkComponentByID(AIDCOmponent: Integer); var SCSComponent: TSCSComponent; begin if F_ProjMan.GSCSBase.CurrProject.Setting.MarkMode = mmTIAEIA606A then begin SCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(AIDCOmponent); if SCSComponent <> nil then RemarkComponent(SCSComponent); end; end; procedure RemarkComponAfterChangePort(ACompon: TSCSComponent); var ListOwner: TSCSList; SprCompType: TNBComponentType; begin if ACompon.ProjectOwner <> nil then begin if ACompon.ProjectOwner.Setting.MarkMode = mmTemplate then begin // Изменить маркировку компоненты, если в шаблоне есть верхний номер порта //20.08.2012 if ACompon.GetPort <> nil then //20.08.2012 - закоментил, так как бывает нужно перемаркировать после удаления порта begin ListOwner := ACompon.GetListOwner; if ListOwner <> nil then begin SprCompType := ListOwner.FSpravochnik.GetComponentTypeByGUID(ACompon.GUIDComponentType); if SprCompType <> nil then if Pos(mteComponPort, SprCompType.ComponentType.MarkMask) <> 0 then RemarkComponent(ACompon); end; end; end else if ACompon.FProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin if GetParentComunicationCompon(ACompon) <> nil then RemarkComponsRelatedToPointComponWithChilds(ACompon, ACompon.FProjectOwner); end; end; end; procedure RemarkComponChild(ACompon, AChild: TSCSComponent); var ListOwner: TSCSList; i: Integer; procedure RemarkComponIfTemlateHaveIsTopCompon(AComponent: TSCSComponent); var SprCompType: TNBComponentType; begin SprCompType := ListOwner.FSpravochnik.GetComponentTypeByGUID(AComponent.GUIDComponentType); if SprCompType <> nil then if Pos(mteTopCompon, SprCompType.ComponentType.MarkMask) <> 0 then RemarkComponent(AComponent); end; begin if ACompon.ProjectOwner <> nil then begin if ACompon.ProjectOwner.Setting.MarkMode = mmTemplate then begin // Изменить маркировку компонентов, в шаблоне которых есть верхний компонент if ACompon.IsTop then begin ListOwner := ACompon.GetListOwner; if ListOwner <> nil then begin RemarkComponIfTemlateHaveIsTopCompon(AChild); for i := 0 to AChild.FChildReferences.Count - 1 do RemarkComponIfTemlateHaveIsTopCompon(AChild.FChildReferences[i]); end; end; end else if ACompon.FProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin if GetParentComunicationCompon(ACompon) <> nil then RemarkComponsRelatedToPointComponWithChilds(AChild, ACompon.FProjectOwner); end; end; end; procedure RemarkComponsRelatedToLineCompon(ACompon: TSCSComponent; AProjectOwner: TSCSProject); var i: Integer; WholeLineCompon: TWholeLineCompon; WholeComponents: TSCSComponents; LastConnectedConnCompon, FirstConnectedConnCompon: TSCSComponent; begin try if ACompon.IsLine = biTrue then if AProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin WholeLineCompon := GetLineComponsInTraceFromBase(ACompon, false); LastConnectedConnCompon := nil; FirstConnectedConnCompon := nil; if WholeLineCompon.LastIDConnectedConnCompon <> 0 then LastConnectedConnCompon := ACompon.FProjectOwner.GetComponentFromReferences(WholeLineCompon.LastIDConnectedConnCompon); if WholeLineCompon.FirstIDConnectedConnCompon <> 0 then FirstConnectedConnCompon := Acompon.FProjectOwner.GetComponentFromReferences(WholeLineCompon.FirstIDConnectedConnCompon); if LastConnectedConnCompon <> nil then ApplyChangeComponMarkID(LastConnectedConnCompon, false, true, nil); if FirstConnectedConnCompon <> nil then ApplyChangeComponMarkID(FirstConnectedConnCompon, false, true, nil); WholeComponents := ACompon.FProjectOwner.GetComponentsByWholeID(ACompon.Whole_ID); for i := 0 to WholeComponents.Count - 1 do ApplyChangeComponMarkID(WholeComponents[i], false, true, nil); FreeAndNil(WholeComponents); end; except on E: Exception do AddExceptionToLogEx('RemarkComponsRelatedToLineCompon', E.Message); end; end; procedure RemarkComponsRelatedToPointCompon(ACompon: TSCSComponent; AProjectOwner: TSCSProject); var i: Integer; JoinedLine: TSCSComponent; begin try if ACompon.IsLine = biFalse then if AProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin for i := 0 to ACompon.JoinedComponents.Count - 1 do begin JoinedLine := ACompon.JoinedComponents[i]; RemarkComponsRelatedToLineCompon(JoinedLine, AProjectOwner); end; end; except on E: Exception do AddExceptionToLogEx('RemarkComponsRelatedToPointCompon', E.Message); end; end; procedure RemarkComponsRelatedToPointComponWithChilds(ACompon: TSCSComponent; AProjectOwner: TSCSProject); var i: Integer; begin try if ACompon.IsLine = biFalse then if AProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin RemarkComponsRelatedToPointCompon(ACompon, AProjectOwner); for i := 0 to ACompon.FChildReferences.Count - 1 do RemarkComponsRelatedToPointCompon(ACompon.FChildReferences[i], AProjectOwner); end; except on E: Exception do AddExceptionToLogEx('RemarkComponsRelatedToPointComponWithChilds', E.Message); end; end; procedure RemarkObjectComponsAfterChangeRoom(ASCSObject: TSCSCatalog); var ListOwner: TSCSList; ComponentTypesWithRoomIndex: TRapList; SprComponentType: TNBComponentType; i, j: Integer; SCSComponent, SCSChildComponent: TSCSComponent; CanRemarkCompon: Boolean; WholeLineCompon: TWholeLineCompon; aNode, aParentTopNode, aProjectTopNode, Node, TopNode: TTreeNode; begin try aParentTopNode := nil; aProjectTopNode := nil; if ASCSObject.FProjectOwner.Setting.MarkMode = mmTemplate then begin ListOwner := ASCSObject.GetListOwner; if ListOwner <> nil then begin ComponentTypesWithRoomIndex := TRapList.Create; if (ASCSObject.FComponentReferences.Count > 0) then begin aParentTopNode := F_ProjMan.GetNodeByObj(ASCSObject); if TF_MAIN(ASCSObject.ActiveForm).GDBMode = bkProjectManager then begin if TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.TreeViewNode <> nil then begin if PObjectData(TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.TreeViewNode.Data).ObjectID = TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.CurrID then aProjectTopNode := TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.TreeViewNode; end; end; if aProjectTopNode = nil then begin TopNode := F_ProjMan.GetTopNode; if TF_MAIN(ASCSObject.ActiveForm).GDBMode = bkProjectManager then begin Node := TopNode; while Node <> nil do begin if Node.Data <> nil then begin if PObjectData(Node.Data).ItemType = itProject then begin if PObjectData(Node.Data).ObjectID = TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.CurrID then if TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.Active then begin //TopID := TF_MAIN(ASCSObject.ActiveForm).GSCSBase.CurrProject.CurrID; TopNode := Node; end; end; end; Node := Node.GetNext; end; aProjectTopNode := TopNode; end; end; end; for i := 0 to ASCSObject.FComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.FComponentReferences[i]; aNode := F_ProjMan.GetNodeByObj(SCSComponent, aParentTopNode); if (aNode = nil) and (aProjectTopNode <> nil) then aNode := F_ProjMan.GetNodeByObj(SCSComponent, aProjectTopNode); if aNode = nil then aNode := F_ProjMan.GetNodeByObj(SCSComponent); if aNode <> nil then SCSComponent.TreeViewNode := aNode; CanRemarkCompon := false; SprComponentType := ListOwner.FSpravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if SprComponentType <> nil then if ComponentTypesWithRoomIndex.IndexOf(SprComponentType) <> -1 then CanRemarkCompon := true else if Pos(mteRoom, SprComponentType.ComponentType.MarkMask) <> 0 then begin ComponentTypesWithRoomIndex.Add(SprComponentType); CanRemarkCompon := true; end; if CanRemarkCompon then ApplyChangeComponMarkID(SCSComponent, false, true, nil); end; FreeAndNil(ComponentTypesWithRoomIndex); end; end else if ASCSObject.FProjectOwner.Setting.MarkMode = mmTIAEIA606A then begin if ASCSObject.ItemType = itSCSConnector then begin for i := 0 to ASCSObject.FComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.FComponentReferences[i]; if IsComunicationCompon(SCSComponent) then begin RemarkComponsRelatedToPointCompon(SCSComponent, SCSComponent.FProjectOwner); for j := 0 to SCSComponent.FChildReferences.Count - 1 do begin RemarkComponsRelatedToPointCompon(SCSComponent.FChildReferences[j], SCSComponent.FProjectOwner); end; end; end; end else if ASCSObject.ItemType = itSCSLine then begin for i := 0 to ASCSObject.FComponentReferences.Count - 1 do begin SCSComponent := ASCSObject.FComponentReferences[i]; // Если кабель между двумя комутационными панелями if SCSComponent.IsUserMark = biFalse then begin WholeLineCompon := GetLineComponsInTraceFromBase(SCSComponent, false); if (WholeLineCompon.FirstIDConnectedConnCompon <> 0) and (WholeLineCompon.LastIDConnectedConnCompon <> 0) then ApplyChangeComponMarkID(SCSComponent, false, true, nil); end; end; end; end; except on E: Exception do AddExceptionToLogEx('RemarkObjectComponsAfterChangeRoom', E.Message); end; end; function RemovePreyscurantFromNorm(ANorm: TSCSNorm; APreyscurant: TSCSComponent): Integer; var NormPreyscurant: TSCSNormPreyscurant; i: integer; begin Result := -1; i := 0; while i <= ANorm.FPreyscurants.Count - 1 do begin NormPreyscurant := TSCSNormPreyscurant(ANorm.FPreyscurants[i]); if NormPreyscurant.SCSComponent = APreyscurant then begin Result := i; ANorm.FPreyscurants.Remove(NormPreyscurant); FreeAndNil(NormPreyscurant); end else Inc(i); end; end; // Tolik 08/04/2020 -- function ReplacePMComponFromNB(APMComponent, ANBComponent: TSCSComponent; ALeaveComplects: Boolean; aReplacePortNumbers: Boolean = False): TSCSComponent; //function ReplacePMComponFromNB(APMComponent, ANBComponent: TSCSComponent; ALeaveComplects: Boolean): TSCSComponent; // var BusyInterfaces, EmptyNBInterfaces, EmptyNewInterfaces: TList; CanReplace, IsEndPartComponent: Boolean; SrcParentCompon: TSCSComponent; JoinComponents, WholeComponents, NewWholeComponents: TSCSComponents; PartComponent, PartComponent1, PartComponent2: TSCSComponent; PartParent: TBasicSCSClass; PartParentNode, ParentNode, NextNode: TTreeNode; PartObjectOwner: TSCSCatalog; SavedFActiveForm: TForm; SavedMarkID, SavedWholeID, SavedIsLine: Integer; SavedParent: TBasicSCSClass; SavedSortID, SavedFirstIDCompon, SavedLastIDCompon: Integer; SavedChildComplect: TComplect; TracesToConnect, ConnectWay: TList; ptrTwoObjects: PTwoObjects; // id соединяемых трасс ChildComponent, JoinedComponent, NewComponent: TSCSComponent; NewIDComponent: Integer; ParentObject: TBasicSCSClass; //SCSCatalogOwner: TSCSCatalog; i, j: Integer; ptrID: ^Integer; TopCatalog, ObjectOwner: TSCSCatalog; TopComponent: TSCSComponent; ChildComponents: TSCSComponents; SelfFullName, NBComponFullName: String; FActiveForm: TForm; //SavefTreeViewNode: TTreeNode; ChildComplect: PComplect; IsUserPortList: TIntList; // Tolik 10/04/2020 -- // Tolik 08/04/2020 -- function GetPortsGuidList(aCompon:TSCSComponent): TStringList; var i: integer; begin Result := TStringList.Create; if Assigned(ACompon) then if Assigned(aCompon.Interfaces) then begin aCompon.Interfaces.pack; for i := 0 to aCompon.Interfaces.Count - 1 do begin if aCompon.Interfaces[i].TypeI = itFunctional then if aCompon.Interfaces[i].isPort = biTrue then if Result.IndexOf(aCompon.Interfaces[i].GuidInterface) = -1 then Result.Add(aCompon.Interfaces[i].GuidInterface); end; end; end; Procedure AddParentToComponsForPortReindexList(aCompon: TSCSComponent); begin if ACompon.Parent <> nil then if aCompon.Parent is TSCSComponent then if GComponsParentListForPortsReindex.indexOf(ACompon.Parent) = -1 then GComponsParentListForPortsReindex.Add(ACompon.Parent); end; function GetPortListByGuid(aGuid: string; aCompon: TSCSComponent): TSCSInterfaces; var i: integer; begin Result := TSCSInterfaces.Create(false); for i := 0 to aCompon.Interfaces.Count - 1 do begin if aCompon.Interfaces[i].TypeI = itFunctional then if aCompon.Interfaces[i].isPort = biTrue then if aCompon.Interfaces[i].GuidInterface = aGuid then if Result.IndexOf(aCompon.Interfaces[i]) = -1 then Result.Add(aCompon.Interfaces[i]); end; end; Procedure InheritPortsNumbers; var OldComponPortGuidList, NewComponPortGuidList: TStringList; OldPortListCountByGuides, NewPortListCountByGuides: TIntList; i, j, k, Counter, GuidIndex: Integer; GuidString: String; PMPortList, NPortList: TList; OldPortfList, NewPortList: TSCSInterfaces; begin try if APMComponent.Parent = nil then exit; if not (APMComponent.Parent is TSCSComponent) then exit; if GComponsParentListForPortsReindex.IndexOf(APMComponent.Parent) <> -1 then exit; IsUserPortList.Clear; //GUIDSLists OldComponPortGuidList := GetPortsGuidList(APMComponent); NewComponPortGuidList := GetPortsGuidList(NewComponent); //если есть порты и количество гуидов сходится ... if ((OldComponPortGuidList.Count <> 0) and (NewComponPortGuidList.Count <> 0) and (OldComponPortGuidList.Count = NewComponPortGuidList.Count)) then begin // ...проверить соответствие по гуидам for I := 0 to OldComponPortGuidList.Count - 1 do begin if NewComponPortGuidList.IndexOf(OldComponPortGuidList[i]) = -1 then begin OldComponPortGuidList.free; NewComponPortGuidList.free; AddParentToComponsForPortReindexList(APMComponent); exit; // не сошлось -- нах отсюда (а парента - в список переиндексации) end; end; OldPortListCountByGuides := TIntList.Create; NewPortListCountByGuides := TIntList.Create; //ports count by Guids for i := 0 to OldComponPortGuidList.Count - 1 do begin Counter := 0; for j := 0 to APMComponent.Interfaces.Count - 1 do begin if APMComponent.Interfaces[j].TypeI = itFunctional then if APMComponent.Interfaces[j].GuidInterface = OldComponPortGuidList[i] then inc(Counter); end; OldPortListCountByGuides.Add(Counter); end; //ports count by Guids for i := 0 to OldComponPortGuidList.Count - 1 do begin Counter := 0; for j := 0 to NewComponent.Interfaces.Count - 1 do begin if NewComponent.Interfaces[j].TypeI = itFunctional then if NewComponent.Interfaces[j].GuidInterface = OldComponPortGuidList[i] then inc(Counter); end; NewPortListCountByGuides.Add(Counter); end; //проверить количественное сходжение портов по гуидам for I := 0 to OldComponPortGuidList.Count - 1 do begin GuidIndex := NewComponPortGuidList.IndexOf(NewComponPortGuidList[i]); if OldPortListCountByGuides[i] <> NewPortListCountByGuides[GuidIndex] then begin OldComponPortGuidList.free; NewComponPortGuidList.free; OldPortListCountByGuides.free; NewPortListCountByGuides.free; AddParentToComponsForPortReindexList(APMComponent); exit; // если не сошлось количественно -- на.. отсюда end; end; OldPortListCountByGuides.free; NewPortListCountByGuides.free; //перенять номера портов for I := 0 to OldComponPortGuidList.Count - 1 do begin OldPortfList := GetPortListByGuid(OldComponPortGuidList[i], APMComponent); NewPortList := GetPortListByGuid(OldComponPortGuidList[i], NewComponent); if OldPortfList.Count = NewPortList.Count then // на всякий .... begin for j := 0 to OldPortfList.Count - 1 do begin NewPortList[j].NppPort := OldPortfList[j].NppPort; NewPortList[j].isUserPort := OldPortfList[j].isUserPort; end; end else // это, конечно, вряд ли...но вдруг что-то пойдет не так и количество не сойдется... begin OldPortfList.Free; NewPortList.Free; OldComponPortGuidList.free; NewComponPortGuidList.free; AddParentToComponsForPortReindexList(APMComponent); exit; end; OldPortfList.Free; NewPortList.Free; end; OldComponPortGuidList.free; NewComponPortGuidList.free; for i := 0 to NewComponent.Interfaces.Count - 1 do IsUserPortList.Add(NewComponent.Interfaces[i].isUserPort); end else begin OldComponPortGuidList.free; NewComponPortGuidList.free; AddParentToComponsForPortReindexList(APMComponent); end; Except on E: Exception do AddExceptionToLog('InheritPortsNumbers: '+E.Message); end; end; begin IsUserPortList := TIntList.Create; //!!!!!!!! WARNiNG (READ BEFORE EDiTHiS PROCEDURE) !!!!!!! // посде удаления Сэлфа, вместо FActiveForm юзать - NewComponent.ActiveForm //!!!!!!! Result := nil; WholeComponents := Nil; // Tolik 11/05/2019 -- try FActiveForm := APMComponent.FActiveForm; ParentObject := APMComponent.FParent; ObjectOwner := APMComponent.GetFirstParentCatalog; TopCatalog := APMComponent.GetTopParentCatalog; TopComponent := APMComponent.GetTopComponent; //SCSCatalogOwner := GetFirstParentCatalog; ZeroMemory(@SavedChildComplect, sizeof(TComplect)); //SavefTreeViewNode := FTreeViewNode; if (TF_Main(FActiveForm).GDBMode = bkProjectManager) and (Assigned(ANBComponent)) then if Assigned(ParentObject) then begin if APMComponent.IsLine <> ANBComponent.IsLine then Exit; //// EXIT //// if APMComponent.FTreeViewNode = nil then APMComponent.FTreeViewNode := TF_Main(FActiveForm).FindComponOrDirInTree(APMComponent.ID, true); SavedFActiveForm := FActiveForm; SavedMarkID := APMComponent.MarkID; SavedParent := APMComponent.FParent; SavedSortID := APMComponent.SortID; TF_Main(FActiveForm).DefineChildNodes(APMComponent.FTreeViewNode); SelfFullName := APMComponent.GetNameForVisible(false); //TF_Main(ActiveForm).GetComponNameForVisible(Name, NameMark); case APMComponent.IsLine of biFalse: begin BusyInterfaces := nil; EmptyNBInterfaces := nil; JoinComponents := nil; NewComponent := nil; CanReplace := true; if CanReplace then begin BaseBeginUpdate; try ////*** Найти подключенные компоненты //JoinComponents := TF_Main(ActiveForm).DM.GetJoinComponents(Self); //*** Скопировать из нормативной базы if Assigned(APMComponent.TreeViewNode) then begin ParentNode := APMComponent.TreeViewNode.Parent; NewIDComponent := TF_Main(FActiveForm).CopyComponentFromNbToPm(F_NormBase, FActiveForm, nil, ParentNode, ANBComponent.ID, ckNone, false, ALeaveComplects); NewComponent := TF_Main(FActiveForm).GSCSBase.CurrProject.GetComponentFromReferences(NewIDComponent); end; SrcParentCompon := APMComponent.GetParentComponent; if SrcParentCompon <> nil then begin SavedChildComplect := PComplect(SrcParentCompon.GetComplectByIDChild(APMComponent.ID))^; end; if Assigned(NewComponent) then begin NewComponent.MarkID := SavedMarkID; NewComponent.ServChangedMarkID := true; NewComponent.SortID := SavedSortID; NewComponent.SaveComponent; ObjectOwner.UpdateComponsChangedFields; //*** Отсоединится от всего //DisConnectFromParent; JoinComponents := APMComponent.DisJoinFromAll(Not ALeaveComplects, SavedParent is TSCSComponent); ////*** Подсоединить новый компонент //if ParentObject is TSCSComponent then // TSCSComponent(ParentObject).ComplectWith(NewComponent); //if ParentObject is TSCSCatalog then // TSCSCatalog(ParentObject).AddComponentToCatRel(NewComponent); { if Assigned(NewComponent.TreeViewNode) then begin PObjectData(NewComponent.TreeViewNode.Data).SortID := SortID; if Assigned(TreeViewNode) then try TF_Main(ActiveForm).Tree_Catalog.OnChange := nil; TF_Main(ActiveForm).Tree_Catalog.OnChanging := nil; NewComponent.TreeViewNode.MoveTo(TreeViewNode, naInsert); finally TF_Main(ActiveForm).Tree_Catalog.OnChange := TF_Main(ActiveForm).Tree_CatalogChange; TF_Main(ActiveForm).Tree_Catalog.OnChanging := TF_Main(ActiveForm).Tree_CatalogChanging; end; end; } if Assigned(NewComponent.TreeViewNode) then begin PObjectData(NewComponent.TreeViewNode.Data).SortID := SavedSortID; if Assigned(APMComponent.TreeViewNode) then TF_Main(FActiveForm).MoveNodeTo(NewComponent.TreeViewNode, APMComponent.TreeViewNode, naInsert); end; //*** Перекинуть комплектующие if ALeaveComplects then while APMComponent.FChildComplects.Count > 0 do begin ChildComponent := APMComponent.FChildComplects[0]; APMComponent.DisComplectChildComponent(ChildComponent); NewComponent.ComplectWith(ChildComponent, -1, true, true); end; // Tolik 08/04/2020 if aReplacePortNumbers then InheritPortsNumbers; //-- перекинуть номера портов -- if IsUserPortList.Count > 0 then begin for i := 0 to NewComponent.Interfaces.Count - 1 do NewComponent.Interfaces[i].isUserPort := biTrue; // Залочить, чтобы не поменялись end; // //*** Удалится нах TF_Main(FActiveForm).DelCompon(APMComponent, nil, false, true, true, false); if SavedParent is TSCSComponent then begin NextNode := NewComponent.TreeViewNode.GetNextSibling; // Учитываем SortID. если заменяется комплектующая ChildComplect := TSCSComponent(SavedParent).ComplectWith(NewComponent, -1, true, true); if (ChildComplect <> nil) and (SavedChildComplect.ID <> 0) then begin ChildComplect.SortID := SavedChildComplect.SortID; PObjectData(NewComponent.TreeViewNode.Data).SortID := SavedChildComplect.SortID; end else PObjectData(NewComponent.TreeViewNode.Data).SortID := SavedSortID; NewComponent.SortID := SavedSortID; TSCSComponent(SavedParent).SortComplects; TSCSComponent(SavedParent).ReloadChildReferences; //*** После комплектации вернуть ветвь обратно if NextNode <> nil then NewComponent.TreeViewNode.MoveTo(NextNode, naInsert); NewComponent.TreeViewNode.Owner.Owner.Selected := NewComponent.TreeViewNode; end; if Assigned(ParentNode) and (ParentObject is TSCSCatalog) then begin TF_Main(NewComponent.ActiveForm).DefineConnectorObjectNodeName(TSCSCatalog(ParentObject)); TF_Main(NewComponent.ActiveForm).DefineObjectNodeGroup(ParentNode, NewComponent.GUIDComponentType, NewComponent.IsLine); end; //TF_Main(ActiveForm).DelCompon(Self, nil, false, true, true); //*** Подсоединиться к бывшим подключенным компонентам if NewComponent.Parent is TSCSComponent then // Запретить всем компл-м подкл. к бывшем подключениям TF_Main(NewComponent.ActiveForm).F_ChoiceConnectSide.SetObjectComponAsCanToJoin(ObjectOwner, false); //*** Подключить только компонент NewComponent к бывшем подключениям TF_Main(NewComponent.ActiveForm).F_ChoiceConnectSide.JoinConnectorWithLines(ObjectOwner, NewComponent, JoinComponents); //*** Востановить внутренние подключения if Assigned(JoinComponents) and (SavedParent is TSCSComponent) then begin for i := 0 to JoinComponents.Count - 1 do begin JoinedComponent := JoinComponents[i]; if JoinedComponent.GetTopComponent = TopComponent then begin if Not NewComponent.JoinTo(JoinedComponent, -1, -1).CanConnect then for j := 0 to NewComponent.FChildReferences.Count - 1 do begin ChildComponent := NewComponent.FChildReferences[j]; if ChildComponent.JoinTo(JoinedComponent, -1, -1).CanConnect then Break; //// BREAK //// end; end; end; end; // Tolik 10/04/2020 -- if IsUserPortList.Count > 0 then begin if NewComponent.Interfaces.Count = IsUserPortList.Count then begin for i := 0 to NewComponent.Interfaces.Count - 1 do NewComponent.Interfaces[i].isUserPort := IsUserPortList[i]; end; end; // Result := NewComponent; end; finally BaseEndUpdate; end; end; if Assigned(JoinComponents) then FreeAndNil(JoinComponents); end; biTrue: begin if APMComponent.ComponentType.SysName = ctsnCableChannel then begin if APMComponent.CanReplaceWithNBCompon(ANBComponent, ALeaveComplects) = [crcrSuccessful] then begin NewComponent := nil; //*** Скопировать из нормативной базы if Assigned(APMComponent.TreeViewNode) then begin ParentNode := APMComponent.TreeViewNode.Parent; if Assigned(ParentNode) then TF_Main(FActiveForm).AddNodes(ParentNode); APMComponent.ServToDelete := True; NewIDComponent := TF_Main(FActiveForm).CopyComponentFromNbToPm(F_NormBase, FActiveForm, nil, ParentNode, ANBComponent.ID, ckNone); NewComponent := TF_Main(FActiveForm).GSCSBase.CurrProject.GetComponentFromReferences(NewIDComponent); end; if Assigned(NewComponent) then begin NewComponent.SortID := SavedSortID; NewComponent.SaveComponent; ChildComponents := TSCSComponents.Create(false); ChildComponents.Assign(APMComponent.FChildComplects); TF_Main(FActiveForm).Tree_Catalog.OnChange := nil; TF_Main(FActiveForm).Tree_Catalog.OnChanging := nil; try //*** Пересыпать кабели в новый кабельный канал for i := 0 to ChildComponents.Count - 1 do begin ChildComponent := ChildComponents[i]; if Assigned(ChildComponent) then if (ChildComponent.ComponentType.SysName <> ctsnCableChannelAccessory) and (ChildComponent.ComponentType.SysName <> ctsnAccessory) then begin ChildComponent.DisConnectFromParent; if NewComponent.ComplectWith(ChildComponent) = nil then ObjectOwner.AddComponentToCatRel(ChildComponent); //if Assigned(NewComponent.TreeViewNode) and Assigned(ChildComponents[i].TreeViewNode) then // begin // ChildComponents[i].TreeViewNode.MoveTo(NewComponent.TreeViewNode, naAddChild); // TF_Main(ActiveForm).OnAddDeleteNode(ChildComponents[i].TreeViewNode, true); // end; end; end; FreeAndNil(ChildComponents); ////*** Отсоединится от всего //DisConnectFromParent; if Assigned(NewComponent.TreeViewNode) then begin PObjectData(NewComponent.TreeViewNode.Data).SortID := SavedSortID; if Assigned(APMComponent.TreeViewNode) then TF_Main(FActiveForm).MoveNodeTo(NewComponent.TreeViewNode, APMComponent.TreeViewNode, naInsert); end; //*** Удалится нах TF_Main(FActiveForm).DelCompon(APMComponent, nil, false, true, true, false); finally try TF_Main(NewComponent.ActiveForm).Tree_Catalog.OnChange := TF_Main(NewComponent.ActiveForm).Tree_CatalogChange; TF_Main(NewComponent.ActiveForm).Tree_Catalog.OnChanging := TF_Main(NewComponent.ActiveForm).Tree_CatalogChanging; except end; end; if Assigned(ParentNode) then begin //TF_Main(NewComponent.ActiveForm).DefineConnectorObjectNodeName(ParentNode); TF_Main(NewComponent.ActiveForm).DefineObjectNodeGroup(ParentNode, NewComponent.GUIDComponentType, NewComponent.IsLine); TF_Main(NewComponent.ActiveForm).F_ChoiceConnectSide.DefineObjectParamsInFuture(ObjectOwner); end; Result := NewComponent; end; end; end else begin SavedMarkID := APMComponent.MarkID; SavedWholeID := APMComponent.Whole_ID; SavedIsLine := APMComponent.IsLine; //*** Найти цельный компонент APMComponent.LoadWholeComponent(false); APMComponent.DefineFirstLast; //*** Нужно определить первый и последний кусок кабеля SavedFirstIDCompon := APMComponent.FirstIDCompon; SavedLastIDCompon := APMComponent.LastIDCompon; WholeComponents := APMComponent.FProjectOwner.GetComponentsByWholeID(APMComponent.Whole_ID); for i := 0 to WholeComponents.Count - 1 do WholeComponents[i].ServToDelete := true; NewWholeComponents := TSCSComponents.Create(false); TracesToConnect := TList.Create; JoinComponents := TSCSComponents.Create(false); //*** Заменить участки for i := 0 to WholeComponents.Count - 1 do begin PartComponent := WholeComponents[i]; PartParentNode := PartComponent.FTreeViewNode; PartParent := PartComponent.Parent; PartObjectOwner := PartComponent.GetFirstParentCatalog; SavedSortID := PartComponent.SortID; NextNode := nil; TF_Main(FActiveForm).FindComponOrDirInTree(PartComponent.ID, True); if PartComponent.TreeViewNode <> nil then NextNode := PartComponent.TreeViewNode.GetNextSibling; //*** Конечный кабель, если да, то подключить его в дальнейшем к компонентам // подсоед-го точ. объекта IsEndPartComponent := false; if (PartComponent.ID = SavedFirstIDCompon) or (PartComponent.ID = SavedLastIDCompon) then IsEndPartComponent := true; //*** отобрать подключенные куски цельного кабеля JoinComponents.Clear; if SavedWholeID > 0 then for j := 0 to PartComponent.FJoinedComponents.Count - 1 do begin if PartComponent.FJoinedComponents[j].Whole_ID = SavedWholeID then begin GetMem(ptrTwoObjects, SizeOf(TTwoObjects)); ptrTwoObjects.Object1 := PartObjectOwner; ptrTwoObjects.Object2 := PartComponent.FJoinedComponents[j].GetFirstParentCatalog; TracesToConnect.Add(ptrTwoObjects); end else JoinComponents.Add(PartComponent.FJoinedComponents[j]); end; TF_Main(FActiveForm).DelCompon(PartComponent, PartComponent.FTreeViewNode, true, true, true, false); NewIDComponent := TF_Main(SavedFActiveForm).CopyComponentFromNbToPm(F_NormBase, FActiveForm, nil, PartObjectOwner.FTreeViewNode, ANBComponent.ID, ckNone); NewComponent := nil; NewComponent := TF_Main(SavedFActiveForm).GSCSBase.CurrProject.GetComponentFromReferences(NewIDComponent); if NewComponent <> nil then begin NewComponent.MarkID := SavedMarkID; NewComponent.ServChangedMarkID := true; PartObjectOwner.UpdateComponsChangedFields; NewWholeComponents.Add(NewComponent); NewComponent.SortID := SavedSortID; if Assigned(NewComponent.TreeViewNode) then begin PObjectData(NewComponent.TreeViewNode.Data).SortID := SavedSortID; if Assigned(NextNode) then TF_Main(FActiveForm).MoveNodeTo(NewComponent.TreeViewNode, NextNode, naInsert); end; //*** Если кабель попал в не тот кабельный канал, то перекинуть его if PartParent is TSCSComponent then if NewComponent.Parent <> PartParent then begin NewComponent.DisConnectFromParent; if TSCSComponent(PartParent).ComplectWith(NewComponent) = nil then PartObjectOwner.AddComponentToCatRel(NewComponent); end; //*** Подключить к бывшим подкдючениям for j := 0 to JoinComponents.Count - 1 do begin TF_Main(SavedFActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(NewComponent, JoinComponents[j], false); end; //*** Подключить к компонентам подсоединенного точ. объекта //if IsEndPartComponent then // TF_Main(SavedFActiveForm).F_ChoiceConnectSide.JoinLineWithJoinedObjects(PartObjectOwner); end; end; //*** подключить куски в единый кабель for i := 0 to TracesToConnect.Count - 1 do begin ptrTwoObjects := TracesToConnect[i]; PartComponent1 := NewWholeComponents.GetComponenByID(TSCSCatalog(ptrTwoObjects.Object1).IDLastAddedComponent); PartComponent2 := NewWholeComponents.GetComponenByID(TSCSCatalog(ptrTwoObjects.Object2).IDLastAddedComponent); if (PartComponent1 <> nil) and (PartComponent2 <> nil) then TF_Main(SavedFActiveForm).F_ChoiceConnectSide.JoinWithDefineSides(PartComponent1, PartComponent2, false); end; FreeAndNil(JoinComponents); FreeAndNil(NewWholeComponents); FreeList(TracesToConnect); Result := NewComponent; end; end; end; //case //*** Вывод инфы в протокол if Assigned(NewComponent) then begin NBComponFullName := NewComponent.GetNameForVisible(false); ShowMessageByType(0, smtProtocol, '"'+SelfFullName+'" '+cSCSComponent_Msg20+' "'+NBComponFullName+'"', '', 0); end; end; except on E: Exception do AddExceptionToLog('ReplacePMComponFromNB: '+E.Message); end; if WholeComponents <> nil then WholeComponents.free;// Tolik 11/05/2019 -- IsUserPortList.free; // Tolik 10/04/2020 -- end; // Tolik -- Замена компонента из НБ (на форме ведомости ресурсов) function ReplacePMComponResFromNB(aCompon, NBCompon: TSCSComponent; aLeaveComplects: Boolean): TSCSComponent; var i: integer; WholeComponent: TSCSComponents; LineCompon, ParentCompon: TSCSComponent; Stream: TFileStream; ComponPictFileName: String; ParentCatalog, ParentCat: TSCSCatalog; NBComponIcon: TMemoryStream; IconType: integer; Spravochnik: TSpravochnik; NewIcon, NBIcon: TNBObjectIcon; ListNorm, Norm: TSCSNorm; NBNorm, NormNbNorm: TNBNorm; Resource: TSCSResourceRel; NBResource: TNbResource; ComponList: TSCSList; SprSuppliesKind, NBSuppliesKind: TNBSuppliesKind; NBProducer, SprProducer: TNBProducer; ParentNode: TTreeNode; function GetWholeComponent(aWholeID: Integer): TSCSComponents; var i: integer; begin Result := TSCSComponents.Create(false); for i := 0 to F_ProjMan.GSCSBase.CurrProject.ComponentReferences.Count - 1 do begin if (F_ProjMan.GSCSBase.CurrProject.ComponentReferences[i].Whole_ID = aWholeID) then Result.Add(F_ProjMan.GSCSBase.CurrProject.ComponentReferences[i]); end; if Result.Count < 1 then FreeAndNil(Result); end; procedure AddPropertyToComponent(AIDProperty: Integer; aGuid: String); var i: Integer; ptrNewProperty: PProperty; PropertyData: TPropertyData; begin with F_NormBase do begin PropertyData := DM.GetPropertyData(AIDProperty, aGuid, nil); ptrNewProperty := aCompon.GetPropertyAsNew; ptrNewProperty.ID_Property := PropertyData.ID; ptrNewProperty.Value := PropertyData.DefValue; ptrNewProperty.IsDefault := biTrue; ptrNewProperty.SysName := PropertyData.SysName; ptrNewProperty.Name_ := PropertyData.Name; ptrNewProperty.IDDataType := PropertyData.IDDataType; aCompon.SaveProperty(meMake, ptrNewProperty); end; end; function CheckHasIcon(NBCompon: TSCSComponent): Boolean; // есть ли УГО var i: integer; begin Result := False; for i := 0 to NBCompon.Properties.Count - 1 do begin if PProperty(NBCompon.Properties[i]).SysName = 'GRAPH_SYMBOL_SPACING' then begin Result := True; break; end; end; end; Procedure AddLoadPropsFromNbCompon; var i: Integer; Prop, NBProp: PProperty; begin //свойство кабеля "Аллюминиевый провод" (или сбросить/установить или удалить ) if (isCableComponent(NBCompon) and isCableComponent(aCompon)) then begin Prop := aCompon.GetPropertyBySysName(pnAluminium); NBProp := NbCompon.GetPropertyBySysName(pnAluminium); if ((Prop <> nil) and (NBProp <> nil)) then Prop.Value := NBProp.Value else if ((Prop <> nil) and (NBProp = nil)) then begin aCompon.Properties.Remove(Prop); FreeMem(prop, SizeOf(TProperty)); end; end; //СВОЙСТВА for i := 0 to NBCompon.Properties.Count - 1 do begin NbProp := PProperty(NBCompon.Properties[i]); Prop := aCompon.GetPropertyBySysName(NBProp.SysName); if Prop <> nil then Prop.Value := NBProp.Value else begin AddPropertyToComponent(NBProp.ID_Property, NBProp.GUIDProperty); Prop := aCompon.GetPropertyBySysName(NBProp.SysName); if Prop <> nil then Prop.Value := NBProp.Value end; end; end; function CheckNoIcon(aIconGuid: String): Boolean; var i: integer; ObjIcon: TNBObjectIcon; begin Result := True; for i := 0 to F_ProjMan.GSCSBase.CurrProject.Spravochnik.FNBObjectIcons.Count - 1 do begin ObjIcon := TNBObjectIcon(F_ProjMan.GSCSBase.CurrProject.Spravochnik.FNBObjectIcons[i]); if ObjIcon.GUID = aIconGuid then begin Result := False; exit; end; end; end; function CheckNoDesignIcon(aIconGuid: String): Boolean; var i: integer; ObjIcon: TNBObjectIcon; begin Result := True; ObjIcon := F_ProjMan.GSCSBase.CurrProject.Spravochnik.GetObjectIconByGUID(aIconGuid); if ObjIcon <> nil then Result := False; end; function CheckCanAddNorms: Boolean; var i: integer; begin Result := False; if NBCompon.NormsResources.Norms.Count > 0 then begin for i := 0 to NBCompon.NormsResources.Norms.Count - 1 do begin if NBCompon.NormsResources.Norms[i].IsFromInterface = biFalse then begin Result := True; break; end; end; end; end; Procedure ReplaceCompons(aCompon, NBCompon: TSCSComponent); var i: integer; begin if aCompon.isLine <> NBCompon.isLine then exit; if NBCompon.GuidObjectIcon <> '' then //заменить УГО (если есть) aCompon.GuidObjectIcon := NBCompon.GuidObjectIcon; AddLoadPropsFromNbCompon; if NBCompon.Name <> '' then aCompon.Name := NBCompon.Name; if NBCompon.NameShort <> '' then aCompon.NameShort := NBCompon.NameShort; if NBCompon.Izm <> '' then aCompon.Izm := NBCompon.Izm; if NBCompon.Notice <> '' then aCompon.Notice := NBCompon.Notice; aCompon.GuidNB := NBCompon.GuidNB; if NBCompon.Description <> nil then begin if NBCompon.Description.Size > 0 then begin try if FileExists(GettempDir + 'descr.tmp') then DeleteFile(GettempDir + 'descr.tmp'); NBCompon.Description.SaveToFile(GettempDir + 'descr.tmp'); if aCompon.Description <> nil then aCompon.Description.Free; aCompon.Description := TMemoryStream.Create; if FileExists(GettempDir + 'descr.tmp') then aCompon.Description.LoadFromFile(GettempDir + 'descr.tmp'); if FileExists(GettempDir + 'descr.tmp') then DeleteFile(GettempDir + 'descr.tmp'); except end; end; end; if NBCompon.Cypher <> '' then aCompon.Cypher := NBCompon.Cypher; if NBCompon.GUIDSuppliesKind <> '' then aCompon.GUIDSuppliesKind := NBCompon.GUIDSuppliesKind; if NBCompon.GUIDSupplier <> '' then aCompon.GUIDSupplier := NBCompon.GUIDSupplier; if NBCompon.ID_Supplier <> 0 then aCompon.ID_Supplier := NBCompon.ID_Supplier; if NBCompon.ID_CURRENCY <> 0 then aCompon.ID_CURRENCY := NBCompon.ID_CURRENCY; if (NBCompon.ID_Producer <> 0) and (NbCompon.GUIDProducer <> '') then begin aCompon.ID_Producer := NBCompon.ID_Producer; aCompon.GUIDProducer := NBCompon.GUIDProducer; SprProducer := F_ProjMan.GSCSBase.CurrProject.Spravochnik.GetProducerByGUID(NbCompon.GUIDProducer); if SprProducer = nil then begin SprProducer := F_NormBase.GSCSBase.FNBSpravochnik.GetProducerByGUID(NbCompon.GUIDProducer); if SprProducer <> nil then begin NBProducer := TNBProducer.Create(F_ProjMan); NBProducer.Assign(SprProducer); F_ProjMan.GSCSBase.CurrProject.Spravochnik.AddProducer(NBProducer); //NBProducer.Save(meMake); end; end; end; if ((NBCompon.IDObjectIcon <> 0) and (NBCompon.GUIDObjectIcon <> '')) then begin aCompon.IdObjectIcon := NBCompon.IDObjectIcon; aCompon.GUIDObjectIcon := NBCompon.GUIDObjectIcon; end; if ((NBCompon.IDSymbol <> 0) and (NBCompon.GUIDSymbol <> '')) then begin aCompon.IDSymbol := NBCompon.IDSymbol; ACompon.GUIDSymbol := NBCompon.GUIDSymbol; end; if NBCompon.IDSuppliesKind <> 0 then aCompon.IDSuppliesKind := NBCompon.IDSuppliesKind; if NBCompon.ComponentType.GUIDDesignIcon <> '' then ACompon.ComponentType.GUIDDesignIcon := NBCompon.ComponentType.GUIDDesignIcon; if NBCompon.Picture <> nil then begin try ComponPictFileName := GetTempDir + 'pict.bmp'; NBCompon.Picture.SaveToFile(ComponPictFileName); if FileExists(ComponPictFileName) then begin Stream := TFileStream.Create(ComponPictFileName, fmOpenReadWrite); Stream.Position := 0; aCompon.Picture.Position := 0; aCompon.Picture.CopyFrom(Stream, 0); ACompon.Picture.Position := 0; FreeAndNil(Stream); DeleteFile(PChar(GetTempDir + 'pict.bmp')); end; except on E:Exception do AddExceptionToLog('SCSComponent.LoadPicture: '+E.Message); end; end; // НОРМЫ if CheckCanAddNorms then begin aCompon.NormsResources.Norms.Clear; for i := 0 to NBCompon.NormsResources.Norms.Count - 1 do begin Norm := NBCompon.NormsResources.Norms[i]; if Norm.IsFromInterface = biFalse then // нормы, пришедшие с интерфейсов не берем begin Norm := TSCSNorm.Create(F_ProjMan, ntProj); Norm.Assign(NBCompon.NormsResources.Norms[i], True); aCompon.NormsResources.Norms.Add(Norm); end; end; end; //РЕСУРСЫ if NBCompon.NormsResources.Resources.Count > 0 then begin aCompon.NormsResources.AssignResources(NBCompon.NormsResources.Resources, false); for i := 0 to aCompon.NormsResources.Resources.Count - 1 do aCompon.NormsResources.Resources[i].IsNew := true; aCompon.NormsResources.SaveByServiceFields(ACompon.ID); end; aCompon.NormsResources.UpdateResources; // if NBCompon.ArticulDistributor <> '' then aCompon.ArticulDistributor := NBCompon.ArticulDistributor; if NBCompon.ArticulProducer <> '' then aCompon.ArticulProducer := NBCompon.ArticulProducer; IconType := NBCompon.GetPropertyValueAsInteger(pnSignType); if IconType = oitNone then IconType := oitProjectible; if NBCompon.GuidObjectIcon <> '' then begin NBComponIcon := TF_Main(NBCompon.ActiveForm).FNormBase.DM.GetComponIconByIconType(NBCompon.IDSymbol, IconType, ieBlk, nbCompon.GUIDObjectIcon); NbComponIcon.Position := 0; if NBComponIcon.Size > 0 then begin AddStringToStringListOnce(F_ProjMan.GSCSBase.CurrProject.Spravochnik.FNewGUIDsObjectIcons, aCompon.GUIDObjectIcon); // aCompon.DefineParams; end; ParentCatalog := aCompon.GetFirstParentCatalog; if ParentCatalog <> nil then begin ParentCatalog.ServToDefineParamsInCAD := True; if checkNoIcon(NBCompon.GUIDObjectIcon) then begin NBIcon := F_NormBase.GSCSBase.FNBSpravochnik.GetObjectIconByGUID(NBCompon.GUIDObjectIcon); if NBIcon <> nil then begin NewIcon := TNBObjectIcon.Create(F_ProjMan); NewIcon.Assign(NBIcon); F_ProjMan.GSCSBase.CurrProject.Spravochnik.AddObjectIcon(NewIcon); end; end; if CheckNoDesignIcon(NBCompon.GUIDSymbol) then begin end; F_ProjMan.F_ChoiceConnectSide.DefineObjectParams(ParentCatalog); end; end; if ((NBCompon.IDSuppliesKind <> 0) and (NBCompon.GUIDSuppliesKind <> ''))then begin aCompon.IDSuppliesKind := NBCompon.IDSuppliesKind; aCompon.GUIDSuppliesKind := NBCompon.GUIDSuppliesKind; SprSuppliesKind := F_ProjMan.GSCSBase.CurrProject.Spravochnik.GetSuppliesKindByGUID(NBCompon.GUIDSuppliesKind); if SprSuppliesKind = nil then begin SprSuppliesKind := F_NormBase.GSCSBase.FNBSpravochnik.GetSuppliesKindByGUID(NBCompon.GUIDSuppliesKind); if SprSuppliesKind <> nil then begin NBSuppliesKind := TNBSuppliesKind.Create(F_ProjMan); NBSuppliesKind.Assign(SprSuppliesKind); F_ProjMan.GSCSBase.CurrProject.Spravochnik.AddSuppliesKind(NBSuppliesKind); NBSuppliesKind.Save(meMake); end; end; end; aCompon.PriceSupply := NBCompon.PriceSupply; aCompon.Price := NBCompon.Price; aCompon.Price_Calc := NBCompon.Price_Calc; ParentCat := aCompon.GetFirstParentCatalog; if ParentCat <> nil then begin if Assigned(ParentCat.TreeViewNode) then begin TF_Main(F_ProjMan).DefineChildNodes(ParentCat.TreeViewNode); TF_Main(F_ProjMan).DefineConnectorObjectNodeName(ParentCat); //TF_Main(F_ProjMan).DefineObjectNodeGroup(aCompon.TreeViewNode.Parent, aCompon.GUIDComponentType, aCompon.IsLine); end; end; if aCompon.TreeViewNode <> nil then begin aCompon.TreeViewNode.Text := F_ProjMan.GetNameNode(aCompon.TreeViewNode, nil, true, true); { TF_Main(F_ProjMan).DefineChildNodes(aCompon.TreeViewNode); if Assigned(aCompon.TreeViewNode.Parent) then begin end; } end; end; begin Result := Nil; if aCompon.isLine <> NBCompon.isLine then exit; if aCompon.isLine = biFalse then ReplaceCompons(aCompon, NBCompon) else begin if aCompon.IsLine = biTrue then begin WholeComponent := GetWholeComponent(aCompon.Whole_ID); if WholeComponent = nil then exit; for i := 0 to WholeComponent.Count - 1 do ReplaceCompons(WholeComponent[i], NBCompon); WholeComponent.free; end; end; { Name: String; NameShort: String; NameMark: String; MarkID: Integer; MarkStr: String; Cypher: String; IsUserMark: Integer; Izm: String; Notice: String; Description: TMemoryStream; ComponentType: TComponentType; Color: Integer; Picture: TMemoryStream; HasNDS: Integer; ArticulDistributor: String; ArticulProducer: String; ID_ComponentType: Integer; IDSymbol: Integer; IDObjectIcon: Integer; ID_Producer: Integer; ID_CURRENCY : Integer; IDSuppliesKind: Integer; ID_Supplier : Integer; IDNetType: Integer; IDCompSpecification: Integer; //SortID : integer; Whole_ID: Integer; UseKindInProj: Integer; IsDismount: Integer; IsUseDismounted: Integer; ComunicationComponID: Integer; ComunicationPortNum: Integer; ComeFrom: Integer; KolComplect: Integer; CableCanalConnectorsCnt: Integer; InterfCount: Integer; JoinsCount: Integer; GUIDComponentType: String; GUIDSymbol: String; GUIDObjectIcon: String; GUIDProducer: String; GUIDSuppliesKind: String; GUIDSupplier: String; GUIDNetType: String; //20.08.2007 CoordZ: Double; //*** Служебные данные IDCompRel: Integer; IDTopComponent: Integer; CompRelSortID: Integer; Count: Integer; ServDisabledLoadDataElements: TCompDataFlags; ServInterfCntToConnect: Integer; ServCopyIndex: Integer; LinkToComlectRec: PComplect; FirstIDCompon: Integer; //*** конечный компонент 1 FirstCompon: TSCSComponent; LastIDCompon: Integer; //*** конечный компонент 2 LastCompon: TSCSComponent; FirstIDConnectedConnCompon: Integer; LastIDConnectedConnCompon: Integer; OwnerCatalog: TObject; FirstConnectedConnCompon: TSCSComponent; LastConnectedConnCompon: TSCSComponent; PriceSupply: Double; Price: Double; Price_Calc: Double; UserLength: Double; MaxLength: Double; ObjectIconStep: Double; LengthReserv: Double; //Размер запаса } end; procedure SaveComponAllIOfIRelsToFile(AComponent: TSCSComponent; AFileName: string); var FHandle: TextFile; procedure WriteIOfIRel(AID, AIDInterfRel, AIDInterfTo, AIDCompRel, AIDComponent, AIDParentCompRel: string); begin Writeln(FHandle); Write(FHandle, AID); Write(FHandle, #9); Write(FHandle, AIDInterfRel); Write(FHandle, #9); Write(FHandle, AIDInterfTo); Write(FHandle, #9); Write(FHandle, AIDCompRel); Write(FHandle, #9); Write(FHandle, AIDComponent); Write(FHandle, #9); Write(FHandle, AIDParentCompRel); end; procedure WriteComponIOfIRel(ACompon: TSCSComponent); var i, j: integer; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; begin for i := 0 to ACompon.FInterfaces.Count - 1 do begin Interf := ACompon.FInterfaces[i]; for j := 0 to Interf.IOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.IOfIRelOut[j]); WriteIOfIRel(IntToStr(IOfIRel.ID), IntToStr(IOfIRel.IDInterfRel), IntToStr(IOfIRel.IDInterfTo), IntToStr(IOfIRel.IDCompRel), IntToStr(ACompon.ID), IntToStr(ACompon.IDCompRel)); end; end; for i := 0 to ACompon.FChildComplects.Count - 1 do WriteComponIOfIRel(ACompon.FChildComplects[i]); end; begin AssignFile(FHandle, AFileName); Rewrite(FHandle); try WriteIOfIRel(fnID, fnIDInterfRel, fnIDInterfTo, fnIDCompRel, fnIDComponent, fnIDParentCompRel); WriteComponIOfIRel(AComponent); finally CloseFile(FHandle); end; end; procedure SelectSCSObjectsInCAD(AObjects: TSCSCatalogs); var i: Integer; SCSObject: TSCSCatalog; ListObjects: TStringList; Idx, ListID: Integer; ObjIds: TIntList; begin try // Снимаем выделение ото всюду DeselectAllSCSObjectsInProject; ListObjects := CreateStringListSorted; for i := 0 to AObjects.Count - 1 do begin SCSObject := AObjects[i]; //SelectObjectInCAD(SCSObject.ListID, SCSObject.SCSID, ''); Idx := ListObjects.IndexOf(IntToStr(SCSObject.ListID)); ObjIds := nil; if Idx = -1 then begin ObjIds := TIntList.Create; ListObjects.AddObject(IntToStr(SCSObject.ListID), ObjIds); end else ObjIds := TIntList(ListObjects.Objects[idx]); ObjIds.Add(SCSObject.SCSID); end; for i := 0 to ListObjects.Count - 1 do begin ListID := StrToInt(ListObjects[i]); ObjIds := TIntList(ListObjects.Objects[i]); SelectObjectsInCADByIDs(ListID, ObjIds); end; FreeStringsObjects(ListObjects, true); ListObjects.Free; except on E: Exception do AddExceptionToLogEx('SelectSCSObjectsInCAD', E.Message); end; end; procedure SetLinksToComplectInIOfIRel(AComponent: TSCSComponent; ARecursive: Boolean); var i, j, k: Integer; Interf: TSCSInterface; IOfIRel: TSCSIOfIRel; Complect: PComplect; begin for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interf := AComponent.FInterfaces[i]; for j := 0 to Interf.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interf.FIOfIRelOut[j]); for k := 0 to AComponent.FComplects.Count - 1 do begin Complect := AComponent.FComplects[k]; if Complect.ID = IOfIRel.IDCompRel then begin IOfIRel.FCompRel := Complect; Break; //// BREAK //// end; end; end; end; if ARecursive then for i := 0 to AComponent.FChildComplects.Count - 1 do SetLinksToComplectInIOfIRel(AComponent.FChildComplects[i], ARecursive); end; procedure SetLinkToInterfPosConnection(AInterfPosConnection: TSCSInterfPosConnection; AOwnerInterf, AConnInterf: TSCSInterface); begin AOwnerInterf.FBusyPositions.Add(AInterfPosConnection.FSelfInterfPosition); AInterfPosConnection.FSelfInterfPosition.InterfOwner := AOwnerInterf; AConnInterf.FBusyPositions.Add(AInterfPosConnection.FConnInterfPosition); AInterfPosConnection.FConnInterfPosition.InterfOwner := AConnInterf; end; procedure SendFirstLastIDsToPartComponent(ALineComponent, APartComponent: TSCSComponent); begin if (ALineComponent <> nil) and (APartComponent <> nil) then begin APartComponent.FirstIDCompon := ALineComponent.FirstIDCompon; APartComponent.LastIDCompon := ALineComponent.LastIDCompon; end; end; procedure SetChildComponInterfacesToNoBusy(AComponent, AChildComponent: TSCSComponent; AIDCompRel: Integer); var i, j: Integer; Interfac: TSCSInterface; IOfIRel: TSCSIOfIRel; SavedIsBusy, SavedKolvoBusy: Integer; begin for i := 0 to AComponent.FInterfaces.Count - 1 do begin Interfac := AComponent.FInterfaces.Items[i]; SavedIsBusy := Interfac.IsBusy; SavedKolvoBusy := Interfac.KolvoBusy; j := 0; while j <= Interfac.FIOfIRelOut.Count - 1 do begin IOfIRel := TSCSIOfIRel(Interfac.FIOfIRelOut[j]); if IOfIRel.IDCompRel = AIDCompRel then if (IOfIRel.InterfaceTo <> nil) and (IOfIRel.InterfaceTo.FComponentOwner = AChildComponent) then begin Interfac.FreeIOfIRel(IOfIRel); Interfac.IsBusy := SavedIsBusy; Interfac.KolvoBusy := SavedKolvoBusy; Continue; //// CONTINUE //// //Interfac.IsBusy := biFalse; //Interfac.KolvoBusy := 0; end; j := j + 1; end; end; end; procedure SetComponAndChildsFieldComeFrom(AComponent: TSCSComponent; AComeFrom: Integer); var i: integer; begin AComponent.ComeFrom := AComeFrom; for i := 0 to AComponent.FChildReferences.Count - 1 do TSCSComponent(AComponent.FChildReferences.FItems.List^[i]).ComeFrom := AComeFrom; end; procedure SetComponAsLite(ACompon: TSCSComponent; AIncludingTemplate: Boolean=false); var i, j, k, l: Integer; ComponList: TSCSComponents; Compon: TSCSComponent; Interf, InterfAdverse, Port, TempInterf1, TempInterf2: TSCSInterface; PortInterfRel: PPortInterfRel; InterfaceTypeToRemove: Boolean; ReqProp, Prop: PProperty; Spravochnik: TSpravochnik; PortCount, PortWireCount, WireCount, InterfRelCount: Integer; PropGender: ShortInt; InterfSection: Double; InterfGuid: String; KeyValues: OleVariant; PropSysNamesConduitElmtSideDimensions: TStringList; IDChangedInterfaces: TIntList; FindedInterf: Boolean; GenLastInterfID, PropRequiredIndex: Integer; PropInterfCnt: Integer; //08.02.2011 Количество интерфейсов от свойства - //08.02.2011 например для одного свойства соединителя "Размер стороны ЭКК" нужно два интерфейса CCEType: Integer; //08.02.2011 - тип ЭКК HaveComponRequiredProp, HaveComponPropPort, HaveComponPropInSection, HaveComponPropOutSection: Boolean; HaveComponPropFunctional: Boolean; // Есть ли свойство, под которое идет функциональный интерфейс InternalConnCnt: Integer; function GetNewInterfPortRel(const AGUID: string): TSCSInterface; var SprInterface: TNBInterface; begin if GenLastInterfID = 0 then GenLastInterfID := GetLastInterfRelID(TF_Main(Compon.FActiveForm).GDBMode); GenLastInterfID := GenLastInterfID + 1; Result := TSCSInterface.Create(Compon.FActiveForm); Result.ID := GenLastInterfID; Result.ID_COMPONENT := Compon.ID; Result.IsLineCompon := Compon.IsLine; Result.Color := clWhite; Result.ID_INTERFACE := 0; Result.IsBusy := biFalse; Result.SignType := oitProjectible; SprInterface := Spravochnik.CreateInterfaceByStandartGUID(AGUID); Result.AssignFromSpr(SprInterface); Result.ComponentOwner := Compon; Result.IsNew := true; //16.08.2010 Compon.FInterfaces.Add(Result); end; procedure SetInterfPortRelSprGUID(AInterf: TSCSInterface; const AGUID: String); var SprInterface: TNBInterface; begin AInterf.ID_COMPONENT := Compon.ID; SprInterface := Spravochnik.CreateInterfaceByStandartGUID(AGUID); AInterf.ID_INTERFACE := SprInterface.ID; AInterf.GUIDInterface := AGUID; AInterf.Name := SprInterface.Name; end; function GetNewPortInterfRel: PPortInterfRel; begin GetZeroMem(Result, SizeOf(TPortInterfRel)); Result.IsNew := true; end; procedure InterfChanged(AInter: TSCSInterface); begin AInter.IsModified := true; //16.08.2010 end; procedure PortInterfRelChanged(APortInterfRel: PPortInterfRel); begin APortInterfRel.IsModified := true; end; begin if GAllowConvertInterfToUniversal then begin try if {//07.07.2009} (GUseLiteFunctional) and // При лайт функцыонале очищать обычные инетрфейсы, если есть такие же универсальные //22.07.2009 GLiteVersion and ((ACompon.IsTemplate = biFalse) or AIncludingTemplate) then begin // Формируем список компонентов ComponList := TSCSComponents.Create(false); ComponList.Assign(ACompon.ChildReferences); ComponList.Insert(0, ACompon); for i := 0 to ComponList.Count - 1 do begin Compon := TSCSComponent(ComponList.List.List^[i]); if Not Compon.ServIsSetToLite then begin // Проверяем, есть ли в компонента свойство, по которому определяется интерфейс HaveComponRequiredProp := false; HaveComponPropPort := false; HaveComponPropFunctional := false; // Есть ли свойство, под которое идет функциональный интерфейс HaveComponPropInSection := false; HaveComponPropOutSection := false; for j := 0 to Compon.FProperties.Count - 1 do begin Prop := Compon.FProperties.List^[j]; PropRequiredIndex := GPropRequired.IndexOf(Prop.SysName); if PropRequiredIndex <> -1 then begin HaveComponRequiredProp := true; if PropRequiredIndex = GPropRequiredIndexPortCount then HaveComponPropPort := true else if (PropRequiredIndex = GPropRequiredIndexPortWireCount) or (PropRequiredIndex = GPropRequiredIndexWireCount) then HaveComponPropFunctional := true else if (PropRequiredIndex = GPropRequiredIndexConduitSideDimensions) or (PropRequiredIndex = GPropRequiredIndexConduitElmentSideDimensions) or (PropRequiredIndex = GPropRequiredIndexConduitElmentSide1Dimensions) or (PropRequiredIndex = GPropRequiredIndexConduitElmentSide2Dimensions) or (PropRequiredIndex = GPropRequiredIndexConduitElmentSide3Dimensions) or (PropRequiredIndex = GPropRequiredIndexConduitElmentSide4Dimensions) then HaveComponPropFunctional := true else if PropRequiredIndex = GPropRequiredIndexInSection then HaveComponPropInSection := true else if PropRequiredIndex = GPropRequiredIndexOutSection then HaveComponPropOutSection := true; //Break; //// BREAK //// end; end; // Убрать левые функциональные интерфейсы и порты для точ. // и все не универсвльные интерфейсы для линейных if HaveComponRequiredProp then begin j := Compon.FInterfaces.Count - 1; while j >= 0 do begin Interf := TSCSInterface(Compon.FInterfaces.List.List^[j]); InterfaceTypeToRemove := false; case Compon.IsLine of biTrue: begin // Если функциональный, или конструктивный+емкостной //if (Interf.TypeI = itFunctional) or (Interf.Multiple = biTrue) then // InterfaceTypeToRemove := true; if (Interf.TypeI = itFunctional) and HaveComponPropFunctional then InterfaceTypeToRemove := true else // конструктивный+емкостной if (Interf.TypeI = itConstructive) and (Interf.Multiple = biTrue) then // Если найдено внутр сечение if (Interf.Gender = gtFemale) and HaveComponPropInSection then InterfaceTypeToRemove := true else // Если найдено внешн сечение if (Interf.Gender = gtMale) and HaveComponPropOutSection then InterfaceTypeToRemove := true; end; biFalse: begin if Interf.TypeI = itFunctional then // Если для порта найдено свойство if (Interf.IsPort = biTrue) and HaveComponPropPort then InterfaceTypeToRemove := true else // Если для функц. интерфейса найдено свойство if (Interf.IsPort = biFalse) and HaveComponPropFunctional then InterfaceTypeToRemove := true; end; end; if InterfaceTypeToRemove then if Interf.GUIDInterface <> '' then if GUniversalInterfaces.IndexOf(Interf.GUIDInterface) = -1 then begin Interf.Free; Compon.FInterfaces.Delete(j); //Continue; //// CONTINUE //// end; j := j - 1; end; end; PropSysNamesConduitElmtSideDimensions := nil; Spravochnik := nil; Prop := nil; Port := nil; Interf := nil; if Spravochnik = nil then Spravochnik := TF_Main(Compon.FActiveForm).GetSpravochnik; GenLastInterfID := 0; // Определяем интерфейсы по свойствам if Not Compon.IsCrossComponent then begin if Compon.FProperties.Count > 0 then begin //GenLastInterfID := 0; if PropSysNamesConduitElmtSideDimensions = nil then begin PropSysNamesConduitElmtSideDimensions := CreateStringListSorted; //TStringList.Create; PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSideDimensions); // Размеры стороны элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide1Dimensions); // Размеры стороны 1 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide2Dimensions); // Размеры стороны 2 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide3Dimensions); // Размеры стороны 3 элемента канала PropSysNamesConduitElmtSideDimensions.Add(pnConduitElmentSide4Dimensions); // Размеры стороны 4 элемента канала end; CCEType := Compon.GetPropertyValueAsInteger(pnCableCanalElemetType); for j := 0 to Compon.FProperties.Count - 1 do begin ReqProp := Compon.FProperties.List^[j]; if GPropRequired.IndexOf(ReqProp.SysName) <> -1 then begin Prop := nil; Port := nil; Interf := nil; if (ReqProp.SysName = pnPortCount) or (ReqProp.SysName = pnPortWireCount) then begin if StrToIntDef(ReqProp.Value, 0) > 0 then begin PortCount := -1; PortWireCount := -1; if ReqProp.SysName = pnPortCount then begin // Количество портов и жил на порт PortCount := StrToIntDef(ReqProp.Value, 0); Prop := Compon.GetPropertyBySysName(pnPortWireCount); if Prop <> nil then PortWireCount := StrToIntDef(Prop.Value, 0); // Добавляем/изменяем порт Port := GetComponInterfBySprGUID(Compon, guidUniversalPort); if Port = nil then begin Port := GetNewInterfPortRel(guidUniversalPort); Port.IsPort := biTrue; Port.TypeI := itFunctional; Port.Kind := ikSplit; Port.Gender := gtFemale; Port.Multiple := biFalse; Port.Kolvo := PortCount; end else begin Port.Kolvo := PortCount; end; InterfChanged(Port); end else if ReqProp.SysName = pnPortWireCount then begin // Количество жил на порт и портов PortWireCount := StrToIntDef(ReqProp.Value, 0); Prop := Compon.GetPropertyBySysName(pnPortCount); if Prop <> nil then PortCount := StrToIntDef(Prop.Value, 0); // Ищем ID порта Port := GetComponInterfBySprGUID(Compon, guidUniversalPort); end; // Добавляем/изменяем интерфейс + его привязку к порту if PortWireCount <> -1 then begin InterfRelCount := PortWireCount; if PortCount <> -1 then InterfRelCount := PortCount * PortWireCount; // Добавляем/изменяем интерфейс interf := GetComponInterfaceByTypeAndGender(Compon, itfunctional, gtFemale, biFalse, guidUniversalWire); if Interf = nil then begin Interf := GetNewInterfPortRel(guidUniversalWire); Interf.IsPort := biFalse; Interf.TypeI := itFunctional; Interf.Kind := ikNoSplit; Interf.Gender := gtFemale; Interf.Multiple := biFalse; Interf.Kolvo := InterfRelCount; end else begin Interf.Kolvo := InterfRelCount; end; InterfChanged(Interf); // Добавляем/изменяем привязку интерфейса к порту if (Port <> nil) and (Interf <> nil) then begin PortInterfRel := Port.GetPortInterfRelByInterfID(Interf.ID); if PortInterfRel = nil then begin //GetZeroMem(PortInterfRel, SizeOf(TPortInterfRel)); PortInterfRel := GetNewPortInterfRel; PortInterfRel.ID := 0; PortInterfRel.RelType := rtPortInterfRel; PortInterfRel.IDPort := Port.ID; PortInterfRel.IDInterfRel := Interf.ID; PortInterfRel.UnitInterfKolvo := PortWireCount; Port.FPortInterfRels.Add(PortInterfRel); Port.DefineInternalRelations; end else begin PortInterfRel.UnitInterfKolvo := PortWireCount; end; PortInterfRelChanged(PortInterfRel); end; end; end; end else //Количество жил if ReqProp.SysName = pnWireCount then begin WireCount := StrToIntDef(ReqProp.Value, 0); if WireCount > 0 then begin PropGender := gtMale; // Если компонент точечный (мало ли), то интерфейс будет мама if Compon.IsLine = biFalse then PropGender := gtFemale; // Добавляем/изменяем интерфейс Interf := GetComponInterfaceByTypeAndGender(Compon, itfunctional, PropGender, biFalse, guidUniversalWire); if Interf = nil then begin Interf := GetNewInterfPortRel(guidUniversalWire); Interf.IsPort := biFalse; Interf.TypeI := itFunctional; Interf.Kind := ikNoSplit; Interf.Gender := PropGender; Interf.Multiple := biFalse; Interf.Kolvo := WireCount; // Для линейного компонента создаем парный интерфейс InterfAdverse := GetNewInterfPortRel(guidUniversalWire); InterfAdverse.Assign(Interf, true); InterfAdverse.ID := GenLastInterfID; RelateParallelInterfaces(Interf, InterfAdverse); end else begin Interf.Kolvo := WireCount; // Для линейного компонента рихтуем парный интерфейс if Compon.IsLine = biTrue then begin InterfAdverse := Compon.GetInterfaceByID(Interf.IDAdverse); if InterfAdverse <> nil then InterfAdverse.Kolvo := WireCount; end; end; InterfChanged(Interf); end; end else // Внешний/внутренний сечение - для кабеля и каб канала if (ReqProp.SysName = pnInSection) or (ReqProp.SysName = pnOutSection) then begin InterfSection := StrToFloatDef_My(ReqProp.Value, 0); if InterfSection > 0 then begin InterfSection := FloatInUOM(InterfSection, umMM, umSM, 2); // Добавляем/изменяем интерфейс InterfGuid := guidUniversalInConstr; PropGender := gtFemale; if ReqProp.SysName = pnOutSection then begin InterfGuid := guidUniversalOutConstr; PropGender := gtMale; end; Interf := GetComponInterfaceByTypeAndGender(Compon, itConstructive, PropGender, biTrue, InterfGuid); if Interf = nil then begin Interf := GetNewInterfPortRel(InterfGuid); Interf.IsPort := biFalse; Interf.TypeI := itConstructive; Interf.Kind := ikNoSplit; Interf.Gender := PropGender; Interf.Multiple := biTrue; Interf.Kolvo := 1; Interf.ValueI := InterfSection; end else begin Interf.ValueI := InterfSection; end; InterfChanged(Interf); end; end else // Размеры сторон кабельного канала - применяется на каб канале if ReqProp.SysName = pnConduitSideDimensions then begin PropGender := gtMale; // Если компонент точечный, то интерфейс будет мама if Compon.IsLine = biFalse then PropGender := gtFemale; // Добавляем/изменяем интерфейс Interf := GetComponInterfaceByTypeAndGender(Compon, itFunctional, PropGender, biFalse, guidUniversalChannelSide); if Interf = nil then begin Interf := GetNewInterfPortRel(guidUniversalChannelSide); Interf.IsPort := biFalse; Interf.TypeI := itFunctional; Interf.Kind := ikNoSplit; Interf.Gender := PropGender; Interf.Multiple := biFalse; Interf.Kolvo := 1; Interf.SideSection := ReqProp.Value; // Для линейного компонента создаем парный интерфейс if Compon.IsLine = biTrue then begin InterfAdverse := GetNewInterfPortRel(guidUniversalWire); InterfAdverse.Assign(Interf, true); InterfAdverse.ID := GenLastInterfID; RelateParallelInterfaces(Interf, InterfAdverse); end; end else begin Interf.SideSection := ReqProp.Value; if Compon.IsLine = biTrue then begin InterfAdverse := Compon.GetInterfaceByID(Interf.IDAdverse); if InterfAdverse <> nil then InterfAdverse.SideSection := ReqProp.Value; end; end; InterfChanged(Interf); end else // Размеры стороны элемента канала if PropSysNamesConduitElmtSideDimensions.IndexOf(ReqProp.SysName) <> -1 then begin IDChangedInterfaces := TIntList.Create; try // Для каждого свойства, определяющего размерность, определяем интерфейс for k := 0 to PropSysNamesConduitElmtSideDimensions.Count - 1 do begin Prop := Compon.GetPropertyBySysName(PropSysNamesConduitElmtSideDimensions[k]); if Prop <> nil then begin PropInterfCnt := 1; if (CCEType = contConnector) and (Prop.SysName = pnConduitElmentSideDimensions) then PropInterfCnt := 2; while PropInterfCnt > 0 do begin FindedInterf := false; for l := 0 to Compon.FInterfaces.Count - 1 do begin Interf := TSCSInterface(Compon.FInterfaces.List.List^[l]); if (Interf.GUIDInterface = guidUniversalChannelSide) and (Interf.IsPort = biFalse) and (IDChangedInterfaces.IndexOf(Interf.ID) = -1) and (Interf.Gender = gtFemale) and (Interf.TypeI = itFunctional) then begin Interf.SideSection := Prop.Value; InterfChanged(Interf); FindedInterf := true; Break; //// BREAK //// end; end; if Not FindedInterf then begin Interf := GetNewInterfPortRel(guidUniversalChannelSide); Interf.IsPort := biFalse; Interf.TypeI := itFunctional; Interf.Kind := ikNoSplit; Interf.Gender := gtFemale; Interf.Multiple := biFalse; Interf.Kolvo := 1; Interf.SideSection := Prop.Value; end; IDChangedInterfaces.Add(Interf.ID); PropInterfCnt := PropInterfCnt-1; // Уменьшаем счетчик end; end; end; finally FreeAndNil(IDChangedInterfaces); end; end; end; end; FreeAndNil(PropSysNamesConduitElmtSideDimensions); end; end else begin // Добавляем интерфейсы Interf := GetComponInterfaceByTypeAndGender(Compon, itFunctional, gtMale, biFalse, guidUniversalPort); if Interf = nil then begin //25.10.2011 - Ищем инетрфейсы кросса, заменяем на универсальные "порты" Interf := nil; InterfAdverse := nil; for j := 0 to Compon.FInterfaces.Count - 1 do begin TempInterf1 := Compon.FInterfaces[j]; if (TempInterf1.PortInterfRels.Count > 0) and (TempInterf1.TypeI = itFunctional) and (TempInterf1.Gender = gtMale) then begin InternalConnCnt := 0; for k := 0 to TempInterf1.PortInterfRels.Count - 1 do begin PortInterfRel := TempInterf1.PortInterfRels[k]; if PortInterfRel.RelType = rtInterfInternalConn then begin TempInterf2 := Compon.GetInterfaceByID(PortInterfRel.IDInterfRel); if (TempInterf2 <> nil) and (TempInterf1.TypeI = itFunctional) and (TempInterf1.Gender = gtMale) then if (TempInterf2.GUIDInterface = TempInterf1.GUIDInterface) then begin SetInterfPortRelSprGUID(TempInterf2, guidUniversalPort); Inc(InternalConnCnt); Interf := TempInterf1; // чтобы сработало условие if (Interf = nil) and (InterfAdverse = nil) then InterfAdverse := TempInterf2; end; end; end; if InternalConnCnt > 0 then SetInterfPortRelSprGUID(TempInterf1, guidUniversalPort); end; end; // Если нихрена не заменили из обычных интерфейсов на цниверс.порты, то создаем их if (Interf = nil) and (InterfAdverse = nil) then begin Interf := GetNewInterfPortRel(guidUniversalPort); Interf.IsPort := biFalse; Interf.TypeI := itFunctional; Interf.Kind := ikSplit; Interf.Gender := gtMale; Interf.Multiple := biFalse; Interf.Kolvo := 1; Port := GetNewInterfPortRel(guidUniversalPort); Port.Assign(Interf, true); Port.ID := GenLastInterfID; // Добавляем привязку интерфейсов //GetZeroMem(PortInterfRel, SizeOf(TPortInterfRel)); PortInterfRel := GetNewPortInterfRel; PortInterfRel.ID := 0; PortInterfRel.RelType := rtInterfInternalConn; PortInterfRel.IDPort := Port.ID; PortInterfRel.IDInterfRel := Interf.ID; PortInterfRel.UnitInterfKolvo := 1; Port.FPortInterfRels.Add(PortInterfRel); Port.DefineInternalRelations; end; end; end; // Если адаптер и без интерфейсов, то добавляем порты мама-папа if Compon.ComponentType.SysName = ctsnAdapter then if Compon.Interfaces.Count = 0 then begin Interf := GetNewInterfPortRel(guidUniversalPort); Interf.IsPort := biTrue; Interf.TypeI := itFunctional; Interf.Kind := ikSplit; Interf.Gender := gtMale; Interf.Multiple := biFalse; Interf.Kolvo := 1; Port := GetNewInterfPortRel(guidUniversalPort); Port.Assign(Interf, true); Port.Gender := gtFemale; Port.ID := GenLastInterfID; // Добавляем привязку интерфейсов //GetZeroMem(PortInterfRel, SizeOf(TPortInterfRel)); PortInterfRel := GetNewPortInterfRel; PortInterfRel.ID := 0; PortInterfRel.RelType := rtInterfInternalConn; PortInterfRel.IDPort := Port.ID; PortInterfRel.IDInterfRel := Interf.ID; PortInterfRel.UnitInterfKolvo := 1; Port.FPortInterfRels.Add(PortInterfRel); Port.DefineInternalRelations; end; if PropSysNamesConduitElmtSideDimensions <> nil then FreeAndNil(PropSysNamesConduitElmtSideDimensions); Compon.ServIsSetToLite := true; end; end; FreeAndNil(ComponList); end; except on E: Exception do AddExceptionToLogEx('SetComponAsLite', E.Message); end; end; end; procedure SortCatalogListInItemType(ACatalogs: TSCSCatalogs; AItemType: Integer; AIsBackSorting: Boolean); var CurrCatalogI, CurrCatalogJ, PrevItemTypedCatalog: TSCSCatalog; i, j: Integer; CanExchangeItems: Boolean; begin PrevItemTypedCatalog := nil; for i := 0 to ACatalogs.Count - 1 do begin CurrCatalogI := ACatalogs[i]; if CurrCatalogI.ItemType = AItemType then for j := i to ACatalogs.Count - 1 do begin CurrCatalogJ := ACatalogs[j]; if (CurrCatalogJ.ItemType = AItemType) and (i <> j) then begin CanExchangeItems := false; if Not AIsBackSorting and (CurrCatalogI.SortID > CurrCatalogJ.SortID) then CanExchangeItems := true else if AIsBackSorting and (CurrCatalogI.SortID < CurrCatalogJ.SortID) then CanExchangeItems := true; if CanExchangeItems then begin ACatalogs.Exchange(i, j); ExchangeObjects(CurrCatalogI, CurrCatalogJ); end; end; end; end; end; procedure SortComponentsByID(ASCSComponents: TSCSComponents); var i, j, LastMaxSortID: Integer; SCSComponentI, SCSComponentJ: TSCSComponent; begin LastMaxSortID := -1; for i := 0 to ASCSComponents.Count - 1 do begin SCSComponentI := ASCSComponents[i]; for j := i to ASCSComponents.Count - 1 do begin SCSComponentJ := ASCSComponents[j]; if SCSComponentJ.ID < SCSComponentI.ID then begin ASCSComponents.Exchange(i, j); //FItems.Move(i, j); ExchangeObjects(SCSComponentJ, SCSComponentI); end; end; end; end; procedure SortComponentsByOutDiametr(ASCSComponents: TSCSComponents; ADescending: Boolean); var i, j: Integer; SCSComponentI, SCSComponentJ: TSCSComponent; DiametrI, DiametrJ: Double; begin for i := 0 to ASCSComponents.Count - 1 do begin SCSComponentI := ASCSComponents[i]; DiametrI := GetComponOutDiametrInMetr(SCSComponentI); for j := i to ASCSComponents.Count - 1 do begin SCSComponentJ := ASCSComponents[j]; DiametrJ := GetComponOutDiametrInMetr(SCSComponentJ); if (Not ADescending and ((DiametrI - DiametrJ) > 0.001) ) or (ADescending and ((DiametrJ - DiametrI) > 0.001) ) then begin ASCSComponents.Exchange(i, j); ExchangeObjects(SCSComponentJ, SCSComponentI); ExchangeDouble(DiametrI, DiametrJ); end; end; end; end; procedure SortSCSObjectsByPMOrder(AObjectList: TSCSCatalogs); var SavedObjectList: TSCSCatalogs; ProjectOwner: TSCSProject; FindedProjLists: TSCSLists; StartIndex, EndIndex, StepIndex, i: Integer; SCSCatalog: TSCSCatalog; CatalogListOwner, ProjList: TSCSList; procedure LookObject(ASCSObject: TSCSCatalog); var i: Integer; ChildObject: TSCSCatalog; begin if SavedObjectList.IndexOf(ASCSObject) <> -1 then AObjectList.Add(ASCSObject); //*** Пробежка по комнатам if ASCSObject is TSCSList then for i := 0 to ASCSObject.FChildCatalogs.Count - 1 do begin ChildObject := ASCSObject.FChildCatalogs[i]; if ChildObject.ItemType = itRoom then LookObject(ChildObject); end; //*** Пробежка по Остальным объектам for i := 0 to ASCSObject.FChildCatalogs.Count - 1 do begin ChildObject := ASCSObject.FChildCatalogs[i]; if ChildObject.ItemType <> itRoom then LookObject(ChildObject); end; end; begin if AObjectList <> nil then if AObjectList.Count > 0 then begin ProjectOwner := nil; FindedProjLists := TSCSLists.Create(false); SavedObjectList := TSCSCatalogs.Create(false); //*** Определить используемые листы for i := 0 to AObjectList.Count - 1 do begin SCSCatalog := AObjectList[i]; if ProjectOwner = nil then ProjectOwner := SCSCatalog.FProjectOwner; CatalogListOwner := SCSCatalog.GetListOwner; if CatalogListOwner <> nil then if FindedProjLists.IndexOf(CatalogListOwner) = -1 then FindedProjLists.Add(CatalogListOwner); end; //*** Переберая объекты проекта, проверять - есть ли объект в списке SavedObjectList, // если да , то кидать его в AObjectList if ProjectOwner <> nil then begin SavedObjectList.Assign(AObjectList, laCopy); AObjectList.Clear; StartIndex := 0; EndIndex := ProjectOwner.FProjectLists.Count - 1; StepIndex := 1; // *** Учитывать реверсивный порядок листов if ProjectOwner.Setting.ListsInReverseOrder then begin StartIndex := ProjectOwner.FProjectLists.Count - 1; EndIndex := 0; StepIndex := -1; end; //*** Перебор листов i := StartIndex; while ((i <= EndIndex) and Not ProjectOwner.Setting.ListsInReverseOrder) or ((i >= EndIndex) and ProjectOwner.Setting.ListsInReverseOrder) do begin ProjList := ProjectOwner.FProjectLists[i]; if FindedProjLists.IndexOf(ProjList) <> -1 then //*** Перебрать объекты листа рекурсивно LookObject(ProjList); i := i + StepIndex; end; end; FreeAndNil(SavedObjectList); FreeAndNil(FindedProjLists); end; end; procedure TNBInterfaceNorm.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.FCatalog.FBuildID < ProjBuildIDWithStrMan then begin Self.GuidInterface := tSQL_InterfaceNorms.FieldByName(fnGuidInterface).AsString; Self.GuidNBNorm := tSQL_InterfaceNorms.FieldByName(fnGuidNBNorm).AsString; if tSQL_InterfaceNorms.FieldDefs.IndexOf(fnGuidComponentType) <> -1 then Self.GUIDComponentType := tSQL_InterfaceNorms.FieldByName(fnGuidComponentType).AsString; end else begin Self.GuidInterface := AStringsMan.GetStrByID(tSQL_InterfaceNorms.FieldByName(fnGuidInterface).AsInteger, AStringsMan.FInterfaceGUIDStrings); Self.GuidNBNorm := AStringsMan.GetStrByID(tSQL_InterfaceNorms.FieldByName(fnGuidNBNorm).AsInteger, AStringsMan.FNormGuidNBStrings); if tSQL_InterfaceNorms.FieldDefs.IndexOf(fnGuidComponentType) <> -1 then Self.GUIDComponentType := AStringsMan.GetStrByID(tSQL_InterfaceNorms.FieldByName(fnGuidComponentType).AsInteger, AStringsMan.FComponentTypeGUIDStrings); end; Self.ID := tSQL_InterfaceNorms.FieldByName(fnID).AsInteger; Self.GUID := tSQL_InterfaceNorms.FieldByName(fnGuid).AsString; Self.IDInterface := tSQL_InterfaceNorms.FieldByName(fnIDInterface).AsInteger; Self.IDNBNorm := tSQL_InterfaceNorms.FieldByName(fnIDNBNorm).AsInteger; Self.Expense := tSQL_InterfaceNorms.FieldByName(fnExpense).AsFloat; Self.InterfaceIsBusy := tSQL_InterfaceNorms.FieldByName(fnInterfaceIsBusy).AsInteger; if tSQL_InterfaceNorms.FieldDefs.IndexOf(fnGuidComponentType) <> -1 then begin Self.IDComponentType := tSQL_InterfaceNorms.FieldByName(fnIDComponentType).AsInteger; Self.KoefLengthForCompl := tSQL_InterfaceNorms.FieldByName(fnKoefLengthForCompl).AsFloat; end; end; end; procedure TNBInterfaceNorm.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_InterfaceNorms.Append; meEdit: if tSQL_InterfaceNorms.Locate(fnID, ID, []) then tSQL_InterfaceNorms.Edit; end; if tSQL_InterfaceNorms.State <> dsBrowse then begin tSQL_InterfaceNorms.FieldByName(fnID).AsInteger := Self.ID; tSQL_InterfaceNorms.FieldByName(fnGuid).AsString := Self.GUID; tSQL_InterfaceNorms.FieldByName(fnGuidInterface).AsInteger := AStringsMan.GenStrID(Self.GuidInterface, AStringsMan.FInterfaceGUIDStrings); tSQL_InterfaceNorms.FieldByName(fnIDInterface).AsInteger := Self.IDInterface; tSQL_InterfaceNorms.FieldByName(fnGuidNBNorm).AsInteger := AStringsMan.GenStrID(Self.GuidNBNorm, AStringsMan.FNormGuidNBStrings); tSQL_InterfaceNorms.FieldByName(fnIDNBNorm).AsInteger := Self.IDNBNorm; tSQL_InterfaceNorms.FieldByName(fnExpense).AsFloat := Self.Expense; tSQL_InterfaceNorms.FieldByName(fnInterfaceIsBusy).AsInteger := Self.InterfaceIsBusy; tSQL_InterfaceNorms.FieldByName(fnGuidComponentType).AsInteger := AStringsMan.GenStrID(Self.GUIDComponentType, AStringsMan.FComponentTypeGUIDStrings); tSQL_InterfaceNorms.FieldByName(fnIDComponentType).AsInteger := Self.IDComponentType; tSQL_InterfaceNorms.FieldByName(fnKoefLengthForCompl).AsFloat := Self.KoefLengthForCompl; tSQL_InterfaceNorms.Post; end; end; end; procedure TNBInterfaceNorm.Save(AMakeEDit: TMakeEdit); var InterfaceNormInfo: TInterfaceNormInfo; begin ZeroMemory(@InterfaceNormInfo, SizeOf(TInterfaceNormInfo)); InterfaceNormInfo.ID := ID; InterfaceNormInfo.GUID := GUID; InterfaceNormInfo.IDInterface := IDInterface; InterfaceNormInfo.IDNBNorm := IDNBNorm; InterfaceNormInfo.Expense := Expense; InterfaceNormInfo.IDComponentType := IDComponentType; InterfaceNormInfo.InterfaceIsBusy := InterfaceIsBusy; InterfaceNormInfo.KoefLengthForCompl := KoefLengthForCompl; TF_Main(FactiveForm).DM.SaveInterfaceNorm(AMakeEdit, @InterfaceNormInfo); if AMakeEdit = meMake then ID := InterfaceNormInfo.ID; end; { TNBCompTypeProperty } procedure TNBCompTypeProperty.Assign(ACompTypeProperty: TNBCompTypeProperty); begin GuidComponentType := ACompTypeProperty.GuidComponentType; PropertyData := ACompTypeProperty.PropertyData; end; procedure TNBCompTypeProperty.AssignFromNBProperty(AProperty: TNBProperty); begin PropertyData.ID_Property := AProperty.PropertyData.ID; PropertyData.GUIDProperty := AProperty.PropertyData.GUID; PropertyData.Value := AProperty.PropertyData.DefValue; PropertyData.Name_ := AProperty.PropertyData.Name; PropertyData.SysName := AProperty.PropertyData.SysName; PropertyData.IsForWholeComponent := AProperty.PropertyData.IsForWholeComponent; PropertyData.IDDataType := AProperty.PropertyData.IDDataType; end; procedure TNBCompTypeProperty.AssignToPProperty(AProperty: PProperty); var Sprproperty: TNBProperty; begin AProperty.ID_Property := Self.PropertyData.ID_Property; AProperty.Name_ := Self.PropertyData.Name_; AProperty.SysName := Self.PropertyData.SysName; AProperty.Value := Self.PropertyData.Value; AProperty.IsDefault := biTrue; AProperty.GUIDProperty := Self.PropertyData.GUIDProperty; AProperty.TakeIntoConnect := Self.PropertyData.TakeIntoConnect; AProperty.TakeIntoJoin := Self.PropertyData.TakeIntoJoin; Sprproperty := nil; if FOwner <> nil then if FOwner.FOwner <> nil then Sprproperty := FOwner.FOwner.GetPropertyByGUID(Self.PropertyData.GUIDProperty); if Sprproperty <> nil then begin AProperty.IsForWholeComponent := Sprproperty.PropertyData.IsForWholeComponent; end; end; constructor TNBCompTypeProperty.Create(AFormOwner: TForm); begin inherited Create(AFormOwner); GuidComponentType := ''; IsModified := false; ZeroMemory(@PropertyData, SizeOf(TProperty)); end; procedure TNBCompTypeProperty.LoadFromMemTable(AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin if AStringsMan.Catalog.CurrBuildID < ProjBuildIDWithStrMan then begin GuidComponentType := tSQL_CompTypePropRelation.FieldByName(fnGuidComponentType).AsString; PropertyData.GUIDProperty := tSQL_CompTypePropRelation.FieldByName(fnGuidProperty).AsString; PropertyData.Value := tSQL_CompTypePropRelation.FieldByName(fnPValue).AsString; end else begin GuidComponentType := AStringsMan.GetStrByID(tSQL_CompTypePropRelation.FieldByName(fnGuidComponentType).AsInteger, AStringsMan.FComponentTypeGUIDStrings); PropertyData.GUIDProperty := AStringsMan.GetStrByID(tSQL_CompTypePropRelation.FieldByName(fnGuidProperty).AsInteger, AStringsMan.FPropertyGUIDStrings); PropertyData.Value := AStringsMan.GetStrByID(tSQL_CompTypePropRelation.FieldByName(fnPValue).AsInteger, AStringsMan.FPropertyValueStrings); end; PropertyData.Guid := tSQL_CompTypePropRelation.FieldByName(fnGUID).AsString; PropertyData.ID := tSQL_CompTypePropRelation.FieldByName(fnID).AsInteger; PropertyData.IDMaster := tSQL_CompTypePropRelation.FieldByName(fnIDComponentType).AsInteger; PropertyData.ID_Property := tSQL_CompTypePropRelation.FieldByName(fnIDProperty).AsInteger; PropertyData.TakeIntoConnect := tSQL_CompTypePropRelation.FieldByName(fnTakeIntoConnect).AsInteger; PropertyData.TakeIntoJoin := tSQL_CompTypePropRelation.FieldByName(fnTakeIntoJoin).AsInteger; PropertyData.IsDefault := tSQL_CompTypePropRelation.FieldByName(fnisStandart).AsInteger; end; end; procedure TNBCompTypeProperty.SaveToMemTable(AMakeEdit: TMakeEdit; AStringsMan: TStringsMan); begin with TF_Main(FActiveForm).DM do begin case AMakeEdit of meMake: tSQL_CompTypePropRelation.Append; meEdit: if tSQL_CompTypePropRelation.Locate(fnID, PropertyData.ID, []) then tSQL_CompTypePropRelation.Edit; end; if tSQL_CompTypePropRelation.State <> dsBrowse then begin tSQL_CompTypePropRelation.FieldByName(fnGuidComponentType).AsInteger := AStringsMan.GenStrID(GuidComponentType, AStringsMan.FComponentTypeGUIDStrings); tSQL_CompTypePropRelation.FieldByName(fnGUID).AsString := PropertyData.Guid; tSQL_CompTypePropRelation.FieldByName(fnID).AsInteger := PropertyData.ID; tSQL_CompTypePropRelation.FieldByName(fnIDComponentType).AsInteger := PropertyData.IDMaster; tSQL_CompTypePropRelation.FieldByName(fnIDProperty).AsInteger := PropertyData.ID_Property; tSQL_CompTypePropRelation.FieldByName(fnGuidProperty).AsInteger := AStringsMan.GenStrID(PropertyData.GUIDProperty, AStringsMan.FPropertyGUIDStrings); tSQL_CompTypePropRelation.FieldByName(fnTakeIntoConnect).AsInteger := PropertyData.TakeIntoConnect; tSQL_CompTypePropRelation.FieldByName(fnTakeIntoJoin).AsInteger := PropertyData.TakeIntoJoin; tSQL_CompTypePropRelation.FieldByName(fnPValue).AsInteger := AStringsMan.GenStrID(PropertyData.Value, AStringsMan.FPropertyValueStrings); tSQL_CompTypePropRelation.FieldByName(fnisStandart).AsInteger := PropertyData.IsDefault; tSQL_CompTypePropRelation.Post; end; end; end; { TPointFigureRelation } constructor TPointFigureRelation.Create; begin inherited; FTraces := TIntList.Create; FFirstPointObject := nil; FLastPointObject := nil; FTracesObjects := TSCSCatalogs.Create(false); end; destructor TPointFigureRelation.Destroy; begin FreeAndNil(FTraces); FreeAndNil(FTracesObjects); inherited; end; { TCADNormColumn } procedure TCADNormColumn.Assign(ACADNormColumn: TCADNormColumn); begin FID := ACADNormColumn.ID; FIDCADNormStruct := ACADNormColumn.FIDCADNormStruct; FCableName := ACADNormColumn.FCableName; FColumns.Text := ACADNormColumn.FColumns.Text; end; constructor TCADNormColumn.Create; begin inherited; FID := -1; FIDCADNormStruct := -1; FCableName := ''; FColumns := TStringList.Create; end; destructor TCADNormColumn.Destroy; begin FreeAndNil(FColumns); inherited; end; { TCADNormStruct } procedure TCADNormStruct.Assing(ACADNormStruct: TCADNormStruct); begin AssignOnlyCADNorm(ACADNormStruct); AssignNormColumns(ACADNormStruct.FNormColumns); end; procedure TCADNormStruct.AssignOnlyCADNorm(ACADNormStruct: TCADNormStruct); begin FID := ACADNormStruct.FID; FNumber := ACADNormStruct.FNumber; FName := ACADNormStruct.FName; FIzm := ACADNormStruct.FIzm; FCount := ACADNormStruct.FCount; FIDCatalog := ACADNormStruct.FIDCatalog; FCatalogItemType := ACADNormStruct.FCatalogItemType; end; procedure TCADNormStruct.AssignNormColumns(ANormColumns: TObjectList); var CADNormColumn, NewCADNormColumn: TCADNormColumn; i: Integer; begin FNormColumns.Clear; for i := 0 to ANormColumns.Count - 1 do begin CADNormColumn := TCADNormColumn(ANormColumns[i]); NewCADNormColumn := TCADNormColumn.Create; FNormColumns.Add(NewCADNormColumn); NewCADNormColumn.Assign(CADNormColumn); NewCADNormColumn.FIDCADNormStruct := ID; end; end; constructor TCADNormStruct.Create; begin inherited; FID := -1; FNumber := ''; FName := ''; FIzm := ''; FCount := ''; FIDCatalog := -1; FCatalogItemType := -1; FNormColumns := TObjectList.Create(true); end; destructor TCADNormStruct.Destroy; begin FreeAndNil(FNormColumns); inherited; end; { TMarkTemplateObj } constructor TMarkTemplateObj.Create; begin inherited; FBeforeText := ''; FObjPrefix := #0; FMinIndexLength := 0; FLetter := biFalse; FRadix := 0; FAfterText := ''; end; destructor TMarkTemplateObj.Destroy; // Tolik 12/12/2019 begin inherited; end; function TMarkTemplateObj.IndexToStr(AVal: Integer): String; var Digits: Integer; begin Result := ''; if FLetter = biTrue then Result := DecToABC(AVal) else if FRadix > 1 then begin if FRadix = 16 then begin Digits := 1; if Self.FMinIndexLength > 0 then Digits := Self.FMinIndexLength; Result := IntToHex(AVal, Digits) end else begin Result := AnsiUpperCase(Int2Str(AVal, FRadix)); if Self.FMinIndexLength > 0 then Result := StrToMinLen(Result, Self.FMinIndexLength); end; end else Result := IntToStrF(AVal, Self.FMinIndexLength); end; { TCheckCollectComponJoinToComponsRes } constructor TCheckCollectComponJoinToComponsRes.Create; begin inherited; // Tolik 12/12/2019 -- FComponsFromCollect := TSCSComponents.Create(false); FListOfListProperCompons := TObjectList.Create(true); FCanJoin := false; end; destructor TCheckCollectComponJoinToComponsRes.Destroy; begin FreeAndNil(FComponsFromCollect); FreeAndNil(FListOfListProperCompons); inherited; end; { TSCSProperty } constructor TSCSProperty.Create(AActiveForm: TForm); begin inherited create; FPropNormResRels := TList.Create; end; destructor TSCSProperty.Destroy; begin FreeAndNil(FPropNormResRels); inherited; end; { TDefectAct } procedure TDefectAct.LoadFromStream(AStream: TStream); begin AStream.ReadComponent(Self); end; procedure TDefectAct.SaveToStream(AStream: TStream); begin AStream.WriteComponent(Self); end; procedure TestGetInterfPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo: Integer; AResFrom, AResTo: Integer); var RFrom, RTo: Integer; begin GetPosIntersectRange(APosFrom, APosTo, ACheckPosFrom, ACheckPosTo, RFrom, RTo); if (RFrom <> AResFrom) or (RTo <> AResTo) then EmptyProcedure; end; { TMemTableInfo } constructor TMemTableInfo.Create; // Tolik 12/12/2019 -- begin inherited; end; destructor TMemTableInfo.Destroy; begin if FMemTable <> nil then FreeAndNil(FMemTable); SetLength(FPackFields, 0); SetLength(FPackDicts, 0); inherited; end; { TMemTableInfoList } destructor TMemTableInfoList.Destroy; begin FreeStringsObjects(Self, true); inherited; end; procedure TMemTableInfoList.AddToMemTablesInfo(var aTable: TSQLMemTable; const aTName: String; aTIdx: Integer; const aPackFields: array of string; const aPackDicts: array of TStringList); var Info: TMemTableInfo; i, Len: Integer; begin if High(aPackFields) <> High(aPackDicts) then Raise Exception.Create('arrays have different sizes'); aTable := TSQLMemTable.Create(nil); aTable.TableName := 'MT_'+aTName; aTable.Tag := aTIdx; Info := TMemTableInfo.Create; Info.FMemTable := aTable; //Info.FPackFields := aPackFields; Len := Max(0, High(aPackFields)+1); // на случай если пустой массив и High вернет "-1" SetLength(Info.FPackFields, Len); for i := 0 to Len - 1 do Info.FPackFields[i] := aPackFields[i]; Len := Max(0, High(aPackDicts)+1); // на случай если пустой массив и High вернет "-1" SetLength(Info.FPackDicts, Len); for i := 0 to Len - 1 do Info.FPackDicts[i] := aPackDicts[i]; Self.AddObject(aTName, Info); end; initialization GTempFilesInfo := TTempFilesInfo.Create; finalization GTempFilesInfo.Free; end. // Row limit 65534