admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 22:45:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/SRC/SCSNormBase/U_ResourceReport.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

26998 lines
2.3 MiB
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.
Reference in New Issue View Git Blame Copy Permalink