unit U_ResourceReport; interface uses Windows, U_LNG, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ToolWin, Contnrs, Printers, Math, U_BaseCommon, U_BaseConstants, U_Constants, U_SCSComponent, U_SCSLists, U_SCSInterfPath, U_frOLEExl, {U_PreviewReport, }ImgList, cxLookAndFeelPainters, cxButtons, XPMenu, U_BaseSettings, DB, kbmMemTable, cxStyles, cxCustomData, cxGraphics, cxFilter, cxData, cxDataStorage, cxEdit, cxDBData, cxSpinEdit, cxCheckBox, cxCurrencyEdit, cxColorComboBox, cxGridCustomTableView, cxGridTableView, cxGridDBTableView, cxGridLevel, cxClasses, cxControls, cxGridCustomView, cxGrid, ExtCtrls, RzPanel, RzLabel, FR_Class, FR_DSet, FR_DBSet, FR_View, U_Common_Classes, FR_Desgn, FR_PrDlg, FR_Prntr, ActnList, RzButton, RzRadChk, siComp, siLngLnk, exgrid, RapTree, FlytreePro, Treecoll, IsPlugEdit, ispinedit, Menus, RzEdit, Mask, RzSpnEdt, ShellApi, pFIBQuery, RzTabs, IniFiles, U_ProtectionCommon, FR_ChBox, DrawObjects, RzRadGrp,//, HTTPGet; //Tolik kbmMemBinaryStreamFormat, RzTreeVw, frxClass; // kbmMWStreamFormat, kbmMWBinaryStreamFormat, kbmMWClientDataSet; // const // Template Column Type ttSimple = 1; ttStamp = 2; ttA3 = 3; // TargetColumnIndex tciCAD = 0; tciReport = 1; tciName = 2; //Report Column Index rciIsOn = 0; rciName = 1; rciSimple = 2; rciStamp = 3; // Section seRepTemplate = 'RepTemplate'; // Idents idtRepType = 'RepType'; idtReportUseKind = 'ReportUseKind'; idtTemplateType = 'TemplateType'; idtName = 'Name'; idtTemplate = 'Template'; // GroupMode gmComponType = 0; gmGroupName = 1; type TReportSortInfo = class; TReportItemParams = class; // Tolik -- 04/09/2016 -- // TCableWayCompon = Class; // added by Tolik // нужно для расчета расхода кабеля из катушек // кабель TCables = record Length : double; // длина Selected : boolean; // отобран end; // катушка TCableReels = record CableIDs : TIntList; // идентификаторы кабелей Rest : double; // остаток Length : double; // изначальная длина Cables : array of double; // куски кабеля CanCut : boolean; // флаг (можни ли еще отрезать от данной катушки) end; // тип кабеля или поставки TCableTypes = record Name: string; // наименование, артикул Length: double; // длина (размер) поставки TypeName: string; // артикул (если есть) или обозначение поставки ReelName: string; // название поставки (катушка, моток и пр.) Izm: string; // единицы измерения Cables: array of TCables; // кабели Reels: array of TCableReels; // катушки CableIDs: TIntList; // айдишники кабелей CableCypher: string; // идентификатор end; // Для отчета "Путь кабеля" // путь кабеля { TCabPath = record ID: Integer; Name: string; NameFrom: TStringList; NppFrom: Integer; NameTo: TStringList; NppTo: Integer; end; } TCabPath = record ID: Integer; Name: string; NameFrom: TSCSComponent; NppFrom: Integer; NameTo: TSCSComponent; NppTo: Integer; Passed: boolean; Kolvo: integer; FromTo: string; BeginPorts: TIntList; EndPorts: TIntList; BeginPortName: string; EndPortName: string; InterFacePositions: TIntList; end; // детализация пути кабеля TCabPathInfo = record ID: Integer; ParentID: Integer; Description: String; InterfCount: Integer; NameFrom: Integer; NameTo: Integer; Margin: Integer; end; TCabPaths = array of TCabPath; TCabPathInfos = array of TCabPathInfo; // описание типа порта PortDescription = record PortName: String; Ports: TIntList; end; PortInform = array of PortDescription; //список компонент PconnCompon = ^connCompon; connCompon = record Component: TSCSComponent; Passed: Boolean; Components: array of PconnCompon; end; CList = array of connCompon; {my_SCSObject = class(TMyObject) public Figure: TFigure; ChildList: TList; isLine: Boolean; Length: Double; HeightOfPlacing: Double; end;} //////////////////////////////////////////////////////////////////////////////////////////////////////////// // Tolik -- 04/09/20106 -- { TCableWayCompon = class(TMyObject) Public FirstCompon: TSCSComponent; LastCompon: TSCSComponent; WayList: TList; Npp: Integer; Passed: Boolean; CanSeekSide1: Boolean; CanSeekSide2: Boolean; CableInterfName: String; CableInterface: TSCSInterface; Side1ConnectedInterface: TSCSInterface; Side2ConnectedInterface: TSCSInterface; //GroupedNpp: string; GroupedNpp: TIntList; Side1InterfList: TList; Side2InterfList: TList; Constructor Create; Destructor Destroy; end;} // TReportShablons = class(TMyObject) private FRepShablons: TStringList; FActiveShablonID: Integer; FMessgShablonNoExists: String; procedure AddShablonToList(AID: Integer; AName: String; AIsActive: Boolean); procedure DefineActiveShablonIfNoDefined; procedure ClearRepShablons; constructor Create; destructor Destroy; override; function GetActiveShablonName: string; function GetShablonNameByID(AID: Integer): string; procedure RemoveShablonNameByID(AID: Integer); end; TSortFieldLists = class(TMyObject) private FOwner: TReportSortInfo; FFieldNames: TStringList; FFieldCaptCodes: TStringList; constructor Create(AOwner: TReportSortInfo); destructor Destroy; override; end; TReportSortInfo = class(TMyObject) private FOwner: TReportItemParams; //FAllFieldList: TSortFieldLists; FAllFieldNames: TStringList; FAllFieldCaptions: TStringList; FUsedFieldNames: TStringList; FID: Integer; FRepKind: ShortInt; FCaseSensitive: ShortInt; FDescending: ShortInt; public property AllFieldNames: TStringList read FAllFieldNames; property AllFieldCaptions: TStringList read FAllFieldCaptions; property CaseSensitive: ShortInt read FCaseSensitive write FCaseSensitive; property Descending: ShortInt read FDescending write FDescending; property ID: Integer read FID write FID; property Owner: TReportItemParams read FOwner write FOwner; property RepKind: ShortInt read FRepKind write FRepKind; property UsedFieldNames: TStringList read FUsedFieldNames write FUsedFieldNames; procedure AddFieldInfo(const AFieldName, ACaption: String); procedure Assign(AReportSortInfo: TReportSortInfo); constructor Create(AOwner: TReportItemParams); destructor Destroy; override; function GetFieldCaption(const AFName: String): String; //Tolik -- 10/08/21017 -- procedure ClearFields; end; TReportItemParams = class(TMyObject) private FSimpleShablons: TReportShablons; FStampShablons: TReportShablons; FReportSortInfo: TReportSortInfo; public Mode: TResourceReportFormMode; // тип отчета ReportUseKind: TReportUseKind; // Использование отчета в опр. условиях ReportUseByProjType: TSCSTypes; // Использование отчета в опр. проектах (напр только для внутренней СКС). // Пустое знач "[]" - означает что проект используется для всех проэктов RepType: Integer; // тип отчета CanHaveActiveComponents: Integer; // учитывть действующие компоненты CanHaveZeroPriceComponents: Integer; // отображать компоненты с нелевой ценой CanHaveFormMode: Integer; // можно ли вывести отчет на форме CanHavePageSize: Integer; // можно ли выбирать размер страници CanHaveDismountAccount: Integer; // Учитывать демонтаж CanHaveTemplate: Integer; // Можно ли создавать шаблоны CanHaveStamp: Integer; // Отчет со штампом FullPathInCableJournal: Integer; CanHaveSupplyValue: Integer; // Учитывать поставочные величины CanRoundValue: Integer; // Округлять значения CanAsPlacingInProj: Integer; // Отображать в парядке размещения CanGroupByCompType: Integer; //Группировать по типу компонента CanFloorNppWithRoom: Integer; // Отображать номер этажа с телекомуникационной комнатой TS CanInTwoCopies: Integer; CanCabinetParams: Integer; CanResources: Integer; CanPricePrecision: Integer; CanKolvoPrecision: Integer; //Added by Tolik for ExplicationComponent Report CanShowKabinet: Integer; // Отображать покабинетную экспликацию компонентов CanShowObjHierarchy : Integer; // Отображать иерархию объектов CanGroupByName : Integer; // Группировать компоненты по назваиню //ShowHeightOfPlacing: Integer; // Отображать высоту размещения объектов 06/03/2018 -- GroupByHeightOfPlacing: Integer; // группировать по высоте размещения 06/03/2018 -- ////Added by Tolik для счета-фактуры CanShowResources: Integer; CanShowWorks: Integer; // Added by Tolik for GOSTCableJournal (галочку будем выключать) CanShowCablePaths : Integer; //Added by Tolik for CablePaths PageToShow: integer; //Added by Tolik for GostCableJournal CanShowOldReportForm: Integer; /////////////// GroupMode: Integer; constructor Create(AMode: TResourceReportFormMode; ARepType: Integer; AReportUseKind: TReportUseKind); destructor Destroy; override; function GetShablonsByTemplateType(ATemplateType: Integer): TReportShablons; end; //PReportItemParams = ^TReportItemParams; TF_ResourceReport = class(TForm) ImageList1: TImageList; PrintDialog: TPrintDialog; SaveDialog: TSaveDialog; XPMenu: TXPMenu; MemTable_RCable: TkbmMemTable; MemTable_RResources: TkbmMemTable; DataSource_MT_RCable: TDataSource; DataSource_MT_RResources: TDataSource; MemTable_RCableJournal: TkbmMemTable; MemTable_RDisparityCompColor: TkbmMemTable; DataSource_MT_RDisparityCompColor: TDataSource; Report: TfrReport; frDBDataSet_Master: TfrDBDataSet; RepDesigner: TfrDesigner; DataSource_MT_RCableJournal: TDataSource; frDBDataSet_Detail: TfrDBDataSet; MemTable_RTypeComponents: TkbmMemTable; MemTable_RTypeComponentsDetail: TkbmMemTable; DataSource_MT_RTypeComponents: TDataSource; DataSource_MT_RTypeComponentsDetail: TDataSource; MemTable_RSpecification: TkbmMemTable; DataSource_MT_RSpecification: TDataSource; MemTable_RSpecifTypeCompon: TkbmMemTable; DataSource_MT_RSpecifTypeCompon: TDataSource; frDBDataSet_SubDetail: TfrDBDataSet; ActionList1: TActionList; Act_ShowReport: TAction; MemTable_RCableJournalExt: TkbmMemTable; DataSource_MT_RCableJournalExt: TDataSource; MemTable_RNorms: TkbmMemTable; DataSource_MT_RNorms: TDataSource; gbViewClose: TRzGroupBox; gbTarget: TRzGroupBox; RzGroupBox4: TRzGroupBox; btClose: TRzBitBtn; splitTarget: TSplitter; btShowReport: TRzBitBtn; Act_ShowWizardReport: TAction; MemTable_RCableGroup: TkbmMemTable; DataSource_MT_RCableGroup: TDataSource; mtExplanatoryProj: TkbmMemTable; dsrcExplanatoryProj: TDataSource; mtExplanatoryList: TkbmMemTable; dsrcExplanatoryList: TDataSource; mtRCableJournalInterfaces: TkbmMemTable; dsrcRCableJournalInterfaces: TDataSource; mtRLegendObjectIcons: TkbmMemTable; dsrcRLegendObjectIcons: TDataSource; pnParamsAndModes: TRzPanel; lng_Forms: TsiLangLinked; tvReports: TFlyTreeViewPro; ToolBar1: TToolBar; btNewTemplate: TToolButton; btEditTemplate: TToolButton; btDelTemplate: TToolButton; Act_NewSimpleTemplateFromStandart: TAction; Act_NewStampTemplateFromStandart: TAction; Act_NewSimpleTemplateFromUser: TAction; Act_NewStampTemplateFromUser: TAction; pmDropDownNewTemplate: TPopupMenu; N1: TMenuItem; N2: TMenuItem; N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; Act_EditTemplate: TAction; Act_NewTemplate: TAction; Act_DeleteTemplate: TAction; Act_DropAll: TAction; Act_EditSimpleTemplate: TAction; Act_EditStampTemplate: TAction; Act_DeleteSimpleTemplate: TAction; Act_DeleteStampTemplate: TAction; pmDropDownEditTemplate: TPopupMenu; N6: TMenuItem; N7: TMenuItem; pmDropDownDelTemplate: TPopupMenu; MenuItem1: TMenuItem; MenuItem2: TMenuItem; pmReports: TPopupMenu; N8: TMenuItem; N9: TMenuItem; N10: TMenuItem; N11: TMenuItem; N13: TMenuItem; N14: TMenuItem; N16: TMenuItem; N17: TMenuItem; RzPanel1: TRzPanel; pmnuiNewTemplate: TMenuItem; pmnuiEdit: TMenuItem; pmnuiDel: TMenuItem; RzGroupBox1: TRzGroupBox; rbModeView: TRzRadioButton; rbModePrint: TRzRadioButton; rbModePacketPrint: TRzRadioButton; tvReportTarget: TFlyTreeViewPro; Timer_DefineReportNodeControls: TTimer; rbModePacketPrintToExcel: TRzRadioButton; mtReport: TkbmMemTable; dsrcReport: TDataSource; frDBDataSet_MasterFirst: TfrDBDataSet; mtReportFirst: TkbmMemTable; dsrcReportFirst: TDataSource; RzBitBtn1: TRzBitBtn; Act_NewMarkPage: TAction; Act_NewMarkPageFromUser: TAction; N12: TMenuItem; N15: TMenuItem; N18: TMenuItem; N22: TMenuItem; N20: TMenuItem; N21: TMenuItem; pnOtherProperties: TRzPanel; lbOtherProperties: TRzLabel; gbParams: TRzGroupBox; pcRepParams: TRzPageControl; tsProjRepParams: TRzTabSheet; gbValues: TRzGroupBox; cbCanRoundValue: TRzCheckBox; cbCanHaveSupplyValue: TRzCheckBox; gbPageSize: TRzGroupBox; rbPageSizeA4: TRzRadioButton; rbPageSizeA3: TRzRadioButton; gbReportMode: TRzGroupBox; rbRepModeDocument: TRzRadioButton; rbRepModeForm: TRzRadioButton; tsMarkPagesParams: TRzTabSheet; cbFloorNppWithRoom: TRzCheckBox; cbInTwoCopies: TRzCheckBox; cbCanHaveActiveComponents: TRzCheckBox; cbCanHaveZeroPriceComponents: TRzCheckBox; cbCanHaveDismountAccount: TRzCheckBox; cbReportWithStamp: TRzCheckBox; cbFullPathInCableJournal: TRzCheckBox; cbCanHaveActiveComponentsMarkPages: TRzCheckBox; cbCanHaveDismountAccountMarkPages: TRzCheckBox; gbNoCabinetNameShort: TRzGroupBox; rbShowRoomName: TRzRadioButton; rbShowString: TRzRadioButton; edNoCabinetNameShort: TRzEdit; lbNoCabinet: TLabel; edNoCabinet: TRzEdit; mtReportDetail: TkbmMemTable; dsrcReportDetail: TDataSource; mtReportSubDetail: TkbmMemTable; dsrcReportSubDetail: TDataSource; cbGroupByCompType: TRzCheckBox; cbAsPlacingInProj: TRzCheckBox; ToolButton1: TToolButton; btExportTemplateToFile: TToolButton; Act_ImportTemplateFromFile: TAction; Act_ExportTemplateToFile: TAction; pmDropDownExportTemplate: TPopupMenu; Act_ExportSimpleTemplateToFile: TAction; Act_ExportStampTemplateToFile: TAction; ActExportSimpleTemplateToFile1: TMenuItem; ActExportSimpleTemplateToFile2: TMenuItem; pmnuiImportTemplate: TMenuItem; pmnuiExportTemplates: TMenuItem; N25: TMenuItem; N26: TMenuItem; pmnuiExportTemplate: TMenuItem; ToolButton2: TToolButton; N19: TMenuItem; Act_EditReportSortInfo: TAction; N23: TMenuItem; ToolButton3: TToolButton; cbCanResources: TRzCheckBox; pnPacketExportType: TPanel; rbPackExportExcel: TRzRadioButton; rbPackExportPdf: TRzRadioButton; frCheckBoxObject1: TfrCheckBoxObject; Timer_ShowReport: TTimer; Act_ExportToBc3: TAction; bc31: TMenuItem; tsCablePathParams: TRzTabSheet; cbCablePathShowEndObjName: TRzCheckBox; cbCablePathShowObjName: TRzCheckBox; cbCablePathShowConnInSeparatePaths: TRzCheckBox; cbCablePathShowCableCanals: TRzCheckBox; gbGroupType: TRzGroupBox; rbGroupByComponType: TRzRadioButton; rbGroupByGroupName: TRzRadioButton; Label1: TLabel; Label2: TLabel; nePricePrecision: TRzNumericEdit; Label3: TLabel; Label4: TLabel; neKolvoPrecision: TRzNumericEdit; Timer_TimeOutExec: TTimer; RzGroupBox2: TRzGroupBox; cbCanShowKabinet: TRzCheckBox; frReport1: TfrReport; frDBDataSet1: TfrDBDataSet; frDBDataSet2: TfrDBDataSet; frDBDataSet3: TfrDBDataSet; cbCanShowObjHierarchy: TRzCheckBox; cbCanGroupByName: TRzCheckBox; gbResources: TRzGroupBox; cbCanShowResources: TRzCheckBox; cbCanShowWorks: TRzCheckBox; RzGroupBox3: TRzGroupBox; cbShowCablePath: TRzCheckBox; rgCableRate: TRzRadioGroup; cbNone: TRzRadioButton; cbMaxScrapRate: TRzRadioButton; cbMaxEfficiency: TRzRadioButton; MemTable_WACoordinates: TkbmMemTable; DataSource_MT_WACoordinates: TDataSource; cbOldReportForm: TRzCheckBox; NetTypeTree: TRzCheckTree; RzLabel1: TRzLabel; CheckAllReports: TRzCheckBox; Label5: TLabel; cbGroupByHeightOfPlacing: TRzCheckBox; rbPackExportExcel2007: TRzRadioButton; rbPackExportWord2007: TRzRadioButton; RzPanel2: TRzPanel; PortsReportPanel: TRzGroupBox; cbGroupBusyPorts: TRzCheckBox; cbGroupFreePorts: TRzCheckBox; cbFullPortPath: TRzCheckBox; cbFreePortsDetail: TRzCheckBox; SortPanel: TRzGroupBox; cbSortOn: TRzCheckBox; procedure FormCreate(Sender: TObject); procedure ToolButton_PrintClick(Sender: TObject); procedure ToolButton1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure GT_RCableMaxLengthGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); procedure ReportGetValue(const ParName: String; var ParValue: Variant); procedure ReportUserFunction(const Name: String; p1, p2, p3: Variant; var Val: Variant); procedure FormDestroy(Sender: TObject); procedure _tvReportTargetGetSelectedIndex(Sender: TObject; Node: TTreeNode); procedure Act_ShowWizardReportExecute(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure gbViewCloseResize(Sender: TObject); procedure cbCanHaveActiveComponentsClick(Sender: TObject); procedure cbCanHaveZeroPriceComponentsClick(Sender: TObject); procedure ReportBeginPage(pgNo: Integer); procedure lbOtherPropertiesClick(Sender: TObject); procedure lbOtherPropertiesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); procedure lbOtherPropertiesMouseLeave(Sender: TObject); procedure tvReportsCloseUp(Sender: TISPlugInplaceEdit; Section: TISPlugSection; DropDown: TISDropDown; var Accept: Boolean); procedure tvReportsSelectedChanged(OldNode, NewNode: TFlyNode); procedure tvReportsDblClick(Sender: TObject); procedure tvReportsDrawCell(Sender: TObject; aCanvas: TCanvas; ACol, ARow: Integer; Rect: TRect; State: TExGridDrawState); procedure Act_NewSimpleTemplateFromStandartExecute(Sender: TObject); procedure Act_NewStampTemplateFromStandartExecute(Sender: TObject); procedure Act_NewSimpleTemplateFromUserExecute(Sender: TObject); procedure Act_NewStampTemplateFromUserExecute(Sender: TObject); procedure Act_EditSimpleTemplateExecute(Sender: TObject); procedure Act_EditStampTemplateExecute(Sender: TObject); procedure Act_DeleteSimpleTemplateExecute(Sender: TObject); procedure Act_DeleteStampTemplateExecute(Sender: TObject); procedure Act_DropAllExecute(Sender: TObject); procedure RepDesignerShow(Sender: TObject); procedure RepDesignerSaveReport(Report: TfrReport; var ReportName: String; SaveAs: Boolean; var Saved: Boolean); procedure tvReportsPrepareDropDown(Sender: TISPlugInplaceEdit; Section: TISPlugSection; Dropdown: TISDropDown); procedure btTemplateClick(Sender: TObject); procedure rbModeViewClick(Sender: TObject); procedure tvReportTargetEdited(Sender: TObject; Node: TFlyNode; var S: String); procedure tvReportsEdited(Sender: TObject; Node: TFlyNode; var S: String); procedure Timer_DefineReportNodeControlsTimer(Sender: TObject); procedure rbRepModeDocumentClick(Sender: TObject); procedure RzBitBtn1Click(Sender: TObject); procedure Act_NewMarkPageExecute(Sender: TObject); procedure Act_NewMarkPageFromUserExecute(Sender: TObject); procedure btEditTemplateClick(Sender: TObject); procedure btDelTemplateClick(Sender: TObject); procedure Act_EditTemplateExecute(Sender: TObject); procedure Act_DeleteTemplateExecute(Sender: TObject); procedure Act_ImportTemplateFromFileExecute(Sender: TObject); procedure Act_ExportTemplateToFileExecute(Sender: TObject); procedure Act_ExportSimpleTemplateToFileExecute(Sender: TObject); procedure Act_ExportStampTemplateToFileExecute(Sender: TObject); procedure btExportTemplateToFileClick(Sender: TObject); procedure Act_EditReportSortInfoExecute(Sender: TObject); procedure tvReportTargetCollapsing(Sender: TObject; Node: TFlyNode; var AllowCollapse: Boolean); procedure Timer_ShowReportTimer(Sender: TObject); procedure Act_ExportToBc3Execute(Sender: TObject); procedure nePricePrecisionChange(Sender: TObject); procedure neKolvoPrecisionChange(Sender: TObject); procedure Timer_TimeOutExecTimer(Sender: TObject); procedure cbCanShowKabinetClick(Sender: TObject); procedure cbAsPlacingInProjClick(Sender: TObject); procedure cbCanGroupByNameClick(Sender: TObject); procedure cbReportWithStampClick(Sender: TObject); procedure cbShowCablePathClick(Sender: TObject); procedure CheckAllReportsClick(Sender: TObject); procedure cbOldReportFormClick(Sender: TObject); procedure cbGroupByHeightOfPlacingClick(Sender: TObject); procedure cbCanHaveSupplyValueClick(Sender: TObject); // procedure ShowEtazhClick(Sender: TObject); // procedure ShowKabinetClick(Sender: TObject); private FFrLocale: TfrLocale; FFrPrintForm: TfrPrintForm; FPrintDevice: TPrintDevice; FUsefrDialog: Boolean; //*** юзать диалог печати из компоненты TfrReport GFormMode: TResourceReportFormMode; FReportUseKind: TReportUseKinds; FExceedLength: Double; FCatalog: TSCSCatalog; FComponent: TSCSComponent; FObjectName: string; FReportCaption: String; FSavedOnAppRestore: TNotifyEvent; FSavedOnAppMinimize: TNotifyEvent; FormList: TObjectList; FMasterOldRecNo: Integer; FDetailOldRecNo: Integer; FOldRecNo: Integer; FCurrRecNo: Integer; FPassNum: Integer; FTotalLaborTime: Integer; FModifiedReportTemplate: Boolean; //*** Для пакетной печати FReportCountToPrint: Integer; FReportCountPrinted: integer; //FPackgeDir: string; // Tolik 07/08/2020 -- //FfrOLEExcelExport: TMyfrOleExl; FCostOfProjectReportParams: TCostOfProjectReportParams; //Tolik 16/02/2022 -- //FcbCanHaveActiveComponentsCurr: TRzCheckBox; //FcbCanHaveDismountAccountCurr: TRzCheckBox; // FReportPagesVisibilityList: TIntList; // Tolik 31/03/2020 -- // Tolik 21/05/2020 FExportToXLSX: Boolean; FExportToDocX: Boolean; // { Private declarations } procedure AddSortFieldsToReportItemParams(AReportItemParams: TReportItemParams); procedure CorrectReport(AResourceReportFormMode: TResourceReportFormMode); procedure ClearTVReportTemplates; procedure CreateControls; function DefineCurrRecNo: Integer; procedure DefineReportModeControls; procedure DefineReportNodeControls(ARepNode: TFlyNode; AWithTemplateInfo: Boolean); procedure DefineReportNodeActiveShablonText(ARepNode: TFlyNode); procedure DefineRepSortInfo; procedure DefineRepTemplates; procedure DelReportTemplate(ARepNode: TFlyNode; ATemplateType: Integer); procedure ExportTemplateToFile(ATemplateType: Integer); function GetCurrReportItemParamValues: TReportItemParams; function GetReportFileNameByType(AReportType: Integer; ATemplateType: Integer; ACanA3: Boolean): String; function GetReportItemParamByRepType(AReportType: Integer): TReportItemParams; function GetTemplateTypeByColumnIndex(AColIndex: Integer): Integer; function GetTemplateTypeByCurrOptions: Integer; function ImportTemplateFromFile: Boolean; function IsSimpleReportKind(AReportUseKinds: TReportUseKinds): Boolean; procedure MakeEditReportTemplate(AMakeEdit: TMakeEdit; AMakeFromStandart: Boolean; ATemplateType: Integer); function MakeNewReportTemplateWizard: Boolean; procedure SortMemTableByParams(AMemTable: TkbmMemTable; AReportItemParams, AReportItemParamValues: TReportItemParams); procedure PrepareReportFormats; procedure RepListWrite(AName: String; AObjCount, AComponCount: Integer; AWorkCost: Double); procedure RepObjWrite(AName: String; AItemType: TItemType; AComponCount: Integer; AWorkCost: Double); procedure RepComponWrite(AName: String; AisCompon: Boolean; AWorkCost: Double; APref: Integer); procedure RepResourcesWrite(AResourcesCost: Double; APref: Integer); procedure RepResourceWrite(AName: String; AWorkCost: Double; APref: Integer); procedure RepComplectsWrite(AComplCost: Double); procedure LoadPortName(AIDPointComponent, AIDLineComponent: Integer; var ANppPort: Integer; var APortName: String; aPort: Pointer=nil; aPortFromPos: PInteger=nil; aPortToPos: PInteger=nil); function GetMultiPortNameMark(APointComponent: TSCSComponent; ARetIndexIfNoMark: Boolean): String; function GetParallelInterfaces(AFirstConnCompon, AFirstLineCompon, ALastConnCompon, ALastLineCompon: TSCSComponent): TInterfLists; function GetUOMLengthMin: String; function GetUOMWithOrthographMarks: String; function GetUOMWeight: String; function GetUOMWeightOrthographMarks: String; public //Tolik 16/02/2022 -- FcbCanHaveActiveComponentsCurr: TRzCheckBox; FcbCanHaveDismountAccountCurr: TRzCheckBox; // GForm: TForm; FmtCableChannelGrp: TkbmMemTable; FdsrcCableChannelGrp: TDataSource; FmtCableChannel: TkbmMemTable; FdsrcCableChannel: TDataSource; FmtCrossJournal: TkbmMemTable; FdsrcCrossJournal: TDataSource; FmtExplicationRoom: TkbmMemTable; FdsrcExplicationRoom: TDataSource; FmtExplicationRoomDetail: TkbmMemTable; FdsrcExplicationRoomDetail: TDataSource; FmtExplicationCompon: TkbmMemTable; FdsrcExplicationCompon: TDataSource; FmtExplicationComponDetail: TkbmMemTable; FdsrcExplicationComponDetail: TDataSource; FmtExplicationComponSubDetail: TkbmMemTable; FdsrcExplicationComponSubDetail: TDataSource; //Tolik 17/10/2023 -- FmtPortReport: TkbmMemTable; FmtPortReportDetail: TkbmMemTable; FdsrcPortReport: TDataSource; FdsrcPortReportDetail: TDataSource; // // Tolik //ReelsCableFlow : TStringList; // список строк с расходом кабеля из катушек AllNetTypes: Boolean; // флажок (если выбраны все типы сетей для отчета/отчетов) NetTypeGuidList: TStringList; // список гуидов типов сетей на проекте (для дерева) NetTypeGuidListSelected: TStringList; // список гуидов типов сетей, выбранных пользователем для отчета INeedNormsRecources: Boolean; // FmtHouse: TkbmMemTable; FdsrcHouse: TDataSource; FmtApproach: TkbmMemTable; FdsrcApproach: TDataSource; FmtDefectAct: TkbmMemTable; FdsrcDefectAct: TDataSource; FmtCommerceInvoice: TkbmMemTable; FdsrcCommerceInvoice: TDataSource; FmtCablePaths: TkbmMemTable; FdsrcCablePaths: TDataSource; FmtCablePathsInfo: TkbmMemTable; FdsrcCablePathsInfo: TDataSource; FmtCrossConnection: TkbmMemTable; FdsrcCrossConnection: TDataSource; FmtMarkRoomTS: TkbmMemTable; FdsrcMarkRoomTS: TDataSource; FmtMarkPathPanel: TkbmMemTable; FdsrcMarkPathPanel: TDataSource; FmtMarkPathPanelPorts: TkbmMemTable; FdsrcMarkPathPanelPorts: TDataSource; FmtMarkSocket: TkbmMemTable; FdsrcMarkSocket: TDataSource; FmtMarkSocketPanel: TkbmMemTable; FdsrcMarkSocketPanel: TDataSource; FmtMarkCable: TkbmMemTable; FdsrcMarkCable: TDataSource; FRepMsgList: TStringList; FPricePrecision: Integer; FKolvoPrecision: Integer; FPackgeDir: string; // Tolik 07/08/2020 -- procedure FormMdiClose(Sender: TObject; var Action: TCloseAction); procedure ApplMinimize(Sender: TObject); procedure ApplRestore(Sender: TObject); procedure frOLEExcelExportStartExportPageEvent(Sender: TObject; ACaption: string; AObjCount: Integer); procedure frOLEExcelExportProgressExportPageEvent(Sender: TObject; var AWasCancel: Boolean; AObjIndex, AObjectCount: Integer); procedure frOLEExcelExportEndExportPageEvent(Sender: TObject; AWasCancel: Boolean); procedure DefinePrecisions; procedure DefineRepDesignLanguage; function ExtractDirToNewReport(ADateTime: TDateTime): String; function ExtractDirToReportTemplate(AReportName: String): String; function GetTargetFolder: TSCSCatalog; procedure ShowWizard(AReportUseKind: TReportUseKinds; AShow: Boolean=true); procedure ShowPreparedReport(AParams: TReportItemParams); procedure ShowReportByParams(AFolder: TSCSCatalog; AParams: TReportItemParams); function ShowReportFromFile(AReportMode: TResourceReportFormMode; AParams: TReportItemParams; AReportFile: String; APrintDevice: TPrintDevice; AIsTemplate: Boolean; AMakeEditTemplate: TMakeEdit): Boolean; function CheckCanShowReport(ACAtalog: TSCSCatalog): Boolean; procedure InitRepMsgList; function PrepareCommerceInvoiceObjects(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams): TSCSCatalog; procedure ShowListObjectReport(AIDComponList: Integer); procedure ShowFolderResourceReport(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue: Boolean); procedure ShowFolderNormReport(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents: Boolean); procedure ShowFolderCableReport(AFolder: TSCSCatalog; AParams: TReportItemParams; AFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveDismountAccount: Boolean; AReportItemParamValues: TReportItemParams); procedure ShowFolderDisparityComponReport(AFolder: TSCSCatalog; AParams: TReportItemParams; AFormMode: TResourceReportFormMode); procedure ShowFolderCableJournal(AFolder: TSCSCatalog; AParams: TReportItemParams; AResRepFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveDismountAccount, AFullPath: Boolean); procedure ShowFolderCableJournalExt(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents, ACanHaveDismountAccount, AFullPath: Boolean); procedure ShowFolderLegendObjectIcons(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents: Boolean); procedure ShowFolderTypeComponenetsReport(AFolder: TSCSCatalog; AParams: TReportItemParams); procedure ShowFolderSpecificationReport(AFolder: TSCSCatalog; AParams, AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveZeroPriceComponents, ACanHaveDismountAccount, ACanRoundValue, ACanHaveSupplyValue: Boolean); procedure ShowFolderExplanatoryReport(AFolder: TSCSCatalog; AParams: TReportItemParams); procedure ShowPriorCostOfProjectReport(AParams: TReportItemParams); procedure ShowPriorCostOfProjectReportWizard(AMemTable, ATotalParams: TkbmMemTable; ACostOfProjectReportParams: TCostOfProjectReportParams; AShowTotalParams, AShowTemplates: Boolean); procedure ShowMarkPages(AFolder: TSCSCatalog; AParams: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode; AReportItemParamValues: TReportItemParams); procedure ShowExplicationRoom(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); // Tolik -- 06/03/2018 -- {procedure ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName: Boolean);} procedure ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName,{ AShowHeightOfPlacing,} AGroupByHeightOfPlacing: Boolean); // procedure ShowExplicationComponentOLD(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); procedure ShowComponSpecifications(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); procedure ShowCrossJournal(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode); procedure ShowHouse(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); procedure ShowDefectAct(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode); procedure ShowDefectActForCompon(ACompon: TSCSComponent; AParams: TReportItemParams; ADefectAct: TDefectAct); procedure ShowCommerceInvoice(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); procedure ShowCablePaths(AParams: TReportItemParams); Procedure ShowPortConnections(aParams: TReportItemParams); // Tolik 07/09/2023 -- procedure ShowCrossConnection(AParams: TReportItemParams); procedure ShowCablePathsWizard(ACable: TSCSComponent); Procedure ShowPortWizard(aCupBoard: TSCSComponent); // Tolik 07/09/2023 -- procedure ShowCrossConnectionWizard(ACompon: TSCSComponent); //added by Tolik procedure ShowWACoordinatesReport(AFolder: TSCSCatalog; AList: TStringList); Procedure IncPaketPrintCounter; Procedure ShowXLSXReport(aRep: TfrReport; aFileNAme: String); Procedure SaveRopPagesVisibility(aRep: TfrReport); // Tolik 31/03/2020 -- constructor Create(AOwner: TComponent; AForm: TForm); destructor Destroy; override; // Tolik 17/03/2020 -- Property Catalog: TSCSCatalog read FCatalog; Property Component: TSCSComponent read FComponent; Property ReportPagesVisibilityList: TIntList read FReportPagesVisibilityList write FReportPagesVisibilityList; // Tolik 21/05/2020 Property ExportToXLSX: Boolean read FExportToXLSX write FExportToXLSX; Property ExportToDocX: Boolean read FExportToDocX write FExportToDocX; // // Tolik 23/06/2020 -- property ReportCountToPrint: Integer read FReportCountToPrint write FReportCountToPrint; property ReportCountPrinted: Integer read FReportCountPrinted write FReportCountPrinted; // Tolik 16/02/2022 -- FReportUseKind: TReportUseKinds; property ReportUseKind: TReportUseKinds read FReportUseKind write FReportUseKind; end; { var F_ResourceReport: TF_ResourceReport;} // Added by Tolik // Procedure SortCables (var CableTypes : array of TCableTypes); implementation Uses U_Main, Unit_DM_SCS, FIBQuery, U_Common, U_Preview, U_ESCadClasess, Gauges, U_MakeMarkPage, U_MasterDefectAct, U_GuideFileList, U_SCSClasses, U_CAD, {Tolik 20/03/2020} U_ExpXlsX; var ReelsCableFlow : TStringList; isCompCable: Boolean; // ReportPagesVisibilityList: TIntList;// Tolik 31/03/2020 -- {$R *.dfm} { TReportShablons } // Added by Tolik type TCableTypeArray = array of TCableTypes; procedure TF_ResourceReport.ReportGetValue(const ParName: String; var ParValue: Variant); begin { if ParName = 'TotalCost' then ParValue := ''; if ParName = 'TodayDate' then ParValue := '';} if ParName = 'CurrencyName' then begin if rkProject in FReportUseKind then ParValue := TF_Main(GForm).GCurrencyM.NameBrief else if rkCalc in FReportUseKind then ParValue := FCostOfProjectReportParams.CurrencyName; end; if ParName = 'ExceedLength' then ParValue := FExceedLength; end; procedure TF_ResourceReport.ReportUserFunction(const Name: String; p1, p2, p3: Variant; var Val: Variant); var SCSProjCatalog: TSCSCatalog; FooterBand: TfrBandView; begin SCSProjCatalog := nil; if FCatalog <> nil then if FCatalog.ItemType = itProject then SCSProjCatalog := FCatalog else SCSProjCatalog := FCatalog.GetTopParentCatalog; if Name = 'GETREPLABEL' then //Tolik 18/02/2022 -- //Val := DateToStr(Date)+' '+cResourceReport_Msg24 +ApplicationName+' '+VersionEXE Val := ApplicationName+' '+VersionEXE // else if Name = 'GETPROJECTNAME' then begin Val := ''; SCSProjCatalog := nil; if Assigned(FCatalog) then if FCatalog.ItemType = itProject then SCSProjCatalog := FCatalog else SCSProjCatalog := FCatalog.GetTopParentCatalog; if Assigned(SCSProjCatalog) then Val := SCSProjCatalog.GetNameForVisible; end else if Name = 'GETLISTNAME' then begin Val := ''; if Assigned(FCatalog) then if FCatalog.ItemType = itList then Val := FCatalog.GetNameForVisible else if FCatalog.ItemType = itDir then Val := FCatalog.GetNameForVisible+' ('+GetCatalogItemsNames(FCatalog, [itList])+')'; end else if Name = 'GETCOMPONNAME' then begin Val := ''; if Assigned(FComponent) then val := FComponent.GetNameForVisible; end //Tolik else if Name = 'GETISCOMPCABLE' then // 08/02/2018 --для отчета "Полный путь кабеля " -- показатель, принадлежит ли кабель, // на котором вызван отчет компьютерной сети begin if isCompCable then Val := 1 else val := 0; end else if Name = 'GETCABLENAME' then begin Val := ''; if Assigned(FComponent) then Val := FComponent.Name; end else if Name = 'GETCABLEZAPAS' then begin Val := null; if FCatalog.ItemType = itList then Val := TSCSList(FCatalog).Setting.LengthKoef; end else if Name = 'GETZAKAZCHIKNAME' then begin if rkCalc in FReportUseKind then Val := FCostOfProjectReportParams.ZakazchikName else begin //Tolik // Val := TSCSProject(SCSProjCatalog).Setting.CustomerName; Val := F_ProjMan.GSCSBase.CurrProject.Setting.CustomerName; end; { if rkProject in FReportUseKind then // if ((rkProject in FReportUseKind) or (rkWACoordinates in FReportUseKind)) then begin if SCSProjCatalog <> nil then Val := TSCSProject(SCSProjCatalog).Setting.CustomerName; end else if rkCalc in FReportUseKind then Val := FCostOfProjectReportParams.ZakazchikName;} end else if Name = 'GETPODRADCHIKNAME' then begin //changed by Tolik // if rkProject in FReportUseKind then // if ((rkProject in FReportUseKind) or (rkWACoordinates in FReportUseKind)) then { begin if SCSProjCatalog <> nil then Val := TSCSProject(SCSProjCatalog).Setting.ContractorName; end else if rkCalc in FReportUseKind then Val := FCostOfProjectReportParams.PodradchikName; } if rkCalc in FReportUseKind then Val := FCostOfProjectReportParams.PodradchikName else if SCSProjCatalog <> nil then Val := TSCSProject(SCSProjCatalog).Setting.ContractorName else Val := ''; end else if Name = 'GETORGANIZATIONNAME' then begin if SCSProjCatalog <> nil then Val := TSCSProject(SCSProjCatalog).Setting.OrganizationName; end else if Name = 'GETCURRNPP' then begin Val := DefineCurrRecNo; //frDBDataSet_Master.DataSource.DataSet.RecNo; end else if Name = 'GETISNEWRECORD' then begin if (FCurrRecNo = FOldRecNo) and (FOldRecNo <> 0) then Val := false else Val := true; end else if Name = 'GETPASSNUM' then begin Val := FPassNum; end else if Name = 'INCPASSNUM' then begin Inc(FPassNum); Val := FPassNum; end else if Name = 'DEFINEPAGEFOOTER' then begin FooterBand := TfrBandView(Report.FindObject('PageFooter')); //if FooterBand <> nil then //begin //end; end else if Name = 'GETLENGTHTHROUGHFLOOR' then begin Val := 0; if FCatalog is TSCSProject then Val := Round2(FloatInUOM(TSCSProject(FCatalog).Setting.HeightThroughFloor * (TSCSProject(FCatalog).IDsNearFloorFigures.Count) / 2, umMetr, TF_Main(GForm).FUOM)); end else if Name = 'GETIZM' then Val := GetNameUOM(TF_Main(GForm).FUOM, true) else if Name = 'GETIZMSYMB' then Val := GetNameUOM(TF_Main(GForm).FUOM, true, false) else if Name = 'GETIZMLENMIN' then Val := GetUOMLengthMin else if Name = 'GETIZMWEIGHT' then Val := GetUOMWeight else if Name = 'GETNDS' then begin if rkProject in FReportUseKind then begin if SCSProjCatalog <> nil then Val := TSCSProject(SCSProjCatalog).Setting.NDS; end end else if Name = 'GETPRICEWITHNDS' then //21.11.2013 - Вернуть цену с НДС begin Report.GetVariableValue(p1, Val); if Val <> null then if TSCSProject(SCSProjCatalog).Setting.NDS > 0 then Val := Val * (TSCSProject(SCSProjCatalog).Setting.NDS/100+1) end else if Name = 'GETTOTALLABORTIME' then Val := GetDisplayTextToNORMLaborTime(IntToStr(FTotalLaborTime)) else if Name = 'GETCAPT' then begin Val := ''; //Tolik 23/10/2023 -- for ports report if p1 = 'PORTSREPORT' then Val := cRepMsg276 else if p1 = 'PORTTO' then Val := cRepMsg278 else if p1 = 'CONNECTEDBY' then Val := cRepMsg277 else if p1 = 'PORTSCUPBOARD' then Val := GPortsCupBoard else if p1 = 'BUSYPORTS' then Val := cRepMsg282 else if p1 = 'FREEPORTS' then Val := cRepMsg283 else if p1 = 'BUSYPORTSCOUNT' then Val := GReportBusyPortsCount else if p1 = 'FREEPORTSCOUNT' then Val := GReportFreePortsCount else // if p1 = 'CUSTOMER' then Val := cRepMsg01 // added by Tolik for CommerceInvoice Report else if p1 = 'RESOURCES' then Val := cRepMsg207_1 else if p1 = 'CONTRACTOR' then Val := cRepMsg02 else if p1 = 'PROJNAME' then Val := cRepMsg03 else if p1 = 'PAGENAME' then Val := cRepMsg10 else if p1 = 'GRAPHSYMBLEGEND' then Val := cRepMsg04 else if p1 = 'NUM' then // Tolik 21/01/2020 {$IF DEFINED (SCS_PE)} Val := 'N' {$ELSE} Val := cRepMsg05 {$IFEND} // else if p1 = 'NAME' then Val := cRepMsg06 else if p1 = 'INDICATION' then Val := cRepMsg07 else if p1 = 'WORKEDOUT' then Val := cRepMsg08 else if p1 = 'LENGTHALLCABLES' then Val := cRepMsg227 else if p1 = 'CHECKEDBY' then Val := cRepMsg09 else if p1 = 'UNDERLINE' then Val := DupStr('_', 30) //'______________________________' else if p1 = 'ADJUSTT' then Val := cRepMsg11 else if p1 = 'VZAMINVENTNUMT' then Val := cRepMsg12 else if p1 = 'SIGNANDDATET' then Val := cRepMsg13 else if p1 = 'INVNUMPODLT' then Val := cRepMsg14 else if p1 = 'IZMT' then Val := cRepMsg15 else if p1 = 'KOLICHT' then Val := cRepMsg16 else if p1 = 'PAGET' then Val := cRepMsg17 else if p1 = 'NUMDOCT' then Val := cRepMsg18 else if p1 = 'SIGNT' then Val := cRepMsg19 else if p1 = 'DATET' then Val := cRepMsg20 else if p1 = 'STAGET' then Val := cRepMsg21 else if p1 = 'PAGEST' then Val := cRepMsg22 else if p1 = 'SIGNATURE' then Val := cRepMsg23 else if p1 = 'LASTNAME' then Val := cRepMsg24 else if p1 = 'CABLEDUCTSLIST' then Val := cRepMsg25 else if p1 = 'UOM' then Val := cRepMsg26 else if p1 = 'FULLNESSPERC' then Val := cRepMsg27 else if p1 = 'LENGTH_M' then Val := cRepMsg154 + GetUOMWithOrthographMarks //cRepMsg28 else if p1 = 'RESERVE_M' then Val := cRepMsg155 + GetUOMWithOrthographMarks //cRepMsg29 else if p1 = 'PRICE' then Val := cRepMsg30 else if p1 = 'COST' then Val := cRepMsg31 else if p1 = 'TOTAL' then Val := cRepMsg32 else if p1 = 'GENERALCABDUCTSLEN' then Val := cRepMsg33 else if p1 = 'M' then Val := cRepMsg34 else if p1 = 'GENERALRESERVLEN' then Val := cRepMsg35 else if p1 = 'CABLEDUCTSLIST_NOTE1' then Val := cRepMsg36 else if p1 = 'CABLELIST' then Val := cRepMsg37 else if p1 = 'CONNECTBEGINSH' then Val := cRepMsg38 else if p1 = 'CONNECTENDSH' then Val := cRepMsg39 else if p1 = 'GENERALCABLESLEN' then Val := cRepMsg40 else if p1 = 'GENERALRESERVLEN' then Val := cRepMsg41 else if p1 = 'CABLELIST_NOTE1' then Val := cRepMsg42 else if p1 = 'CABLELIST_NOTE2' then Val := cRepMsg43 else if p1 = 'LISTOFWORKS' then Val := cRepMsg44 else if p1 = 'CODE' then Val := cRepMsg45 else if p1 = 'VOLUME' then Val := cRepMsg46 else if p1 = 'RESOURCELIST' then Val := cRepMsg47 else if p1 = 'VENDORSERIALNUM' then Val := cRepMsg48 else if p1 = 'DISTRIBSERIALNUM' then Val := cRepMsg49 else if p1 = 'VENDOR' then Val := cRepMsg50 else if p1 = 'QUANTITY' then Val := cRepMsg51 else if p1 = 'PRICEVAT' then Val := cRepMsg52 else if p1 = 'COSTVAT' then Val := cRepMsg53 else if p1 = 'TOTALCOST' then Val := cRepMsg54 else if p1 = 'RESOURCELIST_NOTE1' then Val := cRepMsg55 else if p1 = 'EXTLOGBOOK' then Val := cRepMsg56 else if p1 = 'NUMPP' then Val := cRepMsg57 else if p1 = 'NUMCABLE' then Val := cRepMsg58 else if p1 = 'CABLEDATA' then Val := cRepMsg59 else if p1 = 'CORENUMBER' then Val := cRepMsg60 else if p1 = 'GOFROM' then Val := cRepMsg61 else if p1 = 'GOWHERE' then Val := cRepMsg62 else if p1 = 'BUILDING' then Val := cRepMsg63 else if p1 = 'DEVICE_RACK' then Val := cRepMsg64 else if p1 = 'ELEMENT_PANEL' then Val := cRepMsg65 else if p1 = 'SEATORCIRCUITBOARDTYPE' then Val := cRepMsg66 else if p1 = 'NUMPORT' then Val := cRepMsg67 else if p1 = 'PORTMARKING' then Val := cRepMsg68 else if p1 = 'JUNCTWITHCABLE' then Val := cRepMsg69 else if p1 = 'CABLINGTRACE' then Val := cRepMsg70 else if p1 = 'MARKINGLABEL' then Val := cRepMsg71 else if p1 = 'CABLEDIAMETERMM' then Val := cRepMsg156 +', '+ GetUOMLengthMin //cRepMsg72 else if p1 = 'CABLELEN_M_BUILDING' then Val := cRepMsg157+', '+ GetNameUOM(TF_Main(GForm).FUOM, true)+' '+cRepMsg158 //cRepMsg73 else if p1 = 'NOTE' then Val := cRepMsg74 else if p1 = 'CABLELOGBOOK' then Val := cRepMsg75 else if p1 = 'GOST21_101_97' then Val := cRepMsg76 else if p1 = 'CABLETYPE' then Val := cRepMsg77 else if p1 = 'NUMSWITCHBOARD' then Val := cRepMsg78 else if p1 = 'NUMSWITCHBOARDPORT' then Val := cRepMsg79 else if p1 = 'COMESFROM' then Val := cRepMsg80 else if p1 = 'NUMOUTLETORSWITCHBOARD' then Val := cRepMsg81 else if p1 = 'NUMOUTLETORSWITCHBOARDPORT' then Val := cRepMsg82 else if p1 = 'ROOM' then Val := cRepMsg83 else if p1 = 'CABLE' then Val := cRepMsg84 else if p1 = 'CATEGORY' then Val := cRepMsg85 else if p1 = 'FROM' then Val := cRepMsg86 else if p1 = 'TO' then Val := cRepMsg87 else if p1 = 'WORKPLACE' then Val := cRepMsg88 else if p1 = 'WORKAREA' then Val := cRepMsg88_ else if p1 = 'PORT' then Val := cRepMsg89 else if p1 = 'TYPE' then Val := cRepMsg90 else if p1 = 'SPECIFICATION' then Val := cRepMsg91 else if p1 = 'PRODMARKNUMSH' then Val := cRepMsg92 else if p1 = 'DISTRIBMARKNUMSH' then Val := cRepMsg93 else if p1 = 'VENDOR' then Val := cRepMsg94 else if p1 = 'PRICEWITHVAT' then Val := cRepMsg95 else if p1 = 'COSTWITHVAT' then Val := cRepMsg96 else if p1 = 'SUM' then Val := cRepMsg97 else if p1 = 'SPECIFICATION_NOTE1' then Val := cRepMsg98 else if p1 = 'SPECIFICATION_NOTE2' then Val := cRepMsg99 else if p1 = 'GOST21_110_95' then Val := cRepMsg100 else if p1 = 'POSITION' then Val := cRepMsg101 else if p1 = 'NAMEANDTECHCHARACK' then Val := cRepMsg102 else if p1 = 'DOCTYPEMARKINDICAT' then Val := cRepMsg103 else if p1 = 'CODEOFEQUIPMMATERIAL' then Val := cRepMsg104 else if p1 = 'FACTORYPRODUCER' then Val := cRepMsg105 else if p1 = 'UNITOFMEASURE' then Val := cRepMsg106 else if p1 = 'MASSOFUNITKG' then Val := cRepMsg153 + GetUOMWeightOrthographMarks else if p1 = 'EXPLANATORYNOTE' then Val := cRepMsg109 else if p1 = 'BYTHEPROJECT' then Val := cRepMsg110 else if p1 = 'BASEPROJCURRENCY' then Val := cRepMsg111 else if p1 = 'PROJVAT' then Val := cRepMsg112 else if p1 = 'INTERFLOORLIFTINGSHEIGHT_M' then Val := cRepMsg145 + GetUOMWithOrthographMarks //cRepMsg113 else if p1 = 'BYPAGES' then Val := cRepMsg114 else if p1 = 'FLOORHEIGHT_M' then Val := cRepMsg146 + GetUOMWithOrthographMarks //cRepMsg115 else if p1 = 'DROPCEILINGHEIGHT_M' then Val := cRepMsg147 + GetUOMWithOrthographMarks //cRepMsg116 else if p1 = 'POINTOBJECTSPLACEMENTHEIGHT_M' then Val := cRepMsg148 + GetUOMWithOrthographMarks //cRepMsg117 else if p1 = 'ROUTEPLACEMENTHEIGHT_M' then Val := cRepMsg149 + GetUOMWithOrthographMarks //cRepMsg118 else if p1 = 'CONDUITSFULLNESSCOEFFICIENT' then Val := cRepMsg119 else if p1 = 'CABLELENGTHRESERVE' then Val := cRepMsg120 else if p1 = 'PORTRESERVE_M' then Val := cRepMsg150 + GetUOMWithOrthographMarks //cRepMsg121 else if p1 = 'MULTIPORTRESERVE_M' then Val := cRepMsg151 + GetUOMWithOrthographMarks //Val := cRepMsg122 else if p1 = 'MAXLENRESTRICTION_M' then Val := cRepMsg152 + GetUOMWithOrthographMarks //cRepMsg123 else if p1 = 'EXPLICATIONROOM' then Val := cRepMsg124 else if p1 = 'LETTERTOPLAN' then Val := cRepMsg125 else if p1 = 'FLOOR' then Val := cRepMsg126 else if p1 = 'LODGEMENTTNUM' then Val := cRepMsg127 else if p1 = 'ROOMNUM' then Val := cRepMsg128 else if p1 = 'APPOINTMENTROOM' then Val := cRepMsg129 else if p1 = 'SQUAREINSIDE' then Val := cRepMsg130 else if p1 = 'SQM' then Val := cRepMsg159+'.'+GetNameUOM(TF_Main(GForm).FUOM, true, false)+'.' //кв.м. кв.фт. cRepMsg131 else if p1 = 'INCLUDING' then Val := cRepMsg132 else if p1 = 'TOTALSQUARE' then Val := cRepMsg133 else if p1 = 'HABITABLESQUARE' then Val := cRepMsg134 else if p1 = 'BACKROOMSQUARE' then Val := cRepMsg135 else if p1 = 'SQUARENOINCLUDETOTATAL' then Val := cRepMsg136 else if p1 = 'SQUARESELFWILLEDBUILDING' then Val := cRepMsg137 else if p1 = 'HEIGHT' then Val := cRepMsg138 else if p1 = 'TOTALINFLOOR' then Val := cRepMsg139 else if p1 = 'EXPLICATIONCOMPON' then Val := cRepMsg140 else if p1 = 'COMPONNUM' then Val := cRepMsg141 else if p1 = 'NAMEMARK' then Val := cRepMsg142 else if p1 = 'CROSSJOURNAL' then Val := cRepMsg143 else if p1 = 'GOST21_110_95' then Val := cRepMsg144 else if p1 = 'INTERFLOORLIFTINGSHEIGHT' then Val := cRepMsg145 else if p1 = 'FLOORHEIGHT' then Val := cRepMsg146 else if p1 = 'DROPCEILINGHEIGHT' then Val := cRepMsg147 else if p1 = 'POINTOBJECTSPLACEMENTHEIGHT' then Val := cRepMsg148 else if p1 = 'ROUTEPLACEMENTHEIGHT' then Val := cRepMsg149 else if p1 = 'PORTRESERVE' then Val := cRepMsg150 else if p1 = 'MULTIPORTRESERVE' then Val := cRepMsg151 else if p1 = 'MAXLENRESTRICTION' then Val := cRepMsg152 else if p1 = 'MASSOFUNIT' then Val := cRepMsg153 else if p1 = 'LENGTH' then Val := cRepMsg154 else if p1 = 'RESERVE' then Val := cRepMsg155 else if p1 = 'CABLEDIAMETER' then Val := cRepMsg156 else if p1 = 'CABLELEN' then Val := cRepMsg157 else if p1 = 'BUILDING_S' then Val := cRepMsg158 else if p1 = 'SQ' then Val := cRepMsg159 else if p1 = 'MATERIALS' then Val := cRepMsg160 else if p1 = 'ARTICUL' then Val := cRepMsg161 else if p1 = 'WORKS' then Val := cRepMsg162 else if p1 = 'DEFECTACT' then Val := cRepMsg164 else if p1 = 'FINDDEFECT' then Val := cRepMsg165 else if p1 = 'WITHDEFINEWORKS' then Val := cRepMsg166 else if p1 = 'REPAIRDEFECT' then Val := cRepMsg167 else if p1 = 'ADDRESS' then Val := cRepMsg168 else if p1 = 'DEFECTDESCRIPTION' then Val := cRepMsg169 else if p1 = 'LINKTRANSPORT' then Val := cRepMsg170 else if p1 = 'POINTA' then Val := cRepMsg171 else if p1 = 'POINTB' then Val := cRepMsg172 else if p1 = 'CABLE' then Val := cRepMsg173 else if p1 = 'DEFACTMATERIALS' then Val := cRepMsg174 else if p1 = 'SETEQUIPMENT' then Val := cRepMsg175 else if p1 = 'EQUIPMENT' then Val := cRepMsg176 else if p1 = 'MOVEEQUIPMENT' then Val := cRepMsg177 else if p1 = 'DEFACTCONTRACTOR' then Val := cRepMsg178 else if p1 = 'DATEGETTING' then Val := cRepMsg179 else if p1 = 'DATEEXECUTION' then Val := cRepMsg180 else if p1 = 'FORCOMPONENT' then Val := cRepMsg181 else if p1 = 'R25HOMEANDAPPROACH' then Val := cRepMsg191 else if p1 = 'R25NAME' then Val := cRepMsg182 else if p1 = 'R25COOPERATIVE' then Val := cRepMsg183 else if p1 = 'R25HEO' then Val := cRepMsg184 else if p1 = 'R25AGREED' then Val := cRepMsg185 else if p1 = 'R25BOXINSTALLED' then Val := cRepMsg186 else if p1 = 'R25PRESENCEPOWER200WFROMNETWORK' then Val := cRepMsg187 else if p1 = 'R25CABLESETTOBOX' then Val := cRepMsg188 else if p1 = 'R25FIBEROPTICWELDED' then Val := cRepMsg189 else if p1 = 'R25EQUIPMENTINSTALLED' then Val := cRepMsg190 else //Tolik if p1 = 'CROSSCONNECTION' then Val := cRepMsg205 else if p1 = 'BUILDINGDISTRIBUTOR' then Val := cRepMsg228 else if p1 = 'REELSCABLEFLOW' then //Tolik 07/09/2020 -- // Val := ReelsCableFlow.Text begin if Assigned(ReelsCableFlow) then Val := ReelsCableFlow.Text else Val := ''; end else if p1 = 'CABLEREZERV' then Val := cRepMsg229 else if p1 = 'WACOORDINATES' then Val := cRepMsg238 else if p1 = 'PATH' then Val := cRepMsg230 else if p1 = 'CABLE' then Val := cRepMsg240 else if p1 = 'CABLEWIREMARKING' then Val := cRepMsg247 else if p1 = 'TRACE' then Val := cRepMsg248 else if p1 = 'CABLETRACEPART' then Val := cRepMsg249 else if p1 = 'TRACEBEGIN' then Val := cRepMsg250 else if p1 = 'TRACEEND' then Val := cRepMsg251 else if p1 = 'CABLEWIRE' then Val := cRepMsg252 else if p1 = 'ONPROJECT' then Val := cRepMsg253 else if p1 = 'CABLELAID' then Val := cRepMsg254 else if p1 = 'COUNTANDCROSSSQUARE' then Val := cRepMsg255 else if p1 = 'CABLEMARK' then Val := cRepMsg256 else if p1 = 'CABLETUBEJOURNAL' then Val := cRepMsg257 else if p1 = 'THEN' then Val := cRepMsg206 else if p1 = 'PARTCABLELENGTH' then Val := cRepMsg237 else if p1 = 'PRIORCOSTOFPROJECT' then Val := cRepMsg192 else // к основной рамке на чертеж (подписи)(Tolik) if p1 = 'RAZRABOTAL' then Val := cRepMsg260 else if p1 = 'PROVERIL' then Val := cRepMsg261 else if p1 = 'NCONTROL' then Val := cRepMsg262 else if p1 = 'TCONTROL' then Val := cRepMsg263 else if p1 = 'UTVERDIL' then Val := cRepMsg264 { Значения из свойств проекта и листа} else if p1 = 'STAMPDEVELOPER' then try Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampDeveloper // разработал except end else if p1 = 'MAINENGINEER' then try Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampMainEngineer //главный инженер проекта except end else if p1 = 'STAMPCHECKER' then try Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampChecker // проверил except end else if p1 = 'STAMPAPPROVED' then try Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampApproved // утвердил except end else if p1 = 'DESIGNSTAGE' then try // Tolik -- 24/02/2020 -- if Assigned(GCadForm) then Val := GCadForm.FListSettings.CADStampDesignStage else Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampDesignStage // стадия проектирования except end else if p1 = 'PROECTORGANIZATION' then try Val := F_ProjMan.GSCSBase.CurrProject.Setting.OrganizationName // наименование организации проектировщика except end else if p1 = 'LISTSIGN' then try Val := F_ProjMan.GSCSBase.CurrProject.ProjectLists.Items[0].Setting.CADStampListSign // обозначение документа except end // else begin val := GetStrFromStringsByKey(FRepMsgList, p1); end; end else if Name = 'GETLOAT' then begin val := FloatToStrFix(p1, FloatPrecision); end; {if Name = 'EOPAGE' then begin // передаём номер по порядку - Npp - из базы P1 := ExpandVariables(P1); // и предыдущий номер по порядку - Npp - из базы P2 := ExpandVariables(P2); // если они равны, то № п/п = - 1; - для нормальной нумерации в отчёте if P1 = P2 then Val := - 1 else Val := 0; end;} {if Name = 'HIDEZERO' then if p1 = 0 then Val := false else Val := true; } end; // added dy Tolik function GetListName(AComponent: TSCSComponent): String; var //ListCatalog: TCatalog; SCSList: TSCSList; begin Result := ''; SCSList := nil; SCSList := AComponent.GetListOwner; //TF_Main(GForm).GSCSBase.CurrProject.GetListBySCSID(AIDList); if Assigned(SCSList) then Result := SCSList.GetNameForVisible(false); //ListCatalog := TF_Main(GForm).DM.GetCatalogByComponAndItemType(AIDComponent, itList); //Result := ListCatalog.Name; end; // процедура записи маркировки и длины линейных компонетов по пути кабеля в списки Procedure AddtoPropList(propList1,propList2:TStringList; SCSComponent : TSCSComponent); Var s: string; i: integer; SCSCatalog: TSCSCatalog; TopComponent: TSCSComponent; Begin SCSCatalog := SCSComponent.GetFirstParentCatalog; //трасса SCSCatalog.LoadLength; if SCSCatalog.Length <> 0 then begin SCSCatalog.LoadLength; TopComponent := SCSComponent.GetTopComponent; // элемент, в который вложен кабель (если есть) TopComponent.LoadCurrLength; //showmessage(floattostr(RoundCP(TopComponent.Length))); s:=''; if TopComponent<>SCSComponent then // если кабель вложен begin if TopComponent.NameMark = '' then //если нет маркировки begin if TopComponent.NameShort <> '' then s:=TopComponent.NameShort + ' ' + inttostr(TopComponent.MarkID); end else s := TopComponent.NameMark; // есть маркировка if s = '' then // нет ни маркировки ни обозначения - забиваем наименование(не более 14 символов) begin for i := 1 to Length(TopComponent.Name) do begin s:=s + TopComponent.Name[i]; if i = 14 then break; end; end; //наименование propList1.BeginUpdate; propList1.Add(s); propList1.EndUpdate; //длина компонента или трассы propList2.BeginUpdate; propList2.Add(Floattostr(RoundCP(SCSComponent.GetPartLength))); propList2.EndUpdate; end else // кабель лежит на трассе begin //наименование трассы propList1.BeginUpdate; propList1.Add(SCSComponent.GetFirstParentCatalog.Name + inttostr(SCSComponent.GetFirstParentCatalog.MarkID)); propList1.EndUpdate; //длина трассы propList2.BeginUpdate; propList2.Add(floattostr(RoundCP(SCSComponent.Length-SCSComponent.LengthReserv))); propList2.EndUpdate; end; end; End; //пипец Procedure GetCablePath(SCSCompon: TSCSComponent; propList,PropList1: TStringList; var ComponList: TSCSComponents); Var FirstCompon, LastCompon: TSCSComponent; m,x, PortCountFrom, PortCountTo : integer; s : string; currTrace,NextTrace: TFigure; // трассы, по которым проходит кабель currLine: TOrthoLine; // текущая трасса FirstTraceFound, NextTraceFound: Boolean; // две соседние трассы Figure: TFigure; Ortholine: TOrtholine; Connector1, Connector2, Connector3, Connector4: TConnectorObject; // коннекторы трасс Compon1, Compon2, Compon3, Compon4: TSCSComponent; // компоненты, сидящие на коннекторах трасс currSCSCatalog, nextSCSCatalog: TSCSCatalog; PartSCSComponent1,PartSCSComponent2: TSCScomponent; ListName: string; FromNppPort1: integer; ListOwner: TSCSList; TraceListOwner : TSCSList; ListCAD : TF_CAD; // Tolik 29/09/2016 -- CanAddBetweenFloorHeinght: Boolean; Begin FirstCompon := SCSCompon.FirstConnectedConnCompon;//.GetTopComponent; LastCompon := SCSCompon.LastConnectedConnCompon;//.GetTopComponent; PortCountFrom := 0; PortCountTo := 0; // определяем количество портов у конечных объектов на кабеле // для отчета берем маркировку топового компонента от объекта, у которого // портов больше (это будет предположительно, шкаф, панель и т.п.) // у объекта, имеющего меньше портов берем его маркировку if (FirstCompon <> nil) and (LastCompon <> nil) then begin if (FirstCompon.GetTopComponent <> nil) and (FirstCompon.GetTopComponent.IsLine <> 1) then begin if FirstCompon.GetTopComponent.Interfaces <> nil then begin if FirstCompon.GetTopComponent.Interfaces.Count = 0 then FirstCompon.GetTopComponent.LoadInterfaces(-1, false); PortCountFrom := GetPortsCount(FirstCompon.GetTopComponent, 1, true); end; end; if (LastCompon.GetTopComponent <> nil) and (LastCompon.GetTopComponent.IsLine <> 1) then begin if LastCompon.GetTopComponent.Interfaces <> nil then begin if LastCompon.GetTopComponent.Interfaces.Count = 0 then LastCompon.GetTopComponent.LoadInterfaces(-1, false); PortCountTo := GetPortsCount(LastCompon.GetTopComponent, 1, true); end; end; if PortCountFrom > PortCountTo then FirstCompon := FirstCompon.GetTopComponent; if PortCountTo > PortCountFrom then LastCompon := LastCompon.GetTopComponent; PropList.Add(FirstCompon.NameMark); PropList1.Add(' '); end; s := ''; for x := 0 to ComponList.Count - 1 do begin s := ''; nextSCSCatalog := nil; PartSCSComponent1 := ComponList[x]; ListOwner:=PartSCSComponent1.GetListOwner; currSCSCatalog := PartSCSComponent1.GetFirstParentCatalog; // трасса U_ResourceReport.AddtoPropList(propList,propList1,PartSCSComponent1); // добавляем трассу в список // получаем кабель(частями) currSCSCatalog.LoadLength; // длина трассы // если трасса не последняя в списке, то берем следующую // и ищем предмет, лежащий на стыке трасс (если есть) //09/03/2016 //if x <> SCSCompon.WholeComponent.Count-1 then if (x <> (SCSCompon.WholeComponent.Count - 1)) and (x <> (ComponList.Count - 1)) then begin PartSCSComponent2 := ComponList[x+1]; nextSCSCatalog := PartSCSComponent2.GetFirstParentCatalog; nextSCSCatalog.LoadLength; // длина трассы TraceListOwner := currSCSCatalog.GetListOwner; //лист, на котором находится трасса ListCad := GetListByID(TraceListOwner.SCSID); // Кад, на котором нарисована трасса currTrace := nil; // на всякий nextTrace := nil; connector1 := nil; connector2 := nil; connector3 := nil; connector4 := nil; compon1 := nil; compon2 := nil; compon3 := nil; compon4 := nil; currTrace := (TOrthoLine(GetFigureByID(ListCad,currSCSCatalog.SCSID))); // первая трасса // ищем трассу на Каде if currTrace <> nil then //нашли трассу на КАДе begin connector1 := TConnectorObject(Tortholine(CurrTrace).JoinConnector1); if connector1.JoinedConnectorsList.Count<>0 then begin // первый коннектор трассы connector1:=TConnectorObject(connector1.JoinedConnectorsList[0]); currSCSCatalog := ListOwner.GetCatalogFromReferencesBySCSID(connector1.ID); if currSCSCatalog.SCSComponents.Count<> 0 then Compon1:=currSCSCatalog.SCSComponents[0]; end; // второй коннектор трассы connector2 := TConnectorObject(Tortholine(CurrTrace).JoinConnector2); if connector2.JoinedConnectorsList.Count<>0 then begin connector2:=TConnectorObject(connector2.JoinedConnectorsList[0]); currSCSCatalog := ListOwner.GetCatalogFromReferencesBySCSID(connector2.ID); if currSCSCatalog.SCSComponents.Count<> 0 then Compon2:=currSCSCatalog.SCSComponents[0]; end; end; // вторая трасса TraceListOwner := nextSCSCatalog.GetListOwner; //лист, на котором находится трасса ListCad:=GetListByID(TraceListOwner.SCSID); // Кад, на котором нарисована трасса nextTrace := (TOrthoLine(GetFigureByID(ListCad,nextSCSCatalog.SCSID))); if nextTrace <> nil then //нашли трассу на КАДе begin //первый коннектор трассы connector3 := TConnectorObject(Tortholine(nextTrace).JoinConnector1); if connector3.JoinedConnectorsList.Count<>0 then begin connector3:=TConnectorObject(connector3.JoinedConnectorsList[0]); nextSCSCatalog := ListOwner.GetCatalogFromReferencesBySCSID(connector3.ID); if nextSCSCatalog.SCSComponents.Count<> 0 then Compon3:=nextSCSCatalog.SCSComponents[0]; end; // второй коннектор трассы connector4 := TConnectorObject(Tortholine(nextTrace).JoinConnector2); if connector4.JoinedConnectorsList.Count<>0 then begin connector4:=TConnectorObject(connector4.JoinedConnectorsList[0]); nextSCSCatalog := ListOwner.GetCatalogFromReferencesBySCSID(connector4.ID); if nextSCSCatalog.SCSComponents.Count<> 0 then compon4:=nextSCSCatalog.SCSComponents[0]; end; end; // определяем компонент на стыке трасс s:=''; if ((compon1 <> nil) and ((compon1 = compon3) or (compon1 = compon4))) then begin // если есть компонент - делаем следующее: // если есть маркировка - добавляем в список // если нет - ищем обозначение компонента и индекс // если и их нет - берем название компонента и обрезаем до 14 символов, // если его длина больше if compon1.NameMark<>'' then s:=compon1.NameMark else if compon1.NameShort<>'' then s:=s+compon1.NameShort+inttostr(compon1.MarkID); if s='' then begin for m := 0 to Length(compon1.Name) do begin s:=s + compon1.Name[m]; if m = 14 then break; end; end; // добавляем объект в список propList.BeginUpdate; propList.Add(s); propList.EndUpdate; propList1.BeginUpdate; propList1.Add(' '); propList1.EndUpdate; end; s:=''; // на всякий случай if ((compon2<>nil) and ((compon2 = compon3) or (compon2=compon4))) then begin if compon2.NameMark<>'' then s:=compon2.NameMark else if compon2.NameShort<>'' then s:=s+compon2.NameShort+inttostr(compon2.MarkID); if s='' then begin for m := 0 to Length(compon2.Name) do begin s:=s + compon2.Name[m]; if m = 14 then break; end; end; // добавляем объект в список propList.BeginUpdate; // Tolik 29/09/2016-- // propList.Add(s); propList.Add(copy(s, 1, 14)); // propList.EndUpdate; propList1.BeginUpdate; propList1.Add(' '); propList1.EndUpdate; end; // смотрим, есть ли межэтажное перекрытие // if ((TOrthoLine(currTrace).FIsRaiseUpDown) and (TOrthoLine(nextTrace).FIsRaiseUpDown)) then if PartSCSComponent1.GetListOwner <> PartSCSComponent2.GetListOwner then begin CanAddBetweenFloorHeinght := True; // не добавлять высоту межэтежки, если попали на магистраль {if ((TOrthoLine(currTrace).JoinConnector1 <> nil) and (TConnectorObject(TOrthoLine(currTrace).JoinConnector1).FConnRaiseType in [crt_BetweenFloorDown, crt_BetweenFloorUP, crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(currTrace).JoinConnector2 <> nil) and (TConnectorObject(TOrthoLine(currTrace).JoinConnector2).FConnRaiseType in [crt_BetweenFloorDown, crt_BetweenFloorUP, crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(NextTrace).JoinConnector1 <> nil) and (TConnectorObject(TOrthoLine(NextTrace).JoinConnector1).FConnRaiseType in [crt_BetweenFloorDown, crt_BetweenFloorUP, crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(NextTrace).JoinConnector2 <> nil) and (TConnectorObject(TOrthoLine(NextTrace).JoinConnector2).FConnRaiseType in [crt_BetweenFloorDown, crt_BetweenFloorUP, crt_TrunkUP, crt_TrunkDown])) then CanAddBetweenFloorHeinght := False;} if ((TOrthoLine(currTrace).JoinConnector1 <> nil) and (TConnectorObject(TOrthoLine(currTrace).JoinConnector1).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(currTrace).JoinConnector2 <> nil) and (TConnectorObject(TOrthoLine(currTrace).JoinConnector2).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(NextTrace).JoinConnector1 <> nil) and (TConnectorObject(TOrthoLine(NextTrace).JoinConnector1).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown])) or ((TOrthoLine(NextTrace).JoinConnector2 <> nil) and (TConnectorObject(TOrthoLine(NextTrace).JoinConnector2).FConnRaiseType in [crt_TrunkUP, crt_TrunkDown])) then CanAddBetweenFloorHeinght := False; if CanAddBetweenFloorHeinght then begin // если задана высота межэтажного перекрытия, добавляем его (там же тоже кабель проходит) if currSCSCatalog.ProjectOwner.Setting.HeightThroughFloor > 0 then begin propList.BeginUpdate; propList.Add(cRepMsg231); propList.EndUpdate; propList1.BeginUpdate; propList1.Add(FloatToStr(currSCSCatalog.ProjectOwner.Setting.HeightThroughFloor)); propList1.EndUpdate; end; end; end; end; end; if (FirstCompon <> nil) and (LastCompon<>nil) then begin // Tolik --29/09/2016-- PropList.Add(LastCompon.NameMark); PropList1.Add(' '); end; if ComponList <> nil then FreeAndNil(ComponList); End; // пипец // украдено у Игоря by Tolik из TSCSComponent.DefineFirstLast (модуль U_SCSComponent) // правда, немножко переделано совсем Procedure SetActualOrderInPartComponent(aComponent: TSCSComponent; ComponList : TSCSComponents; FromNppPort1 : integer; ListName : String); Var Component : TSCSComponent; SortedWholeComponent: TIntList; my_comp, ComponentToOrder: TSCSComponent; StepComponent: TSCSComponent; JoinedComponent: TSCSComponent; i, j: Integer; portcount1, portcount2 : integer; ListOwner: TSCSList; EndPointCad : TF_CAD; PointComponent : TSCSComponent; SCSCatalog : TSCSCatalog; SCSInterfaces: TSCSInterfaces; Begin Component := aComponent; // SCSCatalogs := TSCSCatalogs.Create(false); SortedWholeComponent := TIntList.Create; Component.DefineFirstLast; ComponentToOrder := nil; ListOwner := Component.GetListOwner; my_comp := Component.FirstConnectedConnCompon.GetTopComponent; if my_comp <> nil then begin SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount1 := SCSInterfaces.Count; // Tolik -- 20/02/2017 -*- утечка памяти SCSInterfaces.Clear; SCSInterfaces.Free; // my_comp := Component.LastConnectedConnCompon.GetTopComponent; SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount2 := SCSInterfaces.Count; // Tolik -- 20/02/2017 -*- SCSInterfaces.Clear; SCSInterfaces.Free; // ComponentToOrder := Component.FirstConnectedConnCompon; // Сразу же определяем порядок листов для отчета // и порт шкафа begin if Component.FirstConnectedConnCompon.ListID = Component.LastConnectedConnCompon.ListID then ListName := U_ResourceReport.GetListName(Component.FirstConnectedConnCompon) else begin if Portcount1 >= PortCount2 then ListName := U_ResourceReport.GetListName(Component.FirstConnectedConnCompon)+'/'+GetListName(Component.LastConnectedConnCompon) else ListName := U_ResourceReport.GetListName(Component.LastConnectedConnCompon)+'/'+GetListName(Component.FirstConnectedConnCompon); end; end; if PortCount1 >= PortCount2 then ComponentToOrder := Component.FirstConnectedConnCompon else begin ComponentToOrder := Component.LastConnectedConnCompon; Component.LastConnectedConnCompon := Component.FirstConnectedConnCompon; Component.FirstConnectedConnCompon := ComponentToOrder; end; FromNppPort1 := Component.FirstConnectedConnCompon.MarkID ; if Component<> nil then begin for i := 0 to Component.WholeComponent.Count - 1 do begin for j := 0 to ComponentToOrder.JoinedComponents.Count - 1 do begin StepComponent := ComponentToOrder.JoinedComponents[j]; if ((SortedWholeComponent.IndexOf(StepComponent.ID)= -1) and (Component.WholeComponent.IndexOf(StepComponent.ID)<> -1)) then begin SortedWholeComponent.Add(StepComponent.ID); ComponList.Add(StepComponent); ComponentToOrder := StepComponent; SCSCatalog := StepComponent.GetFirstParentCatalog; break; end; end; end; end; ComponentToOrder := Component; //*** Не один участок кабеля не ушел в пизду if ComponentToOrder.WholeComponent.Count = SortedWholeComponent.Count then begin ComponentToOrder.WholeComponent.Clear; ComponentToOrder.WholeComponent.Assign(SortedWholeComponent); end; SortedWholeComponent.Free; end; End; // // сортировка массива кабелей по убыванию в массиве типов Procedure SortCables (var CableTypes : TCableTypeArray); Var i,j,l: integer; k: double; SortAgain: boolean; s: string; Begin if Length(CableTypes) > 1 then begin for i := 0 to Length(CableTypes) - 1 do begin // если элементов массива больше двух, выполняем "пузырьковую сортировку" if Length(CableTypes[i].Cables) > 2 then begin repeat SortAgain := false; for j := 0 to Length(CableTypes[i].Cables) - 2 do begin if CableTypes[i].Cables[j].Length < CableTypes[i].Cables[j + 1].Length then begin k := CableTypes[i].Cables[j].Length; // длина кабеля l := CableTypes[i].CableIDs[j]; // идентификатор CableTypes[i].Cables[j].Length := CableTypes[i].Cables[j + 1].Length; CableTypes[i].CableIDs[j] := (CableTypes[i].CableIDs[j + 1]); CableTypes[i].Cables[j + 1].Length := k; CableTypes[i].CableIDs[j + 1] := l; SortAgain := true; end; end; until not SortAgain; end; // если кабеля всего 2, то, при необходимости, меняем их местами if Length(CableTypes[i].Cables) = 2 then begin if CableTypes[i].Cables[0].Length < CableTypes[i].Cables[1].Length then begin k := CableTypes[i].Cables[0].Length; // длина кабеля l := CableTypes[i].CableIDs[0]; // идентификатор CableTypes[i].Cables[0].Length := CableTypes[i].Cables[1].Length; CableTypes[i].CableIDs[0] := (CableTypes[i].CableIDs[1]); CableTypes[i].Cables[1].Length := k; CableTypes[i].CableIDs[1] := l; SortAgain := true; end; end; end; end; End; // функция "можно ли еще чего отрезать от данной катушки" Function CanCutReel (var Reel : TCableReels; var Cables : array of TCables) : boolean; Var i: integer; Begin Result := false; for i := 0 to Length(Cables) - 1 do begin if not Cables[i].Selected then // если остаток кабеля в катушке больше отрезка кабеля if (Reel.Rest >= Cables[i].Length) and (Cables[i].Selected = false) then begin Result := true; Reel.CanCut := true; break; end; end; If not Result then Reel.CanCut := False; // если ничего уже нельзя отрезать, помечаем катушку как отработанную End; // функция для формирования списка айдишников отобранных кабелей Function AddCableId(var CableIdsList:TIntList; CableId : integer) : boolean; Var i: integer; Begin Result := True; if CableIdsList <> nil then begin if CableIdsList.Count > 0 then begin for i := 0 to CableIdsList.Count - 1 do begin if CableIdsList[i] = CableId then Result := False; end; end else Result := True; end else begin CableIdsList := TIntList.Create; Result := True; end; if Result then begin CableIdsList.Add(CableId); end; End; // процедура записи наименований катушек в таблицу //no comments (сам не понял,чего написал) Procedure CableReelNamesToMemTable(aMemTable : TkbmMemTable; CableTypes : TCableTypeArray); Var i,j,k,l: integer; ReelFound: boolean; ReelCount: integer; s: string; Begin ReelCount := 0; // если таблица не пустая if not aMemTable.IsEmpty then begin // если список кабелей не пустой if Length(CableTypes) > 0 then begin if aMemTable.RecordCount > 0 then begin aMemTable.First; repeat ReelFound := False; ReelCount := 0; l := aMemTable.FieldValues['ID']; for i := 0 to Length(CableTypes) - 1 do begin if Length(CableTypes[i].Reels) > 0 then begin for j := 0 to Length(CableTypes[i].Reels) - 1 do begin if CableTypes[i].Reels[j].CableIDs.Count > 0 then begin for k := 0 to CableTypes[i].Reels[j].CableIDs.Count - 1 do begin if l = CableTypes[i].Reels[j].CableIDs[k] then begin if ReelCount = 0 then begin aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString :=' ('+ CableTypes[i].ReelName + cRepMsg234+ inttostr(j+1)+')'; ReelFound := True; aMemTable.Post; inc(ReelCount); break; end else //для кабеля с длиной, превышающей длину поставки begin aMemTable.Edit; s := aMemTable.FieldByName('REELNAME').Value; delete(s, pos(')',s), 1); aMemTable.FieldByName('REELNAME').AsString := s + ', ' + inttostr(j+1)+')'; ReelFound := True; inc(ReelCount); aMemTable.Post; break; end; //break; end; end; end; end; end; end; if not ReelFound then begin aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString := ' ('+ cRepMsg233+')'; aMemTable.Post; end else if ReelCount > 1 then begin aMemTable.Edit; s := aMemTable.FieldByName('REELNAME').value; aMemTable.FieldByName('REELNAME').AsString := s + ' ('+ cRepMsg233+')'; aMemTable.Post; end; if not aMemTable.eof then aMemTable.Next; until aMemTable.Eof; end; end else begin // Tolik 09/10/2017 -- if aMemTable.RecordCount > 0 then begin aMemTable.First; repeat aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString := ' ('+ cRepMsg233+')'; aMemTable.Post; if not aMemTable.eof then aMemTable.Next; until aMemTable.eof; end; end; end; End; // процедура добавления типа кабеля в список Procedure CableTypesAdd(SCSComponent : TSCSComponent; var CableTypes : TCableTypeArray; var CableIdsList : TIntList; CableID : Integer; aForm: TF_ResourceReport); Var i ,j: integer; CableIn, TakeThisCable: boolean; CurrSuppliesKind: TNBSuppliesKind; k: double; // CurrSuppliesKind : TNBSuppliesKind; //процедура записи типа кабеля в список Procedure SaveCableType(SCSComponent : TSCSComponent; CurrSuppliesKind: TNBSuppliesKind); // Var // currCableTypes : TCableTypeArray; Begin // Setlength(currCableTypes,length(currCableTypes)+1); // сохраняем величину поставки(пригодится) if CheckIsTradUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure) then begin // F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure SetLength(CableTypes, Length(CableTypes) + 1); CableTypes[Length(CableTypes) - 1].Length := RoundX(FloatInUOM(CurrSuppliesKind.Data.UnitKolvoTradUOM, umFoot, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); CableTypes[Length(CableTypes) - 1].CableIDs := TIntList.Create; CableTypes[Length(CableTypes) - 1].Izm := GetNameUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure, true); CableTypes[Length(CableTypes) - 1].CableCypher := SCSComponent.Cypher; end else begin SetLength(CableTypes, Length(CableTypes) + 1); CableTypes[Length(CableTypes) - 1].Length := RoundX(FloatInUOM(CurrSuppliesKind.Data.UnitKolvo, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); CableTypes[Length(CableTypes) - 1].CableIDs := TIntList.Create; // 18/10/2020 -- в метрической могут быть сантиметры....ю поэтому: //CableTypes[Length(CableTypes) - 1].Izm := CurrSuppliesKind.Data.Izm; // единицы измерения CableTypes[Length(CableTypes) - 1].Izm := GetNameUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure, true); // CableTypes[Length(CableTypes) - 1].CableCypher := SCSComponent.Cypher; end; CableTypes[Length(CableTypes) - 1].ReelName := CurrSuppliesKind.Data.Name; // наименование поставки(катушка, моток, боббина и т.п.) // CableTypes[Length(CableTypes) - 1].Length := RoundX(FloatInUOM(CurrSuppliesKind.Data.UnitKolvoTradUOM, umFoot, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); CableTypes[Length(CableTypes) - 1].TypeName := CurrSuppliesKind.Data.GUID; // GUIDNB CableTypes[Length(CableTypes) - 1].Name := SCSComponent.Name + ' ' + SCSComponent.ArticulProducer;// + ' ' + SCSComponent.NameMark + ' ' + SCSComponent.ArticulProducer; // добавляем отрезок кабеля к данному типу SetLength(CableTypes[Length(CableTypes) - 1].Cables, Length(CableTypes[Length(CableTypes) - 1].Cables) + 1); if CheckIsTradUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure) then Cabletypes[Length(CableTypes) - 1].Cables[Length(Cabletypes[Length(CableTypes) - 1].Cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue) //RoundCP(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure)) else Cabletypes[Length(CableTypes) - 1].Cables[Length(Cabletypes[Length(CableTypes) - 1].Cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); //RoundCP(SCSComponent.Length); Cabletypes[Length(CableTypes) - 1].CableIDs.Add(CableID); // идентификатор кабеля // Cabletypes[Length(CableTypes)-1].GuidNB := CurrSuppliesKind.Data.GUID; End; Begin // SCSComponent.LoadWholeLength; // SCSComponent.LoadWholeComponent(false); // если кабель еще не выбирался if AddCableID(CableIDsList, CableId) then begin CableIn := false; CurrSuppliesKind := nil; // получаем параметры поставки кабеля CurrSuppliesKind := F_ProjMan.GSCSBase.CurrProject.Spravochnik.GetSuppliesKindByID(SCSComponent.IDSuppliesKind); // если задан вид поставки if CurrSuppliesKind <> nil then begin // Если длина кабеля превышает длину поставки - его не считаем //TakeThisCable := True; SCSComponent.LoadWholeLength; // загрузить длину кабеля по всей длине {if CheckIsTradUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure) then begin if (RoundX(FloatInUOM(SCSComponent.Length, umMetr, umFoot), aForm.neKolvoPrecision.IntValue) > //if (RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue) > // могут быть дюймы... CurrSuppliesKind.Data.UnitKolvoTradUOM) then TakeThisCable := false; end else begin if SCSComponent.Length > CurrSuppliesKind.Data.UnitKolvo then TakeThisCable := false; end;} // Если кабель годится(длина не превышает величину поставки) - смотрим тип и отбираем типы кабелей //if TakeThisCable then begin // проверяем на наличие типа кабеля // если список типов пуст - добавляем сразу if Length(CableTypes) = 0 then SaveCableType(SCSComponent, CurrSuppliesKind) else // если список типов не пуст - проверяем, нет ли такого в списке begin CableIn := false; for i := 0 to Length(CableTypes) - 1 do begin // есть такой кабель - добавляем этот отрезок кабеля в список с данному типу // if CableTypes[i].TypeName = CurrSuppliesKind.Data.GUID then if CableTypes[i].CableCypher = SCSComponent.Cypher then begin CableIn := true; SetLength(CableTypes[i].cables,Length(CableTypes[i].cables) + 1); if CheckIsTradUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure) then // Cabletypes[Length(CableTypes) - 1].Cables[Length(Cabletypes[Length(CableTypes) - 1].Cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue) CableTypes[i].cables[Length(CableTypes[i].cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue) //RoundCP(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure)) else // Cabletypes[Length(CableTypes) - 1].Cables[Length(Cabletypes[Length(CableTypes) - 1].Cables) - 1].Length := RoundX(SCSComponent.Length, aForm.neKolvoPrecision.IntValue);//RoundCP(SCSComponent.Length); // Cabletypes[Length(CableTypes) - 1].Cables[Length(Cabletypes[Length(CableTypes) - 1].Cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); CableTypes[i].Cables[Length(CableTypes[i].cables) - 1].Length := RoundX(FloatInUOM(SCSComponent.Length, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure), aForm.neKolvoPrecision.IntValue); CableTypes[i].CableIDs.Add(CableID); // идентификатор кабеля break; end; end; // нет такого типа кабеля в списке - добавляем if not CableIn then SaveCableType(SCSComponent,CurrSuppliesKind); end; end; end // задана поставка end; // кабель не выбирался End; // освобождение памяти, занятой массивом типов кабелей Procedure FreeCableTypes(CableTypes : TCableTypearray); Var i,j: integer; Begin if Length(CableTypes) > 0 then begin for i := 0 to Length(CableTypes) - 1 do begin if Length(CableTypes[i].Reels) > 0 then begin for j := 0 to Length(CableTypes[i].Reels) - 1 do begin FreeAndNil(CableTypes[i].Reels[j].CableIDs); end; end; FreeAndNil(CableTypes[i].CableIDs); end; end; SetLength(CableTypes,0); End; // расчет количества катушек и резка кабелей от них Procedure CableReelCalculate(CableTypes : TCableTypeArray; MethodType : string; var ReelsCableFlow : TStringList; aForm: TF_ResourceReport ); Var i,j,k,l : integer; ReelsCount : integer; // текущее расчетное количество катушек для типа кабеля ReelsCounter : integer; // счетчик отработанных катушек SCSComponent : TSCSComponent; CableIn : Boolean; CurrSuppliesKind: TNBSuppliesKind; CableChecks : array of boolean; TakeThisCable : Boolean; s, OverReelString : string; // OverReelString - для единиц поставки, отрезанных от компонент с длиной, превышающей длину поставки // Сброс параметров типов кабелей Procedure DropCableTypesParam(CableTypes : TCableTypes); Var i : integer; Begin // сбрасываем параметры кабелей для данного типа кабеля if Length(CableTypes.Cables) > 0 then begin for i := 0 to Length(CableTypes.Cables) - 1 do begin CableTypes.Cables[i].Selected := False; end; end; // сбрасываем параметры катушек if Length(CableTypes.Reels) > 0 then begin for i := 0 to Length(CableTypes.Reels) - 1 do begin // остаток кабеля в катушке CableTypes.Reels[i].Rest := CableTypes.Length; // список отрезков кабелей SetLength(CableTypes.Reels[i].Cables, 0); // можно ли резать из катушки CableTypes.Reels[i].CanCut := True; // список айдишников кабелей (если есть) if CableTypes.Reels[i].CableIDs <> nil then begin if CableTypes.Reels[i].CableIDs.Count > 0 then CableTypes.Reels[i].CableIDs.Clear; end; end; end; End; // пипец function getOverReels(var aReelsCount: integer; aOrder: Integer): string; var i, j, k: integer; ReelsCount : integer; begin Result := ''; aReelsCount := 0; for k := 0 to Length(CableTypes[aOrder].Cables) - 1 do begin // если кабель больше величины поставки if (CableTypes[aOrder].Cables[k].Selected = false) and (CableTypes[aOrder].Cables[k].Length >= CableTypes[aOrder].Length) then begin // отрезаем от кабеля размер катушки, пока он не станет меньше, чем величина поставки(катушки) while CableTypes[aOrder].Cables[k].Length >= CableTypes[aOrder].Length do begin CableTypes[aOrder].Cables[k].Length := CableTypes[aOrder].Cables[k].Length - CableTypes[aOrder].Length; SetLength(CableTypes[aOrder].Reels, Length(CableTypes[aOrder].Reels) + 1); CableTypes[aOrder].Reels[Length(CableTypes[aOrder].Reels) - 1].Rest := 0; //списов идентификаторов кабелей в катушке CableTypes[aOrder].Reels[Length(CableTypes[aOrder].Reels) - 1].CableIDs := TIntList.Create; CableTypes[aOrder].Reels[Length(CableTypes[aOrder].Reels) - 1].CableIDs.add(CableTypes[aOrder].CableIDs[k]); Inc(aReelsCount); if Result = '' then Result := inttostr(aReelsCount) else Result := Result + ', ' + inttostr(aReeLsCount); end; end; end; if Result <> '' then begin if aReelsCount > 1 then Result := 'Для кабелей с превышающей длиной катушки №№: ' + Result else Result := 'Для кабелей с превышающей длиной катушка №: ' + Result; end; end; // расчет количества бухт и расхода кабелей // режим еффективной работы Procedure MaxEfficiency(CableTypes : TCableTypeArray); Var i,j,k,l : integer; Counter : integer; // счетчик AllCableLength : double; s : string; // сточка для отчета (катушка № + список кабелей) CableCut : Boolean; overrellsCount: integer; OverReelCount: integer; OverReelStr: String; Begin // если список типов кабелей не пустой if Length(CableTypes) > 0 then begin // формируем количество катушек // для каждого типа кабеля // делаем предварительный просчет количества катушек // Tolik 02/11/2020 -- //кабели с длиной, превышающей длину поставки(коцаем) for i := 0 to Length(CableTypes) - 1 do begin for j := 0 to Length(CableTypes[i].Cables) - 1 do begin while CableTypes[i].Cables[j].Length > Cabletypes[i].Length do begin CableTypes[i].Cables[j].Length := CableTypes[i].Cables[j].Length - Cabletypes[i].Length; SetLength(CableTypes[i].Reels, Length(CableTypes[i].Reels) + 1); CableTypes[i].Reels[Length(CableTypes[i].Reels) -1].Rest := -1; CableTypes[i].Reels[Length(CableTypes[i].Reels) -1].CableIDs := TIntList.Create; CableTypes[i].Reels[Length(CableTypes[i].Reels) -1].CableIDs.Add(CableTypes[i].CableIDs[j]); end; end; end; // for i := 0 to Length(CableTypes) - 1 do begin AllCableLength := 0; Counter := 0; // если есть список кабелей if Length(CableTypes[i].Cables) > 0 then begin // получаем общую длину кабелей и их количество for j := 0 to Length(CableTypes[i].Cables) - 1 do begin AllCableLength := AllCableLength + CableTypes[i].Cables[j].Length; Counter := Counter + 1; end; // если общая длина кабелей данного типа не нулевая, можно производить расчет количества катушек if AllCableLength > 0 then begin // Tolik 02/11/2020 -- if CableTypes[i].Cables[j].Length > 0 then begin repeat // добавляем катушку (единицу поставки, может быть и не катущка) SetLength(CableTypes[i].Reels,Length(CableTypes[i].Reels) + 1); if Length(CableTypes[i].Reels) >= 10000 then begin showmessage(cRepMsg236); break; end; // начальный остаток в катушке - величина поставки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest := Cabletypes[i].Length; //создаем список идентификаторов кабелей для катушки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].CableIDs := TIntList.Create; for j := 0 to Length(CableTypes[i].Cables) - 1 do begin // если остаток кабеля в катушке больше или равен размеру текущего кабеля заданного типа и кабель еще не отрезался - отрезаем if (CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest >= CableTypes[i].Cables[j].Length) and (CableTypes[i].Cables[j].Selected = false) then begin CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest := CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest - CableTypes[i].Cables[j].Length; CableTypes[i].Cables[j].Selected := true; // CableTypes[i].Reels[Length(CableTypes[i].Reels)-1].CableIDs.Add(CableTypes[i].CableIDs[j]); // идентификатор кабеля Dec(Counter); if Counter = 0 then Break; //// BREAK ////; на всякий //Counter := Counter - 1; // уменьшаем счетчик end; end; until Counter = 0; end; // сбрасываем отметки кабелей for j := 0 to Length(CableTypes[i].Cables) - 1 do begin CableTypes[i].Cables[j].Selected := false; end; //возвращаем остатки в исходное положение for j := 0 to Length(CableTypes[i].Reels) - 1 do //CableTypes[i].Reels[j].Rest := CableTypes[i].Length; if CableTypes[i].Reels[j].Rest <> -1 then // только не для катушек, отрезанных от кабеля с превышающей длиной CableTypes[i].Reels[j].Rest := CableTypes[i].Length; end; end; end; // финиш предварительного просчета // теперь, если есть катушки - режем по алгоритму (от каждой по очереди ), пока не отрежем все кабели // для каждого типа кабеля for i := 0 to Length(CableTypes) - 1 do begin AllCableLength := 0; Counter := 0; ReelsCount := Length(CableTypes[i].Reels); // расчетное количество катушек данного типа кабеля // если есть список кабелей if Length(CableTypes[i].Cables) > 0 then begin // получаем общую длину кабелей и их количество for j := 0 to Length(CableTypes[i].Cables) - 1 do begin AllCableLength := AllCableLength + CableTypes[i].Cables[j].Length; Counter := Counter + 1; end; // если общая длина кабелей данного типа не нулевая, можно резать if AllCableLength > 0 then begin // сначала добавляем тип кабеля в список ReelsCableFlow.Add(Cabletypes[i].Name); // Для кабелей с превышающей длиной OverReelStr := ''; OverReelCount := 0; for j := 0 to Length(CableTypes[i].Reels) - 1 do begin if CableTypes[i].Reels[j].Rest = -1 then begin if OverReelStr = '' then OverReelStr := inttostr(j + 1) else OverReelStr := OverReelStr + ', ' + inttostr(j + 1); inc(OverReelCount); end; end; if OverReelCount > 0 then begin if OverReelCount > 1 then OverReelStr := 'Для кабелей с превышающей длиной катушки №№: ' + OverReelStr else OverReelStr := 'Для кабелей с превышающей длиной катушка №: ' + OverReelStr; ReelsCableFlow.Add(OverReelStr); end; // repeat for j := 0 to Length(CableTypes[i].Reels) - 1 do begin ReelsCounter := 0; // счетчик отработанных катушек // если от катушки можно чего отрезать ... if CanCutReel(CableTypes[i].Reels[j],CableTypes[i].Cables) then // то отрезаем begin for k := 0 to Length(CableTypes[i].Cables) - 1 do begin if ((CableTypes[i].Cables[k].Length <= CableTypes[i].Reels[j].Rest) and (CableTypes[i].Cables[k].Selected = False)) then begin // отрезаем CableTypes[i].Reels[j].Rest := CableTypes[i].Reels[j].Rest - CableTypes[i].Cables[k].Length; // добавляем к катушке идентификатор кабеля CableTypes[i].Reels[j].CableIDs.Add(CableTypes[i].CableIDs[k]); // добавляем к катушке кабель SetLength(CableTypes[i].Reels[j].Cables, Length(CableTypes[i].Reels[j].Cables) + 1); CableTypes[i].Reels[j].Cables[Length(CableTypes[i].Reels[j].Cables) - 1] := CableTypes[i].Cables[k].Length; CableTypes[i].Cables[k].Selected := True; // отмечаем кабель как отрезанный //Counter := Counter - 1; // уменьшаем счетчик неотрезанных кабелей dec(Counter); break; end; end; end // если от катушки отрезать ничего уже нельзя, то увеличиваем счетчик отработанных катушек else ReelsCounter := ReelsCounter + 1; end; // если приключилось так, что расчетного количества катушек не хватило, чтобы отрезать весь кабель // (счеткик отработанных катушек будет равен их количеству, а счетчик отрезанных кабелей еще не обнулился), // то нужно добавить катушку к данному типу кабелей и сбросить расчеты, чтобы все пересчиталось заново if ((ReelsCounter = ReelsCount) and (Counter > 0)) then begin // сбрасываем расчеты для данного типа кабеля DropCableTypesParam(CableTypes[i]); // добавляем катушку (единицу поставки, может быть и не катущка) SetLength(CableTypes[i].Reels,Length(CableTypes[i].Reels) + 1); // начальный остаток в катушке - величина поставки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest := Cabletypes[i].Length; //создаем список идентификаторов кабелей для катушки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].CableIDs := TIntList.Create; // обновляем счетчик отрезанных кабелей для перерасчета Counter := Length(CableTypes[i].Cables); end; until Counter = 0; // добавляем список катушек с кабелями в лист для отчета // катушки for j := 0 to Length(CableTypes[i].Reels) - 1 do begin if CableTypes[i].Reels[j].Rest <> -1 then begin s := ' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(j + 1)+ ': '; //s := ' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(overrellsCount + 1)+ ': '; for k := 0 to Length(CableTypes[i].Reels[j].Cables) - 1 do begin s := s + FormatFloat('0.0##', CableTypes[i].Reels[j].Cables[k]); if k < (Length(CableTypes[i].Reels[j].Cables) - 1) then if Length(s) <> Length(' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(overrellsCount + 1)+ ': ') then s := s + '; '; end; // s := s + cRepMsg235 + floattostr(Cabletypes[i].Reels[j].Rest) + CableTypes[i].Izm + cRepMsg232; s := s + cRepMsg235 + FormatFloat('0.0##',Cabletypes[i].Reels[j].Rest) + ' ' + CableTypes[i].Izm + cRepMsg232; ReelsCableFlow.Add(s); end; //inc(overrellsCount); end; end; end; end; // пока не отрежем все кабели end; End; // расчет количества бухт и расхода кабелей // режим економии кабеля Procedure MaxScrapRate(CableTypes : TCableTypeArray); Var i,j,k,l : integer; ReelsCount : integer; AllCableLength : double; rest : double; AllCablesDistributed : boolean; CableCut : boolean; Counter : integer; s : string; overrellsCount: integer; Begin // если есть кабели if Length(CableTypes) > 0 then begin // for each cable type count Reels for i := 0 to Length(CableTypes) - 1 do begin AllCableLength := 0; Counter := 0; // если длина кабелей данного типа больше ноля // можно считать расход кабеля for j := 0 to Length(CableTypes[i].Cables) - 1 do begin AllCableLength := AllCableLength + CableTypes[i].Cables[j].Length; Counter := Counter + 1; end; if AllCableLength > 0 then begin ReelsCableFlow.Add(CableTypes[i].Name); // для кабелей с превышающей длиной OverReelString := getOverReels(overrellsCount, i); if OverReelString <> '' then begin ReelsCableFlow.Add(OverReelString); end; repeat // добавляем катушку SetLength(CableTypes[i].Reels, Length(CableTypes[i].Reels) + 1); // если количество катушек больше 10000, то брякнемся (на всякий) if Length(CableTypes[i].Reels) >= 10000 then begin showmessage(cRepMsg236); break; end; // величина поставки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest := CableTypes[i].Length; //списов идентификаторов кабелей в катушке CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].CableIDs := TIntList.Create; // начинаем резать от нее все, что смогем s := ' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(Length(CableTypes[i].Reels))+ ': '; for k := 0 to Length(CableTypes[i].Cables) - 1 do begin // если кабель меньше остатка и еще не отрезался - отрезаем if (CableTypes[i].Cables[k].Selected = false) and (CableTypes[i].Cables[k].Length < CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest) then begin // отрезаем от катушки CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest := CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest - CableTypes[i].Cables[k].Length; // причисляем кабель к данной катушке SetLength(CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Cables, Length(CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Cables) + 1 ); CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Cables[Length(CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Cables) - 1] := CableTypes[i].Cables[k].Length; // добавляем к катушке идентификатор кабеля CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].CableIDs.Add(CableTypes[i].CableIDs[k]); // отмечаем кабель как отрезанный CableTypes[i].Cables[k].Selected := true; // формируем строку (длины кабелей в катушке) if Length(s)<> Length(' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(Length(CableTypes[i].Reels))+ ': ') then s := s +' ; '; s := s + FormatFloat('0.0##', CableTypes[i].Cables[k].Length); Counter := Counter - 1; // уменьшаем счетчик end; end; // s := s + cRepMsg235 + floattostr(CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest) + CableTypes[i].Izm + cRepMsg232; s := s + cRepMsg235 + FormatFloat('0.0##', CableTypes[i].Reels[Length(CableTypes[i].Reels) - 1].Rest) + ' ' + CableTypes[i].Izm + cRepMsg232; ReelsCableFlow.Add(s); until Counter = 0; s := ''; end; end; // округляем остатки { for i := 0 to Length(CableTypes)-1 do begin for j := 0 to Length(CableTypes[i].Reels)-1 do begin CableTypes[i].Reels[j].Rest := RoundX(CableTypes[i].Reels[j].Rest , aForm.neKolvoPrecision.IntValue); end; end; } end; End; Begin // очищаем или создаем список типов кабелей с катушками и // отрезанными от них кабелями if ReelsCableFlow = nil then ReelsCableFlow := TStringList.Create else ReelsCableFlow.Clear; // сортируем кабели по убыванию по типам SortCables(CableTypes); // расчет расхода по заданному алгоритму if MethodType = 'MaxEfficiency' then MaxEfficiency(CableTypes); if MethodType = 'MaxScrapRate' then MaxScrapRate(CableTypes); End; //Tolik -- 04/09/2016 -- { Constructor TCableWayCompon.Create; begin FirstCompon := nil; LastCompon := Nil; Npp := 0; Passed := False; CanSeekSide1 := True; CanSeekSide2 := True; CableInterfName := ''; CableInterface := nil; Side1ConnectedInterface := Nil; Side2ConnectedInterface := Nil; Side1InterfList := Nil; Side2InterfList := Nil; WayList := TList.Create; GroupedNpp := TIntList.Create; end; Destructor TCableWayCompon.Destroy; begin FirstCompon := nil; LastCompon := Nil; CableInterface := nil; Npp := 0; Passed := False; FreeAndNil(WayList); FreeAndNil(GroupedNpp); end; } ////////////////////////// procedure TReportShablons.AddShablonToList(AID: Integer; AName: String; AIsActive: Boolean); begin FRepShablons.AddObject(AName, TObject(AID)); if AIsActive then FActiveShablonID := AID; end; procedure TReportShablons.DefineActiveShablonIfNoDefined; begin if FActiveShablonID = -1 then // Если в списке есть еще другие шаблоны, то выбираем последний из списка if FRepShablons.Count > 0 then FActiveShablonID := Integer(FRepShablons.Objects[FRepShablons.Count-1]); end; procedure TReportShablons.ClearRepShablons; begin FRepShablons.Clear; //AddShablonToList(0, cResourceReport_Msg9, true); FActiveShablonID := -1; end; constructor TReportShablons.Create; begin inherited; FActiveShablonID := -1; FRepShablons := TStringList.Create; FMessgShablonNoExists := cResourceReport_Msg9_2; ClearRepShablons; end; destructor TReportShablons.Destroy; begin FreeAndNil(FRepShablons); inherited; end; function TReportShablons.GetActiveShablonName: string; begin Result := GetShablonNameByID(FActiveShablonID); end; function TReportShablons.GetShablonNameByID(AID: Integer): string; var IndexOfID: Integer; begin Result := FMessgShablonNoExists; IndexOfID := FRepShablons.IndexOfObject(TObject(AID)); if IndexOfID <> -1 then Result := FRepShablons.Strings[IndexOfID]; end; procedure TReportShablons.RemoveShablonNameByID(AID: Integer); var IndexOfID: Integer; begin if AID <> 0 then begin IndexOfID := FRepShablons.IndexOfObject(TObject(AID)); if IndexOfID <> -1 then FRepShablons.Delete(IndexOfID); //*** Определить новый активный шаблон if AID = FActiveShablonID then // Если стандартный есть в списке, то делаем его активным if FRepShablons.IndexOfObject(TObject(0)) <> -1 then FActiveShablonID := 0 else begin FActiveShablonID := -1; DefineActiveShablonIfNoDefined; end; end; end; { TReportItemParams } constructor TReportItemParams.Create(AMode: TResourceReportFormMode; ARepType: Integer; AReportUseKind: TReportUseKind); begin inherited Create; Mode := AMode; RepType := ARepType; ReportUseKind := AReportUseKind; ReportUseByProjType := []; CanHaveActiveComponents := biFalse; CanHaveZeroPriceComponents := biFalse; CanHaveFormMode := biFalse; CanHavePageSize := biFalse; CanHaveDismountAccount := biFalse; CanHaveTemplate := biTrue; CanHaveStamp := biFalse; FullPathInCableJournal := biFalse; CanHaveSupplyValue := biFalse; CanRoundValue := biFalse; CanAsPlacingInProj := biFalse; CanGroupByCompType := biFalse; CanFloorNppWithRoom := biFalse; CanInTwoCopies := biFalse; CanCabinetParams := biFalse; CanResources := biFalse; CanPricePrecision := biFalse; CanKolvoPrecision := biFalse; //Added by Tolik for ExplicationComponent Report CanShowKabinet :=biFalse; CanShowObjHierarchy :=biFalse; CanGroupByName := biFalse; //ShowHeightOfPlacing := biFalse; // 06/03/2018 -- GroupByHeightOfPlacing := biFalse; ////////////////////////////////// CanShowResources := biFalse; CanShowWorks := biFalse; CanShowCablePaths := biFalse; CanShowOldReportForm := biFalse; PageToShow := 0; GroupMode := biNone; FSimpleShablons := TReportShablons.Create; FStampShablons := TReportShablons.Create; FReportSortInfo := TReportSortInfo.Create(Self); end; destructor TReportItemParams.Destroy; begin FreeAndNil(FSimpleShablons); FreeAndNil(FStampShablons); FreeAndNil(FReportSortInfo); inherited; end; function TReportItemParams.GetShablonsByTemplateType( ATemplateType: Integer): TReportShablons; begin Result := nil; case ATemplateType of ttSimple: Result := FSimpleShablons; ttStamp: Result := FStampShablons; end; end; { TF_ResourceReport } // ##### Конструктор ##### constructor TF_ResourceReport.Create(AOwner: TComponent; AForm: TForm); begin GForm := AForm; ExportToXLSX := False; ExportToDocX := False; Inherited Create(AOwner); end; // ##### Деструктор ##### destructor TF_ResourceReport.Destroy; begin inherited; end; procedure TF_ResourceReport.FormCreate(Sender: TObject); var StrToAdd: String; i: Integer; TreeCollection: TTreeCollectionClass; tmp: TTreeColumn; RepParams: TReportItemParams; PrevIconCount: Integer; tmpKbmMemTable: TkbmMemTable; procedure AddParamsToReportList(AItemName: String; AParams: TReportItemParams; AIsOn: Boolean = true); var Node: TFlyNode; begin Node := tvReports.Items.Add(nil, AItemName); Node.ImageIndex := 0; Node.SelectedIndex := Node.ImageIndex; Node.Data := AParams; if AIsOn then Node.Cells[rciIsOn] := bsTrue else Node.Cells[rciIsOn] := bsFalse; if AParams.CanHaveTemplate = biFalse then begin AParams.FSimpleShablons.FMessgShablonNoExists := ''; AParams.FStampShablons.FMessgShablonNoExists := ''; end else if (AParams.CanHaveStamp <> biTrue) then AParams.FStampShablons.FMessgShablonNoExists := ''; AddSortFieldsToReportItemParams(AParams); end; {procedure AddListItem(AItemName: String; AItemMode: TResourceReportFormMode; ARepType: Integer; ACanHaveActiveComponents: Integer; ACanHaveZeroPriceComponents: Integer = biFalse; ACanHavePageSize: Integer = biFalse; ACanHaveFormMode: Integer = biFalse; ACanHaveDismountAccount: Integer = biFalse; ACanStamp: Integer = biTrue; AFullPathInCableJournal: Integer = biFalse); var ListItem: TListItem; ptrReportItemParams: TReportItemParams; Node: TFlyNode; StrMode: string; StrRepType: string; begin //ListItem := lvReports.Items.Add; //ListItem.Caption := AItemName; //ListItem.ImageIndex := 21; //GetMem(ptrReportItemParams, SizeOf(TReportItemParams)); ptrReportItemParams := TReportItemParams.Create(AItemMode, ARepType); ptrReportItemParams.Mode := AItemMode; ptrReportItemParams.RepType := ARepType; ptrReportItemParams.CanHaveActiveComponents := ACanHaveActiveComponents; ptrReportItemParams.CanHaveZeroPriceComponents := ACanHaveZeroPriceComponents; ptrReportItemParams.CanHaveFormMode := ACanHaveFormMode; ptrReportItemParams.CanHavePageSize := ACanHavePageSize; ptrReportItemParams.CanHaveDismountAccount := ACanHaveDismountAccount; ptrReportItemParams.CanHaveStamp := ACanStamp; ptrReportItemParams.FullPathInCableJournal := AFullPathInCableJournal; StrMode := ''; StrRepType := ''; case AItemMode of fmUnsign: StrMode := 'fmUnsign'; fmRObject: StrMode := 'fmRObject'; fmRResources: StrMode := 'fmRResources'; fmRNorms: StrMode := 'fmRNorms'; fmRCable: StrMode := 'fmRCable'; fmRCableExceedLength: StrMode := 'fmRCableExceedLength'; fmRCableCanal: StrMode := 'fmRCableCanal'; fmRDisparityComponColor: StrMode := 'fmRDisparityComponColor'; fmRDisparityComponProducer: StrMode := 'fmRDisparityComponProducer'; fmRCableJournal: StrMode := 'fmRCableJournal'; fmRCableJournalExt: StrMode := 'fmRCableJournalExt'; fmRLegendObjectIcons: StrMode := 'fmRLegendObjectIcons'; fmRTypeComponents: StrMode := 'fmRTypeComponents'; fmRSpecification: StrMode := 'fmRSpecification'; fmRGOSTSpecification: StrMode := 'fmRGOSTSpecification'; fmRGOSTSpecificationA3: StrMode := 'fmRGOSTSpecificationA3'; fmRExplanatoryReport: StrMode := 'fmRExplanatoryReport'; end; case ARepType of rtResources: StrRepType := 'rtResources'; rtCable: StrRepType := 'rtCable'; rtCableCanal: StrRepType := 'rtCableCanal'; rtCableJournal: StrRepType := 'rtCableJournal'; rtCableJournalExt: StrRepType := 'rtCableJournalExt'; rtSpecification: StrRepType := 'rtSpecification'; rtGOSTSpecification: StrRepType := 'rtGOSTSpecification'; rtNorms: StrRepType := 'rtNorms'; rtExplanatoryReport: StrRepType := 'rtExplanatoryReport'; rtLegendObjectIcons: StrRepType := 'rtLegendObjectIcons'; end; GLog.Add('RepParams := TReportItemParams.Create('+StrMode+', '+StrRepType+');'); //GLog.Add('RepParams.Mode := '+IntToStr(Ord(AItemMode))+';'); //GLog.Add('RepParams.RepType := '+IntToStr(ARepType)+';'); if ACanHaveActiveComponents = biTrue then GLog.Add('RepParams.CanHaveActiveComponents := '+IntToStr(ACanHaveActiveComponents)+';'); if ACanHaveZeroPriceComponents = biTrue then GLog.Add('RepParams.CanHaveZeroPriceComponents := '+IntToStr(ACanHaveZeroPriceComponents)+';'); if ACanHaveFormMode = biTrue then GLog.Add('RepParams.CanHaveFormMode := '+IntToStr(ACanHaveFormMode)+';'); if ACanHavePageSize = biTrue then GLog.Add('RepParams.CanHavePageSize := '+IntToStr(ACanHavePageSize)+';'); if ACanHaveDismountAccount = biTrue then GLog.Add('RepParams.CanHaveDismountAccount := '+IntToStr(ACanHaveDismountAccount)+';'); if ACanStamp = biTrue then GLog.Add('RepParams.CanHaveStamp := '+IntToStr(ACanStamp)+';'); if AFullPathInCableJournal = biTrue then GLog.Add('RepParams.FullPathInCableJournal := '+IntToStr(AFullPathInCableJournal)+';'); GLog.Add('AddParamsToReportList('+AItemName+', RepParams);'); GLog.Add(''); //ListItem.Data := ptrReportItemParams; AddParamsToReportList(AItemName, ptrReportItemParams); //25.09.2007 //Node := tvReports.Items.Add(nil, AItemName); //Node.ImageIndex := 21; //Node.SelectedIndex := Node.ImageIndex; //Node.Data := ptrReportItemParams; //Node.Cells[rciIsOn] := bsTrue; end;} begin CreateControls; // Tolik 31/03/2020 -- ReportPagesVisibilityList := nil; // Tolik 09/02/2018 isCompCable := False; // //*** tvReports tvReports.Items.Clear; tvReports.Columns.Clear; //*** Колонка Вкл TreeCollection := tvReports.Columns.Add(cResourceReport_Msg22_1, 'TTreeColumn'); //*** Колонка Вид отчета TreeCollection := tvReports.Columns.Add(cResourceReport_Msg22_2, 'TTreeColumn'); //*** Колонка Шаблон TreeCollection := tvReports.Columns.Add(cResourceReport_Msg22_3, 'TTreeColumn'); //*** Колонка Шаблон со штампом TreeCollection := tvReports.Columns.Add(cResourceReport_Msg22_4, 'TTreeColumn'); tvReports.StructureCol := rciName; //tvReports.Columns[tciSimple].EditorStyle.Sections.Add; //tvReports.Columns[tciStamp].EditorStyle.Sections.Add; tvReports.Columns[rciIsOn].EditorStyle.AutoComplete := true; tvReports.Columns[rciIsOn].EditorStyle.EditorType := tetCheckBox; tvReports.Columns[rciIsOn].EditorStyle.Ctl3d := true; tvReports.Columns[rciIsOn].Width := 30; //tvReports.Columns[rciIsOn].EditorStyle.Sections // Tolik tvReports.Columns[rciIsOn].Caption := ''; CheckAllReports.Left := 8; CheckAllReports.Top := 2; CheckAllReports.Hint := cexdAll; CheckAllReports.ShowHint := True; CheckAllReports.Parent := tvReports; CheckAllReports.Refresh; // tvReports.Columns[rciName].AutoFit := true; tvReports.Columns[rciName].EditorStyle.AutoComplete := true; tvReports.Columns[rciName].EditorStyle.AutoDropDown := true; tvReports.Columns[rciName].ReadOnly := true; tvReports.Columns[rciName].Width := 210; tvReports.Columns[rciSimple].EditorStyle.AutoComplete := true; tvReports.Columns[rciSimple].Width := 100; tvReports.Columns[rciStamp].EditorStyle.AutoComplete := true; tvReports.Columns[rciStamp].Width := 50; tvReports.Columns[rciSimple].EditorStyle.EditorType := tetDropDownList; tvReports.Columns[rciStamp].EditorStyle.EditorType := tetDropDownList; tvReports.Columns[rciSimple].EditorStyle.ButtonType := tbtDropDown; tvReports.Columns[rciStamp].EditorStyle.ButtonType := tbtDropDown; tvReports.Columns[rciSimple].EditorStyle.DropdownStyles := tvReports.Columns[rciSimple].EditorStyle.DropdownStyles+[ddsSized]; tvReports.Columns[rciStamp].EditorStyle.DropdownStyles := tvReports.Columns[rciStamp].EditorStyle.DropdownStyles+[ddsSized]; tvReports.ToolTips := true; tvReports.ToolTipPause := 3000; tvReports.StatesDrawed := false; //*** tvReportTarget tvReportTarget.Items.Clear; tvReportTarget.Columns.Clear; //*** Печать листа TreeCollection := tvReportTarget.Columns.Add(cResourceReport_Msg23_1, 'TTreeColumn'); //*** Печать отчета TreeCollection := tvReportTarget.Columns.Add(cResourceReport_Msg23_2, 'TTreeColumn'); //*** Наименование объекта TreeCollection := tvReportTarget.Columns.Add(cResourceReport_Msg23_3, 'TTreeColumn'); tvReportTarget.StructureCol := 2; tvReportTarget.Columns[0].EditorStyle.Ctl3d := true; tvReportTarget.Columns[0].EditorStyle.EditorType := tetCheckBox; //tvReportTarget.Columns[0].Prompt := 'Teeeeest'; tvReportTarget.Columns[0].Width := 20; tvReportTarget.Columns[1].EditorStyle.Ctl3d := true; tvReportTarget.Columns[1].EditorStyle.EditorType := tetCheckBox; tvReportTarget.Columns[1].Width := 20; tvReportTarget.Columns[2].ReadOnly := true; tvReportTarget.Columns[2].Width := 200; tvReportTarget.Images.Clear; tvReportTarget.Images.AddImages(TF_Main(GForm).DM.ImageList_Dir); // настраиваем иконки свертывания-развертывания PrevIconCount := tvReportTarget.Images.Count; tvReportTarget.Images.AddImages(TF_Main(GForm).DM.ImageList_FlyTree); tvReportTarget.ButtonCollapsedIndex := tbiCollapsed + PrevIconCount; tvReportTarget.ButtonExpandedIndex := tbiExpanded + PrevIconCount; tvReportTarget.DefaultRowHeight := 17; //tvReportTarget.Options := tvReportTarget.Options + [goRowSelect, goAlwaysShowEditor]; tvReportTarget.FitColumnToClientWidth := true; tvReportTarget.ShowButtons := false; tvReportTarget.StatesDrawed := false; FcbCanHaveActiveComponentsCurr := nil; FcbCanHaveDismountAccountCurr := nil; { AddListItem(cResourceReport_Msg1_1, fmRExplanatoryReport, rtExplanatoryReport, biFalse); AddListItem(cResourceReport_Msg1_2, fmRSpecification, rtSpecification, biTrue, biTrue, biFalse, biFalse, biTrue, biFalse); AddListItem(cResourceReport_Msg1_3, fmRGOSTSpecification, rtGOSTSpecification, biTrue, biFalse, biTrue, biFalse, biTrue, biFalse); AddListItem(cResourceReport_Msg1_4, fmRCableJournal, rtCableJournal, biTrue, biFalse, biFalse, biFalse, biTrue); //AddListItem(cResourceReport_Msg1_5_1, fmRCableJournalExt, rtCableJournalExt, biTrue, biFalse, biFalse, biFalse, biTrue); //AddListItem(cResourceReport_Msg1_5_2, fmRCableJournalExt, rtCableJournalExt, biTrue, biFalse, biFalse, biFalse, biTrue, biTrue, biTrue); AddListItem(cResourceReport_Msg1_5_1, fmRCableJournalExt, rtCableJournalExt, biTrue, biFalse, biFalse, biFalse, biTrue, biTrue, biTrue); AddListItem(cResourceReport_Msg1_6, fmRResources, rtResources, biTrue, biTrue, biFalse, biTrue, biTrue); AddListItem(cResourceReport_Msg1_7, fmRNorms, rtNorms, biTrue); AddListItem(cResourceReport_Msg1_8, fmRCable, rtCable, biTrue, biFalse, biFalse, biFalse, biTrue); //AddListItem('Ведомость кабелей с превышающей длиной', fmRCableExceedLength); AddListItem(cResourceReport_Msg1_9, fmRCableCanal, rtCableCanal, biTrue, biFalse, biFalse, biFalse, biTrue); AddListItem(cResourceReport_Msg1_10, fmRLegendObjectIcons, rtLegendObjectIcons, biTrue); //AddListItem('Ведомость соединений по несоответствующим цветам', fmRDisparityComponColor); //AddListItem('Ведомость соединений по несоответствующим производителям', fmRDisparityComponProducer); } //Tolik 07/09/2023 -- //*** Подключенные/свободные порты шкафа -- RepParams := TReportItemParams.Create(fmPortReport, rtPortReport, rkPortReport); RepParams.CanHaveStamp := biFalse; AddParamsToReportList(cResourceReport_Msg1_30, RepParams); // //*** Пояснительная записка RepParams := TReportItemParams.Create(fmRExplanatoryReport, rtExplanatoryReport, rkProject); RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_1, RepParams); //*** Спецификация RepParams := TReportItemParams.Create(fmRSpecification, rtSpecification, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveZeroPriceComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; RepParams.CanResources := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; RepParams.GroupMode := gmComponType; AddParamsToReportList(cResourceReport_Msg1_2, RepParams); //*** Спецификация (ГОСТ 21.110-95) RepParams := TReportItemParams.Create(fmRGOSTSpecification, rtGOSTSpecification, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveZeroPriceComponents := biTrue; RepParams.CanHavePageSize := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; RepParams.CanResources := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; RepParams.GroupMode := gmComponType; AddParamsToReportList(cResourceReport_Msg1_3, RepParams); //*** Кабельный журнал RepParams := TReportItemParams.Create(fmRCableJournal, rtCableJournal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveStamp := biTrue; RepParams.FullPathInCableJournal := biTrue; // Tolik 09/11/2020 -- //RepParams.CanHaveSupplyValue := biTrue; //RepParams.CanRoundValue := biTrue; // AddParamsToReportList(cResourceReport_Msg1_4, RepParams); //*** Кабельный журнал ГОСТ RepParams := TReportItemParams.Create(fmRGOSTCableJournal, rtGOSTCableJournal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanShowOldReportForm := biFalse; RepParams.FullPathInCableJournal := biTrue; //RepParams.CanHaveStamp := biTrue; //RepParams.FullPathInCableJournal := biTrue; AddParamsToReportList(cResourceReport_Msg1_11, RepParams); //*** Расширенный кабельный журнал RepParams := TReportItemParams.Create(fmRCableJournalExt, rtCableJournalExt, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveStamp := biTrue; RepParams.FullPathInCableJournal := biTrue; AddParamsToReportList(cResourceReport_Msg1_5_1, RepParams); //*** Кроссовый журнал RepParams := TReportItemParams.Create(fmRCrossJournal, rtCrossJournal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; AddParamsToReportList(cResourceReport_Msg1_21, RepParams); //*** Кроссовый журнал (ГОСТ 21.110-95) RepParams := TReportItemParams.Create(fmRGOSTCrossJournal, rtGOSTCrossJournal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; AddParamsToReportList(cResourceReport_Msg1_22, RepParams); //*** Ведомость ресурсов RepParams := TReportItemParams.Create(fmRResources, rtResources, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveZeroPriceComponents := biTrue; RepParams.CanHaveFormMode := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveStamp := biTrue; RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; AddParamsToReportList(cResourceReport_Msg1_6, RepParams); //*** Ведомость сметных норм/расценок RepParams := TReportItemParams.Create(fmRNorms, rtNorms, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_7, RepParams); //*** Ведомость кабелей RepParams := TReportItemParams.Create(fmRCable, rtCable, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveStamp := biTrue; RepParams.CanAsPlacingInProj := biTrue; // Tolik 09/11/2020 -- //RepParams.CanHaveSupplyValue := biTrue; //RepParams.CanRoundValue := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; // AddParamsToReportList(cResourceReport_Msg1_8, RepParams); //*** Ведомость кабельных каналов RepParams := TReportItemParams.Create(fmRCableCanal, rtCableCanal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_9, RepParams); //*** Легенда условных обозначений RepParams := TReportItemParams.Create(fmRLegendObjectIcons, rtLegendObjectIcons, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_10, RepParams); //*** Экспликация кабинетов RepParams := TReportItemParams.Create(fmRExplicationRoom, rtExplicationRoom, rkProject); RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_19, RepParams); //*** Экспликация компонентов RepParams := TReportItemParams.Create(fmRExplicationComponent, rtExplicationComponent, rkProject); {RepParams.CanHaveStamp := biTrue; RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanAsPlacingInProj := biTrue; RepParams.CanGroupByCompType := biTrue; } // Changed by Tolik RepParams.CanHaveStamp := biTrue; RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanAsPlacingInProj := biTrue; RepParams.CanGroupByCompType := biTrue; RepParams.CanHaveZeroPriceComponents := biTrue; //RepParams.CanHaveFormMode := biTrue; RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; RepParams.CanShowKabinet := biTrue; RepParams.CanShowObjHierarchy := biTrue; RepParams.CanGroupByName := biTrue; //RepParams.ShowHeightOfPlacing := biTrue; // Tolik -- 06/03/2018 -- RepParams.GroupByHeightOfPlacing := biTrue; // Tolik -- 06/03/2018 -- AddParamsToReportList(cResourceReport_Msg1_20, RepParams); // Спецификация на компоненты RepParams := TReportItemParams.Create(fmCompoSpecification, rtCompoSpecification, rkProject); RepParams.CanHaveStamp := biFalse; RepParams.CanHaveTemplate := biFalse; RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; AddParamsToReportList(cResourceReport_Msg1_25, RepParams, false); // Дом с подъездом RepParams := TReportItemParams.Create(fmRHouse, rtHouse, rkProject); RepParams.CanHaveStamp := biTrue; RepParams.CanAsPlacingInProj := biTrue; AddParamsToReportList(cResourceReport_Msg1_24, RepParams, true); // Дефектный акт RepParams := TReportItemParams.Create(fmRDefectAct, rtDefectAct, rkProject); RepParams.CanHaveStamp := biTrue; AddParamsToReportList(cResourceReport_Msg1_23, RepParams, false); // счет-фактура RepParams := TReportItemParams.Create(fmCommerceInvoice, rtCommerceInvoice, rkProject); RepParams.CanHaveActiveComponents := biTrue; //added by Tolik RepParams.CanShowResources := biTrue; RepParams.CanShowWorks := biTrue; //Tolik 04/07/2022 RepParams.CanHaveZeroPriceComponents := biTrue; // RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; // RepParams.CanHaveFormMode := biTrue; // RepParams.CanHaveStamp := biTrue; //Tolik 21/02/2018 -- RepParams.CanHaveSupplyValue := biTrue; RepParams.CanRoundValue := biTrue; // // RepParams.CanPricePrecision := biTrue; // RepParams.CanKolvoPrecision := biTrue; //RepParams.CanHaveZeroPriceComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; //RepParams.CanRoundValue := biTrue; AddParamsToReportList(cResourceReport_Msg1_26, RepParams, true); //*** Предварительная оценка стоимости проекта RepParams := TReportItemParams.Create(fmRPriorCostOfProject, rtPriorCostOfProject, rkCalc); AddParamsToReportList(cResourceReport_Msg1_12, RepParams); //*** Полный путь кабеля RepParams := TReportItemParams.Create(fmRCablePaths, rtCablePaths, rkCablePath); //Tolik; RepParams.PageToShow := 0; AddParamsToReportList(cResourceReport_Msg1_27, RepParams); //added by Tolik // Координаты рабочих мест RepParams := TReportItemParams.Create(fmWACoordinates, rtWACoordinates, rkWaCoordinates); AddParamsToReportList(cResourceReport_Msg1_29, RepParams); //*** Кроссовое подключение RepParams := TReportItemParams.Create(fmRCrossConnection, rtCrossConnection, rkCrossConnection); AddParamsToReportList(cResourceReport_Msg1_28, RepParams); //-------- Маркировочные листы -------------- // Телекомуникационная комната RepParams := TReportItemParams.Create(fmRMarkRoomTS, rtMarkRoomTS, rkMarkPages); AddParamsToReportList(cResourceReport_Msg1_13, RepParams); // Патч-панели RepParams := TReportItemParams.Create(fmRMarkPathPanel, rtMarkPathPanel, rkMarkPages); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; AddParamsToReportList(cResourceReport_Msg1_14, RepParams); // Порты патч-панелей RepParams := TReportItemParams.Create(fmRMarkPathPanelPorts, rtMarkPathPanelPorts, rkMarkPages); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; AddParamsToReportList(cResourceReport_Msg1_15, RepParams); // Розетки RepParams := TReportItemParams.Create(fmRMarkSocket, rtMarkSocket, rkMarkPages); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanFloorNppWithRoom := biTrue; RepParams.CanCabinetParams := biTrue; AddParamsToReportList(cResourceReport_Msg1_16, RepParams); // Идентификаторы телекомуникационных комнат для лицевых панелей разеток RepParams := TReportItemParams.Create(fmRMarkSocketPanel, rtMarkSocketPanel, rkMarkPages); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanCabinetParams := biTrue; AddParamsToReportList(cResourceReport_Msg1_17, RepParams); // Кабели RepParams := TReportItemParams.Create(fmRMarkCable, rtMarkCable, rkMarkPages); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := biTrue; RepParams.CanInTwoCopies := biTrue; RepParams.CanCabinetParams := biTrue; AddParamsToReportList(cResourceReport_Msg1_18, RepParams); //lvReports.Selected := lvReports.Items[0]; //RichEdit_Report.SelAttributes.Name := 'Courier'; //RichEdit_Report.Font.Name := 'Courier';//'Times New Roman'; {MemTable_RCable.Active := false; MemTable_RCable.FieldDefs.Clear; MemTable_RCable.FieldDefs.Add('ID', ftInteger); //*** ID лин. компоненты MemTable_RCable.FieldDefs.Add('Name', ftString, 255); MemTable_RCable.FieldDefs.Add('Name_Begin', ftString, 255); //*** Начало соединения MemTable_RCable.FieldDefs.Add('Name_End', ftString, 255); //*** Конец соединения MemTable_RCable.FieldDefs.Add('Length', ftFloat); //*** Длина MemTable_RCable.FieldDefs.Add('Max_Length', ftFloat); //*** Длина MemTable_RCable.FieldDefs.Add('Price', ftFloat); //*** Цена MemTable_RCable.FieldDefs.Add('Cost', ftFloat); //*** Стоимость } {MemTable_RResources.Active := false; MemTable_RResources.FieldDefs.Clear; MemTable_RResources.FieldDefs.Add('ID', ftInteger); //*** ID лин. компоненты MemTable_RResources.FieldDefs.Add('Name', ftString, 255); MemTable_RResources.FieldDefs.Add('Kolvo', ftFloat); //*** Длина MemTable_RResources.FieldDefs.Add('Price', ftFloat); //*** Цена MemTable_RResources.FieldDefs.Add('Cost', ftFloat); //*** Стоимость } {MemTable_RDisparityCompColor.Active := false; MemTable_RDisparityCompColor.FieldDefs.Clear; MemTable_RDisparityCompColor.FieldDefs.Add('ID1', ftInteger); MemTable_RDisparityCompColor.FieldDefs.Add('Name1', ftString, 255); MemTable_RDisparityCompColor.FieldDefs.Add('Name_Object1', ftString, 255); MemTable_RDisparityCompColor.FieldDefs.Add('ID2', ftInteger); MemTable_RDisparityCompColor.FieldDefs.Add('Name2', ftString, 255); MemTable_RDisparityCompColor.FieldDefs.Add('Name_Object2', ftString, 255); MemTable_RDisparityCompColor.FieldDefs.Add('Name_Connect_Type', ftString, 255);} FormList := TObjectList.Create(false); FSavedOnAppMinimize := nil; FSavedOnAppRestore := nil; //*** Насыпать поля в таблици MemTable_RCableJournal.FieldDefs.Clear; MemTable_RCableJournal.FieldDefs.Add(fnID, ftAutoInc); MemTable_RCableJournal.FieldDefs.Add(fnNameList, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameCable, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnName, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameMark, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftInteger); //MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnComponentIndex, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnIZM, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnCategory, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnLength, ftFloat); MemTable_RCableJournal.FieldDefs.Add(fnNameFrom, ftString, 255); //MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameTo, ftString, 255); //MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeTo, ftString, 255); // added by tolik MemTable_RCableJournal.FieldDefs.Add(fnLengthReserv, ftFloat); // запас кабеля MemTable_RCableJournal.FieldDefs.Add(fnReelName,ftString,255); // наименование катушки из которой отрезан кабель MemTable_RCableJournalExt.FieldDefs.Clear; MemTable_RCableJournalExt.FieldDefs.Add('ID', ftAutoInc); MemTable_RCableJournalExt.FieldDefs.Add('NumCable', ftInteger); MemTable_RCableJournalExt.FieldDefs.Add('CableData', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('NameMark', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('IZM', ftString, 20); MemTable_RCableJournalExt.FieldDefs.Add('NumThread', ftInteger); MemTable_RCableJournalExt.FieldDefs.Add('From_Building', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add(fnFromDevice, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnFromDeviceSecond, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnFromDeviceThird, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnFromDeviceFourth, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add('From_Element', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('From_InterfName', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('From_NppPort', ftInteger); MemTable_RCableJournalExt.FieldDefs.Add('From_PortMark', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('From_WeldingCable', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('From_NumThread', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('To_Building', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add(fnToDevice, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnToDeviceSecond, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnToDeviceThird, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add(fnToDeviceFourth, ftString, 60); MemTable_RCableJournalExt.FieldDefs.Add('To_Element', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('To_InterfName', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('To_NppPort', ftInteger); MemTable_RCableJournalExt.FieldDefs.Add('To_PortMark', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('To_WeldingCable', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('To_NumThread', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('TraceCabling', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('Sign', ftString, 200); MemTable_RCableJournalExt.FieldDefs.Add('Kolvo', ftInteger); MemTable_RCableJournalExt.FieldDefs.Add('Diameter', ftFloat); MemTable_RCableJournalExt.FieldDefs.Add('Length', ftFloat); MemTable_RCableJournalExt.FieldDefs.Add('Note', ftString, 200); // added by Tolik MemTable_RCableJournalExt.FieldDefs.Add(fnMarks,ftMemo); // путь прохождения кабеля MemTable_RCableJournalExt.FieldDefs.Add(fnPrices,ftMemo); // длины кусков кабеля по маршруту (на название не смотрим, там не цена) {tmpKbmMemTable := MemTable_RCable; for i := 0 to tmpKbmMemTable.FieldDefs.Count - 1 do begin StrToAdd := tmpKbmMemTable.Name + '.FieldDefs.Add('''+tmpKbmMemTable.FieldDefs[i].Name+''''; case tmpKbmMemTable.FieldDefs[i].DataType of ftAutoInc: StrToAdd := StrToAdd +', ftAutoInc'; ftBoolean: StrToAdd := StrToAdd +', ftBoolean'; ftFloat: StrToAdd := StrToAdd +', ftFloat'; ftInteger: StrToAdd := StrToAdd +', ftInteger'; ftString: StrToAdd := StrToAdd +', ftString, '+IntToStr(tmpKbmMemTable.FieldDefs[i].Size); end; StrToAdd := StrToAdd + ');'; GLog.Add(StrToAdd); end;} mtExplanatoryProj.FieldDefs.Add(fnID, ftInteger); mtExplanatoryProj.FieldDefs.Add(fnMarkID, ftInteger); mtExplanatoryProj.FieldDefs.Add(fnName, ftString, 255); mtExplanatoryProj.FieldDefs.Add(fnCurrencyMName, ftString, 255); mtExplanatoryProj.FieldDefs.Add(fnCurrencySName, ftString, 255); mtExplanatoryProj.FieldDefs.Add(fnNDS, ftFloat); mtExplanatoryProj.FieldDefs.Add(fnCustomerName, ftString, 255); mtExplanatoryProj.FieldDefs.Add(fnContractorName, ftString, 255); mtExplanatoryProj.FieldDefs.Add(fnHeightThroughFloor, ftFloat); mtExplanatoryProj.FieldDefs.Add(fnIsVisible, ftBoolean); // added by Tolik mtExplanatoryProj.FieldDefs.Add(fnMaterialsCost, ftFloat); // стоимость материалов mtExplanatoryProj.FieldDefs.Add(fnResourcesCost, ftFloat); // стоимостьресурсов mtExplanatoryProj.FieldDefs.Add(fnWorksCost, ftFloat); // стоимостьработ mtExplanatoryProj.FieldDefs.Add(fnTotalCOst, ftFloat); // общая стоимость проекта // //*** Лист //Вкладка общие mtExplanatoryList.FieldDefs.Add(fnID, ftInteger); mtExplanatoryList.FieldDefs.Add(fnProjectID, ftInteger); mtExplanatoryList.FieldDefs.Add(fnMarkID, ftInteger); mtExplanatoryList.FieldDefs.Add(fnName, ftString, 255); mtExplanatoryList.FieldDefs.Add(fnHeightRoom, ftFloat); //Высота этажа mtExplanatoryList.FieldDefs.Add(fnHeightCeiling, ftFloat); //Высота фальш потолка mtExplanatoryList.FieldDefs.Add(fnHeightSocket, ftFloat); //Высота размещ точ объектов mtExplanatoryList.FieldDefs.Add(fnHeightCorob, ftFloat); //Высота размещ трасс mtExplanatoryList.FieldDefs.Add(fnCableCanalFullnessKoef, ftFloat); //Коэффициент заполненности кабельных каналов mtExplanatoryList.FieldDefs.Add(fnLengthKoef, ftFloat); //Процент запаса длины кабеля mtExplanatoryList.FieldDefs.Add(fnPortReserv, ftFloat); //Резерв со стороны порта mtExplanatoryList.FieldDefs.Add(fnMultiportReserv, ftFloat); //Резерв со стороны мультипорта mtExplanatoryList.FieldDefs.Add(fnTwistedPairMaxLength, ftFloat); //Ограничение по максимальной длине (для витой пары) mtExplanatoryList.MasterSource := dsrcExplanatoryProj; mtExplanatoryList.DetailFields := fnProjectID; // added by Tolik mtExplanatoryList.FieldDefs.Add(fnMaterialsCost, ftFloat); // стоимость материалов mtExplanatoryList.FieldDefs.Add(fnResourcesCost, ftFloat); // стоимостьресурсов mtExplanatoryList.FieldDefs.Add(fnWorksCost, ftFloat); // стоимостьработ mtExplanatoryList.FieldDefs.Add(fnTotalCOst, ftFloat); // общая стоимость проекта // mtRLegendObjectIcons.FieldDefs.Add(fnName, ftString, 255); mtRLegendObjectIcons.FieldDefs.Add(fnPicture, ftBlob); //added by Tolik for WA Coordinates Report //MemTable_WACoordinates.FieldDefs.Add(fnNameList, ftString, 255); // лист //MemTable_WACoordinates.FieldDefs.Add(fnName, ftstring, 255); // компонент //MemTable_WACoordinates.FieldDefs.Add('NameMark', ftstring, 255); // компонент //MemTable_WACoordinates.FieldDefs.Add(fnX, ftstring, 255); // координаты //MemTable_WACoordinates.FieldDefs.Add(fnY, ftstring, 255); //MemTable_WACoordinates.FieldDefs.Add(fnZ, ftstring, 255); FFrLocale := frLocale; DefineRepDesignLanguage; FFrPrintForm := nil; FPrintDevice := pdScreen; FUsefrDialog := true; //FfrOLEExcelExport := nil; { LengthKoef: Double; PortReserv: Double; MultiportReserv: Double; CableCanalFullnessKoef: Double; //*** % заполненности кабельного канала TwistedPairMaxLength: Double; CADBlockStep: Double; CADClickObjectType: TClickType; CADTraceColor: TColor; CADTraceStyle: TPenStyle; CADTraceWidth: Integer; CADShowObjectNotesType: TShowType; CADStampType: TStampType; CADShowRaise: Boolean; ShowObjectTypePM: TShowType; //*** отображать полное или краткое название в МП ShowObjectTypeCAD: TShowType; //*** отображать полное или краткое название на КАДе //ShowObjectMarking: Boolean; //*** Отображать маркировки объктов GroupListObjectsByType: Boolean; //*** Группировать объекты ControlJoinByNetType: Boolean; ControlComplectJoinByProducer: Boolean; ShowLineObjectLength: Boolean; // Отображать длину линейных объектов ShowLineObjectNote: Boolean; // Отображать подписи к линейным объектам ShowConnObjectNote: Boolean; // Отображать подписи к точечным объектам ShowLineObjectCaption: Boolean; // Отображать подписи к линейным объектам ShowConnObjectCaption: Boolean; PutCableInTrace: Boolean; // Ложить кабель на трассу NoteCountPrefix: string[1]; CADGridStep: Double; CADHeight: Double; CADPageOrient: TPageOrient; CADPageSizeIndex: Integer; CADWidth: Double; ListType: TListType; // Тип листа (обычный, отображение компоненты (Шкафа)) IDFigureForDesignList: Integer; // Связь с объектом, в котором находится Шкаф IDListForDesignList: Integer; // Связь с листом, в котором находится Шкаф //2006_02_10 ControlComplectByProperties: Boolean; ControlJoinByProperties: Boolean; //2006_05_10 CADStampLang: TStampLang; } //tvReports.Images := TF_Main(GForm).DM.ImageList_Tree; //tvReports.Images.Clear; //tvReports.Images.AddImages(TF_Main(GForm).DM.ImageList_Tree); // Tolik NetTypeGuidList := TStringList.Create; NetTypeGuidListSelected := TStringList.Create; //Tolik 17/02/2022 -- //AllNetTypes := False; AllNetTypes := True; // не сформируется ведомость ресурсов, если будет false // INeedNormsRecources := False; // InitRepMsgList; rbModeView.Checked := true; {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT)} cbShowCablePath.Checked := true; {$IFEND} cbCanHaveZeroPriceComponents.Checked := true; end; procedure TF_ResourceReport.FormDestroy(Sender: TObject); begin //ClearListViewObjects(lvReports); DeactiveDataSets(Self); Application.OnMinimize := FSavedOnAppMinimize; Application.OnRestore := FSavedOnAppRestore; if FFrPrintForm <> nil then FreeAndNil(FFrPrintForm); FormList.Free; //FFrLocale.Free; if FRepMsgList <> nil then begin FreeStringsObjects(FRepMsgList, true); FreeAndNil(FRepMsgList); end; //Tolik FreeAndNil(NetTypeGuidList); FreeAndNil(NetTypeGuidListSelected); end; procedure TF_ResourceReport.FormShow(Sender: TObject); begin if Not Assigned(FSavedOnAppRestore) then FSavedOnAppRestore := Application.OnRestore; if Not Assigned(FSavedOnAppMinimize) then FSavedOnAppMinimize := Application.OnMinimize; Application.OnRestore := ApplRestore; Application.OnMinimize := ApplMinimize; //Tolik -- Label5.Caption := cRepMsg271; // {GroupBox1.Visible := false; Panel_RCable.Visible := false; Panel_RResouces.Visible := false; Panel_RDisparityCompColor.Visible := false; } case GFormMode of fmRCable, fmRCableExceedLength, fmRCableCanal: begin case GFormMode of // added by Toik fmWaCoordinates : begin Caption := cResourceReport_Msg1_29; end; fmRCable: begin Caption := cResourceReport_Msg2_1; //GT_RCableNameBegin.Visible := true; //GT_RCableNameEnd.Visible := true; //GT_RCableMaxLength.Visible := true; end; fmRCableExceedLength: begin Caption := cResourceReport_Msg2_2; //GT_RCableNameBegin.Visible := true; //GT_RCableNameEnd.Visible := true; //GT_RCableMaxLength.Visible := true; end; fmRCableCanal: begin Caption := cResourceReport_Msg2_3; //GT_RCableNameBegin.Visible := false; //GT_RCableNameEnd.Visible := false; //GT_RCableMaxLength.Visible := false; end; end; //Panel_RCable.Visible := true; //GT_RCablePrice.Caption := 'Цена за 1м, ' + GCurrency.Name_Brief; //GT_RCableCost.Caption := 'Стоимость, ' + GCurrency.Name_Brief; end; fmRResources: begin Caption := cResourceReport_Msg2_4; //Panel_RResouces.Visible := true; //GT_RResourcesPrice.Caption := 'Цена за 1м, ' + GCurrency.Name_Brief; //GT_RResourcesCost.Caption := 'Стоимость, ' + GCurrency.Name_Brief; end; fmRDisparityComponColor, fmRDisparityComponProducer: begin case GFormMode of fmRDisparityComponColor: Caption := cResourceReport_Msg2_5; fmRDisparityComponProducer: Caption := cResourceReport_Msg2_6; end; //Panel_RDisparityCompColor.Visible := True; end; end; gbViewCloseResize(gbViewClose); //Tolik --12/08/2018 -- if cbGroupByHeightOfPlacing.Checked then begin cbCanShowKabinet.Checked := False; cbCanShowObjHierarchy.Enabled := True; end else if cbCanShowKabinet.Checked then cbGroupByHeightOfPlacing.Checked := False; // end; function TF_ResourceReport.DefineCurrRecNo: Integer; var RecNoDelta: Integer; begin FOldRecNo := FCurrRecNo; if frDBDataSet_Detail.DataSource <> nil then begin if frDBDataSet_Master.DataSource.DataSet.RecNo = FMasterOldRecNo then begin RecNoDelta := Abs(frDBDataSet_Detail.DataSource.DataSet.RecNo - FDetailOldRecNo); if RecNoDelta > 0 then begin FCurrRecNo := FCurrRecNo + 1; FDetailOldRecNo := frDBDataSet_Detail.DataSource.DataSet.RecNo; end; end; end; RecNoDelta := Abs(frDBDataSet_Master.DataSource.DataSet.RecNo - FMasterOldRecNo); if RecNoDelta > 0 then begin FCurrRecNo := FCurrRecNo + 1; FMasterOldRecNo := frDBDataSet_Master.DataSource.DataSet.RecNo; end; Result := FCurrRecNo; end; procedure TF_ResourceReport.DefineReportModeControls; var i: Integer; Node: TFlyNode; NodeObj: TObject; begin node := nil; tvReportTarget.Columns[tciCAD].Visible := rbModePacketPrint.Checked and Not(rkMarkPages in FReportUseKind); tvReportTarget.Columns[tciReport].Visible := (rbModePacketPrint.Checked or rbModePacketPrintToExcel.Checked); tvReports.Columns[rciIsOn].Visible := rbModePacketPrint.Checked or rbModePacketPrintToExcel.Checked; CheckAllReports.Visible := rbModePacketPrint.Checked or rbModePacketPrintToExcel.Checked; //tvReports.Columns[0].Visible //*** разрешить опции проекта //rbPageSizeA3.Enabled := Not rbModePacketPrint.Checked; //rbPageSizeA4.Checked := Not rbPageSizeA3.Enabled; gbReportMode.Visible := Not rbModePacketPrint.Checked; DefineReportNodeControls(tvReports.Selected, false); //*** Определить видимые ветви Node := tvReportTarget.Items[0]; // Tolik -- 30/09/2016 -- {while Node <> nil do begin NodeObj := TObject(Node.Data); if NodeObj <> nil then if NodeObj is TSCSList then Node.Hidden := (rbModePacketPrint.Checked = false) and (TSCSList(NodeObj).IsNormalType = false); Node := Node.GetNext; end;} while Node <> nil do begin try begin NodeObj := TObject(Node.Data); if NodeObj <> nil then if NodeObj is TSCSList then Node.Hidden := (rbModePacketPrint.Checked = false) and (TSCSList(NodeObj).IsNormalType = false); Node := Node.GetNext; end; except on E: Exception do begin Node := Nil; //ShowMessage(' tvReportTarget.Items.Count = ' + IntToStr(tvReportTarget.Items.Count)); end; end; end; // { for i := 0 to tvReportTarget.Items.Count - 1 do begin Node := tvReportTarget.Items[0]; NodeObj := TObject(Node.Data); if NodeObj <> nil then if NodeObj is TSCSList then Node.Hidden := (rbModePacketPrint.Checked = false) and (TSCSList(NodeObj).IsNormalType = false); end;} pnPacketExportType.Enabled := rbModePacketPrintToExcel.Checked; rbPackExportExcel.Enabled := pnPacketExportType.Enabled; rbPackExportExcel2007.Enabled := pnPacketExportType.Enabled; rbPackExportPdf.Enabled := pnPacketExportType.Enabled; rbPackExportWord2007.Enabled := pnPacketExportType.Enabled; if Not rbModePacketPrint.Checked then begin end else begin end; end; procedure TF_ResourceReport.DefineReportNodeControls(ARepNode: TFlyNode; AWithTemplateInfo: Boolean); var ReportItemParams: TReportItemParams; RepNode: TFlyNode; RepNodeParams: TReportItemParams; //StrNode: String; CanHaveTemplateBool: Boolean; CanHaveStampBool: Boolean; HaveUserTemplate: Boolean; HaveUserStampTemplate: Boolean; CanHaveActiveComponents: Integer; CanHaveDismountAccount: Integer; CanHaveZeroPriceComponents: Integer; CanHaveStamp: Integer; FullPathInCableJournal: Integer; CanHaveSupplyValue: Integer; CanRoundValue: Integer; CanAsPlacingInProj: Integer; CanGroupByCompType: Integer; CanFloorNppWithRoom: Integer; CanInTwoCopies: Integer; CanCabinetParams: Integer; CanResources: Integer; CanPricePrecision: Integer; CanKolvoPrecision: Integer; // Added by Tolik for ExplicationComponent Report CanShowKabinet: Integer; CanShowObjHierarchy : Integer; CanGroupByName : Integer; //ShowHeightOfPlacing: Integer; // 06/03/2018 -- GroupByHeightOfPlacing: Integer; // 06/03/2018 -- //Added by Tolik для счета-фактуры CanShowResources : Integer; CanShowWorks : Integer; // Added by Tolik for GOSTCableJournal CanShowCablePaths : Integer; CanShowOldReportForm: Integer; ////////////////////////////////////// PageToShow: Integer; GroupMode: Integer; IsPackageMode: Boolean; ExistsActiveTemplate: Boolean; ExistsActiveStampTemplate: Boolean; // Tolik i, CheckCounter: Integer; Node: TFlyNode; currReportItemParams: TReportItemParams; procedure LoadRepShablonsToColumn(AReportShablons: TReportShablons; AColNumber: Integer); var i: Integer; TemplateNode: TFlyNode; begin for i := 0 to AReportShablons.FRepShablons.Count - 1 do begin TemplateNode := tvReports.Columns[AColNumber].EditorStyle.Sections[0].Items.Add(nil, AReportShablons.FRepShablons[i]); TemplateNode.Data := Pointer(AReportShablons.FRepShablons.Objects[i]); end; end; procedure HandleOption(AOptionValue: Integer; ACheckBox: TObject); var SavedOnClick: TNotifyEvent; begin //24.04.2009 if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then if ACheckBox <> nil then begin SavedOnClick := TRzCheckBox(ACheckBox).OnClick; TRzCheckBox(ACheckBox).OnClick := nil; try if ACheckBox = cbcanShowObjHierarchy then cbCanShowObjHierarchy.Enabled:=((cbCanShowKabinet.Enabled) and (cbCanShowKabinet.Checked)) else begin if ACheckBox = cbAsPlacingInProj then cbAsPlacingInProj.Enabled := not cbCanShowKabinet.Checked else TRzCheckBox(ACheckBox).Enabled := AOptionValue = biTrue; if ACheckBox = cbReportWithStamp then begin {if cbShowCablePath.Visible then begin //cbShowCablePath.Enabled := not cbReportWithStamp.Checked; cbReportWithStamp.enabled := not cbShowCablePath.checked; end;} if RZGroupBox3.Visible then begin if AOptionValue = biTrue then begin cbShowCablePath.Enabled := not cbReportWithStamp.Checked; if cbShowCablePath.Enabled and cbShowCablePath.Checked then cbReportWithStamp.Enabled := false; end; end; end; { if ACheckBox = cbReportWithStamp then begin cbReportWithStamp.Enabled := not cbCanShowKabinet.Checked and not cbCanGroupByName.Checked; if cbCanShowKabinet.Checked then cbReportWithStamp.Checked := false; if cbCanGroupByName.Checked then cbReportWithStamp.Checked := false; end } end; //TRzCheckBox(ACheckBox).Checked := AOptionValue = biTrue; //TRzCheckBox(ACheckBox).Enabled := AOptionValue <> biNone; finally TRzCheckBox(ACheckBox).OnClick := SavedOnClick; end; end; end; begin ReportItemParams := nil; if ARepNode <> nil then begin ReportItemParams := TReportItemParams(ARepNode.Data); end; if ARepNode = nil then ClearTVReportTemplates; {StrNode := cResourceReport_Msg9; if NewNode <> nil then StrNode := StrNode +' '+IntToStr(NewNode.Index); TemplateNode := tvReports.Columns[tciSimple].EditorStyle.Sections[0].Items.Add(nil, StrNode); TemplateNode := tvReports.Columns[tciSimple].EditorStyle.Sections[0].Items.Add(nil, StrNode); TemplateNode.Data := Pointer(10); //*** Шаблон со штампом TemplateNode := tvReports.Columns[tciStamp].EditorStyle.Sections[0].Items.Add(nil, cResourceReport_Msg9); TemplateNode.Data := Pointer(10); } CanHaveTemplateBool := true; CanHaveStampBool := false; HaveUserTemplate := false; HaveUserStampTemplate := false; ExistsActiveTemplate := false; ExistsActiveStampTemplate := false; CanCabinetParams := biFalse; GroupMode := biNone; if ReportItemParams <> nil then begin //added by Tolik if ReportItemParams.RepType = rtMarkPathPanelPorts then SortPanel.Visible := true else SortPanel.Visible := false; if ReportItemParams.RepType = rtPortReport then PortsReportPanel.Visible := true else PortsReportPanel.Visible := false; // added by Tolik if ReportItemParams.RepType = rtExplicationComponent then RzGroupBox2.Visible := true else RzGroupBox2.Visible := false; if ReportItemParams.RepType = rtCommerceInvoice then gbResources.Visible := true else gbResources.Visible := false; if (ReportItemParams.RepType = rtCableJournal) or ( ReportItemParams.RepType = rtCableJournalExt) then begin RzGroupBox3.Enabled := true; RzGroupBox3.Visible := true; cbShowCablePath.Enabled := not cbReportWithStamp.Checked; // cbReportWithStamp.Enabled := not cbShowCablePath.Checked; if cbShowCablePath.Enabled and cbShowCablePath.Checked then cbReportWithStamp.Enabled := false; end else RzGroupBox3.Visible := false; if ReportItemParams.RepType = rtGOSTCableJournal then begin RzGroupBox3.Enabled := false; RzGroupBox3.Visible := false; cbOldReportForm.Visible := true; cbOldReportForm.Enabled := true; end else cbOldReportForm.Visible := false; // Tolik 28/10/2020 -- показать тип разрезки кабеля и для счет-фактуры, чтобы правильно посчитать { if (((ReportItemParams.RepType = rtCommerceInvoice) or (ReportItemParams.RepType = rtSpecification) or (ReportItemParams.RepType = rtGOSTSpecification) or (ReportItemParams.RepType = rtResources) or (ReportItemParams.RepType = rtCableJournal) or (ReportItemParams.RepType = rtCable)) and (cbCanHaveSupplyValue.Checked = True)) then rgCableRate.Visible := true } if ((ReportItemParams.RepType = rtCommerceInvoice) or (ReportItemParams.RepType = rtSpecification) or (ReportItemParams.RepType = rtGOSTSpecification) or (ReportItemParams.RepType = rtResources) or (ReportItemParams.RepType = rtCableJournal) or (ReportItemParams.RepType = rtCable)) then rgCableRate.Visible := true else //if ((ReportItemParams.RepType = rtCableJournal) or (ReportItemParams.RepType = rtCable)) then {if ((ReportItemParams.RepType = rtCableJournal) or (ReportItemParams.RepType = rtCable)) then // rgCableRate.Visible := true else} rgCableRate.Visible := false; // if AWithTemplateInfo then begin ClearTVReportTemplates; //*** Насыпать шаблоны простых отчетов в дерево LoadRepShablonsToColumn(ReportItemParams.FSimpleShablons, rciSimple); //*** Насыпать шаблоны отчетов со штампами в дерево LoadRepShablonsToColumn(ReportItemParams.FStampShablons, rciStamp); DefineReportNodeActiveShablonText(ARepNode); end; //*** Определить активные параметры отчета CanHaveActiveComponents := biFalse; CanHaveDismountAccount := biFalse; CanHaveZeroPriceComponents := biFalse; CanHaveStamp := biFalse; FullPathInCableJournal := biFalse; CanHaveSupplyValue := biFalse; CanRoundValue := biFalse; CanAsPlacingInProj := biFalse; CanGroupByCompType := biFalse; CanResources := biFalse; CanPricePrecision := biFalse; CanKolvoPrecision := biFalse; CanShowKabinet := biFalse; CanShowObjHierarchy := biFalse; CanGroupByName := biFalse; //ShowHeightOfPlacing := biFalse; // 06/03/2018 - - GroupByHeightOfPlacing := biFalse; // 06/03/2018 -- //Added by Tolik для счета-фактуры CanShowResources :=biFalse; CanShowWorks := biFalse; CanShowCablePaths := biTrue; CanShowOldReportForm := biFalse; PageToShow := 0; // CanFloorNppWithRoom := biFalse; CanInTwoCopies := biFalse; IsPackageMode := rbModePacketPrint.Checked or rbModePacketPrintToExcel.Checked; if Not IsPackageMode then begin CanHaveActiveComponents := ReportItemParams.CanHaveActiveComponents; CanHaveDismountAccount := ReportItemParams.CanHaveDismountAccount; CanHaveZeroPriceComponents := ReportItemParams.CanHaveZeroPriceComponents; CanHaveStamp := ReportItemParams.CanHaveStamp; FullPathInCableJournal := ReportItemParams.FullPathInCableJournal; CanHaveSupplyValue := ReportItemParams.CanHaveSupplyValue; CanRoundValue := ReportItemParams.CanRoundValue; CanAsPlacingInProj := ReportItemParams.CanAsPlacingInProj; CanGroupByCompType := ReportItemParams.CanGroupByCompType; CanResources := ReportItemParams.CanResources; CanFloorNppWithRoom := ReportItemParams.CanFloorNppWithRoom; CanInTwoCopies := ReportItemParams.CanInTwoCopies; CanCabinetParams := ReportItemParams.CanCabinetParams; CanPricePrecision := ReportItemParams.CanPricePrecision; CanKolvoPrecision := ReportItemParams.CanKolvoPrecision; // added by Tolik for ExplicationComponent Report CanShowKabinet := ReportItemParams.CanShowKabinet; CanShowObjHierarchy := ReportItemParams.CanShowObjHierarchy; CanGroupByName := ReportItemParams.CanGroupByName; //ShowHeightOfPlacing := ReportItemParams.ShowHeightOfPlacing; // 06/03/2018 -- GroupByHeightOfPlacing := ReportItemParams.GroupByHeightOfPlacing; // 06/03/2018 -- ////////////////////////// //Added by Tolik для счета-фактуры CanShowResources := ReportItemParams.CanShowResources; CanShowWorks := ReportItemParams.CanShowWorks; // PageToshow := ReportItemParams.PageToShow; GroupMode := ReportItemParams.GroupMode; end else begin RepNode := tvReports.Items[0]; while RepNode <> nil do begin if Not RepNode.Hidden then if RepNode.Cells[rciIsOn] = bsTrue then begin RepNodeParams := TReportItemParams(RepNode.Data); if RepNodeParams.CanHaveActiveComponents = biTrue then CanHaveActiveComponents := biTrue; // Added by Tolik if RepNodeParams.CanShowKabinet = biTrue then CanShowKabinet := biTrue; if RepNodeParams.CanShowObjHierarchy = biTrue then if (cbCanShowObjHierarchy.Checked and cbCanShowObjHierarchy.Enabled) then CanShowObjHierarchy := biTrue else CanShowObjHierarchy := biFalse; if RepNodeParams.CanGroupByName = biTrue then CanGroupByName := biTrue; if RepNodeParams.CanShowResources = biTrue then CanShowResources := biTrue; if RepNodeParams.CanShowWorks = biTrue then CanShowWorks := biTrue; {if RepNodeParams.ShowHeightOfPlacing = biTrue then ShowHeightOfPlacing := biTrue;} if RepNodeParams.GroupByHeightOfPlacing = biTrue then GroupByHeightOfPlacing := biTrue; /////////////////////////////////////////////// if RepNodeParams.CanHaveDismountAccount = biTrue then CanHaveDismountAccount := biTrue; if RepNodeParams.CanHaveZeroPriceComponents = biTrue then CanHaveZeroPriceComponents := biTrue; if RepNodeParams.CanHaveStamp = biTrue then begin if RzGroupBox3.Visible then begin if cbShowCablePath.Checked then CanHaveStamp := biFalse else CanHaveStamp := biTrue end else CanHaveStamp := biTrue end; if RepNodeParams.FullPathInCableJournal = biTrue then FullPathInCableJournal := biTrue; if RepNodeParams.CanHaveSupplyValue = biTrue then CanHaveSupplyValue := biTrue; if RepNodeParams.CanRoundValue = biTrue then CanRoundValue := biTrue; if RepNodeParams.CanAsPlacingInProj = biTrue then CanAsPlacingInProj := biTrue; if RepNodeParams.CanGroupByCompType = biTrue then CanGroupByCompType := biTrue; if RepNodeParams.CanResources = biTrue then CanResources := biTrue; if RepNodeParams.CanFloorNppWithRoom = biTrue then CanFloorNppWithRoom := biTrue; if RepNodeParams.CanInTwoCopies = biTrue then CanInTwoCopies := biTrue; if RepNodeParams.CanCabinetParams = biTrue then CanCabinetParams := biTrue; if RepNodeParams.CanPricePrecision = biTrue then CanPricePrecision := biTrue; if RepNodeParams.CanKolvoPrecision = biTrue then CanKolvoPrecision := biTrue; if RepNodeParams.GroupMode <> biNone then GroupMode := ReportItemParams.GroupMode; end; RepNode := RepNode.GetNext; end; end; HandleOption(CanHaveActiveComponents, FcbCanHaveActiveComponentsCurr); HandleOption(CanHaveDismountAccount, FcbCanHaveDismountAccountCurr); HandleOption(CanHaveZeroPriceComponents, cbCanHaveZeroPriceComponents); HandleOption(CanHaveStamp, cbReportWithStamp); HandleOption(FullPathInCableJournal, cbFullPathInCableJournal); HandleOption(CanHaveSupplyValue, cbCanHaveSupplyValue); HandleOption(CanRoundValue, cbCanRoundValue); HandleOption(CanAsPlacingInProj, cbAsPlacingInProj); HandleOption(CanGroupByCompType, cbGroupByCompType); HandleOption(CanResources, cbCanResources); // added by Tolik for ExplicationComponent Report HandleOption(CanShowKabinet, cbCanShowKabinet); HandleOption(CanShowObjHierarchy,cbCanShowObjHierarchy); HandleOption(CanGroupByName,cbCanGroupByName); HandleOption(GroupByHeightOfPlacing, cbGroupByHeightOfPlacing); ///////// //Added by Tolik для счета-фактуры HandleOption(CanShowResources,cbCanShowResources); HandleOption(CanShowWorks,cbCanShowWorks); // HandleOption(CanFloorNppWithRoom, cbFloorNppWithRoom); HandleOption(CanInTwoCopies, cbInTwoCopies); gbReportMode.Enabled := (ReportItemParams.CanHaveFormMode = biTrue) and rbModeView.Checked; //gbPageSize.Enabled := (ReportItemParams.CanHavePageSize = biTrue) and (Not IsPackageMode); gbPageSize.Enabled := (ReportItemParams.CanHavePageSize = biTrue) and rbModeView.Checked; gbValues.Enabled := (Not rbModeView.Checked) or (ReportItemParams.CanHaveFormMode = biFalse) or rbRepModeDocument.Checked; gbGroupType.Enabled := GroupMode <> biNone; CanHaveStampBool := CanHaveStamp = biTrue; CanHaveTemplateBool := ReportItemParams.CanHaveTemplate = biTrue; HaveUserTemplate := ReportItemParams.FSimpleShablons.FActiveShablonID > 0; HaveUserStampTemplate := ReportItemParams.FStampShablons.FActiveShablonID > 0; ExistsActiveTemplate := ReportItemParams.FSimpleShablons.FActiveShablonID <> -1; ExistsActiveStampTemplate := ReportItemParams.FStampShablons.FActiveShablonID <> -1; {HandleOption(ReportItemParams.CanHaveActiveComponents, cbCanHaveActiveComponents); HandleOption(ReportItemParams.CanHaveDismountAccount, cbCanHaveDismountAccount); HandleOption(ReportItemParams.CanHaveZeroPriceComponents, cbCanHaveZeroPriceComponents); HandleOption(ReportItemParams.CanHaveStamp, cbReportWithStamp); HandleOption(ReportItemParams.FullPathInCableJournal, cbFullPathInCableJournal); gbReportMode.Enabled := ReportItemParams.CanHaveFormMode = biTrue; gbPageSize.Enabled := ReportItemParams.CanHavePageSize = biTrue; CanHaveStampBool := ReportItemParams.CanHaveStamp = biTrue; HaveUserTemplate := ReportItemParams.FSimpleShablons.FActiveShablonID <> 0; HaveUserStampTemplate := ReportItemParams.FStampShablons.FActiveShablonID <> 0;} end else begin HandleOption(biNone, FcbCanHaveActiveComponentsCurr); HandleOption(biNone, FcbCanHaveDismountAccountCurr); HandleOption(biNone, cbCanHaveZeroPriceComponents); HandleOption(biNone, cbReportWithStamp); HandleOption(biNone, cbFullPathInCableJournal); HandleOption(biNone, cbCanHaveSupplyValue); HandleOption(biNone, cbCanRoundValue); HandleOption(biNone, cbAsPlacingInProj); HandleOption(biNone, cbGroupByCompType); HandleOption(biNone, cbCanResources); HandleOption(biNone, cbFloorNppWithRoom); HandleOption(biNone, cbInTwoCopies); HandleOption(biNone, cbCanShowKabinet); //HandleOption(biNone, cbShowHeightOfPlacing); HandleOption(biNone, cbGroupByHeightOfPlacing); HandleOption(biNone, cbCanshowObjHierarchy); HandleOption(biNone, cbCanGroupByName); HandleOption(biNone, cbCanShowResources); HandleOption(biNone, cbCanShowWorks); gbReportMode.Enabled := false; gbPageSize.Enabled := false; gbGroupType.Enabled := false; //rbGroupByComponType.Checked := GroupMode = gmComponType; //rbGroupByGroupName.Checked := GroupMode = gmGroupName; end; // Свойства Отображение кабинетов gbNoCabinetNameShort.Enabled := CanCabinetParams = biTrue; lbNoCabinet.Enabled := CanCabinetParams = biTrue; edNoCabinet.Enabled := CanCabinetParams = biTrue; nePricePrecision.Enabled := CanPricePrecision = biTrue; neKolvoPrecision.Enabled := CanKolvoPrecision = biTrue; //*** Шаблон со штампом tvReports.Columns[rciSimple].ReadOnly := Not ExistsActiveTemplate; tvReports.Columns[rciStamp].ReadOnly := (CanHaveStampBool = False) or Not ExistsActiveStampTemplate; Act_NewSimpleTemplateFromStandart.Enabled := CanHaveTemplateBool; //true; Act_NewSimpleTemplateFromUser.Enabled := HaveUserTemplate; Act_NewStampTemplateFromStandart.Enabled := CanHaveStampBool; Act_NewStampTemplateFromUser.Enabled := CanHaveStampBool and HaveUserStampTemplate; Act_NewMarkPageFromUser.Enabled := ExistsActiveTemplate; Act_ExportSimpleTemplateToFile.Enabled := HaveUserTemplate; Act_ExportStampTemplateToFile.Enabled := HaveUserStampTemplate; Act_EditSimpleTemplate.Enabled := HaveUserTemplate; Act_EditStampTemplate.Enabled := HaveUserStampTemplate; Act_DeleteSimpleTemplate.Enabled := HaveUserTemplate; Act_DeleteStampTemplate.Enabled := HaveUserStampTemplate; btExportTemplateToFile.Enabled := ExistsActiveTemplate or Not (rkMarkPages in FReportUseKind); Act_ImportTemplateFromFile.Enabled := CanHaveTemplateBool; btEditTemplate.Enabled := ExistsActiveTemplate or Not (rkMarkPages in FReportUseKind); btDelTemplate.Enabled := ExistsActiveTemplate or Not (rkMarkPages in FReportUseKind); Act_ExportTemplateToFile.Enabled := btExportTemplateToFile.Enabled; Act_EditTemplate.Enabled := btEditTemplate.Enabled; Act_DeleteTemplate.Enabled := btDelTemplate.Enabled; Act_EditReportSortInfo.Enabled := (ReportItemParams <> nil) and (ReportItemParams.FReportSortInfo.FAllFieldNames.Count > 0); Act_ExportToBc3.Visible := (ReportItemParams <> nil) and (ReportItemParams.Mode = fmCommerceInvoice); end; procedure TF_ResourceReport.DefineReportNodeActiveShablonText(ARepNode: TFlyNode); var ReportItemParams: TReportItemParams; begin ReportItemParams := nil; if (ARepNode <> nil) and (ARepNode.Data <> nil) then ReportItemParams := ARepNode.Data; if ReportItemParams <> nil then begin ARepNode.Cells[rciSimple] := ReportItemParams.FSimpleShablons.GetActiveShablonName; ARepNode.Cells[rciStamp] := ReportItemParams.FStampShablons.GetActiveShablonName; end; end; procedure TF_ResourceReport.AddSortFieldsToReportItemParams(AReportItemParams: TReportItemParams); function GetCaptFrom(ACaptCode: String): String; var Res: Variant; begin Result := ''; ReportUserFunction('GETCAPT', ACaptCode, '', '', Res); if Res <> null then Result := Res; end; begin if AReportItemParams <> nil then case AReportItemParams.RepType of rtResources: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticulProducer, cRepMsg48); AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticulDistributor, cRepMsg49); AReportItemParams.FReportSortInfo.AddFieldInfo(fnProducerName, cRepMsg50); AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); AReportItemParams.FReportSortInfo.AddFieldInfo(fnKolvo, cRepMsg51); AReportItemParams.FReportSortInfo.AddFieldInfo(fnPrice, cRepMsg30); AReportItemParams.FReportSortInfo.AddFieldInfo(fnCost, cRepMsg31); end; rtCable: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg163); AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameBeginFull, cRepMsg38); //CONNECTBEGINSH AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameEndFull, cRepMsg39); //CONNECTENDSH AReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg154); //LENGTH AReportItemParams.FReportSortInfo.AddFieldInfo(fnLengthReserv, cRepMsg155); //RESERVE AReportItemParams.FReportSortInfo.AddFieldInfo(fnPrice, cRepMsg30); //PRICE AReportItemParams.FReportSortInfo.AddFieldInfo(fnCost, cRepMsg31); //COST end; rtCableCanal: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg163); AReportItemParams.FReportSortInfo.AddFieldInfo(fnFilling, cRepMsg27); //FULLNESSPERC AReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg154); //LENGTH AReportItemParams.FReportSortInfo.AddFieldInfo(fnLengthReserv, cRepMsg155); //RESERVE AReportItemParams.FReportSortInfo.AddFieldInfo(fnPrice, cRepMsg30); //PRICE AReportItemParams.FReportSortInfo.AddFieldInfo(fnCost, cRepMsg31); //COST end; rtCableJournal: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameList, cRepMsg83); //ROOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameCable, cRepMsg84); //CABLE AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg163); AReportItemParams.FReportSortInfo.AddFieldInfo(fnCategory, cRepMsg85); //CATEGORY AReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg154); //LENGTH AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg86+'.'+cRepMsg88); //FROM WORKPLACE AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameFrom, cRepMsg86+'.'+cRepMsg89); //FROM PORT AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortTypeFrom, cRepMsg86+'.'+cRepMsg90); //FROM TYPE AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg87+'.'+cRepMsg88); //TO WORKPLACE AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameTo, cRepMsg87+'.'+cRepMsg89); //TO PORT AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortTypeTo, cRepMsg87+'.'+cRepMsg90); //TO TYPE end; rtCableJournalExt: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnNumCable, cRepMsg58); //NUMCABLE AReportItemParams.FReportSortInfo.AddFieldInfo(fnCableData, cRepMsg59); //CABLEDATA AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnFromBuilding, cRepMsg61+'.'+cRepMsg63); //GOFROM BUILDING AReportItemParams.FReportSortInfo.AddFieldInfo(fnFromDevice+';'+fnFromDeviceSecond+';'+fnFromDeviceThird+';'+fnFromDeviceFourth, cRepMsg61+'.'+cRepMsg64); //GOFROM DEVICE_RACK AReportItemParams.FReportSortInfo.AddFieldInfo(fnFromElement, cRepMsg61+'.'+cRepMsg65); //GOFROM ELEMENT_PANEL AReportItemParams.FReportSortInfo.AddFieldInfo(fnToBuilding, cRepMsg62+'.'+cRepMsg63); //GOWHERE BUILDING AReportItemParams.FReportSortInfo.AddFieldInfo(fnToDevice+';'+fnToDeviceSecond+';'+fnToDeviceThird+';'+fnToDeviceFourth, cRepMsg62+'.'+cRepMsg64); //GOWHERE DEVICE_RACK AReportItemParams.FReportSortInfo.AddFieldInfo(fnToElement, cRepMsg62+'.'+cRepMsg65); //GOWHERE ELEMENT_PANEL AReportItemParams.FReportSortInfo.AddFieldInfo(fnTraceCabling, cRepMsg70); //CABLINGTRACE AReportItemParams.FReportSortInfo.AddFieldInfo(fnSign, cRepMsg07); //INDICATION AReportItemParams.FReportSortInfo.AddFieldInfo(fnKolvo, cRepMsg51); //QUANTITY AReportItemParams.FReportSortInfo.AddFieldInfo(fnDiameter, cRepMsg156); //CABLEDIAMETER AReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg157+' '+cRepMsg158); //CABLELEN BUILDING_S AReportItemParams.FReportSortInfo.AddFieldInfo(fnNote, cRepMsg74); //NOTE end; rtSpecification: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameShort, cRepMsg07); //INDICATION AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticulProducer, cRepMsg48); //PRODMARKNUMSH AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticulDistributor, cRepMsg49); //DISTRIBMARKNUMSH AReportItemParams.FReportSortInfo.AddFieldInfo(fnProducerName, cRepMsg94); //VENDOR AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnKolvo, cRepMsg51); //QUANTITY AReportItemParams.FReportSortInfo.AddFieldInfo(fnPrice, cRepMsg30); //PRICEWITHVAT AReportItemParams.FReportSortInfo.AddFieldInfo(fnCost, cRepMsg31); //COSTWITHVAT end; rtGOSTSpecification: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameShort, cRepMsg103); //DOCTYPEMARKINDICAT AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticulProducer, cRepMsg104); // CODEOFEQUIPMMATERIAL AReportItemParams.FReportSortInfo.AddFieldInfo(fnProducerName, cRepMsg105); //FACTORYPRODUCER AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg106); //UNITOFMEASURE AReportItemParams.FReportSortInfo.AddFieldInfo(fnKolvo, cRepMsg51); //QUANTITY AReportItemParams.FReportSortInfo.AddFieldInfo(fnNotice, cRepMsg74); //NOTE end; rtNorms: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnCypher, cRepMsg45); //CODE AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnIzm, cRepMsg26); //UOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnExpense, cRepMsg46); //VOLUME end; rtExplanatoryReport: begin end; rtLegendObjectIcons: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME end; rtGOSTCableJournal: begin // Tolik { AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameMark, cRepMsg58); //AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg58); //NUMCABLE //AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg58); //NUMCABLE AReportItemParams.FReportSortInfo.AddFieldInfo(fnComponentIndex, cResourceReport_Msg42); // индекс кабеля AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameCable, cRepMsg77); //CABLETYPE AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg78); //NUMSWITCHBOARD AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameTo, cRepMsg79); //NUMSWITCHBOARDPORT AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameList, cRepMsg80); //COMESFROM AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg81); //NUMOUTLETORSWITCHBOARD AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameFrom, cRepMsg82); //NUMOUTLETORSWITCHBOARDPORT } AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg247); AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg250); AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg251); AReportItemParams.FReportSortInfo.AddFieldInfo(fnTraceCabling, cRepMsg249); AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameMark, cRepMsg256); AReportItemParams.FReportSortInfo.AddFieldInfo(fnTotalKolvo, cRepMsg255); AReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg154); end; rtPriorCostOfProject: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnArticul, cRepMsg161); //ARTICUL AReportItemParams.FReportSortInfo.AddFieldInfo(fnKolvo, cRepMsg51); //QUANTITY AReportItemParams.FReportSortInfo.AddFieldInfo(fnPrice, cRepMsg30); //PRICE AReportItemParams.FReportSortInfo.AddFieldInfo(fnCost, cRepMsg31); //COST end; rtCommerceInvoice: begin end; rtMarkRoomTS: RzGroupBox2.Visible:=false; rtMarkPathPanel: RzGroupBox2.Visible:=false; rtMarkPathPanelPorts: RzGroupBox2.Visible:=false; rtMarkSocket: RzGroupBox2.Visible:=false; rtMarkSocketPanel: RzGroupBox2.Visible:=false; rtMarkCable: RzGroupBox2.Visible:=false; rtExplicationRoom: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnRoomNum, cRepMsg128); //ROOMNUM AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameShort, cRepMsg07); //INDICATION AReportItemParams.FReportSortInfo.AddFieldInfo(fnAppointmentRoom, cRepMsg129); //APPOINTMENTROOM AReportItemParams.FReportSortInfo.AddFieldInfo(fnSquareInside, cRepMsg130); //SQUAREINSIDE AReportItemParams.FReportSortInfo.AddFieldInfo(fnHeightRoom, cRepMsg138); //HEIGHT end; rtExplicationComponent: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnFloor, cRepMsg126); //FLOOR AReportItemParams.FReportSortInfo.AddFieldInfo(fnRoomNum, cRepMsg128); //ROOMNUM AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg141); //COMPONNUM AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); //NAME AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameMark, cRepMsg142); //NAMEMARK end; rtCrossJournal, rtGOSTCrossJournal: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameList+';'+fnRoomNum, cRepMsg80); //COMESFROM //05.02.2011 AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg81); //NUMOUTLETORSWITCHBOARD AReportItemParams.FReportSortInfo.AddFieldInfo(fnNumFrom, cRepMsg81); //NUMOUTLETORSWITCHBOARD //05.02.2011 AReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg78); //NUMSWITCHBOARD AReportItemParams.FReportSortInfo.AddFieldInfo(fnNumTo, cRepMsg78); //NUMSWITCHBOARD AReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameTo, cRepMsg79); //NUMSWITCHBOARDPORT AReportItemParams.FReportSortInfo.AddFieldInfo(fnCableNameShort, cRepMsg77); //CABLETYPE //05.02.2011 AReportItemParams.FReportSortInfo.AddFieldInfo(fnCableNameMark, cRepMsg58); //NUMCABLE AReportItemParams.FReportSortInfo.AddFieldInfo(fnCableNum, cRepMsg58); //05.02.2011 NUMCABLE end; rtHouse: begin AReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg06); AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg141); AReportItemParams.FReportSortInfo.AddFieldInfo(fnBoxInstalled, cRepMsg186); AReportItemParams.FReportSortInfo.AddFieldInfo(fnPresencePower200WFromNetwork, cRepMsg187); AReportItemParams.FReportSortInfo.AddFieldInfo(fnCableSetToBox, cRepMsg188); AReportItemParams.FReportSortInfo.AddFieldInfo(fnFiberOpticWelded, cRepMsg189); AReportItemParams.FReportSortInfo.AddFieldInfo(fnEquipmentInstalled, cRepMsg190); end; rtDefectAct: begin end; end; end; procedure TF_ResourceReport.CorrectReport(AResourceReportFormMode: TResourceReportFormMode); var i, j: Integer; FrPage: TfrPage; FrObject: TObject; FrView: TfrView; //FrMemoView: TfrMemoView; //frBandView: TfrBandView; FracDelimetrCode: Integer; begin for i := 0 to Report.Pages.Count - 1 do begin FrPage := Report.Pages[i]; for j := 0 to FrPage.Objects.Count - 1 do begin FrObject := TObject(FrPage.Objects[j]); if FrObject is TFrView then begin FrView := TfrView(FrObject); case AResourceReportFormMode of fmRCableCanal: begin ReplaceTextInStringList('MemTable_RCableGroup', 'FmtCableChannelGrp', FrView.Memo, true); ReplaceTextInStringList('MemTable_RCableGroup', 'FmtCableChannelGrp', FrView.Script, true); ReplaceTextInStringList('MemTable_RCable', 'FmtCableChannel', FrView.Memo, true); ReplaceTextInStringList('MemTable_RCable', 'FmtCableChannel', FrView.Script, true); end; fmRGOSTCableJournal: begin ReplaceTextInStringList(fnMarkID, fnNameMark, FrView.Memo, true); ReplaceTextInStringList(fnMarkID, fnNameMark, FrView.Script, true); end; fmRCrossJournal, fmRGOSTCrossJournal: begin ReplaceTextInStringList('mtReport', 'FmtCrossJournal', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtCrossJournal', FrView.Script, true); end; fmRExplicationRoom: begin ReplaceTextInStringList('mtReport', 'FmtExplicationRoom', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtExplicationRoom', FrView.Script, true); ReplaceTextInStringList('mtReportDetail', 'FmtExplicationRoomDetail', FrView.Memo, true); ReplaceTextInStringList('mtReportDetail', 'FmtExplicationRoomDetail', FrView.Script, true); end; fmRExplicationComponent: begin ReplaceTextInStringList('mtReport', 'FmtExplicationCompon', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtExplicationCompon', FrView.Script, true); ReplaceTextInStringList('mtReportDetail', 'FmtExplicationComponDetail', FrView.Memo, true); ReplaceTextInStringList('mtReportDetail', 'FmtExplicationComponDetail', FrView.Script, true); ReplaceTextInStringList('mtReportSubDetail', 'FmtExplicationComponSubDetail', FrView.Memo, true); ReplaceTextInStringList('mtReportSubDetail', 'FmtExplicationComponSubDetail', FrView.Script, true); end; fmRMarkRoomTS: begin ReplaceTextInStringList('mtReport', 'FmtMarkRoomTS', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkRoomTS', FrView.Script, true); end; fmRMarkPathPanel: begin ReplaceTextInStringList('mtReport', 'FmtMarkPathPanel', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkPathPanel', FrView.Script, true); end; fmRMarkPathPanelPorts: begin ReplaceTextInStringList('mtReport', 'FmtMarkPathPanelPorts', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkPathPanelPorts', FrView.Script, true); end; fmRMarkSocket: begin ReplaceTextInStringList('mtReport', 'FmtMarkSocket', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkSocket', FrView.Script, true); end; fmRMarkSocketPanel: begin ReplaceTextInStringList('mtReport', 'FmtMarkSocketPanel', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkSocketPanel', FrView.Script, true); end; fmRMarkCable: begin ReplaceTextInStringList('mtReport', 'FmtMarkCable', FrView.Memo, true); ReplaceTextInStringList('mtReport', 'FmtMarkCable', FrView.Script, true); end; {fmCommerceInvoice: begin end;} end; end; end; end; end; procedure TF_ResourceReport.ClearTVReportTemplates; begin //*** Шаблон tvReports.Columns[rciSimple].EditorStyle.Sections[0].Items.Clear; //*** Шаблон со штампом tvReports.Columns[rciStamp].EditorStyle.Sections[0].Items.Clear; end; procedure TF_ResourceReport.CreateControls; begin try //Tolik 17/10/2023 -- подключение портов шкафа ... FmtPortReport := TkbmMemTable.create(self); FmtPortReport.Name := 'FmtPortReport'; FmtPortReportDetail := TkbmMemTable.Create(self); FmtPortReportDetail.Name :='FmtPortReportDetail'; FdsrcPortReport := TDataSource.Create(self); FdsrcPortReport.Name := 'FdsrcPortReport'; FdsrcPortReport.DataSet := FmtPortReport; FdsrcPortReportDetail := TDataSource.Create(self); FdsrcPortReportDetail.Name := 'FdsrcPortReportDetail'; FdsrcPortReportDetail.DataSet := FmtPortReportDetail; FmtPortReport.FieldDefs.Clear; FmtPortReport.FieldDefs.Add(fnID, ftAutoInc); FmtPortReport.FieldDefs.Add(fnName, ftString, 255); FmtPortReportDetail.FieldDefs.Clear; FmtPortReportDetail.FieldDefs.Add(fnID, ftAutoInc); FmtPortReportDetail.FieldDefs.Add(fnPortNameFrom, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnConnected, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnPortNameTo, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnIDMaster, ftInteger); // // Ведомость кабелей MemTable_RCable.FieldDefs.Clear; MemTable_RCable.FieldDefs.Add(fnID, ftInteger); MemTable_RCable.FieldDefs.Add(fnName, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameSimple, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameMark, ftString, 255); MemTable_RCable.FieldDefs.Add(fnMarkID, ftInteger); MemTable_RCable.FieldDefs.Add(fnIzm, ftString, 20); MemTable_RCable.FieldDefs.Add(fnNameBegin, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameBeginCompon, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameBeginFull, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameEnd, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameEndCompon, ftString, 255); MemTable_RCable.FieldDefs.Add(fnNameEndFull, ftString, 255); MemTable_RCable.FieldDefs.Add(fnFilling, ftFloat); MemTable_RCable.FieldDefs.Add(fnLength, ftFloat); MemTable_RCable.FieldDefs.Add(fnLengthReserv, ftFloat); MemTable_RCable.FieldDefs.Add(fnMaxLength, ftFloat); MemTable_RCable.FieldDefs.Add(fnPrice, ftFloat); MemTable_RCable.FieldDefs.Add(fnCost, ftFloat); MemTable_RCable.FieldDefs.Add(fnExceedLength, ftBoolean); MemTable_RCable.FieldDefs.Add(fnIDGroup, ftInteger); MemTable_RCable.FieldDefs.Add(fnReelName, ftString, 255); //24.09.2010 MemTable_RNorms.FieldDefs.Clear; MemTable_RNorms.FieldDefs.Add(fnCypher, ftString, 255); MemTable_RNorms.FieldDefs.Add(fnName, ftString, 255); MemTable_RNorms.FieldDefs.Add(fnExpense, ftFloat); // Объем/расход MemTable_RNorms.FieldDefs.Add(fnIzm, ftString, 255); MemTable_RNorms.FieldDefs.Add(fnPrice, ftFloat); // Цена MemTable_RNorms.FieldDefs.Add(fnTotalCost, ftFloat); // Стоимость //19.11.2013 MemTable_RNorms.FieldDefs.Add(fnLaborTime, ftString, 255); // Время выполнения работы (из НБ) MemTable_RNorms.FieldDefs.Add(fnPricePerTime, ftFloat); // Время выполнения работы (из НБ) MemTable_RNorms.FieldDefs.Add(fnTotalLaborTime, ftString, 255); // Время выполнения работы // Для каб каналов FmtCableChannelGrp := TkbmMemTable.Create(Self); FmtCableChannelGrp.Name := 'FmtCableChannelGrp'; //FmtCableChannelGrp.FieldDefs.Assign(MemTable_RCableGroup.FieldDefs); FmtCableChannelGrp.FieldDefs.Add(fnID, ftAutoInc); FmtCableChannelGrp.FieldDefs.Add(fnGUID, ftString, cnstGUIDLength); FmtCableChannelGrp.FieldDefs.Add(fnName, ftString, 255); FmtCableChannelGrp.FieldDefs.Add(fnLength, ftFloat); FmtCableChannelGrp.FieldDefs.Add(fnLengthReserv, ftFloat); FmtCableChannelGrp.FieldDefs.Add(fnCost, ftFloat); FmtCableChannel := TkbmMemTable.Create(Self); FmtCableChannel.Name := 'FmtCableChannel'; FmtCableChannel.FieldDefs.Assign(MemTable_RCable.FieldDefs); FdsrcCableChannelGrp := TDataSource.Create(Self); FdsrcCableChannelGrp.Name := 'FdsrcCableChannelGrp'; FdsrcCableChannelGrp.DataSet := FmtCableChannelGrp; FdsrcCableChannel := TDataSource.Create(Self); FdsrcCableChannel.Name := 'FdsrcCableChannel'; FdsrcCableChannel.DataSet := FmtCableChannel; // для Кроссового журнала FmtCrossJournal := TkbmMemTable.Create(Self); FmtCrossJournal.Name := 'FmtCrossJournal'; FdsrcCrossJournal := TDataSource.Create(Self); FdsrcCrossJournal.Name := 'FdsrcCrossJournal'; FdsrcCrossJournal.DataSet := FmtCrossJournal; // Экспликация кабинетов FmtExplicationRoom := TkbmMemTable.Create(Self); FmtExplicationRoom.Name := 'FmtExplicationRoom'; FdsrcExplicationRoom := TDataSource.Create(Self); FdsrcExplicationRoom.Name := 'FdsrcExplicationRoom'; FdsrcExplicationRoom.DataSet := FmtExplicationRoom; FmtExplicationRoomDetail := TkbmMemTable.Create(Self); FmtExplicationRoomDetail.Name := 'FmtExplicationRoomDetail'; FdsrcExplicationRoomDetail := TDataSource.Create(Self); FdsrcExplicationRoomDetail.Name := 'FdsrcExplicationRoomDetail'; FdsrcExplicationRoomDetail.DataSet := FmtExplicationRoomDetail; // Экспликация компонентов FmtExplicationCompon := TkbmMemTable.Create(Self); FmtExplicationCompon.Name := 'FmtExplicationCompon'; FdsrcExplicationCompon := TDataSource.Create(Self); FdsrcExplicationCompon.Name := 'FdsrcExplicationCompon'; FdsrcExplicationCompon.DataSet := FmtExplicationCompon; FmtExplicationComponDetail := TkbmMemTable.Create(Self); FmtExplicationComponDetail.Name := 'FmtExplicationComponDetail'; FdsrcExplicationComponDetail := TDataSource.Create(Self); FdsrcExplicationComponDetail.Name := 'FdsrcExplicationComponDetail'; FdsrcExplicationComponDetail.DataSet := FmtExplicationComponDetail; FmtExplicationComponSubDetail := TkbmMemTable.Create(Self); FmtExplicationComponSubDetail.Name := 'FmtExplicationComponSubDetail'; FdsrcExplicationComponSubDetail := TDataSource.Create(Self); FdsrcExplicationComponSubDetail.Name := 'FdsrcExplicationComponSubDetail'; FdsrcExplicationComponSubDetail.DataSet := FmtExplicationComponSubDetail; // Дом.подъезд FmtHouse := TkbmMemTable.Create(Self); FmtHouse.Name := 'FmtHouse'; FdsrcHouse := TDataSource.Create(Self); FdsrcHouse.Name := 'FdsrcHouse'; FdsrcHouse.DataSet := FmtHouse; FmtApproach := TkbmMemTable.Create(Self); FmtApproach.Name := 'FmtApproach'; FdsrcApproach := TDataSource.Create(Self); FdsrcApproach.Name := 'FdsrcApproach'; FdsrcApproach.DataSet := FmtApproach; FmtHouse.FieldDefs.Add(fnID, ftInteger); FmtHouse.FieldDefs.Add(fnName, ftString, 255); FmtHouse.FieldDefs.Add(fnMarkID, ftInteger); FmtHouse.FieldDefs.Add(fnCooperative, ftString, 255); FmtHouse.FieldDefs.Add(fnHEO, ftString, 255); FmtHouse.FieldDefs.Add(fnAgreed, ftInteger); FmtApproach.FieldDefs.Add(fnID, ftInteger); FmtApproach.FieldDefs.Add(fnIDComponent, ftInteger); FmtApproach.FieldDefs.Add(fnName, ftString, 255); FmtApproach.FieldDefs.Add(fnMarkID, ftInteger); FmtApproach.FieldDefs.Add(fnBoxInstalled, ftInteger); FmtApproach.FieldDefs.Add(fnPresencePower200WFromNetwork, ftInteger); FmtApproach.FieldDefs.Add(fnCableSetToBox, ftInteger); FmtApproach.FieldDefs.Add(fnFiberOpticWelded, ftInteger); FmtApproach.FieldDefs.Add(fnEquipmentInstalled, ftInteger); // Дефектный акт FmtDefectAct := TkbmMemTable.Create(Self); FmtDefectAct.Name := 'FmtDefectAct'; FdsrcDefectAct := TDataSource.Create(Self); FdsrcDefectAct.Name := 'FdsrcDefectAct'; FdsrcDefectAct.DataSet := FmtDefectAct; FmtDefectAct.FieldDefs.Add(fnName, ftString, 255); FmtDefectAct.FieldDefs.Add(fnFindDefectChecked, ftBoolean); FmtDefectAct.FieldDefs.Add(fnFindDefectAdress, ftMemo); FmtDefectAct.FieldDefs.Add(fnFindDefectDescription, ftMemo); FmtDefectAct.FieldDefs.Add(fnLinkTransportChecked, ftBoolean); FmtDefectAct.FieldDefs.Add(fnLinkTransportPointA, ftMemo); FmtDefectAct.FieldDefs.Add(fnLinkTransportPointB, ftMemo); FmtDefectAct.FieldDefs.Add(fnLinkTransportCable, ftFloat); FmtDefectAct.FieldDefs.Add(fnLinkTransportMaterials, ftMemo); FmtDefectAct.FieldDefs.Add(fnSetEquipmentChecked, ftBoolean); FmtDefectAct.FieldDefs.Add(fnSetEquipmentAddress, ftMemo); FmtDefectAct.FieldDefs.Add(fnSetEquipmentEqipm, ftMemo); FmtDefectAct.FieldDefs.Add(fnSetEquipmentMaterial, ftMemo); FmtDefectAct.FieldDefs.Add(fnMoveEquipmentChecked, ftBoolean); FmtDefectAct.FieldDefs.Add(fnMoveEquipmentPointA, ftMemo); FmtDefectAct.FieldDefs.Add(fnMoveEquipmentPointB, ftMemo); FmtDefectAct.FieldDefs.Add(fnMoveEquipmentEqipm, ftMemo); FmtDefectAct.FieldDefs.Add(fnMoveEquipmentMaterial, ftMemo); FmtDefectAct.FieldDefs.Add(fnContractorName, ftMemo); FmtDefectAct.FieldDefs.Add(fnDateGetting, ftDateTime); FmtDefectAct.FieldDefs.Add(fnDateExecution, ftDateTime); // Маркировочные листы FmtMarkRoomTS := TkbmMemTable.Create(Self); FmtMarkRoomTS.Name := 'FmtMarkRoomTS'; FdsrcMarkRoomTS := TDataSource.Create(Self); FdsrcMarkRoomTS.Name := 'FdsrcMarkRoomTS'; FdsrcMarkRoomTS.DataSet := FmtMarkRoomTS; FmtMarkPathPanel := TkbmMemTable.Create(Self); FmtMarkPathPanel.Name := 'FmtMarkPathPanel'; FdsrcMarkPathPanel := TDataSource.Create(Self); FdsrcMarkPathPanel.Name := 'FdsrcMarkPathPanel'; FdsrcMarkPathPanel.DataSet := FmtMarkPathPanel; FmtMarkPathPanelPorts := TkbmMemTable.Create(Self); FmtMarkPathPanelPorts.Name := 'FmtMarkPathPanelPorts'; FdsrcMarkPathPanelPorts := TDataSource.Create(Self); FdsrcMarkPathPanelPorts.Name := 'FdsrcMarkPathPanelPorts'; FdsrcMarkPathPanelPorts.DataSet := FmtMarkPathPanelPorts; FmtMarkSocket := TkbmMemTable.Create(Self); FmtMarkSocket.Name := 'FmtMarkSocket'; FdsrcMarkSocket := TDataSource.Create(Self); FdsrcMarkSocket.Name := 'FdsrcMarkSocket'; FdsrcMarkSocket.DataSet := FmtMarkSocket; FmtMarkSocketPanel := TkbmMemTable.Create(Self); FmtMarkSocketPanel.Name := 'FmtMarkSocketPanel'; FdsrcMarkSocketPanel := TDataSource.Create(Self); FdsrcMarkSocketPanel.Name := 'FdsrcMarkSocketPanel'; FdsrcMarkSocketPanel.DataSet := FmtMarkSocketPanel; FmtMarkCable := TkbmMemTable.Create(Self); FmtMarkCable.Name := 'FmtMarkCable'; FdsrcMarkCable := TDataSource.Create(Self); FdsrcMarkCable.Name := 'FdsrcMarkCable'; FdsrcMarkCable.DataSet := FmtMarkCable; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.CreateControls', E.Message); end; end; procedure TF_ResourceReport.DefineRepSortInfo; var RepSortInfoList: TObjectList; RepNode: TFlyNode; ReportItemParams: TReportItemParams; ReportSortInfo: TReportSortInfo; i, j: Integer; begin try RepSortInfoList := TF_Main(GForm).DM.GetReportSortInfoList; for i := 0 to tvReports.Items.Count - 1 do begin RepNode := tvReports.Items[i]; ReportItemParams := TReportItemParams(RepNode.Data); for j := 0 to RepSortInfoList.Count - 1 do begin ReportSortInfo := TReportSortInfo(RepSortInfoList[j]); if ReportSortInfo.RepKind = ReportItemParams.RepType then begin ReportItemParams.FReportSortInfo.Assign(ReportSortInfo); FreeAndNil(ReportSortInfo); RepSortInfoList[j] := nil; end; end; RepSortInfoList.Pack; end; RepSortInfoList.OwnsObjects := true; FreeAndNil(RepSortInfoList); except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.DefineRepSortInfo', E.Message); end; end; procedure TF_ResourceReport.DefineRepTemplates; var RepNode: TFlyNode; TemplateNode: TFlyNode; ReportItemParams: TReportItemParams; ActualReportShablons: TReportShablons; UserReportsInfo: TList; ptrUserReportInfo: PUserReportInfo; i, j: Integer; begin ClearTVReportTemplates; TemplateNode := tvReports.Columns[rciSimple].EditorStyle.Sections[0].Items.Add(nil, cResourceReport_Msg9); TemplateNode.Data := Pointer(10); //*** Шаблон со штампом TemplateNode := tvReports.Columns[rciStamp].EditorStyle.Sections[0].Items.Add(nil, cResourceReport_Msg9); TemplateNode.Data := Pointer(10); //*** Определить все шаблоны отчетов UserReportsInfo := TF_Main(GForm).DM.GetUserReportsInfo; //*** Определить активные шаблоны отчетов для отобрадения for i := 0 to tvReports.Items.Count - 1 do begin RepNode := tvReports.Items[i]; ReportItemParams := TReportItemParams(RepNode.Data); ReportItemParams.FSimpleShablons.ClearRepShablons; ReportItemParams.FStampShablons.ClearRepShablons; //Внести стандартные наблоны if (rkProject in FReportUseKind) or //24.02.2011 (rkCalc in FReportUseKind) IsSimpleReportKind(FReportUseKind) then begin if ReportItemParams.CanHaveTemplate = biTrue then begin ReportItemParams.FSimpleShablons.AddShablonToList(0, cResourceReport_Msg9, true); if ReportItemParams.CanHaveStamp = biTrue then ReportItemParams.FStampShablons.AddShablonToList(0, cResourceReport_Msg9, true); end; end; //*** Вкинуть все шаблоны в тек. отчет j := 0; while j <= UserReportsInfo.Count - 1 do begin ptrUserReportInfo := UserReportsInfo[j]; if ptrUserReportInfo.RepKind = ReportItemParams.RepType then begin //*** Определить тип шаблона - простой или со штампом ActualReportShablons := ReportItemParams.GetShablonsByTemplateType(ptrUserReportInfo.TemplateType); if ActualReportShablons <> nil then begin ActualReportShablons.AddShablonToList(ptrUserReportInfo.ID, ptrUserReportInfo.Name, ptrUserReportInfo.UseAsShablon = biTrue); FreeMem(ptrUserReportInfo); UserReportsInfo.Delete(j); end; end else Inc(j); end; // Если шаблон не определен (-1), а всписке еще есть, то определяем из списка ReportItemParams.FSimpleShablons.DefineActiveShablonIfNoDefined; ReportItemParams.FStampShablons.DefineActiveShablonIfNoDefined; DefineReportNodeActiveShablonText(RepNode); //RepNode.Cells[1] := ReportItemParams.FSimpleShablons.GetActiveShablonName; //RepNode.Cells[2] := ReportItemParams.FStampShablons.GetActiveShablonName; end; DefineReportNodeControls(tvReports.Selected, true); FreeList(UserReportsInfo); end; procedure TF_ResourceReport.DelReportTemplate(ARepNode: TFlyNode; ATemplateType: Integer); var ReportItemParams: TReportItemParams; ReportShablons: TReportShablons; TemplateName: String; begin TemplateName := ''; ReportItemParams := nil; ReportShablons := nil; if (ARepNode <> nil) and (ARepNode.Data <> nil) then ReportItemParams := ARepNode.Data; if ReportItemParams <> nil then begin ReportShablons := ReportItemParams.GetShablonsByTemplateType(ATemplateType); if (ReportShablons <> nil) and (ReportShablons.FActiveShablonID > 0) then begin TemplateName := ReportShablons.GetActiveShablonName; if MessageModal(cResourceReport_Msg16 + TemplateName+'?', ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin if tvReports.EditorMode then tvReports.EditorMode := false; //tvReports.UpdateControlState Refresh; //tvReports.Update; TF_Main(GForm).DM.DeleteRecordFromTableByID(tnUserReports, ReportShablons.FActiveShablonID, qmPhisical); ReportShablons.RemoveShablonNameByID(ReportShablons.FActiveShablonID); if ARepNode.Cells[rciIsOn] = bsTrue then if TReportItemParams(ARepNode.Data).FSimpleShablons.FActiveShablonID = -1 then ARepNode.Cells[rciIsOn] := bsFalse; DefineReportNodeControls(ARepNode, true); end; end; end; end; procedure TF_ResourceReport.ExportTemplateToFile(ATemplateType: Integer); var Node: TFlyNode; ReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; ReportFileName: String; ReportFilePath: String; IniPath: String; SaveDialog: TSaveDialog; IniFile: TIniFile; IniFileStream: TFileStream; FrfFileStream: TFileStream; ReportTemplateStream: TFileStream; // Tolik 24/06/2019 -- //RepTemplateSignature: string; RepTemplateSignature: AnsiString; // begin try Node := tvReports.Selected; if Node <> nil then ReportItemParams := TReportItemParams(Node.Data); if ReportItemParams <> nil then begin CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(ATemplateType); ReportFileName := GetReportFileNameByType(ReportItemParams.RepType, ATemplateType, false); if (ReportFileName <> '') and (CurrReportShablons <> nil) then begin SaveDialog := TSaveDialog.Create(Self); try SaveDialog.Title := cResourceReport_Msg32; SaveDialog.InitialDir := ExtractDirToReportTemplate(Node.Text); SaveDialog.DefaultExt := '*.'+enSrt; SaveDialog.FileName := FileNameCorrect(CurrReportShablons.GetActiveShablonName); SaveDialog.Filter := GetDialogFilter(exdSbk, enSrt); //ExtName+' ('+FullExtName+')|'+FullExtName; SaveDialog.Options := SaveDialog.Options - [ofNoChangeDir] + [ofOverwritePrompt]; if SaveDialog.Execute then begin //*** Определить имя файла пользовательского отчета ReportFilePath := GetPathToSCSTmpDir + '\' + ReportFileName; if FileExists(ReportFilePath) then if Not DeleteFile(ReportFilePath) then ReportFilePath := GetNoExistsFileNameForCopy(ReportFilePath); if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.SaveUserReportByIDToFile(CurrReportShablons.FActiveShablonID, ReportFilePath); if FileExists(ReportFilePath) then begin IniPath := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + '\' + fnRepTemplateTmp); IniFile := TIniFile.Create(IniPath); FrfFileStream := TFileStream.Create(ReportFilePath, fmOpenRead); IniFile.WriteInteger(seRepTemplate, idtRepType, ReportItemParams.RepType); IniFile.WriteInteger(seRepTemplate, idtReportUseKind, Ord(ReportItemParams.ReportUseKind)); IniFile.WriteString(seRepTemplate, idtName, CurrReportShablons.GetActiveShablonName); IniFile.WriteInteger(seRepTemplate, idtTemplateType, ATemplateType); IniFile.WriteBinaryStream(seRepTemplate, idtTemplate, FrfFileStream); FreeAndNil(FrfFileStream); FreeAndNil(IniFile); PakFile(IniPath); IniFileStream := TFileStream.Create(IniPath, fmOpenRead); ReportTemplateStream := TFileStream.Create(SaveDialog.FileName, fmCreate); //RepTemplateSignature := PChar(guidRepTemplateSignature); //ReportTemplateStream.WriteBuffer(RepTemplateSignature^, Length(guidRepTemplateSignature)); // Tolik 20/102/2019 -- //ReportTemplateStream.WriteBuffer(PChar(guidRepTemplateSignature)^, Length(guidRepTemplateSignature)); ReportTemplateStream.WriteBuffer(PAnsiChar(AnsiString(guidRepTemplateSignature))^, Length(guidRepTemplateSignature)); // ReportTemplateStream.CopyFrom(IniFileStream, 0); RepTemplateSignature := '111111111111111111111111111111111111111111111111111'; RepTemplateSignature := ''; SetLength(RepTemplateSignature, 32); ReportTemplateStream.Position := 0; ReportTemplateStream.ReadBuffer(RepTemplateSignature[1], Length(guidRepTemplateSignature)); FreeAndNil(ReportTemplateStream); FreeAndNil(IniFileStream); DeleteFile(ReportFilePath); DeleteFile(IniPath); end; end; finally FreeAndNil(SaveDialog); end; end; end; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ExportTemplateToFile', E.Message); end; end; function TF_ResourceReport.GetCurrReportItemParamValues: TReportItemParams; begin Result := TReportItemParams.Create(fmUnsign, -1, rkProject); if cbReportWithStamp.Enabled then Result.CanHaveStamp := BoolToInt(cbReportWithStamp.Checked); if FcbCanHaveActiveComponentsCurr.Enabled then Result.CanHaveActiveComponents := BoolToInt(FcbCanHaveActiveComponentsCurr.Checked); if FcbCanHaveDismountAccountCurr.Enabled then Result.CanHaveDismountAccount := BoolToInt(FcbCanHaveDismountAccountCurr.Checked); if cbCanHaveZeroPriceComponents.Enabled then Result.CanHaveZeroPriceComponents := BoolToInt(cbCanHaveZeroPriceComponents.Checked); if cbFullPathInCableJournal.Enabled then Result.FullPathInCableJournal := BoolToInt(cbFullPathInCableJournal.Checked); if cbCanRoundValue.Enabled then Result.CanRoundValue := BoolToInt(cbCanRoundValue.Checked); if cbCanHaveSupplyValue.Enabled then Result.CanHaveSupplyValue := BoolToInt(cbCanHaveSupplyValue.Checked); if gbPageSize.Enabled then begin if rbPageSizeA4.Checked then Result.CanHavePageSize := 0; if rbPageSizeA3.Checked then Result.CanHavePageSize := 1; end; if gbReportMode.Enabled then begin if rbRepModeDocument.Checked then Result.CanHaveFormMode := 0; if rbRepModeForm.Checked then Result.CanHaveFormMode := 1; end; if cbAsPlacingInProj.Enabled then Result.CanAsPlacingInProj := BoolToInt(cbAsPlacingInProj.Checked); if cbGroupByCompType.Enabled then Result.CanGroupByCompType := BoolToInt(cbGroupByCompType.Checked); if cbCanResources.Enabled then Result.CanResources := BoolToInt(cbCanResources.Checked); if cbFloorNppWithRoom.Enabled then Result.CanFloorNppWithRoom := BoolToInt(cbFloorNppWithRoom.Checked); if cbInTwoCopies.Enabled then Result.CanInTwoCopies := BoolToInt(cbInTwoCopies.Checked); if rbGroupByComponType.Checked then Result.GroupMode := gmComponType else if rbGroupByGroupName.Checked then Result.GroupMode := gmGroupName; // added by Tolik if (cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled) then Result.CanShowKabinet := BoolToInt(cbCanShowKabinet.Checked); if (cbCanShowObjHierarchy.Checked and cbCanShowObjHierarchy.Enabled) then Result.CanShowObjHierarchy := BoolToInt(cbCanShowObjHierarchy.Checked); if (cbCanGroupByName.Checked and cbCanGroupByName.Enabled) then Result.CanGroupByName := BoolToInt(cbCanGroupByName.Checked); if cbCanShowResources.Enabled then Result.CanShowResources := BoolToInt(cbCanShowResources.Checked); if cbCanShowWorks.Enabled then Result.CanShowWorks := BoolToInt(cbCanShowWorks.Checked); if (cbGroupByHeightOfPlacing.Checked and cbGroupByHeightOfPlacing.Enabled) then Result.GroupByHeightOfPlacing := BoolToInt(cbGroupByHeightOfPlacing.Checked) end; function TF_ResourceReport.GetReportFileNameByType(AReportType: Integer; ATemplateType: Integer; ACanA3: Boolean): String; begin Result := ''; case AReportType of rtResources: begin if ATemplateType = ttSimple then Result := Result + fnReportResources else if ATemplateType = ttStamp then Result := Result + fnRSTAMPResources; end; rtCable: begin if ATemplateType = ttSimple then Result := Result + fnReportCable else if ATemplateType = ttStamp then Result := Result + fnRSTAMPCable; end; rtCableCanal: begin if ATemplateType = ttSimple then Result := Result + fnReportCableCanal else if ATemplateType = ttStamp then Result := Result + fnRSTAMPCableCanal; end; rtCableJournal: begin if ATemplateType = ttSimple then Result := Result + fnRCableJournal else if ATemplateType = ttStamp then Result := Result + fnRSTAMPCableJournal; end; rtCableJournalExt: begin if ATemplateType = ttSimple then Result := Result + fnRCableJournalExt else if ATemplateType = ttStamp then Result := Result + fnRSTAMPCableJournalExt; end; rtCablePaths: begin Result := Result + fnRCablePaths; end; rtCrossConnection: Result := Result + fnRCrossConnection; rtGOSTCableJournal: begin Result := Result + fnRGOSTCableJournal; end; rtSpecification: Result := Result + fnRSpecification; rtGOSTSpecification: begin //Tolik 24/01/2020 {if ATemplateType = ttSimple then Result := Result + fnRGOSTSpecification else if (ATemplateType = ttA3) or ACanA3 then Result := Result + fnRGOSTSpecificationA3;} //if ATemplateType = ttSimple then if (ATemplateType = ttA3) or ACanA3 then Result := Result + fnRGOSTSpecificationA3 else Result := Result + fnRGOSTSpecification; // end; rtNorms: begin if ATemplateType = ttSimple then Result := Result + fnRNorms else if ATemplateType = ttStamp then Result := Result + fnRSTAMPNorms; end; rtExplanatoryReport: begin if ATemplateType = ttSimple then Result := Result + fnRExplanatoryReport else if ATemplateType = ttStamp then Result := Result + fnRSTAMPExplanatoryReport; end; rtExplicationRoom: begin if ATemplateType = ttSimple then Result := Result + fnRExplicationRoom else if ATemplateType = ttStamp then Result := Result + fnRSTAMPExplicationRoom; end; rtExplicationComponent: begin if ATemplateType = ttSimple then Result := Result + fnRExplicationComponent else if ATemplateType = ttStamp then Result := Result + fnRSTAMPExplicationComponent; end; rtCrossJournal: Result := Result + fnRCrossJournal; rtGOSTCrossJournal: begin Result := Result + fnRGOSTCrossJournal; end; rtLegendObjectIcons: begin if ATemplateType = ttSimple then Result := Result + fnRLegendObjectIcons else if ATemplateType = ttStamp then Result := Result + fnRSTAMPLegendObjectIcons; end; rtHouse: begin if ATemplateType = ttSimple then Result := Result + fnRHouse else if ATemplateType = ttStamp then Result := Result + fnRSTAMPHouse; end; rtDefectAct: begin if ATemplateType = ttSimple then Result := Result + fnRDefectAct else if ATemplateType = ttStamp then Result := Result + fnRSTAMPDefectAct; end; rtPriorCostOfProject: begin Result := Result + fnRPriorCostOfProject; end; rtCommerceInvoice: begin Result := Result + fnRCommerceInvoice; end; rtMarkRoomTS: Result := Result + fnRMarkRoomTS; rtMarkPathPanel: Result := Result + fnRMarkPathPanel; rtMarkPathPanelPorts: Result := Result + fnRMarkPathPanelPorts; rtMarkSocket: Result := Result + fnRMarkSocket; rtMarkSocketPanel: Result := Result + fnRMarkSocketPanel; rtMarkCable: Result := Result + fnRMarkCable; rtWACoordinates: Result := Result + fnRWACoordinates; rtPortReport: // Tolik 23/08/2023 -- Result := Result + fnRPortReport; end; end; function TF_ResourceReport.GetReportItemParamByRepType(AReportType: Integer): TReportItemParams; var Node: TFlyNode; ReportItemParams: TReportItemParams; begin Result := nil; Node := GetFirstNodeFromFlyTree(tvReports); while Node <> nil do begin ReportItemParams := TReportItemParams(Node.Data); if ReportItemParams.RepType = AReportType then begin Result := ReportItemParams; Break; //// BREAK //// end; Node := Node.GetNext; end; end; function TF_ResourceReport.GetTemplateTypeByColumnIndex(AColIndex: Integer): Integer; begin Result := 0; case AColIndex of rciSimple: Result := ttSimple; rciStamp: Result := ttStamp; end; end; function TF_ResourceReport.GetTemplateTypeByCurrOptions: Integer; begin Result := 0; if Not cbReportWithStamp.Checked then Result := ttSimple else Result := ttStamp; end; function TF_ResourceReport.ImportTemplateFromFile: Boolean; var OpenDialog: TOpenDialog; ReportTemplateStream: TfileStream; ReportTemplateStreamSize: Integer; RepTemplateSignature: string; IniPath: String; IniFileStream: TFileStream; IniFile: TMemIniFile; ReportFilePath: String; FrfFileStream: TFileStream; IsNoReportTemplate: Boolean; CurrReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; DestReportItemParams: TReportItemParams; DestReportShablons: TReportShablons; RepType: Integer; TemplateType: Integer; NewTemplateName: String; NewUserReportInfo: TUserReportInfo; begin Result := false; try OpenDialog := TOpenDialog.Create(Self); try OpenDialog.Title := cResourceReport_Msg33; OpenDialog.InitialDir := ExtractDirToReportTemplate(''); OpenDialog.DefaultExt := '*.'+enSrt; //OpenDialog.FileName := FileNameCorrect(CurrReportShablons.GetActiveShablonName); OpenDialog.Filter := GetDialogFilter(exdSbk, enSrt); //ExtName+' ('+FullExtName+')|'+FullExtName; OpenDialog.Options := SaveDialog.Options - [ofNoChangeDir]; if OpenDialog.Execute then begin CurrReportItemParams := nil; CurrReportShablons := nil; if tvReports.Selected <> nil then CurrReportItemParams := TReportItemParams(tvReports.Selected.Data); ReportTemplateStream := TFileStream.Create(OpenDialog.FileName, fmOpenRead); ReportTemplateStreamSize := ReportTemplateStream.Size; IsNoReportTemplate := false; if ReportTemplateStreamSize > Length(guidRepTemplateSignature) then begin RepTemplateSignature := ''; SetLength(RepTemplateSignature, Length(guidRepTemplateSignature)); ReportTemplateStream.ReadBuffer(RepTemplateSignature[1], Length(guidRepTemplateSignature)); //Tolik 24/06/2019 -- //if RepTemplateSignature = guidRepTemplateSignature then if String(RepTemplateSignature) = guidRepTemplateSignature then // begin IniPath := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + '\' + fnRepTemplateTmp); IniFileStream := TFileStream.Create(IniPath, fmCreate); IniFileStream.CopyFrom(ReportTemplateStream, ReportTemplateStreamSize - ReportTemplateStream.Position); FreeAndNil(IniFileStream); UnPakFile(IniPath); IniFile := TMemIniFile.Create(IniPath); // Сохранить frf файл ReportFilePath := GetNoExistsFileNameForCopy(GetPathToSCSTmpDir + '\' + fnReport); FrfFileStream := TFileStream.Create(ReportFilePath, fmCreate); IniFile.ReadBinaryStream(seRepTemplate, idtTemplate, FrfFileStream); FreeAndNil(FrfFileStream); RepType := IniFile.ReadInteger(seRepTemplate, idtRepType, -1); TemplateType := IniFile.ReadInteger(seRepTemplate, idtTemplateType, -1); NewTemplateName := IniFile.ReadString(seRepTemplate, idtName, ''); if (RepType <> -1) and (TemplateType <> -1) then begin DestReportItemParams := GetReportItemParamByRepType(RepType); DestReportShablons := nil; if DestReportItemParams <> nil then DestReportShablons := DestReportItemParams.GetShablonsByTemplateType(TemplateType); if DestReportShablons <> nil then begin if NewTemplateName = '' then NewTemplateName := ExtractFileNameOnly(OpenDialog.FileName); while (DestReportShablons.FRepShablons.IndexOf(NewTemplateName) <> -1) and (NewTemplateName <> '') do begin MessageModal(cResourceReport_Msg17_1 +' '+ NewTemplateName +' '+ cResourceReport_Msg17_2, ApplicationName, MB_ICONINFORMATION or MB_OK); NewTemplateName := InputForm(GForm, cResourceReport_Msg33, cResourceReport_Msg10_2, NewTemplateName, dtString); end; if NewTemplateName <> '' then begin //*** Внести шаблон в базу ZeroMemory(@NewUserReportInfo, SizeOf(TUserReportInfo)); NewUserReportInfo.Name := NewTemplateName; NewUserReportInfo.RepKind := RepType; NewUserReportInfo.TemplateType := TemplateType; NewUserReportInfo.UseAsShablon := BoolToInt(DestReportItemParams = CurrReportItemParams); NewUserReportInfo.RepFileName := ReportFilePath; NewUserReportInfo.ID := TF_Main(GForm).DM.InsertUserReportToBase(NewUserReportInfo); DestReportShablons.AddShablonToList(NewUserReportInfo.ID, NewUserReportInfo.Name, IntToBool(NewUserReportInfo.UseAsShablon)); if NewUserReportInfo.UseAsShablon = biTrue then DefineReportNodeControls(tvReports.Selected, true); Result := true; end; end; end; DeleteFile(ReportFilePath); DeleteFile(IniPath); FreeAndNil(IniFile); end else IsNoReportTemplate := true; end else IsNoReportTemplate := true; if IsNoReportTemplate then MessageModal(cFileOf + OpenDialog.FileName +' '+cResourceReport_Msg36, ApplicationName, MB_ICONINFORMATION or MB_OK); FreeAndNil(ReportTemplateStream); end; finally FreeAndNil(OpenDialog); end; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ImportTemplateFromFile', E.Message); end; end; function TF_ResourceReport.IsSimpleReportKind(AReportUseKinds: TReportUseKinds): Boolean; begin //Tolik 31/08/2023 -- //Result := (rkCalc in AReportUseKinds) or (rkCablePath in AReportUseKinds) or (rkCrossConnection in AReportUseKinds); Result := (rkCalc in AReportUseKinds) or (rkCablePath in AReportUseKinds) or (rkCrossConnection in AReportUseKinds) or (rkPortReport in AReportUseKinds); // end; procedure TF_ResourceReport.MakeEditReportTemplate(AMakeEdit: TMakeEdit; AMakeFromStandart: Boolean; ATemplateType: Integer); var StandartReportDir: String; UserReportDir: string; ReportFileName: String; ReportFilePath: String; SrcReportFilePath: String; NewTemplateName: String; SrcUserTemplateName: TStringItem; ReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; CanContinueMake: Boolean; NewUserReportInfo: TUserReportInfo; FileAttrib: Integer; Node: TFlyNode; begin ReportFileName := ''; ReportFilePath := ''; SrcReportFilePath := ''; NewTemplateName := ''; ReportItemParams := nil; CurrReportShablons := nil; Node := tvReports.Selected; if Node <> nil then ReportItemParams := TReportItemParams(Node.Data); if ReportItemParams <> nil then begin CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(ATemplateType); ReportFileName := GetReportFileNameByType(ReportItemParams.RepType, ATemplateType, false); if (ReportFileName <> '') and (CurrReportShablons <> nil) then begin //*** Определить имя файла пользовательского отчета ReportFilePath := GetPathToUserReportFile(ReportFileName); //*** Определить стандартную папку с отчетами {$if Defined(ES_GRAPH_SC)} StandartReportDir := ExeDir + '\' + dnReports; {$else} StandartReportDir := ExtractFileDir(ParamStr(0))+'\'+dnReports; {$ifend} //*** Определить папку User В папке Reports UserReportDir := ExtractFileDir(ReportFilePath); if Not DirectoryExists(UserReportDir) then if Not CreateDir(UserReportDir) then raise Exception.Create(cResourceReport_Msg11 + UserReportDir); if FileExists(ReportFilePath) then if Not DeleteFile(ReportFilePath) then ReportFilePath := GetNoExistsFileNameForCopy(ReportFilePath); //*** Определить редактируемый файл if AMakeEdit = meMake then begin CanContinueMake := true; //*** Если исходный шаблон - не стандартный, то выбрать такой из списка SrcUserTemplateName.FString := ''; SrcUserTemplateName.FObject := nil; //if Not AMakeFromStandart then //begin // SrcUserTemplateName := InputFormCombo(GForm, cResourceReport_Msg12_1, cResourceReport_Msg12_2, // CurrReportShablons.GetActiveShablonName, CurrReportShablons.FRepShablons); // if Integer(SrcUserTemplateName.FObject) <> 0 then // CanContinueMake := false; //end; //*** продолжаем создание if CanContinueMake then begin //*** Определить имя нового шаблона отчета while True do begin NewTemplateName := InputForm(GForm, cResourceReport_Msg10_1, cResourceReport_Msg10_2, cResourceReport_Msg14 +' '+ DateTimeToStr(Now), dtString); if CurrReportShablons.FRepShablons.IndexOf(NewTemplateName) <> -1 then MessageModal(cResourceReport_Msg17_1 +' '+ NewTemplateName +' '+ cResourceReport_Msg17_2, ApplicationName, MB_ICONINFORMATION or MB_OK) else Break; //// BREAK //// end; if NewTemplateName <> '' then begin if AMakeFromStandart then begin SrcReportFilePath := StandartReportDir + '\' + ReportFileName; if FileExists(SrcReportFilePath) then begin CopyFileToByName(SrcReportFilePath, ReportFilePath); FileAttrib := FileGetAttr(ReportFilePath); if (FileAttrib and fatrReadOnly) = fatrReadOnly then FileSetAttr(ReportFilePath, FileAttrib - fatrReadOnly); end; end else begin if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.SaveUserReportByIDToFile(CurrReportShablons.FActiveShablonID, ReportFilePath); end; end; end; end else if AMakeEdit = meEdit then begin //SrcUserTemplateName := InputFormCombo(GForm, cResourceReport_Msg13_1, cResourceReport_Msg13_2, // CurrReportShablons.GetActiveShablonName, CurrReportShablons.FRepShablons); //if Integer(SrcUserTemplateName.FObject) <> 0 then if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.SaveUserReportByIDToFile(CurrReportShablons.FActiveShablonID, ReportFilePath); end; if (ReportFilePath <> '') and FileExists(ReportFilePath) then begin RepDesigner.OnSaveReport := RepDesignerSaveReport; try if ShowReportFromFile(fmUnsign, ReportItemParams, ReportFilePath, pdDesign, true, AMakeEdit) then begin //*** Если был создан новый шаблон if AMakeEdit = meMake then begin //*** деактивировать старый if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, CurrReportShablons.FActiveShablonID, biFalse, qmPhisical); //*** Внести шаблон в базу ZeroMemory(@NewUserReportInfo, SizeOf(TUserReportInfo)); NewUserReportInfo.Name := NewTemplateName; NewUserReportInfo.RepKind := ReportItemParams.RepType; NewUserReportInfo.TemplateType := ATemplateType; NewUserReportInfo.UseAsShablon := biTrue; NewUserReportInfo.RepFileName := ReportFilePath; NewUserReportInfo.ID := TF_Main(GForm).DM.InsertUserReportToBase(NewUserReportInfo); CurrReportShablons.AddShablonToList(NewUserReportInfo.ID, NewUserReportInfo.Name, true); DefineReportNodeControls(Node, true); end else //*** Вгнести отредактированный шаблон if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.UpdateBlobTableFieldByID(tnUserReports, fnRepBlob, CurrReportShablons.FActiveShablonID, nil, ReportFilePath); end else begin DeleteFile(ReportFilePath); end; finally RepDesigner.OnSaveReport := nil; end; end; end; end; end; function TF_ResourceReport.MakeNewReportTemplateWizard: Boolean; var Node: TFlyNode; ReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; ReportFilePath: String; NewUserReportInfo: TUserReportInfo; frPage: TfrPage; frView: TfrView; frMemoView: TfrMemoView; frBandView: TfrBandView; MilimetrKoeff: Double; MarginLeft: Integer; MarginRight: Integer; MarginTop: Integer; MarginBottom: Integer; TitleCellHeight: integer; CellHeight: Integer; CellWidth: Integer; CellGap: Integer; RegionWitdh: Integer; IndexOfPaperSize: integer; PageFooterHeight: Integer; PageFooterBandTop: Integer; function AddPage: TfrPage; begin Report.Pages.Add; Result := Report.Pages[Report.Pages.Count - 1]; Result.UseMargins := true; Result.pgMargins.Left := MarginLeft; Result.pgMargins.Right := MarginRight; Result.pgMargins.Top := MarginTop; Result.pgMargins.Bottom := MarginBottom; end; procedure SetfrMemoAligments(AFrMemoView: TfrMemoView); begin // Центрировать текст по горизонтали AFrMemoView.Alignment := (AFrMemoView.Alignment and $FC) + (13 - 11); // Центрировать текст по вертикали AFrMemoView.Alignment := (AFrMemoView.Alignment and $E7) + Word(true) * 8 + Word(false) * $10; end; begin Result := false; TF_Main(GForm).CreateFMakeMarkPage; //04.01.2011 Node := tvReports.Selected; if Node <> nil then ReportItemParams := TReportItemParams(Node.Data); if ReportItemParams <> nil then begin CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(ttSimple); //*** Определить имя файла пользовательского отчета ReportFilePath := GetNoExistsFileNameForCopy(GetPathToUserReportFile('ReportTemplate.frf')); if (ReportFilePath <> '') and Not FileExists(ReportFilePath) then if TF_Main(GForm).F_MakeMarkPage.Execute(ReportItemParams.RepType) then begin Report.Clear; // Настроить размеры страници MilimetrKoeff := 3.6; with TF_Main(GForm).F_MakeMarkPage do begin MarginLeft := Round(GetSpinEditValueMM(seMarginLeft) * MilimetrKoeff); MarginRight := Round(GetSpinEditValueMM(seMarginRight) * MilimetrKoeff); MarginTop := Round(GetSpinEditValueMM(seMarginTop) * MilimetrKoeff); MarginBottom := Round(GetSpinEditValueMM(seMarginBottom) * MilimetrKoeff); CellHeight := Round(GetSpinEditValueMM(seCellHeight) * MilimetrKoeff); CellWidth := Round(GetSpinEditValueMM(seCellWidth) * MilimetrKoeff); CellGap := Round(GetSpinEditValueMM(seCellGap) * MilimetrKoeff); end; // Титулка if TF_Main(GForm).F_MakeMarkPage.cbCreateTitlePage.Checked then begin frPage := AddPage; IndexOfPaperSize := Prn.PaperNames.IndexOf('A4'); if IndexOfPaperSize <> -1 then frPage.ChangePaper(Prn.PaperSizes[IndexOfPaperSize], 0, 0, -1, poPortrait); RegionWitdh := frPage.PrnInfo.Pgw - MarginLeft - MarginRight; TitleCellHeight := 40; frMemoView := TfrMemoView(frCreateObject(gtMemo, '')); frPage.Objects.Add(frMemoView); //frMemoView.SetBounds(MarginLeft, MarginTop*5, RegionWitdh, CellHeight); //frMemoView.SetBounds( // MarginLeft, // Round((frPage.PrnInfo.Pgh/2) - (TitleCellHeight/2)), //Top // RegionWitdh, TitleCellHeight); frMemoView.SetBounds( MarginLeft, MarginTop, RegionWitdh, frPage.PrnInfo.Pgh - MarginTop - MarginBottom); SetfrMemoAligments(frMemoView); frMemoView.Font.Name := TF_Main(GForm).F_MakeMarkPage.FResFont.Name; frMemoView.Font.Size := 28; frMemoView.Font.Style := frMemoView.Font.Style + [fsBold, fsItalic]; frMemoView.Memo.Add(tvReports.Selected.Text); end; // Страница с данными frPage := AddPage; IndexOfPaperSize := Prn.PaperNames.IndexOf(TF_Main(GForm).F_MakeMarkPage.cbPageSize.Text); if IndexOfPaperSize <> -1 then frPage.ChangePaper(Prn.PaperSizes[IndexOfPaperSize], 0, 0, -1, TF_Main(GForm).F_MakeMarkPage.FResPrinterOrientation); RegionWitdh := frPage.PrnInfo.Pgw - MarginLeft - MarginRight; frBandView := TfrBandView(frCreateObject(gtBand, '')); frPage.Objects.Add(frBandView); frBandView.SetBounds(0, MarginTop, 0, CellHeight); frBandView.BandType := btMasterData; frBandView.DataSet := frDBDataSet_Master.Name; //frBandView.Flags := flStretched; //frBandView.FrameStyle := Ord(psDashDot); // Ширина печатаемой области if CellWidth < RegionWitdh then begin frBandView.Columns := Trunc(RegionWitdh / (CellWidth + CellGap)); frBandView.ColumnWidth := CellWidth; frBandView.ColumnGap := CellGap; end; frMemoView := TfrMemoView(frCreateObject(gtMemo, '')); frPage.Objects.Add(frMemoView); frMemoView.SetBounds(MarginLeft, MarginTop, CellWidth, CellHeight); SetfrMemoAligments(frMemoView); frMemoView.Memo.Add('[mtReport."Name_Mark"]'); frMemoView.FillColor := clWhite; frMemoView.Font.Name := TF_Main(GForm).F_MakeMarkPage.FResFont.Name; frMemoView.Font.Size := TF_Main(GForm).F_MakeMarkPage.FResFont.Size; frMemoView.Font.Style := TF_Main(GForm).F_MakeMarkPage.FResFont.Style; frMemoView.FrameColor := TF_Main(GForm).F_MakeMarkPage.ceLineColor.SelectedColor; frMemoView.FrameStyle := TF_Main(GForm).F_MakeMarkPage.FResFrameStyle; //Ord(psDashDot); frMemoView.FrameTyp := TF_Main(GForm).F_MakeMarkPage.FResFrameTyp; frMemoView.FrameWidth := TF_Main(GForm).F_MakeMarkPage.FResFrameWidth; frMemoView.Flags := flStretched {+ flWordWrap}; // Номера страниц if TF_Main(GForm).F_MakeMarkPage.cbShowPageNumber.Checked then begin PageFooterHeight := 18; PageFooterBandTop := frPage.PrnInfo.Pgh - MarginBottom - PageFooterHeight; // Бєнд внизу страници frBandView := TfrBandView(frCreateObject(gtBand, '')); frPage.Objects.Add(frBandView); frBandView.SetBounds(0, PageFooterBandTop, 0, PageFooterHeight); frBandView.BandType := btPageFooter; frMemoView := TfrMemoView(frCreateObject(gtMemo, '')); frPage.Objects.Add(frMemoView); frMemoView.SetBounds(MarginLeft, PageFooterBandTop, frPage.PrnInfo.Pgw - MarginLeft - MarginRight, PageFooterHeight); SetfrMemoAligments(frMemoView); frMemoView.Font.Name := TF_Main(GForm).F_MakeMarkPage.FResFont.Name; frMemoView.Font.Size := 10; frMemoView.Memo.Add('-[PAGE#]-'); end; Report.SaveToFile(ReportFilePath); if FileExists(ReportFilePath) then begin //*** деактивировать старый if CurrReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, CurrReportShablons.FActiveShablonID, biFalse, qmPhisical); //*** Внести шаблон в базу ZeroMemory(@NewUserReportInfo, SizeOf(TUserReportInfo)); NewUserReportInfo.Name := cResourceReport_Msg14 +' '+ DateTimeToStr(Now); NewUserReportInfo.RepKind := ReportItemParams.RepType; NewUserReportInfo.TemplateType := ttSimple; NewUserReportInfo.UseAsShablon := biTrue; NewUserReportInfo.RepFileName := ReportFilePath; NewUserReportInfo.ID := TF_Main(GForm).DM.InsertUserReportToBase(NewUserReportInfo); CurrReportShablons.AddShablonToList(NewUserReportInfo.ID, NewUserReportInfo.Name, true); DefineReportNodeControls(Node, true); Result := True; if TF_Main(GForm).F_MakeMarkPage.cbOpenInDesigner.Checked then MakeEditReportTemplate(meEdit, false, ttSimple); //ShowReport(fmUnsign, ReportFilePath, pdDesign); end; DeleteFile(ReportFilePath); end; end; end; procedure TF_ResourceReport.SortMemTableByParams(AMemTable: TkbmMemTable; AReportItemParams, AReportItemParamValues: TReportItemParams); var StrSortFields: String; i, j: Integer; MemTableCompareOptions: TkbmMemTableCompareOptions; Stream : TStream; FieldNamesDivided: TStringList; begin StrSortFields := ''; if AReportItemParamValues <> nil then begin // Если в порядке размещения на проекте, то не выполняем сортировку if (AReportItemParams.CanAsPlacingInProj = biTrue) and (AReportItemParamValues.CanAsPlacingInProj = biTrue) then Exit; ///// EXIT ///// end; for i := 0 to AReportItemParams.FReportSortInfo.FUsedFieldNames.Count - 1 do begin if AMemTable.FieldDefs.IndexOf(AReportItemParams.FReportSortInfo.FUsedFieldNames[i]) <> -1 then begin if StrSortFields <> '' then StrSortFields := StrSortFields + ';'; StrSortFields := StrSortFields + AReportItemParams.FReportSortInfo.FUsedFieldNames[i]; end else begin FieldNamesDivided := GetStringsFromStr(AReportItemParams.FReportSortInfo.FUsedFieldNames[i], ';', false); for j := 0 to FieldNamesDivided.Count - 1 do if AMemTable.FieldDefs.IndexOf(FieldNamesDivided[j]) <> -1 then begin if StrSortFields <> '' then StrSortFields := StrSortFields + ';'; StrSortFields := StrSortFields + FieldNamesDivided[j]; end; FreeAndNil(FieldNamesDivided); end; end; if StrSortFields <> '' then begin MemTableCompareOptions := []; if AReportItemParams.FReportSortInfo.CaseSensitive = biFalse then MemTableCompareOptions := MemTableCompareOptions + [mtcoCaseInsensitive]; if AReportItemParams.FReportSortInfo.Descending = biTrue then MemTableCompareOptions := MemTableCompareOptions + [mtcoDescending]; //AMemTable.SortOn(StrSortFields, MemTableCompareOptions); AMemTable.SortOn(StrSortFields, []); end; end; function TF_ResourceReport.PrepareCommerceInvoiceObjects(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams): TSCSCatalog; const // Position Type ptGroup = 1; ptEndGroup = 2; ptCompon = 3; ptGroupTotal = 4; ptBreak = 5; var i, j: integer; //NBPath: TStringList; CatalogOwnerPathID: TIntList; Compon: TSCSComponent; ComponIDNB: Integer; RootCatalog: TSCSCatalog; // Корневой объект ComponCatalog: TSCSCatalog; // Объект для компонента CatalogWithNoDefined: TSCSCatalog; // Объект с компонентами, которых нету в БД MaxPathLen: Integer; // Минимальная длина пути //ptrComponTotalQt: PDouble; // переменная из списка, в которой хранится общее кол-во //ComponentQt: Double; // Колво одной компоненты GroupCompon: TSCSComponent; GroupComponList: TSCSComponents; LookedWholeID: TIntList; Catalogs: TSCSCatalogs; LevelColors: TIntList; GenCatalogNum: Integer; //Tolik 24/10/2020 -- для теста -- f: TextFile; // // Создаст объект каталога function CreateCatalogContainer(ANBID: Integer=0; AParentContainer: TSCSCatalog=nil): TSCSCatalog; begin Result := TSCSCatalog.Create(GForm); //Result.Level := ALevel; //Result.SCSComponents.OwnsObjects := false; if ANBID <> 0 then begin Result.ID := ANBID; Result.Name := TF_Main(GForm).FNormBase.DM.GetStringFromTableByID(tnCatalog, fnName, Result.ID, qmPhisical); end; if AParentContainer <> nil then AParentContainer.AddChildCatalogToList(Result); end; // Строит структуру (путь) объектов из пути ID, вернет самый внутренний каталог function CatalogPathIDToObject(ACatalogPathID: TIntList): TSCSCatalog; var i: Integer; CurrCatalog: TSCSCatalog; ChildCatalog: TSCSCatalog; begin CurrCatalog := RootCatalog; for i := 0 to ACatalogPathID.Count - 1 do begin ChildCatalog := CurrCatalog.ChildCatalogs.GetByID(ACatalogPathID[i]); if ChildCatalog = nil then ChildCatalog := CreateCatalogContainer(ACatalogPathID[i], CurrCatalog); CurrCatalog := ChildCatalog; //if (i+1) > MaxCatalogLevel then // MaxCatalogLevel := i+1; end; if (MaxPathLen = 0) or (MaxPathLen < ACatalogPathID.Count) then MaxPathLen := ACatalogPathID.Count; Result := CurrCatalog; end; // Убирает общие верхние объекты - те у которых один дочерний подобъект // смотрим чтобы для компонентов был хотя бы один уровень // и для самого глубокого по возможности - минимкм три уровня procedure RemoveTopCommonObjects; var CurrTopCatalog: TSCSCatalog; //CatalogToRemove: TSCSCatalog; RemovedCount: Integer; begin CurrTopCatalog := RootCatalog; RemovedCount := 0; //while (MaxPathLen - RemovedCount) >= 3 do while true do begin // Проверки для выхода из цыкла if (CurrTopCatalog.ChildCatalogs.Count > 1) or // если несколько объектов, товыходим (CurrTopCatalog.SCSComponents.Count > 0) or // если есть компоненты, то выходим (CurrTopCatalog.ChildCatalogs.Count = 0) or // на всякий случай //((MaxPathLen-RemovedCount) <= 3) then ((MaxPathLen-RemovedCount) <= 3) then begin EmptyProcedure; Break; //// BREAK //// end; RootCatalog := CurrTopCatalog.ChildCatalogs[0]; //RootCatalog.Parent := nil; CurrTopCatalog.RemoveChildCatalogFromList(RootCatalog); CurrTopCatalog.Free; CurrTopCatalog := RootCatalog; RemovedCount := RemovedCount + 1; end; end; procedure DefineCatalogCodes(AParentCatalogs: TSCSCatalogs; ALevel: Integer=-1); var i, j: Integer; ChildLevelCatalogs: TSCSCatalogs; Catalog: TSCSCatalog; begin ChildLevelCatalogs := TSCSCatalogs.Create(false); // Определяем номера Каталогов for i := 0 to AParentCatalogs.Count - 1 do begin Catalog := AParentCatalogs[i]; Catalog.Level := ALevel; GenCatalogNum := GenCatalogNum + 1; Catalog.MarkID := GenCatalogNum; Catalog.NameMark := IntToStrF(Catalog.MarkID, 2); // Определяем список каталогов уровнем ниже for j := 0 to Catalog.ChildCatalogs.Count - 1 do ChildLevelCatalogs.Add(Catalog.ChildCatalogs[j]); end; if ChildLevelCatalogs.Count > 0 then DefineCatalogCodes(ChildLevelCatalogs, ALevel+1); FreeAndNil(ChildLevelCatalogs); end; function GetGrpCompon(AProjCompon: TSCSComponent): TSCSComponent; var Compon: TSCSComponent; Izm: String; i: Integer; begin Result := nil; Izm := AProjCompon.Izm; if CheckPriceTransformToUOMByCompType(@AProjCompon.ComponentType) then Izm := GetNameUOM(umMetr, true); for i := 0 to GroupComponList.Count - 1 do begin Compon := GroupComponList[i]; if (Compon.ArticulProducer = AProjCompon.ArticulProducer) and (Abs(Compon.Price - AProjCompon.Price) < cnstCmpPriceDelta) and (Compon.Izm = Izm) and (Compon.GUIDProducer = AProjCompon.GUIDProducer) and (Compon.Name = AProjCompon.Name) and (Compon.IsLine = AProjCompon.IsLine) then begin Result := Compon; Break; //// BREAK //// end; end; end; begin Result := nil; try RootCatalog := CreateCatalogContainer; RootCatalog.Name := ''; LookedWholeID := TIntList.Create; GroupComponList := TSCSComponents.Create(false); // групповые кобъекты будут удаляться из каталогов //LevelColors := TIntList.Create; try CatalogWithNoDefined := nil; MaxPathLen := 0; { assignFile(f, 'c:\InvoiceCable.txt'); rewrite(f); } for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin Compon := ACatalog.ComponentReferences[i]; // Tolik // по типу сети if (AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(Compon.GUIDNetType) <> -1))) then begin // // Можем ли использовать этот компонент по параметрам if ((Compon.Isline = biFalse) or (LookedWholeID.IndexOf(Compon.Whole_ID) = -1)) and CheckCanLookComponInReportRsrc(Compon, AReportItemParamValues.CanHaveActiveComponents=biTrue, AReportItemParamValues.CanHaveDismountAccount=biTrue) then begin GroupCompon := GetGrpCompon(Compon); if GroupCompon = nil then begin GroupCompon := TSCSComponent.Create(GForm); GroupCompon.AssignOnlyComponent(Compon); GroupCompon.Length := 0; if CheckPriceTransformToUOMByCompType(@GroupCompon.ComponentType) then GroupCompon.Izm := GetNameUOM(umMetr, true); //Tolik 03/04/2022 -- { CatalogOwnerPathID := nil; ComponIDNB := TF_Main(GForm).FNormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, Compon.GuidNB, qmPhisical); if ComponIDNB <> 0 then CatalogOwnerPathID := GetComponCatalogOwnerPathIDByLevel(ComponIDNB, 0, TF_Main(GForm).FNormBase.DM.Query_Select); // Если есть папка в НБ, то кидаем в объект этой папки if (CatalogOwnerPathID <> nil) and (CatalogOwnerPathID.Count > 0) then begin ComponCatalog := CatalogPathIDToObject(CatalogOwnerPathID); //ComponCatalog.SCSComponents.Add(Compon); ComponCatalog.AddComponentToList(GroupCompon); end else // Иначе кидаем в спец. папку с компонентами которых нету в НБ begin if CatalogWithNoDefined = nil then begin CatalogWithNoDefined := CreateCatalogContainer; CatalogWithNoDefined.Name := cResourceReport_Msg43; //08.08.2012 CatalogWithNoDefined.AddComponentToList(GroupCompon); end; CatalogWithNoDefined.AddComponentToList(GroupCompon); end; } if CatalogWithNoDefined = nil then begin CatalogWithNoDefined := CreateCatalogContainer; CatalogWithNoDefined.Name := cResourceReport_Msg43; //08.08.2012 CatalogWithNoDefined.AddComponentToList(GroupCompon); end; CatalogWithNoDefined.AddComponentToList(GroupCompon); // GroupComponList.Add(GroupCompon); end; GroupCompon.Length := GroupCompon.Length + GetComponQuantityByParams(Compon, AReportItemParamValues.CanHaveDismountAccount=biTrue); { if isCableComponent(Compon) then begin writeln(f, 'i = ' + inttostr(i) + Compon.Name + ' GroupCompon.Length = ' + FloatToStr(GroupCompon.Length) + ' Page = ' + Compon.GetListOwner.Name + ' Compon.ID = ' + IntToStr(Compon.ID)); end; } // Запоминаем кабель //02.08.2012 if (Compon.Isline = biTrue) and (Compon.Whole_ID <> 0) then //02.08.2012 LookedWholeID.Add(Compon.Whole_ID); end; end; end; //CloseFile(f); RemoveTopCommonObjects; RootCatalog.AddChildCatalogToList(CatalogWithNoDefined); // Определяем коды (номера папок) по уровням GenCatalogNum := -1; Catalogs := TSCSCatalogs.Create(false); Catalogs.Add(RootCatalog); DefineCatalogCodes(Catalogs); FreeAndNil(Catalogs); // Цвета BGR - blue green red //LevelColors.Add($FFCC99); //LevelColors.Add($CCFFCC); ////LevelColors.Add($CCFFFF); // насыпаем MemTable //ObjectstsToMT(RootCatalog); Result := RootCatalog; finally //FreeAndNil(LevelColors); FreeAndNil(GroupComponList); FreeAndNil(LookedWholeID); //FreeAndNil(RootCatalog); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'PrepareCommerceInvoiceObjects', E.Message); end; end; procedure TF_ResourceReport.PrepareReportFormats; var i, j: Integer; FrPage: TfrPage; FrObject: TObject; FrMemoView: TfrMemoView; FracDelimetrCode: Integer; begin for i := 0 to Report.Pages.Count - 1 do begin FrPage := Report.Pages[i]; for j := 0 to FrPage.Objects.Count - 1 do begin FrObject := TObject(FrPage.Objects[j]); if FrObject is TFrMemoView then begin FrMemoView := TfrMemoView(FrObject); // Проверить разделитель // Код разделителя хранится в 2-х первых байтах if FrMemoView.Format <> 0 then begin FracDelimetrCode := (FrMemoView.Format and $FF); if Chr(FracDelimetrCode) <> DecimalSeparator then begin // Убераем старый код разделителя FrMemoView.Format := FrMemoView.Format - FracDelimetrCode; // Добавляем новый код разделителя FrMemoView.Format := FrMemoView.Format + Ord(DecimalSeparator); end; end; // currenct charset FrMemoView.Font.Charset := F_LNG.GetActiveCharset; end; end; end; end; procedure TF_ResourceReport.RepListWrite(AName: String; AObjCount, AComponCount: Integer; AWorkCost: Double); begin {RichEdit_Report.SelAttributes.Size := 15; RichEdit_Report.Lines.Add('Лист "'+AName+'" '); RichEdit_Report.SelAttributes.Size := 14; RichEdit_Report.Lines.Add(' Объектов '+IntToStr(AObjCount)+'; Компонент '+IntToStr(AComponCount)+'; Стоимость ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); } end; procedure TF_ResourceReport.RepObjWrite(AName: String; AItemType: TItemType; AComponCount: Integer; AWorkCost: Double); begin { RichEdit_Report.SelAttributes.Size := 13; RichEdit_Report.Lines.Add(''); RichEdit_Report.Lines.Add(' Объект "'+AName+'" '); RichEdit_Report.SelAttributes.Size := 12; RichEdit_Report.Lines.Add(' Компонент '+IntToStr(AComponCount)+'; Стоимость ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); } end; procedure TF_ResourceReport.RepComponWrite(AName: String; AisCompon: Boolean; AWorkCost: Double; Apref: Integer); var BeforeName: String; begin { BeforeName := ''; if AisCompon then BeforeName := 'Компонент'; RichEdit_Report.SelAttributes.Size := 12; RichEdit_Report.Lines.Add(DupStr(' ', APref)+ BeforeName +'"'+AName+'" (Стоимость всех ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief+')'); //RichEdit_Report.Lines.Add(' Компонент "'+AName+'" (Стоимость всех ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief+')'); //RichEdit_Report.SelAttributes.Size := 11; //RichEdit_Report.Lines.Add(' Стоимость всех ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); } end; procedure TF_ResourceReport.RepResourcesWrite(AResourcesCost: Double; APref: Integer); begin { RichEdit_Report.SelAttributes.Size := 12; RichEdit_Report.Lines.Add(DupStr(' ', APref) + 'Ресурсы: (Стоимость '+FloatToStr(RoundIBD(AResourcesCost, 2))+' '+GCurrency.Name_Brief+') '); //RichEdit_Report.SelAttributes.Size := 11; //RichEdit_Report.Lines.Add(' Стоимость всех ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); } end; procedure TF_ResourceReport.RepResourceWrite(AName: String; AWorkCost: Double; APref: Integer); begin { RichEdit_Report.SelAttributes.Size := 12; RichEdit_Report.Lines.Add(DupStr(' ', APref) + '"'+AName+'", стоимость '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); //RichEdit_Report.SelAttributes.Size := 11; //RichEdit_Report.Lines.Add(' Стоимость всех ресурсов '+FloatToStr(RoundIBD(AWorkCost, 2))+' '+GCurrency.Name_Brief); } end; procedure TF_ResourceReport.RepComplectsWrite(AComplCost: Double); begin { RichEdit_Report.SelAttributes.Size := 12; RichEdit_Report.Lines.Add(DupStr(' ', 15) + 'Комплектующие: (Стоимость '+FloatToStr(RoundIBD(AComplCost, 2))+' '+GCurrency.Name_Brief+') '); } end; procedure TF_ResourceReport.LoadPortName(AIDPointComponent, AIDLineComponent: Integer; var ANppPort: Integer; var APortName: String; aPort: Pointer=nil; aPortFromPos: PInteger=nil; aPortToPos: PInteger=nil); var //SCSComponent: TSCSComponent; i, j: Integer; Interfac: TSCSInterface; InterfacLineComponent: TSCSInterface; InterfLists: TInterfLists; Interfaces: TList; PointComponent: TSCSComponent; LineComponent: TSCSComponent; Port: TSCSInterface; //RelInterfConnPositions: TList; PortFromPos, PortToPos: Integer; begin //SCSComponent := nil; //04.10.2013 if aPort <> nil then TObject(aPort^) := nil; if aPortFromPos <> nil then aPortFromPos^ := 0; if aPortToPos <> nil then aPortToPos^ := 0; ANppPort := 0; APortName := ''; with F_ProjMan do begin PointComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDPointComponent); LineComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDLineComponent); if Assigned(PointComponent) and Assigned(LineComponent) then begin Interfaces := Tlist.Create; try InterfLists := PointComponent.GetInterfacesThatConnectComponent(LineComponent); if Assigned(InterfLists.InterfList1) then Interfaces.Assign(InterfLists.InterfList1, laOr); if Assigned(InterfLists.InterfList2) then Interfaces.Assign(InterfLists.InterfList2, laOr); // Tolik 11/03/2017 -- InterfLists.InterfList1.Free; InterfLists.InterfList2.Free; // for i := 0 to Interfaces.Count - 1 do begin Interfac := TSCSInterface(Interfaces[i]); if Interfac.ComponentOwner = PointComponent then begin Port := nil; if Interfac.IsPort = biTrue then Port := Interfac else Port := Interfac.PortOwner; //*** Найти интерфейс от линейной компоненты InterfacLineComponent := nil; for j := 0 to LineComponent.Interfaces.Count - 1 do if Interfac.ConnectedInterfaces.IndexOf(LineComponent.Interfaces[j]) <> -1 then begin InterfacLineComponent := LineComponent.Interfaces[j]; Break; //// BREAK //// end; if InterfacLineComponent <> nil then begin //RelInterfConnPositions := if Assigned(Port) then begin ANppPort := GetNppPortByConnected(Port, Interfac, InterfacLineComponent, -1, @PortFromPos, @PortToPos); //Port.NppPort; APortName := Port.LoadName; //05.10.2013 - если подключены кабелем к интерфейсу, то вернем его порт с позициямиs if Interfac.IsPort = biFalse then begin if aPort <> nil then TObject(aPort^) := Port; if aPortFromPos <> nil then aPortFromPos^ := PortFromPos; if aPortToPos <> nil then aPortToPos^ := PortToPos; end; Break; ///// BREAK ///// end; //FreeAndNil(RelInterfConnPositions); end; end; end; finally Interfaces.Free; end; end; //SCSComponent := GSCSBase.CurrProject.GetComponentFromReferences(AIDPointComponent); {if Assigned(SCSComponent) then for i := 0 to SCSComponent.Interfaces.Count - 1 do begin Interfac := SCSComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin ANppPort := Interfac.NppPort; APortName := DM.GetInterfName(Interfac.ID_Interface); end; end;} end; end; function TF_ResourceReport.GetMultiPortNameMark(APointComponent: TSCSComponent; ARetIndexIfNoMark: Boolean): String; var CurrParentComponent: TSCSComponent; ResComponent: TSCSComponent; begin Result := ''; if APointComponent <> nil then begin ResComponent := APointComponent; CurrParentComponent := APointComponent; while CurrParentComponent <> nil do begin if CurrParentComponent.ComponentType.PortKind = pkMultiPort then begin ResComponent := CurrParentComponent; Break; //// BREAK //// end; CurrParentComponent := CurrParentComponent.GetParentComponent; end; if ResComponent.NameMark <> '' then Result := ResComponent.NameMark else if ARetIndexIfNoMark then Result := ResComponent.NameMark; //IntToStr(ResComponent.MarkID); end; end; function TF_ResourceReport.GetParallelInterfaces(AFirstConnCompon, AFirstLineCompon, ALastConnCompon, ALastLineCompon: TSCSComponent): TInterfLists; var InterfacesFirst: TList; InterfacesLast: TList; ConnectedInterfFirst: TInterfLists; ConnectedInterfLast: TInterfLists; ptrInterfFirst: TSCSInterface; ptrInterfLast: TSCSInterface; i, j: Integer; begin Result.InterfList1 := nil; Result.InterfList2 := nil; Result.InterfList1 := TList.Create; Result.InterfList2 := TList.Create; ConnectedInterfFirst := AFirstConnCompon.GetConnectedInterfacesToCompon(AFirstLineCompon); ConnectedInterfLast := ALastConnCompon.GetConnectedInterfacesToCompon(ALastLineCompon); //*** Порты в первую очередь for i := 0 to ConnectedInterfFirst.InterfList1.Count - 1 do begin ptrInterfFirst := ConnectedInterfFirst.InterfList1[i]; if Result.InterfList1.IndexOf(ptrInterfFirst) = -1 then if ptrInterfFirst.IDConnected <> 0 then for j := 0 to ConnectedInterfLast.InterfList1.Count - 1 do if TSCSInterface(ConnectedInterfLast.InterfList1[j]).ID = ptrInterfFirst.IDConnected then if Result.InterfList2.IndexOf(ConnectedInterfLast.InterfList1[j]) = -1 then begin Result.InterfList1.Add(ptrInterfFirst); Result.InterfList2.Add(ConnectedInterfLast.InterfList1[j]); Break; ///// BREAK ///// end; end; for i := 0 to ConnectedInterfFirst.InterfList1.Count - 1 do begin ptrInterfFirst := ConnectedInterfFirst.InterfList1[i]; if Result.InterfList1.IndexOf(ptrInterfFirst) = -1 then if ptrInterfFirst.IDConnected = 0 then for j := 0 to ConnectedInterfLast.InterfList1.Count - 1 do if TSCSInterface(ConnectedInterfLast.InterfList1[j]).ID_Interface = ptrInterfFirst.ID_Interface then if Result.InterfList2.IndexOf(ConnectedInterfLast.InterfList1[j]) = -1 then begin Result.InterfList1.Add(ptrInterfFirst); Result.InterfList2.Add(ConnectedInterfLast.InterfList1[j]); Break; ///// BREAK ///// end; end; //*** Добавить интерфейсы которые не занесены в списки for i := 0 to ConnectedInterfFirst.InterfList1.Count - 1 do if Result.InterfList1.IndexOf(ConnectedInterfFirst.InterfList1[i]) = -1 then Result.InterfList1.Add(ConnectedInterfFirst.InterfList1[i]); for i := 0 to ConnectedInterfLast.InterfList1.Count - 1 do if Result.InterfList2.IndexOf(ConnectedInterfLast.InterfList1[i]) = -1 then Result.InterfList2.Add(ConnectedInterfLast.InterfList1[i]); // Tolik 11/03/2017 -- { ConnectedInterfFirst.InterfList1.Free; ConnectedInterfFirst.InterfList2.Free; ConnectedInterfLast.InterfList1.Free; ConnectedInterfLast.InterfList2.Free; } FreeAndNil(ConnectedInterfFirst.InterfList1); FreeAndNil(ConnectedInterfFirst.InterfList2); FreeAndNil(ConnectedInterfLast.InterfList1); FreeAndNil(ConnectedInterfLast.InterfList2); // end; function TF_ResourceReport.GetUOMLengthMin: String; begin Result := ''; if CheckIsTradUOM(TF_Main(GForm).FUOM) then Result := GetNameUOM(umInch, true) else Result := GetNameUOM(umMillimetr, true); end; function TF_ResourceReport.GetUOMWithOrthographMarks: String; begin Result := ', ('+GetNameUOM(TF_Main(GForm).FUOM, true)+')'; end; function TF_ResourceReport.GetUOMWeight: String; begin Result := ''; if CheckIsTradUOM(TF_Main(GForm).FUOM) then Result := GetNameUOM(umPound, true) else Result := GetNameUOM(umKg, true); end; function TF_ResourceReport.GetUOMWeightOrthographMarks: String; begin Result := ', '+GetUOMWeight; end; procedure TF_ResourceReport.FormMdiClose(Sender: TObject; var Action: TCloseAction); begin FormList.Remove(Sender); //if Report.Preview = TF_Preview(Sender).frPreview1 then // Report.Preview := nil; Action := caFree; end; procedure TF_ResourceReport.ApplMinimize(Sender: TObject); var i: integer; //SavedOnAppMinimize: TNotifyEvent; begin for i := 0 to FormList.Count - 1 do begin TF_Preview(FormList.Items[i]).Hide; // WindowState := wsMinimized; end; //SavedOnAppMinimize := Application.OnMinimize; //Application.OnMinimize := nil; try if Assigned(FSavedOnAppMinimize) then FSavedOnAppMinimize(nil); except end; //Application.OnMinimize := SavedOnAppMinimize; end; procedure TF_ResourceReport.ApplRestore(Sender: TObject); var i: integer; //SavedOnAppRestore: TNotifyEvent; begin for i := 0 to FormList.Count - 1 do begin TF_Preview(FormList.Items[i]).Show; // WindowState := wsMinimized; end; //SavedOnAppRestore := Application.OnRestore; //Application.OnRestore := nil; try if Assigned(FSavedOnAppRestore) then FSavedOnAppRestore(nil); except end; //Application.OnRestore := SavedOnAppRestore; end; procedure TF_ResourceReport.DefinePrecisions; begin FPricePrecision := 3; FKolvoPrecision := 3; if nePricePrecision.Enabled then FPricePrecision := nePricePrecision.IntValue; if neKolvoPrecision.Enabled then FKolvoPrecision := neKolvoPrecision.IntValue; end; procedure TF_ResourceReport.DefineRepDesignLanguage; begin if FileExists(GetPathToRepDesignLang) then begin FFrLocale.UnloadDll; FFrLocale.LoadDll(GetPathToRepDesignLang); end; end; function TF_ResourceReport.ExtractDirToNewReport(ADateTime: TDateTime): String; var CurrDateTime: TDateTime; begin Result := ''; try CurrDateTime := ADateTime; if CurrDateTime = 0 then CurrDateTime := Now; // Tolik --25/09/2020 -- //if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) or (rkCablePath in FReportUseKind) then // begin //Tolik 25/09/2020 -- //if (rkProject in FReportUseKind) or if ((rkProject in FReportUseKind) or (rkCablePath in FReportUseKind)) then // Result := ExtractSaveDir + '\'+cResourceReport_Msg28 else if rkMarkPages in FReportUseKind then Result := ExtractSaveDir + '\'+cResourceReport_Msg37; if Not DirectoryExists(Result) then CreateDir(Result); end else //24.02.2011 if rkCalc in FReportUseKind then if IsSimpleReportKind(FReportUseKind) then begin Result := ExtractSaveDirSimple +'\!'+cResourceReport_Msg1_12; if Not DirectoryExists(Result) then CreateDir(Result); if DirectoryExists(Result) then begin Result := Result +'\'+ FileNameCorrect(DateToStr(CurrDateTime)); if Not DirectoryExists(Result) then CreateDir(Result); end; end; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ExtractDirToNewReport', E.Message); end; end; function TF_ResourceReport.ExtractDirToReportTemplate(AReportName: String): String; var DirNameFromUseKind: String; begin Result := ''; Result := ExtractSaveDirSimple; DirNameFromUseKind := ''; if (rkProject in FReportUseKind) or //24.02.2011 (rkCalc in FReportUseKind) IsSimpleReportKind(FReportUseKind) then DirNameFromUseKind := cResourceReport_Msg31 else if rkMarkPages in FReportUseKind then DirNameFromUseKind := cResourceReport_Msg35; DirNameFromUseKind := FileNameCorrect(DirNameFromUseKind); if DirNameFromUseKind <> '' then begin Result := Result + '\!'+DirNameFromUseKind; if Not DirectoryExists(Result) then CreateDir(Result); if DirectoryExists(Result) then if AReportName <> '' then begin Result := Result + '\' + FileNameCorrect(AReportName); if Not DirectoryExists(Result) then CreateDir(Result); end; end; end; function TF_ResourceReport.GetTargetFolder: TSCSCatalog; begin Result := nil; if Assigned(tvReportTarget.Selected) then Result := TSCSCatalog(tvReportTarget.Selected.Data) end; procedure TF_ResourceReport.ShowWizard(AReportUseKind: TReportUseKinds; AShow: Boolean=true); var CanReport: Boolean; ProjectNode: TFlyNode; NodeToSelect: TFlyNode; ListNode: TFlyNode; SCSObject: TSCSCatalog; SCSList: TSCSList; i: Integer; SelItemType: Integer; SelObjectID: Integer; ProjManNode: TTreeNode; ProjManNodeDat: PObjectData; FlyNodes: TFlyNodes; ReportNode: TFlyNode; RepObjects: TSCSCatalogs; // Tolik NetTypeCount: Integer; RootNode, Node: TTreeNode; function AddObjectToTree(AParentNode: TFlyNode; AObject: TSCSCatalog): TFlyNode; var SCSList: TSCSList; begin Result := tvReportTarget.Items.AddChild(AParentNode, AObject.GetNameForVisible(false)); //Result.ImageIndex := tciiList; Result.ImageIndex := TF_Main(GForm).GetImageIndexByObjectData(nil, AObject.ItemType, ekNone, AObject); Result.SelectedIndex := Result.ImageIndex; Result.Data := AObject; Result.Cells[tciCAD] := bsTrue; SCSList := nil; if AObject is TSCSList then SCSList := TSCSList(AObject); if Assigned(SCSList) {and CheckListNormalType(SCSList.CurrID)} then begin SCSList.IsNormalType := CheckListNormalType(SCSList.CurrID); if Not SCSList.IsNormalType then Result.Cells[tciReport] := bsGray; //Result.Hidden := SCSList.IsNormalType; end; // Для папки лочим печать лита if AObject.ItemType = itDir then Result.Cells[tciCAD] := bsGray; // Если объект добавляем в папку, то делаем его отключенным по умолчанию для пакетной печати //if TObject(AParentNode.Data) is TSCSCatalog then // if TSCSCatalog(AParentNode.Data).ItemType = itDir then // Result.Cells[tciReport] := bsFalse; if (AObject.ItemType = SelItemType) and (AObject.ID = SelObjectID) then NodeToSelect := Result; if Not AParentNode.Expanded then AParentNode.Expanded := true; end; procedure AddChildObjectsToTree(AObjectNode: TFlyNode; AObject: TSCSCatalog; ALevel: Integer); var ChildCatalogs: TSCSCatalogs; ChildCatalog: TSCSCatalog; ChildCatalogNode: TFlyNode; i: Integer; begin ChildCatalogs := TSCSCatalogs.Create(false); TF_Main(GForm).LoadCatalogs(AObject.ID, ALevel, ChildCatalogs, qmMemory); for i := 0 to ChildCatalogs.Count - 1 do begin ChildCatalog := ChildCatalogs[i]; if (ChildCatalog.ItemType = itList) or (ChildCatalog.ItemType = itDir) then begin ChildCatalogNode := AddObjectToTree(AObjectNode, ChildCatalog); AddChildObjectsToTree(ChildCatalogNode, ChildCatalog, ALevel+1); end; end; FreeAndNil(ChildCatalogs); end; begin FReportUseKind := AReportUseKind; // Form Caption if (rkProject in AReportUseKind) or //24.02.2011 (rkCalc in AReportUseKind) IsSimpleReportKind(AReportUseKind) then begin Caption := cResourceReport_Msg28; tvReports.Columns[rciStamp].Visible := true; btExportTemplateToFile.Style := ComCtrls.tbsDropDown; btEditTemplate.Style := ComCtrls.tbsDropDown; btDelTemplate.Style := ComCtrls.tbsDropDown; pmnuiExportTemplates.Visible := true; pmnuiEdit.Visible := true; pmnuiDel.Visible := true; Act_ExportTemplateToFile.Visible := false; Act_EditTemplate.Visible := false; Act_DeleteTemplate.Visible := false; Act_EditReportSortInfo.Visible := true; Act_NewSimpleTemplateFromStandart.Visible := true; Act_NewSimpleTemplateFromUser.Visible := true; Act_NewStampTemplateFromStandart.Visible := true; Act_NewStampTemplateFromUser.Visible := true; Act_ExportSimpleTemplateToFile.Visible := true; Act_ExportStampTemplateToFile.Visible := true; Act_EditSimpleTemplate.Visible := true; Act_EditStampTemplate.Visible := true; Act_DeleteSimpleTemplate.Visible := true; Act_DeleteStampTemplate.Visible := true; Act_NewMarkPage.Visible := false; Act_NewMarkPageFromUser.Visible := false; //pmnuiImportTemplate.MenuIndex := pmnuiNewTemplate.MenuIndex + 1; if rkCablePath in AReportUseKind then pcRepParams.ActivePage := tsCablePathParams else pcRepParams.ActivePage := tsProjRepParams; FcbCanHaveActiveComponentsCurr := cbCanHaveActiveComponents; FcbCanHaveDismountAccountCurr := cbCanHaveDismountAccount; //tvReports.Options := tvReports.Options - [goRowSizing]; //tvReports.WordWrap := false; //tvReports.FitToHeight := false; //tvReports.WordWrap := false; end else if rkMarkPages in AReportUseKind then begin Caption := cResourceReport_Msg29; tvReports.Columns[rciStamp].Visible := false; btExportTemplateToFile.Style := tbsButton; btEditTemplate.Style := tbsButton; btDelTemplate.Style := tbsButton; pmnuiExportTemplates.Visible := false; pmnuiEdit.Visible := false; pmnuiDel.Visible := false; Act_ExportTemplateToFile.Visible := true; Act_EditTemplate.Visible := true; Act_DeleteTemplate.Visible := true; Act_EditReportSortInfo.Visible := false; Act_NewSimpleTemplateFromStandart.Visible := false; Act_NewSimpleTemplateFromUser.Visible := false; Act_NewStampTemplateFromStandart.Visible := false; Act_NewStampTemplateFromUser.Visible := false; Act_ExportSimpleTemplateToFile.Visible := false; Act_ExportStampTemplateToFile.Visible := false; Act_EditSimpleTemplate.Visible := false; Act_EditStampTemplate.Visible := false; Act_DeleteSimpleTemplate.Visible := false; Act_DeleteStampTemplate.Visible := false; Act_NewMarkPage.Visible := true; Act_NewMarkPageFromUser.Visible := true; //pmnuiImportTemplate.MenuIndex := pmnuiExportTemplate.MenuIndex - 1; pcRepParams.ActivePage := tsMarkPagesParams; FcbCanHaveActiveComponentsCurr := cbCanHaveActiveComponentsMarkPages; FcbCanHaveDismountAccountCurr := cbCanHaveDismountAccountMarkPages; //tvReports.Options := tvReports.Options + [goRowSizing]; //tvReports.WordWrap := true; //tvReports.FitToHeight := true; //tvReports.WordWrap := true; end; rbModeView.Checked := true; FReportCaption := ''; CanReport := true; if (rkProject in AReportUseKind) or (rkMarkPages in AReportUseKind) then begin //*** Нати более подходящий объект для отчета, в зависисмости, где выделение в МП SelItemType := -1; SelObjectID := -1; with TF_Main(GForm) do begin SelItemType := itProject; SelObjectID := GSCSBase.CurrProject.ID; ProjManNode := nil; ProjManNode := GetParentNodeByItemType(Tree_Catalog.Selected, [itList]); ProjManNodeDat := nil; if ProjManNode <> nil then ProjManNodeDat := ProjManNode.Data; if ProjManNodeDat <> nil then if ProjManNodeDat.ItemType = itList then begin SelItemType := ProjManNodeDat.ItemType; SelObjectID := ProjManNodeDat.ObjectID; end; end; CanReport := false; //ClearTreeView(tvReportTarget); tvReportTarget.Items.Clear; with F_ProjMan do if Assigned(GSCSBase) then if Assigned(GSCSBase.CurrProject) then if GSCSBase.CurrProject.Active then begin ProjectNode := tvReportTarget.Items.Add(nil, GSCSBase.CurrProject.GetNameForVisible(false)); ProjectNode.ImageIndex := tciiProject; ProjectNode.SelectedIndex := ProjectNode.ImageIndex; ProjectNode.Data := GSCSBase.CurrProject; ProjectNode.Cells[tciCAD] := bsGray; ProjectNode.Cells[tciReport] := bsTrue; NodeToSelect := ProjectNode; {RepObjects := GetChildCatalogsInPlacingOrder(GSCSBase.CurrProject, [itDir, itList]); for i := 0 to RepObjects.Count - 1 do begin SCSObject := RepObjects[i]; //GSCSBase.CurrProject.ProjectLists[i]; ListNode := tvReportTarget.Items.AddChild(ProjectNode, SCSObject.GetNameForVisible(false)); ListNode.ImageIndex := tciiList; ListNode.SelectedIndex := ListNode.ImageIndex; ListNode.Data := SCSObject; ListNode.Cells[tciCAD] := bsTrue; SCSList := nil; if SCSObject is TSCSList then SCSList := TSCSList(SCSObject); if Assigned(SCSList) //and CheckListNormalType(SCSList.CurrID) then begin SCSList.IsNormalType := CheckListNormalType(SCSList.CurrID); if Not SCSList.IsNormalType then ListNode.Cells[tciReport] := bsGray; //ListNode.Hidden := SCSList.IsNormalType; end; if (SCSObject.ItemType = SelItemType) and (SCSObject.ID = SelObjectID) then NodeToSelect := ListNode; end; FreeAndNil(RepObjects);} AddChildObjectsToTree(ProjectNode, GSCSBase.CurrProject, 0); ProjectNode.Expanded := true; tvReportTarget.Selected := NodeToSelect; CanReport := true; // Tolik // типы сетей NetTypeCount := F_ProjMan.GSCSBase.CurrProject.Spravochnik.NetTypes.Count; NetTypeGuidList.Clear; NetTypeGuidListSelected.Clear; NetTypeTree.Items.Clear; INeedNormsRecources := False; RootNode := NetTypeTree.Items.Add( nil, cexdAll); if NetTypeCount > 0 then begin for i := 0 to NetTypeCount - 1 do begin Node := NetTypeTree.Items.AddChild(RootNode, TNBNetType(F_ProjMan.GSCSBase.CurrProject.Spravochnik.NetTypes[i]).Name); NetTypeGuidList.Add(TNBNetType(F_ProjMan.GSCSBase.CurrProject.Spravochnik.NetTypes[i]).GUID); end; end; NetTypeTree.DropTarget := RootNode; NetTypeTree.DropTarget.Expand(false); // чекаем все типы сетей по умолчанию if NetTypeTree.Items.Count > 1 then begin for i := 0 to NetTypeTree.Items.Count - 1 do begin Node := NetTypeTree.Items[i]; if Node.AbsoluteIndex <> 0 then NetTypeTree.Itemstate[Node.AbsoluteIndex] := csChecked; end; end else begin if NetTypeTree.Items.Count = 1 then NetTypeTree.Itemstate[0] := csChecked; end; end; end; gbTarget.Visible := (rkProject in AReportUseKind) or (rkMarkPages in AReportUseKind); splitTarget.Visible := gbTarget.Visible; //gbParams.Enabled := (rkProject in AReportUseKind); gbParams.Enabled := (rkProject in AReportUseKind) or (rkMarkPages in AReportUseKind) or (rkCablePath in AReportUseKind) or (rkCrossConnection in AReportUseKind); nePricePrecision.IntValue := GSCSIni.PM.RepPricePrecision; neKolvoPrecision.IntValue := GSCSIni.PM.RepKolvoPrecision; if CanReport then begin // Определить шаблоны отчетов DefineRepTemplates; // Подгрузить инфу для сортировки данных в отчетах if Not (rkMarkPages in AReportUseKind) then DefineRepSortInfo; DefineReportModeControls; // Настроить видимость отчетов tvReports.OnSelectedChanged := nil; try for i := 0 to tvReports.Items.Count - 1 do begin ReportNode := tvReports.Items[i]; if TReportItemParams(ReportNode.Data).ReportUseKind in AReportUseKind then begin ReportNode.Show(false); // Если отчет отмечен и без шаблона, то снять отметку if ReportNode.Cells[rciIsOn] = bsTrue then if TReportItemParams(ReportNode.Data).FSimpleShablons.FActiveShablonID = -1 then ReportNode.Cells[rciIsOn] := bsFalse; end else ReportNode.Hide; {$IF Defined(NORMSCS_PE) or Defined(SCS_SPA)} case TReportItemParams(ReportNode.Data).RepType of rtNorms: ReportNode.Hide; end; {$IFEND} {$IF Defined(SCS_PE) or Defined(SCS_PANDUIT) or Defined(SCS_SPA)} case TReportItemParams(ReportNode.Data).RepType of rtHouse, rtDefectAct: ReportNode.Hide; end; {$IFEND} end; finally tvReports.OnSelectedChanged := tvReportsSelectedChanged; end; DefineReportNodeControls(tvReports.Selected, true); if AShow then ShowModal else Act_ShowWizardReport.Execute; end else ShowMessageByType(Self.Handle, smtDisplay, cResourceReport_Msg3, Application.Title, MB_OK or MB_ICONINFORMATION); end; procedure TF_ResourceReport.ShowPreparedReport(AParams: TReportItemParams); var ReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; TemplateType: Integer; ReportFileName: String; ReportFilePath: String; IsTemplate: Boolean; begin ReportFileName := ''; ReportFilePath := ''; //*** Определить шаблон отчета ReportItemParams := nil; //if tvReports.Selected <> nil then // ReportItemParams := TReportItemParams(tvReports.Selected.Data); ReportItemParams := AParams; IsTemplate := false; if ReportItemParams <> nil then begin //*** Опреелить текущий тип шаблона TemplateType := ttSimple; if cbReportWithStamp.Enabled and cbReportWithStamp.Checked then TemplateType := ttStamp; //*** Определить параметры текщего шаблона CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(TemplateType); // Tolik 03/10/2020 -- вот тут проебчик... при пакетной печати галочки можно поставить как угодно... // а у некоторых отчетов просто нет шаблона для отчета со штампом... // тогда программа возьмет вместо текущего шаблона отчета -- стандартный, что не есть гут... if CurrReportShablons.FRepShablons.Count = 0 then begin if (rbModePacketPrint.Checked or rbModePacketPrintToExcel.Checked) then if TemplateType = ttStamp then begin TemplateType := ttSimple; CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(TemplateType); end; end; // //*** Если шаблон не стандартный, то извлеч его в файл if (CurrReportShablons <> nil) and (CurrReportShablons.FActiveShablonID > 0) then begin IsTemplate := true; ReportFileName := GetReportFileNameByType(ReportItemParams.RepType, TemplateType, false); //showmessage(ReportFileName); if ReportFileName <> '' then ReportFilePath := GetPathToUserReportFile(ReportFileName); if ReportFilePath <> '' then begin if FileExists(ReportFilePath) then if Not DeleteFile(ReportFilePath) then ReportFilePath := GetNoExistsFileNameForCopy(ReportFilePath); if ReportFilePath <> '' then TF_Main(GForm).DM.SaveUserReportByIDToFile(CurrReportShablons.FActiveShablonID, ReportFilePath); end; end; end; //ShowReport(GFormMode, ReportFilePath, pdScreen); ShowReportFromFile(GFormMode, AParams, ReportFilePath, FPrintDevice, IsTemplate, meNone); end; procedure TF_ResourceReport.ShowReportByParams(AFolder: TSCSCatalog; AParams: TReportItemParams); var CanHaveActiveComponents: Boolean; CanHaveZeroPriceComponents: Boolean; CanHaveDismountAccount: Boolean; ComponsWithZeroPrice: Boolean; CanRoundValue: Boolean; CanHaveSupplyValue: Boolean; CanShowKabinet : Boolean; //ShowHeightOfPlacing: Boolean; // Tolik 06/03/2018 -- GroupByHeightOfPlacing: Boolean; // Tolik 06/03/2018 - CanShowObjHierarchy : Boolean; CanGroupByName : Boolean; CanShowResources : Boolean; CanShowworks : Boolean; FormMode: TResourceReportFormMode; FullPathInCableJournal: Boolean; CurrReportItemParamValues: TReportItemParams; TestRep: Boolean; begin //Tolik 15/02/2022-- try if AFolder is TSCSProject then TSCSProject(AFolder).NotifyBeforeReport; except on E: Exception do; end; CanHaveActiveComponents := FcbCanHaveActiveComponentsCurr.Checked; //ptrReportItemParams^.CanHaveActiveComponents = biTrue; CanHaveZeroPriceComponents := cbCanHaveZeroPriceComponents.Checked; //ptrReportItemParams^.CanHaveZeroPriceComponents = biTrue; CanHaveDismountAccount := FcbCanHaveDismountAccountCurr.Checked; ComponsWithZeroPrice := cbCanHaveZeroPriceComponents.Checked; CanRoundValue := cbCanRoundValue.Checked; CanHaveSupplyValue := cbCanHaveSupplyValue.Checked; // added by Tolik CanShowKabinet := (cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled); CanShowObjHierarchy :=(cbCanShowObjHierarchy.Checked and cbCanShowObjHierarchy.Enabled); CanGroupByName := (cbCanGroupByName.Checked and cbCanGroupByName.Enabled); CanShowResources := cbCanShowResources.Checked; CanShowWorks := cbCanShowWorks.Checked; //ShowHeightOfPlacing := cbShowHeightOfPlacing.Checked; GroupByHeightOfPlacing := cbGroupByHeightOfPlacing.Checked; ///////// CurrReportItemParamValues := GetCurrReportItemParamValues; if (AParams <> nil) and (Assigned(AFolder) or //24.02.2011 (rkCalc in FReportUseKind) IsSimpleReportKind(FReportUseKind)) then begin FormMode := AParams.Mode; FullPathInCableJournal := cbFullPathInCableJournal.Checked; //ptrReportItemParams.FullPathInCableJournal = biTrue; case AParams.Mode of fmRResources: if rbRepModeDocument.Checked then ShowFolderResourceReport(AFolder, AParams, CanHaveActiveComponents, CanHaveDismountAccount, ComponsWithZeroPrice, CanRoundValue, CanHaveSupplyValue) else if rbRepModeForm.Checked then begin TF_Main(GForm).CreateFReportForm; TF_Main(GForm).F_ReportForm.Execute(AFolder, FReportCaption, AParams.Mode, true, true, true); end; fmRCable, fmRCableExceedLength, fmRCableCanal: ShowFolderCableReport(AFolder, AParams , AParams.Mode, CanHaveActiveComponents, CanHaveDismountAccount, CurrReportItemParamValues); //fmRDisparityComponColor, fmRDisparityComponProducer: //ShowFolderDisparityComponReport(SCSCatalog, ptrReportItemParams.Mode); fmRCableJournal: begin ShowFolderCableJournal(AFolder, AParams, FormMode, CanHaveActiveComponents, CanHaveDismountAccount, FullPathInCableJournal); end; fmRCableJournalExt: ShowFolderCableJournalExt(AFolder, AParams, CanHaveActiveComponents, CanHaveDismountAccount, FullPathInCableJournal); fmRGOSTCableJournal: ShowFolderCableJournal(AFolder, AParams, FormMode, CanHaveActiveComponents, CanHaveDismountAccount, false); fmRSpecification, fmRGOSTSpecification: begin if FormMode = fmRGOSTSpecification then if rbPageSizeA3.Checked then FormMode := fmRGOSTSpecificationA3 else if rbPageSizeA4.Checked then FormMode := fmRGOSTSpecification; ShowFolderSpecificationReport(AFolder, AParams, CurrReportItemParamValues, FormMode, CanHaveActiveComponents, CanHaveZeroPriceComponents, CanHaveDismountAccount, CanRoundValue, CanHaveSupplyValue); end; //fmRTypeComponents: //ShowFolderTypeComponenetsReport(SCSCatalog); fmRNorms: ShowFolderNormReport(AFolder, AParams, CanHaveActiveComponents); fmRExplanatoryReport: ShowFolderExplanatoryReport(AFolder, AParams); fmRLegendObjectIcons: ShowFolderLegendObjectIcons(AFolder, AParams, CanHaveActiveComponents); fmRExplicationRoom: ShowExplicationRoom(AFolder, AParams, CurrReportItemParamValues); fmRExplicationComponent: begin // Добавлены параметры отчета (флаги для пересчета стоимости компонент и вывода иерархии объектов) Tolik TestRep := False; if TestRep then ShowExplicationComponentOLD(AFolder, AParams, CurrReportItemParamValues) else ShowExplicationComponent(AFolder, AParams, CurrReportItemParamValues,CanHaveActiveComponents, CanHaveDismountAccount, ComponsWithZeroPrice,CanRoundValue, CanHaveSupplyValue, CanShowKabinet, CanShowObjHierarchy, CanGroupByName, {ShowHeightOfPlacing,} GroupByHeightOfPlacing); end; fmRCrossJournal, fmRGOSTCrossJournal: ShowCrossJournal(AFolder, AParams, CurrReportItemParamValues, AParams.Mode); fmCommerceInvoice: ShowCommerceInvoice(AFolder, AParams, CurrReportItemParamValues); fmRHouse: ShowHouse(AFolder, AParams, CurrReportItemParamValues); fmRDefectAct: ShowDefectAct(AFolder, AParams, CurrReportItemParamValues, AParams.Mode); fmRPriorCostOfProject: ShowPriorCostOfProjectReport(AParams); fmCompoSpecification: ShowComponSpecifications(AFolder, AParams, CurrReportItemParamValues); fmRCablePaths: ShowCablePaths(AParams); fmRCrossConnection: ShowCrossConnection(AParams); fmRMarkRoomTS, fmRMarkPathPanel, fmRMarkPathPanelPorts, fmRMarkSocket, fmRMarkSocketPanel, fmRMarkCable: ShowMarkPages(AFolder, AParams, AParams.Mode, CurrReportItemParamValues); fmPortReport: ShowPortConnections(AParams); end; end; FreeAndNil(CurrReportItemParamValues); end; function TF_ResourceReport.ShowReportFromFile(AReportMode: TResourceReportFormMode; AParams: TReportItemParams; AReportFile: String; APrintDevice: TPrintDevice; AIsTemplate: Boolean; AMakeEditTemplate: TMakeEdit): Boolean; var SCSDir: String; ReportFile: String; DocName: String; i: Integer; //frOLEExcelExport: TMyfrOleExl; frExport: TfrBasicExpFilter; ProgressCaption: String; ExtensionName: String; begin Result := false; try frExport := nil; ReportFile := ''; if (AReportFile <> '') and FileExists(AReportFile) then ReportFile := AReportFile else begin {$if Defined(ES_GRAPH_SC)} SCSDir := ExeDir + '\'; {$else} SCSDir := ExtractFilePath(paramstr(0)); {$ifend} ReportFile := GetReportFileNameByType(AParams.RepType, GetTemplateTypeByCurrOptions, rbPageSizeA3.Checked); ReportFile := SCSDir + dnReports + '\'+ReportFile; end; if FileExists(ReportFile) then begin frDBDataSet_Detail.DataSource := nil; case GFormMode of //added by Tolik fmWACoordinates: FReportCaption := cResourceReport_Msg1_29; fmRResources: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnReportResources //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPResources; frDBDataSet_Master.DataSource := DataSource_MT_RResources; end; fmRCable: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnReportCable //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPCable; frDBDataSet_Master.DataSource := DataSource_MT_RCable; end; fmRCableExceedLength: begin //29.01.2009 ReportFile := ReportFile + fnReportCableExceedLength; frDBDataSet_Master.DataSource := DataSource_MT_RCable; end; fmRCableCanal: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnReportCableCanal //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPCableCanal; frDBDataSet_Master.DataSource := FdsrcCableChannelGrp; //DataSource_MT_RCableGroup; frDBDataSet_Detail.DataSource := FdsrcCableChannel; //DataSource_MT_RCable; end; fmRDisparityComponColor: begin //29.01.2009 ReportFile := ReportFile + fnReportDisparityComponColor; frDBDataSet_Master.DataSource := DataSource_MT_RDisparityCompColor; end; fmRDisparityComponProducer: begin //29.01.2009 ReportFile := ReportFile + fnRDisparityComponProducer; frDBDataSet_Master.DataSource := DataSource_MT_RDisparityCompColor; end; fmRCableJournal: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRCableJournal //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPCableJournal; frDBDataSet_Master.DataSource := DataSource_MT_RCableJournal; end; fmRCableJournalExt: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRCableJournalExt //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPCableJournalExt; frDBDataSet_Master.DataSource := DataSource_MT_RCableJournalExt; frDBDataSet_Detail.DataSource := dsrcRCableJournalInterfaces; end; fmRGOSTCableJournal: begin //29.01.2009 ReportFile := ReportFile + fnRGOSTCableJournal; frDBDataSet_Master.DataSource := DataSource_MT_RCableJournal; end; fmRTypeComponents: begin //29.01.2009 ReportFile := ReportFile + fnRTypeComponents; frDBDataSet_Master.DataSource := DataSource_MT_RTypeComponents; frDBDataSet_Detail.DataSource := DataSource_MT_RTypeComponentsDetail; end; fmRSpecification, fmRGOSTSpecification, fmRGOSTSpecificationA3: begin //29.01.2009 if GFormMode = fmRSpecification then //29.01.2009 ReportFile := ReportFile + fnRSpecification; //29.01.2009 if GFormMode = fmRGOSTSpecification then //29.01.2009 ReportFile := ReportFile + fnRGOSTSpecification; //29.01.2009 if GFormMode = fmRGOSTSpecificationA3 then //29.01.2009 ReportFile := ReportFile + fnRGOSTSpecificationA3; //29.01.2009 if ReportFile <> '' then begin frDBDataSet_Master.DataSource := DataSource_MT_RSpecifTypeCompon; frDBDataSet_Detail.DataSource := DataSource_MT_RSpecification; end; end; fmRNorms: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRNorms //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPNorms; frDBDataSet_Master.DataSource := DataSource_MT_RNorms; end; fmRExplanatoryReport: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRExplanatoryReport //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPExplanatoryReport; frDBDataSet_Master.DataSource := dsrcExplanatoryProj; frDBDataSet_Detail.DataSource := dsrcExplanatoryList; end; fmRLegendObjectIcons: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRLegendObjectIcons //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPLegendObjectIcons; frDBDataSet_Master.DataSource := dsrcRLegendObjectIcons; end; fmRExplicationRoom: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRExplicationRoom //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPExplicationRoom; frDBDataSet_Master.DataSource := FdsrcExplicationRoom; //dsrcReport; frDBDataSet_Detail.DataSource := FdsrcExplicationRoomDetail; //dsrcReportDetail; end; fmRExplicationComponent: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRExplicationComponent //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPExplicationComponent; frDBDataSet_Master.DataSource := FdsrcExplicationCompon; //dsrcReport; frDBDataSet_Detail.DataSource := FdsrcExplicationComponDetail; //dsrcReportDetail; frDBDataSet_SubDetail.DataSource := FdsrcExplicationComponSubDetail; //dsrcReportSubDetail; end; fmRCrossJournal, fmRGOSTCrossJournal: begin //29.01.2009 if GFormMode = fmRCrossJournal then //29.01.2009 ReportFile := ReportFile + fnRCrossJournal //29.01.2009 else //29.01.2009 if GFormMode = fmRGOSTCrossJournal then //29.01.2009 ReportFile := ReportFile + fnRGOSTCrossJournal; frDBDataSet_Master.DataSource := FdsrcCrossJournal; //dsrcReport; end; fmCommerceInvoice: begin frDBDataSet_Master.DataSource := FdsrcCommerceInvoice; frDBDataSet1.DataSource := DataSource_MT_RNorms; frDBDataSet2.DataSource := DataSource_MT_RResources; end; fmRCablePaths: begin frDBDataSet_Master.DataSource := FdsrcCablePaths; frDBDataSet_Detail.DataSource := FdsrcCablePathsInfo; end; fmRCrossConnection: frDBDataSet_Master.DataSource := FdsrcCrossConnection; fmRHouse: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRHouse //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPHouse; frDBDataSet_Master.DataSource := FdsrcHouse; frDBDataSet_Detail.DataSource := FdsrcApproach; end; fmRDefectAct: begin //29.01.2009 if Not cbReportWithStamp.Checked then //29.01.2009 ReportFile := ReportFile + fnRDefectAct //29.01.2009 else //29.01.2009 ReportFile := ReportFile + fnRSTAMPDefectAct; frDBDataSet_Master.DataSource := FdsrcDefectAct; end; fmRPriorCostOfProject: begin //29.01.2009 ReportFile := ReportFile + fnRPriorCostOfProject; frDBDataSet_Master.DataSource := dsrcReport; frDBDataSet_MasterFirst.DataSource := dsrcReportFirst; end; fmRMarkRoomTS, fmRMarkPathPanel, fmRMarkPathPanelPorts, fmRMarkSocket, fmRMarkSocketPanel, fmRMarkCable: begin //frDBDataSet_Master.DataSource := dsrcReport; case GFormMode of fmRMarkRoomTS: frDBDataSet_Master.DataSource := FdsrcMarkRoomTS; fmRMarkPathPanel: frDBDataSet_Master.DataSource := FdsrcMarkPathPanel; fmRMarkPathPanelPorts: frDBDataSet_Master.DataSource := FdsrcMarkPathPanelPorts; fmRMarkSocket: frDBDataSet_Master.DataSource := FdsrcMarkSocket; fmRMarkSocketPanel: frDBDataSet_Master.DataSource := FdsrcMarkSocketPanel; fmRMarkCable: frDBDataSet_Master.DataSource := FdsrcMarkCable; end; end; fmPortReport: begin frDBDataSet_Master.DataSource := FdsrcPortReport; frDBDataSet_Detail.DataSource := FdsrcPortReportDetail; end; //else // Exit; //// EXIT //// end; frDBDataSet_MasterFirst.DataSource := dsrcReportFirst; end; //if (AReportFile <> '') and FileExists(AReportFile) then // ReportFile := AReportFile; if FileExists(ReportFile) then begin Application.ProcessMessages; FMasterOldRecNo := 0; FDetailOldRecNo := 0; FOldRecNo := 0; FCurrRecNo := 0; FPassNum := 1; FModifiedReportTemplate := false; DocName := FReportCaption; //DocName := ApplicationName + ' - ['+lvReports.Selected.Caption+']'; Report.Title := DocName; Report.LoadFromFile(ReportFile); CorrectReport(GFormMode); if (Not AIsTemplate) or (AMakeEditTemplate = meMake) then begin PrepareReportFormats; // Если идет создание шаблона, то сохранить в файл после коррекции разделителя запятой if AMakeEditTemplate = meMake then if ReportFile <> '' then Report.SaveToFile(ReportFile); end; //Report.Pages[0].ColWidth //Report.Preview.col if APrintDevice <> pdDesign then begin if ExtractFileName(Report.FileName)='RExplicationComponent.frf' then begin // if (cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled) then if (((cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled)) or (cbGroupByHeightOfPlacing.Checked and cbGroupByHeightOfPlacing.Enabled)) then begin if Report.Pages.Count > 1 then begin Report.CanRebuild := true; Report.Pages.Pages[0].Visible := false; Report.Pages.Pages[1].Visible := true; frDbDataset_master.First; end else begin ShowMessage(cMain_Mes142); end; end else begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[0].Visible := true; Report.Pages.Pages[1].Visible := false; end; end; end; // Tolik if ExtractFileName(Report.FileName)='RGOSTCableJournal.frf' then begin if Report.Pages.Count > 2 then begin if cbOldReportForm.Checked then begin Report.CanRebuild := true; Report.Pages.Pages[0].Visible := true; Report.Pages.Pages[1].Visible := true; Report.Pages.Pages[2].Visible := false; Report.Pages.Pages[3].Visible := false; end else begin Report.CanRebuild := true; Report.Pages.Pages[0].Visible := false; Report.Pages.Pages[1].Visible := false; Report.Pages.Pages[2].Visible := true; Report.Pages.Pages[3].Visible := true; end; end end; // if ExtractFileName(Report.FileName)='RSTAMPExplicationComponent.frf' then begin if (cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled) then begin if Report.Pages.Count > 2 then begin Report.CanRebuild := true; Report.Pages.Pages[0].Visible := true; Report.Pages.Pages[1].Visible := false; Report.Pages.Pages[2].Visible := true; frDbDataset_master.First; end else begin ShowMessage(cMain_Mes142); end; end else begin if Report.Pages.Count > 2 then begin Report.Pages.Pages[0].Visible := true; Report.Pages.Pages[1].Visible := true; Report.Pages.Pages[2].Visible := false; end; end; end; // added by Tolik if ExtractFileName(Report.FileName)='RCableJournal.frf' then begin if cbShowCablePath.Checked then begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[0].Visible := false; Report.Pages.Pages[1].Visible := true; end end else begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[1].Visible := false; Report.Pages.Pages[0].Visible := true; end end; // end; if ExtractFileName(Report.FileName)='RCableJournalExt.frf' then begin if cbShowCablePath.Checked then begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[0].Visible := false; Report.Pages.Pages[1].Visible := true; end end else begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[1].Visible := false; Report.Pages.Pages[0].Visible := true; end end; // end; if ExtractFileName(Report.FileName)='RCablePaths.frf' then begin if AParams.PageToShow = 0 then begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[0].Visible := True; Report.Pages.Pages[1].Visible := False; end end else begin if Report.Pages.Count > 1 then begin Report.Pages.Pages[1].Visible := True; Report.Pages.Pages[0].Visible := False; end end; // end; end; case APrintDevice of pdDesign: begin FModifiedReportTemplate := true; //RepDesigner.CloseQuery := false; Report.DesignReport; Result := FModifiedReportTemplate; end; pdScreen{, pdPrinter}: with TF_Main(GForm) do begin if FormList.Count + 1 > 5 then begin try F_Preview := TF_Preview(FormList.First); F_Preview.Free; FormList.Remove(FormList.First); except end; for i := 0 to FormList.Count-1 do begin F_Preview := TF_Preview(FormList.Items[i]); F_Preview.Caption := Copy(F_Preview.Caption, 0, pos('№', F_Preview.Caption)); F_Preview.Caption := F_Preview.Caption + IntToStr(i+1); end; end; F_Preview := TF_Preview.Create(Application, GForm); i := FormList.Add(F_Preview); Report.Preview := F_Preview.frPreview1; Report.ShowReport; if APrintDevice = pdPrinter then F_Preview.frPreview1.Print; //CurentReport := ReportKind; F_Preview.Caption := ConcatStrWithDefis(DocName, cResourceReport_Msg4 + IntToStr(i+1), 1); F_Preview.OnClose := {F_FR.}FormMdiClose; F_Preview.ReportFileName := {F_FR.}Report.FileName; F_Preview.ReportCaption := DocName; if Assigned(F_Preview.frPreview1.OnMouseDown) then EmptyProcedure; //Report.PrintPreparedReportDlg; case APrintDevice of pdScreen: begin //Screen.ActiveForm F_Preview.Show; //SetActiveWindow(F_Preview.Handle); //ShowWindow(F_Preview.Handle, SW_MINIMIZE); //ShowWindow(F_Preview.Handle, SW_RESTORE); //SetForegroundWindow(F_Preview.Handle); end; pdPrinter: F_Preview.Close; end; Result := true; end; pdExcel, pdExcel2007, pdWord2007, pdPdf: begin {if FReportCountPrinted = 0 then begin frOLEExcelExportStartExportPageEvent(nil, cResourceReport_Msg21, 1); TF_Main(GForm).F_ProgressExp.HideGauges; TF_Main(GForm).F_ProgressExp.Message1.Caption := cProgressExp_Msg5; TF_Main(GForm).F_ProgressExp.Message1.Visible := True; Application.ProcessMessages; end; Report.Preview := nil; Report.PrepareReport; if FfrOLEExcelExport = nil then begin FfrOLEExcelExport := TF_Main(GForm).F_ProgressExp.CreateMyfrOleExl; FfrOLEExcelExport.Caption := cResourceReport_Msg21; FfrOLEExcelExport.OnStartExportPageEvent := frOLEExcelExportStartExportPageEvent; FfrOLEExcelExport.OnProgressExportPageEvent := frOLEExcelExportProgressExportPageEvent; FfrOLEExcelExport.OnEndExportPageEvent := frOLEExcelExportEndExportPageEvent; end; try Report.ExportTo(FfrOLEExcelExport, GetNoExistsFileNameForCopy(FPackgeDir + FileNameCorrect(FReportCaption)+' ('+FObjectName+').'+enXls)); finally FreeAndNil(FfrOLEExcelExport); end;} ProgressCaption := ''; ExtensionName := ''; if APrintDevice = pdExcel then begin ProgressCaption := cResourceReport_Msg21; ExtensionName := enXls; end // Tolik 12/03/2020 -- else if APrintDevice = pdExcel2007 then begin ProgressCaption := cResourceReport_Msg21; ExtensionName := 'xlsx'; //TF_Main(GForm).F_ProgressExp.Hide; end else if APrintDevice = pdWord2007 then begin ProgressCaption := cResourceReport_Msg21; ExtensionName := 'docx'; //TF_Main(GForm).F_ProgressExp.Hide; end // else if APrintDevice = pdPdf then begin ProgressCaption := cResourceReport_Msg39; ExtensionName := enPdf; end; if FReportCountPrinted = 0 then begin frOLEExcelExportStartExportPageEvent(nil, ProgressCaption, 1); TF_Main(GForm).F_ProgressExp.HideGauges; TF_Main(GForm).F_ProgressExp.Message1.Caption := cProgressExp_Msg5; TF_Main(GForm).F_ProgressExp.Message1.Visible := True; Application.ProcessMessages; end; Report.Preview := nil; // Tolik 31/03/2020 -- сохранить видимость страниц шаблона проекта. PrepareReport -- сохранит проект в стрим // и поднимет из него же... ни при записи ни при чтении видимость страниц не учитывается и устанавливается при // подъеме со стрима по умолчанию в true.... что не есть хорошо, т.к. //для експорта в другие форматы -- уже не понятно, какие страницы отображать, а какие -- нет SaveRopPagesVisibility(Report); // Report.PrepareReport; if frExport = nil then begin if ((APrintDevice = pdExcel) or (APrintDevice = pdExcel2007) or (aPrintDevice = pdWord2007)) then frExport := TF_Main(GForm).F_ProgressExp.CreateMyfrOleExl else if APrintDevice = pdPdf then frExport := TfrPDFExport.Create(Self); frExport.FileCaption := ProgressCaption; frExport.Title := DocName; frExport.OnStartExportPageEvent := frOLEExcelExportStartExportPageEvent; frExport.OnProgressExportPageEvent := frOLEExcelExportProgressExportPageEvent; frExport.OnEndExportPageEvent := frOLEExcelExportEndExportPageEvent; end; try if APrintDevice = pdExcel2007 then begin //TF_Main(GForm).F_ProgressExp.Close; ExportReportToXLSX(GetNoExistsFileNameForCopy(FPackgeDir + FileNameCorrect(FReportCaption)+' ('+FObjectName+').'+ExtensionName), Report); end else if APrintDevice = pdWord2007 then begin //TF_Main(GForm).F_ProgressExp.Close; ExportReportToDocX(GetNoExistsFileNameForCopy(FPackgeDir + FileNameCorrect(FReportCaption)+' ('+FObjectName+').'+ExtensionName), Report); end else Report.ExportTo(frExport, GetNoExistsFileNameForCopy(FPackgeDir + FileNameCorrect(FReportCaption)+' ('+FObjectName+').'+ExtensionName)); finally FreeAndNil(frExport); end; end; pdPrinter: begin Report.Preview := nil; Report.PrepareReport; if FFrPrintForm = nil then Report.PrintPreparedReportDlg else begin Report.PrintPreparedReport('', StrToInt(FFrPrintForm.E1.Text), FFrPrintForm.CollateCB.Checked, TfrPrintPages(FFrPrintForm.CB2.ItemIndex)); end; end; end; //Report.ShowReport; end; except on E: Exception do begin AddExceptionToLog('TF_ResourceReport.ShowReport: '+E.Message); { if rbModePacketPrintToExcel.Checked then begin Inc(FReportCountPrinted); if (FReportCountPrinted = FReportCountToPrint) then begin if FReportCountPrinted = FReportCountToPrint then begin //*** Догнать до 100 for i := TF_Main(GForm).F_ProgressExp.gTotal.Progress + 1 to TF_Main(GForm).F_ProgressExp.gTotal.MaxValue do begin TF_Main(GForm).F_ProgressExp.gTotal.Progress := i; TF_Main(GForm).F_ProgressExp.gTotal.Refresh; Sleep(500); end; if TF_Main(GForm).F_ProgressExp.cbOpen.Checked then ShellExecute(Handle, nil, PChar(FPackgeDir), nil, nil, SW_SHOW); end; FReportCountPrinted := FReportCountToPrint; TF_Main(GForm).F_ProgressExp.Close; end; end;} IncPaketPrintCounter; end; end; end; function TF_ResourceReport.CheckCanShowReport(ACAtalog: TSCSCatalog): Boolean; begin Result := false; if CheckIsOpenProject(true) then if ACatalog.ItemType in [itProject, itList, itDir] then Result := true else ShowMessageByType(Self.Handle, smtDisplay, cResourceReport_Msg5+' "'+ACAtalog.Name+'"', Application.Title, MB_OK or MB_ICONINFORMATION); end; procedure TF_ResourceReport.InitRepMsgList; begin if FRepMsgList = nil then begin FRepMsgList := CreateStringListSorted; AddStrObjToStrings(FRepMsgList, 'COMMERCEINVOICE', cRepMsg193); AddStrObjToStrings(FRepMsgList, 'INVOICE_BUDGET', cRepMsg194); AddStrObjToStrings(FRepMsgList, 'INVOICE_CODE', cRepMsg195); AddStrObjToStrings(FRepMsgList, 'INVOICE_NAT', cRepMsg196); AddStrObjToStrings(FRepMsgList, 'INVOICE_UOM', cRepMsg197); AddStrObjToStrings(FRepMsgList, 'INVOICE_NAME', cRepMsg198); AddStrObjToStrings(FRepMsgList, 'INVOICE_QT', cRepMsg199); AddStrObjToStrings(FRepMsgList, 'INVOICE_PRICE', cRepMsg200); AddStrObjToStrings(FRepMsgList, 'INVOICE_COST', cRepMsg201); // Cable Paths AddStrObjToStrings(FRepMsgList, 'CABPATH_REPNAME', cRepMsg202); AddStrObjToStrings(FRepMsgList, 'CABPATH_NAME', cRepMsg203); AddStrObjToStrings(FRepMsgList, 'CABPATH_FOR', cRepMsg204); AddStrObjToStrings(FRepMsgList, 'CABPATH_CABLE', cRepMsg204); //Cross-connection AddStrObjToStrings(FRepMsgList, 'CROSSCONNECTION_REPNAME', cRepMsg205); AddStrObjToStrings(FRepMsgList, 'CROSSCONNECTION_WITH', cRepMsg206); //19.11.2013 Labor time AddStrObjToStrings(FRepMsgList, 'LABOR_TIME', cRepMsg207); AddStrObjToStrings(FRepMsgList, 'PRICE_PER_TIME_BEFORE', cRepMsg208_1); AddStrObjToStrings(FRepMsgList, 'PRICE_PER_TIME_AFTER', cRepMsg208_2); AddStrObjToStrings(FRepMsgList, 'TOTAL_LABOR_TIME', cRepMsg209); AddStrObjToStrings(FRepMsgList, 'VOLUME_QTY', cRepMsg210); AddStrObjToStrings(FRepMsgList, 'TOTALCOSTTAX', cRepMsg211); end; end; // ##### Показывает отчет ведомости объектов Листа ##### procedure TF_ResourceReport.ShowListObjectReport(AIDComponList: Integer); (* var ListSCSObjects: TList; ptrSCSObject: PSCSCatalog; SCSList: TSCSCatalog; ptrSCSNorm: PSCSNorm; ptrSCSComponent: PSCSComponent; ptrSCSComplect: PSCSComponent; i, j, k, l: Integer; ListWorkCost: Double; ComponCount: integer; ObjectLength: Double; procedure ResourcesWrite(ACompon: PSCSComponent; AIsCompon: Boolean; APref: Integer); var i, j: integer; ptrSCSNorm: PSCSNorm; // ptrResource: PResource; begin (* if AIsCompon then RepComponWrite(ACompon.Name, AIsCompon, ACompon.TotalCost, APref) else RepComponWrite(ACompon.Name, AIsCompon, ACompon.ResourcesCost, APref); RepResourcesWrite(ACompon.ResourcesCost {- ACompon.PRICE_CALC + ACompon.PRICE}, APref + 4); for i := 0 to ACompon.Norms.Count - 1 do begin ptrSCSNorm := ACompon.Norms.Items[i]; if ptrSCSNorm.IsOn = biTrue then for j := 0 to ptrSCSNorm.Resources.Count - 1 do begin ptrResource := ptrSCSNorm.Resources.Items[j]; if ptrResource.IsOn = biTrue then RepResourceWrite(ptrResource.Name, ptrSCSNorm.Kolvo * ptrResource.Cost, APref + Round(APref / 3) + 4); end; end; if ACompon.Norms.Count > 0 then RepResourceWrite(ACompon.Name , ACompon.Price * TSCSNorm(ACompon.Norms[0]^).Kolvo, APref + Round(APref / 3) + 4); end; *) begin (*if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// try try with TF_Main(GForm).DM do begin SCSList := TSCSCatalog.Create(GForm); SCSList.LoadCatalogByID(AIDComponList, false); //*** Отобрать все объекты Листа SetSQLToQuery(scsQSelect, ' select id from katalog '+ ' where (parent_id = '''+IntToStr(AIDComponList)+''') and (( id_item_type = '''+IntToStr(itSCSLine)+''') or ( id_item_type = '''+IntToStr(itSCSConnector)+''') ) '); ListSCSObjects := TList.Create; //*** Загрузка объектов в список while Not scsQSelect.Eof do begin New(ptrSCSObject); ptrSCSObject^ := TSCSCatalog.Create(GForm); ptrSCSObject.ID := scsQSelect.FN('id').AsInteger; ptrSCSObject.ItemType := itList; ListSCSObjects.Add(ptrSCSObject); scsQSelect.Next; end; //*** Загрузить компоненты объектов ListWorkCost := 0; ComponCount := 0; for i := 0 to ListSCSObjects.Count - 1 do begin ObjectLength := 0; ptrSCSObject := ListSCSObjects.Items[i]; //*** Загрузить Объект ptrSCSObject.LoadCatalogByID(ptrSCSObject.ID, true, false); if ptrSCSObject.ItemType = itSCSLine then ObjectLength := TF_Main(GForm).GetPropertyValueAsFloat(tkCatalog, ptrSCSObject.ID, pnLength, -1); //*** Загрузить Компоненты для этого объекта for j := 0 to ptrSCSObject.SCSComponents.Count - 1 do begin ptrSCSComponent := ptrSCSObject.SCSComponents.Items[j]; if ptrSCSComponent.IsLine = bitrue then ptrSCSComponent.Length := ObjectLength; //*** Загрузить Нормы для компоненты и посчитать // стоимость компоненты, ее комплектующих, и ресурсов ptrSCSComponent.NormsResources.CalcResourcesCost(true, true); //*** Загрузить все Комплектующие c нормами этой компоненты ptrSCSComponent.LoadAllSCSComplects(cdNorms or cdCalcResCost); ptrSCSComponent.AddToTotalCostComplResourcesCost; end; ptrSCSObject.CalcResourcesCost(false, false, false); ListWorkCost := ListWorkCost + ptrSCSObject.ResourcesCost; ComponCount := ComponCount + ptrSCSObject.SCSComponents.Count; end; //*** Формирование отчета RichEdit_Report.Lines.Clear; //*** Вывести Лист RepListWrite(SCSList.Name, ListSCSObjects.Count, ComponCount, ListWorkCost); for i := 0 to ListSCSObjects.Count - 1 do begin ptrSCSObject := ListSCSObjects.Items[i]; //*** Вывести Объекты RepObjWrite(ptrSCSObject.Name, ptrSCSObject.ItemType, ptrSCSObject.SCSComponents.Count, ptrSCSObject.ResourcesCost); for j := 0 to ptrSCSObject.SCSComponents.Count - 1 do begin ptrSCSComponent := ptrSCSObject.SCSComponents.Items[j]; //*** Вывести компоненты //RepComponWrite(ptrSCSComponent.Name, true, ptrSCSComponent.TotalCost, 11); //ResourcesWrite(ptrSCSComponent, 15); ResourcesWrite(ptrSCSComponent, true, 11); //*** Вывести комплектующие //RepComplectsWrite(ptrSCSComponent.PriceComponWithComplects - ptrSCSComponent.Price); RepComplectsWrite(ptrSCSComponent.ComplResourcesCost); for k := 0 to ptrSCSComponent.AllSCSComplects.Count - 1 do begin ptrSCSComplect := ptrSCSComponent.AllSCSComplects.Items[k]; ResourcesWrite(ptrSCSComplect, false, 19); end; {RepResourcesWrite(ptrSCSComponent.ResourcesCost, 15); for k := 0 to ptrSCSComponent.Norms.Count - 1 do begin ptrSCSNorm := ptrSCSComponent.Norms.Items[k]; if ptrSCSNorm.IsOn = biTrue then for l := 0 to ptrSCSNorm.Resources.Count - 1 do begin ptrResource := ptrSCSNorm.Resources.Items[l]; if ptrResource.IsOn = biTrue then RepResourceWrite(ptrResource.Name, ptrResource.Cost, 19); end; end; RepResourceWrite(ptrSCSComponent.Name , ptrSCSComponent.Price, 19); } end; end; Caption := 'Ведомость объектов'; GFormMode := fmRObject; ShowModal; end; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; finally if ListSCSObjects <> nil then begin //FreeAndNil(SCSList); //SCSList.Destroy; SCSList.Free; for i := 0 to ListSCSObjects.Count - 1 do begin ptrSCSObject := ListSCSObjects.Items[i]; ptrSCSObject^.Free; //ptrSCSObject^.Free; end; FreeList(ListSCSObjects); end; end; *) end; // Ведомость ресурсов procedure TF_ResourceReport.ShowFolderResourceReport(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue: Boolean); var NormResources: TSCSNormsResources; i,j : Integer; ResourceRel: TSCSResourceRel; ResourceCompon: TSCSComponent; SprSuppliesKind: TNBSuppliesKind; ProjectOwner: TSCSProject; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // TotalCost: Double; // Added by Tolik CableTypes : TCableTypeArray; CableIdsList : TIntList; SCSComponent : TSCSComponent; CableTypeFound : boolean; {const CmpDelta = 0.001; var //Folder: TSCSCatalog; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; PartComponent: TSCSComponent; LookedResources: TSCSResources; GroupList: TList; GroupListFromNorm: TList; GroupResource: TSCSResourceRel; GroupComponentsList: TSCSComponents; LookedComponents: TSCSComponents; i, j, k: Integer; TotalCost: Double;} { procedure AddComponentToGroup(AComponent: TSCSComponent); var GrComponent: TSCSComponent; i: Integer; ExistsGroup: Boolean; begin GrComponent := nil; if Assigned(AComponent) then if LookedComponents.IndexOf(AComponent) = -1 then if AComponent.Price > 0 then begin ExistsGroup := false; for i := 0 to GroupComponentsList.Count - 1 do begin GrComponent := GroupComponentsList[i]; if (GrComponent.GuidNB = AComponent.GuidNB) and (Abs(GrComponent.Price - AComponent.Price) < CmpDelta) then begin if GrComponent.IsLine = biFalse then GrComponent.Length := GrComponent.Length + 1 else GrComponent.Length := GrComponent.Length + AComponent.Length; ExistsGroup := true; end; end; if Not ExistsGroup then begin GrComponent := TSCSComponent.Create(GForm); GrComponent.AssignOnlyComponent(AComponent); if GrComponent.isLine = biFalse then GrComponent.Length := 1 else GrComponent.Length := AComponent.Length; GroupComponentsList.Add(GrComponent); end; end; end; procedure AddResourceToGroup(AResourceRel: TSCSResourceRel; AGroupList: Tlist); var GrResource: TSCSResourceRel; ExistsGroup: Boolean; i: integer; begin if (AResourceRel = nil) or (AGroupList = nil) then Exit; //// EXIT //// if AResourceRel.IsOn = biFalse then Exit; //// EXIT //// if AResourceRel.Cost = 0 then Exit; //// EXIT //// if LookedResources.IndexOf(AResourceRel) = -1 then begin //*** Найти нужную группу ExistsGroup := false; GrResource := nil; for i := 0 to AGroupList.Count - 1 do begin GrResource := AGroupList[i]; if (GrResource.GuidNB = AResourceRel.GuidNB) and (GrResource.TableKindNB = AResourceRel.TableKindNB) and (Abs(GrResource.Price - AResourceRel.Price) < CmpDelta) then begin ExistsGroup := true; GrResource.Kolvo := GrResource.Kolvo + AResourceRel.Kolvo; GrResource.Cost := GrResource.Cost + AResourceRel.Cost; end; end; if Not ExistsGroup then begin GrResource := TSCSResourceRel.Create(GForm, ntProj); GrResource.Assign(AResourceRel); AGroupList.Add(GrResource); end; LookedResources.IndexOf(AResourceRel); end; end; procedure AddNormResourcesToGroup(ANormsResources: TSCSNormsResources); var i, j: Integer; ResourceRel: TSCSResourceRel; SCSNorm: TSCSNorm; begin if ANormsResources = nil then Exit; ///// EXIT ///// for i := 0 to ANormsResources.Resources.Count - 1 do begin ResourceRel := ANormsResources.Resources[i]; AddResourceToGroup(ResourceRel, GroupList); end; for i := 0 to ANormsResources.Norms.Count - 1 do begin SCSNorm := ANormsResources.Norms[i]; for j := 0 to SCSNorm.Resources.Count - 1 do begin ResourceRel := SCSNorm.Resources[j]; AddResourceToGroup(ResourceRel, GroupListFromNorm); end; end; end; procedure LoadComponentsToMT(AComponents: TSCSComponents); var i: Integer; GrComponent: TSCSComponent; ComponentCost: Double; begin if Assigned(AComponents) then for i := 0 to AComponents.Count - 1 do begin GrComponent := AComponents[i]; ComponentCost := 0; ComponentCost := GrComponent.Length * GrComponent.Price; MemTable_RResources.Append; MemTable_RResources.FieldByName('ID').AsInteger := GrComponent.IDNormBase; MemTable_RResources.FieldByName('NAME').AsString := GrComponent.Name; MemTable_RResources.FieldByName(fnIzm).AsString := GrComponent.Izm; MemTable_RResources.FieldByName('Kolvo').AsFloat := RoundX(GrComponent.Length, 2); MemTable_RResources.FieldByName('Price').AsFloat := RoundX(GrComponent.Price, 2); MemTable_RResources.FieldByName('Cost').AsFloat := RoundX(ComponentCost, 2); MemTable_RResources.Post; TotalCost := TotalCost + ComponentCost; end; end; } procedure LoadResourcesToMT(AResources: TSCSResources); var i: Integer; ResourceRel: TSCSResourceRel; Kolvo, Price, Cost: Double; begin for i := 0 to AResources.Count - 1 do begin ResourceRel := AResources[i]; MemTable_RResources.Append; MemTable_RResources.FieldByName('ID').AsInteger := ResourceRel.ID; MemTable_RResources.FieldByName(fnName).AsString := ResourceRel.Name; MemTable_RResources.FieldByName(fnArticulProducer).AsString := ResourceRel.ArtProducer; MemTable_RResources.FieldByName(fnArticulDistributor).AsString := ResourceRel.ArtDistributor; MemTable_RResources.FieldByName(fnProducerName).AsString := TF_Main(GForm).FNormBase.DM.GetStringFromTableByGUID(tnProducers, fnName, ResourceRel.GUIDProducer, qmPhisical); MemTable_RResources.FieldByName(fnIzm).AsString := ResourceRel.Izm; {//21.03.2012 MemTable_RResources.FieldByName('Kolvo').AsFloat := Round3(ResourceRel.Kolvo); MemTable_RResources.FieldByName('Price').AsFloat := Round3(ResourceRel.Price); MemTable_RResources.FieldByName('Cost').AsFloat := Round3(ResourceRel.Cost); MemTable_RResources.Post; TotalCost := TotalCost + Round3(ResourceRel.Cost); //TotalCost := TotalCost + ResourceRel.Cost; } Kolvo := RoundX(ResourceRel.Kolvo, FKolvoPrecision); Price := RoundX(ResourceRel.Price, FPricePrecision); Cost := RoundX(Kolvo * Price, Max(FKolvoPrecision, FPricePrecision) ); MemTable_RResources.FieldByName('Kolvo').AsFloat := Kolvo; MemTable_RResources.FieldByName('Price').AsFloat := Price; MemTable_RResources.FieldByName('Cost').AsFloat := Cost; MemTable_RResources.Post; TotalCost := TotalCost + Cost; end; MemTable_RResources.SortOn(fnName, []); end; begin CableIdsList := nil; if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// OldTick := GetTickCount; TotalCost := 0; if Assigned(AFolder) then begin // Added by Tolik // Расчет расхода кабеля в поставочных величинах // Если задано вывести отчет в поставочных величинах, // то посчитаем расход кабеля в поставочных величинах // Если задан учет поставочных величин, формируем список кабелей if ACanHaveSupplyValue then begin SetLength(CableTypes, 0); if CableIdsList = nil then CableIDsList := TIntList.Create; for i := 0 to AFolder.ComponentReferences.Count - 1 do begin SCSComponent := AFolder.ComponentReferences[i]; // компонент // если кабель if (SCSComponent.IsLine = biTrue) and CheckCanLookComponInReportCable(SCSComponent, ACanHaveDismountAccount) // Tolik 14/11/22 -- //and CheckSysNameIsCable(SCSComponent.ComponentType.SysName) then and isCableComponent(SCSComponent) then // begin if AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType)<> -1)) then begin SCSComponent.RefreshWholeLengthIfNecessary; // цепляем к списк кабелей // CableTypesAdd(SCSComponent, CableTypes, CableIdsList,SCSComponent.ID); CableTypesAdd(SCSComponent, CableTypes, CableIdsList,SCSComponent.Whole_ID, Self); end; end; end; // если на проекте есть кабели if (Length(CableTypes) > 0) And (cbCanHaveSupplyValue.Checked = true) and (not cbNone.Checked) then // расчет расхода кабеля // Tolik 03/11/2020 -- тут только если поставочные величины и выбран метод учета бухт, // иначе - в единицах измерения проекта //CableReelCalculate(CableTypes, 'MaxScrapRate', ReelsCableFlow, Self) begin if cbMaxScrapRate.Checked then CableReelCalculate(CableTypes, 'MaxScrapRate',ReelsCableFlow, Self); if cbMaxEfficiency.Checked then CableReelCalculate(CableTypes, 'MaxEfficiency',ReelsCableFlow, Self); end // // если нет - сбросим результаты предидущих расчетов, // в случае наличия таковых else if ReelsCableFlow <> nil then begin ReelsCableFlow.Clear; if Length(CableTypes) > 0 then SetLength(CableTypes, 0); // на всякий х end; end; // пипец try FCatalog := AFolder; ProjectOwner := AFolder.GetProject; DefinePrecisions; NormResources := nil; BeginProgress(pcPreparingReport); try INeedNormsRecources := True; NormResources := AFolder.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, false, true, ACanHaveSupplyValue); //if ACanHaveSupplyValue or ACanRoundValue then for i := 0 to NormResources.Resources.Count - 1 do begin ResourceRel := NormResources.Resources[i]; ResourceCompon := nil; if Not ResourceRel.ServIsResource then if TSCSResourceGroup(ResourceRel).ObjectList.Count > 0 then if TSCSResourceGroup(ResourceRel).ObjectList[0] is TSCSComponent then begin ResourceCompon := TSCSComponent(TSCSResourceGroup(ResourceRel).ObjectList[0]); end; if ResourceCompon <> nil then begin SprSuppliesKind := nil; if ACanHaveSupplyValue then if ResourceRel.GUIDSuppliesKind <> '' then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(ResourceRel.GUIDSuppliesKind); //*** Учитывать поставочные велечины //Tolik 09/11/2020 -- //if SprSuppliesKind <> nil then if ((SprSuppliesKind <> nil) and (not cbNone.Checked)) then // begin {ResourceRel.Izm := SprSuppliesKind.Data.Name_; ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo; ResourceRel.CalcCost;} if CheckIsTradUOM(TF_Main(GForm).FUOM) then begin ResourceRel.Izm := SprSuppliesKind.Data.NameTradUOM; if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin // Для кабелей и каналов в традиционной системы США нужно юзать ФУТЫ { ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := FloatInUOM(ResourceRel.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM;} // Added by Tolik if Length(Cabletypes) > 0 then begin CableTypeFound := false; for j := 0 to Length(CableTypes) - 1 do begin // if ResourceRel.GuidNB = CableTypes[j].GuidNB then if ResourceCompon.GUIDSuppliesKind = CableTypes[j].TypeName then // Tolik 02/11/2020 -- if ResourceRel.Cypher = CableTypes[j].CableCypher then // begin if cbCanRoundValue.Checked then ResourceRel.Kolvo := Length(CableTypes[j].Reels) else ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; CableTypeFound := true; end end; if not CableTypeFound then ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; end; // ResourceRel.Price := FloatInUOM(ResourceRel.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin // Added by Tolik if Length(Cabletypes) > 0 then begin CableTypeFound := false; for j := 0 to Length(CableTypes) - 1 do begin // if ResourceRel.GuidNB = CableTypes[j].GuidNB then if ResourceCompon.GUIDSuppliesKind = CableTypes[j].TypeName then // Tolik 02/11/2020 -- if ResourceRel.Cypher = CableTypes[j].CableCypher then // begin if cbCanRoundValue.Checked then ResourceRel.Kolvo := Length(CableTypes[j].Reels) else ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; CableTypeFound := true; end end; if not CabletypeFound then ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; end; // // ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvoTradUOM; end; end else begin if not cbNone.Checked then // Tolik 09/11/2020 -- ResourceRel.Izm := SprSuppliesKind.Data.Name; // Added by Tolik if Length(Cabletypes) > 0 then begin CableTypeFound := false; for j := 0 to Length(CableTypes) - 1 do begin // if ResourceRel.GuidNB = CableTypes[j].GuidNB then if ResourceCompon.GUIDSuppliesKind = CableTypes[j].TypeName then // Tolik 02/11/2020 -- if ResourceRel.Cypher = CableTypes[j].CableCypher then if not cbNone.Checked then begin if cbCanRoundValue.Checked then ResourceRel.Kolvo := Length(CableTypes[j].Reels) else ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; CableTypeFound := true; end; end; if not CabletypeFound then ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; end; // // ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; if not cbNone.Checked then ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo else ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; end; //ResourceRel.CalcCost; end else begin if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin ResourceRel.Izm := GetNameUOM(TF_Main(GForm).FUOM, true); if TF_Main(GForm).FUOM <> umMetr then begin ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, TF_Main(GForm).FUOM); ResourceRel.Price := FloatInUOM(ResourceRel.Price, TF_Main(GForm).FUOM, umMetr); //ResourceRel.CalcCost; end; end; end; end; //*** Учитывать флаг округления в большую сторону if ACanRoundValue then begin ResourceRel.Kolvo := RoundUp(ResourceRel.Kolvo); //ResourceRel.CalcCost; end; ResourceRel.CalcCost; end; MemTable_RResources.Active := false; MemTable_RResources.Active := true; //TotalCost := 0; LoadResourcesToMT(NormResources.Resources); //LoadComponentsToMT(GroupComponentsList); //LoadResourcesToMT(GroupList); //LoadResourcesToMT(GroupListFromNorm); //Label_TotalCost.Caption := FloatToStr(RoundX(TotalCost, 2)) +' '+GCurrency.Name_Brief; //MemTable_RResources.SortOn(fnProducerName+';'+fnIzm, []); SortMemTableByParams(MemTable_RResources, AParams, nil); finally EndProgress; if NormResources <> nil then FreeAndNil(NormResources); FreeCableTypes(CableTypes); INeedNormsRecources := False; end; GFormMode := fmRResources; ShowPreparedReport(AParams); //Act_ShowReport.Execute; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; (* if Assigned(AFolder) then begin BeginProgress(pcPreparingReport); try try FCatalog := AFolder; GroupList := TList.Create; GroupListFromNorm := TList.Create; GroupComponentsList := TSCSComponents.Create(true); LookedComponents := TSCSComponents.Create(false); LookedResources := TSCSResources.Create(false); //Folder := TSCSCatalog.Create(GForm); //Folder.LoadCatalogByID(AFolder.ID, false, false); //LoadFolderResources(Folder); for i := 0 to AFolder.ChildCatalogReferences.Count - 1 do begin SCSCatalog := AFolder.ChildCatalogReferences[i]; if Assigned(SCSCatalog) then begin if SCSCatalog.IsLine = biTrue then SCSCatalog.LoadLength; SCSCatalog.NormsResources.CalcResourcesCost(true, true); if SCSCatalog.ItemType in [itSCSConnector, itSCSLine] then AddNormResourcesToGroup(SCSCatalog.NormsResources); end; end; for i := 0 to AFolder.ComponentReferences.Count - 1 do begin SCSComponent := AFolder.ComponentReferences[i]; if Assigned(SCSComponent) then begin if SCSComponent.IsLine = biTrue then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.Length := SCSComponent.GetPropertyValueAsFloat(pnLength); end; SCSComponent.NormsResources.CalcResourcesCost(true, true); AddComponentToGroup(SCSComponent); AddNormResourcesToGroup(SCSComponent.NormsResources); LookedComponents.Add(SCSComponent); if SCSComponent.IsLine = biTrue then begin SCSComponent.LoadWholeComponent(false); for j := 0 to SCSComponent.WholeComponent.Count - 1 do begin PartComponent := AFolder.GetComponentFromReferences(Integer(SCSComponent.WholeComponent[j]^)); if Assigned(PartComponent) then if PartComponent <> SCSComponent then LookedComponents.Add(PartComponent); end; {for j := 0 to SCSComponent.WholeComponent.Count - 1 do begin PartComponent := AFolder.GetComponentFromReferences(Integer(SCSComponent.WholeComponent[j]^)); if Assigned(PartComponent) then if PartComponent <> SCSComponent then if PartComponent.NormsResources.Resources.Count > 0 then LookedResources.Add(PartComponent.NormsResources.Resources[0]); end; } end; end; end; MemTable_RResources.Active := false; MemTable_RResources.Active := true; TotalCost := 0; LoadComponentsToMT(GroupComponentsList); LoadResourcesToMT(GroupList); LoadResourcesToMT(GroupListFromNorm); //Label_TotalCost.Caption := FloatToStr(RoundX(TotalCost, 2)) +' '+GCurrency.Name_Brief; finally EndProgress; //Folder.Free; //*** Удалить Группы LookedResources.Free; for i := 0 to GroupList.Count - 1 do begin GroupResource := GroupList.Items[i]; GroupResource.Free; end; GroupList.Free; for i := 0 to GroupListFromNorm.Count - 1 do begin GroupResource := GroupListFromNorm.Items[i]; GroupResource.Free; end; GroupListFromNorm.Free; GroupComponentsList.Free; LookedComponents.Free; //Freelist(ListWithLookedWholeID); end; GFormMode := fmRResources; Act_ShowReport.Execute; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; end; *) end; (* procedure TF_ResourceReport.ShowFolderResourceReport(AFolder: TSCSCatalog); var Folder: TSCSCatalog; GroupList: TList; GroupListFromNorm: TList; GroupResource: TSCSResourceRel; ListWithLookedWholeID: TList; i: Integer; TotalCost: Double; procedure AddResourceToGroup(AResourceRel: TSCSResourceRel; AGroupList: Tlist); const CmpDelta = 0.001; var GrResource: TSCSResourceRel; ExistsGroup: Boolean; i: integer; begin if (AResourceRel = nil) or (AGroupList = nil) then Exit; //// EXIT //// if AResourceRel.IsOn = biFalse then Exit; //// EXIT //// if AResourceRel.Cost = 0 then Exit; //// EXIT //// //*** Найти нужную группу ExistsGroup := false; GrResource := nil; for i := 0 to AGroupList.Count - 1 do begin GrResource := AGroupList[i]; if (GrResource.IDNB = AResourceRel.IDNB) and (GrResource.TableKindNB = AResourceRel.TableKindNB) and (Abs(GrResource.Price - AResourceRel.Price) < CmpDelta) then begin ExistsGroup := true; GrResource.Kolvo := GrResource.Kolvo + AResourceRel.Kolvo; GrResource.Cost := GrResource.Cost + AResourceRel.Cost; end; end; if Not ExistsGroup then begin GrResource := TSCSResourceRel.Create(GForm, ntProj); GrResource.Assign(AResourceRel); AGroupList.Add(GrResource); end; end; procedure AddNormResourcesToGroup(ANormsResources: TSCSNormsResources); var i, j: Integer; ResourceRel: TSCSResourceRel; SCSNorm: TSCSNorm; begin if ANormsResources = nil then Exit; ///// EXIT ///// for i := 0 to ANormsResources.Resources.Count - 1 do begin ResourceRel := ANormsResources.Resources[i]; AddResourceToGroup(ResourceRel, GroupList); end; for i := 0 to ANormsResources.Norms.Count - 1 do begin SCSNorm := ANormsResources.Norms[i]; for j := 0 to SCSNorm.Resources.Count - 1 do begin ResourceRel := SCSNorm.Resources[j]; AddResourceToGroup(ResourceRel, GroupListFromNorm); end; end; end; procedure LoadFolderResources(AParentFolder: TSCSCatalog); //Resources var SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; i: Integer; ptrID: ^Integer; begin AParentFolder.LoadLength; AParentFolder.NormsResources.CalcResourcesCost(true, true); //*** Загрузка ресурсов и норм папки в группы AddNormResourcesToGroup(AParentFolder.NormsResources); AParentFolder.LoadAllComponents(AParentFolder.ID, false); for i := 0 to AParentFolder.SCSComponents.Count - 1 do begin SCSComponent := AParentFolder.SCSComponents[i]; if (( SCSComponent.IsLine = biTrue) and ( CheckNoIDinList(SCSComponent.Whole_ID, ListWithLookedWholeID) )) or (SCSComponent.IsLine = biFalse) then begin if SCSComponent.IsLine = biTrue then begin New(ptrID); ptrID^ := SCSComponent.Whole_ID; ListWithLookedWholeID.Add(ptrID); SCSComponent.LoadWholeComponent(false); SCSComponent.LoadWholeLength(true); end; SCSComponent.NormsResources.CalcResourcesCost(true, true); //*** Загрузка ресурсов и норм компоненты в группы AddNormResourcesToGroup(SCSComponent.NormsResources); end; end; //AParentFolder.ClearListWithObjects(AParentFolder.SCSComponents); AParentFolder.SCSComponents.Clear; //*** Пройти по внутренным папкам AParentFolder.LoadChildCatalogs(false); for i := 0 to AParentFolder.ChildCatalogs.Count - 1 do begin SCSCatalog := AParentFolder.ChildCatalogs[i]; LoadFolderResources(SCSCatalog); end; //AParentFolder.ClearListWithObjects(AParentFolder.ChildCatalogs); AParentFolder.ChildCatalogs.Clear; end; procedure LoadResourcesToMT(AResources: TList); var i: Integer; ResourceRel: TSCSResourceRel; begin for i := 0 to AResources.Count - 1 do begin ResourceRel := AResources[i]; MemTable_RResources.Append; MemTable_RResources.FieldByName('ID').AsInteger := ResourceRel.ID; MemTable_RResources.FieldByName('NAME').AsString := ResourceRel.Name; MemTable_RResources.FieldByName('Kolvo').AsFloat := RoundX(ResourceRel.Kolvo, 3); MemTable_RResources.FieldByName('Price').AsFloat := RoundX(ResourceRel.Price, 3); MemTable_RResources.FieldByName('Cost').AsFloat := RoundX(ResourceRel.Cost, 3); MemTable_RResources.Post; TotalCost := TotalCost + ResourceRel.Cost; end; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// try Screen.Cursor := crHourGlass; try GroupList := TList.Create; GroupListFromNorm := TList.Create; ListWithLookedWholeID := TList.Create; Folder := TSCSCatalog.Create(GForm); Folder.LoadCatalogByID(AFolder.ID, false, false); LoadFolderResources(Folder); MemTable_RResources.Active := false; MemTable_RResources.Active := true; TotalCost := 0; LoadResourcesToMT(GroupList); LoadResourcesToMT(GroupListFromNorm); Label_TotalCost.Caption := FloatToStr(RoundX(TotalCost, 3)) +' '+GCurrency.Name_Brief; GFormMode := fmRResources; finally Screen.Cursor := crDefault; end; Act_ShowReport.Execute; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; finally Folder.Free; //*** Удалить Группы for i := 0 to GroupList.Count - 1 do begin GroupResource := GroupList.Items[i]; GroupResource.Free; end; GroupList.Free; for i := 0 to GroupListFromNorm.Count - 1 do begin GroupResource := GroupListFromNorm.Items[i]; GroupResource.Free; end; GroupListFromNorm.Free; Freelist(ListWithLookedWholeID); end; end; *) (* procedure TF_ResourceReport.ShowFolderResourceReport(AFolder: TSCSCatalog); var FolderIDComponList: TList; ListWithBusyCompons: TList; i, j: Integer; Group: PSCSCatalog; GroupList: TList; GroupComponent: PSCSComponent; GroupLength: Double; GroupCost: Double; TotalCost: Double; strLength: String; LengthFromStr: Double; StrToShow: String; procedure FillFolderComponList(AIDRoot: Integer); var ChildFolders: TList; i: Integer; CurrCatalog: TSCSCatalog; ptrSCSComponent: PSCSComponent; ptrNewID: ^Integer; begin CurrCatalog := TSCSCatalog.Create(GForm); CurrCatalog.LoadAllComponents(AIDRoot, false); for i := 0 to CurrCatalog.SCSComponents.Count - 1 do begin ptrSCSComponent := CurrCatalog.SCSComponents.Items[i]; New(ptrNewID); ptrNewID^ := ptrSCSComponent.ID; FolderIDComponList.Add(ptrNewID); end; CurrCatalog.Free; ChildFolders := TList.Create; with TF_Main(GForm).DM do begin SetSQLToQuery(scsQSelect, ' select id from katalog where parent_id = '''+IntToStr(AIDRoot)+''' '); IntFieldToList(ChildFolders, scsQSelect, 'ID'); for i := 0 to ChildFolders.Count - 1 do FillFolderComponList(Integer(ChildFolders.Items[i]^)); end; FreeList(ChildFolders); end; procedure AddToGroups(AIDComponent: Integer); var ptrNewSCSComponent: PSCSComponent; Compon: TSCSComponent; i: Integer; ptrGroup: PSCSCatalog; ptrGroupForReceiveCompon: PSCSCatalog; WholeLineCompon: TList; //*** Цельный линейный компонент Length: Double; strLength: String; LengthFromStr: Double; ptrIDBusy: ^Integer; begin if CheckNoIDinList(AIDComponent, ListWithBusyCompons) then begin New(ptrNewSCSComponent); ptrNewSCSComponent^ := TSCSComponent.Create(GForm); ptrNewSCSComponent.LoadComponentByID(AIDComponent, false); case ptrNewSCSComponent.IsLine of biTrue: begin ptrNewSCSComponent.LoadWholeComponent(true); ptrNewSCSComponent.LoadWholeLength(true); //*** Занести в список занятых for i := 0 to ptrNewSCSComponent.WholeComponent.Count - 1 do begin New(ptrIDBusy); ptrIDBusy^ := Integer(ptrNewSCSComponent.WholeComponent[i]^); ListWithBusyCompons.Add(ptrIDBusy); end; end; end; ptrNewSCSComponent.LoadNorms(false); ptrNewSCSComponent.CalcResourcesCost(true, true); if ptrNewSCSComponent.ResourcesCost = 0 then begin ptrNewSCSComponent.Free; FreeMem(ptrNewSCSComponent); Exit; //// EXIT //// end; ptrGroupForReceiveCompon := nil; //*** Найти группу для компоненты for i := 0 to GroupList.Count - 1 do begin ptrGroup := GroupList.Items[i]; if ptrGroup.SCSComponents.Count > 0 then if TSCSComponent(ptrGroup.SCSComponents.Items[0]^).IDNormBase = ptrNewSCSComponent.IDNormBase then begin ptrGroupForReceiveCompon := ptrGroup; Break; end; end; //*** Создать новую группу if ptrGroupForReceiveCompon = nil then begin New(ptrGroup); ptrGroup^ := TSCSCatalog.Create(GForm); GroupList.Add(ptrGroup); ptrGroupForReceiveCompon := ptrGroup; end; //*** Добавить компонент в группу if ptrGroupForReceiveCompon <> nil then begin ptrNewSCSComponent.LoadNorms(false); ptrNewSCSComponent.CalcResourcesCost(true, true); if ptrNewSCSComponent.IsLine = biFalse then begin New(ptrIDBusy); ptrIDBusy^ := ptrNewSCSComponent.ID; ListWithBusyCompons.Add(ptrIDBusy); end; //*** Добавление в группу if ptrNewSCSComponent.ResourcesCost > 0 then ptrGroupForReceiveCompon.SCSComponents.Add(ptrNewSCSComponent) else ptrNewSCSComponent.Free; end; end; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// try FolderIDComponList := Tlist.Create; ListWithBusyCompons := TList.Create; GroupList := TList.Create; //*** Найти все кмопоненты папки //FillFolderComponList(AFolder.ID); FolderIDComponList := GetFolderComponList(GForm, AFolder.ID, [itSCSLine, itSCSConnector]); if FolderIDComponList = nil then Exit; //// EXIT ///// //*** Разбить компоненты по группам относительно IDNormBase for i := 0 to FolderIDComponList.Count - 1 do AddToGroups(Integer(FolderIDComponList.Items[i]^)); //*** Формирование отчета Caption := 'Ведомость ресурсов для "'+AFolder.Name+'" '; TotalCost := 0; MemTable_RResources.Active := false; MemTable_RResources.Active := true; for i := 0 to GroupList.Count - 1 do begin Group := GroupList.Items[i]; GroupLength := 0; GroupCost := 0; if Group.SCSComponents.Count > 0 then begin StrToShow := ''; for j := 0 to Group.SCSComponents.Count - 1 do begin GroupComponent := Group.SCSComponents.Items[j]; GroupCost := GroupCost + GroupComponent.ResourcesCost; if GroupComponent.IsLine = biTrue then begin {strLength := GroupComponent.GetPropertyValueBySysName('LENGTH'); if strLength <> '' then begin LengthFromStr := StrToFloat_My(strLength); GroupLength := GroupLength + LengthFromStr; end;} GroupLength := GroupLength + GroupComponent.Length; end; end; GroupComponent := Group.SCSComponents.Items[0]; MemTable_RResources.Append; MemTable_RResources.FieldByName('ID').AsInteger := GroupComponent.ID; MemTable_RResources.FieldByName('NAME').AsString := GroupComponent.Name; {StrToShow := DupStr(#9, 1); StrToShow := StrToShow + GroupComponent.Name;} case GroupComponent.IsLine of biTrue: begin MemTable_RResources.FieldByName('Kolvo').AsFloat := RoundX(GroupLength, 3); MemTable_RResources.FieldByName('Price').AsFloat := RoundX(GroupComponent.ResourcesCostPerOneNorm, 3); //StrToShow := StrToShow + DupStr(#9, 2) + 'цена '+FloatToStr(RoundX(GroupComponent.ResourcesCostPerOneNorm, 3)) + ' ' +GCurrency.Name_Brief; //StrToShow := StrToShow + DupStr(#9, 1) + 'длина '+FloatToStr(GroupLength)+ ' м'; end; biFalse: begin MemTable_RResources.FieldByName('Kolvo').AsFloat := RoundX(Group.SCSComponents.Count, 3); MemTable_RResources.FieldByName('Price').AsFloat := RoundX(GroupComponent.ResourcesCost, 3); //StrToShow := StrToShow + DupStr(#9, 2) + 'цена '+FloatToStr(RoundX(GroupComponent.ResourcesCost, 3)) + ' ' +GCurrency.Name_Brief; //StrToShow := StrToShow + DupStr(#9, 1) + 'количество '+FloatToStr(Group.SCSComponents.Count); end; end; MemTable_RResources.FieldByName('Cost').AsFloat := RoundX(GroupCost, 3); MemTable_RResources.Post; TotalCost := TotalCost + GroupCost; //StrToShow := StrToShow + DupStr(#9, 1) + 'стоимость '+FloatToStr(RoundX(GroupCost, 3)) + ' ' +GCurrency.Name_Brief; //RichEdit_Report.Lines.Add(StrToShow); //RichEdit_Report.Lines.Add(''); end; end; Label_TotalCost.Caption := FloatToStr(RoundX(TotalCost, 3)) +' '+GCurrency.Name_Brief; //RichEdit_Report.Lines.Add('Общая стоимость '+FloatToStr(RoundX(TotalCost, 3)) +' '+GCurrency.Name_Brief); GFormMode := fmRResources; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; finally //*** Удалить Группы for i := 0 to GroupList.Count - 1 do begin Group := GroupList.Items[i]; Group.Free; end; FreeList(GroupList); FreeList(ListWithBusyCompons); FreeList(FolderIDComponList); end; end; *) procedure TF_ResourceReport.ShowFolderNormReport(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents: Boolean); var i, j, k: Integer; //LookedInterfaces: TList; InterfaceNormList: TList; CurrInterfaceNormList: TList; TempList: TList; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; TraceLength: Double; Interfac: TSCSInterface; ptrJoinedInterf: TSCSInterface; ptrComplectInterf: TSCSInterface; ptrResultInterface: TSCSInterface; //IOfIRel: TSCSIOfIRel; ptrInterfaceNormInfo: PInterfaceNormInfo; ptrInterfaceNormInfoI: PInterfaceNormInfo; ptrInterfaceNormInfoJ: PInterfaceNormInfo; GroupedNorms: TSCSNormsResources; GroupNorm: TSCSNorm; NormTotalLaborTime: Integer; begin try FTotalLaborTime := 0; if Assigned(AFolder) then begin //LookedInterfaces := TList.Create; //InterfaceNormList := TList.Create; //GroupedNorms := TSCSNorms.Create(true); FCatalog := AFolder; BeginProgress(pcPreparingReport); try //Tolik // по типам сетей INeedNormsRecources := True; // //GroupedNorms := AFolder.GetAllNormsResources(nrAll, false, ACanHaveActiveComponents, false, true); //24.09.2010 GroupedNorms := AFolder.GetAllNormsResources([nrNorms], false, ACanHaveActiveComponents, false, true); GroupedNorms := AFolder.GetAllNormsResources([nrNorms], false, ACanHaveActiveComponents, false, true, false, true, false, True); ////24.09.2010 aAllowNormPriceForGroup = True //*** Засыпать нормы в MemTable MemTable_RNorms.Active := false; MemTable_RNorms.Active := true; for i := 0 to GroupedNorms.Norms.Count - 1 do begin GroupNorm := GroupedNorms.Norms[i]; MemTable_RNorms.Append; MemTable_RNorms.FieldByName(fnCypher).AsString := GroupNorm.Cypher; MemTable_RNorms.FieldByName(fnName).AsString := GroupNorm.Name; //Tolik 27/02/2022 -- //MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, 2); // MemTable_RNorms.FieldByName(fnIzm).AsString := GroupNorm.Izm_; //24.09.2010 //Tolik 27/02/2022 -- //MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, PrecisionNormKolvo); //MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, 2); MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, 2); // //19.11.2013 NormTotalLaborTime := Round(GroupNorm.LaborTime*GroupNorm.Kolvo); MemTable_RNorms.FieldByName(fnLaborTime).AsString := GetDisplayTextToNORMLaborTime(IntToStr(GroupNorm.LaborTime)); //Tolik 27/02/2022 -- //MemTable_RNorms.FieldByName(fnPricePerTime).AsFloat := RoundX(GroupNorm.PricePerTime, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnPricePerTime).AsFloat := RoundX(GroupNorm.PricePerTime, 2); // MemTable_RNorms.FieldByName(fnTotalLaborTime).AsString := GetDisplayTextToNORMLaborTime(IntToStr(NormTotalLaborTime)); MemTable_RNorms.Post; FTotalLaborTime := FTotalLaborTime + NormTotalLaborTime; end; //MemTable_RNorms.SortOn(fnCypher, []); SortMemTableByParams(MemTable_RNorms, AParams, nil); finally EndProgress; FreeAndNil(GroupedNorms); //Tolik INeedNormsRecources := False; //FreeList(InterfaceNormList); //FreeAndNil(LookedInterfaces); end; GFormMode := fmRNorms; ShowPreparedReport(AParams); //Act_ShowReport.Execute; end; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderNormReport: '+E.Message); end; end; // отчет ведомость кабелей procedure TF_ResourceReport.ShowFolderCableReport(AFolder: TSCSCatalog; AParams: TReportItemParams; AFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveDismountAccount: Boolean;AReportItemParamValues : TReportItemParams); //const CmpDelta = 0.01; var //FolderIDComponList: TList; List: TSCSList; ListWithLookedCompons: TList; CurrIDCompon: Integer; i, j: Integer; Component: TSCSComponent; FirstObjName: String; FirstComponName: String; LastObjName: String; LastComponName: String; ptrID: ^Integer; WholeComponent: Tlist; //*** Цельный кабель TextLine: String; CableCanalCost: Double; ComponSignType: Integer; ComponLength: Double; ComponMaxLength: Double; ComponLengthReserv: Double; ComponPrice: Double; MemTableOprions: TkbmMemTableCompareOptions; CurrMTGrp: TKbmMemTable; CurrMT: TKbmMemTable; CableTypes : TCableTypeArray; CableIDsList : TIntList; //Tolik currCad : TF_CAD; Figure : TFigure; currCatalog : TSCSCatalog; {function GetNameAndIndexByTCatalog(ACatalog: TCatalog): String; begin Result := ''; Result := TF_Main(GForm).GetNameAndIndex(ACatalog.Name, ACatalog.ItemType, ACatalog.IndexPointObj, ACatalog.IndexConnector, ACatalog.IndexLine); end;} function GetObjNameByIDCompon(AIDComponent: Integer; var AComponName: String): String; var SCSComponent: TSCSComponent; SCSObject: TSCSCatalog; SCSList: TSCSList; begin Result := ''; AComponName := ''; SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDComponent); if Assigned(SCSComponent) then if CheckCanLookComponInReportCable(SCSComponent, ACanHaveDismountAccount) then begin AComponName := SCSComponent.NameMark; SCSObject := SCSComponent.GetFirstParentCatalog; if Assigned(SCSObject) then begin SCSList := SCSObject.GetListOwner; if SCSList <> nil then begin Result := SCSList.GetNameForVisible + '/' + SCSObject.GetNameForVisible; end; end; end; end; procedure DefineBeginEnd(AComponent: TSCSComponent; var AFirstConObj, AFirstConCompon: string; var ALastConObj, ALastConCompon: string); var ConnectedObjFirst: TSCSCatalog; ConnectedObjLast: TSCSCatalog; CatalogFirst: TCatalog; CatalogLast: TCatalog; Buf: Integer; WasReplace: Boolean; i, j, k, FICount, LICount: integer; s: string; currCompon, connCompon, FirstCompon, LastCompon : TSCSComponent; FirstCatalog, LastCatalog : TSCSCatalog; AllConnectedCompons : TSCSComponents; IntCounts : TIntList; tmpstr: string; begin try AFirstConObj := cResourceReport_Msg38; AFirstConCompon := ''; ALastConObj := AFirstConObj; ALastConCompon := ''; FICount := 0; LICount := 0; FirstCompon := nil; LastCompon := nil; IntCounts := TIntList.Create; AllConnectedCompons := TSCSComponents.Create(false); if (AComponent.FirstIDConnectedConnCompon <> 0) and (AComponent.FirstIDCompon <> 0) then AFirstConObj := GetObjNameByIDCompon(AComponent.FirstIDConnectedConnCompon, AFirstConCompon); //TF_Main(GForm).DM.GetNameObjectConnectedToLineCompon(AComponent.FirstIDConnectedConnCompon, AComponent.FirstIDCompon); if (AComponent.LastIDConnectedConnCompon <> 0) and (AComponent.LastIDCompon <> 0) then ALastConObj := GetObjNameByIDCompon(AComponent.LastIDConnectedConnCompon, ALastConCompon); //TF_Main(GForm).DM.GetNameObjectConnectedToLineCompon(AComponent.LastIDConnectedConnCompon, AComponent.LastIDCompon); // added by Tolik if ((AComponent.IDNetType in [3,{4,}5,7])) then begin if (AComponent.FirstIDConnectedConnCompon <> 0) and (AComponent.LastIDConnectedConnCompon <> 0) then begin //FirstCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AComponent.FirstIDConnectedConnCompon); // все компоненты на кабеле for i := 0 to AComponent.WholeComponent.Count -1 do begin currCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AComponent.WholeComponent[i]); // берем все подключенный точечные // участок Кабеля ///////////currCompon.LoadConections; for j := 0 to currCompon.JoinedComponents.Count - 1 do begin if currCompon.JoinedComponents[j].IsLine = biFalse then begin connCompon := currCompon.JoinedComponents[j]; //while not connCompon.IsTop do // connCompon := connCompon.GetParentComponent; AllConnectedCompons.Add(connCompon); end; end; end; // считаем количество интерфейсов на каждом подключенном точечном компоненте for i := 0 to AllConnectedCompons.Count -1 do begin currCompon := AllConnectedCompons[i]; While not currCompon.IsTop do currCompon := currCompon.GetParentComponent; FICount := 0; for j := 0 to currCompon.Interfaces.Count - 1 do begin if currCompon.Interfaces[j].TypeI = itFunctional then begin // если интерфейс один if currCompon.Interfaces[j].Kolvo <= 0 then inc(FICount) else // если интерфейсов несколько FICount := FICount + currCompon.Interfaces[j].Kolvo; end; end; for j := 0 to currCompon.ChildReferences.Count - 1 do begin for k := 0 to currCompon.ChildReferences[j].Interfaces.Count - 1 do begin if currCompon.ChildReferences[j].Interfaces[k].TypeI = itFunctional then begin if currCompon.ChildReferences[j].Interfaces[k].Kolvo <= 0 then inc(FICount) else FICount := FICount + currCompon.ChildReferences[j].Interfaces[k].Kolvo; end; end; end; IntCounts.Add(FICount); end; // Ищем компонент с наибольшим количеством интерфейсов LICount := 0; FICount := IntCounts[0]; for i := 1 to AllConnectedCompons.Count - 1 do begin if FICount < IntCounts[i] then begin FICount := IntCounts[i]; LICount := i; end; end; // первый подключенный FirstCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AllConnectedCompons[LICount].ID); AFirstConObj := GetObjNameByIDCompon(FirstCompon.id, AFirstConCompon); // второй (или список, если их несколько) if AllConnectedCompons.Count = 2 then begin for i := 0 to AllConnectedCompons.Count - 1 do if AllConnectedCompons[i] <> FirstCompon then LastCompon := AllConnectedCompons[i]; ALastConObj := GetObjNameByIDCompon(LastCompon.id, ALastConCompon); if ALastConCompon <> '' then ALastConObj := ALastConObj + '/' + ALastConCompon; end else begin ALastConObj := ''; for i := 0 to AllConnectedCompons.Count -1 do begin currCompon := AllConnectedCompons[i]; if currCompon <> FirstCompon then begin tmpstr := GetObjNameByIDCompon(currCompon.id, ALastConCompon); if ALastConCompon <> '' then tmpstr := tmpstr + '/' + ALastConCompon; if ALastConObj = '' then ALastConObj := tmpstr else ALastConObj := ALastConObj + #13#10 + tmpstr; end; end; end; end; end; //******* {CatalogFirst.ID := 0; CatalogFirst.Name := ''; CatalogLast.ID := 0; CatalogLast.Name := ''; WasReplace := false; if AComponent.FirstIDConnectedConnCompon <> -1 then CatalogFirst := TF_Main(GForm).DM.GetCatalogByCompon(AComponent.FirstIDConnectedConnCompon); if AComponent.LastIDConnectedConnCompon <> -1 then CatalogLast := TF_Main(GForm).DM.GetCatalogByCompon(AComponent.LastIDConnectedConnCompon); ConnectedObjFirst := TSCSCatalog.Create(GForm); ConnectedObjLast := TSCSCatalog.Create(GForm); if CatalogFirst.ID <> 0 then ConnectedObjFirst.LoadAllComponents(CatalogFirst.ID, false); if CatalogLast.ID <> 0 then ConnectedObjLast.LoadAllComponents(CatalogLast.ID, false); if CatalogFirst.Name <> '' then AFirstConObj := GetNameAndIndexByTCatalog(CatalogFirst); if CatalogLast.Name <> '' then ALastConObj := GetNameAndIndexByTCatalog(CatalogLast); } { if ConnectedObjLast.SCSComponents.Count < ConnectedObjFirst.SCSComponents.Count then begin Buf := AComponent.FirstIDConnectedConnCompon; AComponent.FirstIDConnectedConnCompon := AComponent.LastIDConnectedConnCompon; AComponent.LastIDConnectedConnCompon := Buf; WasReplace := true; end; case WasReplace of True: begin if CatalogLast.Name <> '' then AFirstConObj := GetNameAndIndexByTCatalog(CatalogLast); if CatalogFirst.Name <> '' then ALastConObj := GetNameAndIndexByTCatalog(CatalogFirst); end; False: begin if CatalogFirst.Name <> '' then AFirstConObj := GetNameAndIndexByTCatalog(CatalogFirst); if CatalogLast.Name <> '' then ALastConObj := GetNameAndIndexByTCatalog(CatalogLast); end; end; } finally //ConnectedObjFirst.Free; //ConnectedObjLast.Free; IntCounts.Free; FreeAndNil(AllConnectedCompons); end; end; procedure AddTextToLine(AText: String); const PartLength = 17; var TextPart: String[PartLength]; TextLength: Integer; i: Integer; begin TextPart := AText; TextLength := Length(TextPart); if TextLength < PartLength then begin SetLength(TextPart, PartLength); for i := TextLength + 1 to PartLength do TextPart[i] := ' '; end; TextPart[PartLength] := ' '; TextLine := TextLine + TextPart; end; begin SetLength(CableTypes,0); CableIdsList := TintList.Create; DefinePrecisions; // Tolik 14/11/2020 -- try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FCatalog := AFolder; //FolderIDComponList := Tlist.Create; ListWithLookedCompons := TList.Create; WholeComponent := nil; //Component := TSCSComponent.Create(GForm); //FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine]); //if FolderIDComponList = nil then // Exit; ///// EXIT ///// {RichEdit_Report.Lines.Clear; RichEdit_Report.DefAttributes.Size := 10; RichEdit_Report.DefAttributes.Name := 'Courier New'; RichEdit_Report.Lines.Add(DupStr('-', 100)); RichEdit_Report.Lines.Add('Компонент Начало соед. Конец соед. Длина Цена Стоимость '); RichEdit_Report.Lines.Add(DupStr('-', 100)); } {CurrMT.MasterSource := nil; CurrMT.Active := false; CurrMT.Active := True; CurrMTGrp.Active := false; CurrMTGrp.Active := True; if AFormMode = fmRCableCanal then begin CurrMT.MasterSource := DataSource_MT_RCableGroup; CurrMT.MasterFields := fnID; CurrMT.DetailFields := fnIDGroup; end; } CurrMTGrp := nil; CurrMT := nil; if AFormMode = fmRCable then begin CurrMTGrp := MemTable_RCableGroup; CurrMT := MemTable_RCable; end else if AFormMode = fmRCableCanal then begin CurrMTGrp := FmtCableChannelGrp; CurrMT := FmtCableChannel; end; CurrMT.MasterSource := nil; CurrMT.Active := false; //CurrMT.Active := True; CurrMTGrp.Active := false; //CurrMTGrp.Active := True; if AFormMode = fmRCableCanal then begin CurrMT.MasterSource := FdsrcCableChannelGrp; //DataSource_MT_RCableGroup; CurrMT.MasterFields := fnID; CurrMT.DetailFields := fnIDGroup; end; CurrMTGrp.Active := True; CurrMT.Active := True; BeginProgress(pcPreparingReport); try {FExceedLength := 0; //if AFormMode = fmRCableExceedLength then begin List := TF_Main(GForm).GSCSBase.CurrProject.GetListBySCSID(AFolder.ListID); if Assigned(List) then FExceedLength := List.Setting.TwistedPairMaxLength; end; } with TF_Main(GForm).DM do //for i := 0 to FolderIDComponList.Count - 1 do for i := 0 to AFolder.ComponentReferences.Count - 1 do begin Component := AFolder.ComponentReferences[i]; //проверка на тип сети if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(Component.GUIDNetType) <> -1)) then begin //CurrIDCompon := Integer(FolderIDComponList.Items[i]^); if Assigned(Component) and CheckNoIDinList(Component.ID, ListWithLookedCompons) then begin ComponSignType := Component.GetPropertyValueAsInteger(pnSignType); //Component.LoadComponentByID(CurrIDCompon, false); if ((Component.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) and ( not ( Component.IDNetType in [3,{4,}5,7])) and CheckCanLookComponInReportCable(Component, ACanHaveDismountAccount)) then begin Component.RefreshWholeLengthIfNecessary; case AFormMode of fmRCable, fmRCableExceedLength: // Tolik 14/11/2020 -- CheckSysNameIsCable - не учитывает Wire //if CheckSysNameIsCable(Component.ComponentType.SysName) then if isCableComponent(Component) then // begin // Added by Tolik if not cbNone.Checked then CableTypesAdd(Component, CableTypes, CableIdsList,Component.ID, Self); //*** Есть ли функциональные интерфейсы //if HaveComponFunctionalInterfaces(scsQSelect, CurrIDCompon) then if Component.HaveInterfaceByType(itFunctional) then begin FExceedLength := 0; List := Component.GetListOwner; if Assigned(List) then FExceedLength := List.Setting.TwistedPairMaxLength; Component.LoadWholeComponent(false); Component.LoadWholeLength; //Component.LoadInterfaces; //if (AFormMode = fmRCable) or // ((AFormMode = fmRCableExceedLength) and (Component.HaveInterfaceByIDInterface(iidTwistedPair)) and (Component.Length - FExceedLength > CmpDelta)) then // //((AFormMode = fmRCableExceedLength) and (Component.MaxLength > 0) and (Component.Length - Component.MaxLength > CmpDelta) ) then if Not ACanHaveDismountAccount or Not CheckHaveWholeComponentDismounted(FCatalog, Component.WholeComponent) then begin DefineBeginEnd(Component, FirstObjName, FirstComponName, LastObjName, LastComponName); //Component.NormsResources.CalcResourcesCost(true, true); CurrMT.Append; CurrMT.FieldByName(fnID).AsInteger := Component.ID; CurrMT.FieldByName(fnMarkID).AsInteger := Component.MarkID; CurrMT.FieldByName(fnName).AsString := GetComponNameForVisible(Component.Name, Component.NameMark); CurrMT.FieldByName(fnNameSimple).AsString := Component.Name; CurrMT.FieldByName(fnNameMark).AsString := Component.NameMark; ComponLength := 0; ComponLengthReserv := 0; ComponMaxLength := 0; ComponPrice := 0; if CheckPriceTransformToUOMByCompType(@Component.ComponentType) then begin CurrMT.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); ComponLength := FloatInUOM(Component.Length, umMetr, TF_Main(GForm).FUOM); ComponLengthReserv := FloatInUOM(Component.LengthReserv, umMetr, TF_Main(GForm).FUOM); ComponMaxLength := FloatInUOM(Component.MaxLength, umMetr, TF_Main(GForm).FUOM); ComponPrice := FloatInUOM(Component.Price, TF_Main(GForm).FUOM, umMetr); end else begin CurrMT.FieldByName(fnIzm).AsString := Component.Izm; ComponLength := Component.Length; ComponLengthReserv := Component.LengthReserv; ComponMaxLength := Component.MaxLength; ComponPrice := Component.Price; end; CurrMT.FieldByName(fnNameBegin).AsString := FirstObjName; CurrMT.FieldByName(fnNameBeginCompon).AsString := FirstComponName; // Поле для сортировки if FirstComponName = '' then CurrMT.FieldByName(fnNameBeginFull).AsString := FirstObjName else CurrMT.FieldByName(fnNameBeginFull).AsString := FirstObjName+'/'+FirstComponName; CurrMT.FieldByName(fnNameEnd).AsString := LastObjName; CurrMT.FieldByName(fnNameEndCompon).AsString := LastComponName; // Поле для сортировки if LastComponName = '' then CurrMT.FieldByName(fnNameEndFull).AsString := LastObjName else CurrMT.FieldByName(fnNameEndFull).AsString := LastObjName +'/'+LastComponName; //Tolik 14/11/2020 -- { CurrMT.FieldByName('Length').AsFloat := RoundCP(ComponLength); CurrMT.FieldByName('Length_Reserv').AsFloat := RoundCP(ComponLengthReserv); CurrMT.FieldByName('Max_Length').AsFloat := RoundCP(ComponMaxLength); CurrMT.FieldByName('Price').AsFloat := RoundCP(ComponPrice); //RoundX(Component.NormsResources.ResourcesCostPerOneNorm, 2); CurrMT.FieldByName('Cost').AsFloat := RoundCP(ComponPrice*ComponLength); //RoundX(Component.NormsResources.ResourcesCost, 2); } CurrMT.FieldByName('Length').AsFloat := RoundX(ComponLength, FKolvoPrecision); CurrMT.FieldByName('Length_Reserv').AsFloat := RoundX(ComponLengthReserv, FKolvoPrecision); CurrMT.FieldByName('Max_Length').AsFloat := RoundX(ComponMaxLength, FKolvoPrecision); CurrMT.FieldByName('Price').AsFloat := RoundX(ComponPrice,FPricePrecision); CurrMT.FieldByName('Cost').AsFloat := RoundX(ComponPrice*ComponLength, Max(FKolvoPrecision, FPricePrecision)); //RoundX(Component.NormsResources.ResourcesCost, 2); /// //*** Длина превышает граничное значение. if (Component.HaveInterfaceByGUIDInterface(guidTwistedPair)) and (Component.Length - FExceedLength > cnstCmpLenDelta) then CurrMT.FieldByName('ExceedLength').AsBoolean := true else CurrMT.FieldByName('ExceedLength').AsBoolean := false; CurrMT.Post; {TextLine := ''; AddTextToLine(Component.Name); AddTextToLine(FirstName); AddTextToLine(LastName); AddTextToLine(FloatToStr(RoundX(Component.Length, 3)) +' м'); AddTextToLine(FloatToStr(RoundX(Component.ResourcesCostPerOneNorm, 3)) +' '+GCurrency.Name_Brief); AddTextToLine(FloatToStr(RoundX(Component.ResourcesCost, 2)) +' '+GCurrency.Name_Brief); RichEdit_Report.Lines.Add(TextLine); } {RichEdit_Report.Lines.Add(Component.Name + DupStr(' ', 2) + FirstName + DupStr(' ', 2) + LastName + DupStr(' ', 2) + FloatToStr(RoundX(Component.Length, 2)) + DupStr(' ', 2)+ FloatToStr(RoundX(Component.ResourcesCostPerOneNorm, 2)) + DupStr(' ', 2)+ FloatToStr(RoundX(Component.ResourcesCost, 2)) );} end; end; for j := 0 to Component.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := Component.WholeComponent.Items[j]; ListWithLookedCompons.Add(ptrID); end; end; fmRCableCanal: if CheckSysNameIsCableChannel(Component.ComponentType.SysName) then begin Component.LoadCurrLength; //Component.NormsResources.CalcResourcesCost(true, true); //*** Найти/Создать Группу if Not CurrMTGrp.Locate(fnGUID, Component.GuidNB, []) then begin CurrMTGrp.Append; CurrMTGrp.FieldByName(fnGUID).AsString := Component.GuidNB; CurrMTGrp.FieldByName(fnName).AsString := Component.GetNameForVisible(false); CurrMTGrp.FieldByName(fnLength).AsFloat := 0; CurrMTGrp.FieldByName(fnLengthReserv).AsFloat := 0; CurrMTGrp.FieldByName(fnCost).AsFloat := 0; CurrMTGrp.Post; end; if CurrMTGrp.Locate(fnGUID, Component.GuidNB, []) then begin CurrMT.Append; CurrMT.FieldByName(fnID).AsInteger := Component.ID; CurrMT.FieldByName(fnMarkID).AsInteger := Component.MarkID; CurrMT.FieldByName(fnName).AsString := Component.GetNameForVisible(false); //GetComponNameForVisible(Component.Name, Component.NameMark); CurrMT.FieldByName(fnNameSimple).AsString := Component.Name; CurrMT.FieldByName(fnNameMark).AsString := Component.NameMark; ComponLength := 0; ComponLengthReserv := 0; ComponPrice := 0; if CheckPriceTransformToUOMByCompType(@Component.ComponentType) then begin CurrMT.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); ComponLength := FloatInUOM(Component.Length, umMetr, TF_Main(GForm).FUOM); ComponLengthReserv := FloatInUOM(Component.LengthReserv, umMetr, TF_Main(GForm).FUOM); ComponPrice := FloatInUOM(Component.Price, TF_Main(GForm).FUOM, umMetr); end else begin CurrMT.FieldByName(fnIzm).AsString := Component.Izm; ComponLength := Component.Length; ComponLengthReserv := Component.LengthReserv; ComponPrice := Component.Price; end; CableCanalCost := ComponPrice * ComponLength; CurrMT.FieldByName('FILLING').AsFloat := Component.GetFullnessPercentCableCanal; CurrMT.FieldByName('Length').AsFloat := RoundCP(ComponLength); CurrMT.FieldByName(fnLengthReserv).AsFloat := RoundCP(ComponLengthReserv); CurrMT.FieldByName('Price').AsFloat := RoundCP(ComponPrice); //Component.NormsResources.ResourcesCostPerOneNorm; CurrMT.FieldByName('Cost').AsFloat := RoundCP(CableCanalCost); //Component.NormsResources.ResourcesCost; CurrMT.Post; CurrMTGrp.Edit; CurrMTGrp.FieldByName(fnLength).AsFloat := CurrMTGrp.FieldByName(fnLength).AsFloat + RoundCP(ComponLength); CurrMTGrp.FieldByName(fnLengthReserv).AsFloat := CurrMTGrp.FieldByName(fnLengthReserv).AsFloat + RoundCP(ComponLengthReserv); CurrMTGrp.FieldByName(fnCost).AsFloat := CurrMTGrp.FieldByName(fnCost).AsFloat + RoundCP(CableCanalCost); CurrMTGrp.Post; //*** сортировать кабельные каналы в группе CurrMT.SortOn(fnMarkID, []); end; end; end; // Case End end; end; end; end; // первый проход // второй проход // смотрим електросеть, телевиз., и т.п. и засыпаем в таблицу for i := 0 to AFolder.ComponentReferences.Count - 1 do begin Component := AFolder.ComponentReferences[i]; if Assigned(Component) and CheckNoIDinList(Component.ID, ListWithLookedCompons) then begin if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(Component.GUIDNetType) <> -1)) then begin ComponSignType := Component.GetPropertyValueAsInteger(pnSignType); if ((Component.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) and ( (Component.IDNetType in [3,{4,}5,7])) and CheckCanLookComponInReportCable(Component, ACanHaveDismountAccount)) then begin Component.RefreshWholeLengthIfNecessary; case AFormMode of fmRCable, fmRCableExceedLength: // Tolik 14/11/220 -- //if CheckSysNameIsCable(Component.ComponentType.SysName) then if isCableComponent(Component) then // begin // Added by Tolik if not cbNone.Checked then CableTypesAdd(Component, CableTypes, CableIdsList,Component.ID, Self); //*** Есть ли функциональные интерфейсы //if HaveComponFunctionalInterfaces(scsQSelect, CurrIDCompon) then if Component.HaveInterfaceByType(itFunctional) then begin Component.LoadWholeComponent(false); Component.LoadWholeLength; if Not ACanHaveDismountAccount or Not CheckHaveWholeComponentDismounted(FCatalog, Component.WholeComponent) then begin DefineBeginEnd(Component, FirstObjName, FirstComponName, LastObjName, LastComponName); CurrMT.Append; CurrMT.FieldByName(fnID).AsInteger := Component.ID; CurrMT.FieldByName(fnMarkID).AsInteger := Component.MarkID; CurrMT.FieldByName(fnName).AsString := GetComponNameForVisible(Component.Name, Component.NameMark); CurrMT.FieldByName(fnNameSimple).AsString := Component.Name; CurrMT.FieldByName(fnNameMark).AsString := Component.NameMark; ComponLength := 0; ComponLengthReserv := 0; ComponMaxLength := 0; ComponPrice := 0; if CheckPriceTransformToUOMByCompType(@Component.ComponentType) then begin CurrMT.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); ComponLength := FloatInUOM(Component.Length, umMetr, TF_Main(GForm).FUOM); ComponLengthReserv := FloatInUOM(Component.LengthReserv, umMetr, TF_Main(GForm).FUOM); ComponMaxLength := FloatInUOM(Component.MaxLength, umMetr, TF_Main(GForm).FUOM); ComponPrice := FloatInUOM(Component.Price, TF_Main(GForm).FUOM, umMetr); end else begin CurrMT.FieldByName(fnIzm).AsString := Component.Izm; ComponLength := Component.Length; ComponLengthReserv := Component.LengthReserv; ComponMaxLength := Component.MaxLength; ComponPrice := Component.Price; end; CurrMT.FieldByName(fnNameBegin).AsString := FirstObjName; CurrMT.FieldByName(fnNameBeginCompon).AsString := FirstComponName; // Поле для сортировки if FirstComponName = '' then CurrMT.FieldByName(fnNameBeginFull).AsString := FirstObjName // commentsd by Tolik else CurrMT.FieldByName(fnNameBeginFull).AsString := FirstObjName+'/'+FirstComponName; CurrMT.FieldByName(fnNameEnd).AsString := LastObjName; CurrMT.FieldByName(fnNameEndCompon).AsString := '';//LastComponName; // Поле для сортировки if LastComponName = '' then CurrMT.FieldByName(fnNameEndFull).AsString := LastObjName; //commented by Tolik //else // CurrMT.FieldByName(fnNameEndFull).AsString := LastObjName +'/'+LastComponName; CurrMT.FieldByName('Length').AsFloat := RoundCP(ComponLength); CurrMT.FieldByName('Length_Reserv').AsFloat := RoundCP(ComponLengthReserv); CurrMT.FieldByName('Max_Length').AsFloat := RoundCP(ComponMaxLength); CurrMT.FieldByName('Price').AsFloat := RoundCP(ComponPrice); //RoundX(Component.NormsResources.ResourcesCostPerOneNorm, 2); CurrMT.FieldByName('Cost').AsFloat := RoundCP(ComponPrice*ComponLength); //RoundX(Component.NormsResources.ResourcesCost, 2); CurrMT.FieldByName('ExceedLength').AsBoolean := false; CurrMT.Post; end; end; for j := 0 to Component.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := Component.WholeComponent.Items[j]; ListWithLookedCompons.Add(ptrID); end; end; fmRCableCanal: if CheckSysNameIsCableChannel(Component.ComponentType.SysName) then begin Component.LoadCurrLength; //*** Найти/Создать Группу if Not CurrMTGrp.Locate(fnGUID, Component.GuidNB, []) then begin CurrMTGrp.Append; CurrMTGrp.FieldByName(fnGUID).AsString := Component.GuidNB; CurrMTGrp.FieldByName(fnName).AsString := Component.GetNameForVisible(false); CurrMTGrp.FieldByName(fnLength).AsFloat := 0; CurrMTGrp.FieldByName(fnLengthReserv).AsFloat := 0; CurrMTGrp.FieldByName(fnCost).AsFloat := 0; CurrMTGrp.Post; end; if CurrMTGrp.Locate(fnGUID, Component.GuidNB, []) then begin CurrMT.Append; CurrMT.FieldByName(fnID).AsInteger := Component.ID; CurrMT.FieldByName(fnMarkID).AsInteger := Component.MarkID; CurrMT.FieldByName(fnName).AsString := Component.GetNameForVisible(false); //GetComponNameForVisible(Component.Name, Component.NameMark); CurrMT.FieldByName(fnNameSimple).AsString := Component.Name; CurrMT.FieldByName(fnNameMark).AsString := Component.NameMark; ComponLength := 0; ComponLengthReserv := 0; ComponPrice := 0; if CheckPriceTransformToUOMByCompType(@Component.ComponentType) then begin CurrMT.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); ComponLength := FloatInUOM(Component.Length, umMetr, TF_Main(GForm).FUOM); ComponLengthReserv := FloatInUOM(Component.LengthReserv, umMetr, TF_Main(GForm).FUOM); ComponPrice := FloatInUOM(Component.Price, TF_Main(GForm).FUOM, umMetr); end else begin CurrMT.FieldByName(fnIzm).AsString := Component.Izm; ComponLength := Component.Length; ComponLengthReserv := Component.LengthReserv; ComponPrice := Component.Price; end; CableCanalCost := ComponPrice * ComponLength; CurrMT.FieldByName('FILLING').AsFloat := Component.GetFullnessPercentCableCanal; CurrMT.FieldByName('Length').AsFloat := RoundCP(ComponLength); CurrMT.FieldByName(fnLengthReserv).AsFloat := RoundCP(ComponLengthReserv); CurrMT.FieldByName('Price').AsFloat := RoundCP(ComponPrice); //Component.NormsResources.ResourcesCostPerOneNorm; CurrMT.FieldByName('Cost').AsFloat := RoundCP(CableCanalCost); //Component.NormsResources.ResourcesCost; CurrMT.Post; CurrMTGrp.Edit; CurrMTGrp.FieldByName(fnLength).AsFloat := CurrMTGrp.FieldByName(fnLength).AsFloat + RoundCP(ComponLength); CurrMTGrp.FieldByName(fnLengthReserv).AsFloat := CurrMTGrp.FieldByName(fnLengthReserv).AsFloat + RoundCP(ComponLengthReserv); CurrMTGrp.FieldByName(fnCost).AsFloat := CurrMTGrp.FieldByName(fnCost).AsFloat + RoundCP(CableCanalCost); CurrMTGrp.Post; //*** сортировать кабельные каналы в группе CurrMT.SortOn(fnMarkID, []); end; end; end; end; end; end; end; if AFormMode = fmRCableCanal then CurrMTGrp.SortOn(fnName, []); /////////////////////////////////////////////// AParams.FReportSortInfo.FUsedFieldNames.Clear; AParams.FReportSortInfo.FUsedFieldNames.Add(fnNameSimple); AParams.FReportSortInfo.FUsedFieldNames.Add(fnNameBeginFull); AParams.FReportSortInfo.FUsedFieldNames.Add(fnNameEndFull); SortMemTableByParams(CurrMT, AParams, AReportItemParamValues); {if AFormMode = fmRCable then CurrMT.SortOn(fnMarkID, []); if AFormMode = fmRCableExceedLength then CurrMT.SortOn('ExceedLength', []);} finally EndProgress; FreeList(ListWithLookedCompons); end; // Added by Tolik // Если требуется посчитать расход кабеля из катушек, // то посчитаем if not cbNone.Checked then begin if cbMaxScrapRate.Checked then CableReelCalculate(CableTypes, 'MaxScrapRate',ReelsCableFlow, Self); if cbMaxEfficiency.Checked then CableReelCalculate(CableTypes, 'MaxEfficiency',ReelsCableFlow, Self); CableReelNamesToMemTable(MemTable_RCable ,CableTypes); end // если нет - сбросим результаты предидущих расчетов, // в случае наличия таковых else begin if ReelsCableFlow <> nil then ReelsCableFlow.Clear else // нет строк для отчета - создаем пустой список () ReelsCableFlow := TStringList.Create; end; FreeCableTypes(CableTypes); GFormMode := AFormMode; ShowPreparedReport(AParams); //Act_ShowReport.Execute; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderCableReport: '+E.Message); end; end; procedure TF_ResourceReport.ShowFolderDisparityComponReport(AFolder: TSCSCatalog; AParams: TReportItemParams; AFormMode: TResourceReportFormMode); var //FolderIDComponList: TList; ListWithLookedCompons: TList; ptrLookedIDs: PTwoID; CurrIDCompon: Integer; i, j: Integer; Component: TSCSComponent; OwnerCompon: TSCSCatalog; ComponColor: Integer; ComponColorStr: String; ComponIDProducer: Integer; FirstName: String; LastName: String; function CheckNoLookedIDs(AID1, AID2: Integer): Boolean; var i: Integer; begin Result := true; for i := 0 to ListWithLookedCompons.Count - 1 do begin ptrLookedIDs := ListWithLookedCompons[i]; if ( (ptrLookedIDs.ID1 = AID1) and (ptrLookedIDs.ID2 = AID2) ) or ( (ptrLookedIDs.ID1 = AID2) and (ptrLookedIDs.ID2 = AID1) ) then begin Result := false; Break; //// BREAK ///// end; end; end; procedure FindDisparityColorInCompRel(AComponent: TSCSComponent; AOwner: TSCSCatalog; AComponColor: Integer; ACompRelList: Tlist); var i: integer; ptrCompRel: PComplect; SCSComponent: TSCSComponent; OwnerComp: TSCSCatalog; OppositeID: Integer; CompColor: Integer; CompColorStr: String; ConnectKindStr: String; HaveDisparity: Boolean; begin if AComponColor = -1 then Exit; ///// EXIT ///// if Not Assigned(AOwner) then Exit; ///// EXIT ///// //SCSComponent := TSCSComponent.Create(GForm); for i := 0 to ACompRelList.Count - 1 do begin ptrCompRel := ACompRelList[i]; OppositeID := 0; if ptrCompRel.ID_Child <> AComponent.ID then OppositeID := ptrCompRel.ID_Child; if ptrCompRel.ID_Component <> AComponent.ID then OppositeID := ptrCompRel.ID_Component; if OppositeID = 0 then Exit; ///// EXIT ///// if Not CheckNoLookedIDs(AComponent.ID, OppositeID) then Exit; ///// EXIT ///// //SCSComponent.LoadComponentByID(OppositeID, false); SCSComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(OppositeID); if Assigned(SCSComponent) then begin HaveDisparity := false; case AFormMode of fmRDisparityComponColor: begin CompColor := SCSComponent.GetPropertyValueAsInteger(pnColor); if (AComponColor <> CompColor) and (CompColor <> -1) then HaveDisparity := true; end; fmRDisparityComponProducer: if AComponent.ID_Producer <> SCSComponent.ID_Producer then HaveDisparity := true; end; //*** Если цвета не совпадают, то вывести компоненты в отчет if HaveDisparity then begin OwnerComp := SCSComponent.GetFirstParentCatalog; if Assigned(OwnerComp) then begin case ptrCompRel.ConnectType of cntComplect: ConnectKindStr := cResourceReport_Msg6_1; cntUnion: ConnectKindStr := cResourceReport_Msg6_2; end; MemTable_RDisparityCompColor.Append; MemTable_RDisparityCompColor.FieldByName('ID1').AsInteger := AComponent.ID; MemTable_RDisparityCompColor.FieldByName('Name1').AsString := AComponent.GetNameForVisible(false); //GetComponNameForVisible(AComponent.Name, AComponent.NameMark); MemTable_RDisparityCompColor.FieldByName('Name_Object1').AsString := OwnerComp.GetNameForVisible; //GetNameAndIndexByTCatalog(AOwner); MemTable_RDisparityCompColor.FieldByName('ID2').AsInteger := SCSComponent.ID; MemTable_RDisparityCompColor.FieldByName('Name2').AsString := SCSComponent.GetNameForVisible(false); //GetComponNameForVisible(SCSComponent.Name, SCSComponent.NameMark); MemTable_RDisparityCompColor.FieldByName('Name_Object2').AsString := OwnerComp.GetNameForVisible; //GetNameAndIndexByTCatalog(OwnerComp); MemTable_RDisparityCompColor.FieldByName('Name_Connect_Type').AsString := ConnectKindStr; MemTable_RDisparityCompColor.Post; New(ptrLookedIDs); ptrLookedIDs.ID1 := AComponent.ID; ptrLookedIDs.ID2 := SCSComponent.ID; ListWithLookedCompons.Add(ptrLookedIDs); end; end; end; end; //SCSComponent.Free; end; begin try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FCatalog := AFolder; //FolderIDComponList := Tlist.Create; ListWithLookedCompons := TList.Create; //WholeComponent := nil; //Component := TSCSComponent.Create(GForm); //FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine, itSCSConnector]); //if FolderIDComponList = nil then // Exit; ///// EXIT ///// MemTable_RDisparityCompColor.Active := false; MemTable_RDisparityCompColor.Active := true; BeginProgress(pcPreparingReport); try with TF_Main(GForm) do for i := 0 to AFolder.ComponentReferences.Count - 1 do //for i := 0 to FolderIDComponList.Count - 1 do begin //Component.LoadComponentByID(Integer(FolderIDComponList[i]^), false); //OwnerCompon := DM.GetCatalogByCompon(Component.ID); Component := AFolder.ComponentReferences[i]; OwnerCompon := Component.GetFirstParentCatalog; ComponColor := clWhite; case AFormMode of fmRDisparityComponColor: ComponColor := Component.GetPropertyValueAsInteger(pnColor); {fmRDisparityComponProducer: ComponIDProducer} end; /////////Component.LoadComplects; FindDisparityColorInCompRel(Component, OwnerCompon, ComponColor, Component.Complects); /////////Component.LoadConections; FindDisparityColorInCompRel(Component, OwnerCompon, ComponColor, Component.Connections); end; finally EndProgress; FreeList(ListWithLookedCompons); end; GFormMode := AFormMode; //fmRDisparityComponColor; ShowPreparedReport(AParams); //Act_ShowReport.Execute; //ShowModal; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderDisparityComponReport: '+E.Message); end; end; // кабельный журнал procedure TF_ResourceReport.ShowFolderCableJournal(AFolder: TSCSCatalog; AParams: TReportItemParams; AResRepFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveDismountAccount, AFullPath: Boolean); var //FolderIDComponList: TList; AllAllTraceLength: double; ListWithLookedCompons: TList; CatalogList : TSCSCatalogs; currSCSCatalog,nextSCSCatalog : TSCSCatalog; CurrIDCompon: Integer; i, j, k, l, m, n: Integer; SCSComponent : TSCSComponent; PartSCSComponent1, PartSCSComponent2 : TSCSComponent; // части кабеля TopSCSComponent : TSCSComponent; ComponList: TSCSComponents; ComponCatagoryStr: String; ComponCatagory: Integer; Interfaces : TSCSInterfaces; CurrSCSCatalogs : TSCSCatalogs; propList,propList1 : TstringList; ListCAD : TF_CAD; currTrace,NextTrace : TFigure; // трассы, по которым проходит кабель currLine : TOrthoLine; ppropList : ^TStringList; FirstTraceFound, NextTraceFound : Boolean; Figure : TFigure; Ortholine : TOrtholine; Connector1, Connector2, Connector3, Connector4 : TConnectorObject; Compon1,Compon2,Compon3,Compon4 : TSCSComponent; // ComponList : TSCSComponents; List : TList; LineJoins : TStringList; indexes : ^integer; s : string; CableTypes : TCableTypeArray; CableIdsList : TintList; // SCSObject : TSCSObject; //InterfPortsNppFrom: TStringList; //InterfTypesFrom: TStringList; //InterfPortsNppTo: TStringList; //InterfTypesTo: TStringList; ListName: String; FirstComponent: TSCSComponent; LastComponent: TSCSComponent; FromNppPort, FromNppPort1: Integer; FromNppPortFromPos: Integer; FromNppPortToPos: Integer; FromPortName: String; FromPort: TSCSInterface; ToNppPort: Integer; ToNppPortFromPos: Integer; ToNppPortToPos: Integer; ToPortName: String; ToPort: TSCSInterface; InterfCount: Integer; MasterID: Integer; ComponSignType: Integer; ComponMarkTemplate: string; ListOwner, ListOwner1: TSCSList; TraceListOwner : TSCSList; RoomOwner: TSCSCatalog; SprComponentType: TNBComponentType; Ports: TSCSInterfaces; Port : TSCSInterface; childCompon : TSCSComponent; ptrID: ^Integer; FirstCompon, LastCompon,currCompon : TSCScomponent; PortCountTo, PortCountFrom : Integer; { function GetNameFrom(AFirstConnCompon: TSCSComponent): String; var //CompCatalog: TCatalog; OwnerCatalog: TSCSCatalog; TopComponent: TSCSComponent; begin Result := ''; if Assigned(AFirstConnCompon) then begin TopComponent := AFirstConnCompon.GetTopComponent; if (TopComponent <> nil) and (TopComponent <> AFirstConnCompon) then Result := TopComponent.NameMark; //OwnerCatalog := AFirstConnCompon.GetFirstParentCatalog; //if Assigned(OwnerCatalog) then //begin // Result := OwnerCatalog.GetNameForVisible(false); //end; end; end; } // function GetNameTo(ALastConnCompon, ALastLineCompon: TSCSComponent; var aNppPort: Integer; var aPortName: String; aPort: TSCSInterface=nil; aPortFromPos: Integer=0; aPortToPos: Integer=0): String; var //HaveParent: Boolean; //IDCurrCompon: Integer; //PathList: TStringList; //i: Integer; //ResName: String; //LastConnCompon: TSCSComponent; //CurrCompon: TSCSComponent; ListOwner: TSCSList; LastConnComponObject: TSCSCatalog; TopComponent: TSCSComponent; ParentComponent: TSCSComponent; ComponPath: TSCSComponents; DepthJoinedConnCompon: TSCSComponent; DepthComponInterfs: TSCSInterfaces; PrevDepthComponInterfs: TSCSInterfaces; Interf: TSCSInterface; NppPortList: TIntList; PortName: String; i,m: Integer; InternalJoinedCompon, PrevInternalJoinedCompon: TSCSComponent; NppFrom, NppTo: Integer; begin Result := ''; //LastConnComponObject := ALastConnCompon.GetFirstParentCatalog; //if Assigned(LastConnComponObject) then // Result := LastConnComponObject.GetNameForVisible + '\'; //Result := Result + ALastConnCompon.GetNameForVisible; ComponPath := TSCSComponents.Create(false); TopComponent := ALastConnCompon.GetTopComponent; if (TopComponent <> nil) and (TopComponent <> ALastConnCompon) then Result := TopComponent.NameMark + '\'; ListOwner := ALastConnCompon.GetListOwner; if ListOwner <> nil then begin //01.08.2012 DepthJoinedConnCompon := GetDepthJoinedConnComponByConnCompon(ALastConnCompon, ComponPath, nil, nil, nil); DepthComponInterfs := TSCSInterfaces.Create(false); PrevDepthComponInterfs := TSCSInterfaces.Create(false); DepthJoinedConnCompon := GetDepthJoinedConnComponByConnCompon(ALastConnCompon, ComponPath, nil, DepthComponInterfs, PrevDepthComponInterfs, aPort, aPortFromPos, aPortToPos, true); //01.08.2012 - определяем порт внутреннего компонента if DepthJoinedConnCompon <> ALastConnCompon then if PrevDepthComponInterfs.Count > 0 then begin for i := 0 to DepthComponInterfs.Count - 1 do begin Interf := DepthComponInterfs[i]; NppPortList := nil; if Interf.IsPort = biTrue then begin NppPortList := GetNppPortsByConnected(Interf, Interf, PrevDepthComponInterfs[0]); PortName := Interf.LoadName; end else if Interf.PortOwner <> nil then begin NppPortList := GetNppPortsByConnected(Interf.PortOwner, Interf, PrevDepthComponInterfs[0]); PortName := Interf.PortOwner.LoadName; end; if NppPortList <> nil then begin if NppPortList.Count > 0 then begin aNppPort := NppPortList[0]; aPortName := PortName; end; FreeAndNil(NppPortList); end; end; end; FreeAndNil(DepthComponInterfs); FreeAndNil(PrevDepthComponInterfs); //*** Если нужно отображать полный путь к уcтройству // начинаем с компоненты на уровень выше, т.к DepthJoinedConnCompon будет добавлена ниже if AFullPath then begin Result := ''; //04.02.2013 ParentComponent := DepthJoinedConnCompon.GetParentComponent; ParentComponent := ComponPath[0].GetParentComponent; // компонент к которому подключен кабель while ParentComponent <> nil do begin if ParentComponent.NameMark <> '' then begin if Result <> '' then Result := '\' + Result; //04.02.2013 Result + '\'; Result := ParentComponent.NameMark + Result; end; ParentComponent := ParentComponent.GetParentComponent; end; if Result <> '' then Result := Result + '\'; end; //*** Если внешний СКС, то выводим полный путь подключений, иначе подключенный компонент вглубине //01.08.2012 if ListOwner.Setting.SCSType = st_External then if (ListOwner.Setting.SCSType = st_External) or AFullPath then begin PrevInternalJoinedCompon := nil; for i := 0 to ComponPath.Count - 1 do begin InternalJoinedCompon := ComponPath[i]; //04.02.2013 отображаем номер порта пред. внутреннего компонента, к которому пдключен InternalJoinedCompon if PrevInternalJoinedCompon <> nil then if GetPortInfoByJoinedCompons(PrevInternalJoinedCompon, InternalJoinedCompon, NppFrom, NppTo) then begin if NppFrom = NppTo then Result := Result +' ('+cNamePort+' '+IntToStr(NppFrom)+')' else Result := Result +' ('+cNamePort+' '+IntToStr(NppFrom)+'-'+IntToStr(NppTo)+')'; end; if i > 0 then Result := Result + '->'; Result := Result + ComponPath[i].GetNameForVisible; PrevInternalJoinedCompon := InternalJoinedCompon; //04.02.2013 end; end else Result := Result + DepthJoinedConnCompon.GetNameForVisible; end else Result := Result + ALastConnCompon.GetNameForVisible; { 20070709 TopComponent := ALastConnCompon.GetTopComponent; if (TopComponent <> nil) and (TopComponent <> ALastConnCompon) then Result := TopComponent.NameMark + '\'; Result := Result + ALastConnCompon.GetNameForVisible; } {PathList := TStringList.Create; //IDCurrCompon := AIDLastConnCompon; HaveParent := True; //LastConnCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AIDLastConnCompon); LastConnCompon := ALastConnCompon; if Assigned(LastConnCompon) then begin CurrCompon := LastConnCompon; while Assigned(CurrCompon) do begin if PathList.Count < 1 then PathList.Insert(0, CurrCompon.GetNameForVisible(false)) else PathList.Insert(0, CurrCompon.Name); if CurrCompon.Parent is TSCSComponent then CurrCompon := TSCSComponent(CurrCompon.Parent) else CurrCompon := nil; end; end; ResName := ''; for i := 0 to PathList.Count - 1 do begin if i = 0 then ResName := PathList.Strings[i] else ResName := ResName + ' \ ' + PathList.Strings[i]; end; PathList.Free; Result := ResName;} end; {function GetMultiPortNameMark(APointComponent: TSCSComponent): String; var CurrParentComponent: TSCSComponent; ResComponent: TSCSComponent; begin Result := ''; if APointComponent <> nil then begin ResComponent := APointComponent; CurrParentComponent := APointComponent; while CurrParentComponent <> nil do begin if CurrParentComponent.ComponentType.PortKind = pkMultiPort then begin ResComponent := CurrParentComponent; Break; //// BREAK //// end; CurrParentComponent := CurrParentComponent.GetParentComponent; end; if ResComponent.NameMark <> '' then Result := ResComponent.NameMark else Result := IntToStr(ResComponent.MarkID); end; end;} //Tolik Procedure SaveTracedCable(Compon: TSCSComponent); Var i, j, k : Integer; AllCable: TSCSComponents; FirstConnected, LastConnected: TSCSComponents; Interf: TSCSInterFace; InterFacePosition: TSCSInterfPosition; EndAssigned: Boolean; ConnectionSide: Integer; BeginDescription, EndDescription: String; BeginCompon, EndCompon: TSCSComponent; SCSCompon: TSCScomponent; TracePart: string; AllTraceLength, TracePartLength: Double; CrossSquare: String; PropFound: Boolean; Parent,Parent1 : TSCSComponent; // Tolik 10/08/2017 -- // возвращает полное наименование (путь) от самого верхнего компонента типа: шкаф/панель/плинт -- до порта) Procedure CheckConnectionSide(var ConnectedCompons: TSCSComponents; var Descript: string; var ConnectedCompon: TSCSComponent); var ConnSide: Integer; i, j, k : Integer; isLineConnection: Boolean; PathList: TstringList; ComponPath: String; PathIndex: Integer; PathString: String; StringAdded: Boolean; function GetComponPath(aCompon: TSCSComponent): String; var CanSeekPath: Boolean; ParentCompon: TSCSComponent; begin Result := ''; ParentCompon := aCompon.GetParentComponent; if ParentCompon <> nil then begin //Result := ParentCompon.Name + ' '+inttostr(ParentCompon.MarkID); Result := ParentCompon.Name + ' '+ParentCompon.NameMark; CanSeekPath := True; while CanSeekPath do begin CanSeekPath := False; ParentCompon := ParentCompon.GetParentComponent; if ParentCompon <> nil then begin CanSeekPath := True; // Result := ParentCompon.Name + ' '+inttostr(ParentCompon.MarkID) + '/'+Result; Result := ParentCompon.Name + ' '+ParentCompon.NameMark + '/'+Result; end; end; end; end; Begin PathList := TStringList.Create; ConnSide := ConnectionSide; EndAssigned := false; While not EndAssigned do begin if ConnSide = 0 then break; for i := 0 to SCSCompon.Interfaces.Count - 1 do begin if ( (SCSCompon.Interfaces[i].TypeI = itFunctional) and (SCSCompon.Interfaces[i].Side = ConnSide) and ((SCSCompon.Interfaces[i].IsBusy = biTrue) or (SCSCompon.Interfaces[i].KolvoBusy > 0 )) ) then begin for j := 0 to SCSCompon.Interfaces[i].BusyPositions.Count - 1 do begin InterFacePosition := SCSCompon.Interfaces[i].BusyPositions[j]; InterFacePosition := InterFacePosition.GetConnectedPos; Interf := TSCSInterFace(InterFacePosition.InterfOwner); if Interf.ComponentOwner <> nil then begin if ConnectedCompons.IndexOF(Interf.ComponentOwner) = -1 then ConnectedCompons.Add(Interf.ComponentOwner); end; end; end; end; // если нашли точечный компонент, скрутку или ничего не нашли, здесь будет конец кабеля if ( (ConnectedCompons.Count = 0) or ((ConnectedCompons.Count = 1) and (ConnectedCompons[0].IsLine = biFalse)) or (ConnectedCompons.Count > 1) ) then begin if ConnectedCompons.Count = 0 then begin Descript := cRepMsg267; ConnectedCompon := nil; end; if ConnectedCompons.Count > 1 then begin // Tolik -- 23/06/2016 -- isLineConnection := True; for i := 0 to ConnectedCompons.Count - 1 do begin if TSCSComponent(ConnectedCompons[i]).IsLine = biFalse then begin isLineConnection := False; break; end; end; if isLineConnection then Descript := cRepMsg246 else begin //Descript := ConnectedCompon.Name + ' ' + ConnectedCompon.NameMark; if ConnectedCompons.Count > 0 then begin for i := 0 to ConnectedCompons.Count - 1 do begin ConnectedCompon := TSCSComponent(ConnectedCompons[i]); StringAdded := False; ComponPath := ''; //Descript := ConnectedCompon.Name + ' ' + IntToStr(ConnectedCompon.MarkID); Descript := ConnectedCompon.Name + ' ' +ConnectedCompon.NameMark; if cbFullPathInCableJournal.Checked then ComponPath := GetComponPath(ConnectedCompon); if ComponPath <> '' then begin for j := 0 to PathList.Count - 1 do begin PathString := PathList[j]; if Pos(ComponPath, PathString) <> 0 then begin StringAdded := True; PathString := PathString + ',' + Descript; PathList[j] := PathString; break; end; end; if Not StringAdded then PathList.Add(ComponPath + '/' + Descript); end else begin PathList.Add(Descript); end; end; Descript := PathList.Text; end; end; end else if ConnectedCompons.Count = 1 then begin ConnectedCompon := ConnectedCompons.Items[0]; // Tolik 23/10/2020 -- //if cbFullPathInCableJournal.Checked then if not cbFullPathInCableJournal.Checked then // а то кнопочка работает наоборот... Descript := ConnectedCompon.Name + ConnectedCompon.NameMark else begin PathString := GetComponPath(ConnectedCompon); if PathString = '' then Descript := ConnectedCompon.Name + ConnectedCompon.NameMark else Descript := PathString + '/' + ConnectedCompon.Name + ConnectedCompon.NameMark; end; end; EndAssigned := true; end else begin if ((ConnectedCompons.Count = 1) and (ConnectedCompons[0].isLine = biTrue)) then begin //если тот же кабель пошел дальше if ConnectedCompons[0].Cypher = Compon.Cypher then begin ConnSide := 0; ComponList.Add(ConnectedCompons[0]); //определяем сторону подключения к предидущему for j := 0 to ConnectedCompons[0].Interfaces.count - 1 do begin if ConnectedCompons[0].Interfaces[j].TypeI = itFunctional then begin for k := 0 to ConnectedCompons[0].Interfaces[j].BusyPositions.Count - 1 do begin InterFacePosition := ConnectedCompons[0].Interfaces[j].BusyPositions[k]; InterFacePosition := InterFacePosition.GetConnectedPos; Interf := TSCSInterface(InterFacePosition.InterfOwner); if Interf.ComponentOwner = SCSCompon then begin ConnSide := ConnectedCompons[0].Interfaces[j].Side; break; end; end; end; if ConnSide <> 0 then break; end; //сторону подключения меняем, чтобы посмотреть, что подключено с другого конца if ConnSide = 1 then ConnSide := 2 else if ConnSide = 2 then ConnSide := 1; // SCSCompon := ConnectedCompons[0]; if ComponList.IndexOF(SCSCompon) = -1 then ComponList.Add(SCSCompon); if ConnectionSide = 1 then AllCable.Insert(0, SCSCompon) else if ConnectionSide = 2 then AllCable.Add(SCSCompon); ConnectedCompons.Clear; end else begin Descript := cRepMsg242; ConnectedCompon := ConnectedCompons.Items[0]; EndAssigned := true; end; end; end; end; End; Procedure ExcangeSides; var tmpList: TSCSComponents; i: Integer; tmpCompon: TSCSComponent; s: string; begin tmpCompon := BeginCompon; BeginCompon := EndCompon; EndCompon := tmpCompon; tmpList := TSCSComponents.Create(false); tmpList.Assign(FirstConnected, laCopy); FirstConnected.Clear; FirstConnected.Assign(LastConnected, laCopy); LastConnected.Assign(tmpList, laCopy); tmpList.Clear; tmpList.Assign(AllCable,laCopy); AllCable.Clear; for i := tmpList.Count - 1 downto 0 do AllCable.Add(tmpList[i]); tmpList.Clear; s := BeginDescription; BeginDescription := EndDescription; EndDescription := s; tmpList.free; end; // Begin AllCable := TSCSComponents.Create(false); SCSCompon := Compon; FirstConnected := TSCSComponents.Create(false); LastConnected := TSCSComponents.Create(false); BeginDescription := ''; EndDescription := ''; BeginCompon := nil; EndCompon := nil; ALLCable.Add(SCSCompon); // подключение кабеля с одной стороны EndAssigned := false; ConnectionSide := 1; CheckConnectionSide(FirstConnected, BeginDescription, BeginCompon); // подключение кабеля с другой стороны EndAssigned := false; ConnectionSide := 2; SCSCompon := Compon; CheckConnectionSide(LastConnected, EndDescription, EndCompon); CrossSquare := ''; TracePart := ''; TracePartLength := 0; AllTraceLength := 0; // Tolik --10/08/20107 -- перевернуть, если не сходится направление подключения // Tolik -- 10/08/2017 -- Compon.RefreshWholeLengthIfNecessary; Compon.LoadWholeComponent(false); Compon.LoadWholeLength; Compon.DefineFirstLast; // if (BeginCompon <> nil) and (EndCompon <> nil) then if (BeginCompon <> Compon.FirstConnectedConnCompon) or (FirstConnected.IndexOf(BeginCompon) = -1) then ExcangeSides; SCSCompon := AllCable[0]; // TracePartLength := AllCable[0].Length; AllTraceLength := RoundX(AllCable[0].GetPartLength, 2); SCSCompon := AllCable[0]; if SCSCompon.GetParentComponent <> nil then TracePart := SCSCompon.GetParentComponent.NameShort else TracePart := cRepMsg265; TracePartLength := Roundx(SCSCompon.GetPartLength, 2); for i := 1 to AllCable.Count - 1 do begin // оба куска кабеля вложены в ложемент или гофру if (AllCable[i - 1].GetParentComponent <> nil) and (AllCable[i].GetParentComponent <> nil) then begin Parent := AllCable[i - 1].GetParentComponent; Parent1 := AllCable[i].GetParentComponent; SCSCompon := AllCable[i]; //если в одинаковую, то просто складываем длину if Parent.NameShort = Parent1.NameShort then begin TracePartLength := TracePartLength + RoundX(SCSCompon.GetPartLength, 2); end // если не в одинаковую, то добавляем имена else begin // верхний компонент дописываем, если есть TracePart := TracePart + ' - ' + Floattostr(TracePartLength)+'м; ' + Parent1.NameShort; // длину сбрасываем TracePartLength := RoundX(SCSCompon.GetPartLength, 2); end; end; // оба куска кабеля просто лежат на трассах if (AllCable[i - 1].GetParentComponent = nil) and (AllCable[i].GetParentComponent = nil) then begin TracePartLength := TracePartLength + RoundX(AllCable[i].GetPartLength, 2); end; // кусок на трассе, кусок - вложен if ( ((AllCable[i - 1].GetParentComponent <> nil) and (AllCable[i].GetParentComponent = nil)) or ((AllCable[i - 1].GetParentComponent = nil) and (AllCable[i].GetParentComponent <> nil)) ) then begin TracePart := TracePart + ' - '+Floattostr(TracePartLength)+'м;'; if AllCable[i].GetParentComponent = nil then TracePart := TracePart + cRepMsg265 else TracePart := TracePart + ' ' + AllCable[i].GetParentComponent.NameShort; TracePartLength := RoundX(AllCable[i].GetPartLength,2); end; AllTraceLength := AllTraceLength + RoundX(AllCable[i].GetPartLength, 2); end; AllAllTraceLength := AllAllTraceLength + AllTraceLength; //Tolik 23/10/2020 -- не матры, а единицы измерения, принятые в проекте //TracePart := TracePart + '-' + Floattostr(TracePartLength) + cRepMsg266; TracePart := TracePart + '-' + Floattostr(RoundX(FloatInUOM(TracePartLength, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure),2)) + ' ' + GetNameUOM(TF_Main(GForm).FUOM, true); // // ищем сечение кабеля и количество жил (если задано) PropFound := false; if AllCable[0].GetPropertyBySysName(pnWireCount) <> nil then begin CrossSquare := AllCable[0].GetPropertyBySysName(pnWireCount).Value; end; CrossSquare := CrossSquare + 'х' + floattostr(RoundX(AllCable[0].GetVolume(gtMale, '', true),2)); // если выводить полный путь к компонентам //Tolik { if cbFullPathInCableJournal.Checked then begin while not BeginCompon.IsTop do begin BeginCompon := BeginCompon.GetParentComponent; BeginDescription := BeginDescription + '/' + BeginCompon.NameMark; end; while not EndCompon.IsTop do begin EndCompon := EndCompon.GetParentComponent; EndDescription := EndCompon.NameMark + '/' + EndDescription; end; end; } MemTable_RCableJournal.Append; MemTable_RCableJournal.FieldByName(fnName).AsString := Compon.NameMark; // обозначение кабеля MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := BeginDescription; // начало MemTable_RCableJournal.FieldByName(fnNameTo).AsString := EndDescription; // конец MemTable_RCableJournal.FieldByName(fnTraceCabling).AsString := TracePart; // участок трассы, кабеля MemTable_RCableJournal.FieldByName(fnNameMark).AsString := Compon.Name; // марка MemTable_RCableJournal.FieldByName(fnTotalKolvo).AsString := CrossSquare; // количество,число и сечение жид // Tolik 18/10/2020 -- // MemTable_RCableJournal.FieldByName(fnLength).asFloat := AllTraceLength; // длина, м MemTable_RCableJournal.FieldByName(fnLength).asFloat := RoundX(FloatInUOM(AllTraceLength, umMetr, F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure),2); // длина в единицах измерения проекта // MemTable_RCableJournal.FieldByName(fnNotice).asString := SCSCompon.Notice; // примечание if BeginCompon <> nil then MemTable_RCableJournal.FieldByName(fnNameBegin).AsString := BeginCompon.GetFirstParentCatalog.GetNameForVisible(false); // парент каталог для начала if EndCompon <> nil then MemTable_RCableJournal.FieldbyName(fnNameEnd).AsString := EndCompon.GetFirstParentCatalog.GetNameForVisible(false); // парент каталог для конца FreeAndNil(ALLCable); FreeAndNil(FirstConnected); FreeAndNil(LastConnected); End; begin // Tolik 02/09/2020 -- MemTable_RCableJournal.Close; MemTable_RCableJournal.Open; // MemTable_RCableJournal.FieldDefs.Clear; MemTable_RCableJournal.FieldDefs.Add(fnID, ftAutoInc); MemTable_RCableJournal.FieldDefs.Add(fnNameList, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameCable, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnName, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameMark, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftInteger); //MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnComponentIndex, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnIZM, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnCategory, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnLength, ftFloat); //Tolik -- 24/06/2016 -- не влазит, надо расширить // MemTable_RCableJournal.FieldDefs.Add(fnNameFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameFrom, ftString, 3000); // //MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeFrom, ftString, 255); //Tolik -- 24/06/2016 -- не влазит, надо расширить //MemTable_RCableJournal.FieldDefs.Add(fnNameTo, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameTo, ftString, 3000); // //MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeTo, ftString, 255); //Added by Tolik MemTable_RCableJournal.FieldDefs.Add(fnMarks, ftMemo); // маркировки компонентов по всему кабелю MemTable_RCableJournal.FieldDefs.Add(fnPrices, ftMemo); // стоимость кабеля на каждом участке MemTable_RCableJournal.FieldDefs.Add(fnLengthReserv, ftFloat); // запас кабеля MemTable_RCableJournal.FieldDefs.Add(fnReelName,ftString,255); // наименование катушки, из которой отрезан кабель MemTable_RCableJournal.FieldDefs.Add(fnTraceCabling, ftString, 255); // участок трассы, кабеля MemTable_RCableJournal.FieldDefs.Add(fnTotalKolvo, ftString, 255); // количество, число и сечение жил MemTable_RCableJournal.FieldDefs.Add(fnNotice, ftString, 255); // примечание (можно использовать как альтернативную маркировку) MemTable_RCableJournal.FieldDefs.Add(fnNameBegin, ftString, 255); // парент каталог начала MemTable_RCableJournal.FieldDefs.Add(fnNameEnd, ftString, 255); // парент каталог конца MemTable_RCableJournal.Close; MemTable_RCableJournal.Open; // Tolik // Старая форма отчета //Tolik02/09/2020 if (cbOldReportForm.Visible = false) or ((cbOldReportForm.Visible = true) and cbOldReportForm.Checked) then //if cbOldReportForm.Checked then // begin try SetLength(CableTypes,0); if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FCatalog := AFolder; //FolderIDComponList := Tlist.Create; ListWithLookedCompons := TList.Create; //InterfPortsNppFrom := TStringList.Create; //InterfTypesFrom := TStringList.Create; //InterfPortsNppTo := TStringList.Create; //InterfTypesTo := TStringList.Create; //WholeComponent := nil; //Component := TSCSComponent.Create(GForm); //FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine]); //if FolderIDComponList = nil then // Exit; ///// EXIT ///// MemTable_RCableJournal.Active := false; MemTable_RCableJournal.Active := true; //MemTable_RPortToAndFrom.Active := false; //MemTable_RPortToAndFrom.Active := true; BeginProgress(pcPreparingReport); // Tolik if CableIdsList = nil then CableIdsList := TIntList.Create else CableIdsList.Clear; if not cbShowCablePath.Checked then // если не учитывать путь кабеля, то показать // стандартный отчет // begin try with TF_Main(GForm).DM do begin for i := 0 to AFolder.ComponentReferences.Count - 1 do //for i := 0 to FolderIDComponList.Count - 1 do begin //CurrIDCompon := Integer(FolderIDComponList.Items[i]^); SCSComponent := AFolder.ComponentReferences[i]; if Assigned(SCSComponent) then begin // по типу сети if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1)) then begin ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (SCSComponent.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then begin if SCSComponent.HaveInterfaceByType(itFunctional) then //*** Есть ли функциональные интерфейсы begin //if ((CheckSysNameIsCable(SCSComponent.ComponentType.SysName)) and if ( IsCableComponent(SCSComponent) and // Tolik 24/06/2016 -- так правильнее будет(точно будем понимать, что это -- кабель) // Tolik -- отфильтровать сети по типам, но только в том случае, если выбраны все, если выбраны не все - // фильтровать не будем, чтобы дать возможность показать в отчете не только компьютерные сети // (not (SCSComponent.IDNetType in [3,4,5,7])) and // Tolik -- 12/07/2016 -- // (((not (SCSComponent.IDNetType in [3,4,5,7])) and AllNetTypes) or (not AllNetTypes)) and (((SCSComponent.IDNetType in [3,{4,}5,7]) and (not AllNetTypes)) or AllNetTypes) and // CheckNoIDinList(SCSComponent.ID, ListWithLookedCompons)) then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.LoadWholeComponent(false); SCSComponent.LoadWholeLength; SCSComponent.DefineFirstLast; //if (SCSComponent.FirstIDConnectedConnCompon > 0) and // (SCSComponent.LastIDConnectedConnCompon > 0) then if Assigned(SCSComponent.FirstConnectedConnCompon) and Assigned(SCSComponent.LastConnectedConnCompon) and CheckCanLookComponInReportCable(SCSComponent.FirstConnectedConnCompon, ACanHaveDismountAccount) and CheckCanLookComponInReportCable(SCSComponent.LastConnectedConnCompon, ACanHaveDismountAccount) then begin if Not ACanHaveDismountAccount or Not CheckHaveWholeComponentDismounted(FCatalog, SCSComponent.WholeComponent) then begin //01.04.2009 SCSComponent.RefreshWholeLengthIfNecessary; // Если требуется рассчитать расход кабеля из катушек // формируем по ходу список типов кабелей if not cbNone.Checked then CableTypesAdd(SCSComponent, CableTypes, CableIdsList, MemTable_RCableJournal.AutoIncValue+1, self); ComponCatagoryStr := ''; ComponCatagoryStr := SCSComponent.GetPropertyValueBySysName(pnCategory); ListName := ''; FirstComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.FirstIDCompon); LastComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.LastIDCompon); LoadPortName(SCSComponent.FirstIDConnectedConnCompon, SCSComponent.FirstIDCompon, FromNppPort, FromPortName, @FromPort, @FromNppPortFromPos, @FromNppPortToPos); LoadPortName(SCSComponent.LastIDConnectedConnCompon, SCSComponent.LastIDCompon, ToNppPort, ToPortName, @ToPort, @ToNppPortFromPos, @ToNppPortToPos); if AResRepFormMode = fmRCableJournal then begin if (FirstComponent <> nil) and (LastComponent <> nil) then begin if FirstComponent.ListID = LastComponent.ListID then ListName := GetListName(FirstComponent) else ListName := GetListName(FirstComponent) + '/' + GetListName(LastComponent); end; MemTable_RCableJournal.Append; MemTable_RCableJournal.FieldByName(fnNameList).AsString := ListName; MemTable_RCableJournal.FieldByName(fnNameCable).AsString := SCSComponent.GetNameForVisible(false); //GetComponNameForVisible(Component.Name, Component.NameMark); MemTable_RCableJournal.FieldByName(fnName).AsString := SCSComponent.Name; MemTable_RCableJournal.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; //MemTable_RCableJournal.FieldByName(fnMarkID).AsString := IntToStr(SCSComponent.MarkID); MemTable_RCableJournal.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; MemTable_RCableJournal.FieldByName(fnCategory).AsString := ComponCatagoryStr; if CheckPriceTransformToUOMByCompType(@SCSComponent.ComponentType) then begin MemTable_RCableJournal.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); MemTable_RCableJournal.FieldByName(fnLength).AsFloat := FloatInUOM(SCSComponent.Length, umMetr, TF_Main(GForm).FUOM); //MemTable_RCableJournal.FieldByName(fnLength).AsString := FormatFloat(ffMask, FloatInUOM(SCSComponent.Length, umMetr, TF_Main(GForm).FUOM)); end else begin MemTable_RCableJournal.FieldByName(fnIzm).AsString := SCSComponent.Izm; MemTable_RCableJournal.FieldByName(fnLength).AsFloat := SCSComponent.Length; //MemTable_RCableJournal.FieldByName(fnLength).AsString := FormatFloat(ffMask, SCSComponent.Length); end; MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := GetNameTo(SCSComponent.FirstConnectedConnCompon, FirstComponent, FromNppPort, FromPortName, FromPort, FromNppPortFromPos, FromNppPortToPos); //GetNameFrom(SCSComponent.FirstConnectedConnCompon); MemTable_RCableJournal.FieldByName(fnNameTo).AsString := GetNameTo(SCSComponent.LastConnectedConnCompon, LastComponent, ToNppPort, ToPortName, ToPort, ToNppPortFromPos, ToNppPortToPos); MemTable_RCableJournal.FieldByName(fnPortNameFrom).AsInteger := FromNppPort; // MemTable_RCableJournal.FieldByName(fnPortTypeFrom).AsString := FromPortName; MemTable_RCableJournal.FieldByName(fnPortNameTo).AsInteger := ToNppPort; MemTable_RCableJournal.FieldByName(fnPortTypeTo).AsString := ToPortName; MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; MemTable_RCableJournal.Post; end else if AResRepFormMode = fmRGOSTCableJournal then begin if FirstComponent <> nil then begin ListName := GetListName(FirstComponent); RoomOwner := GetComponObjectOwnerByItemType(FirstComponent, itRoom); if RoomOwner <> nil then ListName := ListName + '. '+ RoomOwner.GetNameForVisible; end; //*** Определить шаблон мркировки ComponMarkTemplate := ''; ListOwner := nil; if FirstComponent <> nil then ListOwner := FirstComponent.GetListOwner else if LastComponent <> nil then ListOwner := LastComponent.GetListOwner else ListOwner := SCSComponent.GetListOwner; if ListOwner <> nil then SprComponentType := ListOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if SprComponentType <> nil then ComponMarkTemplate := SprComponentType.ComponentType.MarkMask; //*** Удалить обозначение из if ComponMarkTemplate <> '' then if Pos(mteNameShort, ComponMarkTemplate) <> 0 then Delete(ComponMarkTemplate, Pos(mteNameShort, ComponMarkTemplate), Length(mteNameShort)); MemTable_RCableJournal.Append; //MemTable_RCableJournal.FieldByName(fnMarkID).AsString := TF_Main(SCSComponent.ActiveForm).MakeNameMarkComponent(SCSComponent, SCSComponent.GetFirstParentCatalog, false, ComponMarkTemplate); // номер кабеля MemTable_RCableJournal.FieldByName(fnNameMark).AsString := TF_Main(SCSComponent.ActiveForm).MakeNameMarkComponent(SCSComponent, SCSComponent.GetFirstParentCatalog, false, ComponMarkTemplate); // номер кабеля MemTable_RCableJournal.FieldByName(fnComponentIndex).AsInteger := SCSComponent.MarkID; MemTable_RCableJournal.FieldByName(fnNameCable).AsString := SCSComponent.NameShort; //Тип кабеля MemTable_RCableJournal.FieldByName(fnNameTo).AsString := GetMultiPortNameMark(SCSComponent.LastConnectedConnCompon, true); // Номер комутационной панели MemTable_RCableJournal.FieldByName(fnPortNameTo).AsString := IntToStr(ToNppPort); // Номер порта панели MemTable_RCableJournal.FieldByName(fnNameList).AsString := ListName; // Откуда приходит MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := GetMultiPortNameMark(SCSComponent.FirstConnectedConnCompon, true); // Номер розетки MemTable_RCableJournal.FieldByName(fnPortNameFrom).AsString := IntToStr(FromNppPort);// IntToStr(FromNppPort); // номер порта розетки MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; MemTable_RCableJournal.Post; end; end; end; for j := 0 to SCSComponent.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := SCSComponent.WholeComponent.Items[j]; ListWithLookedCompons.Add(ptrID); end; end; end; end; end; end; end; end; //*** Сортировка //if AResRepFormMode = fmRCableJournal then // MemTable_RCableJournal.SortOn(fnMarkID, []) //else //if AResRepFormMode = fmRGOSTCableJournal then // MemTable_RCableJournal.SortOn(fnMarkID, []); //MemTable_RCableJournal.SortOn(fnMarkID, []); SortMemTableByParams(MemTable_RCableJournal, AParams, nil); finally EndProgress; FreeList(ListWithLookedCompons); end; end else // Added by Tolik (Если учитывать путь кабеля) begin { MemTable_RCableJournal.FieldDefs.Clear; MemTable_RCableJournal.FieldDefs.Add(fnID, ftAutoInc); MemTable_RCableJournal.FieldDefs.Add(fnNameList, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameCable, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnName, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameMark, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftInteger); //MemTable_RCableJournal.FieldDefs.Add(fnMarkID, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnComponentIndex, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnIZM, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnCategory, ftString, 20); MemTable_RCableJournal.FieldDefs.Add(fnLength, ftFloat); MemTable_RCableJournal.FieldDefs.Add(fnNameFrom, ftString, 255); //MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameFrom, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeFrom, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnNameTo, ftString, 255); //MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftString, 255); MemTable_RCableJournal.FieldDefs.Add(fnPortNameTo, ftInteger); MemTable_RCableJournal.FieldDefs.Add(fnPortTypeTo, ftString, 255); //Added by Tolik MemTable_RCableJournal.FieldDefs.Add(fnMarks, ftMemo); // маркировки компонентов по всему кабелю MemTable_RCableJournal.FieldDefs.Add(fnPrices, ftMemo); // стоимость кабеля на каждом участке MemTable_RCableJournal.FieldDefs.Add(fnLengthReserv, ftFloat); // запас кабеля MemTable_RCableJournal.FieldDefs.Add(fnReelName,ftString,255); // наименование катушки, из которой отрезан кабель MemTable_RCableJournal.Close; MemTable_RCableJournal.Open;} // CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(AFolder); CatalogList.AddItems(AFolder.ChildCatalogReferences); SortSCSObjectsByPMOrder(CatalogList); try with TF_Main(GForm).DM do for i := 0 to AFolder.ComponentReferences.Count - 1 do //for i := 0 to FolderIDComponList.Count - 1 do begin //CurrIDCompon := Integer(FolderIDComponList.Items[i]^); SCSComponent := AFolder.ComponentReferences[i]; if Assigned(SCSComponent) then begin // по типу сети if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1)) then begin ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (SCSComponent.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then begin if SCSComponent.HaveInterfaceByType(itFunctional) then //*** Есть ли функциональные интерфейсы begin //Tolik 14/11/2020 -- //if (CheckSysNameIsCable(SCSComponent.ComponentType.SysName) and if (IsCableComponent(SCSComponent) and // // Tolik // (not (SCSComponent.IDNetType in [3,4,5,7])) and (((not (SCSComponent.IDNetType in [3,{4,}5,7])) and AllNetTypes) or (not AllNetTypes)) and // CheckNoIDinList(SCSComponent.ID, ListWithLookedCompons)) then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.LoadWholeComponent(false); SCSComponent.LoadWholeLength; SCSComponent.DefineFirstLast; if Assigned(SCSComponent.FirstConnectedConnCompon) and Assigned(SCSComponent.LastConnectedConnCompon) and CheckCanLookComponInReportCable(SCSComponent.FirstConnectedConnCompon, ACanHaveDismountAccount) and CheckCanLookComponInReportCable(SCSComponent.LastConnectedConnCompon, ACanHaveDismountAccount) then begin if Not ACanHaveDismountAccount or Not CheckHaveWholeComponentDismounted(FCatalog, SCSComponent.WholeComponent) then begin // Если требуется рассчитать расход кабеля из катушек // формируем по ходу список типов кабелей if not cbNone.Checked then CableTypesAdd(SCSComponent, CableTypes, CableIdsList,MemTable_RCableJournal.AutoIncValue + 1, self); //01.04.2009 SCSComponent.RefreshWholeLengthIfNecessary; ComponList := TSCSComponents.create(false); //ComponList1 := TSCSComponents.create(false); SetActualOrderInPartComponent(SCSComponent, ComponList, FromNppPort1, ListName); propList:=tstringList.Create; propList1:=tstringList.Create; GetCablePath(SCSComponent,propList,propList1,ComponList); ComponCatagoryStr := ''; ComponCatagoryStr := SCSComponent.GetPropertyValueBySysName(pnCategory); ListOwner:=nil; SCSComponent.LoadWholeLength; // ListName := ''; FirstComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.FirstIDCompon); LastComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.LastIDCompon); LoadPortName(SCSComponent.FirstIDConnectedConnCompon, SCSComponent.FirstIDCompon, FromNppPort, FromPortName, @FromPort, @FromNppPortFromPos, @FromNppPortToPos); LoadPortName(SCSComponent.LastIDConnectedConnCompon, SCSComponent.LastIDCompon, ToNppPort, ToPortName, @ToPort, @ToNppPortFromPos, @ToNppPortToPos); if AResRepFormMode = fmRCableJournal then begin { if (FirstComponent <> nil) and (LastComponent <> nil) then begin if FirstComponent.ListID = LastComponent.ListID then ListName := GetListName(FirstComponent) else ListName := GetListName(FirstComponent) + '/' + GetListName(LastComponent); end; } MemTable_RCableJournal.Append; MemTable_RCableJournal.FieldByName(fnNameList).AsString := ListName; MemTable_RCableJournal.FieldByName(fnNameCable).AsString := SCSComponent.GetNameForVisible(false); //GetComponNameForVisible(Component.Name, Component.NameMark); MemTable_RCableJournal.FieldByName(fnName).AsString := SCSComponent.Name; MemTable_RCableJournal.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; //MemTable_RCableJournal.FieldByName(fnMarkID).AsString := IntToStr(SCSComponent.MarkID); MemTable_RCableJournal.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; MemTable_RCableJournal.FieldByName(fnCategory).AsString := ComponCatagoryStr; if CheckPriceTransformToUOMByCompType(@SCSComponent.ComponentType) then begin MemTable_RCableJournal.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); MemTable_RCableJournal.FieldByName(fnLength).AsFloat := FloatInUOM(SCSComponent.Length, umMetr, TF_Main(GForm).FUOM); MemTable_RCableJournal.FieldByName(fnLengthReserv).AsFloat := RoundCP(FloatInUOM(SCSComponent.LengthReserv, umMetr, TF_Main(GForm).FUOM)); //MemTable_RCableJournal.FieldByName(fnLength).AsString := FormatFloat(ffMask, FloatInUOM(SCSComponent.Length, umMetr, TF_Main(GForm).FUOM)); end else begin MemTable_RCableJournal.FieldByName(fnIzm).AsString := SCSComponent.Izm; MemTable_RCableJournal.FieldByName(fnLength).AsFloat := SCSComponent.Length; MemTable_RCableJournal.FieldByName(fnLengthReserv).AsFloat := RoundCP(SCSComponent.LengthReserv); //MemTable_RCableJournal.FieldByName(fnLength).AsString := FormatFloat(ffMask, SCSComponent.Length); end; // changed by Tolik // MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := GetNameTo(SCSComponent.FirstConnectedConnCompon, FirstComponent, FromNppPort, FromPortName, FromPort, FromNppPortFromPos, FromNppPortToPos); //GetNameFrom(SCSComponent.FirstConnectedConnCompon); // маркировка начального объекта на пути кабеля try s:=''; if SCSComponent.FirstConnectedConnCompon.GetTopComponent.NameMark <>'' then // если есть маркировка шкафа(или кроса или что там еще) s := SCSComponent.FirstConnectedConnCompon.GetTopComponent.NameMark; if s = '' then begin if SCSComponent.FirstConnectedConnCompon.NameMark <> '' then // если нет - ищем маркировку порта s := SCSComponent.FirstConnectedConnCompon.NameMark; end; if s = '' then begin if SCSComponent.FirstConnectedConnCompon.GetParentComponent.NameMark<>'' then // если нет - ищем маркировку патч -панели begin s := SCSComponent.FirstConnectedConnCompon.GetParentComponent.NameMark; end; end; if s = '' then // если нет - пишем имя шкафа begin s := SCSComponent.FirstConnectedConnCompon.GetTopComponent.Name + ' '+inttostr(SCSComponent.FirstConnectedConnCompon.GetTopComponent.MarkID) end; MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := s; except // если ошибка - берем имя топ компонента и номер MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := SCSComponent.FirstConnectedConnCompon.GetTopComponent.Name + ' '+inttostr(SCSComponent.FirstConnectedConnCompon.GetTopComponent.MarkID); end; // MemTable_RCableJournal.FieldByName(fnNameTo).AsString := GetNameTo(SCSComponent.LastConnectedConnCompon, LastComponent, ToNppPort, ToPortName, ToPort, ToNppPortFromPos, ToNppPortToPos); MemTable_RCableJournal.FieldByName(fnPortNameFrom).AsInteger := FromNppPort1; MemTable_RCableJournal.FieldByName(fnPortTypeFrom).AsString := FromPortName; // // MemTable_RCableJournal.FieldByName(fnPortNameTo).AsInteger := ToNppPort; MemTable_RCableJournal.FieldByName(fnPortNameTo).AsInteger := ToNppPort; //changed by Tolik // если у подключаемого модуля есть маркировка - выводим, // если нет - ищем раркировку верхнего объекта модуля // если и ее нет - пишем имя верхнего объекта модуля // MemTable_RCableJournal.FieldByName(fnPortTypeTo).AsString := ToPortName; s:=''; if SCSComponent.LastConnectedConnCompon.NameMark<>'' then s := SCSComponent.LastConnectedConnCompon.NameMark; if s='' then begin if SCSComponent.LastConnectedConnCompon.GetTopComponent.NameMark<>'' then s := SCSComponent.LastConnectedConnCompon.GetParentComponent.NameMark; end; if s='' then begin s :=SCSComponent.LastConnectedConnCompon.GetTopComponent.Name + ' ' + inttostr(SCSComponent.LastConnectedConnCompon.GetTopComponent.MarkID); end; MemTable_RCableJournal.FieldByName(fnPortTypeTo).AsString := s; // //added by Tolik MemTable_RCableJournal.FieldValues[fnMarks]:=propList.Text; // маркировка объектов по пути кабеля MemTable_RCableJournal.FieldValues[fnPrices]:=propList1.Text; // длины линейных компонент по пути кабеля // MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; MemTable_RCableJournal.Post; end else if AResRepFormMode = fmRGOSTCableJournal then begin if FirstComponent <> nil then begin ListName := GetListName(FirstComponent); RoomOwner := GetComponObjectOwnerByItemType(FirstComponent, itRoom); if RoomOwner <> nil then ListName := ListName + '. '+ RoomOwner.GetNameForVisible; end; //*** Определить шаблон мркировки ComponMarkTemplate := ''; ListOwner := nil; if FirstComponent <> nil then ListOwner := FirstComponent.GetListOwner else if LastComponent <> nil then ListOwner := LastComponent.GetListOwner else ListOwner := SCSComponent.GetListOwner; if ListOwner <> nil then SprComponentType := ListOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if SprComponentType <> nil then ComponMarkTemplate := SprComponentType.ComponentType.MarkMask; //*** Удалить обозначение из if ComponMarkTemplate <> '' then if Pos(mteNameShort, ComponMarkTemplate) <> 0 then Delete(ComponMarkTemplate, Pos(mteNameShort, ComponMarkTemplate), Length(mteNameShort)); MemTable_RCableJournal.Append; //MemTable_RCableJournal.FieldByName(fnMarkID).AsString := TF_Main(SCSComponent.ActiveForm).MakeNameMarkComponent(SCSComponent, SCSComponent.GetFirstParentCatalog, false, ComponMarkTemplate); // номер кабеля MemTable_RCableJournal.FieldByName(fnNameMark).AsString := TF_Main(SCSComponent.ActiveForm).MakeNameMarkComponent(SCSComponent, SCSComponent.GetFirstParentCatalog, false, ComponMarkTemplate); // номер кабеля MemTable_RCableJournal.FieldByName(fnComponentIndex).AsInteger := SCSComponent.MarkID; MemTable_RCableJournal.FieldByName(fnNameCable).AsString := SCSComponent.NameShort; //Тип кабеля //changed by Tolik MemTable_RCableJournal.FieldByName(fnNameTo).AsString := GetMultiPortNameMark(SCSComponent.LastConnectedConnCompon, true); // Номер комутационной панели MemTable_RCableJournal.FieldByName(fnPortNameTo).AsString := IntToStr(ToNppPort); // Номер порта панели MemTable_RCableJournal.FieldByName(fnNameList).AsString := ListName; // Откуда приходит MemTable_RCableJournal.FieldByName(fnNameFrom).AsString := GetMultiPortNameMark(SCSComponent.FirstConnectedConnCompon, true); // Номер розетки MemTable_RCableJournal.FieldByName(fnPortNameFrom).AsString := IntToStr(FromNppPort1); // MemTable_RCableJournal.FieldByName(fnPortNameFrom).AsString := IntToStr(FromNppPort); // номер порта розетки MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; MemTable_RCableJournal.Post; end; end; for j := 0 to SCSComponent.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := SCSComponent.WholeComponent.Items[j]; ListWithLookedCompons.Add(ptrID); end; end; end; end; end; end; end; end; //*** Сортировка //if AResRepFormMode = fmRCableJournal then // MemTable_RCableJournal.SortOn(fnMarkID, []) //else //if AResRepFormMode = fmRGOSTCableJournal then // MemTable_RCableJournal.SortOn(fnMarkID, []); //MemTable_RCableJournal.SortOn(fnMarkID, []); SortMemTableByParams(MemTable_RCableJournal, AParams, nil); finally EndProgress; FreeList(ListWithLookedCompons); end; end; // end else // Если требуется посчитать расход кабеля из катушек // то посчитаем if not cbNone.Checked then begin if cbMaxScrapRate.Checked then CableReelCalculate(CableTypes, 'MaxScrapRate',ReelsCableFlow, Self); if cbMaxEfficiency.Checked then CableReelCalculate(CableTypes, 'MaxEfficiency',ReelsCableFlow, Self); CableReelNamesToMemTable(MemTable_RCableJournal,CableTypes); end // если нет - сбросим результаты предидущих расчетов, // в случае наличия таковых else begin if ReelsCableFlow <> nil then ReelsCableFlow.Clear else // нет строк для отчета - создаем пустой список () ReelsCableFlow := TStringList.Create; end; FreeCableTypes(CableTypes); GFormMode := AResRepFormMode; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderJoining: '+E.Message + 'i = '+ inttostr(i)); end; end // Tolik // Кабельно-трубный журнал по ДСТУ Б А.2.4-21:2008 (форма 8) else begin AllAllTraceLength := 0; FCatalog := AFolder; //ComponList := TSCSComponents.Create(false); { MemTable_RCableJournal.FieldDefs.Clear; MemTable_RCableJournal.FieldDefs.Add(fnID, ftAutoInc); MemTable_RCableJournal.FieldDefs.Add(fnTraceCabling, ftString, 255); // участок трассы, кабеля MemTable_RCableJournal.FieldDefs.Add(fnName, ftString, 255); // обозначение кабеля MemTable_RCableJournal.FieldDefs.Add(fnNameMark, ftString, 255); // марка MemTable_RCableJournal.FieldDefs.Add(fnNameFrom, ftString, 255); // начало MemTable_RCableJournal.FieldDefs.Add(fnNameTo, ftString, 255); // конец MemTable_RCableJournal.FieldDefs.Add(fnTotalKolvo, ftString, 255); // количество, число и сечение жил MemTable_RCableJournal.FieldDefs.Add(fnNotice, ftString, 255); // примечание (можно использовать как альтернативную маркировку) MemTable_RCableJournal.FieldDefs.Add(fnLength, ftFloat); // Длина, м MemTable_RCableJournal.FieldDefs.Add(fnNameBegin, ftString, 255); // парент каталог начала MemTable_RCableJournal.FieldDefs.Add(fnNameEnd, ftString, 255); // парент каталог конца MemTable_RCableJournal.Close; MemTable_RCableJournal.Open; } try if ((AFolder.ItemType = itList) or (AFolder.ItemType = itProject)) then begin ComponList := TSCSComponents.Create(false); for i := 0 to AFolder.ComponentReferences.Count - 1 do begin SCSComponent := AFolder.ComponentReferences[i]; // по типу сети if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1)) then begin if GCableCompTypes.IndexOf(SCSComponent.ComponentType.SysName) <> -1 then begin if ComponList.IndexOf(SCSComponent) = -1 then begin if SCSComponent.IsLine = bitrue then begin if IsCableComponent(SCSComponent) then begin ComponList.Add(SCSComponent); FirstComponent := nil; LastComponent := nil; SaveTracedCable(SCSComponent); end; end; end; end; end; end; // FreeAndNil(ComponList); end; AllAllTraceLength := 0; SortMemTableByParams(MemTable_RCableJournal, AParams, nil); FreeAndNil(ComponList); GFormMode := AResRepFormMode; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderJoining: '+E.Message); end; end; end; // расширенный кабельный журнал procedure TF_ResourceReport.ShowFolderCableJournalExt(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents, ACanHaveDismountAccount, AFullPath: Boolean); var LookedCompons: TSCSComponents; ptrID: ^Integer; i, j, k, l, m, n, p, q, r, x: Integer; CurrCompon: TSCSComponent; ComponSignType: Integer; ptrJoinedComponents: PJoinedComponents; ChangeFirstLast: Boolean; FirstConComponents: TSCSComponents; LastConComponents: TSCSComponents; BuffComponents: TSCSComponents; FirstConCompon: TSCSComponent; LastConCompon: TSCSComponent; FirstLineCompon: TSCSComponent; LastLineCompon: TSCSComponent; PrevLineCompon: TSCSComponent; CurrLineCompon: TSCSComponent; PrevRowCompon: TSCSComponent; CurrRowCompon: TSCSComponent; LeftCompon: TSCSComponent; RightCompon: TSCSComponent; CurrRowComponObject: TSCSCatalog; LeftComponObject: TSCSCatalog; RightComponObject: TSCSCatalog; BuffCompon: TSCSComponent; BuffObject: TSCSCatalog; BuffList: TList; FirstObject: TSCSCatalog; LastObject: TSCSCatalog; InterfCount1: Integer; InterfCount2: Integer; ParallelInterfaces: TInterfLists; JoinedInterfaces: TInterfLists; JoinedInterfacesLeft: TInterfLists; JoinedInterfacesRight: TInterfLists; SideCompon1Left: Integer; SideCompon2Left: Integer; SideCompon1Right: Integer; SideCompon2Right: Integer; InterfacesLeft: TSCSInterfaces; InterfacesLeftPoint: TSCSInterfaces; InterfacesLeftJoinedToPoint: TSCSInterfaces; InterfacesRight: TSCSInterfaces; InterfacesRightPoint: TSCSInterfaces; InterfacesRighJoinedToPoint: TSCSInterfaces; InterfJoinedCount: Integer; NppPortsLeft: TIntList; NppPortsRight: TIntList; NppPortsCount: Integer; ptrWeld: PInterfLists; ptrWeldFirst: PInterfLists; ptrWeldLast: PInterfLists; ptrBuffWeld: PInterfLists; WeldList: Tlist; InterfCount: Integer; ptrInterfFirst: TSCSInterface; ptrInterfLast: TSCSInterface; ptrlineInterfFirst: TSCSInterface; ptrLineInterfLast: TSCSInterface; ptrPortFirst: TSCSInterface; ptrPortLast: TSCSInterface; CurrRow: TSCSComponents; DeviceName: String; DeviceNameSecond: String; DeviceNameThird: String; DeviceNameFourth: String; ElementName: String; NppPort: Integer; CableDiametr: Double; ShowDevNameFrom: Boolean; ShowDevNameTo: Boolean; // added by Tolik currTrace,NextTrace: TFigure; // трассы, по которым проходит кабель currLine: TOrthoLine; // текущая трасса propList, propList1: TstringList; // propList - список трасс по маршруту кабеля, propList1 - длины кусков кабеля соответственно FirstTraceFound, NextTraceFound: Boolean; // две соседние трассы Figure: TFigure; Ortholine: TOrtholine; Connector1, Connector2, Connector3, Connector4: TConnectorObject; // коннекторы трасс Compon1, Compon2, Compon3, Compon4: TSCSComponent; // компоненты, сидящие на коннекторах трасс s: string; currSCSCatalog, nextSCSCatalog: TSCSCatalog; PartSCSComponent1,PartSCSComponent2: TSCScomponent; ListName: string; ComponList: TSCSComponents; FromNppPort1: integer; ListOwner: TSCSList; TraceListOwner : TSCSList; ListCAD : TF_CAD; FirstCompon, LastCompon : TSCSComponent; PortCountFrom, PortCountTo: Integer; // Tolik MasterID: Integer; // { // украдено у Игоря by Tolik из TSCSComponent.DefineFirstLast (модуль U_SCSComponent) // правда, немножко переделано совсем Procedure SetActualOrderInPartComponent(aComponent: TSCSComponent; ComponList : TSCSComponents; FromNppPort1 : integer); Var Component : TSCSComponent; SortedWholeComponent: TIntList; my_comp, ComponentToOrder: TSCSComponent; StepComponent: TSCSComponent; JoinedComponent: TSCSComponent; i, j: Integer; portcount1, portcount2 : integer; ListOwner: TSCSList; EndPointCad : TF_CAD; PointComponent : TSCSComponent; SCSCatalog : TSCSCatalog; SCSInterfaces: TSCSInterfaces; Begin Component := aComponent; // SCSCatalogs := TSCSCatalogs.Create(false); SortedWholeComponent := TIntList.Create; Component.DefineFirstLast; ComponentToOrder := nil; ListOwner := Component.GetListOwner; my_comp := Component.FirstConnectedConnCompon.GetTopComponent; if my_comp<>nil then begin SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount1 := SCSInterfaces.Count; my_comp := Component.LastConnectedConnCompon.GetTopComponent; SCSInterfaces := my_comp.GetInterfacesByIsPort(1, True, -1, nil); portcount2 := SCSInterfaces.Count; ComponentToOrder := Component.FirstConnectedConnCompon; // Сразу же определяем порядок листов для отчета // и порт шкафа begin if Component.FirstConnectedConnCompon.ListID = Component.LastConnectedConnCompon.ListID then ListName := GetListName(Component.FirstConnectedConnCompon) else begin if Portcount1 >= PortCount2 then ListName := GetListName(Component.FirstConnectedConnCompon)+'/'+GetListName(Component.LastConnectedConnCompon) else ListName := GetListName(Component.LastConnectedConnCompon)+'/'+GetListName(Component.FirstConnectedConnCompon); end; end; if PortCount1 >= PortCount2 then ComponentToOrder := Component.FirstConnectedConnCompon else begin ComponentToOrder := Component.LastConnectedConnCompon; Component.LastConnectedConnCompon := Component.FirstConnectedConnCompon; Component.FirstConnectedConnCompon := ComponentToOrder; end; FromNppPort1 := Component.FirstConnectedConnCompon.MarkID ; if Component<> nil then begin for i := 0 to Component.WholeComponent.Count - 1 do begin for j := 0 to ComponentToOrder.JoinedComponents.Count - 1 do begin StepComponent := ComponentToOrder.JoinedComponents[j]; if ((SortedWholeComponent.IndexOf(StepComponent.ID)= -1) and (Component.WholeComponent.IndexOf(StepComponent.ID)<> -1)) then begin SortedWholeComponent.Add(StepComponent.ID); ComponList.Add(StepComponent); ComponentToOrder := StepComponent; SCSCatalog := StepComponent.GetFirstParentCatalog; break; end; end; end; end; ComponentToOrder := Component; //*** Не один участок кабеля не ушел в пизду if ComponentToOrder.WholeComponent.Count = SortedWholeComponent.Count then begin ComponentToOrder.WholeComponent.Clear; ComponentToOrder.WholeComponent.Assign(SortedWholeComponent); end; SortedWholeComponent.Free; end; End; // } function GetDeviceName(AComponents: TSCSComponents): String; var TopCompon: TSCSComponent; i: Integer; begin Result := ''; if Not Assigned(AComponents) then Exit; ///// EXIT //// TopCompon := nil; if AComponents.Count > 0 then TopCompon := AComponents[0].GetTopComponent; for i := 0 to AComponents.Count - 1 do if AComponents[i].GetTopComponent <> TopCompon then Exit; ///// EXIT ///// if Assigned(TopCompon) then Result := GetComponNameForVisible(TopCompon.NameShort, IntTostr(TopCompon.MarkID)); //TopCompon := ACompon.GetTopComponent; //if Assigned(TopCompon) then // Result := TF_Main(GForm).GetComponNameForVisible(TopCompon.NameShort, IntTostr(TopCompon.MarkID)); end; procedure GetDeviceAndElementNamesByLineComponInterfaces(ACompon: TSCSComponent; AInterfaces: TList; var ADevName, ADevNameSecond, ADevNameThird, ADevNameFourth, AElementName: String); var i: integer; CurrPointInterfaces: TSCSInterfaces; PointComponsInterfaces: TSCSInterfaces; PointCompon: TSCSComponent; PointComponents: TSCSComponents; TopComponent: TSCSComponent; PointTopComponents: TSCSComponents; //PathToDepthComponent: TSCSComponent; DevicePath: TStringList; CurrCompon: TSCSComponent; InternalConnComponPath: TSCSComponents; InterrnalJoinedInterfaces: TSCSInterfaces; InternalJoinedCompon, PrevInternalJoinedCompon: TSCSComponent; NppFrom, NppTo: Integer; begin ADevName := ''; ADevNameSecond := ''; ADevNameThird := ''; ADevNameFourth := ''; AElementName := ''; if Assigned(ACompon) and Assigned(AInterfaces) then begin PointComponsInterfaces := TSCSInterfaces.Create(false); PointComponents := TSCSComponents.Create(false); PointTopComponents := TSCSComponents.Create(false); InternalConnComponPath := TSCSComponents.Create(false); InterrnalJoinedInterfaces := TSCSInterfaces.Create(false); for i := 0 to AInterfaces.Count - 1 do begin //01.08.2012 CurrPointInterfaces := ACompon.GetInterfacesConnectedToConnCompon(AInterfaces[i], nil, nil); CurrPointInterfaces := ACompon.GetInterfacesConnectedToConnCompon(AInterfaces[i], InternalConnComponPath, InterrnalJoinedInterfaces); if Assigned(CurrPointInterfaces) then begin PointComponsInterfaces.Assign(CurrPointInterfaces, laOr); CurrPointInterfaces.Free; end; end; for i := 0 to PointComponsInterfaces.Count - 1 do begin PointCompon := TSCSComponent(TSCSInterface(PointComponsInterfaces[i]).ComponentOwner); if PointComponents.IndexOf(PointCompon) = -1 then if CheckCanLookComponInReportCable(PointCompon, ACanHaveDismountAccount) then PointComponents.Add(PointCompon); end; for i := 0 to PointComponents.Count - 1 do begin TopComponent := PointComponents[i].GetTopComponent; if PointTopComponents.IndexOf(TopComponent) = -1 then PointTopComponents.Add(TopComponent); end; //*** Имя устройства c учетом полного пути if Not AFullPath then begin if PointTopComponents.Count > 0 then ADevName := PointTopComponents[0].NameMark; //PointTopComponents[0].NameShort + IntToStr(PointTopComponents[0].MarkID); end else if PointComponents.Count > 0 then begin {CurrCompon := PointComponents[0]; while CurrCompon <> nil do begin if CurrCompon <> PointComponents[0] then begin if ADevName <> '' then ADevName := '\' + ADevName; ADevName := CurrCompon.NameMark + ADevName; end; CurrCompon := CurrCompon.GetParentComponent; end;} DevicePath := TStringList.Create; //*** Сосзать список из пути компоненты в нормальном порядке //04.02.2013 //CurrCompon := PointComponents[0]; //while CurrCompon <> nil do //begin // if CurrCompon <> PointComponents[0] then // DevicePath.Insert(0, CurrCompon.NameMark); // CurrCompon := CurrCompon.GetParentComponent; //end; //04.02.2013 CurrCompon := InternalConnComponPath[0]; // компонент к которому подключен кабель while CurrCompon <> nil do begin if CurrCompon <> InternalConnComponPath[0] then DevicePath.Insert(0, CurrCompon.NameMark); CurrCompon := CurrCompon.GetParentComponent; end; //*** По списку определить элементы подключенного устройства for i := 0 to DevicePath.Count - 1 do begin if i = 0 then ADevName := DevicePath[i] else if i = 1 then ADevNameSecond := DevicePath[i] else if i = 2 then ADevNameThird := DevicePath[i] else if i >= 3 then begin if ADevNameFourth <> '' then ADevNameFourth := ADevNameFourth + '\'; ADevNameFourth := ADevNameFourth + DevicePath[i]; end; end; FreeAndNil(DevicePath); end; //01.08.2012 if AFullPath and (InternalConnComponPath.Count > 0) then begin PrevInternalJoinedCompon := nil; for i := 0 to InternalConnComponPath.Count - 1 do begin InternalJoinedCompon := TSCSComponent(InternalConnComponPath[i]); //04.02.2013 отображаем номер порта пред. внутреннего компонента, к которому пдключен InternalJoinedCompon if PrevInternalJoinedCompon <> nil then if GetPortInfoByJoinedCompons(PrevInternalJoinedCompon, InternalJoinedCompon, NppFrom, NppTo) then begin if NppFrom = NppTo then AElementName := AElementName +' ('+cNamePort+' '+IntToStr(NppFrom)+')' else AElementName := AElementName +' ('+cNamePort+' '+IntToStr(NppFrom)+'-'+IntToStr(NppTo)+')'; end; if i > 0 then AElementName := AElementName +#13; AElementName := AElementName + InternalJoinedCompon.NameMark; PrevInternalJoinedCompon := InternalJoinedCompon; //04.02.2013 end; end else begin if PointComponents.Count > 0 then AElementName := PointComponents[0].NameMark; //PointComponents[0].NameShort + IntToStr(PointComponents[0].MarkID); end; InterrnalJoinedInterfaces.Free; InternalConnComponPath.Free; PointComponents.Free; PointTopComponents.Free; PointComponsInterfaces.Free; end; end; function DefineSidePorts(aIdx: Integer; aInterfacesSide, aInterfacesSidePoint, aInterfacesSideJoinedToPoint: TSCSInterfaces): TIntList; begin Result := nil; if ((InterfacesLeft.Count - 1) >= aIdx) and ((aInterfacesSidePoint.Count - 1) >= aIdx) then if aInterfacesSidePoint[aIdx].PortOwner <> nil then begin Result := GetNppPortsByConnected(aInterfacesSidePoint[aIdx].PortOwner, aInterfacesSidePoint[p], aInterfacesSideJoinedToPoint[0]); //if Result.Count > NppPortsCount then // NppPortsCount := Result.Count; end else if aInterfacesSidePoint[aIdx].IsPort = biTrue then begin //Result := TIntList.Create; //Result.Add(aInterfacesSidePoint[aIdx].NppPort); Result := GetNppPortsByConnected(aInterfacesSidePoint[aIdx], aInterfacesSidePoint[aIdx], aInterfacesSideJoinedToPoint[0]); end; if Assigned(Result) then if Result.Count > NppPortsCount then NppPortsCount := Result.Count; end; function GetDeviceNameByInterface(AInterface: TSCSInterface): String; var ComponOwner: TSCSComponent; TopComponent: TSCSComponent; begin if AInterface <> nil then if Assigned(AInterface.ComponentOwner) then begin ComponOwner := TSCSComponent(AInterface.ComponentOwner); TopComponent := ComponOwner.GetTopComponent; if Assigned(TopComponent) then Result := TopComponent.NameShort + IntToStr(TopComponent.MarkID); end; end; function GetElementName(ACompon: TSCSComponent): String; begin Result := ''; if Not Assigned(ACompon) then Exit; ///// EXIT //// Result := ACompon.NameMark; //GetComponNameForVisible(ACompon.NameShort, IntTostr(ACompon.MarkID)); end; function GetElementNameByInterface(AInterface: TSCSInterface): String; var ComponOwner: TSCSComponent; begin if AInterface <> nil then if Assigned(AInterface.ComponentOwner) then begin ComponOwner := TSCSComponent(AInterface.ComponentOwner); Result := ComponOwner.NameMark; //ComponOwner.NameShort + IntToStr(ComponOwner.MarkID); end; end; function GetWelding(AInterfList: TSCSInterfaces): String; var i: Integer; Interfac: TSCSInterface; ComponOwner: TSCSComponent; begin Result := ''; if Assigned(AInterfList) then for i := 0 to AInterfList.Count - 1 do begin if i > 0 then Result := Result + #10+#13; Interfac := AInterfList[i]; ComponOwner := TSCSComponent(Interfac.ComponentOwner); if Assigned(ComponOwner) then Result := Result + ComponOwner.NameShort + IntToStr(ComponOwner.MarkID); end; end; function GetNumThreads(AInterfList: TSCSInterfaces): String; var i: Integer; Interfac: TSCSInterface; begin Result := ''; if Assigned(AInterfList) then for i := 0 to AInterfList.Count - 1 do begin if i > 0 then Result := Result + #10+#13; Interfac := AInterfList[i]; Result := Result + IntToStr(Interfac.Npp); end; end; begin try if (TF_Main(GForm).GDBMode <> bkProjectManager) or Not(Assigned(AFolder)) then Exit; ///// EXIT ////// if Not CheckCanShowReport(AFolder) then Exit; //// EXIT //// FCatalog := AFolder; mtRCableJournalInterfaces.Active := false; MemTable_RCableJournalExt.Active := false; mtRCableJournalInterfaces.MasterSource := DataSource_MT_RCableJournalExt; mtRCableJournalInterfaces.DetailFields := fnIDMaster; mtRCableJournalInterfaces.MasterFields := fnID; MemTable_RCableJournalExt.Active := true; mtRCableJournalInterfaces.Active := true; LookedCompons := TSCSComponents.Create(false); BeginProgress(pcPreparingReport); try for i := 0 to AFolder.ComponentReferences.Count - 1 do begin CurrCompon := AFolder.ComponentReferences[i]; if Assigned(CurrCompon) then //Tolik // if {CurrCompon.IsLine = biTrue} CheckSysNameIsCable(CurrCompon.ComponentType.SysName) then // так было // проверка на тип сети if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(CurrCompon.GUIDNetType) <> -1)) then begin //if {CurrCompon.IsLine = biTrue} (CheckSysNameIsCable(CurrCompon.ComponentType.SysName) and if (isCableComponent(CurrCompon) and // // (not (CurrCompon.IDNetType in [3,4,5,7]))) then (((not (CurrCompon.IDNetType in [3,{4,}5,7])) and AllNetTypes) or (not AllNetTypes))) then // begin ComponSignType := CurrCompon.GetPropertyValueAsInteger(pnSignType); if (LookedCompons.IndexOf(CurrCompon) = -1) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then if CurrCompon.HaveInterfaceByType(itFunctional) then begin CurrCompon.RefreshWholeLengthIfNecessary; // added by Tolik ComponList := TSCSComponents.create(false); SetActualOrderInPartComponent(CurrCompon, ComponList, FromNppPort1, ListName); propList:=TStringList.Create; propList1:=TStringList.Create; GetCablePath(CurrCompon, propList, propList1,ComponList); CurrCompon.LoadNet; CurrCompon.DefineLengthsOfNetThreads; for j := 0 to CurrCompon.Net.Count - 1 do begin ptrJoinedComponents := CurrCompon.Net[j]; if Not ACanHaveDismountAccount or Not CheckHaveComponentDismountedInList(ptrJoinedComponents.JoinedLines) then for k := 0 to ptrJoinedComponents.FirstConnCompons.Count - 1 do if Assigned(ptrJoinedComponents.FirstConnCompons[k]) and CheckCanLookComponInReportCable(ptrJoinedComponents.FirstConnCompons[k], ACanHaveDismountAccount) then for l := 0 to ptrJoinedComponents.LastConnCompons.Count - 1 do if Assigned(ptrJoinedComponents.LastConnCompons[l]) and CheckCanLookComponInReportCable(ptrJoinedComponents.LastConnCompons[l], ACanHaveDismountAccount) then begin FirstConComponents := ptrJoinedComponents.FirstConnCompons; LastConComponents := ptrJoinedComponents.LastConnCompons; FirstConCompon := ptrJoinedComponents.FirstConnCompons[k]; LastConCompon := ptrJoinedComponents.LastConnCompons[l]; FirstLineCompon := ptrJoinedComponents.First; LastLineCompon := ptrJoinedComponents.Last; //*** Определить Исходящие и входящие объекты ChangeFirstLast := false; FirstObject := FirstConCompon.GetFirstParentCatalog; LastObject := LastConCompon.GetFirstParentCatalog; InterfCount1 := 0; InterfCount2 := 0; if Assigned(FirstObject) then InterfCount1 := FirstObject.GetInterfaceCount([itFunctional]); if Assigned(LastObject) then InterfCount2 := LastObject.GetInterfaceCount([itFunctional]); if InterfCount1 > InterfCount2 then begin ChangeFirstLast := true; BuffComponents := FirstConComponents; FirstConComponents := LastConComponents; LastConComponents := BuffComponents; BuffCompon := FirstConCompon; FirstConCompon := LastConCompon; LastConCompon := BuffCompon; BuffCompon := FirstLineCompon; FirstLineCompon := LastLineCompon; LastLineCompon := BuffCompon; BuffObject := FirstObject; FirstObject := LastObject; LastObject := BuffObject; ptrJoinedComponents.JoinedLines.Rotate; end; PrevRowCompon := nil; CurrRowCompon := nil; // From Left(first) To Right(Last) //if FirstLineCompon.Whole_ID <> LastLineCompon.Whole_ID then begin for m := 0 to ptrJoinedComponents.JoinedLines.Count - 1 do if LookedCompons.IndexOf(ptrJoinedComponents.JoinedLines[m]) = -1 then begin PrevRowCompon := CurrRowCompon; CurrRowCompon := ptrJoinedComponents.JoinedLines[m]; LeftCompon := nil; RightCompon := nil; if Assigned(PrevRowCompon) then if PrevRowCompon.Whole_ID <> CurrRowCompon.Whole_ID then LeftCompon := PrevRowCompon; if Not Assigned(PrevRowCompon) then LeftCompon := FirstConCompon; //*** Компонент слева определен ? if Assigned(LeftCompon) then begin if m < ptrJoinedComponents.JoinedLines.Count - 1 then for n := m+1 to ptrJoinedComponents.JoinedLines.Count - 1 do if CurrRowCompon.Whole_ID <> ptrJoinedComponents.JoinedLines[n].Whole_ID then RightCompon := ptrJoinedComponents.JoinedLines[n] else if n = ptrJoinedComponents.JoinedLines.Count - 1 then RightCompon := LastConCompon; if m = ptrJoinedComponents.JoinedLines.Count - 1 then RightCompon := LastConCompon; end; //*** Определены подключенные компоненты слева и справа if Assigned(LeftCompon) and Assigned(RightCompon) then begin CurrRowCompon.LoadWholeComponent(false); CurrRowCompon.LoadWholeLength; CurrRowComponObject := CurrRowCompon.GetFirstParentCatalog; LeftComponObject := LeftCompon.GetFirstParentCatalog; RightComponObject := RightCompon.GetFirstParentCatalog; SideCompon1Left := -1; SideCompon2Left := -1; SideCompon1Right := -1; SideCompon2Right := -1; if Assigned(CurrRowComponObject) and Assigned(LeftComponObject) and Assigned(RightComponObject) then begin GetSidesByConnectedFigures(CurrRowComponObject.ListID, LeftComponObject.ListID, CurrRowComponObject.SCSID, LeftComponObject.SCSID, SideCompon1Left, SideCompon2Left); GetSidesByConnectedFigures(CurrRowComponObject.ListID, RightComponObject.ListID, CurrRowComponObject.SCSID, RightComponObject.SCSID, SideCompon1Right, SideCompon2Right); end; //**** Side1-Left(First), Side2-Right(Last) ParallelInterfaces := CurrRowCompon.GetInterfacesBySides; if (SideCompon1Left = 2) {or (SideCompon1Right = 1)} then begin BuffList := ParallelInterfaces.InterfList2; ParallelInterfaces.InterfList2 := ParallelInterfaces.InterfList1; ParallelInterfaces.InterfList1 := BuffList; end; ShowDevNameFrom := false; ShowDevNameTo := false; MemTable_RCableJournalExt.Append; MemTable_RCableJournalExt.FieldByName('NumCable').AsInteger := CurrRowCompon.MarkID; MemTable_RCableJournalExt.FieldByName('CableData').AsString := CurrRowCompon.Name; MemTable_RCableJournalExt.FieldByName('NameMark').AsString := CurrRowCompon.NameMark; //added by Tolik MemTable_RCableJournalExt.FieldValues[fnMarks]:=propList.Text; // маркировка объектов по пути кабеля MemTable_RCableJournalExt.FieldValues[fnPrices]:=propList1.Text; // длины линейных компонент по пути кабеля // if CheckPriceTransformToUOMByCompType(@CurrRowCompon.ComponentType) then begin MemTable_RCableJournalExt.FieldByName(fnIzm).AsString := GetNameUOM(TF_Main(GForm).FUOM, true); MemTable_RCableJournalExt.FieldByName(fnLength).AsFloat := FloatInUOM(CurrRowCompon.Length, umMetr, TF_Main(GForm).FUOM); end else begin MemTable_RCableJournalExt.FieldByName(fnIzm).AsString := CurrRowCompon.Izm; MemTable_RCableJournalExt.FieldByName(fnLength).AsFloat := CurrRowCompon.Length; end; MemTable_RCableJournalExt.FieldByName('NumThread').AsInteger := 0; MemTable_RCableJournalExt.FieldByName('From_Building').AsString := LeftCompon.GetListOwner.GetNameForVisible(false); GetDeviceAndElementNamesByLineComponInterfaces(CurrRowCompon, ParallelInterfaces.InterfList1, DeviceName, DeviceNameSecond, DeviceNameThird, DeviceNameFourth, ElementName); if DeviceName = '' then ShowDevNameFrom := true; MemTable_RCableJournalExt.FieldByName(fnFromDevice).AsString := DeviceName; //GetDeviceName(FirstConComponents); MemTable_RCableJournalExt.FieldByName(fnFromDeviceSecond).AsString := DeviceNameSecond; MemTable_RCableJournalExt.FieldByName(fnFromDeviceThird).AsString := DeviceNameThird; MemTable_RCableJournalExt.FieldByName(fnFromDeviceFourth).AsString := DeviceNameFourth; //if LeftCompon.IsLine = biFalse then MemTable_RCableJournalExt.FieldByName('From_Element').AsString := ElementName; //GetElementName(LeftCompon); MemTable_RCableJournalExt.FieldByName('To_Building').AsString := RightCompon.GetListOwner.GetNameForVisible; GetDeviceAndElementNamesByLineComponInterfaces(CurrRowCompon, ParallelInterfaces.InterfList2, DeviceName, DeviceNameSecond, DeviceNameThird, DeviceNameFourth, ElementName); if DeviceName = '' then ShowDevNameTo := true; MemTable_RCableJournalExt.FieldByName(fnToDevice).AsString := DeviceName; //GetDeviceName(LastConComponents); MemTable_RCableJournalExt.FieldByName(fnToDeviceSecond).AsString := DeviceNameSecond; MemTable_RCableJournalExt.FieldByName(fnToDeviceThird).AsString := DeviceNameThird; MemTable_RCableJournalExt.FieldByName(fnToDeviceFourth).AsString := DeviceNameFourth; //if RightCompon.IsLine = biFalse then MemTable_RCableJournalExt.FieldByName('To_Element').AsString := ElementName; //GetElementName(RightCompon); MemTable_RCableJournalExt.FieldByName('TraceCabling').AsString := CurrRowCompon.GetPropertyValueBySysName(pnTraceCabinig); MemTable_RCableJournalExt.FieldByName('Sign').AsString := CurrRowCompon.NameShort + IntToStr(CurrRowCompon.MarkID); MemTable_RCableJournalExt.FieldByName('Kolvo').AsInteger := 2; //MemTable_RCableJournalExt.FieldByName('Diameter').AsFloat := Round3(CurrRowCompon.GetVolume(gtMale) * 10); CableDiametr := CurrRowCompon.GetPropertyValueAsFloat(pnOutDiametr); if CableDiametr <> 0 then begin CableDiametr := FLoatInUOM(CableDiametr, umMillimetr, ConvertUOMToMin(TF_Main(GForm).FUOM)); MemTable_RCableJournalExt.FieldByName(fnDiameter).AsFloat := Round2(CableDiametr); end else MemTable_RCableJournalExt.FieldByName(fnDiameter).Value := null; MemTable_RCableJournalExt.FieldByName('Note').AsString := CurrRowCompon.Notice; MasterID := MemTable_RCableJournalExt.FieldByName(fnID).AsInteger; MemTable_RCableJournalExt.Post; for n := 0 to ParallelInterfaces.InterfList1.Count - 1 do begin ptrInterfFirst := ParallelInterfaces.InterfList1[n]; ptrInterfLast := ParallelInterfaces.InterfList2[n]; InterfacesLeftJoinedToPoint := TSCSInterfaces.Create(false); InterfacesRighJoinedToPoint := TSCSInterfaces.Create(false); InterfacesLeft := CurrRowCompon.GetInterfacesConnectedToInterfaceOtherCompon(ptrInterfFirst); InterfacesLeftPoint := CurrRowCompon.GetInterfacesConnectedToConnCompon(ptrInterfFirst, nil, InterfacesLeftJoinedToPoint); //*** Если не нашлись интерфейсы, подключенные к компоненте в самой глуби // находим подключенные от кабеля if InterfacesLeftJoinedToPoint.Count = 0 then begin FreeAndNil(InterfacesLeftJoinedToPoint); InterfacesLeftJoinedToPoint := CurrRowCompon.GetInterfacesConnectedToEndLineCompon(ptrInterfFirst); end; InterfacesRight := CurrRowCompon.GetInterfacesConnectedToInterfaceOtherCompon(ptrInterfLast); InterfacesRightPoint := CurrRowCompon.GetInterfacesConnectedToConnCompon(ptrInterfLast, nil, InterfacesRighJoinedToPoint); // См коментарий для "if InterfacesLeftJoinedToPoint.Count = 0 then" if InterfacesRighJoinedToPoint.Count = 0 then begin FreeAndNil(InterfacesRighJoinedToPoint); InterfacesRighJoinedToPoint := CurrRowCompon.GetInterfacesConnectedToEndLineCompon(ptrInterfLast); end; //InterfacesLeft := ptrInterfFirst.ConnectedInterfaces; //InterfacesRight := ptrInterfLast.ConnectedInterfaces; if ((InterfacesLeft.Count > 0) or (InterfacesRight.Count > 0)) and (InterfacesLeftPoint.Count > 0) and (InterfacesRightPoint.Count > 0) then begin InterfJoinedCount := 0; //23.03.2009 if InterfacesLeftPoint.Count < InterfacesRightPoint.Count then //23.03.2009 InterfJoinedCount := InterfacesLeftPoint.Count //23.03.2009 else //23.03.2009 InterfJoinedCount := InterfacesRightPoint.Count; if InterfacesLeftPoint.Count > InterfacesRightPoint.Count then InterfJoinedCount := InterfacesLeftPoint.Count else InterfJoinedCount := InterfacesRightPoint.Count; for p := 0 to InterfJoinedCount - 1 do begin NppPortsCount := 1; // 1 чтобы след-й цикл отработал минимум одну итерацию {//01.08.2012 NppPortsLeft := nil; NppPortsRight := nil; // Определяем списки номеров портов if ((InterfacesLeft.Count - 1) >= p) and ((InterfacesLeftPoint.Count - 1) >= p) then if InterfacesLeftPoint[p].PortOwner <> nil then begin NppPortsLeft := GetNppPortsByConnected(InterfacesLeftPoint[p].PortOwner, InterfacesLeftPoint[p], InterfacesLeftJoinedToPoint[0]); if NppPortsLeft.Count > NppPortsCount then NppPortsCount := NppPortsLeft.Count; end; if ((InterfacesRight.Count -1) >= p) and ((InterfacesRightPoint.Count - 1) >= p) then if InterfacesRightPoint[p].PortOwner <> nil then begin NppPortsRight := GetNppPortsByConnected(InterfacesRightPoint[p].PortOwner, InterfacesRightPoint[p], InterfacesRighJoinedToPoint[0]); if NppPortsRight.Count > NppPortsCount then NppPortsCount := NppPortsRight.Count; end;} NppPortsLeft := DefineSidePorts(p, InterfacesLeft, InterfacesLeftPoint, InterfacesLeftJoinedToPoint); NppPortsRight := DefineSidePorts(p, InterfacesRight, InterfacesRightPoint, InterfacesRighJoinedToPoint); for q := 0 to NppPortsCount - 1 do begin mtRCableJournalInterfaces.Append; // Tolik mtRCableJournalInterfaces.FieldByName(fnIDMaster).AsInteger := MasterID; //MemTable_RCableJournalExt.FieldByName(fnID).AsInteger; // mtRCableJournalInterfaces.FieldByName('NumThread').AsInteger := ptrInterfFirst.Npp; // or ptrInterfLast if (InterfacesLeftPoint.Count - 1) >= p then begin if ShowDevNameFrom then mtRCableJournalInterfaces.FieldByName('From_Device').AsString := GetDeviceNameByInterface(InterfacesLeftPoint[p]); mtRCableJournalInterfaces.FieldByName('From_Element').AsString := GetElementNameByInterface(InterfacesLeftPoint[p]); end; if ((InterfacesLeft.Count - 1) >= p) and (TSCSComponent(TSCSInterface(InterfacesLeft[p]).ComponentOwner).IsLine = biTrue) then begin mtRCableJournalInterfaces.FieldByName('From_WeldingCable').AsString := GetWelding(InterfacesLeft); mtRCableJournalInterfaces.FieldByName('From_NumThread').AsString := GetNumThreads(InterfacesLeft); end else if ((InterfacesLeftPoint.Count - 1) >= p) and (InterfacesLeftPoint[p].ComponentOwner.IsLine = biFalse) then begin mtRCableJournalInterfaces.FieldByName('From_InterfName').AsString := InterfacesLeftPoint[p].LoadName; //TF_MAIN(GForm).DM.GetInterfName(TSCSInterface(InterfacesLeft[0]).ID_Interface); ptrPortFirst := InterfacesLeftPoint[p].PortOwner; //}TSCSComponent(TSCSInterface(InterfacesLeft[0]).ComponentOwner).GetPort; //01.08.2012 if ptrPortFirst <> nil then if (NppPortsLeft <> nil) and ((NppPortsLeft.Count-1) >= q) then begin if (ptrPortFirst = nil) and (InterfacesLeftPoint[p].IsPort = biTrue) then //01.08.2012 ptrPortFirst := InterfacesLeftPoint[p]; NppPort := NppPortsLeft[q]; //GetNppPortByConnected(ptrPortFirst, InterfacesLeftPoint[p], InterfacesLeftJoinedToPoint[0], p+1); mtRCableJournalInterfaces.FieldByName('From_NppPort').AsInteger := NppPort; //ptrPortFirst.NppPort; if NppPort <> 0 then //mtRCableJournalInterfaces.FieldByName('From_PortMark').AsString := ConcatStrWithDefis(FirstConCompon.NameMark, IntToStr(NppPort)); //LastConCompon.NameShort + IntToStr(LastConCompon.MarkID)+'-'+IntToStr(ptrPortFirst.NppPort); mtRCableJournalInterfaces.FieldByName('From_PortMark').AsString := ConcatStrWithDefis(ptrPortFirst.ComponentOwner.NameMark, IntToStr(NppPort)); end; end; if (InterfacesRightPoint.Count - 1) >= p then begin if ShowDevNameTo then mtRCableJournalInterfaces.FieldByName('To_Device').AsString := GetDeviceNameByInterface(InterfacesRightPoint[p]); mtRCableJournalInterfaces.FieldByName('To_Element').AsString := GetElementNameByInterface(InterfacesRightPoint[p]); end; if ((InterfacesRight.Count - 1) >= p) and (TSCSComponent(TSCSInterface(InterfacesRight[p]).ComponentOwner).IsLine = biTrue) then begin mtRCableJournalInterfaces.FieldByName('To_WeldingCable').AsString := GetWelding(InterfacesRight); mtRCableJournalInterfaces.FieldByName('To_NumThread').AsString := GetNumThreads(InterfacesRight); end else if ((InterfacesRightPoint.Count - 1) >= p) and (InterfacesRightPoint[p].ComponentOwner.IsLine = biFalse) then begin mtRCableJournalInterfaces.FieldByName('To_InterfName').AsString := InterfacesRightPoint[p].LoadName; //TF_MAIN(GForm).DM.GetInterfName(TSCSInterface(InterfacesRight[0]).ID_Interface); ptrPortLast := InterfacesRightPoint[p].PortOwner; //}TSCSComponent(TSCSInterface(InterfacesRight[0]).ComponentOwner).GetPort; //01.08.2012 if ptrPortLast <> nil then if (NppPortsRight <> nil) and ((NppPortsRight.Count-1) >= q) then begin if (ptrPortLast = nil) and (InterfacesRightPoint[p].IsPort = biTrue) then //01.08.2012 ptrPortLast := InterfacesRightPoint[p]; NppPort := NppPortsRight[q]; //GetNppPortByConnected(ptrPortLast, InterfacesRightPoint[p], InterfacesRighJoinedToPoint[0], p+1); mtRCableJournalInterfaces.FieldByName('To_NppPort').AsInteger := NppPort; // //ptrPortLast.NppPort; if NppPort <> 0 then mtRCableJournalInterfaces.FieldByName('To_PortMark').AsString := ConcatStrWithDefis(ptrPortLast.ComponentOwner.NameMark, IntToStr(NppPort)); end; end; end; if NppPortsLeft <> nil then FreeAndNil(NppPortsLeft); if NppPortsRight <> nil then FreeAndNil(NppPortsRight); {//24.03.2009 mtRCableJournalInterfaces.Append; mtRCableJournalInterfaces.FieldByName(fnIDMaster).AsInteger := MemTable_RCableJournalExt.FieldByName(fnID).AsInteger; mtRCableJournalInterfaces.FieldByName('NumThread').AsInteger := ptrInterfFirst.Npp; // or ptrInterfLast if InterfacesLeft.Count > 0 then begin if (InterfacesLeftPoint.Count - 1) >= p then begin if ShowDevNameFrom then mtRCableJournalInterfaces.FieldByName('From_Device').AsString := GetDeviceNameByInterface(InterfacesLeftPoint[p]); mtRCableJournalInterfaces.FieldByName('From_Element').AsString := GetElementNameByInterface(InterfacesLeftPoint[p]); end; if ((InterfacesLeft.Count - 1) >= p) and (TSCSComponent(TSCSInterface(InterfacesLeft[p]).ComponentOwner).IsLine = biTrue) then begin mtRCableJournalInterfaces.FieldByName('From_WeldingCable').AsString := GetWelding(InterfacesLeft); mtRCableJournalInterfaces.FieldByName('From_NumThread').AsString := GetNumThreads(InterfacesLeft); end else if ((InterfacesLeftPoint.Count - 1) >= p) and (InterfacesLeftPoint[p].ComponentOwner.IsLine = biFalse) then //if (InterfacesLeftPoint[0].ComponentOwner = LeftCompon) or // (InterfacesLeftPoint[0].ComponentOwner = RightCompon) then begin mtRCableJournalInterfaces.FieldByName('From_InterfName').AsString := InterfacesLeftPoint[p].LoadName; //TF_MAIN(GForm).DM.GetInterfName(TSCSInterface(InterfacesLeft[0]).ID_Interface); ptrPortFirst := InterfacesLeftPoint[p].PortOwner; //TSCSComponent(TSCSInterface(InterfacesLeft[0]).ComponentOwner).GetPort; if ptrPortFirst <> nil then begin NppPort := GetNppPortByConnected(ptrPortFirst, InterfacesLeftPoint[p], InterfacesLeftJoinedToPoint[0], p+1); mtRCableJournalInterfaces.FieldByName('From_NppPort').AsInteger := NppPort; //ptrPortFirst.NppPort; if NppPort <> 0 then //mtRCableJournalInterfaces.FieldByName('From_PortMark').AsString := ConcatStrWithDefis(FirstConCompon.NameMark, IntToStr(NppPort)); //LastConCompon.NameShort + IntToStr(LastConCompon.MarkID)+'-'+IntToStr(ptrPortFirst.NppPort); mtRCableJournalInterfaces.FieldByName('From_PortMark').AsString := ConcatStrWithDefis(ptrPortFirst.ComponentOwner.NameMark, IntToStr(NppPort)); end; //MemTable_RCableJournalExt.FieldByName('From_NppPort').AsInteger := TSCSInterface(InterfacesLeft[0]).NppPort; //if TSCSInterface(InterfacesLeft[0]).NppPort <> 0 then // MemTable_RCableJournalExt.FieldByName('From_PortMark').AsString := LastConCompon.MarkStr + IntToStr(LastConCompon.MarkID)+'-'+IntToStr(TSCSInterface(InterfacesLeft[0]).NppPort); end; end; if InterfacesRight.Count > 0 then begin if (InterfacesRightPoint.Count - 1) >= p then begin if ShowDevNameTo then mtRCableJournalInterfaces.FieldByName('To_Device').AsString := GetDeviceNameByInterface(InterfacesRightPoint[p]); mtRCableJournalInterfaces.FieldByName('To_Element').AsString := GetElementNameByInterface(InterfacesRightPoint[p]); end; if ((InterfacesRight.Count - 1) >= p) and (TSCSComponent(TSCSInterface(InterfacesRight[p]).ComponentOwner).IsLine = biTrue) then begin mtRCableJournalInterfaces.FieldByName('To_WeldingCable').AsString := GetWelding(InterfacesRight); mtRCableJournalInterfaces.FieldByName('To_NumThread').AsString := GetNumThreads(InterfacesRight); end else if ((InterfacesRightPoint.Count - 1) >= p) and (InterfacesRightPoint[p].ComponentOwner.IsLine = biFalse) then //if (InterfacesRightPoint[0].ComponentOwner = RightCompon) or // (InterfacesRightPoint[0].ComponentOwner = LeftCompon) then begin mtRCableJournalInterfaces.FieldByName('To_InterfName').AsString := InterfacesRightPoint[p].LoadName; //TF_MAIN(GForm).DM.GetInterfName(TSCSInterface(InterfacesRight[0]).ID_Interface); ptrPortLast := InterfacesRightPoint[p].PortOwner; //TSCSComponent(TSCSInterface(InterfacesRight[0]).ComponentOwner).GetPort; if ptrPortLast <> nil then begin NppPort := GetNppPortByConnected(ptrPortLast, InterfacesRightPoint[p], InterfacesRighJoinedToPoint[0], p+1); mtRCableJournalInterfaces.FieldByName('To_NppPort').AsInteger := NppPort; // //ptrPortLast.NppPort; if NppPort <> 0 then //mtRCableJournalInterfaces.FieldByName('To_PortMark').AsString := ConcatStrWithDefis(LastConCompon.NameMark, IntToStr(NppPort)); //LastConCompon.NameShort + IntToStr(LastConCompon.MarkID)+'-'+IntToStr(ptrPortLast.NppPort); mtRCableJournalInterfaces.FieldByName('To_PortMark').AsString := ConcatStrWithDefis(ptrPortLast.ComponentOwner.NameMark, IntToStr(NppPort)); end; //MemTable_RCableJournalExt.FieldByName('To_NppPort').AsInteger := TSCSInterface(InterfacesRight[0]).NppPort; //if TSCSInterface(InterfacesRight[0]).NppPort <> 0 then // MemTable_RCableJournalExt.FieldByName('To_PortMark').AsString := LastConCompon.MarkStr + IntToStr(LastConCompon.MarkID)+'-'+IntToStr(TSCSInterface(InterfacesRight[0]).NppPort); end; end; } mtRCableJournalInterfaces.Post; end; end; FreeAndNil(InterfacesLeft); FreeAndNil(InterfacesLeftPoint); FreeAndNil(InterfacesLeftJoinedToPoint); FreeAndNil(InterfacesRight); FreeAndNil(InterfacesRightPoint); FreeAndNil(InterfacesRighJoinedToPoint); end; // Tolik -- 11/03/2017 -- //ParallelInterfaces.InterfList1.Free; //ParallelInterfaces.InterfList2.Free; FreeAndNil(ParallelInterfaces.InterfList1); FreeAndNil(ParallelInterfaces.InterfList2); // end; end; LookedCompons.Assign(ptrJoinedComponents.JoinedLines, laOr); end; {for j := 0 to CurrCompon.Net.Count - 1 do begin ptrJoinedComponents := CurrCompon.Net[j]; if Assigned(ptrJoinedComponents.JoinedLines) then LookedCompons.Assign(ptrJoinedComponents.JoinedLines, laOr); end;} end; end; for j := 0 to CurrCompon.Net.Count - 1 do begin ptrJoinedComponents := CurrCompon.Net[j]; if Assigned(ptrJoinedComponents.JoinedLines) then LookedCompons.Assign(ptrJoinedComponents.JoinedLines, laOr); end; end; end; end; end; //MemTable_RCableJournalExt.SortOn('NumCable', []); SortMemTableByParams(MemTable_RCableJournalExt, AParams, nil); finally EndProgress; LookedCompons.Free; end; GFormMode := fmRCableJournalExt; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderCableJournalExt: '+E.Message); end; end; procedure TF_ResourceReport.ShowFolderLegendObjectIcons(AFolder: TSCSCatalog; AParams: TReportItemParams; ACanHaveActiveComponents: Boolean); var i: Integer; CurrCatalog: TSCSCatalog; FirstComponent: TSCSComponent; ComponSignType: Integer; CurrObjIconGUID: string; CurrObjIconType: Integer; LookedObjectIconGUIDs: TStringList; LookedObjectIconActTypes: TIntList; LookedObjectIconProjTypes: TIntList; IndexOfLooked: Integer; SprObjectIcon: TNBObjectIcon; ObjectIcon: TMemoryStream; ObjectIconName: String; ProjOwner: TSCSProject; begin try FCatalog := AFolder; mtRLegendObjectIcons.Active := false; mtRLegendObjectIcons.Active := true; LookedObjectIconGUIDs := TStringList.Create; LookedObjectIconActTypes := TIntList.Create; LookedObjectIconProjTypes := TIntList.Create; BeginProgress(pcPreparingReport); try ProjOwner := AFolder.GetProject; if ProjOwner <> nil then for i := 0 to AFolder.ChildCatalogReferences.Count - 1 do begin CurrCatalog := AFolder.ChildCatalogReferences[i]; if CurrCatalog.ItemType in [itSCSLine, itSCSConnector] then begin //*** ID и Тип условного обозначения объекта //CurrObjIconID := GetIconIDByObjectID(CurrCatalog.SCSID); //CurrObjIconType := GetObjectTypeIDByObjectID(CurrCatalog.SCSID); FirstComponent := CurrCatalog.GetFirstComponent; if (AllNetTypes or (NetTypeGuidListSelected.IndexOf(FirstComponent.GUIDNetType) <> -1)) then begin if FirstComponent <> nil then begin CurrObjIconGUID := FirstComponent.GUIDObjectIcon; //CurrObjIconID := FirstComponent.IDObjectIcon; CurrObjIconType := FirstComponent.GetPropertyValueAsInteger(pnSignType); if (FirstComponent.GUIDObjectIcon <> '') and ((CurrObjIconType = oitProjectible) or ACanHaveActiveComponents) then begin IndexOfLooked := LookedObjectIconGUIDs.IndexOf(CurrObjIconGUID); if (IndexOfLooked = -1) or ((CurrObjIconType = oitActive) and (LookedObjectIconActTypes[IndexOfLooked] = oitNone)) or ((CurrObjIconType = oitProjectible) and (LookedObjectIconProjTypes[IndexOfLooked] = oitNone)) then begin //ObjectIcon := nil; //ObjectIcon := TF_Main(GForm).FNormBase.DM.GetComponIconByIconType(CurrObjIconID, CurrObjIconType, ieBMP); //ObjectIconName := TF_Main(GForm).FNormBase.DM.GetStringFromTableByID(tnObjectIcons, fnName, CurrObjIconID, qmPhisical); SprObjectIcon := ProjOwner.Spravochnik.GetObjectIconByGUID(CurrObjIconGUID); if SprObjectIcon <> nil then begin ObjectIcon := nil; if CurrObjIconType = oitProjectible then ObjectIcon := SprObjectIcon.ProjBmp else if CurrObjIconType = oitActive then ObjectIcon := SprObjectIcon.ActiveBmp; if ObjectIcon <> nil then begin ObjectIcon.Position := 0; mtRLegendObjectIcons.Append; mtRLegendObjectIcons.FieldByName(fnName).AsString := SprObjectIcon.Name; //ObjectIconName; TBlobField(mtRLegendObjectIcons.FieldByName(fnPicture)).LoadFromStream(ObjectIcon); mtRLegendObjectIcons.Post; //FreeAndNil(ObjectIcon); end; end; if IndexOfLooked = -1 then begin IndexOfLooked := LookedObjectIconGUIDs.Add(CurrObjIconGUID); LookedObjectIconActTypes.Add(oitNone); LookedObjectIconProjTypes.Add(oitNone); end; case CurrObjIconType of oitProjectible: LookedObjectIconProjTypes[IndexOfLooked] := CurrObjIconType; oitActive: LookedObjectIconActTypes[IndexOfLooked] := CurrObjIconType; end; end; end; end; end; end; end; finally EndProgress; LookedObjectIconGUIDs.Free; LookedObjectIconActTypes.Free; LookedObjectIconProjTypes.Free; //mtRLegendObjectIcons.SortOn(fnName, []); SortMemTableByParams(mtRLegendObjectIcons, AParams, nil); end; GFormMode := fmRLegendObjectIcons; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog(': '+E.Message); end; end; // ##### Ведомость по типам компонентов ##### procedure TF_ResourceReport.ShowFolderTypeComponenetsReport(AFolder: TSCSCatalog; AParams: TReportItemParams); var FolderIDComponList: TList; ListWithBusyCompons: TList; i, j, k: Integer; IDMaster: Integer; TypeList: TList; Group: TSCSCatalog; GroupList: TList; GroupComponent: TSCSComponent; GroupLength: Double; GroupCost: Double; TotalCost: Double; TypeCost: Double; strLength: String; LengthFromStr: Double; StrToShow: String; procedure AddToGroups(AIDComponent: Integer); var NewSCSComponent: TSCSComponent; Compon: TSCSComponent; i: Integer; Group: TSCSCatalog; GroupForReceiveCompon: TSCSCatalog; WholeLineCompon: TList; //*** Цельный линейный компонент Length: Double; strLength: String; LengthFromStr: Double; ptrIDBusy: ^Integer; begin if CheckNoIDinList(AIDComponent, ListWithBusyCompons) then begin NewSCSComponent := TSCSComponent.Create(GForm); NewSCSComponent.LoadComponentByID(AIDComponent, false); case NewSCSComponent.IsLine of biTrue: begin NewSCSComponent.LoadWholeComponent(false); NewSCSComponent.LoadWholeLength; //*** Занести в список занятых for i := 0 to NewSCSComponent.WholeComponent.Count - 1 do begin New(ptrIDBusy); ptrIDBusy^ := NewSCSComponent.WholeComponent[i]; ListWithBusyCompons.Add(ptrIDBusy); end; end; end; NewSCSComponent.NormsResources.CalcResourcesCost(true, true); if NewSCSComponent.NormsResources.ResourcesCost = 0 then begin NewSCSComponent.Free; Exit; //// EXIT //// end; GroupForReceiveCompon := nil; //*** Найти тип для компоненты GroupList := nil; for i := 0 to TypeList.Count - 1 do begin //GroupList := TypeList.Items[i]; if TList(TypeList.Items[i]).Count > 0 then begin Group := TList(TypeList.Items[i]).Items[0]; // GroupList.Items[0]; if Group.SCSComponents.Count > 0 then if TSCSComponent(Group.SCSComponents.Items[0]).ID_ComponentType = NewSCSComponent.ID_ComponentType then begin GroupList := TypeList.Items[i]; Break; end; end; end; //*** Если нет списка групп для тек-го типа, то создать ее if GroupList = nil then begin GroupList := TList.Create; TypeList.Add(GroupList); end; //*** Найти группу для компоненты for i := 0 to GroupList.Count - 1 do begin Group := GroupList.Items[i]; if Group.SCSComponents.Count > 0 then if TSCSComponent(Group.SCSComponents.Items[0]).GuidNB = NewSCSComponent.GuidNB then begin GroupForReceiveCompon := Group; Break; end; end; //*** Создать новую группу if GroupForReceiveCompon = nil then begin Group := TSCSCatalog.Create(GForm); GroupList.Add(Group); GroupForReceiveCompon := Group; end; //*** Добавить компонент в группу if GroupForReceiveCompon <> nil then begin //ptrNewSCSComponent.LoadNorms(false); //ptrNewSCSComponent.CalcResourcesCost(true, true); if NewSCSComponent.IsLine = biFalse then begin New(ptrIDBusy); ptrIDBusy^ := NewSCSComponent.ID; ListWithBusyCompons.Add(ptrIDBusy); end; //*** Добавление в группу if NewSCSComponent.NormsResources.ResourcesCost > 0 then GroupForReceiveCompon.SCSComponents.Add(NewSCSComponent) else NewSCSComponent.Free; end; end; end; begin FolderIDComponList := nil; try if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// try FCatalog := AFolder; //Tolik 18/05/2018 -- //FolderIDComponList := Tlist.Create; //ListWithBusyCompons := TList.Create; //TypeList := TList.Create; // //GroupList := TList.Create; //*** Найти все кмопоненты папки FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine, itSCSConnector]); if FolderIDComponList = nil then Exit; //// EXIT ///// // Tolik 18/05/2018 -- ListWithBusyCompons := TList.Create; TypeList := TList.Create; // //*** Разбить компоненты по группам относительно IDNormBase for i := 0 to FolderIDComponList.Count - 1 do AddToGroups(Integer(FolderIDComponList.Items[i]^)); TotalCost := 0; MemTable_RTypeComponents.Active := false; MemTable_RTypeComponents.Active := true; MemTable_RTypeComponentsDetail.Active := false; MemTable_RTypeComponentsDetail.Active := true; Screen.Cursor := crHourGlass; try for i := 0 to TypeList.Count - 1 do begin GroupList := TypeList.Items[i]; IDMaster := -1; TypeCost := 0; for j := 0 to GroupList.Count - 1 do begin Group := GroupList.Items[j]; GroupLength := 0; GroupCost := 0; if Group.SCSComponents.Count > 0 then begin StrToShow := ''; for k := 0 to Group.SCSComponents.Count - 1 do begin GroupComponent := Group.SCSComponents.Items[k]; //*** Если Первый компонент текущего типа if (j = 0) and (k = 0) then begin GroupComponent.LoadComponentType; MemTable_RTypeComponents.Append; MemTable_RTypeComponents.FieldByName('Name_Type').AsString := GroupComponent.ComponentType.Name; if GroupComponent.ComponentType.IsLine = biTrue then MemTable_RTypeComponents.FieldByName('IsLine').AsString := 'Да' else MemTable_RTypeComponents.FieldByName('IsLine').AsString := 'Нет'; IDMaster := MemTable_RTypeComponents.FieldByName('ID').AsInteger; MemTable_RTypeComponents.Post; // IDMaster := MemTable_RTypeComponents.FieldByName('ID').AsInteger; end; GroupCost := GroupCost + GroupComponent.NormsResources.ResourcesCost; if GroupComponent.IsLine = biTrue then GroupLength := GroupLength + GroupComponent.Length; TypeCost := TypeCost + GroupComponent.NormsResources.ResourcesCost; end; GroupComponent := Group.SCSComponents.Items[0]; MemTable_RTypeComponentsDetail.Append; MemTable_RTypeComponentsDetail.FieldByName('ID').AsInteger := GroupComponent.ID; MemTable_RTypeComponentsDetail.FieldByName('ID_MASTER').AsInteger := IDMaster; MemTable_RTypeComponentsDetail.FieldByName('NAME').AsString := GroupComponent.Name; case GroupComponent.IsLine of biTrue: begin MemTable_RTypeComponentsDetail.FieldByName('Kolvo').AsFloat := Round3(GroupLength); MemTable_RTypeComponentsDetail.FieldByName('Price').AsFloat := Round3(GroupComponent.NormsResources.ResourcesCostPerOneNorm); end; biFalse: begin MemTable_RTypeComponentsDetail.FieldByName('Kolvo').AsFloat := Round3(Group.SCSComponents.Count); MemTable_RTypeComponentsDetail.FieldByName('Price').AsFloat := Round3(GroupComponent.NormsResources.ResourcesCost); end; end; MemTable_RTypeComponentsDetail.FieldByName('Cost').AsFloat := Round3(GroupCost); MemTable_RTypeComponentsDetail.Post; TotalCost := TotalCost + GroupCost; end; if j = GroupList.Count - 1 then begin MemTable_RTypeComponents.Edit; MemTable_RTypeComponents.FieldByName('Cost_Type').AsFloat := Round3(TypeCost); MemTable_RTypeComponents.Post; end; end; end; //Label_TotalCost.Caption := FloatToStr(RoundX(TotalCost, 3)) +' '+GCurrency.Name_Brief; finally Screen.Cursor := crDefault; end; GFormMode := fmRTypeComponents; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderTypeComponenetsReport: '+E.Message); end; finally //*** Удалить Группы for i := 0 to TypeList.Count - 1 do begin GroupList := TypeList.items[i]; for j := 0 to GroupList.Count - 1 do begin Group := GroupList.Items[j]; Group.Free; end; //GroupList.Free; end; FreeList(TypeList); //FreeList(GroupList); FreeList(ListWithBusyCompons); FreeList(FolderIDComponList); end; end; // ##### Отчет "Спецификация" ##### procedure TF_ResourceReport.ShowFolderSpecificationReport(AFolder: TSCSCatalog; AParams, AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode; ACanHaveActiveComponents, ACanHaveZeroPriceComponents, ACanHaveDismountAccount, ACanRoundValue, ACanHaveSupplyValue: Boolean); const CmpDelta = 0.001; var FolderComponents: TSCSComponents; GroupTypeComponents: TSCSComponents; GroupTypeComponent: TSCSComponent; GroupComponent: TSCSComponent; ComponsFromResources: TSCSComponents; CachedNBCompons: TSCSComponents; NBComponent: TSCSComponent; IDNBComponent: Integer; SprComponent: TSCSComponent; NormResourcesKinds: TNormResourcesKinds; Resources: TSCSNormsResources; ResourceRel: TSCSResourceRel; CurrGroupComponent: TSCSComponent; Component: TSCSComponent; ComponTypeForGroup: TComponentType; ComponSignType: Integer; ComponentLengthKolvo: Double; PartComponent: TSCSComponent; PartLength: Double; ExpenseForMetr: Double; //ExpenseForSection: Double; LengthTrace: Double; LookedComponIDs: TIntList; IDTypeSpecif: Integer; ReservLength: Double; CanAddComponToGroup: Boolean; ProjectOwner: TSCSProject; SprSuppliesKind: TNBSuppliesKind; ComponIzm: String; Kolvo, Price, Cost: Double; TotalCost: Double; i, j, k: Integer; function GetComponTypeForGroup(AComponent: TSCSComponent): TComponentType; var PropGrpName: PProperty; begin ZeroMemory(@Result, SizeOf(TComponentType)); if AReportItemParamValues.GroupMode = gmComponType then Result := AComponent.ComponentType else if AReportItemParamValues.GroupMode = gmGroupName then begin PropGrpName := AComponent.GetPropertyBySysName(pnGroupName); if PropGrpName = nil then begin Result.GUID := ''; Result.Name := cResourceReport_Msg44; end else begin Result.GUID := PropGrpName.Value; Result.Name := PropGrpName.Value; end; Result.NamePlural := Result.Name; end; end; begin try Component := nil; if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FCatalog := AFolder; ProjectOwner := AFolder.GetProject; DefinePrecisions; TotalCost := 0; GroupTypeComponents := TSCSComponents.Create(true); LookedComponIDs := TIntList.Create; MemTable_RSpecifTypeCompon.Active := false; MemTable_RSpecifTypeCompon.Active := true; MemTable_RSpecification.Active := false; MemTable_RSpecification.Active := true; BeginProgress(pcPreparingReport); try // Tolik // по типам сетей INeedNormsRecources := True; // //*** Сгруппировать компоненты FolderComponents := TSCSComponents.Create(false); FolderComponents.Assign(AFolder.ComponentReferences); //Определяем сгруппирированные аксессуары и ресурсы в список компонентов ComponsFromResources := TSCSComponents.Create(true); NormResourcesKinds := [nrAccessories]; if AReportItemParamValues.CanResources = biTrue then NormResourcesKinds := NormResourcesKinds + [nrResources]; Resources := AFolder.GetAllNormsResources(NormResourcesKinds, false, ACanHaveActiveComponents, ACanHaveDismountAccount, ACanHaveZeroPriceComponents); CachedNBCompons := TSCSComponents.Create(true); for i := 0 to Resources.Resources.Count - 1 do begin ResourceRel := Resources.Resources[i]; Component := TSCSComponent.Create(GForm); if ResourceRel.GUIDNBComponent <> '' then begin // Если ресурс из компонента, то ищем его в кеше компонентов из НБ NBComponent := GetComponByGUIDFromList(ResourceRel.GUIDNBComponent, CachedNBCompons); if NBComponent = nil then begin // ищем в НБ IDNBComponent := F_NormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, ResourceRel.GUIDNBComponent, qmPhisical); if IDNBComponent <> 0 then begin NBComponent := TSCSComponent.Create(F_NormBase); NBComponent.LoadComponentByID(IDNBComponent, false); NBComponent.LoadComponentType; // Если на аксессуар установлено свойство "расход на метр", то не учитвать его, т.к. // это свойство уж есть в аксессуаре и оно учтено NBComponent.SetPropertyValueAsFloat(pnExpenseForMetr, 0, false); CachedNBCompons.Add(NBComponent); end else begin // ищем в справочном компоненте //SprComponent := AFolder.ProjectOwner.GetSprComponentByGUID(ResourceRel.GUIDNBComponent); SprComponent := ProjectOwner.GetSprComponentByGUID(ResourceRel.GUIDNBComponent); if SprComponent <> nil then NBComponent := SprComponent; end; end; if NBComponent <> nil then Component.AssignOnlyComponent(NBComponent); end else begin // Внесем отдельный тип - ресурсы Component.GUIDComponentType := guidCompTypeResource; Component.ComponentType.GUID := guidCompTypeResource; Component.ComponentType.SysName := guidCompTypeResource; Component.ComponentType.NamePlural := cBaseOptions_Msg4_1; end; Component.IsLine := biFalse; Component.ComponentType.IsLine := biFalse; Component.Name := ResourceRel.Name; Component.Izm := ResourceRel.Izm; Component.Price := ResourceRel.Price; Component.Length := ResourceRel.Kolvo; FolderComponents.Add(Component); ComponsFromResources.Add(Component); end; FreeAndNil(CachedNBCompons); FreeAndNil(Resources); for i := 0 to FolderComponents.Count - 1 do begin Component := FolderComponents[i]; if Assigned(Component) then begin // Tolik // по типу сети if (AllNetTypes) or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(Component.GUIDNetType)<> -1)) then begin ComponIzm := Component.Izm; if CheckPriceTransformToUOMByCompType(@Component.ComponentType) then ComponIzm := GetNameUOM(umMetr, true); //ComponSignType := Component.GetPropertyValueAsInteger(pnSignType); if ((Component.ID = 0) or (LookedComponIDs.IndexOf(Component.ID) = -1)) and CheckCanLookComponInReportRsrc(Component, ACanHaveActiveComponents, ACanHaveDismountAccount) then //((ComponSignType = oitProjectible) or // (ACanHaveActiveComponents or (ACanHaveDismountAccount and (Component.IsDismount = biTrue)) )) then begin if Component.IsLine = biTrue then begin Component.Length := GetComponPartLengthWithReserv(Component, ReservLength, true, true); // 2007.03.15 Component.LoadWholeComponent(false); //Component.RefreshWholeLengthIfNecessary; // 2007.03.15 if AFolder.ItemType = itProject then // 2007.03.15 begin // 2007.03.15 Component.RefreshWholeLength; // 2007.03.15 Component.Length := Component.GetPropertyValueAsFloat(pnLength) // 2007.03.15 end // 2007.03.15 else // 2007.03.15 Component.Length := Component.GetWholeLength(false); end; GroupTypeComponent := nil; GroupComponent := nil; if (Component.Price > 0) or (ACanHaveZeroPriceComponents) then begin ComponTypeForGroup := GetComponTypeForGroup(Component); //*** Найти группу компонент с соответствующим типом компоненты for j := 0 to GroupTypeComponents.Count - 1 do if GroupTypeComponents[j].GUIDComponentType = ComponTypeForGroup.GUID then //28.02.2012 if GroupTypeComponents[j].GUIDComponentType = Component.ComponentType.GUID then begin GroupTypeComponent := GroupTypeComponents[j]; Break; //// BREAK //// end; if GroupTypeComponent = nil then begin GroupTypeComponent := TSCSComponent.Create(GForm); GroupTypeComponent.GUIDComponentType := ComponTypeForGroup.GUID; //28.02.2012 Component.ComponentType.GUID; GroupTypeComponent.ID_ComponentType := ComponTypeForGroup.ID; //28.02.2012 Component.ComponentType.ID; GroupTypeComponent.Name := ComponTypeForGroup.NamePlural; //28.02.2012 Component.ComponentType.NamePlural; GroupTypeComponents.Add(GroupTypeComponent); end; if GroupTypeComponent <> nil then begin //*** Найти в группе компонент который имеет сходственные параметры с Component for j := 0 to GroupTypeComponent.ChildComplects.Count - 1 do begin CurrGroupComponent := GroupTypeComponent.ChildComplects[j]; CanAddComponToGroup := false; if (CurrGroupComponent.ArticulProducer = Component.ArticulProducer) and (CurrGroupComponent.ArticulDistributor = Component.ArticulDistributor) and //(((Component.IsLine = biTrue) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCostPerOneNorm) < CmpDelta)) or // ((Component.IsLine = biFalse) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCost) < CmpDelta))) and (Abs(CurrGroupComponent.Price - Component.Price) < CmpDelta) and (CurrGroupComponent.Izm = ComponIzm) and (CurrGroupComponent.GUIDProducer = Component.GUIDProducer) and (CurrGroupComponent.Name = Component.Name) and (CurrGroupComponent.NameShort = Component.NameShort) and ((AResourceReportFormMode <> fmRGOSTSpecification) or (CurrGroupComponent.Notice = Component.Notice)) then begin CanAddComponToGroup := true; //***группировка по видам поставки if ACanHaveSupplyValue then if (CurrGroupComponent.GUIDSuppliesKind <> '') and (CurrGroupComponent.GUIDSuppliesKind <> Component.GUIDSuppliesKind) then if ProjectOwner.Spravochnik.GetSuppliesKindByGUID(Component.GUIDSuppliesKind) <> nil then CanAddComponToGroup := false; if CanAddComponToGroup then begin GroupComponent := CurrGroupComponent; Break; //// BREAK //// end; end; end; if GroupComponent = nil then begin GroupComponent := TSCSComponent.Create(GForm); GroupComponent.AssignOnlyComponent(Component); GroupComponent.Izm := ComponIzm; GroupComponent.Length := 0; {if GroupComponent.ArticulProducer = '' then if GroupComponent.ArticulDistributor <> '' then GroupComponent.ArticulProducer := GroupComponent.ArticulDistributor; GroupComponent.Length := 0;} //*** На тот случай, если мертвая ссылка на вид поставки if GroupComponent.GUIDSuppliesKind <> '' then if ProjectOwner.Spravochnik.GetSuppliesKindByGUID(GroupComponent.GUIDSuppliesKind) = nil then GroupComponent.GUIDSuppliesKind := ''; GroupTypeComponent.ChildComplects.Add(GroupComponent); end; if GroupComponent <> nil then begin //if (GroupComponent.Notice = '') and (Component.Notice <> '') then // GroupComponent.Notice := Component.Notice; ComponentLengthKolvo := 0; case GroupComponent.IsLine of biFalse: begin ComponentLengthKolvo := 1; // Если ресурс, то берем количество этого ресурса из поля Length if ComponsFromResources.IndexOf(Component) <> -1 then ComponentLengthKolvo := Component.Length; if ((Component.ComponentType.SysName = ctsnCableChannelAccessory) or (Component.ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr := Component.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then begin ComponentLengthKolvo := Round(Component.Length * ExpenseForMetr); end end; end; biTrue: begin // Расход на ед.длины ExpenseForMetr := Component.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr > 0 then begin //ComponentLengthKolvo := Round(Component.Length) * ExpenseForMetr; ComponentLengthKolvo := Round(Component.Length * ExpenseForMetr); // 2007.03.15 LengthTrace := 0; // 2007.03.15 for k := 0 to Component.WholeComponent.Count - 1 do // 2007.03.15 begin // 2007.03.15 PartComponent := FCatalog.GetComponentFromReferences(Component.WholeComponent[k]); // 2007.03.15 if PartComponent <> nil then // 2007.03.15 begin // 2007.03.15 PartLength := PartComponent.GetPartLength; // 2007.03.15 LengthTrace := LengthTrace + PartLength; // 2007.03.15 end; // 2007.03.15 end; // 2007.03.15 ComponentLengthKolvo := Round(LengthTrace) * ExpenseForMetr; end else ComponentLengthKolvo := RoundCP(Component.Length); // Расход на отрезок //ExpenseForSection := Component.GetPropertyValueAsFloat(pnExpenseForSection); //if ExpenseForSection > 0 then // ComponentLengthKolvo := ComponentLengthKolvo + ExpenseForSection; end; end; //*** Если учитывать демонтаж, и компонент демонтирован, // то отнимать от общего количества, кол-во этой компоненты if ACanHaveDismountAccount and (Component.IsDismount = biTrue) then if Component.IsUseDismounted = biTrue then ComponentLengthKolvo := ComponentLengthKolvo * -1 else ComponentLengthKolvo := 0; GroupComponent.Length := GroupComponent.Length + ComponentLengthKolvo; end; end; end; //25.02.2009 LookedComponIDs.Add(Component.ID); // 2007.03.15 //if Component.IsLine = biTrue then //begin // for j := 0 to Component.WholeComponent.Count - 1 do // if Component.WholeComponent[j] <> Component.ID then // LookedComponIDs.Add(Component.WholeComponent[j]); //end; end; end; end; end; FreeAndNil(ComponsFromResources); FreeAndNil(FolderComponents); //*** Закинуть группы в MemTable for i := 0 to GroupTypeComponents.Count - 1 do begin GroupTypeComponent := GroupTypeComponents[i]; MemTable_RSpecifTypeCompon.Append; //*** ID - AutoInc MemTable_RSpecifTypeCompon.FieldByName(fnName).AsString := GroupTypeComponent.Name; MemTable_RSpecifTypeCompon.FieldByName(fnIDComponentType).AsInteger := GroupTypeComponent.ID_ComponentType; IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName(fnID).AsInteger; MemTable_RSpecifTypeCompon.Post; for j := 0 to GroupTypeComponent.ChildComplects.Count - 1 do begin GroupComponent := GroupTypeComponent.ChildComplects[j]; if GroupComponent.Length > 0 then begin //*** Округлить количество и цену групповой компоненты //GroupComponent.Length := RoundCP(GroupComponent.Length); //GroupComponent.Price := RoundCP(GroupComponent.Price); //*** Учитывать вид поставки SprSuppliesKind := nil; if (ACanHaveSupplyValue or (isCableComponent(GroupComponent) and (not cbNone.Checked))) and (GroupComponent.GUIDSuppliesKind <> '') then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(GroupComponent.GUIDSuppliesKind); // Подогнать под вид поставки // Tolik - 09/11/2020 - для кабеля если только не выбрана опция "НЕТ" для расчета катушек //if SprSuppliesKind <> nil then if ((SprSuppliesKind <> nil) and ((GroupComponent.isLine = biFalse) or (not isCableComponent(GroupComponent)) or (isCableComponent(GroupComponent) and (not cbNone.Checked)))) then begin if CheckIsTradUOM(TF_Main(GForm).FUOM) then begin GroupComponent.Izm := SprSuppliesKind.Data.NameTradUOM; if CheckPriceTransformToUOMByCompType(@GroupComponent.ComponentType) then begin // Для кабелей и каналов в традиционной системы США нужно юзать ФУТЫ GroupComponent.Length := FloatInUOM(GroupComponent.Length, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; GroupComponent.Price := FloatInUOM(GroupComponent.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin GroupComponent.Length := GroupComponent.Length / SprSuppliesKind.Data.UnitKolvoTradUOM; GroupComponent.Price := GroupComponent.Price * SprSuppliesKind.Data.UnitKolvoTradUOM; end; end else begin GroupComponent.Izm := SprSuppliesKind.Data.Name; GroupComponent.Length := GroupComponent.Length / SprSuppliesKind.Data.UnitKolvo; GroupComponent.Price := GroupComponent.Price * SprSuppliesKind.Data.UnitKolvo; end; end else begin if CheckPriceTransformToUOMByCompType(@GroupComponent.ComponentType) then begin GroupComponent.Izm := GetNameUOM(TF_Main(GForm).FUOM, true); if TF_Main(GForm).FUOM <> umMetr then begin GroupComponent.Length := FloatInUOM(GroupComponent.Length, umMetr, TF_Main(GForm).FUOM); GroupComponent.Price := FloatInUOM(GroupComponent.Price, TF_Main(GForm).FUOM, umMetr); end; end; end; //*** Учитывать флаг округления if ACanRoundValue then GroupComponent.Length := RoundUp(GroupComponent.Length); MemTable_RSpecification.Append; MemTable_RSpecification.FieldByName(fnID).AsInteger := GroupComponent.ID; MemTable_RSpecification.FieldByName(fnIDMaster).AsInteger := IDTypeSpecif; MemTable_RSpecification.FieldByName(fnName).AsString := GroupComponent.Name; MemTable_RSpecification.FieldByName(fnNameShort).AsString := GroupComponent.NameShort; MemTable_RSpecification.FieldByName(fnArticulProducer).AsString := GroupComponent.ArticulProducer; MemTable_RSpecification.FieldByName(fnArticulDistributor).AsString := GroupComponent.ArticulDistributor; MemTable_RSpecification.FieldByName(fnNotice).AsString := GroupComponent.Notice; if GroupComponent.ArticulProducer = '' then if GroupComponent.ArticulDistributor <> '' then GroupComponent.ArticulProducer := GroupComponent.ArticulDistributor; MemTable_RSpecification.FieldByName(fnIDProducer).AsInteger := GroupComponent.ID_Producer; MemTable_RSpecification.FieldByName(fnProducerName).AsString := GroupComponent.GetProducerName; MemTable_RSpecification.FieldByName(fnIzm).AsString := GroupComponent.Izm; {//27.03.2012 MemTable_RSpecification.FieldByName(fnKolvo).AsFloat := RoundCP(GroupComponent.Length); MemTable_RSpecification.FieldByName(fnPrice).AsFloat := RoundCP(GroupComponent.Price); //MemTable_RSpecification.FieldByName(fnCost).AsFloat := Round3(Round3(GroupComponent.PRICE) * Round3(GroupComponent.Length)); MemTable_RSpecification.FieldByName(fnCost).AsFloat := RoundCP(GroupComponent.Price * GroupComponent.Length); MemTable_RSpecification.Post; TotalCost := TotalCost + RoundCP(GroupComponent.Price * GroupComponent.Length);} Kolvo := RoundX(GroupComponent.Length, FKolvoPrecision); Price := RoundX(GroupComponent.Price, FPricePrecision); Cost := RoundX(Kolvo * Price, Max(FKolvoPrecision, FPricePrecision) ); MemTable_RSpecification.FieldByName(fnKolvo).AsFloat := Kolvo; MemTable_RSpecification.FieldByName(fnPrice).AsFloat := Price; MemTable_RSpecification.FieldByName(fnCost).AsFloat := Cost; MemTable_RSpecification.Post; TotalCost := TotalCost + Cost; end; end; end; MemTable_RSpecifTypeCompon.SortOn(fnName, []); SortMemTableByParams(MemTable_RSpecification, AParams, nil); finally EndProgress; LookedComponIDs.Free; GroupTypeComponents.Free; //Toilk INeedNormsRecources := False; // end; GFormMode := AResourceReportFormMode; //fmRSpecification; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderSpecificationReport: '+E.Message); end; end; (* procedure TF_ResourceReport.ShowFolderSpecificationReport(AFolder: TSCSCatalog; ACanHaveActiveComponents: Boolean); const CmpDelta = 0.001; var ListWithLookedCompons: TList; ptrID: ^Integer; CurrIDCompon: Integer; Component: TSCSComponent; ComponSignType: Integer; TypeSpecifList: TList; i, j: Integer; IDTypeSpecif: integer; IDObject: Integer; IDSpecification: Integer; TypeKolvo: Double; TypeCost: Double; CurrKolvo: Double; //CurrCost: Double; begin try Component := nil; if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FCatalog := AFolder; ListWithLookedCompons := TList.Create; //Component := TSCSComponent.Create(GForm); MemTable_RSpecifTypeCompon.Active := false; MemTable_RSpecifTypeCompon.Active := true; MemTable_RSpecification.Active := false; MemTable_RSpecification.Active := true; BeginProgress(pcPreparingReport); try for i := 0 to AFolder.ComponentReferences.Count - 1 do begin Component := AFolder.ComponentReferences[i]; if Assigned(Component) then begin ComponSignType := Component.GetPropertyValueAsInteger(pnSignType); if CheckNoIDinList(Component.ID, ListWithLookedCompons) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then begin if Component.IsLine = biTrue then begin Component.RefreshWholeLengthIfNecessary; //Component.LoadWholeComponent(false); //Component.LoadWholeLength; end; //Component.NormsResources.CalcResourcesCost(true, true); //if Component.NormsResources.ResourcesCost > 0 then if Component.Price > 0 then begin IDTypeSpecif := -1; IDObject := -1; IDSpecification := -1; CurrKolvo := 0; //CurrCost := 0; //*** Найти тип спецификации MemTable_RSpecifTypeCompon.First; while Not MemTable_RSpecifTypeCompon.Eof do begin if MemTable_RSpecifTypeCompon.FieldByName('id_component_type').AsInteger = Component.ID_ComponentType then begin IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName('id').AsInteger; Break; ///// BREAK ///// end; MemTable_RSpecifTypeCompon.Next; end; //*** Если тип не найден, то создать его if IDTypeSpecif = -1 then begin Component.RefreshComponentType; MemTable_RSpecifTypeCompon.Append; //*** ID - AutoInc MemTable_RSpecifTypeCompon.FieldByName('name').AsString := Component.ComponentType.NamePlural; MemTable_RSpecifTypeCompon.FieldByName('id_component_type').AsInteger := Component.ID_ComponentType; MemTable_RSpecifTypeCompon.Post; IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName('ID').AsInteger; end; //*** Найти спецификацию для компоненты по совпадающим артик. номерам и ценам while Not MemTable_RSpecification.Eof do begin if (MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString = Component.ArticulProducer) and (MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString = Component.ArticulDistributor) and //(((Component.IsLine = biTrue) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCostPerOneNorm) < CmpDelta)) or // ((Component.IsLine = biFalse) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCost) < CmpDelta))) and (Abs(MemTable_RSpecification.FieldByName(fnPrice).AsFloat - Component.Price) < CmpDelta) and (MemTable_RSpecification.FieldByName('IZM').AsString = Component.Izm) and (MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger = Component.ID_Producer) and (MemTable_RSpecification.FieldByName('NAME').AsString = Component.Name) and (MemTable_RSpecification.FieldByName('NAME_SHORT').AsString = Component.NameShort) then begin IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; TypeKolvo := MemTable_RSpecification.FieldByName('KOLVO').AsFloat; TypeCost := MemTable_RSpecification.FieldByName('COST').AsFloat; CurrKolvo := 0; MemTable_RSpecification.Edit; case Component.IsLine of biTrue: CurrKolvo := Component.Length; biFalse: CurrKolvo := CurrKolvo + 1; end; TypeKolvo := TypeKolvo + CurrKolvo; MemTable_RSpecification.FieldByName('Kolvo').AsFloat := TypeKolvo; MemTable_RSpecification.FieldByName('COST').AsFloat := TypeCost + Round3(CurrKolvo * MemTable_RSpecification.FieldByName(fnPrice).AsFloat); MemTable_RSpecification.Post; end; MemTable_RSpecification.Next; end; //*** Если не найдена спецификация, то создается новая if IDSpecification = -1 then begin MemTable_RSpecification.Append; MemTable_RSpecification.FieldByName('ID').AsInteger := Component.ID; MemTable_RSpecification.FieldByName('ID_MASTER').AsInteger := IDTypeSpecif; MemTable_RSpecification.FieldByName('NAME').AsString := Component.Name; MemTable_RSpecification.FieldByName('NAME_SHORT').AsString := Component.NameShort; MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString := Component.ArticulProducer; MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString := Component.ArticulDistributor; MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger := Component.ID_Producer; MemTable_RSpecification.FieldByName('PRODUCER').AsString := Component.GetProducerName; MemTable_RSpecification.FieldByName('IZM').AsString := Component.Izm; CurrKolvo := 1; case Component.IsLine of biTrue: CurrKolvo := Component.Length; biFalse: CurrKolvo := 1; end; MemTable_RSpecification.FieldByName('Kolvo').AsFloat := CurrKolvo; MemTable_RSpecification.FieldByName('PRICE').AsFloat := Round3(Component.PRICE); MemTable_RSpecification.FieldByName('COST').AsFloat := Round3(Round3(Component.PRICE) * CurrKolvo); MemTable_RSpecification.Post; IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; end; { //*** Найти спецификацию для компоненты по совпадающим артик. номерам и ценам while Not MemTable_RSpecification.Eof do begin if (MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString = Component.ArticulProducer) and (MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString = Component.ArticulDistributor) and (((Component.IsLine = biTrue) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCostPerOneNorm) < CmpDelta)) or ((Component.IsLine = biFalse) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCost) < CmpDelta))) and (MemTable_RSpecification.FieldByName('IZM').AsString = Component.Izm) and (MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger = Component.ID_Producer) and (MemTable_RSpecification.FieldByName('NAME').AsString = Component.Name) and (MemTable_RSpecification.FieldByName('NAME_SHORT').AsString = Component.NameShort) then begin IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; CurrKolvo := MemTable_RSpecification.FieldByName('KOLVO').AsFloat; CurrCost := MemTable_RSpecification.FieldByName('COST').AsFloat; MemTable_RSpecification.Edit; case Component.IsLine of biTrue: MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(CurrKolvo + Component.Length, 2); biFalse: MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(CurrKolvo + 1, 2); end; MemTable_RSpecification.FieldByName('COST').AsFloat := RoundX(CurrCost + Component.NormsResources.ResourcesCost, 2); MemTable_RSpecification.Post; end; MemTable_RSpecification.Next; end; //*** Если не найдена спецификация, то создается новая if IDSpecification = -1 then begin MemTable_RSpecification.Append; MemTable_RSpecification.FieldByName('ID').AsInteger := Component.ID; MemTable_RSpecification.FieldByName('ID_MASTER').AsInteger := IDTypeSpecif; MemTable_RSpecification.FieldByName('NAME').AsString := Component.Name; MemTable_RSpecification.FieldByName('NAME_SHORT').AsString := Component.NameShort; MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString := Component.ArticulProducer; MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString := Component.ArticulDistributor; MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger := Component.ID_Producer; MemTable_RSpecification.FieldByName('PRODUCER').AsString := Component.GetProducerName; MemTable_RSpecification.FieldByName('IZM').AsString := Component.Izm; case Component.IsLine of biTrue: begin MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(Component.Length, 2); MemTable_RSpecification.FieldByName('PRICE').AsFloat := RoundX(Component.NormsResources.ResourcesCostPerOneNorm, 2); end; biFalse: begin MemTable_RSpecification.FieldByName('Kolvo').AsFloat := 1; MemTable_RSpecification.FieldByName('PRICE').AsFloat := RoundX(Component.NormsResources.ResourcesCost, 2); end; end; MemTable_RSpecification.FieldByName('COST').AsFloat := RoundX(Component.NormsResources.ResourcesCost, 2); MemTable_RSpecification.Post; IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; end; } case Component.IsLine of biTrue: for j := 0 to Component.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := Component.WholeComponent[j]; ListWithLookedCompons.Add(ptrID); end; biFalse: begin New(ptrID); ptrID^ := Component.ID; ListWithLookedCompons.Add(ptrID); end; end; end; end; end; end; MemTable_RSpecifTypeCompon.SortOn(fnName, []); finally EndProgress; FreeList(ListWithLookedCompons); end; GFormMode := fmRSpecification; Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog(': '+E.Message); end; end; *) (* // ##### Отчет "Спецификация" ##### procedure TF_ResourceReport.ShowFolderSpecificationReport(AFolder: TSCSCatalog); const CmpDelta = 0.0001; var FolderIDComponList: TList; ListWithLookedCompons: TList; ptrID: ^Integer; CurrIDCompon: Integer; Component: TSCSComponent; TypeSpecifList: TList; i, j: Integer; IDTypeSpecif: integer; IDObject: Integer; IDSpecification: Integer; CurrKolvo: Double; CurrCost: Double; begin try try Component := nil; if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// FolderIDComponList := Tlist.Create; ListWithLookedCompons := TList.Create; Component := TSCSComponent.Create(GForm); //*** Найти все кмопоненты папки FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine, itSCSConnector]); if FolderIDComponList = nil then Exit; //// EXIT ///// MemTable_RSpecifTypeCompon.Active := false; MemTable_RSpecifTypeCompon.Active := true; MemTable_RSpecification.Active := false; MemTable_RSpecification.Active := true; Screen.Cursor := crHourGlass; try for i := 0 to FolderIDComponList.Count - 1 do begin CurrIDCompon := Integer(FolderIDComponList.Items[i]^); if CheckNoIDinList(CurrIDCompon, ListWithLookedCompons) then begin Component.LoadComponentByID(CurrIDCompon, false); Component.LoadOwnerCatalog(false); if Component.IsLine = biTrue then begin Component.LoadWholeComponent(false); Component.LoadWholeLength(true); end; Component.NormsResources.CalcResourcesCost(true, true); if Component.NormsResources.ResourcesCost > 0 then begin IDTypeSpecif := -1; IDObject := -1; IDSpecification := -1; CurrKolvo := 0; CurrCost := 0; //*** Найти тип спецификации MemTable_RSpecifTypeCompon.First; while Not MemTable_RSpecifTypeCompon.Eof do begin if MemTable_RSpecifTypeCompon.FieldByName('id_component_type').AsInteger = Component.ID_ComponentType then begin IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName('id').AsInteger; Break; ///// BREAK ///// end; MemTable_RSpecifTypeCompon.Next; end; //*** Если тип не найден, то создать его if IDTypeSpecif = -1 then begin Component.LoadComponentType; MemTable_RSpecifTypeCompon.Append; //*** ID - AutoInc MemTable_RSpecifTypeCompon.FieldByName('name').AsString := Component.ComponentType.NAME; MemTable_RSpecifTypeCompon.FieldByName('id_component_type').AsInteger := Component.ID_ComponentType; MemTable_RSpecifTypeCompon.Post; IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName('ID').AsInteger; end; { //*** Найти объект, для Компонента while Not MemTable_RObject.Eof do begin if ((Component.ID_ComponentType = ctWorkPlace) and (MemTable_RObject.FieldByName('ID_CATALOG').AsInteger = TSCSCatalog(Component.OwnerCatalog).ID)) then begin IDObject := MemTable_RObject.FieldByName('ID').AsInteger; Break; ///// BREAK ////// end; if Component.ID_ComponentType <> ctWorkPlace then begin IDObject := MemTable_RObject.FieldByName('ID').AsInteger; if IDObject <> TSCSCatalog(Component.OwnerCatalog).ID then begin MemTable_RObject.Edit; MemTable_RObject.FieldByName('NAME').AsString := ''; MemTable_RObject.Post; end; Break; ///// BREAK ////// end; MemTable_RObject.Next; end; //*** Если объект для этого компонента небыл найден if IDObject = -1 then begin MemTable_RObject.Append; MemTable_RObject.FieldByName('ID_MASTER').AsInteger := IDTypeSpecif; MemTable_RObject.FieldByName('ID_CATALOG').AsInteger := TSCSCatalog(Component.OwnerCatalog).ID; MemTable_RObject.FieldByName('NAME').AsString := GetNameAndIndexByTSCSCatalog(Component.OwnerCatalog); //if Component.ID_ComponentType = ctWorkPlace then // MemTable_RObject.FieldByName('NAME').AsString := GetNameAndIndexByTSCSCatalog(Component.OwnerCatalog) //TSCSCatalog(Component.OwnerCatalog).Name //else // MemTable_RObject.FieldByName('NAME').AsString := ''; MemTable_RObject.Post; IDObject := MemTable_RObject.FieldByName('ID').AsInteger; end; } //*** Найти спецификацию для компоненты по совпадающим артик. номерам и ценам while Not MemTable_RSpecification.Eof do begin if (MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString = Component.ArticulProducer) and (MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString = Component.ArticulDistributor) and (((Component.IsLine = biTrue) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCostPerOneNorm) < CmpDelta)) or ((Component.IsLine = biFalse) and (Abs(MemTable_RSpecification.FieldByName('PRICE').AsFloat - Component.NormsResources.ResourcesCost) < CmpDelta))) and (MemTable_RSpecification.FieldByName('IZM').AsString = Component.Izm) and (MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger = Component.ID_Producer) and (MemTable_RSpecification.FieldByName('NAME').AsString = Component.Name) and (MemTable_RSpecification.FieldByName('NAME_SHORT').AsString = Component.NameShort) then begin IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; CurrKolvo := MemTable_RSpecification.FieldByName('KOLVO').AsFloat; CurrCost := MemTable_RSpecification.FieldByName('COST').AsFloat; MemTable_RSpecification.Edit; case Component.IsLine of biTrue: MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(CurrKolvo + Component.Length, 2); biFalse: MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(CurrKolvo + 1, 2); end; MemTable_RSpecification.FieldByName('COST').AsFloat := RoundX(CurrCost + Component.NormsResources.ResourcesCost, 2); MemTable_RSpecification.Post; end; MemTable_RSpecification.Next; end; //*** Если не найдена спецификация, то создается новая if IDSpecification = -1 then begin MemTable_RSpecification.Append; MemTable_RSpecification.FieldByName('ID').AsInteger := Component.ID; MemTable_RSpecification.FieldByName('ID_MASTER').AsInteger := IDTypeSpecif; MemTable_RSpecification.FieldByName('NAME').AsString := Component.Name; MemTable_RSpecification.FieldByName('NAME_SHORT').AsString := Component.NameShort; MemTable_RSpecification.FieldByName('ARTICUL_PRODUCER').AsString := Component.ArticulProducer; MemTable_RSpecification.FieldByName('ARTICUL_DISTRIBUTOR').AsString := Component.ArticulDistributor; MemTable_RSpecification.FieldByName('ID_PRODUCER').AsInteger := Component.ID_Producer; MemTable_RSpecification.FieldByName('PRODUCER').AsString := Component.GetProducerName; MemTable_RSpecification.FieldByName('IZM').AsString := Component.Izm; case Component.IsLine of biTrue: begin MemTable_RSpecification.FieldByName('Kolvo').AsFloat := RoundX(Component.Length, 2); MemTable_RSpecification.FieldByName('PRICE').AsFloat := RoundX(Component.NormsResources.ResourcesCostPerOneNorm, 2); end; biFalse: begin MemTable_RSpecification.FieldByName('Kolvo').AsFloat := 1; MemTable_RSpecification.FieldByName('PRICE').AsFloat := RoundX(Component.NormsResources.ResourcesCost, 2); end; end; MemTable_RSpecification.FieldByName('COST').AsFloat := RoundX(Component.NormsResources.ResourcesCost, 2); MemTable_RSpecification.Post; IDSpecification := MemTable_RSpecification.FieldByName('ID').AsInteger; end; case Component.IsLine of biTrue: for j := 0 to Component.WholeComponent.Count - 1 do begin New(ptrID); ptrID^ := Integer(Component.WholeComponent[j]^); ListWithLookedCompons.Add(ptrID); end; biFalse: begin New(ptrID); ptrID^ := Component.ID; ListWithLookedCompons.Add(ptrID); end; end; end; end; end; finally Screen.Cursor := crHourGlass; end; GFormMode := fmRSpecification; Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog(': '+E.Message); end; finally FreeList(ListWithLookedCompons); FreeList(FolderIDComponList); if Component <> nil then Component.Free; end; end; *) procedure TF_ResourceReport.ShowFolderExplanatoryReport(AFolder: TSCSCatalog; AParams: TReportItemParams); var CurrencyM: TCurrency; CurrencyS: TCurrency; ProjectID: Integer; i: Integer; ProjectOwner: TSCSProject; SprCurrency: TNBCurrency; SCSLists: TSCSCatalogs; SCSList: TSCSCatalog; SCSObject: TSCSCatalog; // Added by Tolik // стоимость материалов, ресурсов, работ и общая стоимость - из названия понятно... TotalCost,MaterialsCost,WorksCost,ResourcesCost : double; Main_TotalCost,Main_MaterialsCost,Main_WorksCost,Main_ResourcesCost : double; NormResources: TSCSNormsResources; ResourceRel: TSCSResourceRel; Price, Kolvo : double; ResourceCompon: TSCSComponent; SprSuppliesKind: TNBSuppliesKind; GroupedNorms: TSCSNormsResources; GroupNorm: TSCSNorm; Component : TSCSCatalog; { ProjectOwner: TSCSProject; OldTick, CurrTick: Cardinal; TotalCost: Double; InterfaceNormList: TList; CurrInterfaceNormList: TList; TempList: TList; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; TraceLength: Double; Interfac: TSCSInterface; ptrJoinedInterf: TSCSInterface; ptrComplectInterf: TSCSInterface; ptrResultInterface: TSCSInterface; //IOfIRel: TSCSIOfIRel; ptrInterfaceNormInfo: PInterfaceNormInfo; ptrInterfaceNormInfoI: PInterfaceNormInfo; ptrInterfaceNormInfoJ: PInterfaceNormInfo; } { procedure AddListToExplanatoryReport(AList: TSCSList); begin mtExplanatoryList.Append; mtExplanatoryList.FieldByName(fnID).AsInteger := AList.ID; mtExplanatoryList.FieldByName(fnProjectID).AsInteger := ProjectID; mtExplanatoryList.FieldByName(fnMarkID).AsInteger := AList.MarkID; mtExplanatoryList.FieldByName(fnName).AsString := AList.GetNameForVisible; mtExplanatoryList.FieldByName(fnHeightRoom).AsFloat := Round2(FloatInUOM(AList.Setting.HeightRoom, umMetr, TF_Main(GForm).FUOM)); //Высота этажа mtExplanatoryList.FieldByName(fnHeightCeiling).AsFloat := Round2(FloatInUOM(AList.Setting.HeightCeiling, umMetr, TF_Main(GForm).FUOM)); //Высота фальш потолка mtExplanatoryList.FieldByName(fnHeightSocket).AsFloat := Round2(FloatInUOM(AList.Setting.HeightSocket, umMetr, TF_Main(GForm).FUOM)); //Высота размещ точ объектов mtExplanatoryList.FieldByName(fnHeightCorob).AsFloat := Round2(FloatInUOM(AList.Setting.HeightCorob, umMetr, TF_Main(GForm).FUOM)); //Высота размещ трасс mtExplanatoryList.FieldByName(fnCableCanalFullnessKoef).AsFloat := AList.Setting.CableCanalFullnessKoef; //Коэффициент заполненности кабельных каналов mtExplanatoryList.FieldByName(fnLengthKoef).AsFloat := AList.Setting.LengthKoef; //Процент запаса длины кабеля mtExplanatoryList.FieldByName(fnPortReserv).AsFloat := Round2(FloatInUOM(AList.Setting.PortReserv, umMetr, TF_Main(GForm).FUOM)); //Резерв со стороны порта mtExplanatoryList.FieldByName(fnMultiportReserv).AsFloat := Round2(FloatInUOM(AList.Setting.MultiportReserv, umMetr, TF_Main(GForm).FUOM)); //Резерв со стороны мультипорта mtExplanatoryList.FieldByName(fnTwistedPairMaxLength).AsFloat := Round2(FloatInUOM(AList.Setting.TwistedPairMaxLength, umMetr, TF_Main(GForm).FUOM)); //Ограничение по максимальной длине (для витой пары) mtExplanatoryList.Post; end; } procedure AddListToExplanatoryReport(AList: TSCSList); var i,j,k : integer; Compon : TSCSComponent; ComponCount, ComponPrice : double; MKolvo: Double; ExpenseForMetr_L: Double; begin if AList.IsNormalType then // Tolik 31/08/2020 -- добавлена проверка листа, потому что иначе в отчет попадают // все листы проекта, в том числе, например, листы с дизайном шкафа ... begin TotalCost := 0; MaterialsCost := 0; WorksCost := 0; ResourcesCost := 0; ComponPrice := 0; ComponCount := 0; //работы GroupedNorms := AList.GetAllNormsResources([nrNorms], false, true, false, true, false, true, false, True); for i := 0 to GroupedNorms.Norms.Count - 1 do begin GroupNorm := GroupedNorms.Norms[i]; WorksCost := WorksCost + GroupNorm.Price*GroupNorm.Kolvo; end; NormResources := AList.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, true, true, true, false, true, true); //Tolik 13/10/2020 -- а от здеся может быть бо-бо...проверять нуно! if NormResources <> nil then begin // for i := 0 to NormResources.Resources.Count - 1 do begin ResourceRel := NormResources.Resources[i]; ResourceCompon := nil; if ResourceRel.ServIsResource then if TSCSResourceGroup(ResourceRel).ObjectList.Count > 0 then if TSCSResourceGroup(ResourceRel).ObjectList[0] is TSCSComponent then begin ResourceCompon := TSCSComponent(TSCSResourceGroup(ResourceRel).ObjectList[0]); end; if ResourceCompon <> nil then begin SprSuppliesKind := nil; if ResourceRel.GUIDSuppliesKind <> '' then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(ResourceRel.GUIDSuppliesKind); //*** Учитывать поставочные величины if SprSuppliesKind <> nil then begin if CheckIsTradUOM(TF_Main(GForm).FUOM) then begin ResourceRel.Izm := SprSuppliesKind.Data.NameTradUOM; if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin // Для кабелей и каналов в традиционной системы США нужно юзать ФУТЫ ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := FloatInUOM(ResourceRel.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvoTradUOM; end; end else begin ResourceRel.Izm := SprSuppliesKind.Data.Name; ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo; end; ResourceRel.CalcCost; end else begin if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin ResourceRel.Izm := GetNameUOM(TF_Main(GForm).FUOM, true); if TF_Main(GForm).FUOM <> umMetr then begin ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, TF_Main(GForm).FUOM); ResourceRel.Price := FloatInUOM(ResourceRel.Price, TF_Main(GForm).FUOM, umMetr); ResourceRel.CalcCost; end; end; end; end; end; // стоимость ресурсов for i := 0 to NormResources.Resources.Count - 1 do begin // отбираем cтоимость ресурсов (лист) if NormResources.Resources[i].ServIsResource then begin ResourceRel := NormResources.Resources[i]; Kolvo := RoundX(ResourceRel.Kolvo,4); Price := RoundX(ResourceRel.Price, 4); ResourcesCost := ResourcesCost+RoundX(Kolvo*Price,2); end; end; Main_ResourcesCost := Main_ResourcesCost+ResourcesCost; end; // стоимость работ (лист) // вытаскиваем стоимость работ из всех компонентов на листе { for i := 0 to AList.ChildCatalogs.Count-1 do begin for j := 0 to AList.ChildCatalogs[i].ComponentReferences.Count - 1 do begin for k := 0 to AList.ChildCatalogs[i].ComponentReferences[j].NormsResources.Norms.Count -1 do begin WorksCost := WorksCost + AList.ChildCatalogs[i].ComponentReferences[j].NormsResources.Norms[k].Price* AList.ChildCatalogs[i].ComponentReferences[j].NormsResources.Norms[k].Kolvo; end; end; end; } WorksCost := RoundX(WorksCost,2); Main_WorksCost := Main_WorksCost + WorksCost; // стоимость материалов (лист) for i := 0 to AList.ComponentReferences.Count - 1 do begin //if AList.ComponentReferences[i].IsLine=bitrue then // MaterialsCost := MaterialsCost+(AList.ComponentReferences[i].Price*AList.ComponentReferences[i].Length) //else // MaterialsCost := MaterialsCost+(AList.ComponentReferences[i].Price); //RoundCP((Price + AdditionalPrice) * Kolvo); //Tolik // по типу сети if AllNetTypes then begin if AList.ComponentReferences[i].IsLine=bifalse then begin MKolvo := 1; if ((AList.ComponentReferences[i].ComponentType.SysName = ctsnCableChannelAccessory) or (AList.ComponentReferences[i].ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr_L := AList.ComponentReferences[i].GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin MKolvo := Round(AList.ComponentReferences[i].Length * ExpenseForMetr_L); end end; MaterialsCost := MaterialsCost + RoundCP((AList.ComponentReferences[i].Price) * MKolvo); end else begin // Расход на ед.длины ExpenseForMetr_L := AList.ComponentReferences[i].GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin MKolvo := Round(AList.ComponentReferences[i].Length * ExpenseForMetr_L); end else MKolvo := AList.ComponentReferences[i].Length; MaterialsCost := MaterialsCost + RoundCP((AList.ComponentReferences[i].Price) * MKolvo); end; end else begin if NetTypeGuidListSelected.IndexOf(AList.ComponentReferences[i].GUIDNetType) <> -1 then begin if AList.ComponentReferences[i].IsLine=bifalse then begin MKolvo := 1; if ((AList.ComponentReferences[i].ComponentType.SysName = ctsnCableChannelAccessory) or (AList.ComponentReferences[i].ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr_L := AList.ComponentReferences[i].GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin MKolvo := Round(AList.ComponentReferences[i].Length * ExpenseForMetr_L); end end; MaterialsCost := MaterialsCost + RoundCP((AList.ComponentReferences[i].Price) * MKolvo); end else begin // Расход на ед.длины ExpenseForMetr_L := AList.ComponentReferences[i].GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin MKolvo := Round(AList.ComponentReferences[i].Length * ExpenseForMetr_L); end else MKolvo := AList.ComponentReferences[i].Length; MaterialsCost := MaterialsCost + RoundCP((AList.ComponentReferences[i].Price) * MKolvo); end; end; end; end; MaterialsCost := Roundx(MaterialsCost, 2); Main_MaterialsCost := Main_MaterialsCost + MaterialsCost; TotalCost := MaterialsCost + WorksCost + ResourcesCost; Main_TotalCost := Main_TotalCost + TotalCost; mtExplanatoryList.Append; mtExplanatoryList.FieldByName(fnID).AsInteger := AList.ID; mtExplanatoryList.FieldByName(fnProjectID).AsInteger := ProjectID; mtExplanatoryList.FieldByName(fnMarkID).AsInteger := AList.MarkID; mtExplanatoryList.FieldByName(fnName).AsString := AList.GetNameForVisible; mtExplanatoryList.FieldByName(fnHeightRoom).AsFloat := Round2(FloatInUOM(AList.Setting.HeightRoom, umMetr, TF_Main(GForm).FUOM)); //Высота этажа mtExplanatoryList.FieldByName(fnHeightCeiling).AsFloat := Round2(FloatInUOM(AList.Setting.HeightCeiling, umMetr, TF_Main(GForm).FUOM)); //Высота фальш потолка mtExplanatoryList.FieldByName(fnHeightSocket).AsFloat := Round2(FloatInUOM(AList.Setting.HeightSocket, umMetr, TF_Main(GForm).FUOM)); //Высота размещ точ объектов mtExplanatoryList.FieldByName(fnHeightCorob).AsFloat := Round2(FloatInUOM(AList.Setting.HeightCorob, umMetr, TF_Main(GForm).FUOM)); //Высота размещ трасс mtExplanatoryList.FieldByName(fnCableCanalFullnessKoef).AsFloat := AList.Setting.CableCanalFullnessKoef; //Коэффициент заполненности кабельных каналов mtExplanatoryList.FieldByName(fnLengthKoef).AsFloat := AList.Setting.LengthKoef; //Процент запаса длины кабеля mtExplanatoryList.FieldByName(fnPortReserv).AsFloat := Round2(FloatInUOM(AList.Setting.PortReserv, umMetr, TF_Main(GForm).FUOM)); //Резерв со стороны порта mtExplanatoryList.FieldByName(fnMultiportReserv).AsFloat := Round2(FloatInUOM(AList.Setting.MultiportReserv, umMetr, TF_Main(GForm).FUOM)); //Резерв со стороны мультипорта mtExplanatoryList.FieldByName(fnTwistedPairMaxLength).AsFloat := Round2(FloatInUOM(AList.Setting.TwistedPairMaxLength, umMetr, TF_Main(GForm).FUOM)); //Ограничение по максимальной длине (для витой пары) // added by Tolik mtExplanatoryList.FieldByName(fnMaterialsCost).AsFloat := MaterialsCost; mtExplanatoryList.FieldByName(fnResourcesCost).AsFloat := ResourcesCost; mtExplanatoryList.FieldByName(fnWorksCost).AsFloat := WorksCost; mtExplanatoryList.FieldByName(fnTotalCost).AsFloat := TotalCost; mtExplanatoryList.Post; end; end; begin if TF_Main(GForm).GDBMode <> bkProjectManager then Exit; ///// EXIT ///// if Not CheckCanShowReport(AFolder) then Exit; ///// EXIT ///// try Main_TotalCost :=0; Main_MaterialsCost := 0; Main_WorksCost := 0; Main_ResourcesCost := 0; FCatalog := AFolder; ProjectOwner := nil; BeginProgress(pcPreparingReport); try //Tolik INeedNormsRecources := True; // mtExplanatoryList.Active := false; mtExplanatoryProj.Active := false; mtExplanatoryProj.Active := true; mtExplanatoryList.Active := true; //свойства проекта mtExplanatoryProj.Append; if AFolder.ItemType = itProject then begin ProjectOwner := TSCSProject(AFolder); ZeroMemory(@CurrencyM, SizeOf(TCurrency)); ZeroMemory(@CurrencyS, SizeOf(TCurrency)); SprCurrency := ProjectOwner.Spravochnik.GetCurrencyByType(ctMain); if SprCurrency <> nil then CurrencyM := SprCurrency.Data else CurrencyM := F_NormBase.DM.GetCurrencyByID(TSCSProject(AFolder).Setting.IDCurrency); SprCurrency := ProjectOwner.Spravochnik.GetCurrencyByType(ctSecond); if SprCurrency <> nil then CurrencyS := SprCurrency.Data else CurrencyS := F_NormBase.DM.GetCurrencyByID(TSCSProject(AFolder).Setting.CurrensySID); ProjectID := TSCSProject(AFolder).ID; mtExplanatoryProj.FieldByName(fnMarkID).AsInteger := TSCSProject(AFolder).MarkID; mtExplanatoryProj.FieldByName(fnName).AsString := TSCSProject(AFolder).GetNameForVisible; mtExplanatoryProj.FieldByName(fnCurrencyMName).AsString := CurrencyM.Name; mtExplanatoryProj.FieldByName(fnCurrencySName).AsString := CurrencyS.Name; mtExplanatoryProj.FieldByName(fnNDS).AsFloat := TSCSProject(AFolder).Setting.NDS; mtExplanatoryProj.FieldByName(fnCustomerName).AsString := TSCSProject(AFolder).Setting.CustomerName; mtExplanatoryProj.FieldByName(fnContractorName).AsString := TSCSProject(AFolder).Setting.ContractorName; mtExplanatoryProj.FieldByName(fnHeightThroughFloor).AsFloat := Round2(FloatInUOM(TSCSProject(AFolder).Setting.HeightThroughFloor, umMetr, TF_Main(GForm).FUOM)); mtExplanatoryProj.FieldByName(fnIsVisible).AsBoolean := true; end else begin if AFolder.GetTopParentCatalog <> nil then ProjectID := AFolder.GetTopParentCatalog.ID; mtExplanatoryProj.FieldByName(fnIsVisible).AsBoolean := false; end; mtExplanatoryProj.FieldByName(fnID).AsInteger := ProjectID; mtExplanatoryProj.Post; if AFolder.ItemType = itProject then begin for i := 0 to TSCSProject(AFolder).ProjectLists.Count - 1 do AddListToExplanatoryReport(TSCSProject(AFolder).ProjectLists[i]); end else if AFolder.ItemType = itList then AddListToExplanatoryReport(TSCSList(AFolder)) else if AFolder.ItemType = itDir then begin SCSLists := GetChildCatalogsInPlacingOrder(AFolder, [itList]); for i := 0 to SCSLists.Count - 1 do begin SCSList := SCSLists[i]; if SCSList is TSCSCatalog then AddListToExplanatoryReport(TSCSList(SCSList)); end; FreeAndNil(SCSLists); end; finally //Tolik INeedNormsRecources := False; // EndProgress; end; mtExplanatoryProj.Edit; mtExplanatoryProj.FieldByName(fnMaterialsCost).AsFloat := Main_MaterialsCost; mtExplanatoryProj.FieldByName(fnResourcesCost).AsFloat := Main_ResourcesCost; mtExplanatoryProj.FieldByName(fnWorksCost).AsFloat := Main_WorksCost; mtExplanatoryProj.FieldByName(fnTotalCost).AsFloat := Main_TotalCost; mtExplanatoryProj.Post; GFormMode := fmRExplanatoryReport; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowFolderExplanatoryReport: '+E.Message); end; end; procedure TF_ResourceReport.ShowPriorCostOfProjectReport(AParams: TReportItemParams); begin try SortMemTableByParams(mtReport, AParams, nil); GFormMode := fmRPriorCostOfProject; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowPriorCostOfProjectReport', E.Message); end; end; procedure TF_ResourceReport.ShowPriorCostOfProjectReportWizard(AMemTable, ATotalParams: TkbmMemTable; ACostOfProjectReportParams: TCostOfProjectReportParams; AShowTotalParams, AShowTemplates: Boolean); begin try if AMemTable <> nil then begin //mtReport.Active := false; // mtReport.FieldDefs.Clear; // mtReport.FieldDefs.Assign(AMemTable.FieldDefs); // mtReport.LoadFromDataSet(AMemTable, []); // mtReport.Active := true; FCostOfProjectReportParams := ACostOfProjectReportParams; mtReportDetail.MasterSource := nil; mtReportDetail.MasterFields := ''; AssignMemTable(mtReport, AMemTable, true); if AShowTotalParams then AssignMemTable(mtReportFirst, ATotalParams, true) else begin mtReportFirst.Active := false; mtReportFirst.FieldDefs.Assign(ATotalParams.FieldDefs); mtReportFirst.Active := true; end; // В mtReport оставляем материалы, а в mtReportDetail перекидываем нормы //mtReportDetail.Active := false; //mtReportDetail.FieldDefs.Assign(mtReport.FieldDefs); ShowWizard([rkCalc], AShowTemplates); //if mtReportFirst.Active then // mtReportFirst.Close; //mtReport.Close; end; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowPriorCostOfProjectReportWizard', E.Message); end; end; procedure TF_ResourceReport.ShowMarkPages(AFolder: TSCSCatalog; AParams: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode; AReportItemParamValues: TReportItemParams); var CanHaveActiveComponents: Boolean; CanHaveDismountAccount: Boolean; SprCompType: TNBComponentType; SCSCatalog: TSCSCatalog; SCSCatalogFirst: TSCSCatalog; SCSComponent: TSCSComponent; ChildComponent: TSCSComponent; TempComponent: TSCSComponent; ComunicationCompon: TSCSComponent; ComunicationComponInFirstSide: TSCSComponent; ComunicationPort: TSCSInterface; ComunicationPortMark: string; LastSideCompon: TSCSComponent; SocketFrameComponent: TSCSComponent; // Рамка розекти/порта i, j: Integer; CableMark: String; RoomOwner: TSCSCatalog; RoomOwnerFirst: TSCSCatalog; RoomMark: String; RoomMarkFirst: String; ListOwner: TSCSList; ListOwnerFirst: TSCSList; ListMark: String; ListMarkFirst: String; LookedObjects: TRapList; LookedWholeIDs: TIntList; LookedSocketFrams: TSCSComponents; LookedSocketFramsIndex: Integer; RoomsOfSocketFrames: TRapList; // Список списков комнат, с которых идет подключение на рамки портов SocketFrameRooms: TRapList; // Список комнат, с которых идет подключение на рамки портов FindedForI: Boolean; SocketFrameSysNames: TStringList; IsLookedSocketFrame: Boolean; mtRep: TkbmMemTable; //Tolik 11/06/2024 -- не были цчтены порты, заданные количественно { procedure AddComponPortsToMemTable(AComponent: TSCSComponent); var i: Integer; Interfac: TSCSInterface; begin for i := 0 to AComponent.Interfaces.Count - 1 do begin Interfac := AComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin AddStrToMemTable(mtRep, fnNameMark, IntToStrF(Interfac.NppPort, 2)); //mtRep.Append; //mtRep.FieldByName(fnNameMark).AsString := IntToStrF(Interfac.NppPort, 2); //mtRep.Post; end; end; end; } procedure AddComponPortsToMemTable(AComponent: TSCSComponent); var i, j, kolvo: Integer; Interfac: TSCSInterface; begin kolvo := -1; for i := 0 to AComponent.Interfaces.Count - 1 do begin Interfac := AComponent.Interfaces[i]; if Interfac.IsPort = biTrue then begin if kolvo = -1 then kolvo := Interfac.NppPort; if Interfac.Kolvo = 1 then begin //AddStrToMemTable(mtRep, fnNameMark, IntToStrF(Interfac.NppPort, 2)) AddStrToMemTable(mtRep, fnNameMark, IntToStrF(kolvo, 2)); inc(kolvo); end else begin for j := 0 to Interfac.Kolvo - 1 do begin AddStrToMemTable(mtRep, fnNameMark, IntToStrF(kolvo, 2)); inc(kolvo); end; end; //mtRep.Append; //mtRep.FieldByName(fnNameMark).AsString := IntToStrF(Interfac.NppPort, 2); //mtRep.Post; end; end; end; // function GetRoomMark(ARoom: TSCSCatalog): String; begin Result := ''; if ARoom <> nil then begin if ARoom.NameShort <> '' then Result := ARoom.NameShort else begin if rbShowRoomName.Checked then Result := ARoom.Name + IntToStr(ARoom.MarkID) else Result := edNoCabinetNameShort.Text; end; end else Result := edNoCabinet.Text; end; begin try mtRep := mtReport; case AParams.Mode of fmRMarkRoomTS: mtRep := FmtMarkRoomTS; fmRMarkPathPanel: mtRep := FmtMarkPathPanel; fmRMarkPathPanelPorts: mtRep := FmtMarkPathPanelPorts; fmRMarkSocket: mtRep := FmtMarkSocket; fmRMarkSocketPanel: mtRep := FmtMarkSocketPanel; fmRMarkCable: mtRep := FmtMarkCable; end; mtRep.Active := false; mtRep.FieldDefs.Clear; mtRep.FieldDefs.Add(fnNameMark, ftString, 255); mtRep.Active := true; LookedObjects := TRapList.Create; FCatalog := AFolder; CanHaveActiveComponents := IntToBool(AReportItemParamValues.CanHaveActiveComponents); CanHaveDismountAccount := IntToBool(AReportItemParamValues.CanHaveDismountAccount); case AResourceReportFormMode of fmRMarkRoomTS: begin // Перебераем все комнаты for i := 0 to FCatalog.ChildCatalogReferences.Count - 1 do begin SCSCatalog := FCatalog.ChildCatalogReferences[i]; if SCSCatalog.ItemType = itRoom then begin FindedForI := false; // Ищем телекомуникационное оборудование в кабинете for j := 0 to SCSCatalog.ComponentReferences.Count - 1 do begin SCSComponent := SCSCatalog.ComponentReferences[j]; SprCompType := SCSComponent.ProjectOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); // Принадлежит ли тип к комуникационному оборудованию if SprCompType <> nil then if (SprCompType.ComponentType.SysName = ctsnCupBoard) or IsPatchPanelSysName(SprCompType.ComponentType.SysName) or (SprCompType.ComponentType.PortKind = pkMultiport) then begin ListOwner := SCSCatalog.GetListOwner; if ListOwner <> nil then begin AddStrToMemTable(mtRep, fnNameMark, IntToStr(ListOwner.MarkID) + GetRoomMark(SCSCatalog)); end; FindedForI := true; Break; //// BREAK //// end; end; if FindedForI then Break; //// BREAK //// end; end; end; fmRMarkPathPanel: begin // Перебераем телекомуникационное оборудование for i := 0 to FCatalog.ComponentReferences.Count - 1 do begin SCSComponent := FCatalog.ComponentReferences[i]; SprCompType := SCSComponent.ProjectOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); // Принадлежит ли тип к ратч-панели или мультипорту if SprCompType <> nil then if IsPatchPanelSysName(SprCompType.ComponentType.SysName) or (SprCompType.ComponentType.PortKind = pkMultiport) then if LookedObjects.IndexOf(SCSComponent) = -1 then if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin AddStrToMemTable(mtRep, fnNameMark, SCSComponent.NameMark); LookedObjects.Add(SCSComponent); end; end; end; fmRMarkPathPanelPorts: begin // Перебераем телекомуникационное оборудование for i := 0 to FCatalog.ComponentReferences.Count - 1 do begin SCSComponent := FCatalog.ComponentReferences[i]; SprCompType := SCSComponent.ProjectOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); // Принадлежит ли тип к ратч-панели или мультипорту if SprCompType <> nil then if IsPatchPanelSysName(SprCompType.ComponentType.SysName) or (SprCompType.ComponentType.PortKind = pkMultiport) then if LookedObjects.IndexOf(SCSComponent) = -1 then begin // Выносим все порты патчпанели if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then AddComponPortsToMemTable(SCSComponent); for j := 0 to SCSComponent.ChildReferences.Count - 1 do begin ChildComponent := SCSComponent.ChildReferences[j]; if CheckCanLookComponInReportRsrc(ChildComponent, CanHaveActiveComponents, CanHaveDismountAccount) then AddComponPortsToMemTable(ChildComponent); end; LookedObjects.Add(SCSComponent); end; end; end; fmRMarkSocket, fmRMarkSocketPanel, fmRMarkCable: begin LookedWholeIDs := TIntList.Create; SocketFrameSysNames := TStringList.Create; SocketFrameSysNames.Add(ctsnSocket); SocketFrameSysNames.Add(ctsnFrame); LookedSocketFrams := TSCSComponents.Create(false); RoomsOfSocketFrames := TRapList.Create; // Перебераем все кабели for i := 0 to FCatalog.ComponentReferences.Count - 1 do begin SCSComponent := FCatalog.ComponentReferences[i]; if SCSComponent.IsLine = biTrue then if LookedWholeIDs.IndexOf(SCSComponent.Whole_ID) = -1 then begin SCSComponent.LoadWholeComponent(false); SCSComponent.DefineFirstLast; if SCSComponent.LastConnectedConnCompon <> nil then begin // Получить парент телекоминационную панель или шкаф ComunicationCompon := GetParentComunicationCompon(SCSComponent.LastConnectedConnCompon); if ComunicationCompon <> nil then begin RoomOwner := nil; ListOwner := nil; RoomMark := ''; ListMark := ''; // Получаем Объект SCSCatalog := ComunicationCompon.GetFirstParentCatalog; if SCSCatalog <> nil then begin // Получаем кабинет RoomOwner := SCSCatalog.GetParentCatalogByItemType(itRoom); RoomMark := GetRoomMark(RoomOwner); ListOwner := SCSCatalog.GetListOwner; if ListOwner <> nil then ListMark := IntToStr(ListOwner.MarkID); end; // Получаем порт панели, к которой подключен кабель ComunicationPort := nil; ComunicationPortMark := ' '; LastSideCompon := SCSComponent.LastConnectedConnCompon.JoinedComponents.GetComponenByID(SCSComponent.LastIDCompon); if LastSideCompon <> nil then ComunicationPort := SCSComponent.LastConnectedConnCompon.GetPortJoinedToLine(LastSideCompon); if ComunicationPort <> nil then ComunicationPortMark := IntToStrF(ComunicationPort.NppPort, 2) else ComunicationPortMark := IntToStrF(SCSComponent.LastConnectedConnCompon.MarkID, 2); case AResourceReportFormMode of fmRMarkSocket, fmRMarkSocketPanel: if SCSComponent.FirstConnectedConnCompon <> nil then begin if AResourceReportFormMode = fmRMarkSocket then begin if CheckCanLookComponInReportRsrc(SCSComponent.FirstConnectedConnCompon, CanHaveActiveComponents, CanHaveDismountAccount) then if AReportItemParamValues.CanFloorNppWithRoom = biTrue then AddStrToMemTable(mtRep, fnNameMark, ListMark + RoomMark+'-'+ComunicationCompon.NameMark + ComunicationPortMark) else AddStrToMemTable(mtRep, fnNameMark, ComunicationCompon.NameMark + ComunicationPortMark) end else if AResourceReportFormMode = fmRMarkSocketPanel then begin SocketFrameComponent := GetComponTopByCTSysNames(SCSComponent.FirstConnectedConnCompon, SocketFrameSysNames, true); if SocketFrameComponent <> nil then if CheckCanLookComponInReportRsrc(SocketFrameComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin IsLookedSocketFrame := false; // Проверяем - была ли расмотрена такая панель с таким кабинетом LookedSocketFramsIndex := LookedSocketFrams.IndexOf(SocketFrameComponent); if LookedSocketFramsIndex <> -1 then begin SocketFrameRooms := RoomsOfSocketFrames[LookedSocketFramsIndex]; if SocketFrameRooms.IndexOf(RoomOwner) <> -1 then IsLookedSocketFrame := true; end; if Not IsLookedSocketFrame then begin AddStrToMemTable(mtRep, fnNameMark, ListMark + RoomMark+'-'); // Занести рамку и комнату в список просмотренных SocketFrameRooms := nil; if LookedSocketFramsIndex = -1 then begin LookedSocketFrams.Add(SocketFrameComponent); SocketFrameRooms := TRapList.Create; RoomsOfSocketFrames.Add(SocketFrameRooms); end else SocketFrameRooms := RoomsOfSocketFrames[LookedSocketFramsIndex]; if SocketFrameRooms <> nil then if SocketFrameRooms.IndexOf(RoomOwner) = -1 then SocketFrameRooms.Add(RoomOwner); end; end; end; end; fmRMarkCable: if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin CableMark := ''; // Подключен ли кабель на обоих концах к телекомуникацтонной панеле ComunicationComponInFirstSide := GetParentComunicationCompon(SCSComponent.FirstConnectedConnCompon); // Выводим маркировку по формату fs1/fs2-n if ComunicationComponInFirstSide <> nil then begin RoomOwnerFirst := nil; ListOwnerFirst := nil; RoomMarkFirst := ''; ListMarkFirst := ''; // Получаем Объект SCSCatalogFirst := ComunicationComponInFirstSide.GetFirstParentCatalog; if SCSCatalogFirst <> nil then begin // Получаем кабинет RoomOwnerFirst := SCSCatalogFirst.GetParentCatalogByItemType(itRoom); RoomMarkFirst := GetRoomMark(RoomOwnerFirst); ListOwnerFirst := SCSCatalogFirst.GetListOwner; if ListOwnerFirst <> nil then ListMarkFirst := IntToStr(ListOwnerFirst.MarkID); end; if (ListMark+RoomMark) < (ListMarkFirst+RoomMarkFirst) then CableMark := ListMark + RoomMark +'/'+ ListMarkFirst + RoomMarkFirst else CableMark := ListMarkFirst + RoomMarkFirst +'/'+ ListMark + RoomMark; CableMark := CableMark +'-'+IntToStr(SCSComponent.MarkID); end else // Ввыводить маркировку по формату fs-an begin CableMark := ListMark + RoomMark +'-'+ ComunicationCompon.NameMark + ComunicationPortMark; end; if CableMark <> '' then begin AddStrToMemTable(mtRep, fnNameMark, CableMark); if AReportItemParamValues.CanInTwoCopies = biTrue then AddStrToMemTable(mtRep, fnNameMark, CableMark); end; end; end; end; end; LookedWholeIDs.Add(SCSComponent.Whole_ID); end; end; // Очистить SocketFrameRooms for i := 0 to RoomsOfSocketFrames.Count - 1 do TObject(RoomsOfSocketFrames[i]).Free; RoomsOfSocketFrames.Free; FreeAndNil(LookedSocketFrams); FreeAndNil(SocketFrameSysNames); FreeAndNil(LookedWholeIDs); end; end; if cbSortOn.Checked then // Tolik 13/06/2024 mtRep.SortOn(fnNameMark, []); FreeAndNil(LookedObjects); GFormMode := AResourceReportFormMode; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowMarkPages', E.Message); end; end; procedure TF_ResourceReport.ShowExplicationRoom(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); var CatalogList: TSCSCatalogs; SCSCatalog: TSCSCatalog; SCSList: TSCSList; SCSRoom: TSCSCatalog; HeightRoom: Double; SquareInside: Double; IsLoadedMaster: Boolean; i, j: Integer; mtRep: TkbmMemTable; mtRepDetail: TkbmMemTable; procedure SetRoomDataToMemTable(AMemTable: TkbmMemTable; AAppend: Boolean); begin if AAppend then AMemTable.Append; if AMemTable.State <> dsBrowse then begin AMemTable.FieldByName(fnFloor).AsInteger := SCSList.MarkID; AMemTable.FieldByName(fnRoomNum).AsInteger := SCSRoom.MarkID; AMemTable.FieldByName(fnNameShort).AsString := SCSRoom.NameShort; AMemTable.FieldByName(fnAppointmentRoom).AsString := SCSRoom.Name; AMemTable.FieldByName(fnSquareInside).AsFloat := RoundCP(FloatInUOM(SquareInside, umMetr, TF_Main(GForm).FUOM, 2)); AMemTable.FieldByName(fnHeightRoom).AsFloat := RoundCP(FloatInUOM(HeightRoom, umMetr, TF_Main(GForm).FUOM)); if AAppend then AMemTable.Post; end; end; begin try mtRep := FmtExplicationRoom; //mtReport; mtRepDetail := FmtExplicationRoomDetail; //mtReportDetail; ClearFieldsInMemTable(mtRep, mtRepDetail); mtRep.FieldDefs.Add(fnID, ftAutoInc); mtRep.FieldDefs.Add(fnFloor, ftInteger); mtRep.FieldDefs.Add(fnRoomNum, ftInteger); mtRep.FieldDefs.Add(fnNameShort, ftString, 255); mtRep.FieldDefs.Add(fnAppointmentRoom, ftString, 255); mtRep.FieldDefs.Add(fnSquareInside, ftFloat); mtRep.FieldDefs.Add(fnHeightRoom, ftFloat); mtRepDetail.FieldDefs.Add(fnIDMaster, ftInteger); mtRepDetail.FieldDefs.Add(fnFloor, ftInteger); mtRepDetail.FieldDefs.Add(fnRoomNum, ftInteger); mtRepDetail.FieldDefs.Add(fnNameShort, ftString, 255); mtRepDetail.FieldDefs.Add(fnAppointmentRoom, ftString, 255); mtRepDetail.FieldDefs.Add(fnSquareInside, ftFloat); mtRepDetail.FieldDefs.Add(fnHeightRoom, ftFloat); ConnectDetailMemTable(FdsrcExplicationRoom, mtRepDetail, fnID, fnIDMaster); mtRep.Active := true; mtRepDetail.Active := true; CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(ACatalog); CatalogList.AddItems(ACatalog.ChildCatalogReferences); BeginProgress(pcPreparingReport); try FCatalog := ACatalog; for i := 0 to CatalogList.Count - 1 do begin SCSCatalog := CatalogList[i]; if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then begin SCSList := TSCSList(SCSCatalog); IsLoadedMaster := false; for j := 0 to SCSList.ChildCatalogReferences.Count - 1 do begin SCSCatalog := SCSList.ChildCatalogReferences[j]; if SCSCatalog.ItemType = itRoom then begin SCSRoom := SCSCatalog; // Узнаем высоту кабинета HeightRoom := SCSList.Setting.HeightRoom; if SCSRoom.RoomSetting.HeightCeiling > 0 then HeightRoom := SCSList.Setting.HeightRoom - SCSRoom.RoomSetting.HeightCeiling else HeightRoom := SCSList.Setting.HeightRoom - SCSList.Setting.HeightCeiling; // Ищем площадь кабинета SquareInside := GetRoomSquare(SCSList.CurrID, SCSRoom.SCSID); if Not IsLoadedMaster then begin mtRep.Append; //mtRep.FieldByName(fnFloor).AsInteger := SCSList.MarkID; SetRoomDataToMemTable(mtRep, false); mtRep.Post; IsLoadedMaster := true; end else begin //SetRoomDataToMemTable(mtRepDetail, true); //mtRepDetail.Append; //mtRepDetail.FieldByName(fnRoomNum).AsInteger := SCSRoom.MarkID; //mtRepDetail.FieldByName(fnAppointmentRoom).AsString := SCSRoom.Name; //mtRepDetail.FieldByName(fnSquareInside).AsFloat := HeightRoom; //mtRepDetail.FieldByName(fnHeightRoom).AsFloat := SquareInside; //mtRepDetail.Post; end; SetRoomDataToMemTable(mtRepDetail, true); end; end; end; end; finally EndProgress; end; FreeAndNil(CatalogList); // Отсортировать по этажам mtRep.SortOn(fnFloor, []); // Отсортировать кабинеты по этажу SortMemTableByParams(mtRepDetail, AParams, AReportItemParamValues); GFormMode := fmRExplicationRoom; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowExplicationRoom', E.Message); end; //ClearFieldsInMemTable(mtRep, mtRepDetail); end; procedure TF_ResourceReport.ShowExplicationComponentOLD(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); var CanHaveActiveComponents: Boolean; CanHaveDismountAccount: Boolean; CatalogList: TSCSCatalogs; SCSCatalog: TSCSCatalog; SCSList: TSCSList; SCSRoom: TSCSCatalog; SCSObject: TSCSCatalog; SCSComponent: TSCSComponent; PartSCSComponent: TSCSComponent; LookedWholeIDs: TIntList; IsLoadedMaster: Boolean; IsLoadedSubMaster: Boolean; IsFindedCompType: Boolean; ComponLists: TStringList; ptrTwoID: PTwoID; MaxListNumLength: Integer; MaxRoomNumLength: Integer; RoomMarkID: Integer; FindedListRoom: Boolean; IsInsertedRecord: Boolean; RecordCount: Integer; RecNo: Integer; IsGroupByCompType: Boolean; IsProjOrder: Boolean; i, j, k, l: Integer; mtRep: TkbmMemTable; mtRepDetail: TkbmMemTable; mtRepSubDetail: TkbmMemTable; procedure SetComponDataToMemTable; var IsFindedCompType: Boolean; begin if Not IsLoadedMaster then begin mtRep.Append; mtRep.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); if SCSRoom <> nil then mtRep.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID) else mtRep.FieldByName(fnRoomNum).AsString := ''; mtRep.Post; IsLoadedMaster := true; end; // Поиск типа компненты для текушего кабинета IsFindedCompType := false; mtRepDetail.First; while Not mtRepDetail.Eof do begin if (IsGroupByCompType and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = SCSComponent.GUIDComponentType)) or (Not IsGroupByCompType and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = '')) then begin IsFindedCompType := true; Break; //// BREAK //// end; mtRepDetail.Next; end; if Not IsFindedCompType then begin mtRepDetail.Append; if IsGroupByCompType then begin mtRepDetail.FieldByName(fnGuidComponentType).AsString := SCSComponent.GUIDComponentType; mtRepDetail.FieldByName(fnName).AsString := SCSComponent.ComponentType.NamePlural; end else mtRepDetail.FieldByName(fnGuidComponentType).AsString := ''; mtRepDetail.Post; end; if (SCSComponent.Whole_ID = 0) or Not mtRepSubDetail.Locate(fnWholeID, SCSComponent.Whole_ID, []) then begin mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); if SCSRoom <> nil then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID) else mtRepSubDetail.FieldByName(fnRoomNum).AsString := ''; mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnWholeID).AsInteger := SCSComponent.Whole_ID; mtRepSubDetail.Post; end; end; begin try mtRep := FmtExplicationCompon; mtRepDetail := FmtExplicationComponDetail; mtRepSubDetail := FmtExplicationComponSubDetail; DisconnectDetailMemTable(mtRepSubDetail); DisconnectDetailMemTable(mtRepDetail); ClearFieldsInMemTable(mtRepSubDetail, nil); ClearFieldsInMemTable(mtRepDetail, nil); ClearFieldsInMemTable(mtRep, nil); // Добавление общих палей mtRep.FieldDefs.Add(fnID, ftAutoInc); mtRep.FieldDefs.Add(fnFloor, ftString, 20); mtRep.FieldDefs.Add(fnRoomNum, ftString, 20); mtRep.FieldDefs.Add(fnMarkID, ftInteger); mtRep.FieldDefs.Add(fnName, ftString, 255); mtRep.FieldDefs.Add(fnNameMark, ftString, 255); mtRepDetail.FieldDefs.Assign(mtRep.FieldDefs); mtRepDetail.FieldDefs.Add(fnIDMaster, ftInteger); mtRepSubDetail.FieldDefs.Assign(mtRepDetail.FieldDefs); // Добавление дополнительных полей mtRep.FieldDefs.Add(fnGuidComponentType, ftString, cnstGUIDLength); mtRepDetail.FieldDefs.Add(fnGuidComponentType, ftString, cnstGUIDLength); mtRepSubDetail.FieldDefs.Add(fnIDComponent, ftInteger); mtRepSubDetail.FieldDefs.Add(fnObjectAddress, ftInteger); mtRepSubDetail.FieldDefs.Add(fnWholeID, ftInteger); ConnectDetailMemTable(FdsrcExplicationCompon, mtRepDetail, fnID, fnIDMaster); ConnectDetailMemTable(FdsrcExplicationComponDetail, mtRepSubDetail, fnID, fnIDMaster); mtRep.Active := true; mtRepDetail.Active := true; mtRepSubDetail.Active := true; CanHaveActiveComponents := IntToBool(AReportItemParamValues.CanHaveActiveComponents); CanHaveDismountAccount := IntToBool(AReportItemParamValues.CanHaveDismountAccount); CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(ACatalog); CatalogList.AddItems(ACatalog.ChildCatalogReferences); SortSCSObjectsByPMOrder(CatalogList); IsGroupByCompType := IntToBool(AReportItemParamValues.CanGroupByCompType); IsProjOrder := IntToBool(AReportItemParamValues.CanAsPlacingInProj); BeginProgress(pcPreparingReport); try FCatalog := ACatalog; if IsProjOrder then begin for i := 0 to CatalogList.Count - 1 do begin SCSCatalog := CatalogList[i]; if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then begin SCSList := TSCSList(SCSCatalog); IsLoadedMaster := false; for j := 0 to SCSList.ChildCatalogs.Count - 1 do begin SCSCatalog := SCSList.ChildCatalogs[j]; if SCSCatalog.ItemType = itRoom then begin SCSRoom := SCSCatalog; IsLoadedMaster := false; // Объекты кабинета for k := 0 to SCSRoom.ChildCatalogs.Count - 1 do begin SCSObject := SCSRoom.ChildCatalogs[k]; SCSObject.ReloadComponentReferences; // Компоненты кабинета for l := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[l]; if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then SetComponDataToMemTable; end; end; end; end; // Объекты Листа for j := 0 to SCSList.ChildCatalogs.Count - 1 do begin SCSObject := SCSList.ChildCatalogs[j]; if IsSCSObjectItemType(SCSObject.ItemType) then begin SCSObject.ReloadComponentReferences; // Компоненты листа IsLoadedMaster := false; SCSRoom := nil; for k := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[k]; if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then SetComponDataToMemTable; end; end; end; end; end; // Сортировка mtRep.First; while Not mtRep.Eof do begin if IsGroupByCompType then mtRepDetail.SortOn(fnName, []); mtRepDetail.First; while Not mtRepDetail.Eof do begin mtRepSubDetail.SortOn(fnMarkID, [mtcoNonMaintained]); mtRepDetail.Next; end; mtRep.Next; end; end else begin LookedWholeIDs := TIntList.Create; // Создаем список листов кабинетов: В стрингах бедет сигнатура для сортировки, а в объектах индексы листа и комнаты ComponLists := TStringList.Create; MaxListNumLength := 0; MaxRoomNumLength := 0; IsLoadedMaster := false; for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin SCSComponent := ACatalog.ComponentReferences[i]; if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then if (SCSComponent.Whole_ID = 0) or (LookedWholeIDs.IndexOf(SCSComponent.Whole_ID) = -1) then begin if Not IsLoadedMaster then begin mtRep.Append; mtRep.Post; IsLoadedMaster := true; end; // Поиск типа компнента IsFindedCompType := false; if (Not IsGroupByCompType and mtRepDetail.Locate(fnGuidComponentType, '', [])) or (IsGroupByCompType and mtRepDetail.Locate(fnGuidComponentType, SCSComponent.GUIDComponentType, [])) then IsFindedCompType := true; if Not IsFindedCompType then begin mtRepDetail.Append; if IsGroupByCompType then begin mtRepDetail.FieldByName(fnGuidComponentType).AsString := SCSComponent.GUIDComponentType; mtRepDetail.FieldByName(fnName).AsString := SCSComponent.ComponentType.NamePlural; end else mtRepDetail.FieldByName(fnGuidComponentType).AsString := ''; mtRepDetail.Post; end; mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := ''; mtRepSubDetail.FieldByName(fnRoomNum).AsString := ''; if SCSComponent.Whole_ID = 0 then begin SCSList := SCSComponent.GetListOwner; SCSRoom := nil; SCSCatalog := SCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSList <> nil then mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); if SCSRoom <> nil then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID); end; mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.FieldByName(fnObjectAddress).AsInteger := Integer(SCSComponent); mtRepSubDetail.FieldByName(fnWholeID).AsInteger := SCSComponent.Whole_ID; mtRepSubDetail.Post; if SCSComponent.Whole_ID <> 0 then begin for j := 0 to ACatalog.ComponentReferences.Count - 1 do begin PartSCSComponent := ACatalog.ComponentReferences[j]; if PartSCSComponent.Whole_ID = SCSComponent.Whole_ID then begin SCSList := PartSCSComponent.GetListOwner; SCSRoom := nil; RoomMarkID := 0; SCSCatalog := PartSCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSRoom <> nil then RoomMarkID := SCSRoom.MarkID; FindedListRoom := false; for k := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[k]); if (ptrTwoID.ID1 = SCSList.MarkID) and (ptrTwoID.ID2 = RoomMarkID) then begin FindedListRoom := true; Break; //// BREAK //// end; end; if Not FindedListRoom then begin GetZeroMem(ptrTwoID, SizeOf(TTwoID)); ptrTwoID.ID1 := SCSList.MarkID; if Length(IntToStr(SCSList.MarkID)) > MaxListNumLength then MaxListNumLength := Length(IntToStr(SCSList.MarkID)); if SCSRoom <> nil then begin ptrTwoID.ID2 := SCSRoom.MarkID; if Length(IntToStr(SCSRoom.MarkID)) > MaxRoomNumLength then MaxRoomNumLength := Length(IntToStr(SCSRoom.MarkID)); end; ComponLists.AddObject('', TObject(ptrTwoID)); end; end; end; // Проставить в стринге сигнатуры для сортировки for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); if ptrTwoID.ID2 <> 0 then ComponLists[j] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+IntToStrF(ptrTwoID.ID2, MaxRoomNumLength) else ComponLists[j] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+DupStr('X', MaxRoomNumLength); end; ComponLists.Sort; // Вносим номера if ComponLists.Count > 0 then begin // Экономим строки ptrTwoID := Pointer(ComponLists.Objects[0]); mtRepSubDetail.Edit; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.Post; // Добавляем новые строки с номерами листов и кабинетов for j := 1 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); IsInsertedRecord := false; mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.Post; end; end; // Очистить список листов / комнат for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); FreeMem(ptrTwoID); end; ComponLists.Clear; end; if SCSComponent.Whole_ID <> 0 then LookedWholeIDs.Add(SCSComponent.Whole_ID); end; end; if mtRep.RecordCount > 0 then begin // Сортонуть все нах if IsGroupByCompType then mtRepDetail.SortOn(fnName, []); mtRepDetail.First; while Not mtRepDetail.Eof do begin {//mtRepSubDetail.SortOn(fnMarkID, []); mtRepSubDetail.SortFields := fnMarkID+';'+fnFloor+';'+fnRoomNum; mtRepSubDetail.Sort([]); //mtRepSubDetail.inSortFields := '';} SortMemTableByParams(mtRepSubDetail, AParams, AReportItemParamValues); mtRepDetail.Next; end; //SortMemTableByParams(mtRepSubDetail, AParams, AReportItemParamValues); { // Для кабелей подгрузить все номера листов и комнат через которые он проходит mtRepDetail.First; while Not mtRepDetail.Eof do begin mtRepSubDetail.First; RecordCount := mtRepSubDetail.RecordCount; RecNo := mtRepSubDetail.RecNo; while RecNo < RecordCount do //while Not mtRepSubDetail.Eof do begin if mtRepSubDetail.FieldByName(fnWholeID).AsInteger <> 0 then begin // Загрузить список с номерами SCSComponent := TSCSComponent(mtRepSubDetail.FieldByName(fnObjectAddress).AsInteger); if SCSComponent = nil then Continue; //// CONTINUE //// for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin PartSCSComponent := ACatalog.ComponentReferences[i]; if PartSCSComponent.Whole_ID = SCSComponent.Whole_ID then begin SCSList := PartSCSComponent.GetListOwner; SCSRoom := nil; RoomMarkID := 0; SCSCatalog := PartSCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSRoom <> nil then RoomMarkID := SCSRoom.MarkID; FindedListRoom := false; for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); if (ptrTwoID.ID1 = SCSList.MarkID) and (ptrTwoID.ID2 = RoomMarkID) then begin FindedListRoom := true; Break; //// BREAK //// end; end; if Not FindedListRoom then begin GetZeroMem(ptrTwoID, SizeOf(TTwoID)); ptrTwoID.ID1 := SCSList.MarkID; if Length(IntToStr(SCSList.MarkID)) > MaxListNumLength then MaxListNumLength := Length(IntToStr(SCSList.MarkID)); if SCSRoom <> nil then begin ptrTwoID.ID2 := SCSRoom.MarkID; if Length(IntToStr(SCSRoom.MarkID)) > MaxRoomNumLength then MaxRoomNumLength := Length(IntToStr(SCSRoom.MarkID)); end; ComponLists.AddObject('', TObject(ptrTwoID)); end; end; end; // Проставить в стринге сигнатуры для сортировки for i := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); if ptrTwoID.ID2 <> 0 then ComponLists[i] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+IntToStrF(ptrTwoID.ID2, MaxRoomNumLength) else ComponLists[i] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+DupStr('X', MaxRoomNumLength); end; ComponLists.Sort; // Вносим номера if ComponLists.Count > 0 then begin // Экономим строки ptrTwoID := Pointer(ComponLists.Objects[0]); mtRepSubDetail.Edit; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.Post; // Добавляем новые строки с номерами листов и кабинетов for i := 1 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); IsInsertedRecord := false; if mtRepSubDetail.Eof then mtRepSubDetail.Append else begin mtRepSubDetail.Next; mtRepSubDetail.Insert; IsInsertedRecord := true; end; if mtRepSubDetail.State <> dsBrowse then begin mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.Post; //if IsInsertedRecord then // mtRepSubDetail.Prior; end; end; end; // Очистить список листов / комнат for i := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); FreeMem(ptrTwoID); end; ComponLists.Clear; end; mtRepSubDetail.Next; RecNo := RecNo + 1; end; mtRepDetail.Next; end;} end; FreeAndNil(ComponLists); FreeAndNil(LookedWholeIDs); end; finally EndProgress; end; FreeAndNil(CatalogList); GFormMode := fmRExplicationComponent; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowExplicationComponent', E.Message); end; //DisconnectDetailMemTable(mtRepSubDetail); //DisconnectDetailMemTable(mtRepDetail); //ClearFieldsInMemTable(mtRepSubDetail, nil); //ClearFieldsInMemTable(mtRepDetail, nil); //ClearFieldsInMemTable(mtRep, nil); end; // Отчет "Экспликация компонентов" // Tolik -- 06/03/2018 -- {procedure TF_ResourceReport.ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName: Boolean);} procedure TF_ResourceReport.ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName, {AShowHeightOfPlacing,} AGroupByHeightOfPlacing: Boolean); var CanHaveActiveComponents: Boolean; CanHaveDismountAccount: Boolean; CanHaveComponensWithZeroPrice : Boolean; CatalogList: TSCSCatalogs; SCSCatalog: TSCSCatalog; SCSList: TSCSList; SCSRoom: TSCSCatalog; SCSObject: TSCSCatalog; TopComponent,ParentComponent, SCSComponent: TSCSComponent; ParentCatalog : TSCSCatalog; PartSCSComponent: TSCSComponent; // Added by Tolik NormResources: TSCSNormsResources; ResourceRel: TSCSResourceRel; ResourceCompon: TSCSComponent; SprSuppliesKind: TNBSuppliesKind; ProjectOwner: TSCSProject; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // Price,Cost,Kolvo: Double; // цена, стоимость, количество - для компоненты //*************************************** LookedWholeIDs: TIntList; IsLoadedMaster: Boolean; IsLoadedSubMaster: Boolean; IsFindedCompType: Boolean; ComponLists: TStringList; ptrTwoID: PTwoID; MaxListNumLength: Integer; MaxRoomNumLength: Integer; RoomMarkID: Integer; FindedListRoom: Boolean; IsInsertedRecord: Boolean; RecordCount: Integer; RecNo: Integer; IsGroupByCompType: Boolean; //added by Tolik IsCanShowKabinet: Boolean; IsCanShowObjHierarchy: Boolean; IsCanGroupByName: Boolean; IsAddedString: Boolean; //IsShowHeightOfPlacing: Boolean; // 06/03/2018 IsCanGroupbyHeightOfPlacing: Boolean; // 06/03/2018 // IsProjOrder: Boolean; i, j, k, l: Integer; mtRep: TkbmMemTable; mtRepDetail: TkbmMemTable; mtRepSubDetail: TkbmMemTable; //added by Tolik ListHasComponents: boolean; // флажок для проверки наличия компонентов на листе (Tolik) VirtualRoom: TSCSCatalog; // кабинет для "безкабинетных" компонентов CompNameWithParents: string; //**************************************************************************************** // ************************ Added by Tolik Процедура поиска и вычисления цены и стоимости компоненты *********************************** Procedure FindResourcesForComponent(Component: TSCSComponent; ComponName: string; ComponPrice: double; ComponLength: double; aIsLine: Boolean); Var i: integer; IsFoundResource: boolean; ExpenseForMetr_L: double; Begin IsFoundResource := false; ComponPrice := RoundX(ComponPrice, FPricePrecision); for i := 0 to NormResources.Resources.Count - 1 do begin if Not Assigned(ResourceRel) then ResourceRel := TSCSResourceRel.Create(GForm, ntProj); ResourceRel.Assign(NormResources.Resources[i]); if ResourceRel.Name = ComponName then begin ResourceRel.Price := RoundX(ResourceRel.Price, FPricePrecision); if ResourceRel.Price = ComponPrice then begin //Если компонента не линейная то количество =1, если нет = длина компоненты //if ComponLength = 0 then // ResourceRel.Kolvo := 1 //else // ResourceRel.Kolvo := ComponLength; //if Not aIsLine then // ResourceRel.Kolvo := 1 //else // ResourceRel.Kolvo := ComponLength; if Not aIsLine then begin ResourceRel.Kolvo := 1; // Если ресурс, то берем количество этого ресурса из поля Length //if ComponsFromResources.IndexOf(Component) <> -1 then // ResourceRel.Kolvo := Component.Length; if ((Component.ComponentType.SysName = ctsnCableChannelAccessory) or (Component.ComponentType.SysName = ctsnAccessory)) then begin ExpenseForMetr_L := Component.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin ResourceRel.Kolvo := Round(Component.Length * ExpenseForMetr_L); end end; end else begin // Расход на ед.длины ExpenseForMetr_L := Component.GetPropertyValueAsFloat(pnExpenseForMetr); if ExpenseForMetr_L > 0 then begin ResourceRel.Kolvo := Round(Component.Length * ExpenseForMetr_L); end else ResourceRel.Kolvo := ComponLength; // RoundCP(Component.Length); end; //Если цена компоненты - 0 - дальше не считаем if ComponPrice = 0 then begin //if Not aIsLine then // ResourceRel.Kolvo := 1 //else // ResourceRel.Kolvo := ComponLength; ResourceRel.Price := 0; ResourceRel.Cost := 0; break; end; ResourceCompon := nil; if Not NormResources.Resources[i].ServIsResource then if TSCSResourceGroup(NormResources.Resources[i]).ObjectList.Count > 0 then if TSCSResourceGroup(NormResources.Resources[i]).ObjectList[0] is TSCSComponent then begin ResourceCompon := TSCSComponent(TSCSResourceGroup(NormResources.Resources[i]).ObjectList[0]); end; if ResourceCompon <> nil then begin SprSuppliesKind := nil; if ACanHaveSupplyValue then if NormResources.Resources[i].GUIDSuppliesKind <> '' then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(NormResources.Resources[i].GUIDSuppliesKind); //*** Учитывать поставочные величины if SprSuppliesKind <> nil then begin if CheckIsTradUOM(TF_Main(GForm).FUOM) then begin ResourceRel.Izm := SprSuppliesKind.Data.NameTradUOM; if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin // Для кабелей и каналов в традиционной системы США нужно юзать ФУТЫ ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := FloatInUOM(ResourceRel.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvoTradUOM; end; end else begin ResourceRel.Izm := SprSuppliesKind.Data.Name; ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo; end; ResourceRel.CalcCost; end else begin if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin ResourceRel.Izm := GetNameUOM(TF_Main(GForm).FUOM, true); if TF_Main(GForm).FUOM <> umMetr then begin ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, TF_Main(GForm).FUOM); ResourceRel.Price := FloatInUOM(ResourceRel.Price, TF_Main(GForm).FUOM, umMetr); ResourceRel.CalcCost; end; end; end; end; //*** Учитывать флаг округления в большую сторону if ACanRoundValue then begin ResourceRel.Kolvo := RoundUp(ResourceRel.Kolvo); ResourceRel.CalcCost; end; IsFoundResource:=true; break; end; if IsFoundResource then break; end; if IsFoundResource then break; end; if not IsFoundResource then begin if ResourceRel <> nil then begin ResourceRel.Cost := 0; ResourceRel.Price := 0; end; //Tolik -- 12/03/2018 -- количество показать надо бы, даже если нет цены // ResourceRel.Kolvo := 0; // end; End; // ********************************************************************************************** // ************************ Процедура записи данных в таблицы *********************************** function GetHeightString(aCompon: TSCSComponent): String;// Tolik 13/03/2018 -- var CadForm: TF_Cad; aLine: TOrthoLine; ParentCatalog: TSCSCatalog; ComponFigure: TFigure; s: String; JoinConn: TconnectorObject; begin Result := cMakeEditComponentType_Msg9 + ' 0' + GetUOMString(GCurrProjUnitOfMeasure); ParentCatalog := SCSComponent.GetFirstParentCatalog; if ParentCatalog = nil then exit; CadForm := GetListById(ParentCatalog.ListId); if CadForm = nil then exit; ComponFigure := GetFigureByID(CadForm, ParentCatalog.SCSID); if ComponFigure = nil then exit; if ParentCatalog.IsLine = biFalse then Result := cMakeEditComponentType_Msg9 + ' ' + floatTostr(RoundX(TConnectorObject(ComponFigure).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure) else if ParentCatalog.IsLine = biTrue then begin // линейные aLine := TOrthoLine(ComponFigure); if aLine.JoinConnector1 <> nil then if aLine.JoinConnector2 <> nil then if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = 0 then Result := cMakeEditComponentType_Msg9 + ' ' + floatTostr(RoundX(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure) else begin //райз, вертикаль, межэтажка, наклонная трасса или магистраль s := ''; if aLine.FIsVertical then s := cRepMsg273 // вертикаль (или простой райз) else if aLine.FIsRaiseUpDown then // begin JoinConn := TconnectorObject(aLine.JoinConnector1); if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) then s := cRepMsg274 else if (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then s := cRepMsg272; if s = '' then begin JoinConn := TconnectorObject(aLine.JoinConnector2); if (JoinConn.FConnRaiseType = crt_BetweenFloorUp) or (JoinConn.FConnRaiseType = crt_BetweenFloorDown) then s := cRepMsg274 else if (JoinConn.FConnRaiseType = crt_TrunkUp) or (JoinConn.FConnRaiseType = crt_TrunkDown) then s := cRepMsg272; end; if s = '' then s := cRepMsg273; end else // наклонная трасса s := cRepMsg275; if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = -1 then Result := s + ' ' + floatTostr(RoundX(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure) + ' - ' + floatTostr(Roundx(TConnectorObject(aLine.JoinConnector2).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure) else if CompareValue(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], TConnectorObject(aLine.JoinConnector2).ActualZOrder[1]) = 1 then Result := s + ' ' + floatTostr(RoundX(TConnectorObject(aLine.JoinConnector2).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure) + ' - ' + floatTostr(RoundX(TConnectorObject(aLine.JoinConnector1).ActualZOrder[1], 2)) + GetUOMString(GCurrProjUnitOfMeasure); end; end; end; procedure SetComponDataToMemTable(ACanShowKabinet: boolean; AGroupByH: boolean = false); var IsFindedCompType: Boolean; IsCanShowKabinet: Boolean; IsAddedString : Boolean; markstring, s : string; aHStr: String; begin //Tolik 13/03/2018 -- if ResourceRel = nil then exit; // IsCanShowKabinet := ACanShowKabinet or AGroupByH; Kolvo := RoundX(ResourceRel.Kolvo, FKolvoPrecision); Price := RoundX(ResourceRel.Price, FPricePrecision); //Cost := RoundX(Kolvo * Price, Max(FKolvoPrecision, FPricePrecision)); if ((FKolvoPrecision<4) and (FPricePrecision<4)) then Cost := RoundX(Kolvo * Price, max(FKolvoPrecision, FPricePrecision)) else Cost := RoundX(Kolvo * Price,4); if AGroupByH then begin aHStr := GetHeightString(SCSComponent); if not mtRep.Locate(fnRoomName, aHStr, []) then begin mtRep.Append; mtRep.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); //этаж (лист) mtRep.FieldByName(fnRoomName).AsString := aHStr; mtRep.FieldByName(fnRoomNum).AsString := ''; mtRep.Post; end; end else begin if Not IsLoadedMaster then begin mtRep.Append; mtRep.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); //этаж (лист) if SCSRoom <> nil then // если кабинет - добавляем номер и название в таблицу begin // Added by Tolik if SCSRoom.ID = 0 then mtRep.FieldByName(fnRoomName).AsString := SCSRoom.Name // Название кабинета else if SCSRoom.NameShort <> '' then mtRep.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name + ' ' + SCSRoom.NameShort else mtRep.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name; mtRep.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID); end else mtRep.FieldByName(fnRoomNum).AsString := ''; mtRep.Post; IsLoadedMaster := true; end; end; // Поиск типа компненты для текушего кабинета IsFindedCompType := false; mtRepDetail.First; while Not mtRepDetail.Eof do begin { TODO NEW протестить и пересмотреть какое из условий правильнее будет работать } if (IsGroupByCompType and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = SCSComponent.GUIDComponentType)) or ((Not IsGroupByCompType) and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = '')) then begin //beep; end; if ((IsGroupByCompType or IsCanGroupByname) and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = SCSComponent.GUIDComponentType)) or (((Not IsGroupByCompType) or IsCanGroupByName) and (mtRepDetail.FieldByName(fnGuidComponentType).AsString = '')) then begin IsFindedCompType := true; Break; //// BREAK //// end; mtRepDetail.Next; end; if Not IsFindedCompType then begin mtRepDetail.Append; if SCSRoom.id = 0 then mtRepDetail.FieldByName(fnRoomName).AsString := SCSRoom.Name else if SCSRoom.NameShort <> '' then mtRepDetail.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name + ' ' + SCSRoom.NameShort else mtRepDetail.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name; if IsGroupByCompType then begin mtRepDetail.FieldByName(fnGuidComponentType).AsString := SCSComponent.GUIDComponentType; mtRepDetail.FieldByName(fnName).AsString := SCSComponent.ComponentType.NamePlural; //added by Tolik mtRepDetail.FieldByName(fnfloor).AsString := IntToStr(SCSList.MarkID); end else mtRepDetail.FieldByName(fnGuidComponentType).AsString := ''; mtRepDetail.Post; end; {if IsCanShowKabinet or (not IsCanShowKabinet and ((SCSComponent.Whole_ID = 0) or Not mtRepSubDetail.Locate(fnWholeID, SCSComponent.Whole_ID, []))) then } IsAddedString := false; if IsCanGroupByName then //задана группировка объектов по наименованию begin s:='...'; mtRepSubdetail.First; while not mtRepsubDetail.Eof do begin if ((SCSComponent.Whole_ID <> 0) and (mtRepSubDetail.FieldValues[fnWholeID] = SCSComponent.Whole_ID) and ((mtRepSubDetail.Fieldvalues[fnName] = SCSComponent.Name) or (mtRepSubDetail.Fieldvalues[fnName] = CompNameWithParents)) and (mtRepSubDetail.Fieldvalues[fnPrice] = price)) or ((SCSComponent.Whole_ID <> 0) and ((mtRepSubDetail.Fieldvalues[fnName] = SCSComponent.Name) or (mtRepSubDetail.Fieldvalues[fnName] = CompNameWithParents)) and (mtRepSubDetail.FieldValues[fnFloor] = Inttostr(SCSList.MarkId)) and (mtRepSubDetail.FieldValues[fnPrice] = Price)) or ((SCSComponent.Whole_ID <> 0) and ((mtRepSubDetail.Fieldvalues[fnName] = SCSComponent.Name) or (mtRepSubDetail.Fieldvalues[fnName] = CompNameWithParents)) and (mtRepSubDetail.FieldValues[fnFloor] = Inttostr(SCSList.MarkId)) and (mtRepSubDetail.FieldValues[fnRoomNum] = SCSRoom.MarkID) and (mtRepSubDetail.FieldValues[fnPrice] = Price)) // это кабель or // Компоненты ((SCSComponent.Whole_ID = 0) and ((mtRepSubDetail.Fieldvalues[fnName] = SCSComponent.Name) or (mtRepSubDetail.Fieldvalues[fnName] = CompNameWithParents)) and (mtRepSubDetail.FieldValues[fnFloor] = Inttostr(SCSList.MarkId)) and (mtRepSubDetail.FieldValues[fnPrice] = Price) and ( mtRepSubDetail.FieldValues[fnRoomNum] = Inttostr(SCSRoom.MarkID)) and IsCanShowKabinet) or ((SCSComponent.Whole_ID = 0) and (mtRepSubDetail.Fieldvalues[fnName] = SCSComponent.Name) and (mtRepSubDetail.FieldValues[fnFloor] = Inttostr(SCSList.MarkId)) and (mtRepSubDetail.FieldValues[fnPrice] = Price) and (not IsCanShowKabinet) and (mtRepSubDetail.FieldValues[fnRoomNum] = inttostr(SCSRoom.MarkID))) then begin mtRepSubDetail.Edit; mtRepSubDetail.FieldByName('KOLVO').AsFloat := mtRepSubDetail.FieldValues['KOLVO'] + kolvo; //mtRepSubDetail.FieldByName('PRICE').AsFloat := mtRepSubDetail.FieldValues['PRICE'] + price; //mtRepSubDetail.FieldByName('COST').AsFloat := mtRepSubDetail.FieldValues['COST'] + cost; mtRepSubDetail.FieldByName('COST').AsFloat := mtRepSubDetail.FieldByName('COST').AsFloat + cost; //if SCSComponent.Whole_ID = 0 then //begin mtRepSubDetail.FieldbyName(fnMarkID).asInteger := 0; markstring := mtRepSubDetail.FieldValues[fnNameMark]; if Pos(s, markstring) = 0 then mtRepSubDetail.FieldbyName(fnNameMark).AsString := markstring + s + SCSComponent.NameMark else begin Delete(markstring, pos(s, markstring) + 1, (Length(markstring) - pos(s, markstring))); mtRepSubDetail.FieldbyName(fnNameMark).AsString := markstring + s + SCSComponent.NameMark; end; //end; mtRepSubDetail.Post; IsAddedString := true; break; end; mtRepSubDetail.Next; end; end; if not IsAddedString then begin if ((FKolvoPrecision<4) and (FPricePrecision<4)) then cost := RoundX(cost,max(FKolvoPrecision,FPricePrecision)) else cost := RoundX(cost,4); mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID); if SCSRoom <> nil then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID) else mtRepSubDetail.FieldByName(fnRoomNum).AsString := ''; mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; if not isCanShowObjHierarchy then mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name else mtRepSubDetail.FieldByName(fnName).AsString := CompNameWithParents; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnWholeID).AsInteger := SCSComponent.Whole_ID; mtRepSubDetail.FieldByName(fnIzm).AsString := ResourceRel.Izm; if SCSRoom.ID = 0 then mtRepSubDetail.FieldByName(fnRoomName).AsString := SCSRoom.Name else if SCSRoom.NameShort <> '' then mtRepSubDetail.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name + ' ' + SCSRoom.NameShort else mtRepSubDetail.FieldByName(fnRoomName).AsString := ' / ' + SCSRoom.Name; mtRepSubDetail.FieldByName('Kolvo').AsFloat := Kolvo; mtRepSubDetail.FieldByName('Price').AsFloat := Price; mtRepSubDetail.FieldByName('Cost').AsFloat := Cost; mtRepSubDetail.FieldByName('Notice').AsString := SCSComponent.Notice; mtRepSubDetail.Post; end; CompNameWithParents := ''; end; // **************************************************************************************************************** begin try ResourceRel := Nil; NormResources := nil; VirtualRoom := nil; // Tolik 17/07/2020 -- if Assigned(FdsrcExplicationCompon) then FdsrcExplicationCompon.free; if Assigned(FdsrcExplicationComponDetail) then FdsrcExplicationComponDetail.free; if Assigned(FdsrcExplicationComponSubDetail) then FdsrcExplicationComponSubDetail.free; if Assigned(FmtExplicationCompon) then FmtExplicationCompon.free; if Assigned(FmtExplicationComponDetail) then FmtExplicationComponDetail.free; if Assigned(FmtExplicationComponSubDetail) then FmtExplicationComponSubDetail.free; FmtExplicationCompon := TkbmMemTable.Create(Self); FmtExplicationCompon.Name := 'FmtExplicationCompon'; FmtExplicationComponDetail := TkbmMemTable.Create(Self); FmtExplicationComponDetail.Name := 'FmtExplicationComponDetail'; FmtExplicationComponSubDetail := TkbmMemTable.Create(Self); FmtExplicationComponSubDetail.Name := 'FmtExplicationComponSubDetail'; FdsrcExplicationCompon := TDataSource.Create(Self); FdsrcExplicationCompon.Name := 'FdsrcExplicationCompon'; FdsrcExplicationCompon.DataSet := FmtExplicationCompon; FdsrcExplicationComponDetail := TDataSource.Create(Self); FdsrcExplicationComponDetail.Name := 'FdsrcExplicationComponDetail'; FdsrcExplicationComponDetail.DataSet := FmtExplicationComponDetail; FdsrcExplicationComponSubDetail := TDataSource.Create(Self); FdsrcExplicationComponSubDetail.Name := 'FdsrcExplicationComponSubDetail'; FdsrcExplicationComponSubDetail.DataSet := FmtExplicationComponSubDetail; // mtRep := FmtExplicationCompon; mtRepDetail := FmtExplicationComponDetail; mtRepSubDetail := FmtExplicationComponSubDetail; // Tolik 17/07/2020 -- //DisconnectDetailMemTable(mtRepSubDetail); //DisconnectDetailMemTable(mtRepDetail); // ClearFieldsInMemTable(mtRepSubDetail, nil); ClearFieldsInMemTable(mtRepDetail, nil); ClearFieldsInMemTable(mtRep, nil); // Добавление общих палей mtRep.FieldDefs.Add(fnID, ftAutoInc); mtRep.FieldDefs.Add(fnFloor, ftString, 20); mtRep.FieldDefs.Add(fnRoomNum, ftString, 20); mtRep.FieldDefs.Add(fnMarkID, ftInteger); mtRep.FieldDefs.Add(fnName, ftString, 255); mtRep.FieldDefs.Add(fnNameMark, ftString, 255); mtRep.FieldDefs.Add(fnRoomName, ftString, 255); mtRepDetail.FieldDefs.Assign(mtRep.FieldDefs); mtRepDetail.FieldDefs.Add(fnIDMaster, ftInteger); mtRepSubDetail.FieldDefs.Assign(mtRepDetail.FieldDefs); //************************************************************** mtRep.FieldDefs.Add(fnGuidComponentType, ftString, cnstGUIDLength); mtRepDetail.FieldDefs.Add(fnGuidComponentType, ftString, cnstGUIDLength); mtRepSubDetail.FieldDefs.Add(fnIDComponent, ftInteger); mtRepSubDetail.FieldDefs.Add(fnObjectAddress, ftInteger); mtRepSubDetail.FieldDefs.Add(fnWholeID, ftInteger); // Добавлено by Tolik для покабинетной экспликации компонентов mtRepSubDetail.FieldDefs.Add(fnIZM, ftString, 20);// единицы измерения mtRepSubDetail.FieldDefs.Add(fnKolvo, ftFloat); // цена mtRepSubDetail.FieldDefs.Add(fnPrice, ftFloat); // количество mtRepSubDetail.FieldDefs.Add(fnCost, FtFloat); // стоимость //*************************************************************************************** mtRepSubDetail.FieldDefs.Add(fnNotice, FtString, 200); // примечание ConnectDetailMemTable(FdsrcExplicationCompon, mtRepDetail, fnID, fnIDMaster); ConnectDetailMemTable(FdsrcExplicationComponDetail, mtRepSubDetail, fnID, fnIDMaster); mtRep.Active := true; mtRepDetail.Active := true; mtRepSubDetail.Active := true; CanHaveActiveComponents := IntToBool(AReportItemParamValues.CanHaveActiveComponents); CanHaveDismountAccount := IntToBool(AReportItemParamValues.CanHaveDismountAccount); CatalogList := TSCSCatalogs.Create(false); CatalogList.Add(ACatalog); CatalogList.AddItems(ACatalog.ChildCatalogReferences); SortSCSObjectsByPMOrder(CatalogList); IsGroupByCompType := IntToBool(AReportItemParamValues.CanGroupByCompType); IsProjOrder := IntToBool(AReportItemParamValues.CanAsPlacingInProj); IsCanShowKabinet := IntToBool(AReportItemParamValues.CanShowKabinet); IsCanShowObjHierarchy := IntToBool(AReportItemParamValues.CanShowObjHierarchy); IsCanGroupByName := IntToBool(AReportItemParamValues.CanGroupByName); //IsShowHeightOfPlacing := IntToBool(AReportItemParamValues.ShowHeightOfPlacing); IsCanGroupbyHeightOfPlacing := IntToBool(AReportItemParamValues.GroupbyHeightOfPlacing); // **************** Перебор и запись элементов проекта в таблицы (Begin) BeginProgress(pcPreparingReport); try FCatalog := ACatalog; ProjectOwner := FCatalog.GetProject; NormResources := ACatalog.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, false, true, ACanHaveSupplyValue); ResourceRel := TSCSResourceRel.Create(GForm, ntProj); isCanShowObjHierarchy := ACanShowObjHierarchy; // Tolik 06/03/2018 //if true then begin // Если задано отображать в порядке размещения if IsProjOrder or IsCanShowKabinet or IsCanGroupbyHeightOfPlacing then begin DefinePrecisions; // Установка точности вывода цены и количества // По умолчанию - 3 знака, если не определено пользователем; // Все компоненты листа, не входящие ни в один кабинет, а находящиеся непосредственно на листе, // собираем в отдельный кабинет, для чего создаем отдельный кабинет, если таковые компоненты есть (Tolik) for i := 0 to CatalogList.Count - 1 do begin SCSCatalog := CatalogList[i]; if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then begin SCSList := TSCSList(SCSCatalog); // Added by Tolik *************************************************** ListHasComponents := false; //Ищем компоненты на листе // Объекты Листа (объект - не всегда есть компонент) for j := 0 to SCSList.ChildCatalogs.Count - 1 do begin SCSObject := SCSList.ChildCatalogs[j]; if IsSCSObjectItemType(SCSObject.ItemType) then begin SCSObject.ReloadComponentReferences; // Компоненты листа SCSRoom := nil; for k := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[k]; if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin ListHasComponents := true; break; end; end; end; if ListHasComponents then break; end; end; // Если есть компоненты на листе, создаем для них отдельный кабинет if ListHasComponents then begin // Создать кабинет VirtualRoom := TSCSList.Create(F_ProjMan); VirtualRoom.ItemType := itRoom; VirtualRoom.ID := 0; VirtualRoom.Name := cResourceReport_Msg45; break; end; end; // ******************************************* Tolik ************************************************************* for i := 0 to CatalogList.Count - 1 do begin SCSCatalog := CatalogList[i]; // Если объект списка - Лист, то выбираем из него компоненты для отчета // в два прохода по списку // в первом - отбираем компоненты кабинетов // во втором - отбираем компоненты листа if (SCSCatalog.ItemType = itList) and (SCSCatalog is TSCSList) then begin SCSList := TSCSList(SCSCatalog); IsLoadedMaster := false; for j := 0 to SCSList.ChildCatalogs.Count - 1 do begin SCSCatalog := SCSList.ChildCatalogs[j]; if SCSCatalog.ItemType = itRoom then begin SCSRoom := SCSCatalog; IsLoadedMaster := false; // Объекты кабинета for k := 0 to SCSRoom.ChildCatalogs.Count - 1 do begin SCSObject := SCSRoom.ChildCatalogs[k]; SCSObject.ReloadComponentReferences; // Компоненты кабинета for l := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[l]; if (AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1))) then begin if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin // Added by Tolik if (SCSComponent.Price <> 0) or AComponsWithZeroPrice then begin if isCanShowObjHierarchy then begin CompNameWithParents := SCSComponent.Name; TopComponent := nil; if SCSComponent <> SCSComponent.GetTopComponent then TopComponent := SCSComponent.GetTopComponent; if ((TopComponent <> nil) and (SCSComponent.ChildReferences.Count = 0)) then CompNameWithParents := TopComponent.Name + ' ' + TopComponent.NameMark + ' / ' + CompNameWithParents; CompNameWithParents := SCSObject.Name + ' ' + IntToStr(SCSObject.MarkID) + ' / ' + CompNameWithParents; FindResourcesForComponent(SCSComponent, SCSComponent.Name, SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet, IsCanGroupbyHeightOfPlacing); end else begin FindResourcesForComponent(SCSComponent, SCSComponent.Name, SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet, IsCanGroupbyHeightOfPlacing); end; end; end; end; end; end; end; end; if IsCanShowKabinet then IsLoadedMaster := false else begin //comented by Igor else IsLoadedMaster:=true; // Added by Tolik end; // Объекты Листа for j := 0 to SCSList.ChildCatalogs.Count - 1 do begin SCSObject := SCSList.ChildCatalogs[j]; if IsSCSObjectItemType(SCSObject.ItemType) then begin SCSObject.ReloadComponentReferences; // Компоненты листа // Commented by Tolik // IsLoadedMaster := false; SCSRoom := VirtualRoom; for k := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[k]; if (AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1))) then begin if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin //Added by Tolik if (SCSComponent.Price <> 0) or AComponsWithZeroPrice then begin if isCanShowObjHierarchy then begin CompNameWithParents:=SCSComponent.Name; TopComponent := nil; if SCSComponent <> SCSComponent.GetTopComponent then TopComponent := SCSComponent.GetTopComponent; if ((TopComponent<>nil) and (SCSComponent.ChildReferences.Count = 0)) then CompNameWithParents := TopComponent.Name + ' ' + TopComponent.NameMark + ' / ' + CompNameWithParents; CompNameWithParents := SCSObject.Name + ' ' +IntToStr(SCSObject.MarkID) + ' / ' + CompNameWithParents; FindResourcesForComponent(SCSComponent, SCSComponent.Name, SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet, IsCanGroupbyHeightOfPlacing); end else begin FindResourcesForComponent(SCSComponent, SCSComponent.Name,SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet, IsCanGroupbyHeightOfPlacing); end; end; end; end; /////////////////////////////////////////////// //IsLoadedMaster := true; end; end; end; end; end; // **************** Перебор и запись элементов проекта в таблицы (End) // Сортировка данных в таблицах mtRep.First; while Not mtRep.Eof do begin if IsGroupByCompType then mtRepDetail.SortOn(fnName, []); mtRepDetail.First; while Not mtRepDetail.Eof do begin mtRepSubDetail.SortOn(fnMarkID, [mtcoNonMaintained]); mtRepDetail.Next; end; mtRep.Next; end; end else begin LookedWholeIDs := TIntList.Create; // Создаем список листов кабинетов: В стрингах будет сигнатура для сортировки, а в объектах индексы листа и комнаты ComponLists := TStringList.Create; MaxListNumLength := 0; MaxRoomNumLength := 0; IsLoadedMaster := false; for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin SCSComponent := ACatalog.ComponentReferences[i]; if (AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1))) then begin if CheckCanLookComponInReportRsrc(SCSComponent, CanHaveActiveComponents, CanHaveDismountAccount) then begin if (SCSComponent.Whole_ID = 0) or (LookedWholeIDs.IndexOf(SCSComponent.Whole_ID) = -1) then begin if Not IsLoadedMaster then begin mtRep.Append; IsLoadedMaster := true; mtRep.Post; end; // Поиск типа компнента IsFindedCompType := false; if (Not IsGroupByCompType and mtRepDetail.Locate(fnGuidComponentType, '', [])) or (IsGroupByCompType and mtRepDetail.Locate(fnGuidComponentType, SCSComponent.GUIDComponentType, [])) then IsFindedCompType := true; if Not IsFindedCompType then begin mtRepDetail.Append; if IsGroupByCompType then begin mtRepDetail.FieldByName(fnGuidComponentType).AsString := SCSComponent.GUIDComponentType; mtRepDetail.FieldByName(fnName).AsString := SCSComponent.ComponentType.NamePlural; end else mtRepDetail.FieldByName(fnGuidComponentType).AsString := ''; mtRepDetail.Post; end; mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := ''; mtRepSubDetail.FieldByName(fnRoomNum).AsString := ''; if SCSComponent.Whole_ID = 0 then begin SCSList := SCSComponent.GetListOwner; SCSRoom := nil; SCSCatalog := SCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSList <> nil then mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(SCSList.MarkID) //Tolik else mtRepSubDetail.FieldByName(fnFloor).AsString := '0'; // if SCSRoom <> nil then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(SCSRoom.MarkID); end; mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.FieldByName(fnObjectAddress).AsInteger := Integer(SCSComponent); mtRepSubDetail.FieldByName(fnWholeID).AsInteger := SCSComponent.Whole_ID; mtRepSubDetail.Post; if SCSComponent.Whole_ID <> 0 then begin for j := 0 to ACatalog.ComponentReferences.Count - 1 do begin PartSCSComponent := ACatalog.ComponentReferences[j]; if PartSCSComponent.Whole_ID = SCSComponent.Whole_ID then begin SCSList := PartSCSComponent.GetListOwner; SCSRoom := nil; RoomMarkID := 0; SCSCatalog := PartSCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSRoom <> nil then RoomMarkID := SCSRoom.MarkID; FindedListRoom := false; for k := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[k]); if (ptrTwoID.ID1 = SCSList.MarkID) and (ptrTwoID.ID2 = RoomMarkID) then begin FindedListRoom := true; Break; //// BREAK //// end; end; if Not FindedListRoom then begin GetZeroMem(ptrTwoID, SizeOf(TTwoID)); ptrTwoID.ID1 := SCSList.MarkID; if Length(IntToStr(SCSList.MarkID)) > MaxListNumLength then MaxListNumLength := Length(IntToStr(SCSList.MarkID)); if SCSRoom <> nil then begin ptrTwoID.ID2 := SCSRoom.MarkID; if Length(IntToStr(SCSRoom.MarkID)) > MaxRoomNumLength then MaxRoomNumLength := Length(IntToStr(SCSRoom.MarkID)); end; ComponLists.AddObject('', TObject(ptrTwoID)); end; end; end; // Проставить в стринге сигнатуры для сортировки for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); if ptrTwoID.ID2 <> 0 then ComponLists[j] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+IntToStrF(ptrTwoID.ID2, MaxRoomNumLength) else ComponLists[j] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+DupStr('X', MaxRoomNumLength); end; ComponLists.Sort; // Вносим номера if ComponLists.Count > 0 then begin // Экономим строки ptrTwoID := Pointer(ComponLists.Objects[0]); mtRepSubDetail.Edit; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2) // Tolik else mtRepSubDetail.FieldByName(fnRoomNum).AsString :='0'; mtRepSubDetail.Post; // Добавляем новые строки с номерами листов и кабинетов for j := 1 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); IsInsertedRecord := false; mtRepSubDetail.Append; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2) //Tolik else mtRepSubDetail.FieldByName(fnRoomNum).AsString :='0'; mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.Post; end; end; // Очистить список листов / комнат for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); FreeMem(ptrTwoID); end; ComponLists.Clear; end; if SCSComponent.Whole_ID <> 0 then LookedWholeIDs.Add(SCSComponent.Whole_ID); end; end; end; end; {mtRep.SortOn('fnfloor,fnroomnum,fnGuidComponentType',[]); mtRepDetail.SortOn('fnfloor,fnroomnum,fnGuidComponentType',[]); mtRepDetail.SortOn('fnfloor,fnroomnum,fnMarkId,fnNameMark,fnidcomponent',[]); } //mtRepSubdetail.SortOn('',[]); if mtRep.RecordCount > 0 then begin // Сортонуть все нах if IsGroupByCompType then mtRepDetail.SortOn(fnName, []); mtRepDetail.First; while Not mtRepDetail.Eof do begin {//mtRepSubDetail.SortOn(fnMarkID, []); mtRepSubDetail.SortFields := fnMarkID+';'+fnFloor+';'+fnRoomNum; mtRepSubDetail.Sort([]); //mtRepSubDetail.inSortFields := '';} SortMemTableByParams(mtRepSubDetail, AParams, AReportItemParamValues); mtRepDetail.Next; end; //SortMemTableByParams(mtRepSubDetail, AParams, AReportItemParamValues); { // Для кабелей подгрузить все номера листов и комнат через которые он проходит mtRepDetail.First; while Not mtRepDetail.Eof do begin mtRepSubDetail.First; RecordCount := mtRepSubDetail.RecordCount; RecNo := mtRepSubDetail.RecNo; while RecNo < RecordCount do //while Not mtRepSubDetail.Eof do begin if mtRepSubDetail.FieldByName(fnWholeID).AsInteger <> 0 then begin // Загрузить список с номерами SCSComponent := TSCSComponent(mtRepSubDetail.FieldByName(fnObjectAddress).AsInteger); if SCSComponent = nil then Continue; //// CONTINUE //// for i := 0 to ACatalog.ComponentReferences.Count - 1 do begin PartSCSComponent := ACatalog.ComponentReferences[i]; if PartSCSComponent.Whole_ID = SCSComponent.Whole_ID then begin SCSList := PartSCSComponent.GetListOwner; SCSRoom := nil; RoomMarkID := 0; SCSCatalog := PartSCSComponent.GetFirstParentCatalog; if SCSCatalog <> nil then SCSRoom := SCSCatalog.GetParentCatalogByItemType(itRoom); if SCSRoom <> nil then RoomMarkID := SCSRoom.MarkID; FindedListRoom := false; for j := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[j]); if (ptrTwoID.ID1 = SCSList.MarkID) and (ptrTwoID.ID2 = RoomMarkID) then begin FindedListRoom := true; Break; //// BREAK //// end; end; if Not FindedListRoom then begin GetZeroMem(ptrTwoID, SizeOf(TTwoID)); ptrTwoID.ID1 := SCSList.MarkID; if Length(IntToStr(SCSList.MarkID)) > MaxListNumLength then MaxListNumLength := Length(IntToStr(SCSList.MarkID)); if SCSRoom <> nil then begin ptrTwoID.ID2 := SCSRoom.MarkID; if Length(IntToStr(SCSRoom.MarkID)) > MaxRoomNumLength then MaxRoomNumLength := Length(IntToStr(SCSRoom.MarkID)); end; ComponLists.AddObject('', TObject(ptrTwoID)); end; end; end; // Проставить в стринге сигнатуры для сортировки for i := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); if ptrTwoID.ID2 <> 0 then ComponLists[i] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+IntToStrF(ptrTwoID.ID2, MaxRoomNumLength) else ComponLists[i] := IntToStrF(ptrTwoID.ID1, MaxListNumLength)+'-'+DupStr('X', MaxRoomNumLength); end; ComponLists.Sort; // Вносим номера if ComponLists.Count > 0 then begin // Экономим строки ptrTwoID := Pointer(ComponLists.Objects[0]); mtRepSubDetail.Edit; mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.Post; // Добавляем новые строки с номерами листов и кабинетов for i := 1 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); IsInsertedRecord := false; if mtRepSubDetail.Eof then mtRepSubDetail.Append else begin mtRepSubDetail.Next; mtRepSubDetail.Insert; IsInsertedRecord := true; end; if mtRepSubDetail.State <> dsBrowse then begin mtRepSubDetail.FieldByName(fnFloor).AsString := IntToStr(ptrTwoID.ID1); if ptrTwoID.ID2 <> 0 then mtRepSubDetail.FieldByName(fnRoomNum).AsString := IntToStr(ptrTwoID.ID2); mtRepSubDetail.FieldByName(fnMarkID).AsInteger := SCSComponent.MarkID; mtRepSubDetail.FieldByName(fnName).AsString := SCSComponent.Name; mtRepSubDetail.FieldByName(fnNameMark).AsString := SCSComponent.NameMark; mtRepSubDetail.FieldByName(fnIDComponent).AsInteger := SCSComponent.ID; mtRepSubDetail.Post; //if IsInsertedRecord then // mtRepSubDetail.Prior; end; end; end; // Очистить список листов / комнат for i := 0 to ComponLists.Count - 1 do begin ptrTwoID := Pointer(ComponLists.Objects[i]); FreeMem(ptrTwoID); end; ComponLists.Clear; end; mtRepSubDetail.Next; RecNo := RecNo + 1; end; mtRepDetail.Next; end;} end; FreeAndNil(ComponLists); FreeAndNil(LookedWholeIDs); end; end; finally EndProgress; end; FreeAndNil(CatalogList); GFormMode := fmRExplicationComponent; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowExplicationComponent', E.Message); end; // Tolik -- 13/13/2018 -- if ResourceRel <> nil then FreeAndNil(ResourceRel); if NormResources <> nil then FreeAndNil(NormResources); if VirtualRoom <> nil then FreeAndNil(VirtualRoom); // //DisconnectDetailMemTable(mtRepSubDetail); //DisconnectDetailMemTable(mtRepDetail); //ClearFieldsInMemTable(mtRepSubDetail, nil); //ClearFieldsInMemTable(mtRepDetail, nil); //ClearFieldsInMemTable(mtRep, nil); end; procedure TF_ResourceReport.ShowComponSpecifications(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); begin try if Not rbModePacketPrintToExcel.Checked then begin CreateFGuideFileList; //Tolik // F_GuideFileList.Execute(gftCompSpecification, ACatalog.ComponentReferences); if AllNetTypes then F_GuideFileList.Execute(gftCompSpecification, ACatalog.ComponentReferences, nil) else F_GuideFileList.Execute(gftCompSpecification, ACatalog.ComponentReferences, NetTypeGuidListSelected); end // Tolik // При пакетной печати нужно увеличить счетчик, а то будет горе - зависнет форма // Если это последний отчет, форму прогреса нужно закрыть else IncPaketPrintCounter; {if rbModePacketPrintToExcel.Checked then begin Inc(FReportCountPrinted); if (FReportCountPrinted = FReportCountToPrint) then begin if FReportCountPrinted = FReportCountToPrint then begin //*** Догнать до 100 for i := TF_Main(GForm).F_ProgressExp.gTotal.Progress + 1 to TF_Main(GForm).F_ProgressExp.gTotal.MaxValue do begin TF_Main(GForm).F_ProgressExp.gTotal.Progress := i; TF_Main(GForm).F_ProgressExp.gTotal.Refresh; Sleep(500); end; if TF_Main(GForm).F_ProgressExp.cbOpen.Checked then ShellExecute(Handle, nil, PChar(FPackgeDir), nil, nil, SW_SHOW); end; FReportCountPrinted := FReportCountToPrint; TF_Main(GForm).F_ProgressExp.Close; end; end; end;} except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowComponSpecifications', E.Message); end; end; procedure TF_ResourceReport.ShowCrossJournal(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode); var ListWithLookedCompons: TIntList; CurrIDCompon: Integer; i, j: Integer; SCSComponent: TSCSComponent; ComponCatagoryStr: String; ComponCatagory: Integer; ComponNameMark: String; ListName: String; FirstComponent: TSCSComponent; LastComponent: TSCSComponent; FromNppPort: Integer; FromPortName: String; ToNppPort: Integer; ToPortName: String; InterfCount: Integer; MasterID: Integer; ComponSignType: Integer; ComponMarkTemplate: string; ListOwner: TSCSList; RoomOwner: TSCSCatalog; SprComponentType: TNBComponentType; mtRep: TkbmMemTable; begin try mtRep := FmtCrossJournal; ClearFieldsInMemTable(mtRep, nil); mtRep.FieldDefs.Add(fnNameList, ftString, 255); mtRep.FieldDefs.Add(fnRoomNum, ftString, 255); mtRep.FieldDefs.Add(fnNameFrom, ftString, 255); mtRep.FieldDefs.Add(fnNameTo, ftString, 255); mtRep.FieldDefs.Add(fnNumFrom, ftInteger, 0); //05.02.2011 mtRep.FieldDefs.Add(fnNumTo, ftInteger, 0); //05.02.2011 // Tolik -- 04/05/2017 -- по просьбам трудящихся в отчет добавлен порт ("откуда") mtRep.FieldDefs.Add(fnPortNameFrom, ftString, 255); // mtRep.FieldDefs.Add(fnPortNameTo, ftInteger, 0); //05.02.2011 mtRep.FieldDefs.Add(fnPortNameTo, ftString, 255); mtRep.FieldDefs.Add(fnCableNameShort, ftString, 255); mtRep.FieldDefs.Add(fnCableNameMark, ftString, 255); mtRep.FieldDefs.Add(fnCableNum, ftInteger, 0); mtRep.Active := true; FCatalog := AFolder; ListWithLookedCompons := TIntList.Create; BeginProgress(pcPreparingReport); try for i := 0 to AFolder.ComponentReferences.Count - 1 do begin SCSComponent := AFolder.ComponentReferences[i]; if Assigned(SCSComponent) then begin if (SCSComponent.IsLine = biFalse) or ((SCSComponent.IsLine = biTrue) and (AllNetTypes or (NetTypeGuidListSelected.IndexOf(SCSComponent.GUIDNetType) <> -1))) then begin ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (SCSComponent.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (AReportItemParamValues.CanHaveActiveComponents = biTrue)) then if SCSComponent.HaveInterfaceByType(itFunctional) then //*** Есть ли функциональные интерфейсы //if (CheckSysNameIsCable(SCSComponent.ComponentType.SysName) and if (isCableComponent(SCSComponent) and (not (SCSComponent.IDNetType in [3,{4,}5,7])) and (ListWithLookedCompons.IndexOf(SCSComponent.ID) = -1)) then begin SCSComponent.RefreshWholeLengthIfNecessary; SCSComponent.LoadWholeComponent(false); SCSComponent.LoadWholeLength; SCSComponent.DefineFirstLast; //if (SCSComponent.FirstIDConnectedConnCompon > 0) and // (SCSComponent.LastIDConnectedConnCompon > 0) then if Assigned(SCSComponent.FirstConnectedConnCompon) and Assigned(SCSComponent.LastConnectedConnCompon) and CheckCanLookComponInReportCable(SCSComponent.FirstConnectedConnCompon, AReportItemParamValues.CanHaveDismountAccount = biTrue) and CheckCanLookComponInReportCable(SCSComponent.LastConnectedConnCompon, AReportItemParamValues.CanHaveDismountAccount = biTrue) then if Not (AReportItemParamValues.CanHaveDismountAccount = biTrue) or Not CheckHaveWholeComponentDismounted(FCatalog, SCSComponent.WholeComponent) then begin //01.04.2009 SCSComponent.RefreshWholeLengthIfNecessary; ComponCatagoryStr := ''; ComponCatagoryStr := SCSComponent.GetPropertyValueBySysName(pnCategory); ListName := ''; FirstComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.FirstIDCompon); LastComponent := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(SCSComponent.LastIDCompon); // Tolik -- 04/05/2017 -- FromNppPort := -1; FromPortName := ''; // LoadPortName(SCSComponent.FirstIDConnectedConnCompon, SCSComponent.FirstIDCompon, FromNppPort, FromPortName); LoadPortName(SCSComponent.LastIDConnectedConnCompon, SCSComponent.LastIDCompon, ToNppPort, ToPortName); // Определить Лист и кабинет ListOwner := nil; RoomOwner := nil; {//11.03.2009 if FirstComponent <> nil then ListOwner := FirstComponent.GetListOwner else if LastComponent <> nil then ListOwner := LastComponent.GetListOwner else ListOwner := SCSComponent.GetListOwner; } ListOwner := SCSComponent.FirstConnectedConnCompon.GetListOwner; if ListOwner <> nil then begin ListName := ListOwner.GetNameForVisible; RoomOwner := GetComponObjectOwnerByItemType(SCSComponent.FirstConnectedConnCompon, itRoom); //11.03.2009 GetComponObjectOwnerByItemType(FirstComponent, itRoom); //if RoomOwner <> nil then // ListName := ListName + '. '+ RoomOwner.GetNameForVisible; SprComponentType := ListOwner.Spravochnik.GetComponentTypeByGUID(SCSComponent.GUIDComponentType); if SprComponentType <> nil then ComponMarkTemplate := SprComponentType.ComponentType.MarkMask; //*** Удалить обозначение из шаблона маркировки if ComponMarkTemplate <> '' then if Pos(mteNameShort, ComponMarkTemplate) <> 0 then Delete(ComponMarkTemplate, Pos(mteNameShort, ComponMarkTemplate), Length(mteNameShort)); end; mtRep.Append; mtRep.FieldByName(fnNameList).AsString := ListName; // Откуда приходит if RoomOwner <> nil then mtRep.FieldByName(fnRoomNum).AsString := RoomOwner.GetNameForVisible; mtRep.FieldByName(fnNameFrom).AsString := GetMultiPortNameMark(SCSComponent.FirstConnectedConnCompon, true); // # розетки или коммутационной панели mtRep.FieldByName(fnNumFrom).AsInteger := SCSComponent.FirstConnectedConnCompon.MarkID; ComponNameMark := GetMultiPortNameMark(SCSComponent.LastConnectedConnCompon, false); // # комутационной панели // Если в панеле пустая маркировка, то выводим тире if ComponNameMark <> '' then begin mtRep.FieldByName(fnNameTo).AsString := ComponNameMark; mtRep.FieldByName(fnNumTo).AsInteger := SCSComponent.LastConnectedConnCompon.MarkID; end else begin mtRep.FieldByName(fnNameTo).AsString := '-'; mtRep.FieldByName(fnNumTo).AsInteger := 0; end; mtRep.FieldByName(fnPortNameTo).AsInteger := ToNppPort; //05.02.2011 IntToStr(ToNppPort); // Номер порта панели //mtRep.FieldByName(fnPortNameTo).AsString := IntToStr(ToNppPort); // Номер порта панели mtRep.FieldByName(fnCableNameShort).AsString := SCSComponent.NameShort; mtRep.FieldByName(fnCableNameMark).AsString := TF_Main(SCSComponent.ActiveForm).MakeNameMarkComponent(SCSComponent, SCSComponent.GetFirstParentCatalog, false, ComponMarkTemplate); // номер кабеля //SCSComponent.NameMark; mtRep.FieldByName(fnCableNum).AsInteger := SCSComponent.MarkID; // Tolik -- 04/05/2017 -- if FromNppPort <> -1 then mtRep.FieldByName(fnPortNameFrom).AsString := IntToStr(FromNppPort) else mtRep.FieldByName(fnPortNameFrom).AsString := ' - '; mtRep.Post; end; for j := 0 to SCSComponent.WholeComponent.Count - 1 do ListWithLookedCompons.Add(SCSComponent.WholeComponent[j]); end; end; end; end; //*** Сортировка //MemTable_RCableJournal.SortOn(fnNameFrom, []); SortMemTableByParams(mtRep, AParams, AReportItemParamValues); finally EndProgress; FreeAndNil(ListWithLookedCompons); end; GFormMode := AResourceReportFormMode; ShowPreparedReport(AParams); //Act_ShowReport.Execute; except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowCrossJournal', E.Message); end; end; procedure TF_ResourceReport.ShowHouse(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); var i, j, k: integer; Catalogs: TSCSCatalogs; CreatedCatalogs: Boolean; SCSCatalog: TSCScatalog; HouseCompon: TSCSComponent; ApproachCompon: TSCSComponent; // Tolik 21/03/2017 -- CatalogsAssigned: Boolean; // begin try // Tolik 21/03/2017 -- CatalogsAssigned := False; // DisconnectDetailMemTable(FmtApproach); FmtApproach.Active := false; FmtHouse.Active := false; ConnectDetailMemTable(FdsrcHouse, FmtApproach, fnID, fnIDComponent); FmtHouse.Active := true; FmtApproach.Active := true; FCatalog := AFolder; Catalogs := nil; CreatedCatalogs := false; if AParams.CanAsPlacingInProj = biTrue then begin Catalogs := GetChildCatalogsInPlacingOrder(AFolder, [itSCSConnector]); CreatedCatalogs := true; end else Catalogs := AFolder.ChildCatalogReferences; for i := 0 to Catalogs.Count - 1 do begin SCSCatalog := Catalogs[i]; for j := 0 to SCSCatalog.SCSComponents.Count - 1 do begin HouseCompon := SCSCatalog.SCSComponents[j]; if HouseCompon.ComponentType.SysName = ctsnHouse then begin FmtHouse.Append; FmtHouse.FieldByName(fnID).AsInteger := HouseCompon.ID; FmtHouse.FieldByName(fnName).AsString := HouseCompon.Name; FmtHouse.FieldByName(fnMarkID).AsInteger := HouseCompon.MarkID; FmtHouse.FieldByName(fnCooperative).AsString := HouseCompon.GetPropertyValueBySysName(pnCooperative); FmtHouse.FieldByName(fnHEO).AsString := HouseCompon.GetPropertyValueBySysName(pnHEO); FmtHouse.FieldByName(fnAgreed).AsInteger := GetPropValueAsBoolGrayedDef(HouseCompon.Properties, pnAgreed, bigFalse); FmtHouse.Post; for k := 0 to HouseCompon.ChildComplects.Count - 1 do begin ApproachCompon := HouseCompon.ChildComplects[k]; if ApproachCompon.ComponentType.SysName = ctsnApproach then begin FmtApproach.Append; FmtApproach.FieldByName(fnID).AsInteger := ApproachCompon.ID; FmtApproach.FieldByName(fnIDComponent).AsInteger := HouseCompon.ID; FmtApproach.FieldByName(fnName).AsString := ApproachCompon.Name; FmtApproach.FieldByName(fnMarkID).AsInteger := ApproachCompon.MarkID; FmtApproach.FieldByName(fnBoxInstalled).AsInteger := GetPropValueAsBoolGrayedDef(ApproachCompon.Properties, pnBoxInstalled, bigFalse); FmtApproach.FieldByName(fnPresencePower200WFromNetwork).AsInteger := GetPropValueAsBoolGrayedDef(ApproachCompon.Properties, pnPresencePower200WFromNetwork, bigFalse); FmtApproach.FieldByName(fnCableSetToBox).AsInteger := GetPropValueAsBoolGrayedDef(ApproachCompon.Properties, pnCableSetToBox, bigFalse); FmtApproach.FieldByName(fnFiberOpticWelded).AsInteger := GetPropValueAsBoolGrayedDef(ApproachCompon.Properties, pnFiberOpticWelded, bigFalse); FmtApproach.FieldByName(fnEquipmentInstalled).AsInteger := GetPropValueAsBoolGrayedDef(ApproachCompon.Properties, pnEquipmentInstalled, bigFalse); FmtApproach.Post; end; end; end; end; end; // Сортируем FmtHouse.SortOn(fnName+';'+fnMarkID, []); if AReportItemParamValues.CanAsPlacingInProj = biFalse then SortMemTableByParams(FmtApproach, AParams, AReportItemParamValues); if CreatedCatalogs then // Tolik 21/03/2017 -- // FreeAndNil(Catalogs); Catalogs.free; // GFormMode := AParams.Mode; ShowPreparedReport(AParams); except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowHouse', E.Message); end; end; procedure TF_ResourceReport.ShowDefectAct(AFolder: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams; AResourceReportFormMode: TResourceReportFormMode); var F_MasterDefectAct: TF_MasterDefectAct; begin // Tolik // при пакетной печати - не формируем if Not rbModePacketPrintToExcel.Checked then begin // FCatalog := AFolder; F_MasterDefectAct := TF_MasterDefectAct.Create(GForm, GForm); F_MasterDefectAct.Execute(fmView, AFolder, true, TF_Main(GForm).FUOM); FreeAndNil(F_MasterDefectAct); end else IncPaketPrintCounter; end; procedure TF_ResourceReport.ShowDefectActForCompon(ACompon: TSCSComponent; AParams: TReportItemParams; ADefectAct: TDefectAct); var DefectAct: TDefectAct; Params: TReportItemParams; begin try Params := AParams; if Params = nil then Params := TReportItemParams(tvReports.Selected.Data); DefectAct := ADefectAct; if DefectAct = nil then DefectAct := ACompon.ProjectOwner.GetComponDefectAct(ACompon); if DefectAct = nil then DefectAct := TDefectAct.Create(nil); FmtDefectAct.Active := false; FmtDefectAct.Active := true; FmtDefectAct.Append; FmtDefectAct.FieldByName(fnName).AsString := ACompon.GetNameForVisible; FmtDefectAct.FieldByName(fnFindDefectChecked).AsBoolean := DefectAct.FindDefectChecked; TMemoField(FmtDefectAct.FieldByName(fnFindDefectAdress)).Value := DefectAct.FindDefectAdress; TMemoField(FmtDefectAct.FieldByName(fnFindDefectDescription)).Value := DefectAct.FindDefectDescription; FmtDefectAct.FieldByName(fnLinkTransportChecked).AsBoolean := DefectAct.LinkTransportChecked; TMemoField(FmtDefectAct.FieldByName(fnLinkTransportPointA)).Value := DefectAct.LinkTransportPointA; TMemoField(FmtDefectAct.FieldByName(fnLinkTransportPointB)).Value := DefectAct.LinkTransportPointB; FmtDefectAct.FieldByName(fnLinkTransportCable).AsFloat := FloatInUOM(DefectAct.LinkTransportCable, umMetr, TF_Main(GForm).FUOM); TMemoField(FmtDefectAct.FieldByName(fnLinkTransportMaterials)).Value := DefectAct.LinkTransportMaterials; FmtDefectAct.FieldByName(fnSetEquipmentChecked).AsBoolean := DefectAct.SetEquipmentChecked; TMemoField(FmtDefectAct.FieldByName(fnSetEquipmentAddress)).Value := DefectAct.SetEquipmentAddress; TMemoField(FmtDefectAct.FieldByName(fnSetEquipmentEqipm)).Value := DefectAct.SetEquipmentEqipm; TMemoField(FmtDefectAct.FieldByName(fnSetEquipmentMaterial)).Value := DefectAct.SetEquipmentMaterial; FmtDefectAct.FieldByName(fnMoveEquipmentChecked).AsBoolean := DefectAct.MoveEquipmentChecked; TMemoField(FmtDefectAct.FieldByName(fnMoveEquipmentPointA)).Value := DefectAct.MoveEquipmentPointA; TMemoField(FmtDefectAct.FieldByName(fnMoveEquipmentPointB)).Value := DefectAct.MoveEquipmentPointB; TMemoField(FmtDefectAct.FieldByName(fnMoveEquipmentEqipm)).Value := DefectAct.MoveEquipmentEqipm; TMemoField(FmtDefectAct.FieldByName(fnMoveEquipmentMaterial)).Value := DefectAct.MoveEquipmentMaterial; TMemoField(FmtDefectAct.FieldByName(fnContractorName)).Value := DefectAct.Contractor; FmtDefectAct.FieldByName(fnDateGetting).AsDateTime := DefectAct.DateGetting; FmtDefectAct.FieldByName(fnDateExecution).AsDateTime := DefectAct.DateExecution; FmtDefectAct.Post; if ADefectAct = nil then FreeAndNil(DefectAct); GFormMode := fmRDefectAct; ShowPreparedReport(Params); except on E: Exception do AddExceptionToLogEx('TF_ResourceReport.ShowDefectActForCompon', E.Message); end; end; procedure TF_ResourceReport.ShowCommerceInvoice(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); const // Position Type ptGroup = 1; ptEndGroup = 2; ptCompon = 3; ptGroupTotal = 4; ptBreak = 5; var // i, j: integer; // //NBPath: TStringList; // CatalogOwnerPathID: TIntList; // Compon: TSCSComponent; // ComponIDNB: Integer; // added by Tolik IsCanShowResources, IsCanShowWorks: Boolean; NormResources: TSCSNormsResources; i: Integer; ResourceRel: TSCSResourceRel; ResourceCompon: TSCSComponent; SprSuppliesKind: TNBSuppliesKind; ProjectOwner: TSCSProject; // Tolik 28/08/2019 -- //OldTick, CurrTick: Cardinal; OldTick, CurrTick: DWord; // TotalCost: Double; InterfaceNormList: TList; CurrInterfaceNormList: TList; TempList: TList; SCSComponent: TSCSComponent; SCSCatalog: TSCSCatalog; TraceLength: Double; Interfac: TSCSInterface; ptrJoinedInterf: TSCSInterface; ptrComplectInterf: TSCSInterface; ptrResultInterface: TSCSInterface; //IOfIRel: TSCSIOfIRel; ptrInterfaceNormInfo: PInterfaceNormInfo; ptrInterfaceNormInfoI: PInterfaceNormInfo; ptrInterfaceNormInfoJ: PInterfaceNormInfo; GroupedNorms: TSCSNormsResources; GroupNorm: TSCSNorm; RootCatalog: TSCSCatalog; // Корневой объект // ComponCatalog: TSCSCatalog; // Объект для компонента // CatalogWithNoDefined: TSCSCatalog; // Объект с компонентами, которых нету в БД // MaxPathLen: Integer; // Минимальная длина пути // //ptrComponTotalQt: PDouble; // переменная из списка, в которой хранится общее кол-во // //ComponentQt: Double; // Колво одной компоненты // GroupCompon: TSCSComponent; // GroupComponList: TSCSComponents; // LookedWholeID: TIntList; // Catalogs: TSCSCatalogs; LevelColors: TIntList; CableTypes : TCableTypeArray; CableIdsList : TIntList; // GenCatalogNum: Integer; // // Создаст объект каталога // function CreateCatalogContainer(ANBID: Integer=0; AParentContainer: TSCSCatalog=nil): TSCSCatalog; // begin // Result := TSCSCatalog.Create(GForm); // //Result.SCSComponents.OwnsObjects := false; // // if ANBID <> 0 then // begin // Result.ID := ANBID; // Result.Name := TF_Main(GForm).FNormBase.DM.GetStringFromTableByID(tnCatalog, fnName, Result.ID, qmPhisical); // end; // if AParentContainer <> nil then // AParentContainer.AddChildCatalogToList(Result); // end; // // // Строит структуру (путь) объектов из пути ID, вернет самый внутренний каталог // function CatalogPathIDToObject(ACatalogPathID: TIntList): TSCSCatalog; // var // i: Integer; // CurrCatalog: TSCSCatalog; // ChildCatalog: TSCSCatalog; // begin // CurrCatalog := RootCatalog; // for i := 0 to ACatalogPathID.Count - 1 do // begin // ChildCatalog := CurrCatalog.ChildCatalogs.GetByID(ACatalogPathID[i]); // if ChildCatalog = nil then // ChildCatalog := CreateCatalogContainer(ACatalogPathID[i], CurrCatalog); // CurrCatalog := ChildCatalog; // // //if (i+1) > MaxCatalogLevel then // // MaxCatalogLevel := i+1; // end; // if (MaxPathLen = 0) or (MaxPathLen < ACatalogPathID.Count) then // MaxPathLen := ACatalogPathID.Count; // Result := CurrCatalog; // end; // // // Убирает общие верхние объекты - те у которых один дочерний подобъект // // смотрим чтобы для компонентов был хотя бы один уровень // // и для самого глубокого по возможности - минимкм три уровня // procedure RemoveTopCommonObjects; // var // CurrTopCatalog: TSCSCatalog; // //CatalogToRemove: TSCSCatalog; // RemovedCount: Integer; // begin // CurrTopCatalog := RootCatalog; // RemovedCount := 0; // //while (MaxPathLen - RemovedCount) >= 3 do // while true do // begin // // Проверки для выхода из цыкла // if (CurrTopCatalog.ChildCatalogs.Count > 1) or // если несколько объектов, товыходим // (CurrTopCatalog.SCSComponents.Count > 0) or // если есть компоненты, то выходим // (CurrTopCatalog.ChildCatalogs.Count = 0) or // на всякий случай // //((MaxPathLen-RemovedCount) <= 3) then // ((MaxPathLen-RemovedCount) <= 3) then // begin // EmptyProcedure; // Break; //// BREAK //// // end; // RootCatalog := CurrTopCatalog.ChildCatalogs[0]; // //RootCatalog.Parent := nil; // CurrTopCatalog.RemoveChildCatalogFromList(RootCatalog); // // CurrTopCatalog.Free; // CurrTopCatalog := RootCatalog; // RemovedCount := RemovedCount + 1; // end; // end; // // procedure DefineCatalogCodes(AParentCatalogs: TSCSCatalogs); // var // i, j: Integer; // ChildLevelCatalogs: TSCSCatalogs; // Catalog: TSCSCatalog; // begin // ChildLevelCatalogs := TSCSCatalogs.Create(false); // // Определяем номера Каталогов // for i := 0 to AParentCatalogs.Count - 1 do // begin // Catalog := AParentCatalogs[i]; // // GenCatalogNum := GenCatalogNum + 1; // Catalog.MarkID := GenCatalogNum; // // // Определяем список каталогов уровнем ниже // for j := 0 to Catalog.ChildCatalogs.Count - 1 do // ChildLevelCatalogs.Add(Catalog.ChildCatalogs[j]); // end; // if ChildLevelCatalogs.Count > 0 then // DefineCatalogCodes(ChildLevelCatalogs); // FreeAndNil(ChildLevelCatalogs); // end; // // function GetGrpCompon(AProjCompon: TSCSComponent): TSCSComponent; // var // Compon: TSCSComponent; // Izm: String; // i: Integer; // begin // Result := nil; // Izm := AProjCompon.Izm; // if CheckPriceTransformToUOMByCompType(@AProjCompon.ComponentType) then // Izm := GetNameUOM(umMetr, true); // // for i := 0 to GroupComponList.Count - 1 do // begin // Compon := GroupComponList[i]; // if (Compon.ArticulProducer = AProjCompon.ArticulProducer) and // (Abs(Compon.Price - AProjCompon.Price) < cnstCmpPriceDelta) and // (Compon.Izm = Izm) and // (Compon.GUIDProducer = AProjCompon.GUIDProducer) and // (Compon.Name = AProjCompon.Name) and // (Compon.IsLine = AProjCompon.IsLine) then // begin // Result := Compon; // Break; //// BREAK //// // end; // end; // end; procedure AddRecoToMT(const ACode, ANat, AUom, AName: String; AQt, APrice, ACost: Double; AColor, APositionType: Integer); //AColor, ACharterLevel: Integer; AIsTotal: Boolean); begin FmtCommerceInvoice.Append; FmtCommerceInvoice.FieldByName(fnCode).AsString := ACode; FmtCommerceInvoice.FieldByName(fnNat).AsString := ANat; FmtCommerceInvoice.FieldByName(fnUOM).AsString := AUom; FmtCommerceInvoice.FieldByName(fnName).AsString := AName; //15.08.2012 FmtCommerceInvoice.FieldByName(fnQt).AsFloat := AQt; //15.08.2012 FmtCommerceInvoice.FieldByName(fnPrice).AsFloat := APrice; //15.08.2012 FmtCommerceInvoice.FieldByName(fnCost).AsFloat := ACost; // commented by Tolik { FmtCommerceInvoice.FieldByName(fnQt).AsString := FormatFloat(ffMask, AQt); FmtCommerceInvoice.FieldByName(fnPrice).AsString := FormatFloat(ffMask, APrice); FmtCommerceInvoice.FieldByName(fnCost).AsString := FormatFloat(ffMask, ACost);} // выполнено округления цен и количества до заданных пользователем(Tolik) FmtCommerceInvoice.FieldByName(fnQt).AsString := FloatToStr(RoundX(AQt,FKolvoPrecision)); FmtCommerceInvoice.FieldByName(fnPrice).AsString := FloatToStr(RoundX(APrice,FPricePrecision)); FmtCommerceInvoice.FieldByName(fnCost).AsString := FloatToStr(RoundX(ACost,Max(FKolvoPrecision,FPricePrecision))); // // ServFields FmtCommerceInvoice.FieldByName(fnColor).AsInteger := AColor; FmtCommerceInvoice.FieldByName(fnPosType).AsInteger := APositionType; //FmtCommerceInvoice.FieldByName(fnCharterLevel).AsInteger := ACharterLevel; //FmtCommerceInvoice.FieldByName(fnIsCharter).AsBoolean := //FmtCommerceInvoice.FieldByName(fnIsTotal).AsBoolean := AIsTotal; FmtCommerceInvoice.Post; end; procedure CatalogComponsToMT(ACatalog: TSCSCatalog; ACatalogCost: PDouble); var i, j: Integer; Compon: TSCSComponent; ComponPrice: Double; ComponCount: Double; ComponCost: Double; //Tolik 23/10/2020 -- SprSuppliesKind: TNBSuppliesKind; SupplyName, SupplyIzm: string; SupplyCost: double; SupplyCount: double; SCount, AllCount: Double; // begin for i := 0 to ACatalog.SCSComponents.Count - 1 do begin Compon := ACatalog.SCSComponents[i]; // Tolik // по типу сети if (AllNetTypes or ((not AllNetTypes) and (NetTypeGuidListSelected.Indexof(Compon.GUIDNetType)<> -1))) then begin // Tolik 23/10/2020 -- если нужно учесть поставочные величины -- if cbCanHaveSupplyValue.Checked then begin if ProjectOwner <> nil then begin SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(Compon.GUIDSuppliesKind); if SprSuppliesKind <> nil then begin SCount := 0; if CheckisTradUom(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure) then begin SupplyName := SprSuppliesKind.Data.NameTradUOM; SupplyIzm := SprSuppliesKind.Data.IzmTradUOM; SupplyCount := SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin SupplyName := SprSuppliesKind.Data.Name; SupplyIzm := SprSuppliesKind.Data.Izm; SupplyCount := SprSuppliesKind.Data.UnitKolvo; end; GetComponQtPriceInUOM(Compon, TF_Main(GForm).FUOM, @ComponPrice, @ComponCount); ComponCount := 0; if SupplyCount <> 0 then // если определено количество в поставке begin //SCount := 1; ComponPrice := ComponPrice * SupplyCount; // за единицу поставки if ComponCount > SupplyCount then begin ComponCount := 1; AllCount := SupplyCount; while AllCount < ComponCount do begin //SCount := SCount + 1; ComponCount := ComponCount + 1; AllCount := AllCount + SupplyCount; end; ComponPrice := ComponPrice * ComponCount; end else ComponCount := 1; end; ComponCount := RoundX(ComponCount,FKolvoPrecision); ComponPrice := RoundX(ComponPrice,FPricePrecision); //Округлаем стоимость в пределах разумного до 5 знаков if ((FPricePrecision<4) and (FKolvoPrecision<4)) then ComponCost := RoundX(ComponPrice * ComponCount,Max(FPricePrecision,FKolvoPrecision)) else ComponCost :=RoundX(ComponPrice * ComponCount,4); // Tolik 03/11/2020 -- проставочные величины (количество для кабеля ) if Compon.isLine = biTrue then begin if isCableComponent(Compon) then begin if cbCanHaveSupplyValue.Checked then begin if not cbNone.Checked then begin if Length(CableTypes) > 0 then begin for j := 0 to Length(CableTypes) - 1 do begin if Compon.Cypher = CableTypes[j].CableCypher then begin if Length(CableTypes[j].Reels) > 0 then ComponCount := Length(CableTypes[j].Reels); // это, если округлять величины if not cbCanRoundValue.Checked then begin ComponCount := RoundX((Compon.Length/SupplyCount), FKolvoPrecision); // не округлять величины end; if ComponCount <> 0 then begin ComponCost := RoundX(ComponPrice * ComponCount, FPricePrecision); // цена //ComponCost := RoundX((Compon.Length/SupplyCount * ComponPrice, FPricePrecision); end; break; end; end; end; end else begin // если нет учета бухт кабеля - вывести как есть (ВАЖНО!!! -- в единицах измерения проекта) ComponCount := Compon.Length; ComponCost := RoundX(ComponPrice * ComponCount, FPricePrecision); // ценаComponPrice * ComponCount SupplyName := GetNameUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure, true); end; end; end; end; // // Tolik 19/10/2020 для линейных компонент следует указать единицы измерения согласно настроек проекта, // а не те, что в компоненте прописаны ... //AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); if Compon.isLine = biFalse then //AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon) AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, SupplyName, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon) else //AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, GetNameUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure, // true), Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, SupplyName, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); // if ACatalogCost <> nil then ACatalogCost^ := ACatalogCost^ + ComponCost; end; end; end else begin //ComponPrice := Compon.Price; //ComponCount := Compon.Length; //// Цена компонента по СИ //if CheckPriceTransformToUOMByCompType(@Compon.ComponentType) then //begin // if TF_Main(GForm).FUOM <> umMetr then // begin // ComponCount := FloatInUOM(Compon.Length, umMetr, TF_Main(GForm).FUOM); // ComponPrice := FloatInUOM(Compon.Price, TF_Main(GForm).FUOM, umMetr); // end; //end; GetComponQtPriceInUOM(Compon, TF_Main(GForm).FUOM, @ComponPrice, @ComponCount); // commented by Toik { ComponCost := RoundCP(ComponPrice * ComponCount); AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, RoundCP(ComponCount), RoundCP(ComponPrice), ComponCost, clNone, ptCompon);} // выполнено округление (Tolik) ComponCount := RoundX(ComponCount,FKolvoPrecision); ComponPrice := RoundX(ComponPrice,FPricePrecision); //Округлаем стоимость в пределах разумного до 5 знаков if ((FPricePrecision<4) and (FKolvoPrecision<4)) then ComponCost := RoundX(ComponPrice * ComponCount,Max(FPricePrecision,FKolvoPrecision)) else ComponCost :=RoundX(ComponPrice * ComponCount,4); // Tolik 19/10/2020 для линейных компонент следует указать единицы измерения согласно настроек проекта, // а не те, что в компоненте прописаны ... //AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); //Tolik 06/07/2022 -- проверить на нулевую цену if ((AReportItemParamValues.CanHaveZeroPriceComponents = 1) or ((AReportItemParamValues.CanHaveZeroPriceComponents = 0) and (ComponPrice <> 0))) then begin if Compon.isLine = biFalse then AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon) else AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, GetNameUOM(F_ProjMan.GSCSBase.CurrProject.Setting.UnitOfMeasure, true), Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); end; // if ACatalogCost <> nil then ACatalogCost^ := ACatalogCost^ + ComponCost; end; end; end; end; // Загрузка ресурсов в таблицу procedure LoadResourcesOnlyToMT(AResources: TSCSResources); var i: Integer; ResourceRel: TSCSResourceRel; Kolvo, Price, Cost: Double; begin MemTable_RResources.Close; MemTable_RResources.Open; for i := 0 to AResources.Count - 1 do begin // отбираем только ресурсы if AResources[i].ServIsResource then begin ResourceRel := AResources[i]; MemTable_RResources.Append; MemTable_RResources.FieldByName('ID').AsInteger := ResourceRel.ID; MemTable_RResources.FieldByName(fnName).AsString := ResourceRel.Name; // Шифр ресурса помещаем в поле ArtProducer (показываем шифр ресурса в поле 'КОД' отчета ) MemTable_RResources.FieldByName(fnArticulProducer).AsString := ResourceRel.Cypher; //ResourceRel.ArtProducer; MemTable_RResources.FieldByName(fnArticulDistributor).AsString := ResourceRel.ArtDistributor; MemTable_RResources.FieldByName(fnProducerName).AsString := TF_Main(GForm).FNormBase.DM.GetStringFromTableByGUID(tnProducers, fnName, ResourceRel.GUIDProducer, qmPhisical); MemTable_RResources.FieldByName(fnIzm).AsString := ResourceRel.Izm; Kolvo := RoundX(ResourceRel.Kolvo, FKolvoPrecision); Price := RoundX(ResourceRel.Price, FPricePrecision); //Округляем стоимость в пределах разумного (до 4 знаков) if ((FKolvoPrecision<4) and (FPricePrecision<4)) then Cost := RoundX(Kolvo * Price, Max(FKolvoPrecision, FPricePrecision) ) else Cost := RoundX(Kolvo*Price,4); MemTable_RResources.FieldByName('Kolvo').AsFloat := Kolvo; MemTable_RResources.FieldByName('Price').AsFloat := Price; MemTable_RResources.FieldByName('Cost').AsFloat := Cost; MemTable_RResources.Post; TotalCost := TotalCost + Cost; end; end; MemTable_RResources.SortOn(fnName, []); end; procedure ObjectstsToMT(ACatalog: TSCSCatalog; ALevel: Integer=-1; AParentCatalogCost: PDouble=nil); var i: Integer; Catalog: TSCSCatalog; Nat: String; Color: Integer; PositionType: Integer; CatalogCost: Double; begin PositionType := ptEndGroup; //ptGroup; CatalogCost := 0; if ALevel >= 0 then begin Nat := ''; //ptGroup = 1; //ptEndGroup = 2; //ptCompon = 3; //ptGroupTotal = 4; //ptBreak = 5; // Если есть компоненты, тогда раздел, иначе глава if ACatalog.SCSComponents.Count > 0 then begin //PositionType := ptEndGroup; Nat := cBaseCommon74; end else begin //PositionType := ptGroup; Nat := cBaseCommon73; end; // Цвет группы Color := clNone; if ALevel < LevelColors.Count then begin Color := LevelColors[ALevel]; PositionType := ptGroup; end; //Tolik 03/04/2022 -- заголовки типа секйи и глав - тоже убрать ... //AddRecoToMT(IntToStrF(ACatalog.MarkID, 2), Nat, '', ACatalog.Name, 0, 0, 0, Color, PositionType); // CatalogComponsToMT(ACatalog, @CatalogCost); end; // Загружаем подкаталоги for i := 0 to ACatalog.ChildCatalogs.Count - 1 do begin Catalog := ACatalog.ChildCatalogs[i]; //CatalogComponsToMT(Catalog); ObjectstsToMT(Catalog, ALevel+1, @CatalogCost); end; if ALevel >= 0 then begin // Итого группы //Tolik 03/04/2022 -- все итоги отсюда нах //AddRecoToMT('', '', '', IntToStrF(ACatalog.MarkID, 2), 0, 0, CatalogCost, clNone, ptGroupTotal); // // Черная полоска //Tolik 18/02/2022 -- Здесь Рома сказа сделать белую полоску //AddRecoToMT('', '', '', '', 0, 0, 0, clBlack, ptBreak); //AddRecoToMT('', '', '', '', 0, 0, 0, clWhite, ptBreak); // end else begin // Общее итого // commented by Tolik, потому что считать общие суммы будем в отчете // AddRecoToMT('', '', '', cRepMsg32, 0, 0, CatalogCost, clNone, ptGroupTotal); end; if AParentCatalogCost <> nil then AParentCatalogCost^ := AParentCatalogCost^ + CatalogCost; end; begin //Tolik 26/02/2022 -- FPricePrecision := 2; FKolvoPrecision := 2; // //Tolik 12/11/2019 -- OldTick := GetTickCount; CableIdsList := nil; // MemTable_RResources.Close; MemTable_RResources.Open; MemTable_RNorms.Close; MemTable_RNorms.Open; DefinePrecisions; // Получить точность цены и количества ProjectOwner := nil; if cbCanHaveSupplyValue.Checked then ProjectOwner := ACatalog.GetProject; try if FmtCommerceInvoice = nil then begin //Tolik // по типу сети INeedNormsRecources :=True; // FmtCommerceInvoice := TkbmMemTable.Create(Self); FmtCommerceInvoice.Name := 'FmtCommerceInvoice'; FdsrcCommerceInvoice := TDataSource.Create(Self); FdsrcCommerceInvoice.Name := 'FdsrcCommerceInvoice'; FdsrcCommerceInvoice.DataSet := FmtCommerceInvoice; FmtCommerceInvoice.FieldDefs.Add(fnID, ftAutoInc); FmtCommerceInvoice.FieldDefs.Add(fnCode, ftString, 255); FmtCommerceInvoice.FieldDefs.Add(fnNat, ftString, 255); FmtCommerceInvoice.FieldDefs.Add(fnUOM, ftString, 255); FmtCommerceInvoice.FieldDefs.Add(fnName, ftString, 255); //15.08.2012 FmtCommerceInvoice.FieldDefs.Add(fnQt, ftFloat); //15.08.2012 FmtCommerceInvoice.FieldDefs.Add(fnPrice, ftFloat); //15.08.2012 FmtCommerceInvoice.FieldDefs.Add(fnCost, ftFloat); FmtCommerceInvoice.FieldDefs.Add(fnQt, ftString, 255); FmtCommerceInvoice.FieldDefs.Add(fnPrice, ftString, 255); FmtCommerceInvoice.FieldDefs.Add(fnCost, ftString, 255); // ServFields FmtCommerceInvoice.FieldDefs.Add(fnColor, ftInteger); FmtCommerceInvoice.FieldDefs.Add(fnPosType, ftInteger); //FmtCommerceInvoice.FieldDefs.Add(fnCharterLevel, ftInteger); //FmtCommerceInvoice.FieldDefs.Add(fnIsCharter, ftBoolean); //FmtCommerceInvoice.FieldDefs.Add(fnIsTotal, ftBoolean); end; FmtCommerceInvoice.Active := false; FmtCommerceInvoice.Active := true; // RootCatalog := CreateCatalogContainer; // LookedWholeID := TIntList.Create; // GroupComponList := TSCSComponents.Create(false); // групповые кобъекты будут удаляться из каталогов // LevelColors := TIntList.Create; // try // CatalogWithNoDefined := nil; // MaxPathLen := 0; // for i := 0 to ACatalog.ComponentReferences.Count - 1 do // begin // Compon := ACatalog.ComponentReferences[i]; // // Можем ли использовать этот компонент по параметрам // if ((Compon.Isline = biFalse) or (LookedWholeID.IndexOf(Compon.Whole_ID) = -1)) and // CheckCanLookComponInReportRsrc(Compon, AReportItemParamValues.CanHaveActiveComponents=biTrue, // AReportItemParamValues.CanHaveDismountAccount=biTrue) then // begin // GroupCompon := GetGrpCompon(Compon); // // if GroupCompon = nil then // begin // GroupCompon := TSCSComponent.Create(GForm); // GroupCompon.AssignOnlyComponent(Compon); // GroupCompon.Length := 0; // if CheckPriceTransformToUOMByCompType(@GroupCompon.ComponentType) then // GroupCompon.Izm := GetNameUOM(umMetr, true); // // CatalogOwnerPathID := nil; // ComponIDNB := TF_Main(GForm).FNormBase.DM.GetIntFromTableByGUID(tnComponent, fnID, Compon.GuidNB, qmPhisical); // if ComponIDNB <> 0 then // CatalogOwnerPathID := GetComponCatalogOwnerPathIDByLevel(ComponIDNB, 0, TF_Main(GForm).FNormBase.DM.Query_Select); // // Если есть папка в НБ, то кидаем в объект этой папки // if (CatalogOwnerPathID <> nil) and (CatalogOwnerPathID.Count > 0) then // begin // ComponCatalog := CatalogPathIDToObject(CatalogOwnerPathID); // //ComponCatalog.SCSComponents.Add(Compon); // // ComponCatalog.AddComponentToList(GroupCompon); // end // else // // Иначе кидаем в спец. папку с компонентами которых нету в НБ // begin // if CatalogWithNoDefined = nil then // begin // CatalogWithNoDefined := CreateCatalogContainer; // CatalogWithNoDefined.Name := cResourceReport_Msg43; // CatalogWithNoDefined.AddComponentToList(GroupCompon); // end; // end; // GroupComponList.Add(GroupCompon); // end; // GroupCompon.Length := GroupCompon.Length + GetComponQuantityByParams(Compon, AReportItemParamValues.CanHaveDismountAccount=biTrue); // // // Запоминаем кабель // if (Compon.Isline = biTrue) and (Compon.Whole_ID <> 0) then // LookedWholeID.Add(Compon.Whole_ID); // end; // end; // RemoveTopCommonObjects; // RootCatalog.AddChildCatalogToList(CatalogWithNoDefined); // // // Определяем коды (номера папок) по уровням // GenCatalogNum := -1; // Catalogs := TSCSCatalogs.Create(false); // Catalogs.Add(RootCatalog); // DefineCatalogCodes(Catalogs); // FreeAndNil(Catalogs); // // // Цвета BGR - blue green red // LevelColors.Add($FFCC99); // LevelColors.Add($CCFFCC); // //LevelColors.Add($CCFFFF); // // // насыпаем MemTable // ObjectstsToMT(RootCatalog); // finally // FreeAndNil(LevelColors); // FreeAndNil(GroupComponList); // FreeAndNil(LookedWholeID); // FreeAndNil(RootCatalog); // end; RootCatalog := PrepareCommerceInvoiceObjects(ACatalog, AParams, AReportItemParamValues); LevelColors := TIntList.Create; try // Цвета BGR - blue green red LevelColors.Add($FFCC99); // $FFCC99 LevelColors.Add($CCFFCC); // $CCFFCC //Tolik 03/11/2020 -- // если учитывать поставочные величины - просчитать наперед количество кабеля в поставочных величинах ... if cbCanHaveSupplyValue.Checked then begin if not cbNone.Checked then begin CableIdsList := TIntList.Create; if ReelsCableFlow <> nil then ReelsCableFlow.Clear else // нет строк для отчета - создаем пустой список () ReelsCableFlow := TStringList.Create; if Length(CableTypes) > 0 then FreeCableTypes(CableTypes); SetLength(CableTypes, 0); for i := 0 to aCatalog.ComponentReferences.Count - 1 do begin SCSComponent := aCatalog.ComponentReferences[i]; if isCableComponent(SCSComponent) then begin if CableIdsList.IndexOf(SCSComponent.Whole_ID) = -1 then begin SCSComponent.LoadWholeLength; CableTypesAdd(SCSComponent, CableTypes, CableIdsList, SCSComponent.ID, Self); CableIdsList.Add(SCSComponent.Whole_ID); end; end; end; if cbMaxScrapRate.Checked then CableReelCalculate(CableTypes, 'MaxScrapRate',ReelsCableFlow, Self); if cbMaxEfficiency.Checked then CableReelCalculate(CableTypes, 'MaxEfficiency',ReelsCableFlow, Self); //CableReelNamesToMemTable(MemTable_RCable ,CableTypes); end; // если нет - сбросим результаты предидущих расчетов, // в случае наличия таковых if cbMaxEfficiency.Checked then begin end else if cbMaxScrapRate.Checked then; end; // // насыпаем MemTable ObjectstsToMT(RootCatalog); IsCanShowResources := IntToBool(AReportItemParamValues.CanShowResources); //ACanShowResources; IsCanShowWorks := IntToBool(AReportItemParamValues.CanShowWorks); //ACanShowWorks; // Если показывать работы, то формируем таблицу значений if IsCanShowWorks then begin // frdbdataset1.Assign(MemTable_RNorms); try if Assigned(ACatalog) then begin // LookedInterfaces := TList.Create; // InterfaceNormList := TList.Create; // GroupedNorms := TSCSNorms.Create(true); FCatalog := ACatalog; BeginProgress(pcPreparingReport); try //GroupedNorms := AFolder.GetAllNormsResources(nrAll, false, ACanHaveActiveComponents, false, true); //24.09.2010 GroupedNorms := AFolder.GetAllNormsResources([nrNorms], false, ACanHaveActiveComponents, false, true); // 21/02/2018 Tolik -- с учетом флажка "учитывать поставочные величины" -- {GroupedNorms := ACatalog.GetAllNormsResources([nrNorms], false, true, false, true, false, true, false, True); ////24.09.2010 aAllowNormPriceForGroup = True} GroupedNorms := ACatalog.GetAllNormsResources([nrNorms], false, true, false, true, false, false, inttobool(AReportItemParamValues.CanHaveSupplyValue), True); //*** Засыпать нормы в MemTable MemTable_RNorms.Active := false; MemTable_RNorms.Active := true; for i := 0 to GroupedNorms.Norms.Count - 1 do begin GroupNorm := GroupedNorms.Norms[i]; MemTable_RNorms.Append; MemTable_RNorms.FieldByName(fnCypher).AsString := GroupNorm.Cypher; MemTable_RNorms.FieldByName(fnName).AsString := GroupNorm.Name; //Tolik 27/02/2022 -- //MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, 2); // MemTable_RNorms.FieldByName(fnIzm).AsString := GroupNorm.Izm_; //24.09.2010 //Tolik 27/02/2022 -- //MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, PrecisionNormKolvo); //MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, 2); MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, 2); // MemTable_RNorms.Post; end; //MemTable_RNorms.SortOn(fnCypher, []); SortMemTableByParams(MemTable_RNorms, AParams, nil); finally EndProgress; FreeAndNil(GroupedNorms); //FreeList(InterfaceNormList); //FreeAndNil(LookedInterfaces); end; end; finally end; end; ////////////////////////////////////////////////////////////////////////////////////////////////////////// finally FreeAndNil(RootCatalog); FreeAndNil(LevelColors); end; // Если показывать ресурсы, то выбираем ресурсы в табличку if IsCanShowResources then begin TotalCost := 0; if Assigned(ACatalog) then begin try FCatalog := ACatalog; ProjectOwner := ACatalog.GetProject; DefinePrecisions; NormResources := nil; BeginProgress(pcPreparingReport); try // Tolik -- 21/02/2018 -- { NormResources := ACatalog.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, IntToBool(AReportItemParamValues.CanHaveActiveComponents), IntToBool(AReportItemParamValues.CanHaveDismountAccount), true, false, true, true);} NormResources := ACatalog.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, IntToBool(AReportItemParamValues.CanHaveActiveComponents), IntToBool(AReportItemParamValues.CanHaveDismountAccount), true, false, true, inttobool(AReportItemParamValues.CanHaveSupplyValue)); // //if ACanHaveSupplyValue or ACanRoundValue then for i := 0 to NormResources.Resources.Count - 1 do begin ResourceRel := NormResources.Resources[i]; ResourceCompon := nil; if Not ResourceRel.ServIsResource then if TSCSResourceGroup(ResourceRel).ObjectList.Count > 0 then if TSCSResourceGroup(ResourceRel).ObjectList[0] is TSCSComponent then begin ResourceCompon := TSCSComponent(TSCSResourceGroup(ResourceRel).ObjectList[0]); end; if ResourceCompon <> nil then begin SprSuppliesKind := nil; // if ACanHaveSupplyValue then if ResourceRel.GUIDSuppliesKind <> '' then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(ResourceRel.GUIDSuppliesKind); //*** Учитывать поставочные велечины if SprSuppliesKind <> nil then begin if CheckIsTradUOM(TF_Main(GForm).FUOM) then begin ResourceRel.Izm := SprSuppliesKind.Data.NameTradUOM; if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin // Для кабелей и каналов в традиционной системы США нужно юзать ФУТЫ ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, umFoot) / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := FloatInUOM(ResourceRel.Price, umFoot, umMetr) * SprSuppliesKind.Data.UnitKolvoTradUOM; end else begin ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvoTradUOM; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvoTradUOM; end; end else begin ResourceRel.Izm := SprSuppliesKind.Data.Name; ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; ResourceRel.Price := ResourceRel.Price * SprSuppliesKind.Data.UnitKolvo; end; ResourceRel.CalcCost; end else begin if CheckPriceTransformToUOMByCompType(@ResourceCompon.ComponentType) then begin ResourceRel.Izm := GetNameUOM(TF_Main(GForm).FUOM, true); if TF_Main(GForm).FUOM <> umMetr then begin ResourceRel.Kolvo := FloatInUOM(ResourceRel.Kolvo, umMetr, TF_Main(GForm).FUOM); ResourceRel.Price := FloatInUOM(ResourceRel.Price, TF_Main(GForm).FUOM, umMetr); ResourceRel.CalcCost; end; end; end; end; //*** Учитывать флаг округления в большую сторону //if ACanRoundValue then if AReportItemParamValues.CanRoundValue = biTrue then begin ResourceRel.Kolvo := RoundUp(ResourceRel.Kolvo); ResourceRel.CalcCost; end; end; MemTable_RResources.Active := false; MemTable_RResources.Active := true; while not MemTable_RResources.Eof do MemTable_RResources.Delete; LoadResourcesOnlyToMT(NormResources.Resources); SortMemTableByParams(MemTable_RResources, AParams, nil); MemTable_RResources.First; finally EndProgress; if NormResources <> nil then FreeAndNil(NormResources); end; except on E: Exception do AddExceptionToLog('TF_ResourceReport.ShowListResourceReport: '+E.Message); end; end; CurrTick := GetTickCount - OldTick; CurrTick := GetTickCount - OldTick; end; GFormMode := AParams.Mode; ShowPreparedReport(AParams); except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowCommerceInvoice', E.Message); end; // Tolik // по типу сети (отключаем) INeedNormsRecources :=True; end; // Tolik // отчет путь кабеля // взят старый за образец и немножко переделан совсем procedure TF_ResourceReport.ShowCablePaths(AParams: TReportItemParams); var //Params: TReportItemParams; Interf: TSCSInterface; i, j, k, l, m: Integer; //Tolik // EndComponents, EndPathListConnected: TObjectList; AllConnectedCompons, ConnectedCompons: TSCSComponents; SCSComponent, currCompon: TSCSComponent; currCable: TSCSComponent; Interfaces: TSCSInterfaces; ComponIndex: integer; ConnectedCable : TSCSComponent; BeginSide, EndSide : integer; FromName : TStringList; InterfName : string; InterfaceFrom, InterFaceTo: integer; // пути и компоненты концов подключения currID: integer; AddInterfaces: boolean; EndPathList, PathList: TCabPaths; DescriptionList: TCabPathInfos; PathListLength, DescriptionListLength: Integer; HasConnection, Passed: Boolean; // присоединен ли кабель к чему-нибудь BeginCompon, EndCompon, BeginCable, EndCable: TSCSComponent; BeginCompons, EndCompons: TSCSComponents; CablesPassed: TSCSComponents; CablePath : TStringList; WasChangedInterFaces, WasChangedBeginEnd: boolean; currInterfaces, AllCableInterFaces : TSCSInterfaces; InterFacesNpp : integer; InterfPos : integer; // позиции интерфейсов (практически - распиновка) s, BeginName, EndName : string; path1 : TInterfPath; InterfacePosition, InterfacePosition1 : TSCSInterfPosition; InterfNames : TStringList; CableBusyInterfaces: integer; BeginCableSide, EndCableSide: integer; //стороны подключения кабеля в начале и в конце (бывает 1 или 2) PosNumber: Integer; BeginPos, EndPos : Integer; WasChanged: Boolean; NameList: TStringList; InterfacePositions : TIntList; // занятые позиции интерфейса HasCableCanals: boolean; PassedPositions: TIntList; BeginPortInfo, EndPortInfo: PortInform; NumPairEqual: Boolean; ComponList: CList; Counter: Integer; ConnectedCables, StrangeCables: TSCSComponents; // Tolik 04/09/2016 -- Side1InterfList, Side2InterfList: TList; Side1CableCompon, Side2CableCompon: TSCSComponent; CanSeekCable : Boolean; ConnectedPosFound: Boolean; ConnectInerfSide1, ConnectInterfSide2 : integer; FCableCatalog: TSCSCatalog; FCableFigure: TOrthoLine; CableWayCompon: TCableWayCompon; FCableNpp: Integer; // количество функциональных интерфейсов кабеля; currNPP: Integer; CableWay : TList; CurrentInterface: TSCSInterface; //InterfPos : TSCSInterfPosition; // // формирует строку из списка чисел Function GetNumberCount(AList : TIntList) : string; Var i,j: Integer; Passed: Boolean; BeginPos, EndPos: Integer; Begin //сортируем список Passed := true; while Passed do begin Passed := false; for i := 0 to AList.Count - 2 do begin if AList[i] > AList[i+1] then begin Passed := true; j := AList[i]; AList[i] := AList[i+1]; AList[i+1] := j; end; end; end; Result := '('; // если портов меньше трех, то выведем по порядку через запятую if AList.Count < 2 then begin for i := 0 to AList.Count - 1 do begin if Result[Length(Result)] <> '(' then Result := Result + ','; Result := Result + inttostr(AList[i]); end; Passed := true; end else // если портов больше трех, смотрим, что можно вывести в сокращенной записи типа(1-3) begin Passed := false; BeginPos := AList[0]; EndPos := AList[0]; for i := 0 to AList.Count - 2 do begin // порты подключены подряд if ((AList[i+1] - EndPos) = 1) then begin inc(EndPos); // Passed := true; end // не подряд - записываем отработанные else begin // если прошли один порт if (BeginPos = EndPos) then begin if Result[Length(Result)] <> '(' then Result := Result + ','; Result := Result + inttostr(BeginPos); Passed := false; end //если прошли несколько портов else begin if Result[Length(Result)] <> '(' then Result := Result + ','; if ((EndPos - BeginPos) > 1) then Result := Result + inttostr(BeginPos) + '-'+inttostr(EndPos) else Result := Result + inttostr(BeginPos) + ','+inttostr(EndPos); Passed := False; end; // следующая позиция BeginPos := AList[i+1]; EndPos := AList[i+1]; Passed := false; end; end; end; if not Passed then begin if (BeginPos = EndPos) then begin if Result[Length(Result)] <> '(' then Result := Result + ',' + inttostr(BeginPos) else Result := Result + inttostr(BeginPos); Passed := false; end //если прошли несколько портов else begin if Result[Length(Result)] <> '(' then Result := Result + ','; if ((EndPos - BeginPos) > 1) then Result := Result + inttostr(BeginPos) + '-'+inttostr(EndPos) else Result := Result + inttostr(BeginPos) + ','+inttostr(EndPos); Passed := False; end; end; Result := Result+')'; End; // Tolik -- 04/09/2016 -- Procedure GetCableWayBySide(aSide, aNpp, ACurrNpp: Integer; aCableCompon: TSCSComponent; aWayListSide: Integer); var i, j, k: Integer; InterfPos, CableInterfPos: TSCSInterfPosition; TempNpp, CurrNpp: Integer; CurrInterface, PointComponInterface, InternalInterface: TSCSInterface; InterfSide: Integer; ConnectedPosFound: Boolean; //CanSeekCable: Boolean; InternalConnection: Boolean; PointCompon, InternalConnectedCompon: TSCSComponent; InternalConnSide: Integer; CanSeekCable: Boolean; // Tolik PassedCableList: TList; // begin PassedCableList := TList.Create; CurrNpp := ACurrNpp; TempNpp := 0; //смещение позиции интерфейса InterfSide := aSide; CanSeekCable := True; ConnectedPosFound := False; InterfPos := Nil; // сброс конечного компонента if aWayListSide = 1 then begin TCableWayCompon(CableWay[aNpp-1]).FirstCompon := nil; TCableWayCompon(CableWay[aNpp-1]).Side1ConnectedInterface := nil; end else if aWayListSide = 2 then begin TCableWayCompon(CableWay[aNpp-1]).LastCompon := nil; TCableWayCompon(CableWay[aNpp-1]).Side2ConnectedInterface := nil; end; // определить позицию жилы for j := 0 to aCableCompon.Interfaces.Count - 1 do begin CurrInterface := TSCSInterface(aCableCompon.Interfaces[j]); //if (CurrInterface.TypeI = itFunctional) and (CurrInterface.Side = ConnectInerfSide1) then if (CurrInterface.TypeI = itFunctional) and (CurrInterface.Side = aSide) then begin if ((CurrInterface.IsBusy = biTrue) or (CurrInterface.BusyPositions.Count > 0)) then begin for k := 0 to CurrInterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(CurrInterface.BusyPositions[k]); if (((InterfPos.FromPos + TempNpp) <= ACurrNpp) and ((InterfPos.ToPos + TempNpp) >= ACurrNpp)) then begin ConnectedPosFound := True; CableInterfPos := InterfPos; InterfPos := InterfPos.GetConnectedPos; break; end; end; if ConnectedPosFound then Break; //// BREAK //// end; TempNpp := TempNpp + CurrInterface.Kolvo; end; end; if ConnectedPosFound then begin InternalInterface := nil; if ((InterfPos.InterfOwner.ComponentOwner <> nil) and (InterfPos.InterfOwner.ComponentOwner.isLine = biFalse)) then begin InternalConnection := False; PointComponInterface := TSCSInterface(InterfPos.InterfOwner); // прописать конец пути (пришли на поинт) if aWayListSide = 1 then begin TCableWayCompon(CableWay[aNpp-1]).FirstCompon := PointComponInterface.ComponentOwner; TCableWayCompon(CableWay[aNpp-1]).Side1ConnectedInterface := InterfPos.InterfOwner; end else if aWayListSide = 2 then begin TCableWayCompon(CableWay[aNpp-1]).LastCompon := PointComponInterface.ComponentOwner; TCableWayCompon(CableWay[aNpp-1]).Side2ConnectedInterface := InterfPos.InterfOwner; end; // если это проходящее соединение -- TempNpp := 0; for i := 0 to PointComponInterface.InternalConnected.Count - 1 do begin InternalInterface := TSCSInterface(PointComponInterface.InternalConnected[i]); if ((TempNpp <= ACurrNpp) and ((InternalInterface.Kolvo + TempNpp) >= ACurrNpp)) then begin //ShowMessage('InternalConnection Found on ' + PointComponInterface.ComponentOwner.Name); break; end else begin CurrNpp := CurrNpp - InternalInterface.Kolvo; TempNpp := TempNpp + InternalInterface.Kolvo; end; end; end; if InternalInterface <> nil then begin TempNpp := 0; if InternalInterface.Kolvo > InterfPos.InterfOwner.Kolvo then begin for i := 0 to InternalInterface.InternalConnected.Count - 1 do begin if InternalInterface.InternalConnected[i] <> InterfPos.InterfOwner then begin TempNpp := TempNpp + InternalInterface.InternalConnected[i].Kolvo; end else begin CurrNpp := currNpp + TempNpp; TempNpp := 0; Break; //// BREAK ////; end; end; end; // определить позицию пришедшего интерфейса по отношению к подключенному через точку for i := 0 to InternalInterface.BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(InternalInterface.BusyPositions[i]); if (InterfPos.FromPos <= CurrNpp) and (InterfPos.ToPos >= currNpp) then begin InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin InterNalConnectedCompon := InterfPos.InterfOwner.ComponentOwner; if ((InternalConnectedCompon <> nil) and IsCableComponent(InternalConnectedCompon)) then begin if InterfPos.InterfOwner.Side = 1 then InternalConnSide := 2 else if InterfPos.InterfOwner.Side = 2 then InternalConnSide := 1; // вписать путь if aWayListSide = 1 then begin TCableWayCompon(CableWay[aNpp - 1]).WayList.Insert(0, TCableWayCompon(CableWay[aNpp - 1]).FirstCompon); TCableWayCompon(CableWay[aNpp - 1]).FirstCompon := nil; TCableWayCompon(CableWay[aNpp - 1]).Side1ConnectedInterface := Nil; TCableWayCompon(CableWay[aNpp - 1]).WayList.Insert(0, InterNalConnectedCompon); end else if aWayListSide = 2 then begin TCableWayCompon(CableWay[aNpp - 1]).WayList.Add(TCableWayCompon(CableWay[aNpp - 1]).LastCompon); TCableWayCompon(CableWay[aNpp - 1]).LastCompon := nil; TCableWayCompon(CableWay[aNpp - 1]).Side2ConnectedInterface := Nil; TCableWayCompon(CableWay[aNpp - 1]).WayList.Add(InterNalConnectedCompon); end; CanSeekCable := True; while CanSeekCable do begin CanSeekCable := False; for j := 0 to InterNalConnectedCompon.Interfaces.Count - 1 do begin if (TSCSInterface(InterNalConnectedCompon.Interfaces[j]).TypeI = itFunctional) and (TSCSInterface(InterNalConnectedCompon.Interfaces[j]).Side = InternalConnSide) and ((TSCSInterface(InterNalConnectedCompon.Interfaces[j]).isBusy = biTrue) or ((TSCSInterface(InterNalConnectedCompon.Interfaces[j]).BusyPositions.Count > 0 ))) then begin InterfPos := TSCSInterfPosition(TSCSInterface(InterNalConnectedCompon.Interfaces[j]).BusyPositions[0]); InterfPos := InterfPos.GetConnectedPos; if InterfPos <> nil then begin // присоединен кабель if IsCableComponent(InterfPos.InterfOwner.ComponentOwner) then begin //сторона для последующего соединения if InterfPos.InterfOwner.Side = 1 then InternalConnSide := 2 else if InterfPos.InterfOwner.Side = 2 then InternalConnSide := 1; // переопределяем текущий кабель InterNalConnectedCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); // вписать путь if aWayListSide = 1 then TCableWayCompon(CableWay[aNpp -1]).WayList.Insert(0, InterNalConnectedCompon) else if aWayListSide = 2 then TCableWayCompon(CableWay[aNpp -1]).WayList.Add(InterNalConnectedCompon); CanSeekCable := True; Break; //// BREAK //// end // дошли до точки else begin if TSCSComponent(InterfPos.InterfOwner.ComponentOwner).isLine = biFalse then begin // точка PointCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); if aWayListSide = 1 then begin TCableWayCompon(CableWay[aNpp -1]).FirstCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); TCableWayCompon(CableWay[aNpp -1]).Side1ConnectedInterface := InterfPos.InterfOwner; end else if aWayListSide = 2 then begin TCableWayCompon(CableWay[aNpp -1]).LastCompon := TSCSComponent(InterfPos.InterfOwner.ComponentOwner); TCableWayCompon(CableWay[aNpp -1]).Side2ConnectedInterface := InterfPos.InterfOwner; end; CanSeekCable := False; Break; //// BREAK //// end; end; end; end; end; end; // GetCableWayBySide(aSide, aNpp, CurrNpp, InterNalConnectedCompon, aWayListSide); GetCableWayBySide(InternalConnSide, aNpp, CurrNpp, InterNalConnectedCompon, aWayListSide); end; end; end; end; end; end; PassedCableList.Free; end; //Tolik 05/09/2016 -- Procedure SortWayList; var i: Integer; CanSort: Boolean; CurrWay: TCableWayCompon; begin CanSort := True; while CanSort do begin CanSort := False; for i := (CableWay.Count - 1) downto 1 do begin if (TCableWayCompon(CableWay[i-1]).FirstCompon = nil) and (TCableWayCompon(CableWay[i-1]).LastCompon = nil) and ((TCableWayCompon(CableWay[i]).FirstCompon <> nil) or (TCableWayCompon(CableWay[i]).LastCompon <> nil)) then begin CurrWay := TCableWayCompon(CableWay[i]); CableWay[i] := CableWay[i - 1]; CableWay[i] := CurrWay; Cansort := True; break; end; end; end; end; Procedure PackWayList; Var i, j, TempVal: Integer; CanPack: Boolean; CurrWay: TCableWayCompon; CanSort: Boolean; begin CanPack := True; // слить до кучи одинаковые if CableWay.Count > 1 then begin CurrWay := TCableWayCompon(CableWay[CableWay.Count - 1]); for i := (CableWay.Count - 2) downto 0 do begin if (CurrWay.FirstCompon = TCableWayCompon(CableWay[i]).FirstCompon) and (CurrWay.LastCompon = TCableWayCompon(CableWay[i]).LastCompon) and (CurrWay.WayList.Count = TCableWayCompon(CableWay[i]).WayList.Count) then begin CanPack := True; for j := 0 to CurrWay.WayList.Count - 1 do begin if TSCSComponent(CurrWay.WayList[j]).ID <> TSCSComponent(TCableWayCompon(CableWay[i]).WayList[j]).Id then begin CanPack := False; Break; //// BREAK ////; end; end; if CanPack then begin TCableWayCompon(CableWay[i]).Passed := True; // CurrWay.GroupedNpp := CurrWay.GroupedNpp + ',' + IntToStr(TCableWayCompon(CableWay[i]).Npp); if CurrWay.GroupedNpp.IndexOf(TCableWayCompon(CableWay[i]).Npp) = -1 then CurrWay.GroupedNpp.Add(TCableWayCompon(CableWay[i]).Npp); end; end else CurrWay := TCableWayCompon(CableWay[i]); end; // удалить лишние for i := CableWay.Count - 1 downto 0 do begin if TCableWayCompon(CableWay[i]).Passed then begin CurrWay := TCableWayCompon(CableWay[i]); FreeAndNil(CurrWay); CableWay.Delete(i); end; end; // сортануть номера интерфейсов и портов for i := 0 to CableWay.Count - 1 do begin if TCableWayCompon(CableWay[i]).GroupedNpp.Count > 1 then begin CanSort := True; while CanSort do begin CanSort:= False; for j := 0 to TCableWayCompon(CableWay[i]).GroupedNpp.Count - 2 do begin if TCableWayCompon(CableWay[i]).GroupedNpp[j] > TCableWayCompon(CableWay[i]).GroupedNpp[j+1] then begin CanSort := True; TempVal := TCableWayCompon(CableWay[i]).GroupedNpp[j]; TCableWayCompon(CableWay[i]).GroupedNpp[j] := TCableWayCompon(CableWay[i]).GroupedNpp[j+1]; TCableWayCompon(CableWay[i]).GroupedNpp[j+1] := TempVal; end; end; end; end; end; end; end; //6/09/2016 -- Procedure SaveWayListToTables; var i, j, k, l, m, ParentID: Integer; TempCableWayCompon, currCableWayCompon: TCableWayCompon; ComponName: String; ParentCompon: TSCSComponent; s: String; CanSave: Boolean; Side1ComponList, Side2ComponList: TList; Side1InterfList, Side2InterfList: TList; CableInterfCount: Integer; SavedPosCount: Integer; SaveList: TList; EqualCableWay: Boolean; TopCompon1, TopCompon2: TSCSComponent; List1, List2, List3, List4: TList; CableInterfList, Side1PortList, Side2PortList: TIntList; Side1PortNameList, Side2PortNameList: TStringList; TempPortList: TIntList; // для сборки MasterId: Integer;//для связки InterfGuideList: TStringList; // список идентификаторов интерфейсов в кабеле TempList: TList; PortListString1, PortListString2: string; PortNameList1, PortNameList2: TStringList; CanLookPort: Boolean; ComponInterfList: TIntList; ComponInterfCount: Integer; Function IsEqualWay(aCompon1, aCompon2: TCableWayCompon): Boolean; var i: Integer; begin Result := True; if (aCompon1.CableInterface.GUIDInterface <> aCompon2.CableInterface.GUIDInterface) or (aCompon1.WayList.Count <> aCompon2.WayList.Count) then begin Result := False; exit; end; for i := 0 to aCompon1.WayList.Count - 1 do begin if TSCSComponent(aCompon1.WayList[i]).ID <> TSCSComponent(aCompon2.WayList[i]).ID then begin Result := False; Break; //// BREAK ////; end; end; end; begin // инициализация списков (чтобы не проебать) Side1ComponList := nil; Side2ComponList := nil; Side1InterfList := nil; Side2InterfList := nil; SaveList := nil; List1 := nil; List2 := nil; List3 := nil; List4 := nil; CableInterfList := nil; Side1PortList := nil; Side2PortList := nil; Side1PortNameList := nil; Side2PortNameList := nil; TempPortList := nil; InterfGuideList := nil; TempList := nil; PortNameList1 := nil; PortNameList2 := nil; ComponInterfList := nil; // если расключать интерфейсы кабеля if cbCablePathShowConnInSeparatePaths.Checked then begin for i := 0 to CableWay.Count - 1 do begin currCableWayCompon := TCableWayCompon(CableWay[i]); FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := i+1; FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + ' ' + '('+ Inttostr(i+1) + ')'; FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; if currCableWayCompon.FirstCompon <> nil then begin if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.FirstCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 // + currCableWayCompon.FirstCompon.GetNameForVisible(false) else s := {currCableWayCompon.FirstCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 +} currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false) + #13#10; //currCableWayCompon.FirstCompon.GetNameForVisible(False); if (currCableWayCompon.Side1ConnectedInterface <> nil) and (currCableWayCompon.Side1ConnectedInterface.PortOwner <> nil) then s := s + currCableWayCompon.Side1ConnectedInterface.PortOwner.LoadName+ ' ('+Inttostr(currCableWayCompon.Side1ConnectedInterface.PortOwner.NppPort) + ')'+ #13#10; FmtCablePaths.FieldByName(fnNameFrom).AsString := s; end else FmtCablePaths.FieldByName(fnNameFrom).AsString := cRepMsg270; if currCableWayCompon.LastCompon <> nil then begin if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.LastCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 // + currCableWayCompon.LastCompon.GetNameForVisible(False) else s := {currCableWayCompon.LastCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 +} currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false) + #13#10; //currCableWayCompon.LastCompon.GetNameForVisible(False); if (currCableWayCompon.Side2ConnectedInterface <> nil) and (currCableWayCompon.Side2ConnectedInterface.PortOwner <> nil) then s := s + currCableWayCompon.Side2ConnectedInterface.PortOwner.LoadName+ ' ('+Inttostr(currCableWayCompon.Side2ConnectedInterface.PortOwner.NppPort) + ')'+ #13#10; FmtCablePaths.FieldByName(fnNameTo).AsString := s; end else FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg270; FmtCablePaths.Post; if currCableWayCompon.FirstCompon <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := i+1; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; // FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 1; ComponName := currCableWayCompon.FirstCompon.GetNameForVisible(False); ParentCompon := currCableWayCompon.FirstCompon.GetParentComponent; While ParentCompon <> nil do begin ComponName := ParentCompon.GetNameForVisible(False) + ' / ' + ComponName; ParentCompon := ParentCompon.GetParentComponent; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; for j := 0 to currCableWayCompon.WayList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := i+1; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; // FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 1; ComponName := TSCSComponent(currCableWayCompon.WayList[j]).GetNameForVisible(False); if IsCableComponent(TSCSComponent(currCableWayCompon.WayList[j])) then begin if cbCablePathShowCableCanals.Checked then begin if TSCSComponent(currCableWayCompon.WayList[j]).GetParentComponent <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[j]).GetParentComponent.GetNameForVisible(false) + ' / ' + ComponName; end; if cbCablePathShowObjName.Checked then begin if TSCSComponent(currCableWayCompon.WayList[j]).GetFirstParentCatalog <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[j]).GetFirstParentCatalog.GetNameForVisible(False) + ' / ' + ComponName; end; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; if currCableWayCompon.LastCompon <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := i+1; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; // FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 1; ComponName := currCableWayCompon.LastCompon.GetNameForVisible(False); ParentCompon := currCableWayCompon.LastCompon.GetParentComponent; While ParentCompon <> nil do begin ComponName := ParentCompon.GetNameForVisible(False) + ' / ' + ComponName; ParentCompon := ParentCompon.GetParentComponent; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end end; // сбросить путь for i := (CableWay.Count - 1) downto 0 do begin currCableWayCompon := TCableWayCompon(CableWay[i]); CableWay.Delete(i); FreeAndNil(currCableWayCompon); end; FreeAndNil(CableWay); end else // не расключать интерфейсы кабеля begin List1 := TList.Create; // point - to - point List2 := TList.Create; // Point - to - Nil List3 := TList.Create; // Nil - To - Point List4 := TList.Create; // Nil - to - Nil // разбить по типам конечных подключений for i := 0 to CableWay.Count - 1 do begin if (TCableWayCompon(CableWay[i]).FirstCompon <> nil) and (TCableWayCompon(CableWay[i]).LastCompon <> nil) then List1.Add(TCableWayCompon(CableWay[i])) else if (TCableWayCompon(CableWay[i]).FirstCompon <> nil) and (TCableWayCompon(CableWay[i]).LastCompon = nil) then List2.Add(TCableWayCompon(CableWay[i])) else if (TCableWayCompon(CableWay[i]).FirstCompon = nil) and (TCableWayCompon(CableWay[i]).LastCompon <> nil) then List3.Add(TCableWayCompon(CableWay[i])) else if (TCableWayCompon(CableWay[i]).FirstCompon = nil) and (TCableWayCompon(CableWay[i]).LastCompon = nil) then List4.Add(TCableWayCompon(CableWay[i])); end; // сложить то, что получилось CableInterfList := TIntList.Create; Side1PortList := TIntList.Create; Side2PortList := TIntList.Create; Side1PortNameList := TStringList.Create; Side2PortNameList := TStringList.Create; TempPortList := TIntList.Create; // для сборки MasterId := 1; InterfGuideList := TStringList.Create; TempList := TList.Create; PortNameList1 := TStringList.Create; PortNameList2 := TstringList.Create; Side1ComponList := TList.Create; Side2ComponList := TList.Create; ComponInterfList := TIntList.Create; // PointToPoint if List1.Count > 0 then begin CanSave := True; for i := 0 to List1.Count - 1 do begin if InterfGuideList.IndexOf(TCableWayCompon(List1[i]).CableInterface.GUIDInterface) = -1 then InterfGuideList.Add(TCableWayCompon(List1[i]).CableInterface.GUIDInterface); end; While CanSave do begin CanSave := False; for i := 0 to InterfGuideList.Count - 1 do begin currCableWayCompon := Nil; for j := 0 to List1.Count - 1 do begin if (not TCableWayCompon(List1[j]).Passed) and (TCableWayCompon(List1[j]).CableInterface.GUIDInterface = InterfGuideList[i]) then begin currCableWayCompon := TCableWayCompon(List1[j]); TCableWayCompon(List1[j]).Passed := True; Break; //// BREAK ////; end; end; if currCableWayCompon <> nil then begin CanSave := True; TempList.Clear; TempList.Add(currCableWayCompon); for j := 0 to List1.Count - 1 do begin if (not TCableWayCompon(List1[j]).Passed) and IsEqualWay(currCableWayCompon, List1[j]) then begin TCableWayCompon(List1[j]).Passed := true; TempList.Add(TCableWayCompon(List1[j])); end; end; TempPortList.Clear; PortNameList1.Clear; PortNameList2.Clear; PortListString1 := ''; PortListString2 := ''; // порты (для верхнего компонента) for j := 0 to TempList.Count - 1 do begin // порты (сторона 1) s := ''; if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1.IndexOf(s) = -1 then PortNameList1.Add(s); end; // порты (сторона 2) s := ''; if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2.IndexOf(s) = -1 then PortNameList2.Add(s); end; end; Side1PortList.Clear; Side2PortList.Clear; // side1 for k := 0 to PortNameList1.Count - 1 do begin for j := 0 to TempList.Count - 1 do begin if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.LoadName; if (s = PortNameList1[k]) and (Side1PortList.IndexOf(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort)= -1) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort); end; end; if PortListString1 = '' then PortListString1 := PortListString1 + ' ' + PortNameList2[k] + GetNumberCount(Side1PortList) else PortListString1 := PortListString1 + ',' + ' ' + PortNameList2[k] + GetNumberCount(Side1PortList); Side1PortList.Clear; end; // side2 for k := 0 to PortNameList2.Count - 1 do begin for j := 0 to TempList.Count - 1 do begin if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.LoadName; if (s = PortNameList2[k]) and (Side2PortList.IndexOf(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort)= -1) then Side2PortList.Add(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort); end; end; if PortListString2 = '' then PortListString2 := PortListString2 + ' ' + PortNameList2[k] + GetNumberCount(Side2PortList) else PortListString2 := PortListString2 + ',' + ' ' + PortNameList2[k] + GetNumberCount(Side2PortList); Side2PortList.Clear; end; for j := 0 to TempList.Count - 1 do begin // порты (сторона 1) if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort); // порты (сторона 2) if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort); // пины кабеля TempPortList.Add(TCableWayCompon(TempList[j]).Npp); end; currCableWayCompon := TCableWayCompon(TempList[0]); TopCompon1 := currCableWayCompon.FirstCompon.GetTopComponent; TopCompon2 := currCableWayCompon.LastCompon.GetTopComponent; // ЗАПИСЬ // заголовок FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + ' ' + IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; s := ''; if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.FirstCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 else s := currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false) + #13#10; s := s + PortListString1; FmtCablePaths.FieldByName(fnNameFrom).AsString := s; if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.LastCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 // + currCableWayCompon.LastCompon.GetNameForVisible(False) else s := currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false) + #13#10; s := s + PortListString2; FmtCablePaths.FieldByName(fnNameTo).AsString := s; FmtCablePaths.Post; // путь // компоненты сторон Side1ComponList.Clear; Side2ComponList.Clear; for j := 0 to TempList.Count - 1 do begin if Side1ComponList.IndexOf(TCableWayCompon(TempList[j]).FirstCompon) = -1 then Side1ComponList.Add(TCableWayCompon(TempList[j]).FirstCompon); if Side2ComponList.IndexOf(TCableWayCompon(TempList[j]).LastCompon) = -1 then Side2ComponList.Add(TCableWayCompon(TempList[j]).LastCompon); end; // вкатать в таблицу начальные компоненты for k := 0 to Side1ComponList.Count - 1 do begin ComponInterfList.Clear; ComponInterfCount := 0; // жилы, подключенные к компоненту for j := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[j]).FirstCompon.ID = TSCSComponent(Side1ComponList[k]).ID then begin Inc(ComponInterfCount); if ComponInterfList.IndexOf(TCableWayCompon(TempList[j]).Npp) = -1 then ComponInterfList.Add(TCableWayCompon(TempList[j]).Npp); end; end; // определить порты компонента, подключенные к жилам Side1PortList.Clear; PortNameList1.Clear; // наименования портов for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1.IndexOf(s) = -1 then PortNameList1.Add(s); end; end; end; end; // формируем наименование + нумерация PortListString1 := ''; for m := 0 to PortNameList1.count - 1 do begin for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1[m] = s then if Side1PortList.IndexOf(TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.NppPort) = -1 then Side1PortList.Add(TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.NppPort); end; end; end; end; if PortListString1 = '' then PortListString1 := PortListString1 + s + GetNumberCount(Side1PortList) else PortListString1 := PortListString1 + ', ' + s + GetNumberCount(Side1PortList); Side1PortList.Clear; end; FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := ComponInterfCount; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; TopCompon1 := TSCSComponent(Side1ComponList[k]); ComponName := TSCSComponent(Side1ComponList[k]).GetNameForVisible(False); if TopCompon1 <> nil then begin while not TopCompon1.IsTop do begin TopCompon1 := TopCompon1.GetParentComponent; if TopCompon1 <> nil then begin if not TopCompon1.IsTop then ComponName := TopCompon1.GetNameForVisible(false) + '/' + ComponName; end else Break; //// BREAK //// end; end; if PortListString1 = '' then FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName else FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName + ' ' + PortListString1; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' '; // currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; // вкатать путь -- кабель с транзитными компонентами for k := 0 to currCableWayCompon.WayList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetNameForVisible(False); if IsCableComponent(TSCSComponent(currCableWayCompon.WayList[k])) then begin if cbCablePathShowCableCanals.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent.GetNameForVisible(false) + ' / ' + ComponName; end; if cbCablePathShowObjName.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog.GetNameForVisible(False) + ' / ' + ComponName; end; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList) + ' ' + ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' ';{IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList) + ' ' + ComponName;} FmtCablePathsInfo.Post; end; // вкатать конечные компоненты for k := 0 to Side2ComponList.Count - 1 do begin ComponInterfList.Clear; ComponInterfCount := 0; for j := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[j]).LastCompon.ID = TSCSComponent(Side2ComponList[k]).ID then begin Inc(ComponInterfCount); if ComponInterfList.IndexOf(TCableWayCompon(TempList[j]).Npp) = -1 then ComponInterfList.Add(TCableWayCompon(TempList[j]).Npp); end; end; // определить порты компонента, подключенные к жилам Side2PortList.Clear; PortNameList2.Clear; // наименования портов for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2.IndexOf(s) = -1 then PortNameList2.Add(s); end; end; end; end; // формируем наименование + нумерация PortListString2 := ''; for m := 0 to PortNameList2.count - 1 do begin for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2[m] = s then if Side2PortList.IndexOf(TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.NppPort) = -1 then Side2PortList.Add(TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.NppPort); end; end; end; end; if PortListString2 = '' then PortListString2 := PortListString2 + s + GetNumberCount(Side2PortList) else PortListString2 := PortListString2+ ', ' + s + GetNumberCount(Side2PortList); Side2PortList.Clear; end; FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponName := TSCSComponent(Side2ComponList[k]).GetNameForVisible(False); TopCompon2 := TSCSComponent(Side2ComponList[k]); if TopCompon2 <> nil then begin while not TopCompon2.IsTop do begin TopCompon2 := TopCompon2.GetParentComponent; if TopCompon2 <> nil then begin if not TopCompon2.IsTop then ComponName := TopCompon2.GetNameForVisible(false) + '/' + ComponName; end else Break; //// BREAK //// end; end; if PortListString2 = '' then FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName else FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName + ' ' + PortListString2; // FmtCablePathsInfo.FieldByName(fnDescription).AsString := ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' '; {inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName;} FmtCablePathsInfo.Post; end; Inc(MasterId); end; end; end; end else FreeAndNil(List1); //PointToNil if List2.Count > 0 then begin CanSave := True; for i := 0 to List2.Count - 1 do begin if InterfGuideList.IndexOf(TCableWayCompon(List2[i]).CableInterface.GUIDInterface) = -1 then InterfGuideList.Add(TCableWayCompon(List2[i]).CableInterface.GUIDInterface); end; While CanSave do begin CanSave := False; for i := 0 to InterfGuideList.Count - 1 do begin currCableWayCompon := Nil; for j := 0 to List2.Count - 1 do begin if (not TCableWayCompon(List2[j]).Passed) and (TCableWayCompon(List2[j]).CableInterface.GUIDInterface = InterfGuideList[i]) then begin currCableWayCompon := TCableWayCompon(List2[j]); TCableWayCompon(List2[j]).Passed := True; Break; //// BREAK ////; end; end; if currCableWayCompon <> nil then begin CanSave := True; TempList.Clear; TempList.Add(currCableWayCompon); for j := 0 to List2.Count - 1 do begin if (not TCableWayCompon(List2[j]).Passed) and IsEqualWay(currCableWayCompon, List2[j]) then begin TCableWayCompon(List2[j]).Passed := true; TempList.Add(TCableWayCompon(List2[j])); end; end; TempPortList.Clear; PortNameList1.Clear; PortNameList2.Clear; PortListString1 := ''; PortListString2 := ''; // порты (для верхнего компонента) for j := 0 to TempList.Count - 1 do begin // порты (сторона 1) s := ''; if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1.IndexOf(s) = -1 then PortNameList1.Add(s); end; end; Side1PortList.Clear; Side2PortList.Clear; // side1 for k := 0 to PortNameList1.Count - 1 do begin for j := 0 to TempList.Count - 1 do begin if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.LoadName; if (s = PortNameList1[k]) and (Side1PortList.IndexOf(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort)= -1) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort); end; end; if PortListString1 = '' then PortListString1 := PortListString1 + ' ' + PortNameList1[k] + GetNumberCount(Side1PortList) else PortListString1 := PortListString1 + ',' + ' ' + PortNameList1[k] + GetNumberCount(Side1PortList); Side1PortList.Clear; end; for j := 0 to TempList.Count - 1 do begin // порты (сторона 1) if (TCableWayCompon(TempList[j]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner <> nil) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side1ConnectedInterface.PortOwner.NppPort); // пины кабеля TempPortList.Add(TCableWayCompon(TempList[j]).Npp); end; currCableWayCompon := TCableWayCompon(TempList[0]); // ЗАПИСЬ // заголовок FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + ' ' + IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList); // FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + GetNumberCount(TempPortList); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; s := ''; if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.FirstCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 else s := currCableWayCompon.FirstCompon.GetTopComponent.GetNameForVisible(false) + #13#10; s := s + PortListString1; FmtCablePaths.FieldByName(fnNameFrom).AsString := s; { if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.LastCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 // + currCableWayCompon.LastCompon.GetNameForVisible(False) else s := currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false) + #13#10; s := s + PortListString2; } FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg270; FmtCablePaths.Post; // путь // компоненты сторон Side1ComponList.Clear; Side2ComponList.Clear; for j := 0 to TempList.Count - 1 do begin if Side1ComponList.IndexOf(TCableWayCompon(TempList[j]).FirstCompon) = -1 then Side1ComponList.Add(TCableWayCompon(TempList[j]).FirstCompon); end; // вкатать в таблицу начальные компоненты for k := 0 to Side1ComponList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponInterfList.Clear; ComponInterfCount := 0; for j := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[j]).FirstCompon.ID = TSCSComponent(Side1ComponList[k]).ID then begin Inc(ComponInterfCount); if ComponInterfList.IndexOf(TCableWayCompon(TempList[j]).Npp) = -1 then ComponInterfList.Add(TCableWayCompon(TempList[j]).Npp); end; end; // определить порты компонента, подключенные к жилам Side1PortList.Clear; PortNameList1.Clear; // наименования портов for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1.IndexOf(s) = -1 then PortNameList1.Add(s); end; end; end; end; // формируем наименование + нумерация PortListString1 := ''; for m := 0 to PortNameList1.count - 1 do begin for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side1ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.LoadName; if PortNameList1[m] = s then if Side1PortList.IndexOf(TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.NppPort) = -1 then Side1PortList.Add(TCableWayCompon(TempList[l]).Side1ConnectedInterface.PortOwner.NppPort); end; end; end; end; if PortListString1 = '' then PortListString1 := PortListString1 + s + GetNumberCount(Side1PortList) else PortListString1 := PortListString1 + ', ' + s + GetNumberCount(Side1PortList); Side1PortList.Clear; end; TopCompon1 := TSCSComponent(Side1ComponList[k]); ComponName := TSCSComponent(Side1ComponList[k]).GetNameForVisible(False); if TopCompon1 <> nil then begin while not TopCompon1.IsTop do begin TopCompon1 := TopCompon1.GetParentComponent; if TopCompon1 <> nil then begin if not TopCompon1.IsTop then ComponName := TopCompon1.GetNameForVisible(false) + '/' + ComponName; end else Break; //// BREAK //// end; end; // ComponName := TSCSComponent(Side1ComponList[k]).GetNameForVisible(False); if PortListString1 = '' then FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName else FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName + ' ' + PortListString1; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' '; // currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; // вкатать путь -- кабель с транзитными компонентами for k := 0 to currCableWayCompon.WayList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetNameForVisible(False); if IsCableComponent(TSCSComponent(currCableWayCompon.WayList[k])) then begin if cbCablePathShowCableCanals.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent.GetNameForVisible(false) + ' / ' + ComponName; end; if cbCablePathShowObjName.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog.GetNameForVisible(False) + ' / ' + ComponName; end; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList) + ' ' +ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' ';// currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; Inc(MasterId); end; end; end; end else FreeAndNil(List2); //NilToPoint if List3.Count > 0 then begin CanSave := True; for i := 0 to List3.Count - 1 do begin if InterfGuideList.IndexOf(TCableWayCompon(List3[i]).CableInterface.GUIDInterface) = -1 then InterfGuideList.Add(TCableWayCompon(List3[i]).CableInterface.GUIDInterface); end; While CanSave do begin CanSave := False; for i := 0 to InterfGuideList.Count - 1 do begin currCableWayCompon := Nil; for j := 0 to List3.Count - 1 do begin if (not TCableWayCompon(List3[j]).Passed) and (TCableWayCompon(List3[j]).CableInterface.GUIDInterface = InterfGuideList[i]) then begin currCableWayCompon := TCableWayCompon(List3[j]); TCableWayCompon(List3[j]).Passed := True; Break; //// BREAK ////; end; end; if currCableWayCompon <> nil then begin CanSave := True; TempList.Clear; TempList.Add(currCableWayCompon); for j := 0 to List3.Count - 1 do begin if (not TCableWayCompon(List3[j]).Passed) and IsEqualWay(currCableWayCompon, List3[j]) then begin TCableWayCompon(List3[j]).Passed := true; TempList.Add(TCableWayCompon(List3[j])); end; end; TempPortList.Clear; PortNameList1.Clear; PortNameList2.Clear; PortListString1 := ''; PortListString2 := ''; // порты (для верхнего компонента) for j := 0 to TempList.Count - 1 do begin // порты (сторона 2) s := ''; if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2.IndexOf(s) = -1 then PortNameList2.Add(s); end; end; // side2 Side2PortList.Clear; for k := 0 to PortNameList2.Count - 1 do begin for j := 0 to TempList.Count - 1 do begin if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.LoadName; if (s = PortNameList2[k]) and (Side2PortList.IndexOf(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort)= -1) then Side2PortList.Add(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort); end; end; if PortListString2 = '' then PortListString2 := PortListString2 + ' ' + PortNameList2[k] + GetNumberCount(Side2PortList) else PortListString2 := PortListString2 + ',' + ' ' + PortNameList2[k] + GetNumberCount(Side2PortList); Side2PortList.Clear; end; for j := 0 to TempList.Count - 1 do begin // порты (сторона 2) if (TCableWayCompon(TempList[j]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner <> nil) then Side1PortList.Add(TCableWayCompon(TempList[j]).Side2ConnectedInterface.PortOwner.NppPort); // пины кабеля TempPortList.Add(TCableWayCompon(TempList[j]).Npp); end; currCableWayCompon := TCableWayCompon(TempList[0]); // ЗАПИСЬ // заголовок FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + ' ' + IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList); // FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + GetNumberCount(TempPortList); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; s := ''; FmtCablePaths.FieldByName(fnNameFrom).AsString := cRepMsg270; if cbCablePathShowEndObjName.Checked then s := currCableWayCompon.LastCompon.GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false)+ #13#10 // + currCableWayCompon.LastCompon.GetNameForVisible(False) else s := currCableWayCompon.LastCompon.GetTopComponent.GetNameForVisible(false) + #13#10; s := s + PortListString2; FmtCablePaths.FieldByName(fnNameTo).AsString := s; FmtCablePaths.Post; // путь // компоненты сторон Side1ComponList.Clear; Side2ComponList.Clear; for j := 0 to TempList.Count - 1 do begin if Side2ComponList.IndexOf(TCableWayCompon(TempList[j]).LastCompon) = -1 then Side2ComponList.Add(TCableWayCompon(TempList[j]).LastCompon); end; // вкатать путь -- кабель с транзитными компонентами for k := 0 to currCableWayCompon.WayList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetNameForVisible(False); if IsCableComponent(TSCSComponent(currCableWayCompon.WayList[k])) then begin if cbCablePathShowCableCanals.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent.GetNameForVisible(false) + ' / ' + ComponName; end; if cbCablePathShowObjName.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog.GetNameForVisible(False) + ' / ' + ComponName; end; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList) + ' ' +ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' '; //currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; // вкатать конечные компоненты for k := 0 to Side2ComponList.Count - 1 do begin ComponInterfList.Clear; ComponInterfCount := 0; for j := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[j]).LastCompon.ID = TSCSComponent(Side2ComponList[k]).ID then begin Inc(ComponInterfCount); if ComponInterfList.IndexOf(TCableWayCompon(TempList[j]).Npp) = -1 then ComponInterfList.Add(TCableWayCompon(TempList[j]).Npp); end; end; // определить порты компонента, подключенные к жилам Side2PortList.Clear; PortNameList2.Clear; // наименования портов for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2.IndexOf(s) = -1 then PortNameList2.Add(s); end; end; end; end; // формируем наименование + нумерация PortListString2 := ''; for m := 0 to PortNameList2.count - 1 do begin for j := 0 to ComponInterfList.Count - 1 do begin s := ''; for l := 0 to TempList.Count - 1 do begin if TCableWayCompon(TempList[l]).Npp = ComponInterfList[j] then begin if (TCableWayCompon(TempList[l]).Side2ConnectedInterface <> nil) and (TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner <> nil) then begin s := TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.LoadName; if PortNameList2[m] = s then if Side2PortList.IndexOf(TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.NppPort) = -1 then Side2PortList.Add(TCableWayCompon(TempList[l]).Side2ConnectedInterface.PortOwner.NppPort); end; end; end; end; if PortListString2 = '' then PortListString2 := PortListString2 + s + GetNumberCount(Side2PortList) else PortListString2 := PortListString2+ ', ' + s + GetNumberCount(Side2PortList); Side2PortList.Clear; end; FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; // ComponName := TSCSComponent(Side2ComponList[k]).GetNameForVisible(False); TopCompon2 := TSCSComponent(Side2ComponList[k]); ComponName := TSCSComponent(Side2ComponList[k]).GetNameForVisible(False); if TopCompon2 <> nil then begin while not TopCompon2.IsTop do begin TopCompon2 := TopCompon2.GetParentComponent; if TopCompon2 <> nil then begin if not TopCompon2.IsTop then ComponName := TopCompon2.GetNameForVisible(false) + '/' + ComponName; end else Break; //// BREAK //// end; end; // FmtCablePathsInfo.FieldByName(fnDescription).AsString := ComponName; if PortListString2 = '' then FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName else FmtCablePathsInfo.FieldByName(fnDescription).AsString := inttostr(ComponInterfCount) + ' ' + GetNumberCount(ComponInterfList) + ' ' + ComponName + ' ' + PortListString2; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' ';//currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; Inc(MasterId); end; end; end; end else FreeANdNil(List3); //NilToNil if List4.Count > 0 then begin CanSave := True; for i := 0 to List4.Count - 1 do begin if InterfGuideList.IndexOf(TCableWayCompon(List4[i]).CableInterface.GUIDInterface) = -1 then InterfGuideList.Add(TCableWayCompon(List4[i]).CableInterface.GUIDInterface); end; While CanSave do begin CanSave := False; for i := 0 to InterfGuideList.Count - 1 do begin currCableWayCompon := Nil; for j := 0 to List4.Count - 1 do begin if (not TCableWayCompon(List4[j]).Passed) and (TCableWayCompon(List4[j]).CableInterface.GUIDInterface = InterfGuideList[i]) then begin currCableWayCompon := TCableWayCompon(List4[j]); TCableWayCompon(List4[j]).Passed := True; Break; //// BREAK ////; end; end; if currCableWayCompon <> nil then begin CanSave := True; TempList.Clear; TempList.Add(currCableWayCompon); for j := 0 to List4.Count - 1 do begin if (not TCableWayCompon(List4[j]).Passed) and IsEqualWay(currCableWayCompon, List4[j]) then begin TCableWayCompon(List4[j]).Passed := true; TempList.Add(TCableWayCompon(List4[j])); end; end; TempPortList.Clear; PortNameList1.Clear; PortNameList2.Clear; PortListString1 := ''; PortListString2 := ''; for j := 0 to TempList.Count - 1 do begin // пины кабеля TempPortList.Add(TCableWayCompon(TempList[j]).Npp); end; currCableWayCompon := TCableWayCompon(TempList[0]); // ЗАПИСЬ // заголовок FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + ' ' + IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList); // FmtCablePaths.FieldByName(fnName).AsString := currCableWayCompon.CableInterfName + GetNumberCount(TempPortList); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; s := ''; FmtCablePaths.FieldByName(fnNameFrom).AsString := cRepMsg270; FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg270; FmtCablePaths.Post; // путь // вкатать путь -- кабель с транзитными компонентами for k := 0 to currCableWayCompon.WayList.Count - 1 do begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldbyName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := 1; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetNameForVisible(False); if IsCableComponent(TSCSComponent(currCableWayCompon.WayList[k])) then begin if cbCablePathShowCableCanals.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetParentComponent.GetNameForVisible(false) + ' / ' + ComponName; end; if cbCablePathShowObjName.Checked then begin if TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog <> nil then ComponName := TSCSComponent(currCableWayCompon.WayList[k]).GetFirstParentCatalog.GetNameForVisible(False) + ' / ' + ComponName; end; end; FmtCablePathsInfo.FieldByName(fnDescription).AsString := IntToStr(TempList.Count) + ' ' + GetNumberCount(TempPortList) + ' ' + ComponName; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := 0; FmtCablePathsInfo.FieldByName(fnName).AsString := ' ';// currCableWayCompon.CableInterfName; FmtCablePathsInfo.Post; end; Inc(MasterId); end; end; end; end else FreeAndNil(List4); // сбросить путь for i := (CableWay.Count - 1) downto 0 do begin currCableWayCompon := TCableWayCompon(CableWay[i]); CableWay.Delete(i); FreeAndNil(currCableWayCompon); end; FreeAndNil(CableWay); end; // почистить и сбросить списки if Side1ComponList <> nil then FreeAndNil(Side1ComponList); if Side2ComponList <> nil then FreeAndNil(Side2ComponList); if Side1InterfList <> nil then FreeAndNil(Side1InterfList); if Side2InterfList <> nil then FreeAndNil(Side2InterfList); if SaveList <> nil then FreeAndNil(SaveList); if List1 <> nil then FreeAndNil(List1); if List2 <> nil then FreeAndNil(List2); if List3 <> nil then FreeAndNil(List3); if List4 <> nil then FreeAndNil(List4); if CableInterfList <> nil then FreeAndNil(CableInterfList); if Side1PortList <> nil then FreeAndNil(Side1PortList); if Side2PortList <> nil then FreeAndNil(Side2PortList); if Side1PortNameList <> nil then FreeAndNil(Side1PortNameList); if Side2PortNameList <> nil then FreeAndNil(Side2PortNameList); if TempPortList <> nil then FreeAndNil(TempPortList); if InterfGuideList <> nil then FreeAndNil(InterfGuideList); if TempList <> nil then FreeAndNil(TempList); if PortNameList1 <> nil then FreeAndNil(PortNameList1); if PortNameList2 <> nil then FreeAndNil(PortNameList2); if ComponInterfList <> nil then FreeAndNil(ComponInterfList); end; // // Tolik // строит список всех точечных компонент, подключенных к кабелю Function GetConnectedPoints(Component: TSCSComponent; LoadWholeComponent : boolean): TSCSComponents; Var i, j : integer; SCSComponent, JoinCompon: TSCSComponent; Begin Result := TSCSComponents.Create(false); // если нужны подключенные точечные ко всему кабелю if LoadWholeComponent then begin Component.LoadWholeComponent(true); for i := 0 to Component.WholeComponent.Count - 1 do begin // кабель берем весь по WHOLE_ID SCSComponent := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(Component.WholeComponent[i]); if SCSComponent <> nil then begin for j := 0 to SCSComponent.JoinedComponents.Count - 1 do begin JoinCompon := SCSComponent.JoinedComponents[j]; // подключенный точечный if JoinCompon.IsLine = biFalse then begin if Result.IndexOf(JoinCompon) = -1 then Result.Add(JoinCompon); end; end; end; end; end else begin // подключенные точечные к одному куску кабеля for j := 0 to Component.JoinedComponents.Count - 1 do begin JoinCompon := Component.JoinedComponents[j]; // подключенный точечный if JoinCompon.IsLine = biFalse then begin if Result.IndexOf(JoinCompon) = -1 then Result.Add(JoinCompon); end; end; end; End; // отбирает из всех точечных компонент, подключенных к кабелю, // подключенные с заданной стороны Function GetConnectedPointsBySide(Compons : TSCSComponents; Cable: TSCSComponent; Side: Integer): TSCSComponents; Var i,j: integer; InterF: TSCSInterFace; Begin Result := TSCSComponents.Create(false); for i := 0 to Cable.Interfaces.Count - 1 do begin if Cable.Interfaces[i].TypeI = itFunctional then begin if Cable.Interfaces[i].IsBusy or Cable.Interfaces[i].KolvoBusy > 0 then begin Interf := Cable.Interfaces[i]; if Interf.Side = Side then begin for j := 0 to Compons.Count - 1 do begin if Interf.CheckJoinToComponent(Compons[j]) and (Result.IndexOf(Compons[j]) = -1) then Result.Add(Compons[j]); end; end; end; end; end; End; Function GetConnectedToCable(Compons: TSCSComponents; Cable: TSCSComponent): TSCSComponents; Var i : integer; Begin Result := TSCSComponents.Create(false); for i := 0 to Compons.Count - 1 do begin if Compons[i].JoinedComponents.IndexOf(Cable) <> -1 then Result.Add(Compons[i]); end; End; Function GetBusyInterfCountByType(InterfType : string; Cable: TSCSComponent; bySide: boolean; Side : integer): integer; Var i : integer; Begin Result := 0; if not bySide then begin for i := 0 to Cable.Interfaces.Count - 1 do begin if (Cable.Interfaces[i].TypeI = itFunctional) and (Cable.Interfaces[i].GUIDInterface = InterfType) then if Cable.Interfaces[i].IsBusy or Cable.Interfaces[i].KolvoBusy > 0 then begin // showmessage('Npp = ' +inttostr(Cable.Interfaces[i].Npp) + ','+ ' Kolvo = '+inttostr(Cable.Interfaces[i].kolvoBusy)+ ' Side = '+ inttostr(Cable.Interfaces[i].Side)); Result := Result + Cable.Interfaces[i].KolvoBusy; end; end; end else begin for i := 0 to Cable.Interfaces.Count - 1 do begin if (Cable.Interfaces[i].TypeI = itFunctional) and (Cable.Interfaces[i].Side = Side) and (Cable.Interfaces[i].GUIDInterface = InterfType) then if Cable.Interfaces[i].IsBusy or Cable.Interfaces[i].KolvoBusy > 0 then begin // showmessage('Npp = ' +inttostr(Cable.Interfaces[i].Npp) + ','+ ' Kolvo = '+inttostr(Cable.Interfaces[i].kolvoBusy)+ ' Side = '+ inttostr(Cable.Interfaces[i].Side)); Result := Result + Cable.Interfaces[i].KolvoBusy; end; end; end; End; // определяет количество интерфейсов объекта (компонент - топовый) function GetCountInterfObject(Component: TSCSComponent): integer; var i, j: integer; currCompon: TSCSComponent; begin //Tolik Result := 0; if Component <> nil then begin for i := 0 to Component.Interfaces.Count - 1 do begin if Component.Interfaces[i].TypeI = itFunctional then Result := Result + Component.Interfaces[i].Kolvo; end; for i := 0 to Component.ChildReferences.Count - 1 do begin currCompon := Component.ChildReferences[i]; for j := 0 to currCompon.Interfaces.Count - 1 do begin if currCompon.Interfaces[j].TypeI = itFunctional then Result := Result + currCompon.Interfaces[j].Kolvo; end; end; end; // End; // определяет объект с наибольшим количеством интерфейсов из списка function GetMaxInterfObject(Components: TSCSComponents; GetTopComponent: boolean): TSCSComponent; var i, j, k: integer; currCompon : TSCSComponent; MaxCounter, CurrCounter: integer; SCSComponent: TSCSComponent; begin if Components.Count > 0 then begin MaxCounter := 0; CurrCounter := 0; // первый компонент списка Result := Components[0]; SCSComponent := Components[0]; if Components.Count = 1 then begin if GetTopComponent then begin while not Result.IsTop do Result := Result.GetParentComponent; end; end else begin //объект должен быть топовым while not Result.IsTop do Result := Result.GetParentComponent; // интерфейсы самого компонента for i := 0 to Result.Interfaces.Count - 1 do begin if Result.Interfaces[i].TypeI = itFunctional then MaxCounter := MaxCounter + Result.Interfaces[i].Kolvo; end; // интерфейсы чилдов первого компонента for i := 0 to Result.ChildReferences.Count - 1 do begin currCompon := Result.ChildReferences[i]; for j := 0 to currCompon.Interfaces.Count -1 do begin if currCompon.Interfaces[j].TypeI = itFunctional then MaxCounter := MaxCounter + currCompon.Interfaces[j].Kolvo; end; end; // ищем в списке for i := 1 to Components.Count - 1 do begin currCompon := Components[i]; SCSComponent := Components[i]; //объект должен быть топовым (верхним) while not currCompon.IsTop do currCompon := currCompon.GetParentComponent; CurrCounter := 0; // интерфейсы компонента for j := 0 to currCompon.Interfaces.Count - 1 do begin if currCompon.Interfaces[j].TypeI = itFunctional then begin if currCompon.Interfaces[j].Kolvo <= 0 then inc(CurrCounter) else CurrCounter := CurrCounter + currCompon.Interfaces[j].Kolvo; end; end; // интерфейсы чилдов for j := 0 to currCompon.ChildReferences.Count - 1 do begin for k := 0 to currCompon.ChildReferences[j].Interfaces.Count - 1 do begin if currCompon.ChildReferences[j].Interfaces[k].TypeI = itFunctional then begin if currCompon.ChildReferences[j].Interfaces[k].Kolvo <= 0 then inc(CurrCounter) else CurrCounter := CurrCounter + currCompon.ChildReferences[j].Interfaces[k].Kolvo; end; end; end; if MaxCounter < CurrCounter then begin MaxCounter := CurrCounter; if GetTopComponent then Result := currCompon else Result := SCSComponent; end; end; end; end; end; // удаление компонента из списка Procedure DelComponFromList(ComponList: TSCSComponents; Component : TSCScomponent); var i: integer; begin if ((ComponList.Count > 0) and (Component <> nil)) then begin for i := 0 to ComponList.Count - 1 do begin if ComponList[i] = Component then begin ComponList.Delete(i); break; end; end; end; end; // процедура сортировки списка Procedure SortListByPositions(AList : TCabPaths); Var i,j,k : integer; s : string; Passed : boolean; Ports : TIntList; Begin if Length(AList) > 1 then begin Ports := TIntList.Create; Passed := False; while not Passed do begin Passed := true; for j := 0 to Length(AList) - 2 do begin if AList[j].NppFrom > AList[j + 1].NppFrom then begin Passed := false; //ID k := AList[j].ID; AList[j].ID := AList[j+1].ID; AList[j+1].ID := k; //Name s := AList[j].Name; AList[j].Name := AList[j+1].Name; AList[j+1].Name := s; //NameFrom currCompon := AList[j].NameFrom; AList[j].NameFrom := AList[j + 1].NameFrom; AList[j + 1].NameFrom := currCompon; //NAmeTo currCompon := AList[j].NameTo; AList[j].NameTo := AList[j + 1].NameTo; AList[j + 1].NameTo := currCompon; //NppFrom k := AList[j].NppFrom; AList[j].NppFrom := AList[j + 1].NppFrom; AList[j + 1].NppFrom := k; //NppTo k := AList[j].NppTo; AList[j].NppTo := AList[j + 1].NppTo; AList[j + 1].NppTo := k; //kolvo k := AList[j].Kolvo; AList[j].Kolvo := AList[j+1].Kolvo; AList[j+1].Kolvo := k; Passed := AList[j].Passed; AList[j].Passed := AList[j+1].Passed; AList[j+1].Passed := Passed; //FromTo s := AList[j].FromTo; AList[j].FromTo := AList[j+1].FromTo; AList[j+1].FromTo := s; //BeginPortName s := AList[j].BeginPortName; AList[j].BeginPortName := AList[j+1].BeginPortName; AList[j+1].BeginPortName := s; //EndPortName s := AList[j].EndPortName; AList[j].EndPortName := AList[j+1].EndPortName; AList[j+1].EndPortName := s; if (AList[j].BeginPorts = Nil) then AList[j].BeginPorts := TIntList.Create; if (AList[j].EndPorts = Nil) then AList[j].EndPorts := TIntList.Create; // BeginPorts if Ports.Count > 0 then Ports.Clear; for i := 0 to AList[j].BeginPorts.Count - 1 do Ports.Add(AList[j].BeginPorts[i]); AList[j].BeginPorts.Clear; for i := 0 to AList[j+1].BeginPorts.Count - 1 do AList[j].BeginPorts.Add(AList[j+1].BeginPorts[i]); AList[j+1].BeginPorts.Clear; for i := 0 to Ports.Count -1 do AList[j+1].BeginPorts.Add(Ports[i]); //EndPorts if Ports.Count > 0 then Ports.Clear; for i := 0 to AList[j].EndPorts.Count - 1 do Ports.Add(AList[j].EndPorts[i]); AList[j].EndPorts.Clear; for i := 0 to AList[j+1].EndPorts.Count - 1 do AList[j].EndPorts.Add(AList[j+1].EndPorts[i]); AList[j+1].EndPorts.Clear; for i := 0 to Ports.Count -1 do AList[j+1].EndPorts.Add(Ports[i]); //InterFacePositions if Ports.Count > 0 then Ports.Clear; for i := 0 to AList[j].InterFacePositions.Count - 1 do Ports.Add(AList[j].InterFacePositions[i]); AList[j].InterFacePositions.Clear; for i := 0 to AList[j+1].InterFacePositions.Count - 1 do AList[j].InterFacePositions.Add(AList[j+1].InterFacePositions[i]); AList[j+1].InterFacePositions.Clear; for i := 0 to Ports.Count -1 do AList[j+1].InterFacePositions.Add(Ports[i]); break; end; end; end; // Tolik 21/03/2017 -- Ports.free; // end; End; // запись кабеля в таблицу Function WriteCableToTbl(CablesPassed: TSCSComponents; InterFacePositions: TIntList; PosNumber, ParentID, InterFacePositionsCount: Integer): integer; Var k: Integer; s: String; Begin Result := PosNumber; // кабель // если показывать трассы if cbCablePathShowObjName.Checked then begin for k := 0 to CablesPassed.Count - 1 do begin s := ''; inc(Result); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := Result; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := ParentID; s := CablesPassed[k].GetNameForVisible(false); if HasCableCanals then begin if CablesPassed[k].GetParentComponent <> nil then // каб канал s := CablesPassed[k].GetParentComponent.GetNameForVisible(false) +'/' + s; end; // трасса s := CablesPassed[k].GetFirstParentCatalog.GetNameForVisible(false) + '/' + s; s := GetNumberCount(InterFacePositions) + ' '+s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := InterFacePositionsCount; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end end; // не показывать трассы if HasCableCanals and (not cbCablePathShowObjName.Checked) then begin for k := 0 to CablesPassed.Count - 1 do begin if CablesPassed[k].GetParentComponent <> nil then begin s := ''; inc(Result); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := Result; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := ParentID; // кабель s := CablesPassed[k].GetNameForVisible(false); if cbCablePathShowCableCanals.Checked then // каб канал s := CablesPassed[k].GetParentComponent.GetNameForVisible(false) +'/' +s; s := GetNumberCount(InterFacePositions) + ' '+s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s:=''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := InterFacePositionsCount; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; end; end; // не показывать ни трассы ни каб каналы if (not cbCablePathShowObjName.Checked) and (not HasCableCanals) then begin s:=''; inc(Result); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := Result; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := ParentID; // кабель s := CablesPassed[0].GetNameForVisible(false); s := GetNumberCount(InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := InterFacePositionsCount; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; End; // собирает по куску кабеля все соединение в список // все подряд, пока порядок не важен Procedure GetAllConnected(FCompon: TSCSComponent; AList: TSCSComponents; FCypher: String; AddComponToList: TSCSComponent); Var j: integer; passed: boolean; currCompon: TSCSComponent; function checkList: boolean; var i: Integer; begin Result := False; for i := 0 to aList.Count - 1 do begin if aList[i].Id = FCompon.Id then begin Result := True; exit; end; end end; Begin if checkList then exit else AList.Add(FCompon); for j := 0 to FCompon.JoinedComponents.Count - 1 do begin currCompon := FCompon.JoinedComponents[j]; if AList.IndexOf(currCompon) = -1 then begin if currCompon.IsLine = biFalse then begin if aList.IndexOf(currCompon) = -1 then begin GetAllConnected(currCompon, AList, FCypher, FCompon); end; end else begin if isCableComponent(currCompon) then if currCompon.Cypher = FComponent.Cypher then if aList.IndexOf(currCompon) = -1 then GetAllConnected(currCompon, AList, FCypher, FCompon); end; end; end; End; {Procedure GetAllConnected(FCompon: TSCSComponent; AList: TSCSComponents; FCypher: String; AddComponToList: TSCSComponent); Var j: integer; passed: boolean; currCompon: TSCSComponent; Begin Passed := false; While Passed = false do begin Passed := true; for j := 0 to FCompon.JoinedComponents.Count - 1 do begin currCompon := FCompon.JoinedComponents[j]; Passed := true; if AList.IndexOf(currCompon) = -1 then begin if (FCompon.IsLine = biFalse) and (FCompon.JoinedComponents.Count > 1) and (currCompon.IsLine = biTrue) and (currCompon.JoinedComponents.Count <= 2) then AList.Add(FCompon); Passed := False; AList.Add(currCompon); GetAllConnected(currCompon, AList, FCypher, FCompon); // break; end; end; end; End; } // возвращает сторону кабеля, подключенную к компоненту Function GetConnectionSide(Compon, ConnectedCompon: TSCSComponent): Integer; Var k, l, m: Integer; Interf: TSCSInterFace; InterfPos: TSCSInterfPosition; Begin Result := 0; for k := 0 to Compon.Interfaces.count - 1 do begin if ((Compon.Interfaces[k].TypeI = itFunctional) and ((Compon.Interfaces[k].IsBusy = bitrue) or (Compon.Interfaces[k].KolvoBusy > 0))) then begin for l := 0 to Compon.Interfaces[k].BusyPositions.count - 1 do begin InterfPos := Compon.Interfaces[k].BusyPositions[l]; InterfPos := InterFPos.GetConnectedPos; InterF := TSCSInterFace(InterfPos.InterfOwner); if ConnectedCompon = InterF.ComponentOwner then begin Result := Compon.Interfaces[k].Side; break; end; end; end; if Result <> 0 then break; end; End; // таблички для электрики Procedure SaveTable(BeginConnected, EndConnected, StrangeCables: TSCSComponents); Var i, j, k, l, m, MasterID, currID, Counter: integer; currCompon: TSCSComponent; s, CableName: String; JointText: TStringList; InterfNames: TStringList; // список типов занятых интерфейсов в кабеле InterfName: string; // наименование текущего интерфейса JointPositions, CablePositions, ComponPositions: TIntList; InterfCount: Integer; InterFPos, InterfPos1: TSCSInterfPosition; ConnectionSide: Integer; currInterface: TSCSInterface; BusyCableInterFaces, AllCableInterFaces: TSCSInterFaces; isInList: Boolean; AllCableInterfPos, BusyCableInterfPos: TSCSInterfPositions; PinPosition, PinPositionCount: Integer; JointList: TStringList; // описание скрутки currConnectedInterFaces, ConnectedInterFaces: PortInform; // интерфейсы кабеля, подключенные к компоненту HasCableCanals, isMultiPointObject: Boolean; ComponPorts, ConnectedPorts: PortInform; // если попался объект типа "точка" (там может сидеть несколько компонент друг на дружке) // или один компонент типа модуля // в таких случаях нужно выводить в отчет имя объекта Function MultiPointObject(Compon: TSCSComponent): boolean; Var i, Counter: integer; currParentCatalog: TSCSCatalog; Begin Result := false; Counter := 0; if not Compon.IsTop then begin currParentCatalog := Compon.GetFirstParentCatalog; for i := 0 to currParentCatalog.ComponentReferences.count - 1 do begin if currParentCatalog.ComponentReferences[i].IsTop then inc(Counter); end; if Counter > 1 then Result := true; end else // например, модуль брошен на лист и к чему-то подключен if Compon.isTop then Result := true; End; Procedure AddToCableInterFaces(ComponInterFaces: PortInform; var CableInterFaces: PortInform); Var j, k, m, Counter: Integer; isInList: Boolean; Begin for j := 0 to Length(ComponInterFaces) - 1 do begin if Length(CableInterFaces) = 0 then begin SetLength(CableInterFaces,1); CableInterFaces[0].Ports := TIntList.Create; CableInterFaces[0].PortName := ComponInterFaces[j].PortName; for k := 0 to ComponInterFaces[j].Ports.Count - 1 do begin CableInterFaces[0].Ports.add(ComponInterFaces[j].Ports[k]); end; end else begin isInList := false; for k := 0 to Length(CableInterFaces) - 1 do begin if CableInterFaces[k].PortName = ComponInterFaces[j].PortName then begin isInList := true; for m := 0 to ComponInterFaces[j].Ports.count - 1 do begin if CableInterFaces[k].Ports.IndexOf(ComponInterFaces[j].Ports[m]) = - 1 then CableInterFaces[k].Ports.Add(ComponInterFaces[j].Ports[m]); end; if isInList then break; end; end; if not isInList then begin Counter := Length(CableInterFaces); inc(Counter); SetLength(CableInterFaces, Counter); CableInterFaces[Counter-1].PortName := ComponInterFaces[j].PortName; CableInterFaces[Counter-1].Ports := TIntList.Create; for k := 0 to ComponInterFaces[j].Ports.Count - 1 do begin CableInterFaces[Counter-1].Ports.Add(ComponInterFaces[j].Ports[k]); end; end; end; end; End; Function GetInterfConnected(ConnCompon, CableCompon: TSCSComponent; var ComponPorts: PortInform): PortInform; // ConnInterFaces); Var j, k, l, m: Integer; Begin SetLength(ComponPorts, 0); SetLength(Result, 0); for j := 0 to CableCompon.Interfaces.Count - 1 do begin if ( (CableCompon.Interfaces[j].TypeI = itFunctional) and ((CableCompon.Interfaces[j].IsBusy = bitrue) or (CableCompon.Interfaces[j].KolvoBusy > 0)) and (CableCompon.Interfaces[j].Side = ConnectionSide) ) then begin for k := 0 to CableCompon.Interfaces[j].BusyPositions.Count - 1 do begin InterfPos := CableCompon.Interfaces[j].BusyPositions[k]; InterfPos1 := InterfPos.GetConnectedPos; Interf := TSCSInterFace(InterfPos1.InterfOwner); if Interf.ComponentOwner = ConnCompon then begin // порты (только для точечных) if ConnCompon.IsLine = biFalse then begin if Interf.PortOwner <> nil then if Interf.PortOwner.isPort = biTrue then begin if Length(ComponPorts) = 0 then begin SetLength(ComponPorts,1); ComponPorts[0].PortName := Interf.PortOwner.LoadName; ComponPorts[0].Ports := TIntLIst.Create; ComponPorts[0].Ports.add(Interf.PortOwner.NppPort); end else begin isInList := false; for l := 0 to Length(ComponPorts) - 1 do begin if ComponPorts[l].PortName = Interf.PortOwner.LoadName then begin isInLIst := true; if ComponPorts[l].Ports.IndexOf(Interf.PortOwner.NppPort) = -1 then ComponPorts[l].Ports.Add(Interf.PortOwner.NppPort); end; end; if not isInList then begin m := Length(ComponPorts); SetLength(ComponPorts,m+1); ComponPorts[m].PortName := Interf.PortOwner.LoadName; ComponPorts[m].Ports := TIntLIst.Create; ComponPorts[m].Ports.add(Interf.PortOwner.NppPort); end; end; end; end; // интерфейсы if InterfPos.FromPos <> 0 then begin if Length(Result) = 0 then begin SetLength(Result, 1); Result[0].PortName := CableCompon.Interfaces[j].GUIDInterface; Result[0].Ports := TIntList.Create; if ((InterfPos.ToPos - InterfPos.FromPos) = 0) then begin if Result[0].Ports.indexof(InterfPos.FromPos) = -1 then Result[0].Ports.Add(InterfPos.FromPos); end; if ((InterfPos.ToPos - InterfPos.FromPos) > 0) then begin for l := InterfPos.FromPos to InterfPos.ToPos do begin if Result[0].Ports.IndexOf(l) = -1 then Result[0].Ports.Add(l); end; end; end else begin if Length(Result) > 0 then begin isInList := False; for m := 0 to Length(Result) - 1 do begin if Result[m].PortName = CableCompon.Interfaces[j].GUIDInterface then begin isInList := true; if ((InterfPos.ToPos - InterfPos.FromPos) = 0) then begin if Result[m].Ports.IndexOf(InterfPos.FromPos) = -1 then Result[m].Ports.Add(InterfPos.FromPos); end; if ((InterfPos.ToPos - InterfPos.FromPos) > 0) then begin for l := InterfPos.FromPos to InterfPos.ToPos do begin if Result[m].Ports.IndexOf(l) = -1 then Result[m].Ports.Add(l); end; end; end; end; if not isInLIst then begin SetLength(Result, Length(Result) + 1); Result[Length(Result) - 1].PortName := CableCompon.Interfaces[j].GUIDInterface; Result[Length(Result) - 1].Ports := TIntList.Create; if ((InterfPos.ToPos - InterfPos.FromPos) = 0) then begin if Result[Length(Result) - 1].Ports.indexof(InterfPos.FromPos) = -1 then Result[Length(Result) - 1].Ports.Add(InterfPos.FromPos); end; if ((InterfPos.ToPos - InterfPos.FromPos) > 0) then begin for l := InterfPos.FromPos to InterfPos.ToPos do begin if Result[Length(Result) - 1].Ports.indexof(L) = -1 then Result[Length(Result) - 1].Ports.Add(l); end; end; end; end; end; end; end; end; end; end; End; // получает список имен занятых интерфейсов из списка линейных компонент // здесь берем кабель краями, т.к. он, по идее, от точки к точке не должен прерываться Function GetInterfNames(Compons: TSCSComponents): TStringList; Var i: integer; Begin Result := TStringList.Create; if (assigned(Compons) and (Compons.Count > 0)) then begin for i := 0 to Compons[0].Interfaces.Count - 1 do begin if (Compons[0].Interfaces[i].TypeI = itFunctional) and ((Compons[0].Interfaces[i].IsBusy = biTrue) or (Compons[0].Interfaces[i].KolvoBusy > 0)) then begin if Result.IndexOf(Compons[0].Interfaces[i].GUIDInterface) = -1 then Result.Add(Compons[0].Interfaces[i].GUIDInterface); end; end; if Compons.Count > 1 then begin for i := 0 to Compons[Compons.Count - 1].Interfaces.Count - 1 do begin if (Compons[Compons.Count - 1].Interfaces[i].TypeI = itFunctional) and ((Compons[Compons.Count - 1].Interfaces[i].IsBusy = biTrue) or (Compons[Compons.Count - 1].Interfaces[i].KolvoBusy > 0)) then begin if Result.IndexOf(Compons[Compons.Count - 1].Interfaces[i].GUIDInterface) = -1 then Result.Add(Compons[Compons.Count - 1].Interfaces[i].GUIDInterface); end; end; end; end; End; // имя интерфейса по Гуиду Function GetInterfNameFromGuid(Compon: TSCSComponent; InterfGuid: string): string; Var i: Integer; Begin Result := ''; for i := 0 to Compon.Interfaces.Count - 1 do begin if (Compon.Interfaces[i].TypeI = itFunctional) and ((Compon.Interfaces[i].IsBusy = biTrue) or (Compon.Interfaces[i].KolvoBusy > 0)) then begin if Compon.Interfaces[i].GUIDInterface = InterfGuid then begin Result := Compon.Interfaces[i].LoadName; break; end; end; if Result <> '' then break; end; End; Procedure GetConnectedPositions(BusyCableInterFaces, AllCableInterFaces: TSCSInterFaces; ComponPositions, CablePositions: TIntList; BeginCompon: TSCSComponent); Var PinPosition, k, l, m: Integer; Interf: TSCSInterFace; InterfPos, InterfPos1: TSCSInterfPosition; Begin if ComponPositions = nil then ComponPositions := TintList.Create else ComponPositions.Clear; for k := 0 to BusyCableInterFaces.Count - 1 do begin for l := 0 to BusyCableInterFaces[k].BusyPositions.Count - 1 do begin // подключение InterFPos := BusyCableInterFaces[k].BusyPositions[l]; // обратная сторона (на компоненте) InterFPos1 := InterFPos.GetConnectedPos; // подключенный интерфейс компонента Interf := TSCSInterface(InterfPos1.InterfOwner); // если подключено к данному компоненту, собираем позиции подключения(распиновка) if Interf.ComponentOwner = BeginCompon then begin PinPosition := 0; // для первого интерфейса можно просто взять занятые позиции if BusyCableInterFaces[k].Npp < 2 then begin if ((InterFPos.ToPos - InterFPos.FromPos) = 0) then begin ComponPositions.Add(InterFPos.FromPos); CablePositions.Add(InterFPos.FromPos); end; if ((InterFPos.ToPos - InterFPos.FromPos) > 0) then begin for m := InterFPos.FromPos to InterFPos.ToPos do begin ComponPositions.Add(m); // позиции кабеля, подключенные к интерфейсу CablePositions.Add(m); // занятые позиции в кабеле end; end; end else // если интерфейс не первый, то занятые позиции нужно высчитать // от первого интерфейса до текущего begin if BusyCableInterFaces[k].Npp >= 2 then begin PinPosition := 0; // вычисляем номер последней позиции перед текущим интерфейсом for m := 0 to ((InterFPos.ToPos - InterFPos.FromPos) - 2) do begin PinPosition := PinPosition + AllCableInterFaces[m].Kolvo; end; // если позиция одна if (InterFPos.ToPos - InterFPos.FromPos = 0) then begin ComponPositions.Add(InterFPos.FromPos + PinPosition); CablePositions.Add(InterFPos.FromPos + PinPosition); end else begin // если позиция одна, но занимает несколько пинов if (InterFPos.ToPos - InterFPos.FromPos > 0) then begin for m := InterfPos.FromPos to InterfPos.ToPos do begin // добавляем позиции интерфейса в список для компонента ComponPositions.Add(m+PinPosition); CablePositions.Add(m+PinPosition); // end; end; end; end; end; end; end; end; End; Function GetBusyCablePositions(BeginCable, EndCable: TSCSComponent; CableInterFaces: TSCSInterFaces; InterfGuid: String): TIntList; Var i, j, k : Integer; PosNumber: Integer; InterfPos: TSCSInterFPosition; Begin Result := TIntList.Create; for i := 0 to BeginCable.Interfaces.count - 1 do begin // начало кабеля if ( (BeginCable.Interfaces[i].TypeI = itFunctional) and (BeginCable.Interfaces[i].GUIDInterface = InterfGuid) and ((BeginCable.Interfaces[i].IsBusy = biTrue) or (BeginCable.Interfaces[i].KolvoBusy > 0)) ) then begin PosNumber := 0; if BeginCable.Interfaces[i].Npp >= 2 then begin for j := 0 to BeginCable.Interfaces[i].Npp - 1 do begin PosNumber := PosNumber + CableInterFaces[j].Kolvo; end; end; for j := 0 to BeginCable.Interfaces[i].BusyPositions.Count - 1 do begin InterfPos := BeginCable.Interfaces[i].BusyPositions[j]; if (InterfPos.ToPos - InterfPos.FromPos) = 0 then Result.Add(InterfPos.FromPos + PosNumber) else begin for k := InterfPos.FromPos to InterfPos.ToPos do Result.Add(k + PosNumber) end; end; end; end; // конец кабеля for i := 0 to EndCable.Interfaces.count - 1 do begin if ( (EndCable.Interfaces[i].TypeI = itFunctional) and (BeginCable.Interfaces[i].GUIDInterface = InterfGuid) and ((EndCable.Interfaces[i].IsBusy = biTrue) or (EndCable.Interfaces[i].KolvoBusy > 0)) ) then begin PosNumber := 0; if EndCable.Interfaces[i].Npp >= 2 then begin for j := 0 to EndCable.Interfaces[i].Npp - 1 do begin PosNumber := PosNumber + CableInterFaces[j].Kolvo; end; end; for j := 0 to EndCable.Interfaces[i].BusyPositions.Count - 1 do begin InterfPos := EndCable.Interfaces[i].BusyPositions[j]; if (InterfPos.ToPos - InterfPos.FromPos) = 0 then begin if Result.IndexOf(InterfPos.FromPos) = -1 then Result.Add(InterfPos.FromPos + PosNumber); end else begin for k := InterfPos.FromPos to InterfPos.ToPos do begin if Result.IndexOf(k) = -1 then Result.Add(k + PosNumber); end; end; end; end; end; End; // созвращает список кабелей другого типа, подключенных к концу кабеля Function DefineStrangeCables(Compon, PrevCompon: TSCSComponent): TSCSComponents; Var i, j: Integer; Interf: TSCSInterFace; InterfPos, InterfPos1: TSCSInterfPosition; Begin Result := TSCSComponents.Create(false); // ConnectionSide := GetConnectionSide(Compon, PrevCompon); //if ConnectionSide <> 0 then begin for i := 0 to Compon.Interfaces.Count - 1 do begin if ( (Compon.Interfaces[i].TypeI = itFunctional) and (Compon.Interfaces[i].Side = ConnectionSide) and ((Compon.Interfaces[i].IsBusy = biTrue) or (Compon.Interfaces[i].KolvoBusy > 0)) ) then begin for j := 0 to Compon.Interfaces[i].BusyPositions.Count - 1 do begin InterfPos := TSCSInterfPosition(Compon.Interfaces[i].BusyPositions[j]); InterfPos1 := InterfPos.GetConnectedPos; Interf := TSCSInterface(InterfPos1.InterfOwner); if (Interf.ComponentOwner.IsLine = biTrue) and (Interf.ComponentOwner.Cypher <> Compon.Cypher) then begin if Result.IndexOf(Interf.ComponentOwner) = -1 then Result.Add(Interf.ComponentOwner); end; end; end end; end; End; Function PortsConnection(ConnPorts: Portinform): string; Var i: Integer; Begin Result:= ''; if Length(ConnPorts) > 0 then begin for i := 0 to Length(ConnPorts) - 1 do begin if Result = '' then Result := Result + ConnPorts[i].PortName + GetNumberCount(ConnPorts[i].Ports) else Result := Result + ', ' + ConnPorts[i].PortName + GetNumberCount(ConnPorts[i].Ports); end; end; End; Begin JointText := TStringList.Create; isMultiPointObject := false; ConnectionSide:= 0; // порты SetLength(ComponPorts,0); SetLength(ConnectedPorts,0); if BeginConnected[0].IsLine = biFalse then ConnectionSide := GetConnectionSide(ConnectedCables[0], BeginConnected[0]) else ConnectionSide := GetConnectionSide(ConnectedCables[0], BeginConnected[1]); // BeginCompons // если начальные - точечные inc(BeginPos); MasterID := BeginPos; SetLength(ConnectedInterFaces, 0); // начальные - точечные if BeginConnected[0].isLine = biFalse then begin isMultiPointObject := MultiPointObject(BeginConnected[0]); for i := 0 to BeginConnected.Count - 1 do begin SetLength(currConnectedInterFaces, 0); currConnectedInterFaces := GetInterfConnected(BeginConnected[i], ConnectedCables[0], ComponPorts); if Length(ComponPorts) > 0 then AddToCableInterFaces(ComponPorts, ConnectedPorts); // определили интерфейсы подключения (c позициями) // пишем начальные компоненты в табличку (описание) s := ''; // Tolik 09/02/2018 -- показать распиновку только для кабеля компьютерной сети { for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports) + #13#10; end; } if isCompCable then begin for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports) + #13#10; end; end else begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + #13#10; end; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; if Length(ComponPorts) = 0 then FmtCablePathsInfo.FieldByName(fnDescription).AsString := BeginConnected[i].GetNameForVisible(false) else FmtCablePathsInfo.FieldByName(fnDescription).AsString := BeginConnected[i].GetNameForVisible(false) + ' / ' + cRepMsg245 + PortsConnection(ComponPorts); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; // добавляем интерфейсы подключений в интерфейсы, заюзанные в кабеле AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; // поле Откуда в заголовке FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := ConnectedCables[0].GetNameForVisible(false); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; currCompon := BeginConnected[0]; if isMultiPointObject then begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + cRepMsg245 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetFirstParentCatalog.GetNameForVisible(false); end else begin if cbCablePathShowEndObjName.Checked then begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + BeginConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10 + cRepMsg245 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + BeginConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10; end else begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10 + cRepMsg245 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameFrom).AsString := BeginConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10; end; end; end // если начальные - линейные (скрутка) else begin if BeginConnected[0].isLine = biTrue then begin JointText.Clear; JointText.Add(' ' + cRepMsg241); JointText.Add(' ' +BeginConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + BeginConnected[0].GetNameForVisible(false)); // сначала считаем занятые интерфейсы (для кабеля) for i := 0 to BeginConnected.Count - 1 do begin SetLength(currConnectedInterFaces,0); if BeginConnected[i] <> ConnectedCables[0] then currConnectedInterFaces := GetInterfConnected(BeginConnected[i], ConnectedCables[0], ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; StrangeCables := DefineStrangeCables(ConnectedCables[0], BeginConnected[1]); for i := 0 to StrangeCables.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(StrangeCables[i], ConnectedCables[0], ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; for i := 1 to BeginConnected.Count - 1 do begin SetLength(currConnectedInterFaces,0); if BeginConnected[i] <> ConnectedCables[0] then begin s:=''; currConnectedInterFaces := GetInterfConnected(BeginConnected[i], ConnectedCables[0], ComponPorts); for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + GetNumberCount(currConnectedInterfaces[j].Ports); end; JointText.Add(s + ' ' + BeginConnected[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + BeginConnected[i].GetNameForVisible(false)); end; end; if StrangeCables.Count > 0 then begin JointText.Add(cRepMsg243); for i := 0 to StrangeCables.count - 1 do begin SetLength(currConnectedInterFaces, 0); s :=''; currConnectedInterFaces := GetInterfConnected(StrangeCables[i], ConnectedCables[0], ComponPorts); for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + GetNumberCount(currConnectedInterfaces[j].Ports) ; end; JointText.Add(s + ' ' + StrangeCables[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + StrangeCables[i].GetNameForVisible(false)); end; end; FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := MasterID; FmtCablePaths.FieldByName(fnName).AsString := ConnectedCables[0].GetNameForVisible(false); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := 0; FmtCablePaths.FieldByName(fnNppTo).AsInteger := 0; FmtCablePaths.FieldByName(fnNameFrom).AsString := cRepMsg246; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := JointText.Text; // вся скрутка - в описание FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := ''; FmtCablePathsInfo.Post; end; end; // теперь то же самое в конце // если есть конечные if EndConnected.Count > 0 then begin if Length(ConnectedPorts) > 0 then SetLength(ConnectedPorts, 0); // сбрасываем порта от начала (если были) // если конечные - точечные if EndConnected[0].isLine = biFalse then begin isMultiPointObject := MultiPointObject(EndConnected[0]); Counter := ConnectedCables.Count - 1; // последний кабель ConnectionSide := 0; ConnectionSide := GetConnectionSide(ConnectedCables[Counter],EndConnected[0]); SetLength(currConnectedInterFaces, 0); for i := 0 to EndConnected.Count - 1 do begin SetLength(currConnectedInterFaces, 0); currConnectedInterFaces := GetInterfConnected(EndConnected[i], ConnectedCables[ConnectedCables.Count - 1], ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); AddToCableInterFaces(ComponPorts, ConnectedPorts); end; s :=''; // Tolik 09/02/2018 -- показать распиновку только для кабеля компьютерной сети { for j := 0 to Length(ConnectedInterfaces) - 1 do begin if s = '' then s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) else s := ',' + s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports); end; } if isCompCable then begin for j := 0 to Length(ConnectedInterfaces) - 1 do begin if s = '' then s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) else s := s + ',' + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports); end; end else begin for j := 0 to Length(ConnectedInterfaces) - 1 do begin if s = '' then s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) else s := s + ',' + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName); end; end; // // кабель // показывать детальное расключение if cbCablePathShowConnInSeparatePaths.Checked then begin for i := 0 to ConnectedCables.Count - 1 do begin CableName := ConnectedCables[i].GetNameForVisible(false); if cbCablePathShowCableCanals.Checked then begin if ConnectedCables[i].GetParentComponent <> nil then CableName := ConnectedCables[i].GetParentComponent.GetNameForVisible(false) + ' / ' + CableName; end; if cbCablePathShowObjName.Checked then begin CableName := ConnectedCables[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + CableName; end; CableName := ' ' + CableName; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := CableName; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end else // не показывать детальное расключение begin Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ' ' + ConnectedCables[0].GetNameForVisible(false); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; // заголовок (ТО) FmtCablePaths.Edit; if isMultiPointObject then begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + cRepMsg245 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetFirstParentCatalog.GetNameForVisible(false); end else begin if cbCablePathShowEndObjName.Checked then begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + EndConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetFirstParentCatalog.GetNameForVisible(false) + #13#10 + EndConnected[0].GetTopComponent.GetNameForVisible(false); end else begin if Length(ConnectedPorts) > 0 then FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetTopComponent.GetNameForVisible(false) + #13#10 + PortsConnection(ConnectedPorts) else FmtCablePaths.FieldByName(fnNameTo).AsString := EndConnected[0].GetTopComponent.GetNameForVisible(false); end; end; FmtCablePaths.Post; isMultiPointObject := MultiPointObject(EndConnected[0]); Counter := ConnectedCables.Count - 1; // последний кабель ConnectionSide := 0; ConnectionSide := GetConnectionSide(ConnectedCables[Counter],EndConnected[0]); SetLength(currConnectedInterFaces, 0); for i := 0 to EndConnected.Count - 1 do begin SetLength(currConnectedInterFaces, 0); currConnectedInterFaces := GetInterfConnected(EndConnected[i], ConnectedCables[ConnectedCables.Count - 1], ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); s := ''; Counter := Length(currConnectedInterfaces); // Tolik 09/02/2018 -- показать распиновку только для кабеля компьютерной сети { for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports) + #13#10; end; } if isCompCable then begin for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports) + #13#10; end; end else begin for j := 0 to Length(currConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],currConnectedInterfaces[j].PortName)+ #13#10; end; end; // Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; if Length(ComponPorts) > 0 then FmtCablePathsInfo.FieldByName(fnDescription).AsString := EndConnected[i].GetNameForVisible(false) + ' / ' + cRepMsg245 + PortsConnection(ComponPorts) else FmtCablePathsInfo.FieldByName(fnDescription).AsString := EndConnected[i].GetNameForVisible(false); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end else begin // если конечные - линейные (скрутка) if EndConnected[0].isLine = biTrue then begin ConnectionSide := 0; ConnectionSide := GetConnectionSide(ConnectedCables[ConnectedCables.Count - 1], EndConnected[EndConnected.Count - 1]); for i := 0 to EndConnected.Count - 1 do begin SetLength(currConnectedInterFaces,0); if EndConnected[i] <> ConnectedCables[ConnectedCables.count - 1] then begin currConnectedInterFaces := GetInterfConnected(ConnectedCables[ConnectedCables.Count - 1], EndConnected[i], ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; end; StrangeCables := DefineStrangeCables(ConnectedCables[ConnectedCables.Count - 1], EndConnected[0]); // если есть подключение к кабелю другого типа if StrangeCables.Count > 0 then begin // добавляем подключенные интерфейсы к занятым интерфейсам кабеля for i := 0 to StrangeCables.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(StrangeCables[i], currCompon, ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; end; // заголовок (ТО) FmtCablePaths.Edit; FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg246; FmtCablePaths.Post; s :=''; for j := 0 to Length(ConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) + #13#10; end; // кабели // показывать детально расключение if cbCablePathShowConnInSeparatePaths.Checked then begin for i := 0 to ConnectedCables.count - 1 do begin CableName := ConnectedCables[i].GetNameForVisible(false); if cbCablePathShowCableCanals.Checked then begin if ConnectedCables[i].GetParentComponent <> nil then CableName := ConnectedCables[i].GetParentComponent.GetNameForVisible(false) + ' / ' + CableName; end; if cbCablePathShowObjName.Checked then begin CableName := ConnectedCables[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + CableName; end; CableName := ' ' + CableName; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := CableName; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end else // не показывать детальное расключение begin Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ' ' + ConnectedCables[0].GetNameForVisible(false); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; if EndConnected.IndexOf(ConnectedCables[ConnectedCables.Count - 1]) = -1 then EndConnected.Insert(0,ConnectedCables[ConnectedCables.Count - 1]); s := ' ' + cRepMsg241 + #13#10; s :=s + ' ' + EndConnected[0].getFirstParentCatalog.GetNameForVisible(false) + ' / ' + EndConnected[0].GetNameForVisible(false) + #13#10; for i := 1 to EndConnected.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(EndConnected[i], ConnectedCables[ConnectedCables.Count - 1], ComponPorts); for j := 0 to Length(currConnectedInterFaces) - 1 do s := s + GetInterfNameFromGuid(ConnectedCables[ConnectedCables.Count -1],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports); s := s + ' ' + EndConnected[i].getFirstParentCatalog.GetNameForVisible(false) + ' / '+ EndConnected[i].GetNameForVisible(false) + #13#10; end; if StrangeCables.Count > 0 then begin s := s + cRepMsg243 + #13#10; for j := 0 to StrangeCables.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(StrangeCables[j], ConnectedCables[ConnectedCables.Count - 1], ComponPorts); for k := 0 to Length(currConnectedInterFaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[ConnectedCables.Count -1],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[k].Ports); s := s + ' ' + StrangeCables[j].getFirstParentCatalog.GetNameForVisible(false) + ' / '+ StrangeCables[j].GetNameForVisible(false) + #13#10; end; end; end; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := ''; FmtCablePathsInfo.Post; end; end; end else // если нет конечных begin currCompon := ConnectedCables[ConnectedCables.Count - 1]; // последний кусок кабеля // проверяем на подключение к кабелю другого типа if StrangeCables = nil then StrangeCables := TSCSComponents.Create(false) else StrangeCables.Clear; ConnectionSide := 0; // если кусок кабеля на участке один if ConnectedCables.Count = 1 then begin // если начальные точечные if BeginConnected[0].IsLine = biFalse then begin ConnectionSide := GetConnectionSide(ConnectedCables[ConnectedCables.Count - 1], BeginConnected[0]); // currCompon := BeginConnected[0]; end else // если в начале - скрутка begin ConnectionSide := GetConnectionSide(ConnectedCables[ConnectedCables.Count - 1], BeginConnected[1]); // currCompon := BeginConnected[1]; end; end else begin if ConnectedCables.Count > 1 then begin ConnectionSide := GetConnectionSide(currCompon, ConnectedCables[ConnectedCables.Count - 2]); // currCompon := ConnectedCables[ConnectedCables.Count - 2]; end; end; if ConnectionSide = 1 then ConnectionSide := 2 else begin if ConnectionSide = 2 then ConnectionSide := 1; end; StrangeCables := DefineStrangeCables(ConnectedCables[ConnectedCables.Count - 1], currCompon); // если есть подключение к кабелю другого типа if StrangeCables.Count > 0 then begin // добавляем подключенные интерфейсы к занятым интерфейсам кабеля for i := 0 to StrangeCables.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(StrangeCables[i], currCompon, ComponPorts); AddToCableInterFaces(currConnectedInterFaces, ConnectedInterFaces); end; // пишем кабель, т.к. все интерфейсы уже определены s :=''; for j := 0 to Length(ConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) + #13#10; end; // кабели // показывать детальное расключение if cbCablePathShowConnInSeparatePaths.Checked then begin for i := 0 to ConnectedCables.count - 1 do begin CableName := ConnectedCables[i].GetNameForVisible(false); if cbCablePathShowCableCanals.Checked then begin if ConnectedCables[i].GetParentComponent <> nil then CableName := ConnectedCables[i].GetParentComponent.GetNameForVisible(false) + ' / ' + CableName; end; if cbCablePathShowObjName.Checked then begin CableName := ConnectedCables[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + CableName; end; CableName := ' ' + CableName; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := CableName; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end else begin Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ' ' + ConnectedCables[0].GetNameForVisible(false); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; // смотрим: если инородный кабель - один, то это - соединение, больше одного - скрутка if StrangeCables.Count = 1 then begin FmtCablePaths.Edit; FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg242; FmtCablePaths.Post; s :=''; s := s + ConnectedCables[ConnectedCables.Count - 1].GetFirstParentCatalog.GetNameforVisible(false) + ' ' + ConnectedCables[ConnectedCables.Count - 1].GetNameforVisible(false)+ #13#10; s := s + ' '+ cRepMsg244 + #13#10; for j := 0 to Length(ConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) + ' '; end; s := s + StrangeCables[0].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + StrangeCables[0].GetNameForVisible(false); Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := ' '; FmtCablePathsInfo.Post; end else // если кабель другого типа не один - это скрутка, так и запишем begin // заголовок FmtCablePaths.Edit; FmtCablePaths.FieldByName(fnNameTo).AsString := cRepMsg246; FmtCablePaths.Post; JointText.Clear; JointText.Add(' ' + cRepMsg241); JointText.Add(' ' + ConnectedCables[ConnectedCables.Count - 1].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + ConnectedCables[ConnectedCables.Count - 1].GetNameForVisible(false)); JointText.Add(cRepMsg243); for i := 0 to StrangeCables.Count - 1 do begin SetLength(currConnectedInterFaces,0); currConnectedInterFaces := GetInterfConnected(StrangeCables[i], ConnectedCables[ConnectedCables.Count - 1], ComponPorts); for j := 0 to Length(currConnectedInterFaces) - 1 do begin s := ''; s := s + GetInterfNameFromGuid(ConnectedCables[ConnectedCables.Count -1],currConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(currConnectedInterfaces[j].Ports); end; s := s + ' ' + StrangeCables[i].getFirstParentCatalog.GetNameForVisible(false) + ' / '+ StrangeCables[i].GetNameForVisible(false); JointText.Add(s); end; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := JointText.Text; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := ''; FmtCablePathsInfo.Post; end; end else // если таки ничего нет, то пишем заголовок(куда = "пусто") и кабель begin FmtCablePaths.Edit; FmtCablePaths.FieldByName(fnNameTo).AsString := ' '; FmtCablePaths.Post; s := ''; for j := 0 to Length(ConnectedInterfaces) - 1 do begin s := s + GetInterfNameFromGuid(ConnectedCables[0],ConnectedInterfaces[j].PortName) + ' ' + GetNumberCount(ConnectedInterfaces[j].Ports) + ' '; end; // кабели // показывать детальное расключение if cbCablePathShowConnInSeparatePaths.Checked then begin for i := 0 to ConnectedCables.count - 1 do begin CableName := ConnectedCables[i].GetNameForVisible(false); if cbCablePathShowCableCanals.Checked then begin if ConnectedCables[i].GetParentComponent <> nil then CableName := ConnectedCables[i].GetParentComponent.GetNameForVisible(false) + ' / ' + CableName; end; if cbCablePathShowObjName.Checked then begin CableName := ConnectedCables[i].GetFirstParentCatalog.GetNameForVisible(false) + ' / ' + CableName; end; CableName := ' ' + CableName; Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := CableName; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end else begin Inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := MasterID; FmtCablePathsInfo.FieldByName(fnDescription).AsString := ' ' + ConnectedCables[0].GetNameForVisible(false); FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := -1; FmtCablePathsInfo.FieldByName(fnName).AsString := s; FmtCablePathsInfo.Post; end; end; end; ConnectedCables.Clear; BeginConnected.Clear; EndConnected.Clear; End; Procedure GetAllConnectedFromBegin(FCompon, PrevCompon: TSCSComponent; BeginConnected: TSCSComponents; FCypher: string; FromBegin: boolean); Var j, k, l, m: integer; passed: boolean; currCompon, ConnectedCompon: TSCSComponent; IsJoint: Boolean; InterF: TSCSInterFace; CurrInterFaces: TSCSInterFaces; ConnectionSide: Integer; InterFacePosition: TSCSInterFPosition; // connectedCables: TSCSComponents; Counter: integer; isAnotherCable, FromLine, FromPoint: boolean; BeginCompons, EndConnected: TSCSComponents; Begin if ((FCompon.Cypher = FCypher) and (CablesPassed.IndexOf(FCompon) = -1)) then begin CablesPassed.Add(FCompon); if ConnectedCables.IndexOf(FCompon) = -1 then ConnectedCables.Add(FCompon); EndConnected := TSCSComponents.create(false); if BeginConnected = nil then BeginConnected := TSCSComponents.Create(false); // смотрим сторону подключения кабеля к предидущему компоненту ConnectionSide := 0; for j := 0 to FCompon.Interfaces.count - 1 do begin if ( (FCompon.Interfaces[j].TypeI = itFunctional) and ((FCompon.Interfaces[j].IsBusy = biTrue) or (FCompon.Interfaces[j].KolvoBusy > 0)) ) then begin for k := 0 to FCompon.Interfaces[j].BusyPositions.Count - 1 do begin InterfacePosition := FCompon.Interfaces[j].BusyPositions[k]; InterFacePosition := InterfacePosition.GetConnectedPos; Interf := TSCSInterface(InterfacePosition.InterfOwner); if Interf.ComponentOwner = PrevCompon then begin ConnectionSide := FCompon.Interfaces[j].Side; break; end; end; end; if ConnectionSide <> 0 then break; end; if FromBegin then begin for j := 0 to FCompon.Interfaces.count - 1 do begin if ( (FCompon.Interfaces[j].Side = ConnectionSide) and (FCompon.Interfaces[j].TypeI = itFunctional) and ((FCompon.Interfaces[j].IsBusy = biTrue) or (FCompon.Interfaces[j].KolvoBusy > 0)) ) then begin for k := 0 to FCompon.Interfaces[j].BusyPositions.Count - 1 do begin InterfacePosition := FCompon.Interfaces[j].BusyPositions[k]; InterFacePosition := InterfacePosition.GetConnectedPos; Interf := TSCSInterface(InterfacePosition.InterfOwner); // точечные добавляем сразу однозначно if Interf.ComponentOwner.IsLine = biFalse then begin if BeginConnected.IndexOf(Interf.ComponentOwner) = -1 then BeginConnected.Add(Interf.ComponentOwner); end; // линейные проверяем по шифру кабеля if ((Interf.ComponentOwner.IsLine = biTrue) and (Interf.ComponentOwner.Cypher = FCypher)) then begin if BeginConnected.IndexOf(Interf.ComponentOwner) = -1 then BeginConnected.Add(Interf.ComponentOwner); end; end; end; end; //если сзади -скрутка if BeginConnected[0].IsLine = biTrue then begin if BeginConnected.IndexOf(FCompon) = -1 then BeginConnected.Insert(0, FCompon); // текущий компонент - тоже есть на сткутке end; end; // идем дальше (смотрим на кабель с другой стороны) for j := 0 to FCompon.Interfaces.count - 1 do begin if ( (FCompon.Interfaces[j].Side <> ConnectionSide) and (FCompon.Interfaces[j].TypeI = itFunctional) and ((FCompon.Interfaces[j].IsBusy = biTrue) or (FCompon.Interfaces[j].KolvoBusy > 0)) ) then begin for k := 0 to FCompon.Interfaces[j].BusyPositions.Count - 1 do begin InterfacePosition := FCompon.Interfaces[j].BusyPositions[k]; InterFacePosition := InterfacePosition.GetConnectedPos; Interf := TSCSInterface(InterfacePosition.InterfOwner); // точечные добавляем сразу однозначно if Interf.ComponentOwner.IsLine = biFalse then begin if EndConnected.IndexOf(Interf.ComponentOwner) = -1 then EndConnected.Add(Interf.ComponentOwner); end; // линейные проверяем по шифру кабеля if ((Interf.ComponentOwner.IsLine = biTrue) and (Interf.ComponentOwner.Cypher = FCypher)) then begin if EndConnected.IndexOf(Interf.ComponentOwner) = -1 then EndConnected.Add(Interf.ComponentOwner); end; end; end; end; // смотрим, что получилось в конце куска кабеля // 1 - "висящий конец" или подключение к кабелю не того типа if EndConnected.Count = 0 then begin StrangeCables.Clear; // проверяем на подключение к инородному кабелю, for j := 0 to FCompon.Interfaces.count - 1 do begin if ( (FCompon.Interfaces[j].Side <> ConnectionSide) and (FCompon.Interfaces[j].TypeI = itFunctional) and ((FCompon.Interfaces[j].IsBusy = biTrue) or (FCompon.Interfaces[j].KolvoBusy > 0)) ) then begin for k := 0 to FCompon.Interfaces[j].BusyPositions.Count - 1 do begin InterfacePosition := FCompon.Interfaces[j].BusyPositions[k]; InterFacePosition := InterfacePosition.GetConnectedPos; Interf := TSCSInterface(InterfacePosition.InterfOwner); // линейные проверяем по шифру кабеля if ((Interf.ComponentOwner.IsLine = biTrue) and (Interf.ComponentOwner.Cypher = FCypher)) then EndConnected.Add(Interf.ComponentOwner); end; end; end; // пишем табличку ... и не возвращаемся SaveTable(BeginConnected, EndConnected, StrangeCables); end else // 2 кабель пошел дальше if EndConnected.Count <> 0 then begin if ((EndConnected.Count = 1) and (EndConnected[0].IsLine = bitrue)) then begin // проверяем, нет ли подключения кабелей другого типа в этой точке // если есть - пишем в табличку isAnotherCable := false; for j := 0 to EndConnected[0].Interfaces.Count - 1 do begin if (EndConnected[0].Interfaces[j].TypeI = itFunctional) and (EndConnected[0].Interfaces[j].Side = ConnectionSide) and ((EndConnected[0].Interfaces[j].IsBusy = biTrue) or (EndConnected[0].Interfaces[j].KolvoBusy > 0)) then begin for k := 0 to EndConnected[0].Interfaces[j].BusyPositions.Count - 1 do begin InterFacePosition := EndConnected[0].Interfaces[j].BusyPositions[k]; InterFacePosition := InterFacePosition.GetConnectedPos; Interf := TSCSInterface(InterFacePosition.InterfOwner); if (Interf.ComponentOwner.IsLine = biTrue) and (Interf.ComponentOwner.Cypher <> FCypher) then begin isAnotherCable := true; break; end; end; end; if isAnotherCable then break; end; ConnectedCompon := EndConnected[0]; if isAnotherCable then begin SaveTable(BeginConnected, EndConnected, StrangeCables); GetAllConnectedFromBegin(ConnectedCompon, FCompon, BeginConnected, FCypher, True); end else begin // идем дальше EndConnected.Clear; // BeginConnected.add(ConnectedCompon); GetAllConnectedFromBegin(ConnectedCompon, FCompon, BeginConnected, FCypher, false); end; end else // 3 скрутка if ((EndConnected.Count > 1) and (EndConnected[0].IsLine = bitrue)) then begin StrangeCables.Clear; // пишем табличку, разворачиваем скрутку if EndConnected.IndexOf(FCompon) = -1 then EndConnected.Insert(0, FCompon); // текущий компонент тоже скручен BeginCompons := TSCSComponents.Create(false); for j := 1 to EndConnected.Count - 1 do begin if BeginCompons.IndexOf(EndConnected[j]) = -1 then BeginCompons.Add(EndConnected[j]); end; SaveTable(BeginConnected, EndConnected, StrangeCables); for k := 0 to BeginCompons.Count - 1 do begin GetAllConnectedFromBegin(BeginCompons[k], FCompon, nil, FCypher, true); end; end else // 4 точечные (или один точечный) if ((EndConnected.Count > 0) and (EndConnected[0].IsLine = biFalse)) then begin BeginCompons := TSCSComponents.Create(false); for j := 0 to EndConnected.Count - 1 do begin if BeginCompons.IndexOf(EndConnected[j]) = -1 then BeginCompons.Add(EndConnected[j]); end; SaveTable(BeginConnected, EndConnected, StrangeCables); for j := 0 to BeginCompons.Count - 1 do begin for k := 0 to BeginCompons[j].JoinedComponents.Count - 1 do begin currCompon := BeginCompons[j]; currCompon := BeginCompons[j].JoinedComponents[k]; if (BeginCompons[j].JoinedComponents[k].IsLine = biTrue) and (BeginCompons[j].JoinedComponents[k].Cypher = FCypher) and (BeginCompons[j].JoinedComponents[k] <> FCompon) and (CablesPassed.IndexOf(BeginCompons[j].JoinedComponents[k]) = -1) then begin GetAllConnectedFromBegin(BeginCompons[j].JoinedComponents[k], BeginCompons[j], nil, FCypher, true); end; end; end; end; end; end; // // у первого компонента может быть несколько кабелей if PrevCompon.IsLine = biFalse then begin for k := 0 to PrevCompon.JoinedComponents.Count - 1 do begin if (PrevCompon.JoinedComponents[k].IsLine = biTrue) and (PrevCompon.JoinedComponents[k].Cypher = FCypher) and (PrevCompon.JoinedComponents[k] <> FCompon) and (CablesPassed.IndexOf(PrevCompon.JoinedComponents[k]) = -1) then begin GetAllConnectedFromBegin(PrevCompon.JoinedComponents[k], PrevCompon, nil, FCypher, true); end; end; end; End; begin try // Tolik 10/02/2018 if not isCableComponent(FComponent) then // на всякий exit; // if FComponent <> nil then begin NumPairEqual := True; if FmtCablePaths = nil then begin CreateMTWithDsrc(Self, FmtCablePaths, FdsrcCablePaths, 'FmtCablePaths', 'FdsrcCablePaths'); FmtCablePaths.FieldDefs.Add(fnID, ftAutoInc); FmtCablePaths.FieldDefs.Add(fnName, ftString, 255); //FmtCablePaths.FieldDefs.Add(fnNameFrom, ftString, 255); FmtCablePaths.FieldDefs.Add(fnNameFrom, ftMemo); FmtCablePaths.FieldDefs.Add(fnNppFrom, ftInteger); //FmtCablePaths.FieldDefs.Add(fnNameTo, ftString, 255); FmtCablePaths.FieldDefs.Add(fnNameTo, ftMemo); FmtCablePaths.FieldDefs.Add(fnNppTo, ftInteger); //FmtCablePaths.FieldDefs.Add(fnDescription, ftMemo); CreateMTWithDsrc(Self, FmtCablePathsInfo, FdsrcCablePathsInfo, 'FmtCablePathsInfo', 'FdsrcCablePathsInfo'); FmtCablePathsInfo.FieldDefs.Add(fnID, ftAutoInc); FmtCablePathsInfo.FieldDefs.Add(fnParentID, ftInteger); // FmtCablePathsInfo.FieldDefs.Add(fnDescription, ftString, 255); FmtCablePathsInfo.FieldDefs.Add(fnDescription, ftString, 2000); //FmtCablePathsInfo.FieldDefs.Add(fnNumPair, ftString, 255); FmtCablePathsInfo.FieldDefs.Add(fnInterfCount, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnNameFrom, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnNameTo, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnMargin, ftInteger); // Tolik FmtCablePathsInfo.FieldDefs.Add(fnName,ftString,255); // интерфейсы кабеля в подключении ConnectDetailMemTable(FdsrcCablePaths, FmtCablePathsInfo, fnID, fnParentID); end; FmtCablePaths.Active := false; FmtCablePaths.Active := true; FmtCablePathsInfo.Active := false; FmtCablePathsInfo.Active := true; //Tolik // если кабель компьютерно-телефонно-чего-то там, оставляем как было, // но немножко переделаем совсем if ( not (FComponent.IDNetType in [3,{4,}5,7])) then begin // Tolik -- if IsCableComponent(FComponent) then begin FCableCatalog := FComponent.GetFirstParentCatalog; if FCableCatalog <> nil then begin Side1InterfList := TList.Create; Side2InterfList := TList.Create; FCableNpp := 0; //список прохождения каждого интерфейса (от и до) //количество жил for i := 0 to FComponent.Interfaces.Count - 1 do begin if ((TSCSInterface(FComponent.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(FComponent.Interfaces[i]).Side = 1)) then FCableNpp := FCableNpp + TSCSInterface(FComponent.Interfaces[i]).Kolvo; end; if FCableNpp > 0 then begin // создать пути CableWay := TList.Create; for i := 1 to FCableNpp do begin CableWayCompon := TCableWayCompon.Create; CableWayCompon.WayList.Add(FComponent); CableWayCompon.Npp := i; CableWay.Add(CableWayCompon); CableWayCompon.GroupedNpp.Add(i); end; // забить наименования интерфейсов в пути прохождения //CanSeekCable := True; currNPP := 0; for i := 0 to FComponent.Interfaces.Count - 1 do begin if (TSCSInterface(FComponent.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(FComponent.Interfaces[i]).Side = 1) then begin for j := 1 to TSCSInterface(FComponent.Interfaces[i]).Kolvo do begin TCableWayCompon(CableWay[currNpp]).CableInterfName := TSCSInterface(FComponent.Interfaces[i]).LoadName; TCableWayCompon(CableWay[currNpp]).CableInterface := TSCSInterface(FComponent.Interfaces[i]); Inc(CurrNpp); end; end; end; { for j := 0 to FComponent.Interfaces.Count - 1 do begin if (TSCSInterface(FComponent.Interfaces[j]).TypeI = itFunctional) and (TSCSInterface(FComponent.Interfaces[j]).Side = 1) and ((currNPP <= (i+1)) and ((TSCSInterface(FComponent.Interfaces[j]).Kolvo + currNpp) >= (i+1))) then begin TCableWayCompon(CableWay[i]).CableInterfName := TSCSInterface(FComponent.Interfaces[j]).LoadName; TCableWayCompon(CableWay[i]).CableInterface := TSCSInterface(FComponent.Interfaces[j]); Break; //// BREAK ////; end else currNpp := currNPP + TSCSInterface(FComponent.Interfaces[j]).Kolvo; end; } //FCableFigure := TOrthoLine(GetFigureByID(GCadForm, FCableCatalog.SCSID)); for i := 0 to FComponent.Interfaces.Count - 1 do begin // занятые интерфейсы кабеля с одной стороны if ((TSCSInterface(FComponent.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(FComponent.Interfaces[i]).Side = 1) {and ((TSCSInterface(FComponent.Interfaces[i]).BusyPositions.Count > 0) or (TSCSInterface(FComponent.Interfaces[i]).IsBusy = biTrue))}) then Side1InterfList.Add(TSCSInterface(FComponent.Interfaces[i])) else // занятые интерфейсы кабеля с другой стороны if ((TSCSInterface(FComponent.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(FComponent.Interfaces[i]).Side = 2) {and ((TSCSInterface(FComponent.Interfaces[i]).BusyPositions.Count > 0) or (TSCSInterface(FComponent.Interfaces[i]).IsBusy = biTrue))}) then Side2InterfList.Add(TSCSInterface(FComponent.Interfaces[i])); end; // края кабеля с обеих сторон (если стали где-то на средине) Side1CableCompon := FComponent; Side2CableCompon := FComponent; //первая сторона CanSeekCable := True; ConnectInerfSide1 := 1; while CanSeekCable do begin CanSeekCable := False; for i := 0 to Side1CableCompon.Interfaces.Count - 1 do begin if (TSCSInterface(Side1CableCompon.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(Side1CableCompon.Interfaces[i]).Side = ConnectInerfSide1) and ((TSCSInterface(Side1CableCompon.Interfaces[i]).isBusy = biTrue) or ((TSCSInterface(Side1CableCompon.Interfaces[i]).BusyPositions.Count > 0 ))) then begin InterfacePosition := TSCSInterfPosition(TSCSInterface(Side1CableCompon.Interfaces[i]).BusyPositions[0]); InterfacePosition := InterfacePosition.GetConnectedPos; if InterfacePosition <> nil then begin // присоединен кабель if IsCableComponent(InterfacePosition.InterfOwner.ComponentOwner) then begin //сторона для последующего соединения if InterfacePosition.InterfOwner.Side = 1 then ConnectInerfSide1 := 2 else if InterfacePosition.InterfOwner.Side = 2 then ConnectInerfSide1 := 1; // переопределяем текущий кабель Side1CableCompon := TSCSComponent(InterfacePosition.InterfOwner.ComponentOwner); // вписать путь for j := 0 to CableWay.Count - 1 do begin TCableWayCompon(CableWay[j]).WayList.Insert(0, Side1CableCompon); end; CanSeekCable := True; Break; //// BREAK //// end; end; end; end; end; //вторая сторона CanSeekCable := True; ConnectInterfSide2 := 2; while CanSeekCable do begin CanSeekCable := False; for i := 0 to Side2CableCompon.Interfaces.Count - 1 do begin if (TSCSInterface(Side2CableCompon.Interfaces[i]).TypeI = itFunctional) and (TSCSInterface(Side2CableCompon.Interfaces[i]).Side = ConnectInterfSide2) and ((TSCSInterface(Side2CableCompon.Interfaces[i]).isBusy = biTrue) or ((TSCSInterface(Side2CableCompon.Interfaces[i]).BusyPositions.Count > 0 ))) then begin InterfacePosition := TSCSInterfPosition((TSCSInterface(Side2CableCompon.Interfaces[i]).BusyPositions[0])); InterfacePosition := InterfacePosition.GetConnectedPos; if InterfacePosition <> nil then begin // присоединен кабель if IsCableComponent(InterfacePosition.InterfOwner.ComponentOwner) then begin //сторона для последующего соединения if InterfacePosition.InterfOwner.Side = 1 then ConnectInterfSide2 := 2 else if InterfacePosition.InterfOwner.Side = 2 then ConnectInterfSide2 := 1; // переопределяем текущий кабель Side2CableCompon := TSCSComponent(InterfacePosition.InterfOwner.ComponentOwner); for j := 0 to CableWay.Count - 1 do begin TCableWayCompon(CableWay[j]).WayList.Add(Side2CableCompon); end; CanSeekCable := True; Break; //// BREAK //// end; end; end; end; end; (* // если есть незанятые позиции кабеля на концах -- сбрасываем их сразу // сторона 1 for i := 0 to CableWay.Count - 1 do begin currNPP := 0;//смещение позиции интерфейса CanSeekCable := True; ConnectedPosFound := False; for j := 0 to Side1CableCompon.Interfaces.Count - 1 do begin CurrentInterface := TSCSInterface(Side1CableCompon.Interfaces[j]); if (CurrentInterface.TypeI = itFunctional) and (CurrentInterface.Side = ConnectInerfSide1) then begin if ((CurrentInterface.IsBusy = biTrue) or (CurrentInterface.BusyPositions.Count > 0)) then begin for k := 0 to CurrentInterface.BusyPositions.Count - 1 do begin InterfacePosition := TSCSInterfPosition(CurrentInterface.BusyPositions[k]); if (((InterfacePosition.FromPos + currNPP) <= (i+1)) and ((InterfacePosition.ToPos + currNPP) >= (i+1))) then begin CanSeekCable := False; ConnectedPosFound := True; InterfacePosition := InterfacePosition.GetConnectedPos; if InterfacePosition <> nil then begin if InterfacePosition.InterfOwner.ComponentOwner.isLine = biFalse then TCableWayCompon(CableWay[i]).FirstCompon := InterfacePosition.InterfOwner.ComponentOwner; end else TCableWayCompon(CableWay[i]).FirstCompon := nil; break; end; end; if ConnectedPosFound then Break; //// BREAK //// end else currNPP := currNpp + CurrentInterface.Kolvo; if (currNPP > (i+1)) then begin CanSeekCable := False; Break; //// BREAK ////; end; end; {if (CanSeekCable) and (CurrentInterface.TypeI = itFunctional) and (CurrentInterface.Side = ConnectInerfSide1) then currNPP := currNpp + CurrentInterface.Kolvo else break;} end; if not ConnectedPosFound then TCableWayCompon(CableWay[i]).CanSeekSide1 := False; end; // сторона 2 for i := 0 to CableWay.Count - 1 do begin currNPP := 0;//смещение позиции интерфейса CanSeekCable := True; ConnectedPosFound := False; for j := 0 to Side2CableCompon.Interfaces.Count - 1 do begin CurrentInterface := TSCSInterface(Side2CableCompon.Interfaces[j]); if (CurrentInterface.TypeI = itFunctional) and (CurrentInterface.Side = ConnectInterfSide2) then begin if ((CurrentInterface.IsBusy = biTrue) or (CurrentInterface.BusyPositions.Count > 0)) then begin for k := 0 to CurrentInterface.BusyPositions.Count - 1 do begin InterfacePosition := TSCSInterfPosition(CurrentInterface.BusyPositions[k]); if (((InterfacePosition.FromPos + currNPP) <= (i+1)) and ((InterfacePosition.ToPos + currNPP) >= (i+1))) then begin CanSeekCable := False; ConnectedPosFound := True; InterfacePosition := InterfacePosition.GetConnectedPos; if InterfacePosition <> nil then begin if InterfacePosition.InterfOwner.ComponentOwner.isLine = biFalse then TCableWayCompon(CableWay[i]).LastCompon := InterfacePosition.InterfOwner.ComponentOwner; end else TCableWayCompon(CableWay[i]).LastCompon := nil; break; end; end; if ConnectedPosFound then Break; //// BREAK //// end else currNPP := currNpp + CurrentInterface.Kolvo; if (currNPP > (i+1)) then begin CanSeekCable := False; Break; //// BREAK ////; end; end; {if (CanSeekCable) and (CurrentInterface.TypeI = itFunctional) and (CurrentInterface.Side = ConnectInterfSide2) then currNPP := currNpp + CurrentInterface.Kolvo else break;} end; if not ConnectedPosFound then TCableWayCompon(CableWay[i]).CanSeekSide2 := False; end; *) // топаем в обе стороны по каждой жиле for i := 0 to CableWay.Count - 1 do begin if TCableWayCompon(CableWay[i]).CanSeekSide1 then GetCableWayBySide(ConnectInerfSide1, i+1, i+1, Side1CableCompon, 1); if TCableWayCompon(CableWay[i]).CanSeekSide2 then GetCableWayBySide(ConnectInterfSide2, i+1, i+1, Side2CableCompon, 2); end; //сортануть список путей // SortWayList; // ЕСЛИ НЕ ПОКАЗЫВАТЬ ДЕТАЛЬНОЕ РАСКЛЮЧЕНИЕ КАБЕЛЯ -- сложить одинаковые пути {if not cbCablePathShowConnInSeparatePaths.Checked then PackWayList; } SaveWayListToTables; end; end; end; // // определяем подключенные точечные ConnectedCompons := GetConnectedPoints(FComponent,true); // если есть подключенные точечные - строим (* if ConnectedCompons.Count > 0 then begin BeginCable := nil; EndCable := nil; BeginCompons := nil; EndCompons := nil; // определяем начало и конец кабеля // если кабель всего один - он и будет начало/конец // а компоненты будут "сидеть" на нем с разных сторон if FComponent.WholeComponent.Count = 1 then begin BeginCable := FComponent; EndCable := FComponent; // строим списки компонент в начале и конце BeginCableSide := 1; EndCableSide := 2; BeginCompons := GetConnectedPointsBySide(ConnectedCompons, BeginCable, BeginCableSide); EndCompons := GetConnectedPointsBySide(ConnectedCompons, EndCable, EndCableSide); // если кабель расключен в конце меньше, то меняем начало и конец местами if BeginCompons.Count < EndCompons.Count then begin BeginCableSide := 2; EndCableSide := 1; BeginCompons := GetConnectedPointsBySide(ConnectedCompons, BeginCable, BeginCableSide); EndCompons := GetConnectedPointsBySide(ConnectedCompons, EndCable, EndCableSide); end; if CablesPassed = nil then CablesPassed := TSCSComponents.Create(false); // отобраннe отрезки кабеля CablesPassed.Add(BeginCable); end // если кусков кабеля несколько else begin // берем начало с одной стороны (определяем край) BeginCable := nil; while BeginCable = nil do begin for i := 0 to FComponent.WholeComponent.Count - 1 do begin k := 0; currCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(FComponent.WholeComponent[i]); for j := 0 to currCompon.JoinedComponents.Count - 1 do begin if (currCompon.JoinedComponents[j].IsLine = biTrue) and (currCompon.JoinedComponents[j].Whole_ID = FComponent.Whole_ID) then inc(k); end; // к концу кабеля подключен только один кусок кабеля - значит, это край if k = 1 then begin BeginCable := currCompon; break; end; end; end; // конец кабеля if CablesPassed = nil then CablesPassed := TSCSComponents.Create(false); // отобраннe отрезки кабеля CablesPassed.Add(BeginCable); EndCable := BeginCable; // чапаем от начала к концу кабеля // (так заодно и путь построим) while CablesPassed.Count <> FComponent.WholeComponent.Count do begin for i := 0 to FComponent.WholeComponent.Count - 1 do begin currCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(FComponent.WholeComponent[i]); for j := 0 to EndCable.JoinedComponents.Count - 1 do begin if EndCable.JoinedComponents[j] = currCompon then begin if CablesPassed.IndexOf(currCompon) = -1 then begin EndCable := currCompon; CablesPassed.Add(currCompon); break; end; end; end; end; end; // определяем начальные и конечные компоненты BeginCompons := GetConnectedPoints(BeginCable, false); EndCompons := GetConnectedPoints(EndCable, false); // если в начале кабель больше расключен if BeginCompons.Count > EndCompons.Count then begin // переопределяем начало/конец кабеля BeginCable := EndCable; CablesPassed.Clear; CablesPassed.Add(BeginCable); // строим путь заново (и конец заново определяем с другой стороны) while CablesPassed.Count <> FComponent.WholeComponent.Count do begin for i := 0 to FComponent.WholeComponent.Count - 1 do begin currCompon := F_ProjMan.GSCSBase.CurrProject.GetComponentFromReferences(FComponent.WholeComponent[i]); for j := 0 to EndCable.JoinedComponents.Count - 1 do begin if EndCable.JoinedComponents[j] = currCompon then begin if CablesPassed.IndexOf(currCompon) = -1 then begin EndCable := currCompon; CablesPassed.Add(currCompon); break; end; end; end; end; end; // переопределяем начальные и конечные компоненты BeginCompons := GetConnectedPoints(BeginCable, false); EndCompons := GetConnectedPoints(EndCable, false); end; end; // определяем стороны подключения интерфейсов к точечным компонентам на концах кабеля // (для определения соответствия занятых) BeginCableSide := 0; EndCableSide := 0; if BeginCompons.Count > 0 then begin for i := 0 to BeginCable.Interfaces.Count - 1 do begin if (BeginCable.Interfaces[i].TypeI = itFunctional) then begin for j := 0 to BeginCompons.Count - 1 do begin if BeginCable.Interfaces[i].CheckJoinToComponent(BeginCompons[j]) then begin BeginCableSide := BeginCable.Interfaces[i].Side; break; end; end; end; if BeginCableSide <> 0 then break; end; end; if EndCompons.Count > 0 then begin for i := 0 to EndCable.Interfaces.Count - 1 do begin if (EndCable.Interfaces[i].TypeI = itFunctional) then begin for j := 0 to EndCompons.Count - 1 do begin if EndCable.Interfaces[i].CheckJoinToComponent(EndCompons[j]) then begin EndCableSide := EndCable.Interfaces[i].Side; break; end; end; end; if EndCableSide <> 0 then break; end; end; // определяем количество типов занятых интерфейсов в кабеле (которые надо расписать) // будем смотреть по гуиду InterfNames := TStringList.Create; // смотрим в начале кабеля for i := 0 to BeginCable.Interfaces.Count - 1 do begin if BeginCable.Interfaces[i].TypeI = itFunctional then begin if BeginCable.Interfaces[i].IsBusy or BeginCable.Interfaces[i].KolvoBusy > 0 then begin if InterfNames.IndexOf(BeginCable.Interfaces[i].GUIDInterface) = -1 then InterfNames.Add(BeginCable.Interfaces[i].GUIDInterface); end; end; end; // теперь в конце for i := 0 to EndCable.Interfaces.Count - 1 do begin if EndCable.Interfaces[i].TypeI = itFunctional then begin if EndCable.Interfaces[i].IsBusy or EndCable.Interfaces[i].KolvoBusy > 0 then begin if InterfNames.IndexOf(EndCable.Interfaces[i].GUIDInterface) = -1 then InterfNames.Add(EndCable.Interfaces[i].GUIDInterface); end; end; end; // сбрасываем данные в таблицах (на всякий) {FmtCablePaths.Close; FmtCablePaths.Open; FmtCablePathsInfo.Close; FmtCablePathsInfo.Open;} // по типам интерфейсов (мало ли чего в кабеле попадется) for i := 0 to InterfNames.Count - 1 do begin // считаем количество занятых интерфейсов в кабеле по типам // имеем ввиду, что с разных сторон кабеля интерфейсов может быть // подключено разное количество, потому берем максимальное // если кабель подключен с обеих сторон if EndCompons.Count > 0 then begin if FComponent.WholeComponent.Count > 1 then // если частей кабеля несколько CableBusyInterFaces := Max(GetBusyInterfCountByType(InterfNames[i], BeginCable, true ,BeginCableSide),GetBusyInterfCountByType(InterfNames[i], EndCable, true, EndCableSide)) else // если кусок кабеля один CableBusyInterFaces := Max(GetBusyInterfCountByType(InterfNames[i], BeginCable, true, BeginCableSide),GetBusyInterfCountByType(InterfNames[i], BeginCable, true, EndCableSide)); end else // если кабель подключен с одной стороны, то и в конец придет столько // же занятых, сколько будет в начале begin if FComponent.WholeComponent.Count > 1 then CableBusyInterFaces := GetBusyInterfCountByType(InterfNames[i], BeginCable, true , BeginCableSide); end; // строим заголовки и описание к ним if (InterFaces <> nil) and (InterFaces.Count > 1) then begin if InterFaces = nil then InterFaces := TSCSInterFaces.Create(false); if InterFaces.Count > 0 then InterFaces.Clear; end; // смотрим расключение в начале кабеля по интерфейсам // и определяем занятые позиции // все функциональные интерфейсы кабеля if AllCableInterFaces = nil then AllCableInterFaces := TSCSInterFaces.Create(false); // в начале кабеля for j := 0 to BeginCable.Interfaces.Count - 1 do begin if (BeginCable.Interfaces[j].TypeI = itFunctional) and (BeginCable.Interfaces[j].Side = BeginCableSide) and (BeginCable.Interfaces[j].GUIDInterface = InterfNames[i]) then begin if AllCableInterFaces.IndexOf(BeginCable.Interfaces[j]) = -1 then AllCableInterFaces.Add(BeginCable.Interfaces[j]); end; end; // в конце кабеля // добавляем проверку на соответствие нумерации пар вначале и в конце, // потому что нумерация интерфейсов может не совпадать // (в проектах, сформированных в старых версиях программы) // если такое случилось, отчет не формируем, а выдадим сообщение, // дабы избежать .... NumPairEqual := true; for j := 0 to EndCable.Interfaces.Count - 1 do begin if (EndCable.Interfaces[j].TypeI = itFunctional) and (EndCable.Interfaces[j].Side = EndCableSide) and (EndCable.Interfaces[j].GUIDInterface = InterfNames[i]) then begin NumPairEqual := false; for k := 0 to AllCableInterFaces.Count - 1 do begin if AllCableInterFaces[k].Npp = EndCable.Interfaces[j].Npp then begin NumPairEqual := true; break; end; end; if NumPairEqual = false then break; // найдено несоответствие end; end; //если номерация интерфейсов на концах кабеля сходится, строим отчет, если нет - не строим и выдаем сообщение if NumPairEqual then begin // сортируем список интерфейсов по возрастанию порядкового номера // (если их больше одного) if AllCableInterFaces.Count > 1 then begin WasChangedInterFaces := true; while WasChangedInterFaces do begin WasChangedInterFaces := false; for j := 0 to AllCableInterFaces.Count - 2 do begin if AllCableInterFaces[j].Npp > AllCableInterFaces[j+1].Npp then begin WasChangedInterFaces := true; Interf := AllCableInterFaces[j]; AllCableInterFaces[j] := AllCableInterFaces[j+1]; AllCableInterFaces[j+1] := Interf; end; end; end; end; // подключение начала кабеля for j := 0 to BeginCable.Interfaces.Count - 1 do begin if (BeginCable.Interfaces[j].TypeI = itFunctional) and (BeginCable.Interfaces[j].GUIDInterface = InterfNames[i]) and (BeginCable.Interfaces[j].Side = BeginCableSide) then begin //если есть занятые позиции интерфейса, добавляем в список if (BeginCable.Interfaces[j].IsBusy = biTrue) or (BeginCable.Interfaces[j].KolvoBusy > 0) then begin PosNumber := 0; // текущая позиция для интерфейса if BeginCable.Interfaces[j].Npp > 1 then begin for l := 0 to BeginCable.Interfaces[j].Npp - 2 do begin PosNumber := PosNumber + AllCableInterFaces[l].Kolvo; end; end; for k := 0 to BeginCable.Interfaces[j].BusyPositions.Count - 1 do begin InterFacePosition := TSCSInterfPosition(BeginCable.Interfaces[j].BusyPositions[k]); // если занятая позиция интерфейса занимает одну позицию if (InterFacePosition.ToPos - InterFacePosition.FromPos = 0) then begin SetLength(PathList, Length(PathList)+1); PathListLength := Length(PathList); PathList[PathListLength-1].ID := PathListLength - 1; currID := PathList[PathListLength-1].ID; PathList[PathListLength-1].Name := ''; PathList[PathListLength-1].NameFrom := InterfacePosition.GetConnectedPos.InterfOwner.ComponentOwner; PathList[PathListLength-1].NameTo := nil; PathList[PathListLength-1].NppFrom := InterfacePosition.FromPos+PosNumber; PathList[PathListLength-1].NppTo := InterfacePosition.ToPos+PosNumber; PathList[PathListLength-1].Kolvo := 1; PathList[PathListLength-1].Passed := false; PathList[PathListLength-1].BeginPorts := TIntList.Create; PathList[PathListLength-1].EndPorts := TIntList.Create; PathList[PathListLength-1].BeginPortName := ''; PathList[PathListLength-1].EndPortName := ''; PathList[PathListLength-1].InterFacePositions := TIntList.Create; PathList[PathListLength-1].InterFacePositions.Add(InterfacePosition.FromPos+PosNumber); // смотрим, подключен ли порт и если да, то добавляем его if InterfacePosition.GetConnectedPos.InterfOwner.PortOwner <> nil then begin InterFacePosition1 := InterFacePosition.GetConnectedPos; if GetPortPosRangeByInterfRange(TSCSInterface(InterfacePosition1.InterfOwner), TSCSInterfPosition(InterfacePosition1).FromPos, TSCSInterfPosition(InterfacePosition1).ToPos, BeginPos, EndPos) then // если есть порты - добавляем в список begin if PathList[PathListLength-1].BeginPorts.Indexof(BeginPos) = -1 then PathList[PathListLength-1].BeginPorts.Add(BeginPos); PathList[PathListLength-1].BeginPortName := InterfacePosition1.InterfOwner.PortOwner.LoadName; end; end; end // если занятая позиция интерфейса занимает несколько позиций, то нужно ее расписать else begin for l := 0 to (InterFacePosition.ToPos - InterfacePosition.FromPos) do begin SetLength(PathList, Length(PathList)+1); PathListLength := Length(PathList); PathList[PathListLength-1].ID := PathListLength - 1; currID := PathList[PathListLength-1].ID; PathList[PathListLength-1].Name := ''; PathList[PathListLength-1].NameFrom := InterfacePosition.GetConnectedPos.InterfOwner.ComponentOwner; PathList[PathListLength-1].NameTo := nil; PathList[PathListLength-1].NppFrom := InterfacePosition.FromPos+PosNumber; PathList[PathListLength-1].NppTo := InterfacePosition.FromPos+PosNumber; PathList[PathListLength-1].Kolvo := 1; PathList[PathListLength-1].Passed := false; PathList[PathListLength-1].BeginPorts := TIntList.Create; PathList[PathListLength-1].EndPorts := TIntList.Create; PathList[PathListLength-1].BeginPortName := ''; PathList[PathListLength-1].EndPortName := ''; PathList[PathListLength-1].InterFacePositions := TIntList.Create; PathList[PathListLength-1].InterFacePositions.Add(InterfacePosition.FromPos+PosNumber); // смотрим, подключен ли порт и если да, то добавляем его if InterfacePosition.GetConnectedPos.InterfOwner.PortOwner <> nil then begin InterFacePosition1 := InterFacePosition.GetConnectedPos; if GetPortPosRangeByInterfRange(TSCSInterface(InterfacePosition1.InterfOwner), TSCSInterfPosition(InterfacePosition1).FromPos, TSCSInterfPosition(InterfacePosition1).ToPos, BeginPos, EndPos) then // если есть порты - добавляем в список begin // showmessage(GetPortCaption(InterfacePosition.GetConnectedPos.InterfOwner.PortOwner, BeginPos)); if PathList[PathListLength-1].BeginPorts.Indexof(BeginPos) = -1 then PathList[PathListLength-1].BeginPorts.Add(BeginPos); PathList[PathListLength-1].BeginPortName := InterfacePosition1.InterfOwner.PortOwner.LoadName; end; end; inc(PosNumber); end; end; end; end; end; end; // подключение кончала кабеля (если есть конечные компоненты) if EndCompons.Count > 0 then begin for j := 0 to EndCable.Interfaces.Count - 1 do begin if (EndCable.Interfaces[j].TypeI = itFunctional) and (EndCable.Interfaces[j].GUIDInterface = InterfNames[i]) and (EndCable.Interfaces[j].Side = EndCableSide) then begin //если есть занятые позиции интерфейса, добавляем в список if (EndCable.Interfaces[j].IsBusy = biTrue) or (EndCable.Interfaces[j].KolvoBusy > 0) then begin PosNumber := 0; // текущая позиция для интерфейса if EndCable.Interfaces[j].Npp > 1 then begin for l := 0 to EndCable.Interfaces[j].Npp - 2 do begin PosNumber := PosNumber + AllCableInterFaces[l].Kolvo; end; end; for k := 0 to EndCable.Interfaces[j].BusyPositions.Count - 1 do begin InterFacePosition := TSCSInterfPosition(EndCable.Interfaces[j].BusyPositions[k]); // если занятая позиция интерфейса занимает одну позицию if (InterFacePosition.ToPos - InterFacePosition.FromPos = 0) then begin SetLength(EndPathList, Length(EndPathList)+1); PathListLength := Length(EndPathList); EndPathList[PathListLength-1].ID := PathListLength - 1; currID := EndPathList[PathListLength-1].ID; EndPathList[PathListLength-1].Name := ''; EndPathList[PathListLength-1].NameFrom := nil; EndPathList[PathListLength-1].NameTo := InterfacePosition.GetConnectedPos.InterfOwner.ComponentOwner; EndPathList[PathListLength-1].NppFrom := 0; EndPathList[PathListLength-1].NppTo := InterfacePosition.FromPos+PosNumber; EndPathList[PathListLength-1].Kolvo := 1; EndPathList[PathListLength-1].Passed := false; EndPathList[PathListLength-1].BeginPorts := TIntList.Create; EndPathList[PathListLength-1].EndPorts := TIntList.Create; EndPathList[PathListLength-1].BeginPortName := ''; EndPathList[PathListLength-1].EndPortName := ''; EndPathList[PathListLength-1].InterFacePositions := TIntList.Create; EndPathList[PathListLength-1].InterFacePositions.Add(InterfacePosition.FromPos+PosNumber); // смотрим, подключен ли порт и если да, то добавляем его if InterfacePosition.GetConnectedPos.InterfOwner.PortOwner <> nil then begin InterFacePosition1 := InterFacePosition.GetConnectedPos; if GetPortPosRangeByInterfRange(TSCSInterface(InterfacePosition1.InterfOwner), TSCSInterfPosition(InterfacePosition1).FromPos, TSCSInterfPosition(InterfacePosition1).ToPos, BeginPos, EndPos) then // если есть порты - добавляем в список begin // if EndPathList[PathListLength-1].EndPorts.Indexof(BeginPos) = -1 then EndPathList[PathListLength-1].EndPorts.Add(BeginPos); EndPathList[PathListLength-1].EndPortName := InterfacePosition1.InterfOwner.PortOwner.LoadName; end; end; end // если занятая позиция интерфейса занимает несколько позиций, то нужно ее расписать else begin for l := 0 to (InterFacePosition.ToPos - InterfacePosition.FromPos) do begin SetLength(EndPathList, Length(EndPathList)+1); PathListLength := Length(EndPathList); EndPathList[PathListLength-1].ID := PathListLength - 1; currID := EndPathList[PathListLength-1].ID; EndPathList[PathListLength-1].Name := ''; EndPathList[PathListLength-1].NameFrom := nil; EndPathList[PathListLength-1].NameTo := InterfacePosition.GetConnectedPos.InterfOwner.ComponentOwner; EndPathList[PathListLength-1].NppFrom := 0; EndPathList[PathListLength-1].NppTo := InterfacePosition.FromPos+PosNumber; EndPathList[PathListLength-1].Kolvo := 1; EndPathList[PathListLength-1].Passed := false; EndPathList[PathListLength-1].BeginPorts := TIntList.Create; EndPathList[PathListLength-1].EndPorts := TIntList.Create; EndPathList[PathListLength-1].BeginPortName := ''; EndPathList[PathListLength-1].EndPortName := ''; EndPathList[PathListLength-1].InterFacePositions := TIntList.Create; EndPathList[PathListLength-1].InterFacePositions.Add(InterfacePosition.FromPos+PosNumber); // смотрим, подключен ли порт и если да, то добавляем его if InterfacePosition.GetConnectedPos.InterfOwner.PortOwner <> nil then begin InterFacePosition1 := InterFacePosition.GetConnectedPos; if GetPortPosRangeByInterfRange(TSCSInterface(InterfacePosition1.InterfOwner), TSCSInterfPosition(InterfacePosition1).FromPos, TSCSInterfPosition(InterfacePosition1).ToPos, BeginPos, EndPos) then // если есть порты - добавляем в список begin EndPathList[PathListLength-1].EndPorts.Add(BeginPos); EndPathList[PathListLength-1].EndPortName := InterfacePosition1.InterfOwner.PortOwner.LoadName; end; end; inc(PosNumber); end; end; end; end; end; end; // сортируем списки SortListByPositions(PathList); SortListByPositions(EndPathList); // складываем по типу интерфейса те записи, где одинаковые начальный и конечный компонент подключения // (или нет в конце, или нет в начале) if Length(EndPathList) > 0 then begin l := Length(PathList) - 1; // ищем и прописываем двосторонние подключения for j := 0 to l do begin for k := 0 to Length(EndPathList) - 1 do begin if PathList[j].NppFrom = EndPathList[k].NppTo then begin PathList[j].EndPortName := EndPathList[k].EndPortName; PathList[j].NameTo := EndPathList[k].NameTo; if EndPathList[k].EndPorts.Count > 0 then begin for l := 0 to EndPathList[k].EndPorts.Count - 1 do PathList[j].EndPorts.Add(EndPathList[k].EndPorts[l]); end; PathList[j].NppTo := EndPathList[k].NppTo; PathList[j].NameTo := EndPathList[k].NameTo; end; end; end; end; // смотрим не расключенные с конца for j := 0 to Length(EndPathList) - 1 do begin passed := true; for k := 0 to Length(PathList) - 1 do begin if EndPathList[j].NppTo = PathList[k].NppFrom then begin passed := false; break; end; end; // нашли подключение в никуда с конца - добавляем в список if passed <> false then begin SetLength(PathList,Length(PathList)+1); PathListLength := Length(PathList); PathList[PathListLength-1].ID := PathListLength - 1; PathList[PathListLength-1].Name := ''; PathList[PathListLength-1].NameFrom := nil; PathList[PathListLength-1].NameTo := EndPathList[j].NameTo; PathList[PathListLength-1].NppFrom := EndPathList[j].NppTo; PathList[PathListLength-1].NppTo := EndPathList[j].NppTo; PathList[PathListLength-1].Kolvo := 1; PathList[PathListLength-1].Passed := false; PathList[PathListLength-1].BeginPorts := TIntList.Create; PathList[PathListLength-1].EndPorts := TIntList.Create; PathList[PathListLength-1].BeginPortName := ''; PathList[PathListLength-1].EndPortName := EndPathLIst[j].EndPortName; if EndPathList[j].EndPorts.Count > 0 then PathList[PathListLength-1].EndPorts.Add(EndPathList[j].EndPorts[0]); // порт тут один PathList[PathListLength-1].InterFacePositions := TIntList.Create; PathList[PathListLength-1].InterFacePositions.Add(EndPathList[j].InterFacePositions[0]); // позиция тут одна end; end; end else SortListByPositions(PathList); SortListByPositions(PathList); //здесь уже все расключение сидит // определяем, вложен ли кабель в кабельные каналы (хоть где-нибудь) HasCableCanals := false; if cbCablePathShowCableCanals.Checked then begin for j := 0 to CablesPassed.Count - 1 do begin if CablesPassed[j].GetParentComponent <> nil then begin HasCableCanals := true; break; end; end; end; //интерфейс (потом из него выгребем наименование) Interf := nil; for j := 0 to BeginCable.Interfaces.Count - 1 do begin if Begincable.Interfaces[j].GUIDInterface = InterfNames[i] then begin Interf := BeginCable.Interfaces[j]; break; end; end; // если интерфейс только в конце кабеля, смотрим там if Interf = nil then begin for j := 0 to EndCable.Interfaces.Count - 1 do begin if EndCable.Interfaces[j].GUIDInterface = InterfNames[i] then begin Interf := EndCable.Interfaces[j]; break; end; end; end; // ЕСЛИ ПОКАЗЫВАТЬ ДЕТАЛЬНОЕ РАСКЛЮЧЕНИЕ КАБЕЛЯ if cbCablePathShowConnInSeparatePaths.Checked then begin l := Length(PathList); // сбрасываем в таблицу // разложим в три прохода, чтобы было "кирасиво" if NameList = nil then NameList:=TStringList.Create else NameList.Clear; PosNumber := 0; for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo <> nil)) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := PathList[j].ID; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(PathList[j].InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathList[j].NppTo; // откуда // если есть порты, добавляем имя и номера занятых s:=''; if PathList[j].BeginPortName <> '' then begin s := ' ' + PathList[j].BeginPortName + GetNumberCount(PathList[j].BeginPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameFrom <> nil then begin if not PathList[j].NameFrom.IsTop then NameList.Insert(0,PathList[j].NameFrom.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameFrom <> nil) and (not PathList[j].NameFrom.IsTop) then NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда s :=''; if PathList[j].EndPortName <> '' then begin s:= ' ' + PathList[j].EndPortName + GetNumberCount(PathList[j].EndPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameTo <> nil then begin if not PathList[j].NameTo.IsTop then NameList.Insert(0,PathList[j].NameTo.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameTo.GetfirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameTo <> nil) and (not PathList[j].NameTo.IsTop) then NameList.Insert(0,PathList[j].NameTo.getfirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; //теперь описание //начальный объект (если есть) s := ''; if PathList[j].NameFrom <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; // если подключен топовый компонент - выводим в описание, если нет, // то поднимаемся до топа, добавляя всех парентов по пути к топу if PathList[j].NameFrom.IsTop then s := PathList[j].NameFrom.GetNameForVisible(true) else begin currCompon := PathList[j].NameFrom; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].BeginPortName <> '' then s := s + ' / ' + PathList[j].BeginPortName; if PathList[j].BeginPorts.Count > 0 then s := s + GetNumberCount(PathList[j].BeginPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameFrom.GetNameForVisible(true)+; s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].Kolvo; //.BeginPorts.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; // кабель PosNumber := WriteCableToTbl(CablesPassed, PathList[j].InterFacePositions, PosNumber, PathList[j].ID, PathList[j].InterFacePositions.Count); //кончальный объект (если есть) s := ''; if PathList[j].NameTo <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; if PathList[j].NameTo.IsTop then s := PathList[j].NameTo.GetNameForVisible(true) else begin currCompon := PathList[j].NameTo; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].EndPortName <> '' then s := s + ' / ' + PathList[j].EndPortName; if PathList[j].EndPorts.Count > 0 then s := s + GetNumberCount(PathList[j].EndPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameTo.GetNameForVisible(true); s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterfacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; FmtCablePaths.Post; end; end; end; NameList.Clear; for j := 0 to Length(PathList) - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo = nil )) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := PathList[j].ID; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(PathList[j].InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathList[j].NppTo; // откуда // если есть порты, добавляем имя и номера занятых s:=''; if PathList[j].BeginPortName <> '' then begin s := ' ' + PathList[j].BeginPortName + GetNumberCount(PathList[j].BeginPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameFrom <> nil then begin if not PathList[j].NameFrom.IsTop then NameList.Insert(0,PathList[j].NameFrom.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameFrom <> nil) and (not PathList[j].NameFrom.IsTop) then NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда s :=''; if PathList[j].EndPortName <> '' then begin s:= ' ' + PathList[j].EndPortName + GetNumberCount(PathList[j].EndPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameTo <> nil then begin if not PathList[j].NameTo.IsTop then NameList.Insert(0,PathList[j].NameTo.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameTo.GetfirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameTo <> nil) and (not PathList[j].NameTo.IsTop) then NameList.Insert(0,PathList[j].NameTo.getfirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; //теперь описание //начальный объект (если есть) s := ''; if PathList[j].NameFrom <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; // если подключен топовый компонент - выводим в описание, если нет, // то поднимаемся до топа, добавляя всех парентов по пути к топу if PathList[j].NameFrom.IsTop then s := PathList[j].NameFrom.GetNameForVisible(true) else begin currCompon := PathList[j].NameFrom; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].BeginPortName <> '' then s := s + ' / ' + PathList[j].BeginPortName; if PathList[j].BeginPorts.Count > 0 then s := s + GetNumberCount(PathList[j].BeginPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameFrom.GetNameForVisible(true)+; s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].Kolvo; //.BeginPorts.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; // кабель PosNumber := WriteCableToTbl(CablesPassed, PathList[j].InterFacePositions, PosNumber, PathList[j].ID, PathList[j].InterFacePositions.Count); //кончальный объект (если есть) s := ''; if PathList[j].NameTo <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; if PathList[j].NameTo.IsTop then s := PathList[j].NameTo.GetNameForVisible(true) else begin currCompon := PathList[j].NameTo; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].EndPortName <> '' then s := s + ' / ' + PathList[j].EndPortName; if PathList[j].EndPorts.Count > 0 then s := s + GetNumberCount(PathList[j].EndPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameTo.GetNameForVisible(true); s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterfacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; FmtCablePaths.Post; end; end; end; NameList.Clear; for j := 0 to Length(PathList) - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom = nil) and (PathList[j].NameTo <> nil)) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := PathList[j].ID; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(PathList[j].InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathList[j].NppTo; // откуда // если есть порты, добавляем имя и номера занятых s:=''; if PathList[j].BeginPortName <> '' then begin s := ' ' + PathList[j].BeginPortName + GetNumberCount(PathList[j].BeginPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameFrom <> nil then begin if not PathList[j].NameFrom.IsTop then NameList.Insert(0,PathList[j].NameFrom.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameFrom <> nil) and (not PathList[j].NameFrom.IsTop) then NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда s :=''; if PathList[j].EndPortName <> '' then begin s:= ' ' + PathList[j].EndPortName + GetNumberCount(PathList[j].EndPorts); NameList.Insert(0,s); s:=''; end; if PathList[j].NameTo <> nil then begin if not PathList[j].NameTo.IsTop then NameList.Insert(0,PathList[j].NameTo.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameTo.GetfirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameTo <> nil) and (not PathList[j].NameTo.IsTop) then NameList.Insert(0,PathList[j].NameTo.getfirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; //теперь описание //начальный объект (если есть) s := ''; if PathList[j].NameFrom <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; // если подключен топовый компонент - выводим в описание, если нет, // то поднимаемся до топа, добавляя всех парентов по пути к топу if PathList[j].NameFrom.IsTop then s := PathList[j].NameFrom.GetNameForVisible(true) else begin currCompon := PathList[j].NameFrom; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].BeginPortName <> '' then s := s + ' / ' + PathList[j].BeginPortName; if PathList[j].BeginPorts.Count > 0 then s := s + GetNumberCount(PathList[j].BeginPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameFrom.GetNameForVisible(true)+; s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterFacePositions.Count; //.BeginPorts.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; // кабель PosNumber := WriteCableToTbl(CablesPassed, PathList[j].InterFacePositions, PosNumber, PathList[j].ID, PathList[j].InterFacePositions.Count); //кончальный объект (если есть) s := ''; if PathList[j].NameTo <> nil then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := j; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := PathList[j].ID; if PathList[j].NameTo.IsTop then s := PathList[j].NameTo.GetNameForVisible(true) else begin currCompon := PathList[j].NameTo; while not currCompon.IsTop do begin if s <> '' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; if PathList[j].EndPortName <> '' then s := s + ' / ' + PathList[j].EndPortName; if PathList[j].EndPorts.Count > 0 then s := s + GetNumberCount(PathList[j].EndPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s;//PathList[j].NameTo.GetNameForVisible(true); s := ''; // количество портов (если есть) FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterfacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; FmtCablePaths.Post; end; end; end; NameList.Clear; end else // НЕ ПОКАЗЫВАТЬ РАСКЛЮЧЕНИЕ КАБЕЛЯ В ОТДЕЛЬНЫХ ПУТЯХ begin // теперь нужно сложить порты и пары по топовым компонентам // (учесть типы и номера портов, если таковые имеются) l := Length(PathList); if NameList = nil then NameList:=TStringList.Create else NameList.Clear; PosNumber := 0; l := Length(PathList); SetLength(EndPathList,0); // дублируем список for j := 0 to l - 1 do begin SetLength(EndPathList, Length(EndPathList) + 1); PathListLength := Length(EndPathList) - 1; EndPathList[PathListLength].ID := PathList[j].ID; EndPathList[PathListLength].BeginPortName := PathList[j].BeginPortName; EndPathList[PathListLength].EndPortName := PathList[j].EndPortName; EndPathList[PathListLength].BeginPorts := TIntList.Create; if PathList[j].BeginPorts.Count > 0 then begin for k := 0 to PathList[j].BeginPorts.Count - 1 do EndPathList[PathListLength].BeginPorts.Add(PathList[j].BeginPorts[k]); end; EndPathList[PathListLength].EndPorts := TIntList.Create; if PathList[j].EndPorts.Count > 0 then begin for k := 0 to PathList[j].EndPorts.Count - 1 do EndPathList[PathListLength].EndPorts.Add(PathList[j].EndPorts[k]); end; EndPathList[PathListLength].Kolvo := PathList[j].Kolvo; EndPathList[PathListLength].FromTo := PathList[j].FromTo; EndPathList[PathListLength].NppFrom := PathList[j].NppFrom; EndPathList[PathListLength].NppTo := PathList[j].NppTo; EndPathList[PathListLength].InterFacePositions := TIntList.Create; if PathList[j].InterFacePositions.Count > 0 then begin for k := 0 to PathList[j].InterFacePositions.Count - 1 do begin EndPathList[PathListLength].InterFacePositions.Add(PathList[j].InterFacePositions[k]); end; end; if PathList[j].NameFrom = nil then EndPathList[PathListLength].NameFrom := nil else EndPathList[PathListLength].NameFrom := PathList[j].NameFrom; if PathList[j].NameTo = nil then EndPathList[PathListLength].NameTo := nil else EndPathList[PathListLength].NameTo := PathList[j].NameTo; EndPathList[PathListLength].Passed := PathList[j].Passed; end; // end копирования списка // сначала складываем интерфейсы (пары) по портам(компонентам) подключения // для начальных компонент в первом списке for j := 0 to l - 2 do begin if PathList[j].Passed = false then begin for k := j+1 to l - 1 do begin // если одинаковые "откуда-куда" (объекты) if ((PathList[j].NameFrom = PathList[k].NameFrom) and (PathList[j].NameTo = PathList[k].NameTo)) or ((PathList[j].NameFrom = nil) and (PathList[k].NameFrom = nil) and (PathList[j].NameTo = PathList[k].NameTo)) or ((PathList[j].NameFrom = PathList[k].NameFrom) and (PathList[j].NameTo = nil) and (PathList[k].NameTo=nil)) or ((PathList[j].NameFrom = PathList[k].NameFrom) and (PathList[j].NameTo <> PathList[k].NameTo)) then begin // теперь надо проверить порты (есть, нет, и одинаковые ли) // для того, чтобы сложить пары, идущие к одинаковым портам или объектам // (или в "никуда" с одного конца) // порты здесь пока разложены по одной штуке // если типы портов подключения одинаковые и порты одинаковые, то складываем пары // если подключено по портам if ( (PathList[j].BeginPortName = PathList[k].BeginPortName) and (PathLIst[j].BeginPortName <> '') and (PathList[k].BeginPortName <> '') and (PathList[j].BeginPorts[0] = PathList[k].BeginPorts[0]) ) or // портов нет, складываем пары подключенные к одним и тем же компонентам ( ((PathLIst[j].BeginPortName = '') and (PathList[k].BeginPortName = '')) and ((PathLIst[j].NameFrom = PathLIst[k].NameFrom) and (PathLIst[j].NameTo = PathLIst[k].NameTo)) ) then begin inc(PathList[j].Kolvo); PathList[k].Passed := true; // пары PathList[j].InterFacePositions.Add(PathList[k].InterFacePositions[0]); end; end; end; end; end; // собрали список // Делаем то же самое для конечных компонент for j := 0 to l - 2 do begin if EndPathList[j].Passed = false then begin for k := j+1 to l - 1 do begin // если одинаковые "откуда-куда" (объекты) if ((EndPathList[j].NameFrom = EndPathList[k].NameFrom) and (EndPathList[j].NameTo = EndPathList[k].NameTo)) or ((EndPathList[j].NameFrom = nil) and (EndPathList[k].NameFrom = nil) and (EndPathList[j].NameTo = EndPathList[k].NameTo)) or ((EndPathList[j].NameFrom = EndPathList[k].NameFrom) and (EndPathList[j].NameTo = nil) and (EndPathList[k].NameTo=nil)) or ((EndPathList[j].NameTo = EndPathList[k].NameTo) and (EndPathList[j].NameFrom <> EndPathList[k].NameFrom)) then begin // теперь надо проверить порты (есть, нет, и одинаковые ли) // для того, чтобы сложить пары, идущие к одинаковым портам или объектам // (или в "никуда" с одного конца) // порты здесь пока разложены по одной штуке // если типы портов подключения одинаковые и порты одинаковые, то складываем пары if ( (EndPathList[j].EndPortName = EndPathList[k].EndPortName) and (EndPathList[j].EndPortName <> '') and (EndPathList[k].EndPortName <>'') and (EndPathList[j].EndPorts[0] = EndPathList[k].EndPorts[0]) ) or // портов нет, складываем пары подключенные к одним и тем же компонентам ( ((EndPathLIst[j].EndPortName = '') and (EndPathList[k].EndPortName = '')) and ((EndPathLIst[j].NameFrom = EndPathLIst[k].NameFrom) and (EndPathLIst[j].NameTo = EndPathLIst[k].NameTo)) ) then begin inc(EndPathList[j].Kolvo); EndPathList[k].Passed := true; EndPathList[j].InterFacePositions.Add(EndPathList[k].InterFacePositions[0]); end; end; end; end; end; // собрали список // позиции интерфейсов if InterFacePositions = nil then InterFacePositions := TIntList.Create else InterFacePositions.Clear; PosNumber := 0; // ID подчиненной таблицы SetLength(BeginPortInfo,0); SetLength(EndPortInfo,0); Passed := false; // ПИШЕМ ТАБЛИЧКИ (сначала - описание, потом сформируем заголовки) // сначала пишем те, где есть "откуда - куда" (если есть) //проверяем, есть ли такие for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo <> nil)) then begin passed := true; break; end; end; end; // если есть - пишем //начало(откуда) if Passed then begin for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo <> nil)) then begin // позиции интерфейсов складываем в список for k := 0 to PathList[j].InterFacePositions.Count - 1 do begin if InterFacePositions.IndexOf(PathList[j].InterFacePositions[k]) = -1 then InterFacePositions.Add(PathList[j].InterFacePositions[k]); end; // порты тоже складываем в список по наименованиям if PathList[j].BeginPortName <> '' then begin // если инфы о портах пока нет - добавляем сразу if Length(BeginPortInfo) = 0 then begin SetLength(BeginPortInfo,Length(BeginPortInfo)+1); m := Length(BeginPortInfo) - 1 ; BeginPortInfo[m].PortName := PathList[j].BeginPortName; BeginPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному BeginPortInfo[m].Ports.Add(PathList[j].BeginPorts[0]); end // если есть, смотрим, куда добавить else begin passed := false; for m := 0 to Length(BeginPortInfo) - 1 do begin if BeginPortInfo[m].PortName = PathList[j].BeginPortName then begin if BeginPortInfo[m].Ports.IndexOf(PathList[j].BeginPorts[0]) = -1 then BeginPortInfo[m].Ports.Add(PathLIst[j].BeginPorts[0]); Passed := true; break; end; end; if passed = false then begin SetLength(BeginPortInfo,Length(BeginPortInfo)+1); m := Length(BeginPortInfo) - 1 ; BeginPortInfo[m].PortName := PathList[j].BeginPortName; BeginPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному BeginPortInfo[m].Ports.Add(PathList[j].BeginPorts[0]); end; end; end; //пишем порт (компонент) в таблицу inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := 1; s := ' '; if PathList[j].NameFrom <> nil then begin if PathList[j].NameFrom.IsTop then s := PathList[j].NameFrom.GetNameForVisible(true) else begin currCompon := PathList[j].NameFrom; while not currCompon.IsTop do begin if s <> ' ' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; end; if PathList[j].BeginPortName <> '' then s := s + ' / ' + PathList[j].BeginPortName; if PathList[j].BeginPorts.Count > 0 then s := s + GetNumberCount(PathList[j].BeginPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterFacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; end; end; // кабель PosNumber := WriteCableToTbl(CablesPassed, InterFacePositions, PosNumber, 1, InterFacePositions.Count ); // конец (куда) for j := 0 to l - 1 do begin if ((EndPathList[j].NameFrom <> nil) and (EndPathList[j].NameTo <> nil)) then begin if EndPathList[j].passed = false then begin // порты складываем в список по наименованиям if EndPathList[j].EndPortName <> '' then begin // если инфы о портах пока нет - добавляем сразу if Length(EndPortInfo) = 0 then begin SetLength(EndPortInfo,Length(EndPortInfo)+1); m := Length(EndPortInfo) - 1 ; EndPortInfo[m].PortName := EndPathList[j].EndPortName; EndPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному EndPortInfo[m].Ports.Add(EndPathList[j].EndPorts[0]); end // если есть, смотрим, куда добавить else begin passed := false; for m := 0 to Length(EndPortInfo) - 1 do begin if EndPortInfo[m].PortName = EndPathList[j].EndPortName then begin if EndPortInfo[m].Ports.IndexOf(EndPathList[j].EndPorts[0]) = -1 then EndPortInfo[m].Ports.Add(EndPathLIst[j].EndPorts[0]); Passed := true; break; end; end; if passed = false then begin SetLength(EndPortInfo,Length(EndPortInfo)+1); m := Length(EndPortInfo) - 1 ; EndPortInfo[m].PortName := EndPathList[j].EndPortName; EndPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному EndPortInfo[m].Ports.Add(EndPathList[j].EndPorts[0]); end; end; end; //пишем порт (компонент) в таблицу inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := 1; s := ' '; if EndPathList[j].NameTo <> nil then begin if EndPathList[j].NameTo.IsTop then s := EndPathList[j].NameTo.GetNameForVisible(true) else begin currCompon := EndPathList[j].NameTo; while not currCompon.IsTop do begin if s <> ' ' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; end; if EndPathList[j].EndPortName <> '' then s := s + ' / ' + EndPathList[j].EndPortName; if PathList[j].EndPorts.Count > 0 then s := s + GetNumberCount(EndPathList[j].EndPorts); s := GetNumberCount(EndPathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := EndPathList[j].InterFacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; end; end; // теперь пишем заголовок if NameList = nil then NameList := TStringList.Create else NameList.Clear; for j := 0 to l - 1 do begin if ((PathList[j].NameFrom <> nil ) and (PathList[j].NameTo <> nil)) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := 1; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathList[j].NppTo; // откуда // если есть начальные порты, добавляем имя и номера занятых s:=''; if Length(BeginPortInfo) > 0 then begin for k := 0 to Length(BeginPortInfo) - 1 do begin if s <> '' then s := s + ','; s := s + BeginPortInfo[k].PortName + GetNumberCount(BeginPortInfo[k].Ports); end; NameList.Insert(0,s); s:=''; end; if PathList[j].NameFrom <> nil then begin if not PathList[j].NameFrom.IsTop then NameList.Insert(0,PathList[j].NameFrom.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameFrom <> nil) and (not PathList[j].NameFrom.IsTop) then NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда s :=''; if Length(EndPortInfo) > 0 then begin for k := 0 to Length(EndPortInfo) - 1 do begin if s <> '' then s := s + ','; s := s + EndPortInfo[k].PortName + GetNumberCount(EndPortInfo[k].Ports); end; NameList.Insert(0,s); s:=''; end; if PathList[j].NameTo <> nil then begin if not PathList[j].NameTo.IsTop then NameList.Insert(0,PathList[j].NameTo.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameTo.GetfirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameTo <> nil) and (not PathList[j].NameTo.IsTop) then NameList.Insert(0,PathList[j].NameTo.getfirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; FmtCablePaths.Post; break; end; end; end; //============================================================================================================= if InterFacePositions = nil then InterFacePositions := TIntList.Create else InterFacePositions.Clear; SetLength(BeginPortInfo,0); SetLength(EndPortInfo,0); // откуда - "никуда" Passed := false; for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo = nil)) then begin passed := true; break; end; end; end; // если есть - пишем if Passed then begin // начало for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom <> nil) and (PathList[j].NameTo = nil)) then begin // позиции интерфейсов складываем в список for k := 0 to PathList[j].InterFacePositions.Count - 1 do begin if InterFacePositions.IndexOf(PathList[j].InterFacePositions[k]) = -1 then InterFacePositions.Add(PathList[j].InterFacePositions[k]); end; // порты тоже складываем в список по наименованиям if PathList[j].BeginPortName <> '' then begin // если инфы о портах пока нет - добавляем сразу if Length(BeginPortInfo) = 0 then begin SetLength(BeginPortInfo,Length(BeginPortInfo)+1); m := Length(BeginPortInfo) - 1 ; BeginPortInfo[m].PortName := PathList[j].BeginPortName; BeginPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному BeginPortInfo[m].Ports.Add(PathList[j].BeginPorts[0]); end // если есть, смотрим, куда добавить else begin passed := false; for m := 0 to Length(BeginPortInfo) - 1 do begin if BeginPortInfo[m].PortName = PathList[j].BeginPortName then begin if BeginPortInfo[m].Ports.IndexOf(PathList[j].BeginPorts[0]) = -1 then BeginPortInfo[m].Ports.Add(PathLIst[j].BeginPorts[0]); Passed := true; break; end; end; if passed = false then begin SetLength(BeginPortInfo,Length(BeginPortInfo)+1); m := Length(BeginPortInfo) - 1 ; BeginPortInfo[m].PortName := PathList[j].BeginPortName; BeginPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному BeginPortInfo[m].Ports.Add(PathList[j].BeginPorts[0]); end; end; end; //пишем порт (компонент) в таблицу inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := 2; s := ' '; if PathList[j].NameFrom <> nil then begin if PathList[j].NameFrom.IsTop then s := PathList[j].NameFrom.GetNameForVisible(true) else begin currCompon := PathList[j].NameFrom; while not currCompon.IsTop do begin if s <> ' ' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; end; if PathList[j].BeginPortName <> '' then s := s + ' / ' + PathList[j].BeginPortName; if PathList[j].BeginPorts.Count > 0 then s := s + GetNumberCount(PathList[j].BeginPorts); s := GetNumberCount(PathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := PathList[j].InterFacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; end; end; //кончала не будет - сразу пишем кабель (и алес) // кабель PosNumber := WriteCableToTbl(CablesPassed, InterFacePositions, PosNumber, 2, InterFacePositions.Count ); // теперь заголовок if NameList = nil then NameList := TStringList.Create else NameList.Clear; for j := 0 to l - 1 do begin if ((PathList[j].NameFrom <> nil ) and (PathList[j].NameTo = nil)) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := 2; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathList[j].NppTo; // откуда // если есть начальные порты, добавляем имя и номера занятых s:=''; if Length(BeginPortInfo) > 0 then begin for k := 0 to Length(BeginPortInfo) - 1 do begin if s <> '' then s := s + ','; s := s + BeginPortInfo[k].PortName + GetNumberCount(BeginPortInfo[k].Ports); end; NameList.Insert(0,s); s:=''; end; if PathList[j].NameFrom <> nil then begin if not PathList[j].NameFrom.IsTop then NameList.Insert(0,PathList[j].NameFrom.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (PathList[j].NameFrom <> nil) and (not PathList[j].NameFrom.IsTop) then NameList.Insert(0,PathList[j].NameFrom.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда NameList.Insert(0,' '); FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; FmtCablePaths.Post; break; end; end; end; Passed := false; //================================================================================================================= if InterFacePositions = nil then InterFacePositions := TIntList.Create else InterFacePositions.Clear; SetLength(BeginPortInfo,0); SetLength(EndPortInfo,0); // "из никуда" - "куда" for j := 0 to l - 1 do begin if PathList[j].Passed = false then begin if ((PathList[j].NameFrom = nil) and (PathList[j].NameTo <> nil)) then begin passed := true; break; end; end; end; // если есть - пишем // тут немножко не так, сначала считаем, потом пишем кабель, а потом компоненты if Passed then begin for j := 0 to l - 1 do begin if ((EndPathList[j].NameFrom = nil) and (EndPathList[j].NameTo <> nil)) then begin if EndPathList[j].passed = false then begin // позиции интерфейсов for k := 0 to EndPathList[j].InterFacePositions.Count - 1 do begin if InterFacePositions.IndexOf(EndPathList[j].InterFacePositions[k]) = -1 then InterFacePositions.Add(EndPathList[j].InterFacePositions[k]); end; // порты складываем в список по наименованиям if EndPathList[j].EndPortName <> '' then begin // если инфы о портах пока нет - добавляем сразу if Length(EndPortInfo) = 0 then begin SetLength(EndPortInfo,Length(EndPortInfo)+1); m := Length(EndPortInfo) - 1 ; EndPortInfo[m].PortName := EndPathList[j].EndPortName; EndPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному EndPortInfo[m].Ports.Add(EndPathList[j].EndPorts[0]); end // если есть инфа о портах, смотрим, куда добавить else begin passed := false; for m := 0 to Length(EndPortInfo) - 1 do begin if EndPortInfo[m].PortName = EndPathList[j].EndPortName then begin if EndPortInfo[m].Ports.IndexOf(EndPathList[j].EndPorts[0]) = -1 then EndPortInfo[m].Ports.Add(EndPathLIst[j].EndPorts[0]); Passed := true; break; end; end; if passed = false then begin SetLength(EndPortInfo,Length(EndPortInfo)+1); m := Length(EndPortInfo) - 1 ; EndPortInfo[m].PortName := EndPathList[j].EndPortName; EndPortInfo[m].Ports := TIntList.Create; // порты сидят в списке по одному EndPortInfo[m].Ports.Add(EndPathList[j].EndPorts[0]); end; end; end; end; end; end; // начала не будет - сразу пишем кабель // кабель PosNumber := WriteCableToTbl(CablesPassed, InterFacePositions, PosNumber, 3, InterFacePositions.Count ); // пишем конечные подключения for j := 0 to l - 1 do begin if ((EndPathList[j].NameFrom = nil) and (EndPathList[j].NameTo <> nil)) then begin if EndPathList[j].passed = false then begin //пишем порт (компонент) в таблицу inc(PosNumber); FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnID).AsInteger := PosNumber; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := 3; s := ' '; if EndPathList[j].NameTo <> nil then begin if EndPathList[j].NameTo.IsTop then s := EndPathList[j].NameTo.GetNameForVisible(true) else begin currCompon := EndPathList[j].NameTo; while not currCompon.IsTop do begin if s <> ' ' then s := currCompon.GetNameForVisible(true) + '/' + s else s := currCompon.GetNameForVisible(true); currCompon := currCompon.GetParentComponent; end; end; end; if EndPathList[j].EndPortName <> '' then s := s + ' / ' + EndPathList[j].EndPortName; if PathList[j].EndPorts.Count > 0 then s := s + GetNumberCount(EndPathList[j].EndPorts); s := GetNumberCount(EndPathList[j].InterFacePositions) + ' ' + s; FmtCablePathsInfo.FieldByName(fnDescription).AsString := s; s := ''; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := EndPathList[j].InterFacePositions.Count; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := 0; FmtCablePathsInfo.Post; end; end; end; //теперь заголовок if NameList = nil then NameList := TStringList.Create else NameList.Clear; for j := 0 to l - 1 do begin if ((EndPathList[j].NameFrom = nil ) and (PathList[j].NameTo <> nil)) then begin FmtCablePaths.Append; FmtCablePaths.FieldByName(fnID).AsInteger := 3; FmtCablePaths.FieldByName(fnName).AsString := Interf.LoadName + ' ' + GetNumberCount(InterFacePositions); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := EndPathList[j].NppFrom; FmtCablePaths.FieldByName(fnNppTo).AsInteger := EndPathList[j].NppTo; s:=''; NameList.Insert(0,' '); FmtCablePaths.FieldByName(fnNameFrom).AsString := NameList.Text; NameList.Clear; // куда s :=''; if Length(EndPortInfo) > 0 then begin for k := 0 to Length(EndPortInfo) - 1 do begin if s <> '' then s := s + ','; s := s + EndPortInfo[k].PortName + GetNumberCount(EndPortInfo[k].Ports); end; NameList.Insert(0,s); s:=''; end; if EndPathList[j].NameTo <> nil then begin if not EndPathList[j].NameTo.IsTop then NameList.Insert(0,EndPathList[j].NameTo.GetTopComponent.GetNameForVisible(True)) else NameList.Insert(0,EndPathList[j].NameTo.GetfirstParentCatalog.GetNameForVisible(True)); end else NameList.Insert(0,' '); // если показывать конечные объекты if cbCablePathShowEndObjName.Checked then begin if (EndPathList[j].NameTo <> nil) and (not EndPathList[j].NameTo.IsTop) then NameList.Insert(0,EndPathList[j].NameTo.GetFirstParentCatalog.GetNameForVisible(True)); end; FmtCablePaths.FieldByName(fnNameTo).AsString := NameList.Text; NameList.Clear; FmtCablePaths.Post; break; end; end; end; Passed := false; // Финиш, Ёпт,ура! end; AllCableInterFaces.Clear; end else //выводим сообщение об несоответствии нумерации пар интерфейсов на концах кабеля begin showmessage(cRepMsg239); end; if NumPairEqual = false then break; end; // end i end;*) if NumPairEqual then begin GFormMode := fmRCablePaths; AParams.PageToShow := 0; ShowPreparedReport(AParams); end; end // пипец для компутерных сетей(и типа того) // сеть електро- (и типа того) else begin NumPairEqual := false; // на всякий, хотя тут - до лампочки // определяем подключенные (сначала все) Passed := false; AllConnectedCompons := TSCSComponents.Create(false); BeginCompons := nil; GetAllConnected(FComponent, AllConnectedCompons, FComponent.Cypher, nil); // showmessage('Connected count = '+inttostr(AllConnectedCompons.Count)); // подключенные точечные к кабелю ConnectedCompons := TSCSComponents.Create(false); for j := 0 to AllConnectedCompons.Count - 1 do begin if ( (AllConnectedCompons[j].IsLine = biFalse) and (ConnectedCompons.IndexOf(AllConnectedCompons[j]) = -1) ) then ConnectedCompons.Add(AllConnectedCompons[j]); end; // если подключенных точечных нет - отчет не строим if ConnectedCompons.Count > 0 then begin NumPairEqual := true; // нужно для проверки отображения отчета // ОПРЕДЕЛЯЕМ НАЧАЛЬНЫЙ КОМПОНЕНТ // если подключенный точечный один - он и будет началом пути if ConnectedCompons.Count = 1 then begin BeginCompon := ConnectedCompons[0]; end // если подключенных точечных несколько - определяем начальный по наибольшему количеству // функциональных интерфейсов else begin // Начало пути - верхний компонент BeginCompon := GetMaxInterfObject(ConnectedCompons, true); end; CablesPassed := nil; CablesPassed := TSCSComponents.Create(false); ConnectedCables := TSCSComponents.Create(false); StrangeCables := TSCSComponents.Create(false); BeginPos := 0; PosNumber := 0; BeginCompons := TSCSComponents.create(false); EndCompons := TSCSComponents.create(false); Passed := false; // НАЧАЛО ПУТИ - конкретно подключенный к кабелю компонент if BeginCompon.IsTop then // Проверка на подключение кабеля к компонентам начального компонента begin for j := 0 to ConnectedCompons.Count - 1 do begin if BeginCompon.ChildReferences.IndexOf(ConnectedCompons[j]) <> -1 then begin currCompon := ConnectedCompons[j]; // Кабель, подключенный к начальному компоненту for k := 0 to currCompon.JoinedComponents.Count - 1 do begin if currCompon.JoinedComponents[k].Cypher = FComponent.Cypher then begin if (currCompon.JoinedComponents[k].isLine = biTrue) and (AllConnectedCompons.IndexOf(currCompon.JoinedComponents[k]) <> -1) and (CablesPassed.IndexOf(currCompon.JoinedComponents[k]) = -1) then begin GetAllConnectedFromBegin(currCompon.JoinedComponents[k], currCompon, nil, FComponent.Cypher, true); Passed := true; break; end; end; end; end; if Passed then break; end; end; // if not Passed then // проверка на подключение кабеля к самому компоненту begin for k := 0 to BeginCompon.JoinedComponents.Count - 1 do begin if (BeginCompon.JoinedComponents[k].isLine = biTrue) and (AllConnectedCompons.IndexOf(BeginCompon.JoinedComponents[k]) <> -1) and (CablesPassed.IndexOf(BeginCompon.JoinedComponents[k]) = -1) then begin if BeginCompon.JoinedComponents[k].Cypher = FComponent.Cypher then begin GetAllConnectedFromBegin(BeginCompon.JoinedComponents[k], BeginCompon, nil, FComponent.Cypher, true); Passed := true; break; end; end; end; end; AllConnectedCompons.Clear; Counter := 0; end; // пипец, если строим отчет // отчет показываем, только если нумерация интерфейсов кабеля сходится на концах if NumPairEqual then begin GFormMode := fmRCablePaths; AParams.PageToShow := 1; ShowPreparedReport(AParams); end; end; // пипец (кабель электрический, пожарка и т.п.) end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowCablePaths', E.Message); end; end; Procedure TF_ResourceReport.ShowPortConnections(aParams: TReportItemParams); // Tolik 07/09/2023 -- type FportCount = array of integer; var i, j, PortNameIndex: integer; CupBoardFolder, JoinedLineCatalog: TSCSCatalog; PortNamesList: TStringList; PortsCount, BusyPortsCount, FreePortsCount: integer; JoinedLinesList: TList; JoinedLine: TOrthoLine; CableComponent: TSCSComponent; PassedComponList: TSCSComponents; FreeportsbyName, BusyPortsByName: FPortCount; function GetPortCount(aComponent: TSCSComponent; aRec: Boolean = false): integer; var i, j: integer; ComponList: TList; Compon: TSCScomponent; port: TSCSInterface; PortList: TSCSInterfaces; begin Result := 0; ComponList := TList.Create; if aRec then begin for i := 0 to aComponent.ChildReferences.Count - 1 do ComponList.Add(aComponent.ChildReferences[i]); end; ComponList.Insert(0, aComponent); PortList := TSCSInterfaces.Create(false); for i := 0 to ComponList.Count - 1 do begin Compon := TSCSComponent(ComponList[i]); for j := 0 to Compon.Interfaces.Count - 1 do begin port := Compon.Interfaces[j]; if port.IsPort = biTrue then begin if PortList.IndexOf(port) = -1 then begin PortList.Add(Port); if port.Kolvo > 0 then Result := Result + port.Kolvo else inc(Result); end; end; end; end; end; Procedure CollectPortNames(aCompon: TSCScomponent); var i: integer; InterfName : string; begin if aCompon <> nil then begin for i := 0 to aCompon.Interfaces.Count - 1 do begin if aCompon.Interfaces[i].IsPort = biTrue then begin InterfName := aCompon.Interfaces[i].LoadName; InterfName := aCompon.Interfaces[i].GetNameForVisible; if PortNamesList.IndexOf(aCompon.Interfaces[i].Name) = -1 then PortNamesList.Add(aCompon.Interfaces[i].NAme); end; end; for i := 0 to aCompon.ChildComplects.Count - 1 do CollectPortNames(aCompon.ChildComplects[i]); end; end; function GetConnectedLines: TList; var i, j: integer; CupboardFigure: TFigure; JoinedConn: TConnectorObject; JoinedLine: TOrthoLine; begin Result := TList.Create; if CupBoardFolder <> nil then begin if GCadForm <> nil then begin CupboardFigure := getFigureByID(GCadForm, CupBoardFolder.SCSID); if CupBoardFigure <> nil then begin if CupBoardFigure is TConnectorObject then begin for i := 0 to TConnectorObject(CupBoardFigure).JoinedConnectorsList.Count - 1 do begin JoinedConn := TConnectorObject(TConnectorObject(CupBoardFigure).JoinedConnectorsList[i]); if not JoinedConn.Deleted then begin if JoinedConn.ConnectorType = ct_Clear then begin for j := 0 to JoinedConn.JoinedOrtholinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedConn.JoinedOrtholinesList[j]); if not JoinedLine.Deleted then begin if Result.IndexOf(JoinedLine) = -1 then Result.Add(JoinedLine); end; end; end; end; end; end; end; end; end; end; function GetFullPortName(aInterf: TSCSInterface): string; var ParentCompon: TSCSComponent; begin if aInterf.Name = '' then aInterf.LoadName; Result := aInterf.ComponentOwner.GetNameForVisible + '/' + aInterf.GetNameForVisible; ParentCompon := aInterf.ComponentOwner.GetParentComponent; if ParentCompon <> nil then begin while ParentCompon <> FComponent do begin Result := ParentCompon.GetNameForVisible + '/' + Result; ParentCompon := ParentCompon.GetParentComponent; if ParentCompon = nil then break; end; end; end; Procedure AddInternalConnections(aPath: boolean = false); // внутренние соединения в шкафу посредством патч-кордов var i, j, k, l: integer; PortList: TSCSInterfaces; ChildCompon, PCord, JoinedCompon: TSCSComponent; PatchCordList: TSCSComponents; ConnectedPort1, ConnectedPort2: TSCSInterface; CableConnected: boolean; begin PassedComponList.Clear; PatchCordList := TSCSComponents.Create(false); // патчкорды PortList := TSCSInterfaces.Create(false); for i := 0 to CupBoardFolder.ComponentReferences.Count - 1 do begin ChildCompon := (CupBoardFolder.ComponentReferences[i]); if ChildCompon.ComponentType.SysName <> ctsnPatchCord then // патч-корды исключаем begin for j := 0 to ChildCompon.Interfaces.Count - 1 do begin if ChildCompon.Interfaces[j].TypeI = itFunctional then begin if ChildCompon.Interfaces[j].IsPort = biTrue then begin ConnectedPort1 := nil; ConnectedPort2 := nil; if ChildCompon.Interfaces[j].IsBusy = biTrue then // порт занят begin if ChildCompon.Interfaces[j].ConnectedInterfaces[0].ComponentOwner.ComponentType.SysName = ctsnPatchCord then begin if PortList.indexof(ChildCompon.Interfaces[j]) = -1 then begin PCord := ChildCompon.Interfaces[j].ConnectedInterfaces[0].ComponentOwner; // патчкорд ConnectedPort1 := ChildCompon.Interfaces[j]; // порт компоненты inc(BusyPortsCount); FmtPortReportDetail.Append; if aPath then FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := ConnectedPort1.ComponentOwner.GetNameForVisible(true) + '/' + ConnectedPort1.GetNameForVisible else FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := ConnectedPort1.GetNameForVisible; FmtPortReportDetail.FieldbyName(fnConnected).AsString := PCord.GetNameForVisible; FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 0; //FmtPortReport.FieldValues[fnID]; PortNameIndex := PortNamesList.IndexOf(ConnectedPort1.Name); if PortNameIndex <> -1 then inc(BusyPortsByName[PortNameIndex]); if ChildCompon.Interfaces[j].ConnectedInterfaces[0].InternalConnected.Count > 0 then begin if ChildCompon.Interfaces[j].ConnectedInterfaces[0].InternalConnected[0].ConnectedInterfaces.Count > 0 then begin if ChildCompon.Interfaces[j].ConnectedInterfaces[0].InternalConnected[0].ConnectedInterfaces[0].IsPort = bitrue then begin ConnectedPort2 := ChildCompon.Interfaces[j].ConnectedInterfaces[0].InternalConnected[0].ConnectedInterfaces[0]; if PortList.IndexOf(ConnectedPort2) = -1 then begin inc(BusyPortsCount); PortList.Add(ConnectedPort2); PortNameIndex := PortNamesList.IndexOf(ConnectedPort2.Name); if PortNameIndex <> -1 then inc(BusyPortsByName[PortNameIndex]); if aPath then FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := ConnectedPort2.ComponentOwner.GetNameForVisible(true) + '/' + ConnectedPort2.GetNameForVisible else FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := ConnectedPort2.GetNameForVisible; end else ConnectedPort2 := nil; end; end; end; end; end else begin //// -- Tolik 17/11/2023 -- вот здесь если будет воткнут коннектор в порт, но кабеля в нем нет - считать порт свободным /// if ChildCompon.Interfaces[j].ConnectedInterfaces[0].ComponentOwner.ComponentType.SysName = ctsnConnector then begin CableConnected := false; for k := 0 to ChildCompon.Interfaces[j].ConnectedInterfaces[0].ComponentOwner.JoinedComponents.Count - 1 do begin if IsCableComponent(ChildCompon.Interfaces[j].ConnectedInterfaces[0].ComponentOwner.JoinedComponents[k]) then begin CableConnected := true; break; end; end; if not CableConnected then begin inc(FreePortsCount, ChildCompon.Interfaces[j].Kolvo); PortNameIndex := PortNamesList.IndexOf(ChildCompon.Interfaces[j].Name); if PortNameIndex <> -1 then inc(FreePortsByName[PortNameIndex], ChildCompon.Interfaces[j].Kolvo); end; end; end; end else begin //порт свободен FmtPortReportDetail.Last; FmtPortReportDetail.Append; if cbFullPortPath.Checked then FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := GetFullPortName(ChildCompon.Interfaces[j]) else FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := ChildCompon.GetNameForVisible + '/' + ChildCompon.Interfaces[j].GetNameForVisible; FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := ''; FmtPortReportDetail.FieldbyName(fnConnected).AsString := ''; if cbFreePortsDetail.Checked then FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 2 else FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 100; inc(FreePortsCount, ChildCompon.Interfaces[j].Kolvo); PortNameIndex := PortNamesList.IndexOf(ChildCompon.Interfaces[j].Name); if PortNameIndex <> -1 then inc(FreePortsByName[PortNameIndex], ChildCompon.Interfaces[j].Kolvo); end; end; end; end; end; end; FmtPortReport.Append; FmtPortReport.FieldByName(fnName).AsString := cRepMsg279; FmtPortReport.Last; FmtPortReport.Append; FmtPortReport.FieldByName(fnName).AsString := cRepMsg280; //Free ports info FmtPortReport.Last; FmtPortReport.Append; FmtPortReport.FieldByName(fnName).AsString := cRepMsg281; //GReportBusyPortsCount := inttostr(BusyPortsCount); //GReportFreePortsCount := inttostr(FreePortsCount); { for i := 0 to CupBoardFolder.ComponentReferences.Count - 1 do begin ChildCompon := (CupBoardFolder.ComponentReferences[i]); if ChildCompon.ComponentType.SysName = ctsnPatchCord then // патч-корды исключаем begin if PatchCordList.IndexOf(ChildCompon) = -1 then PatchCordList.Add(ChildCompon); end; end; } { if PatchCordList.Count > 0 then begin for i := 0 to CupBoardFolder.ComponentReferences.Count - 1 do begin ChildCompon := (CupBoardFolder.ComponentReferences[i]); //1. Self to self (порты одной компоненты подключены между собой) for j := 0 to PatchCordList.Count - 1 do begin PCord := PatchCordList[j]; if PCord.JoinedComponents.IndexOf(ChildCompon) <> -1 then begin ConnectedPort1 := nil; ConnectedPort2 := nil; end; end; //2. порты разных компонент подключены друг к другу for j := 0 to PatchCordList.Count - 1 do begin end; { if ChildCompon.ComponentType.Name <> ctsnPatchCord then // патч-корды исключаем begin for j := 0 to ChildCompon.Interfaces.Count - 1 do begin if ChildCompon.Interfaces[j].TypeI = itFunctional then // только функциональные begin if ChildCompon.Interfaces[j].IsPort = biTrue then begin if ChildCompon.Interfaces[j].IsBusy = biTrue then //занятый порт begin PCord := nil; for k := 0 to ChildCompon.Interfaces[j].ConnectedInterfaces.Count - 1 do begin if ChildCompon.Interfaces[j].ConnectedInterfaces[k].ComponentOwner.ComponentType.SysName = ctsnPatchCord then begin PCord := ChildCompon.Interfaces[j].ConnectedInterfaces[k].ComponentOwner; JoinedCompon := nil; for l := 0 to PCord.JoinedComponents.Count - 1 do begin if PCord.JoinedComponents[l].ID <> ChildCompon.ID then begin JoinedCompon := PCord.JoinedComponents[l]; break; end; end; if JoinedCompon <> nil then break; end; end; if PCord <> nil then begin ///////////////////////////////////////////////////////////////////////////////////////////////////// end; end; end; end; end; end; } { end; end;} PatchCordList.Free; PortList.Free; end; Procedure AddExternalConnections(aCompon: TSCSComponent); var FirstCompon, LastCompon: TSCSComponent; FirstPort, LastPort: TSCSInterface; begin FirstCompon := nil; LastCompon := nil; FirstPort := nil; LastPort := nil; aCompon.LoadWholeComponent(true); aCompon.DefineFirstLast; if aCompon.WholeComponent.Count > 1 then begin if ((aCompon.FirstConnectedConnCompon <> nil) and ((aCompon.FirstConnectedConnCompon = FComponent) or (FComponent.ChildReferences.IndexOf(aCompon.FirstConnectedConnCompon)<> -1))) then begin FirstCompon := aCompon.FirstCompon; FirstPort := aCompon.FirstConnectedConnCompon.GetPortJoinedToLine(FirstCompon); if aCompon.LastConnectedConnCompon <> nil then begin LastCompon := aCompon.LastCompon; LastPort := aCompon.LastConnectedConnCompon.GetPortJoinedToLine(LastCompon); //if LastPort.Name = '' then // LastPort.LoadName; end; end else begin if ((aCompon.LastConnectedConnCompon <> nil) and ((aCompon.LastConnectedConnCompon = FComponent) or (FComponent.ChildReferences.IndexOf(aCompon.LastConnectedConnCompon)<> -1))) then begin FirstCompon := aCompon.LastCompon; FirstPort := aCompon.LastConnectedConnCompon.GetPortJoinedToLine(FirstCompon); if aCompon.FirstConnectedConnCompon <> nil then begin LastCompon := aCompon.FirstCompon; LastPort := aCompon.FirstConnectedConnCompon.GetPortJoinedToLine(LastCompon); end; end; end; //if FirstCompon <> nil then if FirstPort <> nil then begin inc(BusyPortsCount); PortNameIndex := PortNamesList.IndexOf(FirstPort.Name); if PortNameIndex <> -1 then inc(BusyPortsByName[PortNameIndex]); FmtPortReportDetail.Append; FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := GetFullPortName(FirstPort); { if FirstCompon = aCompon.FirstCompon then FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := aCompon.FirstConnectedConnCompon.GetNameForVisible else FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := aCompon.LastConnectedConnCompon.GetNameForVisible; } //if LastCompon <> nil then if LastPort <> nil then begin if LastPort.ComponentOwner.ListId = FComponent.ListID then FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := GetFullPortName(LastPort) else FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := F_ProjMan.GSCSBase.CurrProject.GetListBySCSID(LastPort.ComponentOwner.ListId).GetNameForVisible + '/' + GetFullPortName(LastPort); { if LastCompon = aCompon.FirstCompon then FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := aCompon.FirstConnectedConnCompon.GetNameForVisible else FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := aCompon.LastConnectedConnCompon.GetNameForVisible; } end; FmtPortReportDetail.FieldbyName(fnConnected).AsString := aCompon.GetNameForVisible; FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 1; end end else begin end; //external connections {FmtPortReport.Append; FtPortReport.FieldByName(fnName).AsString := cRepMsg281;} //aCompon.LastCompon end; Procedure AddFreePortsInfo; var i: integer; ComponPort: TSCSInterface; begin for i := 0 to CupBoardFolder.ComponentReferences.Count - 1 do begin end; end; begin try GPortsCupBoard := ''; GReportBusyPortsCount := ''; GReportFreePortsCount := ''; CupBoardFolder := FComponent.GetFirstParentCatalog; PortNamesList := TStringList.Create; CollectPortNames(FComponent); SetLength(FreeportsbyName, PortNamesList.Count); SetLength(BusyPortsByName, PortNamesList.Count); PortsCount := GetPortCount(FComponent, true); FreePortsCount := GetPortsCountReadyToConnectByInterf(FComponent, 0, true); BusyPortsCount := PortsCount - FreePortsCount; if CupBoardFolder <> nil then // если удалось получить каталог шкафа begin GPortsCupBoard := FComponent.GetNameForVisible(false); DisconnectDetailMemTable(FmtPortReportDetail); ClearFieldsInMemTable(FmtPortReportDetail, nil); ClearFieldsInMemTable(FmtPortReport, nil); FmtPortReport.FieldDefs.Clear; FmtPortReport.FieldDefs.Add(fnID, ftAutoInc); FmtPortReport.FieldDefs.Add(fnName, ftString, 255); FmtPortReportDetail.FieldDefs.Clear; FmtPortReportDetail.FieldDefs.Add(fnID, ftAutoInc); FmtPortReportDetail.FieldDefs.Add(fnPortNameFrom, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnConnected, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnPortNameTo, ftString, 255); FmtPortReportDetail.FieldDefs.Add(fnIDMaster, ftInteger); ConnectDetailMemTable(FdsrcPortReport, FmtPortReportDetail, fnID, fnIDMaster); FmtPortReport.Active := true; FmtPortReportDetail.Active := true; PassedComponList := TSCSComponents.Create(false); CollectPortNames(FComponent); // подклюяенные порты // внутренние подключения //(тут просто смотрим подключения патч-кордами) BusyPortsCount := 0; FreePortsCount := 0; AddInternalConnections(true); // внешние подключения (если только через порт оборудования в шкафу, а не разводка панели, например...) JoinedLinesList := GetConnectedLines; if JoinedLinesList.Count > 0 then begin for i := 0 to JoinedLinesList.Count - 1 do begin JoinedLine := TOrthoLine(JoinedLinesList[i]); JoinedLineCatalog := F_ProjMan.GSCSBase.CurrProject.CurrList.GetCatalogFromReferencesBySCSID(JoinedLine.ID); if JoinedLineCatalog <> nil then begin for j := 0 to JoinedLineCatalog.ComponentReferences.Count - 1 do begin if IsCableComponent(JoinedLineCatalog.ComponentReferences[j]) then begin CableComponent := JoinedLineCatalog.ComponentReferences[j]; AddExternalConnections(CableComponent); end; end; end; end; end else begin end; GReportBusyPortsCount := inttostr(BusyPortsCount); GReportFreePortsCount := inttostr(FreePortsCount); if cbGroupBusyPorts.Checked then begin FmtPortReport.Last; FmtPortReport.Append; FmtPortReport.FieldByName(fnName).AsString := cRepMsg285; for i := 0 to PortNamesList.Count - 1 do begin if BusyPortsByName[i] <> 0 then begin FmtPortReportDetail.Append; FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := PortNamesList[i]; FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := inttostr(BusyPortsByName[i]); FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 3; end; end; end; if cbGroupFreePorts.Checked then begin FmtPortReport.Last; FmtPortReport.Append; FmtPortReport.FieldByName(fnName).AsString := cRepMsg284; for i := 0 to PortNamesList.Count - 1 do begin if FreePortsByName[i] <> 0 then begin FmtPortReportDetail.Append; FmtPortReportDetail.FieldbyName(fnPortNameFrom).AsString := PortNamesList[i]; FmtPortReportDetail.FieldbyName(fnPortNameTo).AsString := inttostr(FreePortsByName[i]); FmtPortReportDetail.FieldbyName(fnIDMaster).AsInteger := 4; end; end; end; JoinedLinesList.Free; {JoinedLine: TOrthoLine; CableComponent: TSCSComponent;} //свободные порты AddFreePortsInfo; end; PortNamesList.Free; SetLength(FreeportsbyName, 0); SetLength(BusyPortsByName, 0); PassedComponList.Free; if FmtPortReportDetail.RecordCount > 1 then FmtPortReportDetail.SortOn(fnPortNameFrom,[]); GFormMode := fmPortReport; ShowPreparedReport(AParams); except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowPortConnections', E.Message); end; end; procedure TF_ResourceReport.ShowCrossConnection(AParams: TReportItemParams); var i, j: Integer; ChildCompon: TSCSComponent; InterfFrom, interfTo: TSCSInterface; procedure LoadConnectionByInterf(aInterf: TSCSInterface; const aFldName, aFldPort: String); var Compon, ParentCompon: TSCSComponent; FldName, FldPort: String; NppFrom, NppTo: Integer; begin if aInterf.ConnectedInterfaces.Count > 0 then begin Compon := aInterf.ConnectedInterfaces[0].ComponentOwner; ParentCompon := Compon.GetParentComponent; FldName := Compon.GetNameForVisible; if ParentCompon <> Compon.GetTopComponent then FldName := ParentCompon.GetNameForVisible +'\'+ FldName; FldPort := ''; if GetPortInfoByJoinedCompons(Compon, ChildCompon, NppFrom, NppTo) then begin if NppFrom = NppTo then FldPort := IntToStr(NppFrom) else FldPort := IntToStr(NppFrom)+'-'+IntToStr(NppTo); end; FmtCrossConnection.FieldByName(aFldName).AsString := FldName; FmtCrossConnection.FieldByName(aFldPort).AsString := FldPort; end; end; begin try if FComponent <> nil then begin if FmtCrossConnection = nil then begin CreateMTWithDsrc(Self, FmtCrossConnection, FdsrcCrossConnection, 'FmtCrossConnection', 'FdsrcCrossConnection'); FmtCrossConnection.FieldDefs.Add(fnID, ftAutoInc); FmtCrossConnection.FieldDefs.Add(fnNameFrom, ftMemo); FmtCrossConnection.FieldDefs.Add(fnNppFrom, ftString, 255); FmtCrossConnection.FieldDefs.Add(fnNameTo, ftMemo); FmtCrossConnection.FieldDefs.Add(fnNppTo, ftString, 255); FmtCrossConnection.FieldDefs.Add(fnName, ftString, 255); FmtCrossConnection.FieldDefs.Add(fnMarkID, ftInteger); end; FmtCrossConnection.Active := false; FmtCrossConnection.Active := true; for i := 0 to FComponent.ChildReferences.Count - 1 do begin ChildCompon := FComponent.ChildReferences[i]; if ChildCompon.IsCrossComponent then begin InterfFrom := nil; interfTo := nil; for j := 0 to ChildCompon.Interfaces.Count - 1 do begin if InterfFrom = nil then InterfFrom := ChildCompon.Interfaces[j] else if interfTo = nil then begin interfTo := ChildCompon.Interfaces[j]; Break; //// BREAK //// end; end; FmtCrossConnection.Append; FmtCrossConnection.FieldByName(fnName).AsString := ChildCompon.GetNameForVisible; FmtCrossConnection.FieldByName(fnMarkID).AsInteger := ChildCompon.MarkID; if InterfFrom <> nil then LoadConnectionByInterf(InterfFrom, fnNameFrom, fnNppFrom); if InterfTo <> nil then LoadConnectionByInterf(InterfTo, fnNameTo, fnNppTo); FmtCrossConnection.Post; end; end; FmtCrossConnection.SortOn(fnMarkID, []); GFormMode := fmRCrossConnection; ShowPreparedReport(AParams); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowCrossConnection', E.Message); end; end; function getnamemark(Figure: TFigure; SCSComponent: TSCSComponent): string; var ii: integer; begin result := ''; if Figure.ClassName = 'TConnectorObject' then begin if TConnectorObject(Figure).OutTextCaptions.Count > 0 then begin if TF_CAD(Figure.Owner.Owner).FShowObjectCaptionsType = st_Short then begin result := TConnectorObject(Figure).OutTextCaptions[0]; end else begin for ii := 1 to TConnectorObject(Figure).OutTextCaptions.Count - 1 do begin if result <> '' then result := result + #13#10; result := result + TConnectorObject(Figure).OutTextCaptions[ii]; end; end; end else result := SCSComponent.NameMark; end else result := SCSComponent.NameMark; end; // Tolik Procedure TF_ResourceReport.IncPaketPrintCounter; Var i: Integer; Begin if rbModePacketPrintToExcel.Checked then begin Inc(FReportCountPrinted); if (FReportCountPrinted = FReportCountToPrint) then begin if FReportCountPrinted = FReportCountToPrint then begin //*** Догнать до 100 for i := TF_Main(GForm).F_ProgressExp.gTotal.Progress + 1 to TF_Main(GForm).F_ProgressExp.gTotal.MaxValue do begin TF_Main(GForm).F_ProgressExp.gTotal.Progress := i; TF_Main(GForm).F_ProgressExp.gTotal.Refresh; Sleep(100); end; if TF_Main(GForm).F_ProgressExp.cbOpen.Checked then ShellExecute(Handle, nil, PChar(FPackgeDir), nil, nil, SW_SHOW); end; FReportCountPrinted := FReportCountToPrint; TF_Main(GForm).F_ProgressExp.Close; end; end; End; // Procedure TF_ResourceReport.ShowXLSXReport(aRep: TfrReport; aFileNAme: String); begin if ExportToXLSX then U_ExpXlsX.ExportReportToXLSX(aFileName, aRep, true) //U_ExpXlsX.ExportRepToXLSX(aRep, aFileName) //U_ExpXlsX.ExportReportToXLSX(aFileName, aRep) else if ExportToDOCx then //U_ExpXlsX.ExportRepToDocX(aRep, aFileName) U_ExpXlsX.ExportReportToDocX(aFileName, aRep, true) else begin aRep.PrepareReport; aRep.ShowPreparedReport; end; // aRep.ShowReport; end; // Tolik 31/3/2020 -- Procedure TF_ResourceReport.SaveRopPagesVisibility(aRep: TfrReport); var i: integer; begin if ReportPagesVisibilityList = nil then ReportPagesVisibilityList := TIntList.Create else ReportPagesVisibilityList.Clear; for i := 0 to aRep.Pages.Count - 1 do begin if aRep.Pages.Pages[i].Visible then ReportPagesVisibilityList.Add(1) else ReportPagesVisibilityList.Add(0); end; end; // procedure TF_ResourceReport.ShowWACoordinatesReport(AFolder: TSCSCatalog; AList: TStringList); Var i,ii,j,k : integer; SCSCatalog: TSCSCatalog; SCSComponent: TSCSComponent; ObjectsList: TList; CurrentWA: TConnectorObject; FiguresList : Tlist; SCSList: TSCSList; WAList: TF_CAD; TypeFound : boolean; MapScale, Coordinata : double; SCSobject, SCSObject1 : TSCSCatalog; Figure : TFigure; AParams :TReportItemParams; ReportItemParams: TReportItemParams; CurrReportShablons: TReportShablons; TemplateType: Integer; ReportFileName: String; ReportFilePath: String; IsTemplate: Boolean; SCSDir: String; ReportFile: String; DocName: String; frExport: TfrBasicExpFilter; ProgressCaption: String; ExtensionName: String; F_Preview: TF_Preview; ListArray : TSCSCatalogs; ListCount : integer; //Tolik 25/03/2020 -- PassedList: TRapList; // Begin // Tolik 23/03/2017 -- ListArray := nil; PassedList := TRapList.Create; // if (AFolder <> nil) and (AFolder.ItemType <> itProject) and (AFolder.ItemType <> itList) then begin AFolder := AFolder.GetListOwner; end; if (AFolder <> nil) and (AList.Count > 0) then begin MemTable_WACoordinates.Close; MemTable_WACoordinates.Open; // если стоим на листе if AFolder.ItemType = itList then begin ListCount := 0; for i:= 0 to AFolder.ChildCatalogReferences.Count - 1 do begin SCSObject := AFolder.ChildCatalogReferences[i]; for j := 0 to SCSObject.ComponentReferences.Count - 1 do begin SCSComponent := SCSObject.ComponentReferences[j]; // Tolik 25/03/2020 -- Исключить дубли (могут быть, если есть кабинеты на листе) if PassedList.IndexOf(SCSComponent) = -1 then PassedList.Add(SCSComponent) else Continue; // TypeFound := False; if SCScomponent.IsTop then begin for k := 0 to AList.Count - 1 do begin if SCSComponent.ComponentType.NamePlural = AList[k] then begin TypeFound := true; break; end; end; end; // добавляем в таблицу if TypeFound then begin SCSObject1 := SCSComponent.GetFirstParentCatalog; // верхний объект компонента(каталог) будет иметь отображение на Каде WAList := GetListByID(SCSObject1.GetListOwner.SCSID); // получаем КАД объекта if WAList <> nil then begin ListCount := ListCount + 1; MemTable_WACoordinates.Edit; MemTable_WACoordinates.Append; MemTable_WACoordinates.FieldByName('Name_List').AsString := AFolder.GetNameForVisible(false); // наименоние листа MemTable_WACoordinates.FieldByName('Name').AsString := SCSComponent.GetNameForVisible(false); // наименование компонента Figure := GetFigureByID(WALIST,SCSObject1.SCSID); // объект на каде - фигура MemTable_WACoordinates.FieldByName('NameMark').AsString := GetNameMark(Figure, SCSComponent); MapScale := WAList.PCad.MapScale; // масштаб сетки Када Coordinata := Figure.ActualPoints[1].x * Mapscale / 1000; // Х - координата MemTable_WACoordinates.FieldByName('X').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); Coordinata := Figure.ActualPoints[1].y * Mapscale / 1000; // Y - координата MemTable_WACoordinates.FieldByName('Y').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); Coordinata := TConnectorObject(Figure).ActualZOrder[1]; // Y - координата MemTable_WACoordinates.FieldByName('Z').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); end; end; end; end; end else // Tolik 25/03/2020 -- // если стоим на проекте if AFolder.ItemType = itProject then begin ListArray := TSCSCatalogs.Create(false); ListCount := 0; // определяем листы for i := 0 to AFolder.ChildCatalogReferences.Count - 1 do begin if AFolder.ChildCatalogReferences[i].ItemType = itList then begin if GetListByID(AFolder.ChildCatalogReferences[i].GetListOwner.SCSID) <> nil then begin ListArray.Add(AFolder.ChildCatalogReferences[i]); ListCount := ListCount + 1; end; end; end; // если есть листы на проекте c открытыми кадами if ListCount > 0 then begin // проходим по всем листам for i := 0 to ListArray.Count - 1 do begin SCSCatalog := Listarray[i]; for j := 0 to SCSCatalog.ComponentReferences.Count -1 do begin TypeFound := false; SCSComponent := SCSCatalog.ComponentReferences[j]; // Tolik 25/03/2020 -- if PassedList.IndexOf(SCSComponent) = -1 then PassedList.Add(SCSComponent) else Continue; // if SCSComponent.IsTop then begin for k := 0 to AList.Count -1 do begin if SCSComponent.ComponentType.NamePlural = AList[k] then begin TypeFound := true; break; end; end; end; if TypeFound then begin MemTable_WACoordinates.Edit; MemTable_WACoordinates.Append; MemTable_WACoordinates.FieldByName('Name_List').AsString := SCSCatalog.GetNameForVisible(false); // наименоние листа MemTable_WACoordinates.FieldByName('Name').AsString := SCSComponent.GetNameForVisible(false); // наименование компонента SCSObject := SCSComponent.GetFirstParentCatalog; // верхний объект компонента(каталог) будет иметь отображение на Каде WAList := GetListByID(SCSObject.GetListOwner.SCSID); // получаем КАД объекта Figure := GetFigureByID(WALIST,SCSObject.SCSID); // объект на каде - фигура MemTable_WACoordinates.FieldByName('NameMark').AsString := GetNameMark(Figure, SCSComponent); MapScale := WAList.PCad.MapScale; // масштаб сетки Када Coordinata := Figure.ActualPoints[1].x * Mapscale / 1000; // Х - координата MemTable_WACoordinates.FieldByName('X').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); Coordinata := Figure.ActualPoints[1].y * Mapscale / 1000; // Y - координата MemTable_WACoordinates.FieldByName('Y').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); Coordinata := TConnectorObject(Figure).ActualZOrder[1]; // Z - координата MemTable_WACoordinates.FieldByName('Z').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); end; end; end; end; end; end; if ListCount > 0 then begin GFormMode := fmWACoordinates; ReportFileName := ''; ReportFilePath := ''; //*** Определить шаблон отчета ReportItemParams := nil; //if tvReports.Selected <> nil then // ReportItemParams := TReportItemParams(tvReports.Selected.Data); ReportItemParams := AParams; IsTemplate := false; if ReportItemParams <> nil then begin //*** Опреелить текущий тип шаблона TemplateType := ttSimple; if cbReportWithStamp.Enabled and cbReportWithStamp.Checked then TemplateType := ttStamp; //*** Определить параметры текщего шаблона CurrReportShablons := ReportItemParams.GetShablonsByTemplateType(TemplateType); //*** Если шаблон не стандартный, то извлеч его в файл if (CurrReportShablons <> nil) and (CurrReportShablons.FActiveShablonID > 0) then begin IsTemplate := true; ReportFileName := GetReportFileNameByType(ReportItemParams.RepType, TemplateType, false); //showmessage(ReportFileName); if ReportFileName <> '' then ReportFilePath := GetPathToUserReportFile(ReportFileName); if ReportFilePath <> '' then begin if FileExists(ReportFilePath) then if Not DeleteFile(ReportFilePath) then ReportFilePath := GetNoExistsFileNameForCopy(ReportFilePath); if ReportFilePath <> '' then TF_Main(GForm).DM.SaveUserReportByIDToFile(CurrReportShablons.FActiveShablonID, ReportFilePath); end; end; end; if FormList = nil then formList := TObjectList.Create(false); FCatalog := AFolder; {$if Defined(ES_GRAPH_SC)} SCSDir := ExeDir + '\'; {$else} SCSDir := ExtractFilePath(paramstr(0)); {$ifend} ReportFile := 'RWACoordinates.frf';//GetReportFileNameByType(AParams.RepType, GetTemplateTypeByCurrOptions, false); ReportFile := SCSDir + dnReports + '\'+ReportFile; {if FileExists(ReportFile) then frDBDataSet_Detail.DataSource := nil;} if FileExists(ReportFile) then begin Application.ProcessMessages; FMasterOldRecNo := 0; FDetailOldRecNo := 0; FOldRecNo := 0; FCurrRecNo := 0; FPassNum := 1; FModifiedReportTemplate := false; DocName := cResourceReport_Msg1_29; //DocName := ApplicationName + ' - ['+lvReports.Selected.Caption+']'; // frDBDataSet_Master.DataSource := dsrcReport; // frDBDataSet_MasterFirst.DataSource := dsrcReportFirst; frDBDataSet_Master.DataSource := DataSource_MT_WACoordinates; Report.Title := DocName; Report.LoadFromFile(ReportFile); F_Preview := TF_Preview.Create(Application, GForm); F_Preview.frPreview1.LoadFile(ReportFile); // i := FormList.Add(F_Preview); Report.Preview := F_Preview.frPreview1; Report.ShowReport; F_Preview.Caption := ConcatStrWithDefis(DocName, cResourceReport_Msg4 + IntToStr(i+1), 1); // F_Preview.OnClose := {F_FR.}FormMdiClose; F_Preview.ReportFileName := {F_FR.}Report.FileName; F_Preview.ReportCaption := DocName; if Assigned(F_Preview.frPreview1.OnMouseDown) then EmptyProcedure; F_Preview.Show; end; end; // Tolik 21/03/2017 -- if ListArray <> nil then ListArray.Free; // PassedList.Free; // Tolik 25/03/2020 -- End; procedure TF_ResourceReport.ShowCablePathsWizard(ACable: TSCSComponent); begin //GFormMode := fmRCablePaths; //ShowPreparedReport(AParams); FComponent := ACable; // Tolik 08/02/2018 -- if (not (FComponent.IDNetType in [3,5,7])) then isCompCable := True else isCompCable := False; // FCatalog := ACable.GetFirstParentCatalog; ShowWizard([rkCablePath], true); end; //Tolik 07/09/2023 -- Procedure TF_ResourceReport.ShowPortWizard(aCupBoard: TSCSComponent); begin FComponent := aCupBoard; FCatalog := aCupBoard.GetFirstParentCatalog; ShowWizard([rkPortReport], true); end; // procedure TF_ResourceReport.ShowCrossConnectionWizard(ACompon: TSCSComponent); begin FComponent := ACompon; FCatalog := ACompon.GetFirstParentCatalog; ShowWizard([rkCrossConnection], true); end; procedure TF_ResourceReport.ToolButton1Click(Sender: TObject); begin //if SaveDialog.Execute then // RichEdit_Report.Lines.SaveToFile(SaveDialog.FileName); end; procedure TF_ResourceReport.ToolButton_PrintClick(Sender: TObject); begin //If PrintDialog.Execute then // RichEdit_Report.Print(RichEdit_Report.Lines.Text); end; // ##### Вместо 0 макс. длины отображать "нет" ##### procedure TF_ResourceReport.GT_RCableMaxLengthGetDisplayText( Sender: TcxCustomGridTableItem; ARecord: TcxCustomGridRecord; var AText: String); begin if AText = '0' then AText := ''; end; procedure TF_ResourceReport.ReportBeginPage(pgNo: Integer); var HeaderBand: TfrBandView; FooterBand: TfrBandView; ChildBand: TfrBandView; Stream: TStream; begin //Report.Pages[1]. Exit; FooterBand := TfrBandView(Report.FindObject('PageFooter')); //TfrBandView(Report.FindObject('PageFooter')); if FooterBand <> nil then begin ChildBand := nil; if pgNo = 0 then ChildBand := TfrBandView(Report.FindObject('pfFirst')) else if pgNo > 0 then ChildBand := TfrBandView(Report.FindObject('pfSecond')); if ChildBand <> nil then begin FooterBand.Assign(ChildBand); {Stream := TMemoryStream.Create; try Stream.Position := 0; ChildBand.SaveToStream(Stream); Stream.Position := 0; FooterBand.LoadFromStream(Stream); finally FreeAndNil(Stream); end;} //FooterBand.ChildBand := ChildBand.Name; //FooterBand.Master := ChildBand.Name; end; end; end; procedure TF_ResourceReport._tvReportTargetGetSelectedIndex(Sender: TObject; Node: TTreeNode); begin Node.SelectedIndex := Node.ImageIndex; end; procedure TF_ResourceReport.Act_ShowWizardReportExecute(Sender: TObject); var ReportItemParams: TReportItemParams; SCSCatalog: TSCSCatalog; strMessg: String; {CanHaveActiveComponents: Boolean; CanHaveZeroPriceComponents: Boolean; CanHaveDismountAccount: Boolean; ComponsWithZeroPrice: Boolean; FormMode: TResourceReportFormMode; FullPathInCableJournal: Boolean; } i: Integer; CanPrintReport: Boolean; CheckedObjectCount: Integer; CheckedReportCount: Integer; NodeTarget: TFlyNode; //NodeReport: TFlyNode; ListOfAllCADID: TIntList; ListOfCADID: TIntList; CurrDateTime: TDateTime; SaveDialog: TSaveDialog; DirDialogCaption: String; DefDirName: String; //Tolik Node: TTreeNode; NetTypeSelected: Boolean; function GetCheckedObjectCount: Integer; var NodeTarget: TFlyNode; begin Result := 0; NodeTarget := tvReportTarget.Items[0]; while NodeTarget <> nil do begin if NodeTarget.Cells[tciReport] = bsTrue then Inc(Result); NodeTarget := NodeTarget.GetNext; end; end; function GetCheckedReportCount: Integer; var NodeReport: TFlyNode; begin Result := 0; NodeReport := tvReports.Items[0]; while NodeReport <> nil do begin if Not NodeReport.Hidden then if NodeReport.Cells[rciIsOn] = bsTrue then Inc(Result); NodeReport := NodeReport.GetNext; end; end; procedure ShowReportInPackageMode; var NodeTarget: TFlyNode; NodeReport: TFlyNode; ReportItemParams: TReportItemParams; begin //*** Перебор объектов if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then begin NodeTarget := nil; if tvReportTarget.Items.Count > 0 then NodeTarget := tvReportTarget.Items[0]; while NodeTarget <> nil do begin if NodeTarget.Cells[tciReport] = bsTrue then begin FObjectName := ''; SCSCatalog := TSCSCatalog(NodeTarget.Data); if SCSCatalog <> nil then FObjectName := SCSCatalog.GetNameForVisible; //*** Перебор отчетов NodeReport := tvReports.Items[0]; while NodeReport <> nil do begin if Not NodeReport.Hidden then if NodeReport.Cells[rciIsOn] = bsTrue then begin ReportItemParams := TReportItemParams(NodeReport.Data); FReportCaption := NodeReport.Text; ShowReportByParams(SCSCatalog, ReportItemParams); if FReportCountPrinted = FReportCountToPrint then Break; //// BREAK //// end; NodeReport := NodeReport.GetNext; end; end; if FReportCountPrinted = FReportCountToPrint then Break; //// BREAK //// NodeTarget := NodeTarget.GetNext; end; end else if IsSimpleReportKind(FReportUseKind) then //24.02.2011 if rkCalc in FReportUseKind then begin FObjectName := ''; //*** Перебор отчетов NodeReport := tvReports.Items[0]; while NodeReport <> nil do begin if Not NodeReport.Hidden then if NodeReport.Cells[rciIsOn] = bsTrue then begin ReportItemParams := TReportItemParams(NodeReport.Data); FReportCaption := NodeReport.Text; ShowReportByParams(SCSCatalog, ReportItemParams); if FReportCountPrinted = FReportCountToPrint then Break; //// BREAK //// end; NodeReport := NodeReport.GetNext; end; end; end; begin // Tolik // выбраны ли все типы сетей для отображения в отчетах AllNetTypes := True; NetTypeSelected := True; if NetTypeGuidList.Count > 0 then begin for i := 0 to NetTypeTree.Items.Count - 1 do begin Node := NetTypeTree.Items[i]; if Node.AbsoluteIndex <> 0 then begin if NetTypeTree.ItemState[Node.AbsoluteIndex] = csunChecked then begin AllNetTypes := False; break; end; end; end; // Если не все типы сетей выбраны, смотрим, выбрано ли что-нибудь вообще // заодно и список выбранных типов сетей построим (гуиды) NetTypeGuidListSelected.Clear; if not AllNetTypes then begin NetTypeSelected := False; //NetTypeGuidListSelected.Clear; for i := 0 to NetTypeTree.Items.Count - 1 do begin Node := NetTypeTree.Items[i]; if Node.AbsoluteIndex <> 0 then begin if NetTypeTree.ItemState[Node.AbsoluteIndex] = csChecked then begin NetTypeSelected := True; NetTypeGuidListSelected.Add(NetTypeGuidList[i-1]); // потому что первый элемент - "все", его не считаем end; end; end; // Tolik -- 20/03/2017 -- NetTypeGuidListSelected.Add(''); // end else //все выбрано - кидаем все begin for i := 0 to NetTypeGuidList.Count - 1 do NetTypeGuidListSelected.Add(NetTypeGuidList[i]); // Tolik -- 20/03/2017 -- NetTypeGuidListSelected.Add(''); // end; end else begin if (NetTypeTree.Items.Count > 0) and (NetTypeTree.ItemState[0] <> csChecked) then begin ShowMessage(cRepMsg268); Exit; end else AllNetTypes := True; end; if NetTypeSelected then begin strMessg := ''; ReportItemParams := nil; SCSCatalog := nil; FObjectName := ''; FReportCaption := ''; if tvReports.Selected <> nil then begin ReportItemParams := TReportItemParams(tvReports.Selected.Data); FReportCaption := tvReports.Selected.Text; end else strMessg := cResourceReport_Msg7; {begin if Assigned(lvReports.Selected) then begin ptrReportItemParams := lvReports.Selected.Data; FReportCaption := lvReports.Selected.Caption; end else strMessg := cResourceReport_Msg7; end;} if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then begin SCSCatalog := GetTargetFolder; if SCSCatalog = nil then strMessg := cResourceReport_Msg8; //if Assigned(tvReportTarget.Selected) then // SCSCatalog := TSCSCatalog(tvReportTarget.Selected.Data) //else // strMessg := cResourceReport_Msg8; end; if strMessg <> '' then ShowMessageByType(Self.Handle, smtDisplay, strMessg, Application.Title, mb_OK or MB_ICONINFORMATION) else begin //*** режим просмотра, или простой печати if rbModeView.Checked or rbModePrint.Checked then begin //Если не определен шаблон для маркировочного листа if (ReportItemParams.FSimpleShablons.FActiveShablonID = -1) and (rkMarkPages in FReportUseKind) then begin if MessageModal(cResourceReport_Msg30, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then MakeNewReportTemplateWizard; end; if (ReportItemParams.FSimpleShablons.FActiveShablonID <> -1) or (ReportItemParams.CanHaveTemplate = biFalse) then begin //*** определить тип устройства вывода - принтер - документ if rbModeView.Checked then FPrintDevice := pdScreen else if rbModePrint.Checked then FPrintDevice := pdPrinter; // Tolik -- 11/04/2017 -- if (SCSCatalog = nil) then SCSCatalog := TSCSCatalog(F_ProjMan.GSCSBase.CurrProject.CurrList); if SCSCatalog <> nil then // ShowReportByParams(SCSCatalog, ReportItemParams); end; end else //*** режим пакетной печати if rbModePacketPrint.Checked then begin FPrintDevice := pdPrinter; CanPrintReport := true; //*** Определить печатаемые листы ListOfAllCADID := TIntList.Create; ListOfCADID := TIntList.Create; if rkProject in FReportUseKind then begin NodeTarget := tvReportTarget.Items[0]; while NodeTarget <> nil do begin SCSCatalog := TSCSCatalog(NodeTarget.Data); if SCSCatalog is TSCSList then begin ListOfAllCADID.Add(TSCSList(SCSCatalog).SCSID); if NodeTarget.Cells[tciCAD] = bsTrue then ListOfCADID.Add(TSCSList(SCSCatalog).SCSID); end; NodeTarget := NodeTarget.GetNext; end; end; //*** определить количество объектов для печати //CheckedObjectCount := 0; //NodeTarget := tvReportTarget.Items[0]; //while NodeTarget <> nil do //begin // if NodeTarget.Cells[tciReport] = bsTrue then // Inc(CheckedObjectCount); // NodeTarget := NodeTarget.GetNext; //end; CheckedObjectCount := 0; if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then CheckedObjectCount := GetCheckedObjectCount else if IsSimpleReportKind(FReportUseKind) then //24.02.2011 if rkCalc in FReportUseKind then CheckedObjectCount := 1; if CheckedObjectCount = 0 then begin CanPrintReport := false; if ListOfCADID.Count = 0 then MessageModal(cResourceReport_Msg18_1, ApplicationName, mb_OK or MB_ICONINFORMATION); end; //*** определить количество печатаемых отчетов //CheckedReportCount := 0; //NodeReport := tvReports.Items[0]; //while NodeReport <> nil do //begin // if NodeReport.Cells[rciIsOn] = bsTrue then // Inc(CheckedReportCount); // NodeReport := NodeReport.GetNext; //end; CheckedReportCount := GetCheckedReportCount; if CheckedReportCount = 0 then begin CanPrintReport := false; if ListOfCADID.Count = 0 then MessageModal(cResourceReport_Msg18_2, ApplicationName, mb_OK or MB_ICONINFORMATION); end; //*** Печать листов if rkProject in FReportUseKind then PrintCADLists(ListOfAllCADID, ListOfCADID); //*** Диалог печати отчетов if CanPrintReport then begin if FFrPrintForm = nil then FFrPrintForm := TfrPrintForm.Create(nil); if GSCSIni.PM.RepDesignLanguageFile = fnRepDesignLangRus then FFrPrintForm.Caption := cResourceReport_Msg19Rus else if GSCSIni.PM.RepDesignLanguageFile = fnRepDesignLangUkr then FFrPrintForm.Caption := cResourceReport_Msg19Ukr; FFrPrintForm.RB2.Enabled := False; // Current page FFrPrintForm.RB3.Enabled := False; // Numbers: FFrPrintForm.E2.Enabled := False; // Numbers: FFrPrintForm.E1.Text := IntToStr(Report.DefaultCopies); FFrPrintForm.CollateCB.Checked := Report.DefaultCollate; if FFrPrintForm.ShowModal = mrOk then begin if CheckedObjectCount > 0 then FReportCountToPrint := CheckedObjectCount * CheckedReportCount else FReportCountToPrint := CheckedReportCount; FReportCountPrinted := 0; ShowReportInPackageMode; {//*** Перебор объектов NodeTarget := tvReportTarget.Items[0]; while NodeTarget <> nil do begin if NodeTarget.Cells[tciReport] = bsTrue then begin SCSCatalog := TSCSCatalog(NodeTarget.Data); //*** Перебор отчетов NodeReport := tvReports.Items[0]; while NodeReport <> nil do begin if NodeReport.Cells[rciIsOn] = bsTrue then begin ReportItemParams := TReportItemParams(NodeReport.Data); ShowReportByParams(SCSCatalog, ReportItemParams); end; NodeReport := NodeReport.GetNext; end; end; NodeTarget := NodeTarget.GetNext; end; } end; FreeAndNil(FFrPrintForm); end; FreeAndNil(ListOfAllCADID); FreeAndNil(ListOfCADID); end else if rbModePacketPrintToExcel.Checked then begin FPrintDevice := pdExcel; DirDialogCaption := cResourceReport_Msg26; DefDirName := cResourceReport_Msg27; if rbPackExportPdf.Checked then begin FPrintDevice := pdPdf; DirDialogCaption := cResourceReport_Msg40; DefDirName := cResourceReport_Msg41; end // Tolik 12/03/2020 else if rbPackExportExcel2007.Checked then begin FPrintDevice := pdExcel2007; DirDialogCaption := cResourceReport_Msg26; DefDirName := cResourceReport_Msg27; end else if rbPackExportWord2007.Checked then begin FPrintDevice := pdWord2007; DirDialogCaption := cResourceReport_Msg26_1; DefDirName := cResourceReport_Msg28; end; CanPrintReport := true; if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then begin //*** определить количество объектов для печати CheckedObjectCount := GetCheckedObjectCount; if CheckedObjectCount = 0 then begin CanPrintReport := false; MessageModal(cResourceReport_Msg18_1, ApplicationName, mb_OK or MB_ICONINFORMATION); end; end; //*** определить количество печатаемых отчетов CheckedReportCount := GetCheckedReportCount; if CheckedReportCount = 0 then begin CanPrintReport := false; MessageModal(cResourceReport_Msg18_2, ApplicationName, mb_OK or MB_ICONINFORMATION); end; if CanPrintReport then begin CurrDateTime := Now; //FPackgeDir := BrowseDialog('Создание папки для Excel отчетов...'); //'c:\temp\SCSReports\'; FPackgeDir := TF_Main(GForm).BrowseNewDirName(DirDialogCaption, ExtractDirToNewReport(CurrDateTime), FileNameCorrect(DefDirName+' '+DateTimeToStr(CurrDateTime))); if FPackgeDir <> '' then FPackgeDir := FPackgeDir + '\'; if FPackgeDir <> '' then begin if Not DirectoryExists(FPackgeDir) then if Not CreateDir(FPackgeDir) then begin MessageModal(cResourceReport_Msg20 + FPackgeDir, ApplicationName, MB_ICONINFORMATION or MB_OK); Exit; ///// EXIT ///// end; if DirectoryExists(FPackgeDir) then begin if CheckedObjectCount > 0 then FReportCountToPrint := CheckedObjectCount * CheckedReportCount else FReportCountToPrint := CheckedReportCount; FReportCountPrinted := 0; //*** Заблокировать BeginProgress Inc(GIsProgressCount); try ShowReportInPackageMode; finally //*** Разрешить BeginProgress Dec(GIsProgressCount); end; end; end; end; end; end; end else ShowMessage(cRepMsg268); end; procedure TF_ResourceReport.FormClose(Sender: TObject; var Action: TCloseAction); begin //Application.OnRestore := FSavedOnAppRestore; //Application.OnMinimize := FSavedOnAppMinimize; //FormList.Clear; end; procedure TF_ResourceReport.gbViewCloseResize(Sender: TObject); begin SetMiddleControlChilds(TControl(Sender), TControl(Self)); end; procedure TF_ResourceReport.cbCanHaveActiveComponentsClick( Sender: TObject); //var // ptrReportItemParams: PReportItemParams; begin //if lvReports.Selected <> nil then //begin // ptrReportItemParams := lvReports.Selected.Data; // if ptrReportItemParams^.CanHaveActiveComponents <> biNone then // if cbCanHaveActiveComponents.Checked then // ptrReportItemParams^.CanHaveActiveComponents := biTrue // else // ptrReportItemParams^.CanHaveActiveComponents := biFalse; //end; end; // Tolik 30/10/2020 -- procedure TF_ResourceReport.cbCanHaveSupplyValueClick(Sender: TObject); begin { if tvReports.Selected <> nil then if ((TReportItemParams(tvReports.Selected.data).RepType = rtCommerceInvoice) or (TReportItemParams(tvReports.Selected.data).RepType = rtSpecification) or (TReportItemParams(tvReports.Selected.data).RepType = rtGOSTSpecification) or (TReportItemParams(tvReports.Selected.data).RepType = rtResources) or (TReportItemParams(tvReports.Selected.data).RepType = rtCableJournal) or (TReportItemParams(tvReports.Selected.data).RepType = rtCable)) then rgCableRate.Visible := (cbCanHaveSupplyValue.Checked = true); } end; // procedure TF_ResourceReport.cbCanHaveZeroPriceComponentsClick( Sender: TObject); //var // ptrReportItemParams: PReportItemParams; begin //if lvReports.Selected <> nil then //begin // ptrReportItemParams := lvReports.Selected.Data; // if ptrReportItemParams^.CanHaveZeroPriceComponents <> biNone then // if cbCanHaveZeroPriceComponents.Checked then // ptrReportItemParams^.CanHaveZeroPriceComponents := biTrue // else // ptrReportItemParams^.CanHaveZeroPriceComponents := biFalse; //end; end; procedure TF_ResourceReport.lbOtherPropertiesClick(Sender: TObject); begin ChoiceBaseOptions(stiReportDesigner); end; procedure TF_ResourceReport.lbOtherPropertiesMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin TRzLabel(Sender).Font.Style := TRzLabel(Sender).Font.Style + [fsUnderline]; end; procedure TF_ResourceReport.lbOtherPropertiesMouseLeave(Sender: TObject); begin TRzLabel(Sender).Font.Style := TRzLabel(Sender).Font.Style - [fsUnderline]; end; procedure TF_ResourceReport.tvReportsCloseUp(Sender: TISPlugInplaceEdit; Section: TISPlugSection; DropDown: TISDropDown; var Accept: Boolean); var NewShablonNode: TFlyNode; NodeIndex: Integer; ReportItemParams: TReportItemParams; ReportShablons: TReportShablons; ActualColumn: Integer; begin //TPopupTree(DropDown.ContainedControl).Selected //tvReports.Col //tvReports.Columns.VisibleColumn[tvReports.Col].Index ActualColumn := tvReports.Columns.VisibleColumn[tvReports.Col].Index; NewShablonNode := nil; //*** Определить выбранную ветвь колонки if TPopupTree(DropDown.ContainedControl).Selected <> nil then begin NodeIndex := TPopupTree(DropDown.ContainedControl).Selected.Index; if (NodeIndex <> -1) and (NodeIndex <= tvReports.Columns[ActualColumn].EditorStyle.Sections[0].Items.Count - 1) then NewShablonNode := tvReports.Columns[ActualColumn].EditorStyle.Sections[0].Items[NodeIndex]; end; if NewShablonNode <> nil then begin //*** Определить используемый шаблон ReportItemParams := tvReports.Selected.Data; ReportShablons := nil; if ReportItemParams <> nil then ReportShablons := ReportItemParams.GetShablonsByTemplateType(GetTemplateTypeByColumnIndex(ActualColumn)); if (ReportShablons <> nil) and (Integer(NewShablonNode.Data) <> ReportShablons.FActiveShablonID) and // Выбран другой (ReportShablons.FRepShablons.IndexOfObject(TObject(NewShablonNode.Data)) <> -1) // Выбран есть в списке then begin //*** Сбросить старый if ReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, ReportShablons.FActiveShablonID, biFalse, qmPhisical); //*** Внести новый ReportShablons.FActiveShablonID := Integer(NewShablonNode.Data); if ReportShablons.FActiveShablonID > 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, ReportShablons.FActiveShablonID, biTrue, qmPhisical); DefineReportNodeControls(tvReports.Selected, true); end; end; { NewShablonNode := nil; //*** Определить выбранную ветвь колонки if TPopupTree(DropDown.ContainedControl).Selected <> nil then begin NodeIndex := TPopupTree(DropDown.ContainedControl).Selected.Index; if (NodeIndex <> -1) and (NodeIndex <= tvReports.Columns[tvReports.Col].EditorStyle.Sections[0].Items.Count - 1) then NewShablonNode := tvReports.Columns[tvReports.Col].EditorStyle.Sections[0].Items[NodeIndex]; end; if NewShablonNode <> nil then begin //*** Определить используемый шаблон ReportItemParams := tvReports.Selected.Data; ReportShablons := nil; if ReportItemParams <> nil then ReportShablons := ReportItemParams.GetShablonsByTemplateType(GetTemplateTypeByColumnIndex(tvReports.Col)); if (ReportShablons <> nil) and (Integer(NewShablonNode.Data) <> ReportShablons.FActiveShablonID) and // Выбран другой (ReportShablons.FRepShablons.IndexOfObject(TObject(NewShablonNode.Data)) <> -1) // Выбран есть в списке then begin //*** Сбросить старый if ReportShablons.FActiveShablonID <> 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, ReportShablons.FActiveShablonID, biFalse, qmPhisical); //*** Внести новый ReportShablons.FActiveShablonID := Integer(NewShablonNode.Data); if ReportShablons.FActiveShablonID <> 0 then TF_Main(GForm).DM.UpdateIntTableFieldByID(tnUserReports, fnUseAsShablon, ReportShablons.FActiveShablonID, biTrue, qmPhisical); DefineReportNodeControls(tvReports.Selected); end; end; } end; procedure TF_ResourceReport.tvReportsSelectedChanged(OldNode, NewNode: TFlyNode); begin if OldNode <> NewNode then DefineReportNodeControls(NewNode, true); end; procedure TF_ResourceReport.tvReportsDblClick(Sender: TObject); begin if tvReports.Selected <> nil then if Not rbModePacketPrint.Checked then // Если отчет запустить в средине этого обработчика (не по таймеру) // то после клика по отчету, стает активной эта форма Timer_ShowReport.Enabled := true; //Act_ShowWizardReport.Execute; end; procedure TF_ResourceReport.tvReportsDrawCell(Sender: TObject; aCanvas: TCanvas; ACol, ARow: Integer; Rect: TRect; State: TExGridDrawState); var Node: TFlyNode; ReportItemParams: TReportItemParams; ActualColumn: Integer; begin ActualColumn := tvReports.Columns.VisibleColumn[ACol].Index; //if ActualColumn = rciStamp then // begin // Node := tvReports.GetNodeAtRow(ARow); // ReportItemParams := nil; // if Node <> nil then // ReportItemParams := TReportItemParams(Node.Data); // if ReportItemParams <> nil then // if ReportItemParams.CanHaveStamp <> biTrue then // begin // aCanvas.Brush.Color := clDisabledCell; //$F3F3F3; //clSkyBlue; // aCanvas.FillRect(Rect); // aCanvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Node.Cells[ActualColumn]); // //SetBkColor(aCanvas.Handle, clSilver); // end; // end; if (ActualColumn = rciSimple) or (ActualColumn = rciStamp) then begin Node := tvReports.GetNodeAtRow(ARow); ReportItemParams := nil; if Node <> nil then ReportItemParams := TReportItemParams(Node.Data); if ReportItemParams <> nil then if (ReportItemParams.CanHaveTemplate = biFalse) or ((ActualColumn = rciStamp) and (ReportItemParams.CanHaveStamp <> biTrue)) then begin aCanvas.Brush.Color := clDisabledCell; //$F3F3F3; //clSkyBlue; aCanvas.FillRect(Rect); aCanvas.TextRect(Rect, Rect.Left + 1, Rect.Top + 1, Node.Cells[ActualColumn]); end; end; end; procedure TF_ResourceReport.Act_NewSimpleTemplateFromStandartExecute( Sender: TObject); begin MakeEditReportTemplate(meMake, true, ttSimple); end; procedure TF_ResourceReport.Act_NewStampTemplateFromStandartExecute( Sender: TObject); begin MakeEditReportTemplate(meMake, true, ttStamp); end; procedure TF_ResourceReport.Act_NewSimpleTemplateFromUserExecute( Sender: TObject); begin MakeEditReportTemplate(meMake, false, ttSimple); end; procedure TF_ResourceReport.Act_NewStampTemplateFromUserExecute( Sender: TObject); begin MakeEditReportTemplate(meMake, false, ttStamp); end; procedure TF_ResourceReport.Act_EditSimpleTemplateExecute(Sender: TObject); begin MakeEditReportTemplate(meEdit, false, ttSimple); end; procedure TF_ResourceReport.Act_EditStampTemplateExecute(Sender: TObject); begin MakeEditReportTemplate(meEdit, false, ttStamp); end; procedure TF_ResourceReport.Act_DeleteSimpleTemplateExecute( Sender: TObject); begin DelReportTemplate(tvReports.Selected, ttSimple); end; procedure TF_ResourceReport.Act_DeleteStampTemplateExecute( Sender: TObject); begin DelReportTemplate(tvReports.Selected, ttStamp); end; procedure TF_ResourceReport.Act_DropAllExecute(Sender: TObject); begin // end; procedure TF_ResourceReport.RepDesignerShow(Sender: TObject); begin // end; procedure TF_ResourceReport.RepDesignerSaveReport(Report: TfrReport; var ReportName: String; SaveAs: Boolean; var Saved: Boolean); begin if Report.Modified then if MessageModal(cResourceReport_Msg15, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then begin Report.SaveToFile(ReportName); FModifiedReportTemplate := true; end else begin FModifiedReportTemplate := false; Saved := false; end; end; procedure TF_ResourceReport.tvReportsPrepareDropDown( Sender: TISPlugInplaceEdit; Section: TISPlugSection; Dropdown: TISDropDown); var i: Integer; CurrTextWidth: Integer; MaxTextWidth: Integer; NewWidth: Integer; begin //TPopupTree(Dropdown.ContainedControl).gett MaxTextWidth := 0; for i := 0 to Section.Items.Count - 1 do begin CurrTextWidth := Canvas.TextWidth(Section.Items[i].Text); if MaxTextWidth < CurrTextWidth then MaxTextWidth := CurrTextWidth; end; NewWidth := 0; if MaxTextWidth > 0 then NewWidth := MaxTextWidth + 40 else NewWidth := tvReports.Columns[tvReports.Col].Width; //tvReports.Columns[tvReports.Col].Width * 2; if NewWidth > Dropdown.ContainedControl.Width then Dropdown.ContainedControl.Width := NewWidth; end; procedure TF_ResourceReport.btTemplateClick(Sender: TObject); begin TToolButton(Sender).CheckMenuDropdown; end; procedure TF_ResourceReport.btExportTemplateToFileClick(Sender: TObject); begin if btExportTemplateToFile.Style = ComCtrls.tbsDropDown then TToolButton(Sender).CheckMenuDropdown else ExportTemplateToFile(ttSimple); end; procedure TF_ResourceReport.btEditTemplateClick(Sender: TObject); begin if btEditTemplate.Style = ComCtrls.tbsDropDown then TToolButton(Sender).CheckMenuDropdown else MakeEditReportTemplate(meEdit, false, ttSimple); end; procedure TF_ResourceReport.btDelTemplateClick(Sender: TObject); begin if btDelTemplate.Style = ComCtrls.tbsDropDown then TToolButton(Sender).CheckMenuDropdown else DelReportTemplate(tvReports.Selected, ttSimple); end; procedure TF_ResourceReport.rbModeViewClick(Sender: TObject); begin DefineReportModeControls; if Sender = rbModePacketPrint then btShowReport.Caption := rbModePrint.Caption else if Sender = rbModePacketPrintToExcel then btShowReport.Caption := cNameExportB else btShowReport.Caption := TRzCheckBox(Sender).Caption; end; procedure TF_ResourceReport.tvReportTargetEdited(Sender: TObject; Node: TFlyNode; var S: String); var ActualColumn: Integer; begin ActualColumn := tvReportTarget.GetColumnOrder(tvReportTarget.Col); //*** опция какой колонки изменяется if Node <> nil then if Node.Data <> nil then case ActualColumn of tciCAD: // для проекта не м.б печать КАДа if TObject(Node.Data) is TSCSProject then S := bsGray; tciReport: // Для нестандартного листа не м.б отчета if TObject(Node.Data) is TSCSList then if Not TSCSList(Node.Data).IsNormalType then S := bsGray; end; end; procedure TF_ResourceReport.tvReportsEdited(Sender: TObject; Node: TFlyNode; var S: String); var ActualColumn: Integer; WasChanged: Boolean; i, CheckCounter, VisibleItemsCounter: Integer; currReportItemParams: TReportItemParams; aNode: TFlyNode; begin ActualColumn := TFlyTreeViewPro(Sender).GetColumnOrder(TFlyTreeViewPro(Sender).Col); WasChanged := true; if ActualColumn = rciIsOn then begin // Tolik //if TReportItemParams(Node.Data).Mode = fmRDefectAct then if (TReportItemParams(Node.Data).Mode = fmRDefectAct) or (TReportItemParams(Node.Data).Mode = fmCompoSpecification) then begin WasChanged := false; S := bsFalse; end; if WasChanged then Timer_DefineReportNodeControls.Enabled := true; //Tolik // выставить состояние переключателя (выбрать все) при пакетной печати / экспорте CheckCounter := 0; VisibleItemsCounter := 0; for i := 0 to tvReports.Items.Count - 1 do begin aNode := tvReports.Items[i]; if aNode.Hidden = false then Inc(VisibleItemsCounter); end; if VisibleItemsCounter > 2 then begin for i := 0 to tvReports.Items.Count - 1 do begin aNode := tvReports.Items[i]; if aNode <> Node then begin if aNode.Hidden = false then begin currReportItemParams := TReportItemParams(aNode.Data); if ((currReportItemParams.RepType <> rtCompoSpecification) and (currReportItemParams.RepType <> rtDefectAct)) then begin if tvReports.Items[i].Cells[rciIsOn] = bsTrue then Inc(CheckCounter); end; end; end; end; currReportItemParams := TReportItemParams(Node.Data); if (((currReportItemParams.RepType <> rtCompoSpecification) and (currReportItemParams.RepType <> rtDefectAct)) and (Node.Cells[rciIsOn] = bsFalse)) then Inc(CheckCounter); if CheckCounter = (VisibleItemsCounter - 2) then begin CheckAllReports.OnClick := nil; CheckAllReports.State := cbChecked; CheckAllReports.OnClick := CheckAllReportsClick; end else begin CheckAllReports.OnClick := nil; CheckAllReports.State := cbUnChecked; CheckAllReports.OnClick := CheckAllReportsClick; end; end; end; end; procedure TF_ResourceReport.Timer_DefineReportNodeControlsTimer( Sender: TObject); begin Timer_DefineReportNodeControls.Enabled := false; if tvReports.Selected.Cells[rciIsOn] = bsTrue then begin // Не дать установить галочку напротив отчета без шаблона для маркировочных листов if rkMarkPages in FReportUseKind then if (TReportItemParams(tvReports.Selected.Data).FSimpleShablons.FActiveShablonID = -1) then begin if MessageModal(cResourceReport_Msg30, ApplicationName, MB_ICONQUESTION or MB_YESNO) = IDYES then MakeNewReportTemplateWizard; if TReportItemParams(tvReports.Selected.Data).FSimpleShablons.FActiveShablonID = -1 then tvReports.Selected.Cells[rciIsOn] := bsFalse; end; end; DefineReportNodeControls(tvReports.Selected, false); end; procedure TF_ResourceReport.frOLEExcelExportStartExportPageEvent(Sender: TObject; ACaption: string; AObjCount: Integer); begin TF_Main(GForm).F_ProgressExp.Message1.Visible := False; TF_Main(GForm).F_ProgressExp.esBitBtn1.Visible := True; TF_Main(GForm).F_ProgressExp.Gauge1.Visible := True; TF_Main(GForm).F_ProgressExp.Gauge1.MinValue := 0; TF_Main(GForm).F_ProgressExp.Gauge1.MaxValue := AObjCount - 1; TF_Main(GForm).F_ProgressExp.Gauge1.Progress := 0; if FReportCountPrinted = 0 then begin TF_Main(GForm).F_ProgressExp.FormStyle := fsStayOnTop; TF_Main(GForm).F_ProgressExp.lbProgress.Visible := true; TF_Main(GForm).F_ProgressExp.lbTotalProgress.Visible := true; TF_Main(GForm).F_ProgressExp.pnTotalProgress.Visible := true; TF_Main(GForm).F_ProgressExp.AutoSize := false; TF_Main(GForm).F_ProgressExp.AutoSize := true; TF_Main(GForm).F_ProgressExp.cbOpen.Visible := true; TF_Main(GForm).F_ProgressExp.cbOpen.Checked := true; TF_Main(GForm).F_ProgressExp.cbOpen.Caption := ACaption; //cResourceReport_Msg21; TF_Main(GForm).F_ProgressExp.gTotal.Visible := true; TF_Main(GForm).F_ProgressExp.gTotal.MinValue := 1; TF_Main(GForm).F_ProgressExp.gTotal.MaxValue := 100; TF_Main(GForm).F_ProgressExp.gTotal.Progress := 0; TF_Main(GForm).F_ProgressExp.WasCancel := false; Application.ProcessMessages; TF_Main(GForm).F_ProgressExp.FormStyle := fsStayOnTop; TF_Main(GForm).F_ProgressExp.Show; SetForegroundWindow(TF_Main(GForm).F_ProgressExp.Handle); end; TF_Main(GForm).F_ProgressExp.lbProgress.Caption := cNameReportB + ': '+FReportCaption; TF_Main(GForm).F_ProgressExp.lbTotalProgress.Caption := cNameObjectB + ': '+FObjectName; TF_Main(GForm).F_ProgressExp.Repaint; //SetForegroundWindow(TF_Main(GForm).F_ProgressExp.Handle); //Application.ProcessMessages; end; procedure TF_ResourceReport.frOLEExcelExportProgressExportPageEvent(Sender: TObject; var AWasCancel: Boolean; AObjIndex, AObjectCount: Integer); var UnitCountInProgressStep: Integer; // Количество единиц для одного объекта UnitCountLoadedForCurObject: Integer; // загруженность одного объекта begin if Not TF_Main(GForm).F_ProgressExp.WasCancel then begin Application.ProcessMessages; TF_Main(GForm).F_ProgressExp.Gauge1.Progress := AObjIndex; TF_Main(GForm).F_ProgressExp.Gauge1.Refresh; //*** Количество шагов для одного объекта в общем прогрессе UnitCountInProgressStep := Round(100 / FReportCountToPrint); UnitCountLoadedForCurObject := Round((AObjIndex+1) / AObjectCount) * UnitCountInProgressStep; TF_Main(GForm).F_ProgressExp.gTotal.Progress := (UnitCountInProgressStep * FReportCountPrinted) + UnitCountLoadedForCurObject - 2; TF_Main(GForm).F_ProgressExp.gTotal.Refresh; end; AWasCancel := TF_Main(GForm).F_ProgressExp.WasCancel; end; procedure TF_ResourceReport.frOLEExcelExportEndExportPageEvent(Sender: TObject; AWasCancel: Boolean); var i: Integer; begin Inc(FReportCountPrinted); if (FReportCountPrinted = FReportCountToPrint) or AWasCancel then begin if FReportCountPrinted = FReportCountToPrint then begin //*** Догнать до 100 for i := TF_Main(GForm).F_ProgressExp.gTotal.Progress + 1 to TF_Main(GForm).F_ProgressExp.gTotal.MaxValue do begin TF_Main(GForm).F_ProgressExp.gTotal.Progress := i; TF_Main(GForm).F_ProgressExp.gTotal.Refresh; // Tolik 29/07/2019 -- //Sleep(500); Sleep(5); // end; if TF_Main(GForm).F_ProgressExp.cbOpen.Checked then ShellExecute(Handle, nil, PChar(FPackgeDir), nil, nil, SW_SHOW); end; if AWasCancel then FReportCountPrinted := FReportCountToPrint; TF_Main(GForm).F_ProgressExp.Close; end; end; procedure TF_ResourceReport.rbRepModeDocumentClick(Sender: TObject); begin if tvReports.Selected <> nil then DefineReportNodeControls(tvReports.Selected, true); end; procedure TF_ResourceReport.RzBitBtn1Click(Sender: TObject); begin MakeNewReportTemplateWizard; end; procedure TF_ResourceReport.Act_NewMarkPageExecute(Sender: TObject); begin MakeNewReportTemplateWizard; end; procedure TF_ResourceReport.Act_NewMarkPageFromUserExecute( Sender: TObject); begin MakeEditReportTemplate(meMake, false, ttSimple); end; procedure TF_ResourceReport.Act_EditTemplateExecute(Sender: TObject); begin if rkMarkPages in FReportUseKind then MakeEditReportTemplate(meEdit, false, ttSimple); end; procedure TF_ResourceReport.Act_DeleteTemplateExecute(Sender: TObject); begin if rkMarkPages in FReportUseKind then DelReportTemplate(tvReports.Selected, ttSimple); end; procedure TF_ResourceReport.Act_ImportTemplateFromFileExecute( Sender: TObject); begin ImportTemplateFromFile; end; procedure TF_ResourceReport.Act_ExportTemplateToFileExecute(Sender: TObject); begin ExportTemplateToFile(ttSimple); end; procedure TF_ResourceReport.Act_ExportSimpleTemplateToFileExecute( Sender: TObject); begin ExportTemplateToFile(ttSimple); end; procedure TF_ResourceReport.Act_ExportStampTemplateToFileExecute( Sender: TObject); begin ExportTemplateToFile(ttStamp); end; { TSortFieldLists } constructor TSortFieldLists.Create(AOwner: TReportSortInfo); begin FOwner := AOwner; FFieldNames := TStringList.Create; FFieldCaptCodes := TStringList.Create; end; destructor TSortFieldLists.Destroy; begin FreeAndNil(FFieldNames); FreeAndNil(FFieldCaptCodes); inherited; end; { TReportSortInfo } procedure TReportSortInfo.AddFieldInfo(const AFieldName, ACaption: String); begin FAllFieldNames.Add(AFieldName); FAllFieldCaptions.Add(ACaption); end; procedure TReportSortInfo.Assign(AReportSortInfo: TReportSortInfo); begin FID := AReportSortInfo.FID; FRepKind := AReportSortInfo.FRepKind; FDescending := AReportSortInfo.FDescending; FCaseSensitive := AReportSortInfo.FCaseSensitive; FUsedFieldNames.Clear; FUsedFieldNames.AddStrings(AReportSortInfo.FUsedFieldNames); end; constructor TReportSortInfo.Create(AOwner: TReportItemParams); begin FOwner := AOwner; FAllFieldNames := TStringList.Create; FAllFieldCaptions := TStringList.Create; FUsedFieldNames := TStringList.Create; FID := 0; FRepKind := 0; if AOwner <> nil then FRepKind := AOwner.RepType; FDescending := biFalse; FCaseSensitive := biFalse; end; destructor TReportSortInfo.Destroy; begin FreeAndNil(FAllFieldNames); FreeAndNil(FAllFieldCaptions); FreeAndNil(FUsedFieldNames); inherited; end; function TReportSortInfo.GetFieldCaption(const AFName: String): String; var StrIndex: Integer; begin Result := ''; StrIndex := FAllFieldNames.IndexOf(AFName); if StrIndex <> -1 then Result := FAllFieldCaptions[StrIndex]; end; Procedure TReportSortInfo.ClearFields; begin if FAllFieldNames <> nil then FAllFieldNames.Clear; if FAllFieldCaptions <> nil then FAllFieldCaptions.Clear; if FUsedFieldNames <> nil then FUsedFieldNames.Clear; end; procedure TF_ResourceReport.Act_EditReportSortInfoExecute(Sender: TObject); var ReportItemParams: TReportItemParams; begin ReportItemParams := nil; if tvReports.Selected <> nil then ReportItemParams := TReportItemParams(tvReports.Selected.Data); if ReportItemParams <> nil then begin if TF_Main(GForm).CreateFItemsSelector.SelectReportSortFields(ReportItemParams.FReportSortInfo) then TF_Main(GForm).DM.SaveReportSortInfo(ReportItemParams.FReportSortInfo); end; end; procedure TF_ResourceReport.tvReportTargetCollapsing(Sender: TObject; Node: TFlyNode; var AllowCollapse: Boolean); begin AllowCollapse := false; end; procedure TF_ResourceReport.Timer_ShowReportTimer(Sender: TObject); begin TTimer(Sender).Enabled := false; Act_ShowWizardReport.Execute; end; procedure TF_ResourceReport.Act_ExportToBc3Execute(Sender: TObject); var RootObjectsCatalog: TSCSCatalog; TargetFolder: TSCSCatalog; ReportItemParams: TReportItemParams; ReportItemParamValues: TReportItemParams; StringList: TStringList; Str: String; ProjCurrency: TNBCurrency; CurrencySign: String; Dialog: TSaveDialog; procedure AddCatalogInfoToStrings(ACatalog: TSCSCatalog); var CatalogChild: TSCSCatalog; Compon: TSCSComponent; TopSign: String; CatalogName: String; i: Integer; begin Str := ''; // Для 2-х верхних уровней, кроме самого верхнего(-1) добавляем символ '#' TopSign := ''; CatalogName := ''; if (ACatalog.Level <= 1) and (ACatalog.Level <> -1) then TopSign := '#'; if ACatalog.Level <> -1 then CatalogName := ACatalog.Name; Str := '~C|'+ACatalog.NameMark+TopSign+'||'+CatalogName+'|0|211108|0|'; StringList.Add(Str); // Записываем подкаталоги и компоненты Str := ''; Str := Str + '~D|'+ACatalog.NameMark+TopSign+'|'; for i := 0 to ACatalog.ChildCatalogs.Count - 1 do begin CatalogChild := ACatalog.ChildCatalogs[i]; Str := Str + CatalogChild.NameMark+'\1\0\'; end; for i := 0 to ACatalog.SCSComponents.Count - 1 do begin Compon := ACatalog.SCSComponents[i]; Str := Str + Compon.ArticulProducer+'\1\0\'; end; Str := Str + '|'; StringList.Add(Str); end; procedure LoadCatalogList; var SortedCatalogs: TStringList; Catalog: TSCSCatalog; i: Integer; begin SortedCatalogs := CreateStringListSorted; // Сортируем каталоги по маркировке for i := 0 to RootObjectsCatalog.ChildCatalogReferences.Count - 1 do begin Catalog := RootObjectsCatalog.ChildCatalogReferences[i]; SortedCatalogs.AddObject(Catalog.NameMark, Catalog); end; for i := 0 to SortedCatalogs.Count - 1 do begin Catalog := TSCSCatalog(SortedCatalogs.Objects[i]); AddCatalogInfoToStrings(Catalog); end; AddCatalogInfoToStrings(RootObjectsCatalog); FreeAndNil(SortedCatalogs); end; procedure LoadComponList; var SortedCompons: TStringList; Compon: TSCSComponent; ComponPrice, ComponCount: Double; i: integer; DescriptionStream: TStream; NBQuerySelect: TpFIBQuery; begin SortedCompons := TStringList.Create; for i := 0 to RootObjectsCatalog.ComponentReferences.Count - 1 do begin Compon := RootObjectsCatalog.ComponentReferences[i]; SortedCompons.AddObject(Compon.ArticulProducer, Compon); end; for i := 0 to SortedCompons.Count - 1 do begin Compon := TSCSComponent(SortedCompons.Objects[i]); GetComponQtPriceInUOM(Compon, TF_Main(GForm).FUOM, @ComponPrice, @ComponCount); Str := '~C|'+Compon.ArticulProducer+'|'+Compon.Izm+'|'+Compon.Name+'|'+FloatToStr(ComponPrice)+'|211108|3|'; StringList.Add(Str); end; // Скрипт загрузки описания компонента из НБ NBQuerySelect := TF_Main(GForm).FNormBase.DM.Query_Select; // Описания компонентов for i := 0 to SortedCompons.Count - 1 do begin Compon := TSCSComponent(SortedCompons.Objects[i]); DescriptionStream := TF_Main(GForm).FNormBase.DM.GetStreamFromTableByGUID(tnComponent, fnDescription, Compon.GuidNB, qmPhisical); Str := GetStringFromStream(DescriptionStream); if Str <> '' then begin Str := '~T|'+Compon.ArticulProducer +'|'+ Str+'|'; StringList.Add(Str); end; FreeAndNil(DescriptionStream); end; FreeAndNil(SortedCompons); end; begin try if tvReports.Selected <> nil then begin ReportItemParams := TReportItemParams(tvReports.Selected.Data); TargetFolder := GetTargetFolder; if TargetFolder = nil then MessageInfo(cResourceReport_Msg8) else begin Dialog := TSaveDialog.Create(nil); Dialog.Title := cSavingToFile; //SetParamsToDialog(Dialog, FFileExt); Dialog.DefaultExt := '*'+enBc3; Dialog.Filter := GetDialogFilter(GetExtensionDescription(enBc3), enBc3); Dialog.InitialDir := ''; Dialog.FileName := ''; Dialog.FileName := ''; Dialog.Options := Dialog.Options + [ofOverwritePrompt]; if Dialog.Execute then begin Application.ProcessMessages; ReportItemParamValues := GetCurrReportItemParamValues; RootObjectsCatalog := PrepareCommerceInvoiceObjects(TargetFolder, ReportItemParams, ReportItemParamValues); BeginProgress; try ProjCurrency := TF_Main(GForm).GSCSBase.CurrProject.Spravochnik.GetCurrencyByType(ctMain); CurrencySign := ''; if ProjCurrency <> nil then CurrencySign := ProjCurrency.Data.NameBrief; StringList := TStringList.Create; // Заголовок StringList.Add('~V|SOFT S.A.|FIEBDC-3/2002|Presto 8.8||ANSI|'); // Инфа о валюте StringList.Add('~K|\3\3\3\3\3\3\3\'+CurrencySign+'\|0|'); // Список Каталогов LoadCatalogList; // Компоненты LoadComponList; //StringList.SaveToFile('c:\file.bc3'); StringList.SaveToFile(Dialog.FileName); FreeAndNil(StringList); finally EndProgress; FreeAndNil(RootObjectsCatalog); end; FreeAndNil(ReportItemParamValues); end; Dialog.Free; end; end; except on E: Exception do AddExceptionToLogExt(ClassName, MethodName(@TF_ResourceReport.Act_ExportToBc3Execute), E.Message); end; end; procedure TF_ResourceReport.nePricePrecisionChange(Sender: TObject); begin if nePricePrecision.IntValue <> GSCSIni.PM.RepPricePrecision then begin GSCSIni.PM.RepPricePrecision := nePricePrecision.IntValue; WritePMIni(GSCSIni.PM); end; end; procedure TF_ResourceReport.neKolvoPrecisionChange(Sender: TObject); begin if neKolvoPrecision.IntValue <> GSCSIni.PM.RepKolvoPrecision then begin GSCSIni.PM.RepKolvoPrecision := neKolvoPrecision.IntValue; WritePMIni(GSCSIni.PM); end; end; procedure TF_ResourceReport.Timer_TimeOutExecTimer(Sender: TObject); var i: integer; begin if self.Visible then begin TTimer(Sender).Enabled := false; SendKeyDown(tvReports, VK_HOME, []); Application.ProcessMessages; if TTimer(Sender).Tag > 0 then begin for i := 1 to TTimer(Sender).Tag do begin SendKeyDown(tvReports, VK_DOWN, []); Application.ProcessMessages; end; end; Act_ShowWizardReport.Execute; end; end; { procedure TF_ResourceReport.ShowEtazhClick(Sender: TObject); begin ShowAllResourses.Enabled:=(ShowEtazh.Checked or ShowKabinet.Checked); end; procedure TF_ResourceReport.ShowKabinetClick(Sender: TObject); begin ShowAllResourses.Enabled:=(ShowEtazh.Checked or ShowKabinet.Checked); end; } procedure TF_ResourceReport.cbCanShowKabinetClick(Sender: TObject); begin if cbCanShowKabinet.Checked then cbGroupByHeightOfPlacing.Checked := False; cbCanShowObjHierarchy.Enabled := cbCanShowKabinet.Visible and cbCanShowKabinet.Checked; cbAsPlacingInProj.Enabled := not cbCanShowKabinet.Checked; //cbReportWithStamp.Enabled := not cbCanShowKabinet.Checked and not cbCanGroupByName.Checked; //if cbCanShowKabinet.Checked then // cbReportWithStamp.Checked := false; //if cbCanGroupByName.Checked then // cbReportWithStamp.Checked := false; // cbCanGroupByName.Enabled:=cbCanShowKabinet.Visible and cbCanShowKabinet.Checked; end; procedure TF_ResourceReport.cbAsPlacingInProjClick(Sender: TObject); begin //cbCanshowKabinet.Enabled := cbAsPlacingInProj.Checked; //cbCanShowObjHierarchy.Enabled := cbCanShowKabinet.Checked and cbCanShowKabinet.Enabled; //cbCanGroupByName.Enabled := cbAsPlacingInProj.Checked; end; procedure TF_ResourceReport.cbCanGroupByNameClick(Sender: TObject); begin //cbReportWithStamp.Enabled := not cbCanShowKabinet.Checked and not cbCanGroupByName.Checked; //if cbCanShowKabinet.Checked then // cbReportWithStamp.Checked := false; //if cbCanGroupByName.Checked then // cbReportWithStamp.Checked := false; end; procedure TF_ResourceReport.cbReportWithStampClick(Sender: TObject); begin cbShowCablePath.Enabled := not cbReportWithStamp.Checked; end; procedure TF_ResourceReport.cbShowCablePathClick(Sender: TObject); begin cbReportWithStamp.Enabled := not cbShowCablePath.Checked; //cbShowCablePath.Enabled := not cbReportWithStamp.Checked; end; //Tolik procedure TF_ResourceReport.CheckAllReportsClick(Sender: TObject); var i: Integer; Node: TFlyNode; ReportItemParams: TReportItemParams; begin for i := 0 to tvReports.Items.Count - 1 do begin Node := tvReports.Items[i]; if Node.Hidden = False then begin ReportItemParams := TReportItemParams(Node.Data); if ((ReportItemParams.RepType <> rtCompoSpecification) and (ReportItemParams.RepType <> rtDefectAct)) then begin if CheckAllReports.Checked then tvReports.Items[i].Cells[rciIsOn] := bsTrue else tvReports.Items[i].Cells[rciIsOn] := bsFalse; end; end; end; end; // Tolik --10/08/2017 -- procedure TF_ResourceReport.cbOldReportFormClick(Sender: TObject); var ReportItemParams: TReportItemParams; begin ReportItemParams := nil; if tvReports.Selected <> nil then ReportItemParams := TReportItemParams(tvReports.Selected.Data); if ReportItemParams <> nil then begin ReportItemParams.FReportSortInfo.ClearFields; if cbOldReportForm.checked then begin ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameMark, cRepMsg58); //AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg58); //NUMCABLE //AReportItemParams.FReportSortInfo.AddFieldInfo(fnMarkID, cRepMsg58); //NUMCABLE ReportItemParams.FReportSortInfo.AddFieldInfo(fnComponentIndex, cResourceReport_Msg42); // индекс кабеля ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameCable, cRepMsg77); //CABLETYPE ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg78); //NUMSWITCHBOARD ReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameTo, cRepMsg79); //NUMSWITCHBOARDPORT ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameList, cRepMsg80); //COMESFROM ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg81); //NUMOUTLETORSWITCHBOARD ReportItemParams.FReportSortInfo.AddFieldInfo(fnPortNameFrom, cRepMsg82); //NUMOUTLETORSWITCHBOARDPORT end else begin ReportItemParams.FReportSortInfo.AddFieldInfo(fnName, cRepMsg247); ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameFrom, cRepMsg250); ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameTo, cRepMsg251); ReportItemParams.FReportSortInfo.AddFieldInfo(fnTraceCabling, cRepMsg249); ReportItemParams.FReportSortInfo.AddFieldInfo(fnNameMark, cRepMsg256); ReportItemParams.FReportSortInfo.AddFieldInfo(fnTotalKolvo, cRepMsg255); ReportItemParams.FReportSortInfo.AddFieldInfo(fnLength, cRepMsg154); end; end end; procedure TF_ResourceReport.cbGroupByHeightOfPlacingClick(Sender: TObject); begin if cbGroupByHeightOfPlacing.Checked then begin cbCanShowKabinet.Checked := False; cbCanShowObjHierarchy.Enabled := True; end else cbCanShowObjHierarchy.Enabled := False; end; end.