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, 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 // 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; // 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; //////////////////////////////////////////////////////////////////////////////////////////////////////////// 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; 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; function GetFieldCaption(const AFName: String): String; 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; // Группировать компоненты по назваиню ////Added by Tolik для счета-фактуры CanShowResources : Integer; CanShowWorks : Integer; // Added by Tolik for GOSTCableJournal (галочку будем выключать) CanShowCablePaths : 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; Timer1: TTimer; 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; 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 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; //FfrOLEExcelExport: TMyfrOleExl; FCostOfProjectReportParams: TCostOfProjectReportParams; FcbCanHaveActiveComponentsCurr: TRzCheckBox; FcbCanHaveDismountAccountCurr: TRzCheckBox; { 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 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 //ReelsCableFlow : TStringList; // список строк с расходом кабеля из катушек 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; 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); procedure ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName: 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 ShowCrossConnection(AParams: TReportItemParams); procedure ShowCablePathsWizard(ACable: TSCSComponent); procedure ShowCrossConnectionWizard(ACompon: TSCSComponent); //added by Tolik procedure ShowWACoordinatesReport(AFolder: TSCSCatalog; AList: TStringList); constructor Create(AOwner: TComponent; AForm: TForm); destructor Destroy; override; 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; var ReelsCableFlow : TStringList; {$R *.dfm} { TReportShablons } // Added by Tolik type TCableTypeArray = array of TCableTypes; // 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; 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; 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; // длина трассы // если трасса не последняя в списке, то берем следующую // и ищем предмет, лежащий на стыке трасс (если есть) if x <> SCSCompon.WholeComponent.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; propList.Add(s); 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 // если задана высота межэтажного перекрытия, добавляем его (там же тоже кабель проходит) 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; if (FirstCompon <> nil) and (LastCompon<>nil) then begin 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; 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 := 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; Begin // если таблица не пустая if not aMemTable.IsEmpty then begin // если список кабелей не пустой if Length(CableTypes) > 0 then begin aMemTable.First; repeat ReelFound := False; 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 aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString :=' ('+ CableTypes[i].ReelName + cRepMsg234+ inttostr(j+1)+')'; ReelFound := True; aMemTable.Post; break; end; end; end; end; end; end; if not ReelFound then begin aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString := ' ('+ cRepMsg233+')'; aMemTable.Post; end; aMemTable.Next; until aMemTable.Eof; end else begin aMemTable.First; repeat aMemTable.Edit; aMemTable.FieldByName('REELNAME').AsString := ' ('+ cRepMsg233+')'; aMemTable.Post; aMemTable.Next; until aMemTable.eof; 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; CableTypes[Length(CableTypes) - 1].Izm := CurrSuppliesKind.Data.Izm; // единицы измерения 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) > 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 : string; // Сброс параметров типов кабелей 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; // пипец // расчет количества бухт и расхода кабелей // режим еффективной работы Procedure MaxEfficiency(CableTypes : TCableTypeArray); Var i,j,k,l : integer; Counter : integer; // счетчик AllCableLength : double; s : string; // сточка для отчета (катушка № + список кабелей) CableCut : Boolean; Begin // если список типов кабелей не пустой if Length(CableTypes) > 0 then begin // формируем количество катушек // для каждого типа кабеля // делаем предварительный просчет количества катушек 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 // пока не отрежем все кабели 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]); // идентификатор кабеля Counter := Counter - 1; // уменьшаем счетчик end; end; until Counter = 0; // сбрасываем отметки кабелей 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; 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); 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; // уменьшаем счетчик неотрезанных кабелей 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 s := ' ' + CableTypes[i].ReelName + cRepMsg234 + inttostr(j + 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(j + 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; 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; 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); 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; ////////////////////////// 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; ////////////////////////////////// CanShowResources := biFalse; CanShowWorks := biFalse; CanShowCablePaths := biFalse; 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; 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; //*** 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 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); } //*** Пояснительная записка 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; AddParamsToReportList(cResourceReport_Msg1_4, RepParams); //*** Кабельный журнал ГОСТ RepParams := TReportItemParams.Create(fmRGOSTCableJournal, rtGOSTCableJournal, rkProject); RepParams.CanHaveActiveComponents := biTrue; RepParams.CanHaveDismountAccount := 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; 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; AddParamsToReportList(cResourceReport_Msg1_20, RepParams); // Спецификация на компоненты RepParams := TReportItemParams.Create(fmCompoSpecification, rtCompoSpecification, rkProject); RepParams.CanHaveStamp := biFalse; RepParams.CanHaveTemplate := biFalse; AddParamsToReportList(cResourceReport_Msg1_25, RepParams, false); // Дом с подъездом RepParams := TReportItemParams.Create(fmRHouse, rtHouse, rkProject); RepParams.CanHaveStamp := biTrue; RepParams.CanAsPlacingInProj := biTrue; AddParamsToReportList(cResourceReport_Msg1_24, RepParams, false); // Дефектный акт 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; // RepParams.CanHaveZeroPriceComponents := biTrue; RepParams.CanPricePrecision := biTrue; RepParams.CanKolvoPrecision := biTrue; // RepParams.CanHaveFormMode := biTrue; // RepParams.CanHaveStamp := biTrue; // 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, false); //*** Предварительная оценка стоимости проекта RepParams := TReportItemParams.Create(fmRPriorCostOfProject, rtPriorCostOfProject, rkCalc); AddParamsToReportList(cResourceReport_Msg1_12, RepParams); //*** Полный путь кабеля RepParams := TReportItemParams.Create(fmRCablePaths, rtCablePaths, rkCablePath); 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); 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; 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; {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); 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 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; //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]; 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; { 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; rbPackExportPdf.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; //Added by Tolik для счета-фактуры CanShowResources : Integer; CanShowWorks : Integer; // Added by Tolik for GOSTCableJournal CanShowCablePaths : Integer; ////////////////////////////////////// GroupMode: Integer; IsPackageMode: Boolean; ExistsActiveTemplate: Boolean; ExistsActiveStampTemplate: Boolean; 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 Toilk 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 RzGroupBox3.Enabled := false; 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; //Added by Tolik для счета-фактуры CanShowResources :=biFalse; CanShowWorks := biFalse; CanShowCablePaths := biTrue; // 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; ////////////////////////// //Added by Tolik для счета-фактуры CanShowResources := ReportItemParams.CanShowResources; CanShowWorks := ReportItemParams.CanShowWorks; 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.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); ///////// //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, 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 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 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 // Ведомость кабелей 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; RepTemplateSignature: string; 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)); ReportTemplateStream.WriteBuffer(PChar(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); 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 if ATemplateType = ttSimple then Result := Result + fnRGOSTSpecification else if (ATemplateType = ttA3) or ACanA3 then Result := Result + fnRGOSTSpecificationA3; 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; 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)); if 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 Result := (rkCalc in AReportUseKinds) or (rkCablePath in AReportUseKinds) or (rkCrossConnection 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; // Создаст объект каталога 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; 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; //08.08.2012 CatalogWithNoDefined.AddComponentToList(GroupCompon); end; CatalogWithNoDefined.AddComponentToList(GroupCompon); end; GroupComponList.Add(GroupCompon); end; GroupCompon.Length := GroupCompon.Length + GetComponQuantityByParams(Compon, AReportItemParamValues.CanHaveDismountAccount=biTrue); // Запоминаем кабель //02.08.2012 if (Compon.Isline = biTrue) and (Compon.Whole_ID <> 0) then //02.08.2012 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); 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); 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]); 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; if (rkProject in FReportUseKind) or (rkMarkPages in FReportUseKind) then begin if rkProject 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; 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; 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); //*** Если шаблон не стандартный, то извлеч его в файл 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; CanShowObjHierarchy : Boolean; CanGroupByName : Boolean; CanShowResources : Boolean; CanShowworks : Boolean; FormMode: TResourceReportFormMode; FullPathInCableJournal: Boolean; CurrReportItemParamValues: TReportItemParams; TestRep: Boolean; begin if AFolder is TSCSProject then TSCSProject(AFolder).NotifyBeforeReport; 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; ///////// 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); 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); 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; //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 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; if ExtractFileName(Report.FileName)='RExplicationComponent.frf' then begin if (cbCanShowKabinet.Checked and cbCanShowKabinet.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; 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; 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, 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 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; Report.PrepareReport; if frExport = nil then begin if APrintDevice = pdExcel 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 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 AddExceptionToLog('TF_ResourceReport.ShowReport: '+E.Message); 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); //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; OldTick, CurrTick: Cardinal; 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) and CheckSysNameIsCable(SCSComponent.ComponentType.SysName) then begin SCSComponent.RefreshWholeLengthIfNecessary; // цепляем к списк кабелей // CableTypesAdd(SCSComponent, CableTypes, CableIdsList,SCSComponent.ID); CableTypesAdd(SCSComponent, CableTypes, CableIdsList,SCSComponent.Whole_ID, Self); end; end; // если на проекте есть кабели if Length(CableTypes) > 0 then // расчет расхода кабеля CableReelCalculate(CableTypes, 'MaxScrapRate', ReelsCableFlow, Self) // если нет - сбросим результаты предидущих расчетов, // в случае наличия таковых 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 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); //*** Учитывать поставочные велечины if SprSuppliesKind <> nil 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 begin ResourceRel.Kolvo := Length(CableTypes[j].Reels); 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 begin ResourceRel.Kolvo := Length(CableTypes[j].Reels); 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 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 begin ResourceRel.Kolvo := Length(CableTypes[j].Reels); CableTypeFound := true; end end; if not CabletypeFound then ResourceRel.Kolvo := ResourceRel.Kolvo / SprSuppliesKind.Data.UnitKolvo; end; // // 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; 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); 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 //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; MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnIzm).AsString := GroupNorm.Izm_; //24.09.2010 MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, PrecisionNormKolvo); //19.11.2013 NormTotalLaborTime := Round(GroupNorm.LaborTime*GroupNorm.Kolvo); MemTable_RNorms.FieldByName(fnLaborTime).AsString := GetDisplayTextToNORMLaborTime(IntToStr(GroupNorm.LaborTime)); MemTable_RNorms.FieldByName(fnPricePerTime).AsFloat := RoundX(GroupNorm.PricePerTime, PrecisionNormKolvo); 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); //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 inc(FICount); 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 inc(FICount); 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]; //While not currCompon.IsTop do // currCompon := currCompon.GetParentComponent; 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; { LastCompon := TF_Main(GForm).GSCSBase.CurrProject.GetComponentFromReferences(AComponent.LastIDConnectedConnCompon); if ((FirstCompon <> nil) and (LastCompon <> nil)) then begin if ((FirstCompon <> nil) and (LastCompon <> nil)) then begin While not FirstCompon.IsTop do FirstCompon := FirstCompon.GetParentComponent; While not LastCompon.IsTop do LastCompon := LastCompon.GetParentComponent; // количество интерфейсов на концах соединения for i := 0 to FirstCompon.Interfaces.Count - 1 do begin if FirstCompon.Interfaces[i].TypeI = itFunctional then inc(FICount); end; for i := 0 to FirstCompon.ChildReferences.Count - 1 do begin for j := 0 to FirstCompon.ChildReferences[i].Interfaces.Count - 1 do begin if FirstCompon.ChildReferences[i].Interfaces[j].TypeI = itFunctional then inc(FICount); end; end; for i := 0 to LastCompon.Interfaces.Count - 1 do begin if LastCompon.Interfaces[i].TypeI = itFunctional then inc(LICount); end; for i := 0 to LastCompon.ChildReferences.Count - 1 do begin for j := 0 to LastCompon.ChildReferences[i].Interfaces.Count - 1 do begin if LastCompon.ChildReferences[i].Interfaces[j].TypeI = itFunctional then inc(LICount); end; end; if LICount > FICount then begin s := ALastConObj; ALastConObj := AFirstConObj; AFirstConObj := s; 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; 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]; //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: if CheckSysNameIsCable(Component.ComponentType.SysName) then begin // Added by Tolik if not cbNone.Checked then // CableTypesAdd(Component, CableTypes, CableIdsList,MemTable_RCableJournal.AutoIncValue+1); 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; 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); //*** Длина превышает граничное значение. 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; // первый проход // второй проход // смотрим електросеть, телевиз., и т.п. и засыпаем в таблицу for i := 0 to AFolder.ComponentReferences.Count - 1 do begin Component := AFolder.ComponentReferences[i]; if Assigned(Component) and CheckNoIDinList(Component.ID, ListWithLookedCompons) 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: if CheckSysNameIsCable(Component.ComponentType.SysName) then begin // Added by Tolik if not cbNone.Checked then // CableTypesAdd(Component, CableTypes, CableIdsList,MemTable_RCableJournal.AutoIncValue+1); 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; 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; 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;} 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 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 ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (SCSComponent.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then if SCSComponent.HaveInterfaceByType(itFunctional) then //*** Есть ли функциональные интерфейсы if ((CheckSysNameIsCable(SCSComponent.ComponentType.SysName)) and // Tolik (not (SCSComponent.IDNetType in [3,4,5,7])) 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 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; MemTable_RCableJournal.Post; MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; 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); // номер порта розетки MemTable_RCableJournal.Post; MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; 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; //*** Сортировка //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 ComponSignType := SCSComponent.GetPropertyValueAsInteger(pnSignType); if (SCSComponent.IsLine = biTrue) and ((ComponSignType = oitProjectible) or (ACanHaveActiveComponents)) then if SCSComponent.HaveInterfaceByType(itFunctional) then //*** Есть ли функциональные интерфейсы if (CheckSysNameIsCable(SCSComponent.ComponentType.SysName) and // Tolik (not (SCSComponent.IDNetType in [3,4,5,7])) 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 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; // длины линейных компонент по пути кабеля // MemTable_RCableJournal.Post; MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; 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); // номер порта розетки MemTable_RCableJournal.Post; MasterID := MemTable_RCableJournal.FieldByName(fnID).AsInteger; 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; //*** Сортировка //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); 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; { // украдено у Игоря 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 {CurrCompon.IsLine = biTrue} (CheckSysNameIsCable(CurrCompon.ComponentType.SysName) and (not (CurrCompon.IDNetType in [3,4,5,7]))) 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; 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; mtRCableJournalInterfaces.FieldByName(fnIDMaster).AsInteger := 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; 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; //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 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; 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; FolderIDComponList := Tlist.Create; ListWithBusyCompons := TList.Create; TypeList := TList.Create; //GroupList := TList.Create; //*** Найти все кмопоненты папки FolderIDComponList := GetFolderComponList(GForm, AFolder, [itSCSLine, itSCSConnector]); if FolderIDComponList = nil then Exit; //// EXIT ///// //*** Разбить компоненты по группам относительно 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 := 'Нет'; 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 //*** Сгруппировать компоненты 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 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; 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; MemTable_RSpecifTypeCompon.Post; IDTypeSpecif := MemTable_RSpecifTypeCompon.FieldByName(fnID).AsInteger; 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 and (GroupComponent.GUIDSuppliesKind <> '') then SprSuppliesKind := ProjectOwner.Spravochnik.GetSuppliesKindByGUID(GroupComponent.GUIDSuppliesKind); // Подогнать под вид поставки if SprSuppliesKind <> nil 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; 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 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); 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; // стоимость работ (лист) // вытаскиваем стоимость работ из всех компонентов на листе { 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); 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; 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; 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 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 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; 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; 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; 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; // Отчет "Экспликация компонентов" procedure TF_ResourceReport.ShowExplicationComponent(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams;ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, ACanRoundValue, ACanHaveSupplyValue, ACanShowKabinet, ACanShowObjHierarchy, ACanGroupByName: 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; OldTick, CurrTick: Cardinal; 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; // 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 ResourceRel.Cost := 0; ResourceRel.Price := 0; ResourceRel.Kolvo := 0; end; End; // ********************************************************************************************** // ************************ Процедура записи данных в таблицы *********************************** procedure SetComponDataToMemTable(ACanShowKabinet: boolean); var IsFindedCompType: Boolean; IsCanShowKabinet: Boolean; IsAddedString : Boolean; markstring, s : string; begin IsCanShowKabinet := ACanShowKabinet; 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 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; // Поиск типа компненты для текушего кабинета 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 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); 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); // **************** Перебор и запись элементов проекта в таблицы (Begin) BeginProgress(pcPreparingReport); try FCatalog := ACatalog; ProjectOwner := FCatalog.GetProject; NormResources := nil; NormResources := ACatalog.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, ACanHaveActiveComponents, ACanHaveDismountAccount, AComponsWithZeroPrice, false, true, ACanHaveSupplyValue); isCanShowObjHierarchy := ACanShowObjHierarchy; // Если задано отображать в порядке размещения if IsProjOrder or IsCanShowKabinet 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 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); end else begin FindResourcesForComponent(SCSComponent, SCSComponent.Name, SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet); 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 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); end else begin FindResourcesForComponent(SCSComponent, SCSComponent.Name,SCSComponent.Price, SCSComponent.Length, SCSComponent.Isline = biTrue); SetComponDataToMemTable(ACanShowKabinet); 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 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; 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) //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; {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; 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; procedure TF_ResourceReport.ShowComponSpecifications(ACatalog: TSCSCatalog; AParams: TReportItemParams; AReportItemParamValues: TReportItemParams); begin try if Not rbModePacketPrintToExcel.Checked then begin CreateFGuideFileList; F_GuideFileList.Execute(gftCompSpecification, ACatalog.ComponentReferences); 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 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 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 (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); 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; mtRep.Post; end; for j := 0 to SCSComponent.WholeComponent.Count - 1 do ListWithLookedCompons.Add(SCSComponent.WholeComponent[j]); 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; begin try 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 FreeAndNil(Catalogs); 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 FCatalog := AFolder; F_MasterDefectAct := TF_MasterDefectAct.Create(GForm, GForm); F_MasterDefectAct.Execute(fmView, AFolder, true, TF_Main(GForm).FUOM); FreeAndNil(F_MasterDefectAct); 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; 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; 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; // 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: Integer; Compon: TSCSComponent; ComponPrice: Double; ComponCount: Double; ComponCost: Double; begin for i := 0 to ACatalog.SCSComponents.Count - 1 do begin Compon := ACatalog.SCSComponents[i]; //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); AddRecoToMT(Compon.ArticulProducer, cBaseCommon75, Compon.Izm, Compon.Name, ComponCount, ComponPrice, ComponCost, clNone, ptCompon); if ACatalogCost <> nil then ACatalogCost^ := ACatalogCost^ + ComponCost; 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; 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 // Итого группы AddRecoToMT('', '', '', IntToStrF(ACatalog.MarkID, 2), 0, 0, CatalogCost, clNone, ptGroupTotal); // Черная полоска AddRecoToMT('', '', '', '', 0, 0, 0, clBlack, ptBreak); end else begin // Общее итого // commented by Tolik, потому что считать общие суммы будем в отчете // AddRecoToMT('', '', '', cRepMsg32, 0, 0, CatalogCost, clNone, ptGroupTotal); end; if AParentCatalogCost <> nil then AParentCatalogCost^ := AParentCatalogCost^ + CatalogCost; end; begin MemTable_RResources.Close; MemTable_RResources.Open; MemTable_RNorms.Close; MemTable_RNorms.Open; DefinePrecisions; // Получить точность цены и количества try if FmtCommerceInvoice = nil then begin 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 // насыпаем 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); GroupedNorms := ACatalog.GetAllNormsResources([nrNorms], false, true, 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; MemTable_RNorms.FieldByName(fnExpense).AsFloat := RoundX(GroupNorm.Kolvo, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnIzm).AsString := GroupNorm.Izm_; //24.09.2010 MemTable_RNorms.FieldByName(fnPrice).AsFloat := RoundX(GroupNorm.Price, PrecisionNormKolvo); MemTable_RNorms.FieldByName(fnTotalCost).AsFloat := RoundX(GroupNorm.TotalCost, PrecisionNormKolvo); 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 NormResources := ACatalog.GetAllNormsResources([nrResources, nrAccessories, nrComponents], false, IntToBool(AReportItemParamValues.CanHaveActiveComponents), IntToBool(AReportItemParamValues.CanHaveDismountAccount), true, false, true, true); //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 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; end; procedure TF_ResourceReport.ShowCablePaths(AParams: TReportItemParams); var //Params: TReportItemParams; Interf: TSCSInterface; i: Integer; Paths: TObjectList; Path: TInterfPath; SideEndPaths: TObjectList; // полученные конечные объекты для стороны интерфейса SidePathsInfo: TObjectList; // Инфа о пути для каждого конечного объекта в SideEndObjects StepPathsInfo: TObjectList; // Инфа о текущем расматриваемом пути в рекурсии LoadPathsInfoForSide; EndPaths: TObjectList; PrevPathInfo: TInterfPath; function CheckInterfInPaths(AInterf: TSCSInterface): Boolean; var i: Integer; Path: TInterfPath; begin Result := false; for i := 0 to Paths.Count - 1 do begin Path := TInterfPath(Paths[i]); if Path.CheckInterfInPaths(AInterf) then begin Result := true; Break; //// BREAK //// end; end; end; function GetEndPathList(APath: TInterfPath; ASideEndPaths: TObjectList): TObjectList; var i: Integer; Paths: TObjectList; begin Result := nil; for i := 0 to ASideEndPaths.Count - 1 do begin Paths := TObjectList(ASideEndPaths[i]); if TSCSComponent(TInterfPath(Paths[0]).Compon).GetTopComponent = TSCSComponent(APath.Compon).GetTopComponent then begin Result := Paths; Break; //// BREAK //// end; end; end; procedure AddToSidePaths(APath: TInterfPath); var InsIndex: Integer; i: Integer; SideEndFromPos: Integer; MinFromPos: Integer; begin InsIndex := SideEndPaths.Count; MinFromPos := 0; for i := 0 to SideEndPaths.Count - 1 do begin SideEndFromPos := TInterfPath(TObjectList(SideEndPaths[i]).Items[0]).FromPos; if (APath.FromPos < SideEndFromPos) and ((MinFromPos=0) or (MinFromPos > SideEndFromPos)) then begin MinFromPos := SideEndFromPos; InsIndex := i; end; end; StepPathsInfo := APath.GetPathFromRoot; EndPaths := TObjectList.Create(false); EndPaths.Add(APath); SideEndPaths.Insert(InsIndex, EndPaths); //SideEndPaths.Add(APath); SidePathsInfo.Insert(InsIndex, StepPathsInfo); end; function LoadPathsInfoForSideStep(APath: TInterfPath): Boolean; var i: Integer; ChildPath: TInterfPath; ChildsRes: Boolean; WithoutInterfCount: Integer; EndPaths: TObjectList; InsIndex: Integer; begin Result := false; if APath.Interf <> nil then begin EndPaths := nil; // Если конечные объекты отображаем в одной группе if Not cbCablePathShowConnInSeparatePaths.Checked then EndPaths := GetEndPathList(APath, SideEndPaths); if EndPaths = nil then begin if APath.Paths.Count = 0 then begin if (APath.ParentPath <> nil) then begin AddToSidePaths(APath); Result := true; end; end else begin WithoutInterfCount := 0; for i := 0 to APath.Paths.Count - 1 do begin ChildPath := TInterfPath(APath.Paths[i]); ChildsRes := LoadPathsInfoForSideStep(ChildPath); if ChildsRes then Result := true; if ChildPath.Interf = nil then WithoutInterfCount := WithoutInterfCount + 1; end; // Если на всех дочерних объектах не указан интерфейс (соединение внутри верхнего компонента), // тогда этот будет поледним if (Not Result) and (APath.Paths.Count > 0) and (APath.Paths.Count = WithoutInterfCount) then begin Result := true; AddToSidePaths(APath); end; end; end else begin InsIndex := EndPaths.Count; for i := 0 to EndPaths.Count - 1 do if APath.FromPos < TInterfPath(EndPaths[i]).FromPos then begin InsIndex := i; Break; //// BREAK //// end; EndPaths.Insert(InsIndex, APath); end; end; end; function LoadPathsInfoForSide(APath: TInterfPath; var ASideEndPaths, ASidePathsInfo: TObjectList): Boolean; begin SideEndPaths.Clear; SidePathsInfo.Clear; ASideEndPaths := TObjectList.Create(true); ASidePathsInfo := TObjectList.Create(true); Result := LoadPathsInfoForSideStep(APath); if Result = true then begin ASideEndPaths.Assign(SideEndPaths); ASidePathsInfo.Assign(SidePathsInfo); end; end; function PointPathToStr(APath: TInterfPath; ASidePathsInfo: TObjectList): String; var Indent: String; IndentStep: Integer; InternalConnected: TSCSComponents; InternalCompon: TSCSComponent; Compon: TSCSComponent; TopComponent: TSCSComponent; Path: TInterfPath; Strings: TStringList; //Str: String; PortFromPos, PortToPos: Integer; PortInfo: String; i: Integer; begin Result := ''; Indent := ''; IndentStep := 2; Strings := TStringList.Create; Compon := TSCSInterface(APath.Interf).ComponentOwner; TopComponent := Compon.GetTopComponent; // Определяем порт на который приходит PortInfo := ''; if APath.ConnPosition <> nil then begin if TSCSInterface(APath.Interf).PortOwner <> nil then begin if GetPortPosRangeByInterfRange(TSCSInterface(APath.Interf), TSCSInterfPosition(APath.ConnPosition).FromPos, TSCSInterfPosition(APath.ConnPosition).ToPos, PortFromPos, PortToPos) then begin PortInfo := ' ('+TSCSInterface(APath.Interf).PortOwner.LoadName + ' '+ IntToStr(PortFromPos)+' - '+IntToStr(PortToPos)+')'; end; end; //else // PortInfo := TSCSInterface(APath.Interf).LoadName + ' '+ // IntToStr(TSCSInterfPosition(APath.ConnPosition).FromPos)+' - '+ // IntToStr(TSCSInterfPosition(APath.ConnPosition).ToPos); end; if cbCablePathShowConnInSeparatePaths.Checked then begin InternalConnected := TSCSComponents.Create(false); // Из начала пути выгребаем внутри компонентное подключение for i := ASidePathsInfo.Count - 1 downto 0 do begin Path := TInterfPath(ASidePathsInfo[i]); if TSCSComponent(Path.Compon).GetTopComponent = TopComponent then begin if InternalConnected.IndexOf(Compon) = -1 then InternalConnected.Insert(0, TSCSComponent(Path.Compon)); end else Break; //// BREAK //// end; if InternalConnected.IndexOf(Compon) = -1 then InternalConnected.Add(Compon); // Объект if cbCablePathShowEndObjName.Checked then begin Strings.Add(Indent + TopComponent.GetFirstParentCatalog.GetNameForVisible+'\'); Indent := Indent + DupStr(' ', IndentStep); end; // Верхний компонент if InternalConnected.IndexOf(TopComponent) = -1 then begin Strings.Add(Indent + TopComponent.GetNameForVisible+'\'); Indent := Indent + DupStr(' ', IndentStep); end; // Внутри-подключенные компоненты по интерфейсам for i := 0 to InternalConnected.Count - 1 do begin InternalCompon := InternalConnected[i]; Strings.Add(Indent + InternalCompon.GetNameForVisible); if InternalCompon = Compon then begin Indent := Indent + DupStr(' ', IndentStep); //22.12.2011 - Инфа о порте на который приходит if PortInfo <> '' then begin Strings.Add(Indent + PortInfo); Indent := Indent + DupStr(' ', IndentStep); end; end; end; // Внутри-подключенные компоненты по подключениям if APath.Paths.Count > 0 then for i := 0 to APath.Paths.Count - 1 do begin Path := TInterfPath(APath.Paths[i]); if Path.Interf = nil then Strings.Add(Indent + TSCSComponent(Path.Compon).GetNameForVisible); end; InternalConnected.Free; end else begin if cbCablePathShowEndObjName.Checked then begin Strings.Add(Indent + TopComponent.GetFirstParentCatalog.GetNameForVisible+'\'); Indent := Indent + DupStr(' ', IndentStep); end; // Верхний компонент Strings.Add(Indent + TopComponent.GetNameForVisible+'\'); Indent := Indent + DupStr(' ', IndentStep); //22.12.2011 сам компонент if TopComponent <> Compon then begin Strings.Add(Indent + Compon.GetNameForVisible+'\'); Indent := Indent + DupStr(' ', IndentStep); end; //22.12.2011 - Инфа о порте на который приходит if PortInfo <> '' then begin Strings.Add(Indent + PortInfo); Indent := Indent + DupStr(' ', IndentStep); end; end; Result := Strings.Text; Strings.Free; end; function EqualCompons(ACompon1, ACompon2: TSCSComponent): Boolean; begin Result := (ACompon1 = ACompon2); //or ((ACompon1.Whole_ID <> 0) and (ACompon1.Whole_ID = ACompon2.Whole_ID)); if Not Result and (ACompon1.Whole_ID <> 0) and (ACompon1.Whole_ID = ACompon2.Whole_ID) and Not cbCablePathShowObjName.Checked and (Not cbCablePathShowCableCanals.Checked or (ACompon1.GetParentComponent = ACompon2.GetParentComponent)) // Если отображать каналы then Result := true; end; procedure AddToDescription(var ADescr: String; APath: TInterfPath; AMargin: Boolean=false); var Msg: String; ParentCompon: TSCSComponent; begin if (PrevPathInfo = nil) or Not EqualCompons(TSCSComponent(APath.Compon), TSCSComponent(PrevPathInfo.Compon)) or ((TSCSInterface(APath.Interf).Kolvo <> TSCSInterface(PrevPathInfo.Interf).Kolvo) or (APath.FromPos <> PrevPathInfo.FromPos) or (APath.ToPos <> PrevPathInfo.ToPos)) then begin //Msg := PathToStr(APath, APath.FromPos, APath.ToPos); Msg := TSCSInterface(APath.Interf).ComponentOwner.GetNameForVisible; // Каб.каналы if cbCablePathShowCableCanals.Checked then begin ParentCompon := TSCSInterface(APath.Interf).ComponentOwner.GetParentComponent; while ParentCompon <> nil do begin Msg := ParentCompon.GetNameForVisible +'\'+Msg; ParentCompon := ParentCompon.GetParentComponent; end; end; // Имя объекта if cbCablePathShowObjName.Checked then Msg := TSCSInterface(APath.Interf).ComponentOwner.GetFirstParentCatalog.GetNameForVisible +'\'+Msg; if Msg <> '' then begin FmtCablePathsInfo.Append; FmtCablePathsInfo.FieldByName(fnParentID).AsInteger := FmtCablePaths.FieldByName(fnID).AsInteger; FmtCablePathsInfo.FieldByName(fnDescription).AsString := Msg; //FmtCablePathsInfo.FieldByName(fnNumPair).AsString := // IntTostr(TSCSInterface(APath.Interf).Kolvo)+ ' ('+IntToStr(APath.FromPos)+'-'+IntToStr(APath.ToPos)+')'; FmtCablePathsInfo.FieldByName(fnInterfCount).AsInteger := TSCSInterface(APath.Interf).Kolvo; FmtCablePathsInfo.FieldByName(fnNameFrom).AsInteger := APath.FromPos; FmtCablePathsInfo.FieldByName(fnNameTo).AsInteger := APath.ToPos; FmtCablePathsInfo.FieldByName(fnMargin).AsInteger := BoolToInt(AMargin); FmtCablePathsInfo.Post; end; end; PrevPathInfo := APath; end; procedure LoadLineInterfacesFromEndPath(APath: TInterfPath; AInterList: TObjectList); var PrevPath: TInterfPath; begin // Определяем интерфейсы кабеля подключенного к точ. компоненту PrevPath := APath; while PrevPath <> nil do begin if (PrevPath.Interf <> nil) and(TSCSComponent(PrevPath.Compon).IsLine = biTrue) then begin if (TSCSInterface(PrevPath.Interf).ParallelInterface <> nil) and (AInterList.IndexOf(TSCSInterface(PrevPath.Interf).ParallelInterface)=-1) then AInterList.Add(TSCSInterface(PrevPath.Interf).ParallelInterface); Break; //// BREAK //// end; PrevPath := PrevPath.ParentPath; end; end; function ShowInterfPaths(APath: TInterfPath): Boolean; var Side1EndPaths: TObjectList; Side1PathsInfo: TObjectList; Side2EndPaths: TObjectList; Side2PathsInfo: TObjectList; SideREndPaths: TObjectList; SideRPathsInfo: TObjectList; SidePathsInfoFrom, SidePathsInfoTo: TObjectList; EndPathList1, EndPathList2: TObjectList; EndPathListFrom, EndPathListTo, EndPathListConnected: TObjectList; EndComponents: TObjectList; BeginLineInterfaces, EndLineInterfaces: TObjectList; BeginLineInterf, EndLineInterf, InterfToDefine: TSCSInterface; ConnectedCount: Integer; //LookedPathList: TObjectList; FullPathList: TObjectList; EndPath1, EndPath2: TInterfPath; EndPath: TInterfPath; Path: TInterfPath; PathInfo: TObjectList; FullPath, FullPath2: TInterfPath; ParamPath, ParamPath2: TInterfPath; PathToShow: TInterfPath; PathToShowToPos: Integer; PrevPath: TInterfPath; Res1, Res2: Boolean; i, j, k, l: Integer; Description: String; RotatePath: Boolean; OldFmtCablePathsInfoRecCnt: Integer; //13.10.2013 begin Result := false; if cbCablePathShowConnInSeparatePaths.Checked then begin // Ищем конечные объекты с одной стороны Res1 := LoadPathsInfoForSide(APath, Side1EndPaths, Side1PathsInfo); if Res1 then for i := 0 to Side1EndPaths.Count - 1 do begin //EndPath1 := TInterfPath(Side1EndPaths[i]); EndPath1 := TInterfPath(TObjectList(Side1EndPaths[i]).Items[0]); EndPath := nil; EndPath := EndPath1; PathInfo := TObjectList(Side1PathsInfo[i]); //if (PathInfo.Count > 0) and (PathInfo[PathInfo.Count-1] = EndPath1) then //begin // Ищем от конечного сегмента, сегмент с кабелем (линейным компонентом) //for j := PathInfo.Count - 1 downto 0 do //begin // Path := TInterfPath(PathInfo[j]); // if TSCSComponent(Path.Compon).IsLine = biTrue then // begin // EndPath := Path; // // Чтобы не пойти в обратном пути к EndPath1, берем интерфейс с другой стороны // if (Path.ParentPath <> nil) and (Path.ParentPath.Compon = Path.Compon) then // EndPath := Path.ParentPath; // Break; //// BREAK //// // end; //end; // Ищем от конечного сегмента, сегмент с точ.компонентом кот-й соединен с линейным (для случая подключений в пределах верхнего компонента) //for j := PathInfo.Count - 1 downto 0 do //begin // Path := TInterfPath(PathInfo[j]); // if TSCSComponent(Path.Compon).GetTopComponent = TSCSComponent(EndPath1.Compon).GetTopComponent then // EndPath := Path // else // Break; //// BREAK //// //end; //end; if EndPath <> nil then begin //FullPath := TSCSInterface(EndPath1.Interf).GetInterfPath(EndPath1.FromPos, EndPath1.ToPos, false); FullPath := TSCSInterface(EndPath.Interf).GetInterfPath(EndPath.FromPos, EndPath.ToPos, false); ParamPath := FullPath.GetPathByInterfFromAll(APath.Interf); if ParamPath <> nil then begin Result := true; Res2 := LoadPathsInfoForSide(FullPath, Side2EndPaths, Side2PathsInfo); if Res2 then begin // тут авэха(в этом цикле) for j := 0 to Side2EndPaths.Count - 1 do begin //EndPath2 := TInterfPath(Side2EndPaths[0]); //EndPath2 := TInterfPath(Side2EndPaths[j]); EndPath2 := TInterfPath(TObjectList(Side2EndPaths[j]).Items[0]); PathInfo := TObjectList(Side2PathsInfo[j]); PathToShow := ParamPath; // Смотрим на путь с другой стороны FullPath2 := TSCSInterface(EndPath2.Interf).GetInterfPath(EndPath2.FromPos, EndPath2.ToPos, false); ParamPath2 := FullPath2.GetPathByInterfFromAll(APath.Interf); SideREndPaths := nil; SideRPathsInfo := nil; // Если с другой стороны видем детальнее: меньший диапазон жил, тогда отображаем путь с такой стороны if (ParamPath2 <> nil) and ((ParamPath2.ToPos-ParamPath2.FromPos) < (ParamPath.ToPos-ParamPath.FromPos)) then begin PathToShow := ParamPath2; Res2 := LoadPathsInfoForSide(FullPath2, SideREndPaths, SideRPathsInfo); if Res2 and (SideRPathsInfo.Count > 0) then begin PathInfo := TObjectList(SideRPathsInfo[0]); RotateTObjectList(PathInfo); end; end; FmtCablePaths.Append; FmtCablePaths.FieldByName(fnName).AsString := TSCSInterface(PathToShow.Interf).LoadName+ ' '+ IntToStr(PathToShow.FromPos)+'-'+IntToStr(PathToShow.ToPos); FmtCablePaths.FieldByName(fnNppFrom).AsInteger := PathToShow.FromPos; FmtCablePaths.FieldByName(fnNppTo).AsInteger := PathToShow.ToPos; FmtCablePaths.FieldByName(fnNameFrom).AsString := PointPathToStr(EndPath1, TObjectList(Side1PathsInfo[i])); FmtCablePaths.FieldByName(fnNameTo).AsString := PointPathToStr(EndPath2, TObjectList(Side2PathsInfo[j])); //PointPathToStr(EndPath2, TObjectList(Side2PathsInfo[0])); FmtCablePaths.Post; for k := 0 to PathInfo.Count - 1 do AddToDescription(Description, TInterfPath(PathInfo[k])); if ParamPath2 <> nil then ParamPath2.Free; if SideREndPaths <> nil then SideREndPaths.Free; if SideRPathsInfo <> nil then SideRPathsInfo.Free; end; end; Side2EndPaths.Free; Side2PathsInfo.Free; FullPath.Free; end; end; end; Side1EndPaths.Free; Side1PathsInfo.Free; FmtCablePaths.SortOn(fnNppFrom, []); end else begin Res1 := LoadPathsInfoForSide(APath, Side1EndPaths, Side1PathsInfo); Res2 := LoadPathsInfoForSide(APath.PathSide, Side2EndPaths, Side2PathsInfo); if Res1 and Res2 then begin OldFmtCablePathsInfoRecCnt := FmtCablePathsInfo.RecordCount; for i := 0 to Side1EndPaths.Count - 1 do begin EndPathList1 := TObjectList(Side1EndPaths[i]); for j := 0 to Side2EndPaths.Count - 1 do begin EndPathList2 := TObjectList(Side2EndPaths[j]); EndPathListFrom := EndPathList1; EndPathListTo := EndPathList2; SidePathsInfoFrom := Side1PathsInfo; SidePathsInfoTo := Side2PathsInfo; // Будем расматривать путь с той стороны где больше расклюен кабель //if EndPathList2.Count > EndPathList1.Count then //if EndPathList2.Count < EndPathList1.Count then //begin // EndPathListFrom := EndPathList2; // EndPathListTo := EndPathList1; // SidePathsInfoFrom := Side2PathsInfo; // SidePathsInfoTo := Side1PathsInfo; //end; EndPath1 := TInterfPath(EndPathListFrom[0]); EndPath2 := TInterfPath(EndPathListTo[0]); PathToShow := APath; PathToShowToPos := 0; FmtCablePaths.Append; // имя кабеля выведем чуть ниже - из-за определеня детального диапазона жил FmtCablePaths.FieldByName(fnNameFrom).AsString := PointPathToStr(EndPath1, TObjectList(Side1PathsInfo[i])); FmtCablePaths.FieldByName(fnNameTo).AsString := PointPathToStr(EndPath2, TObjectList(Side2PathsInfo[j])); FmtCablePaths.Post; EndPathListConnected := TObjectList.Create(false); EndComponents := TObjectList.Create(false); BeginLineInterfaces := TObjectList.Create(false); EndLineInterfaces := TObjectList.Create(false); //LookedPathList := TObjectList.Create(false); FullPathList := TObjectList.Create(true); for k := 0 to EndPathListFrom.Count - 1 do begin EndPath1 := TInterfPath(EndPathListFrom[k]); EndPath := EndPath1; if TSCSInterface(EndPath.Interf).id = 10182 then EmptyProcedure; FullPath := TSCSInterface(EndPath.Interf).GetInterfPath(EndPath.FromPos, EndPath.ToPos, false); FullPathList.Add(FullPath); // Определяем интерфейсы кабеля подключенного к точ. компоненту LoadLineInterfacesFromEndPath(EndPath1, BeginLineInterfaces); for l := EndPathListTo.Count - 1 downto 0 do begin EndPath2 := TInterfPath(EndPathListTo[l]); PathToShow := FullPath.GetPathByInterfFromAll(EndPath2.Interf, EndPath2.FromPos, EndPath2.ToPos); if PathToShow <> nil then //if LookedPathList.IndexOf(EndPath2) = -1 then begin EndPathListConnected.Add(PathToShow); //EndPathListConnected.Add(PathToShow); EndComponents.Add(PathToShow.Compon); //LookedPathList.Add(EndPath2); // Определяем интерфейсы кабеля подключенного к точ. компоненту LoadLineInterfacesFromEndPath(PathToShow, EndLineInterfaces); //PathToShow := FullPath.GetPathByInterfFromAll(EndPath1.Interf, 41,41); // Выводим подключенные точ компоненты объекта (начало) if EndPathListConnected.Count > 0 then AddToDescription(Description, EndPath1, true); end; end; end; SideREndPaths := nil; SideRPathsInfo := nil; PathInfo := TObjectList(Side2PathsInfo[j]); // Путь PathToShow := nil; InterfToDefine := nil; RotatePath := false; // Определяем интерфейс конечного куска кабеля из которого можно получить более детальную инфу о диапазоне жил // например в APath 50 жил, а задействовано с 21-30 if (BeginLineInterfaces.Count = 1) and (EndLineInterfaces.Count = 1) then begin BeginLineInterf := TSCSInterface(BeginLineInterfaces[0]); EndLineInterf := TSCSInterface(EndLineInterfaces[0]); if BeginLineInterf.Kolvo < EndLineInterf.Kolvo then InterfToDefine := BeginLineInterf else begin InterfToDefine := EndLineInterf; RotatePath := true; end; end else if BeginLineInterfaces.Count = 1 then InterfToDefine := TSCSInterface(BeginLineInterfaces[0]) else if EndLineInterfaces.Count = 1 then begin InterfToDefine := TSCSInterface(EndLineInterfaces[0]); RotatePath := true; end; //if EndLineInterfaces.Count = 1 then // InterfToDefine := TSCSInterface(EndLineInterfaces[0]); if InterfToDefine <> nil then begin FullPath := InterfToDefine.GetInterfPath(1, InterfToDefine.Kolvo, false); FullPathList.Add(FullPath); PathToShow := FullPath.GetPathByInterfFromAll(APath.Interf); if PathToShow <> nil then begin //PathToShowToPos := PathToShow.ToPos; // PathToShow может пренадлежать кабелю в которого каждая жила расключена и в итоге увидем 1-48 вместо 1-1 PathToShowToPos := PathToShow.FromPos + (FullPath.ToPos - (FullPath.FromPos-1)-1); Res2 := LoadPathsInfoForSide(FullPath, SideREndPaths, SideRPathsInfo); if Res2 and (SideRPathsInfo.Count > 0) then begin PathInfo := TObjectList(SideRPathsInfo[0]); if RotatePath then RotateTObjectList(PathInfo); end; end; end; // Выводим путь и конечные объекты if EndPathListConnected.Count > 0 then begin // Выводим путь (кабели) for l := 0 to PathInfo.Count - 1 do begin Path := TInterfPath(PathInfo[l]); if EndComponents.IndexOf(Path.Compon) = -1 then AddToDescription(Description, Path); end; // Выводим подключенные точ компоненты объекта (конец) for l := 0 to EndPathListConnected.Count - 1 do begin EndPath := TInterfPath(EndPathListConnected[l]); AddToDescription(Description, EndPath, true); end; end; //PathToShow := nil; // Если конечный объект один (кабель не разведен на несколько комплектеющих шкафа), тогда отображаем сколько жил кабеля задействовано //if EndPathListConnected.Count = 1 then //begin // EndPath := TInterfPath(EndPathListConnected[0]); // FullPath := TSCSInterface(EndPath.Interf).GetInterfPath(EndPath.FromPos, EndPath.ToPos, false); // PathToShow := FullPath.GetPathByInterfFromAll(APath.Interf); //end; if PathToShow = nil then begin PathToShow := APath; PathToShowToPos := APath.ToPos; end; FmtCablePaths.Edit; FmtCablePaths.FieldByName(fnName).AsString := TSCSInterface(PathToShow.Interf).LoadName+ ' '+ IntToStr(PathToShow.FromPos)+'-'+IntToStr(PathToShowToPos); FmtCablePaths.Post; Result := FmtCablePathsInfo.RecordCount > OldFmtCablePathsInfoRecCnt; //13.10.2013 - Попали ли данные интерфейса в отчет if SideREndPaths <> nil then SideREndPaths.Free; if SideRPathsInfo <> nil then SideRPathsInfo.Free; FullPathList.Free; EndLineInterfaces.Free; BeginLineInterfaces.Free; EndComponents.Free; EndPathListConnected.Free; //LookedPathList.Free; end; end; end; Side1EndPaths.Free; Side1PathsInfo.Free; Side2EndPaths.Free; Side2PathsInfo.Free; end; end; begin try if FComponent <> nil then begin 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(fnNumPair, ftString, 255); FmtCablePathsInfo.FieldDefs.Add(fnInterfCount, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnNameFrom, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnNameTo, ftInteger); FmtCablePathsInfo.FieldDefs.Add(fnMargin, ftInteger); ConnectDetailMemTable(FdsrcCablePaths, FmtCablePathsInfo, fnID, fnParentID); end; FmtCablePaths.Active := false; FmtCablePaths.Active := true; FmtCablePathsInfo.Active := false; FmtCablePathsInfo.Active := true; Paths := TObjectList.Create(true); SideEndPaths := TObjectList.Create(false); SidePathsInfo := TObjectList.Create(false); for i := 0 to FComponent.Interfaces.Count - 1 do begin Interf := FComponent.Interfaces[i]; if (Interf.TypeI = itFunctional) and Not CheckInterfInPaths(Interf) then begin Path := Interf.GetInterfPath(1, Interf.Kolvo); if Path.ChildReferences.Count < Path.PathSide.ChildReferences.Count then Path := Path.PathSide; if ShowInterfPaths(Path) then Paths.Add(Path); end; end; FreeAndNil(SideEndPaths); FreeAndNil(SidePathsInfo); FreeAndNil(Paths); //Params := TReportItemParams.Create(fmRCablePaths, rtCablePaths, rkProject); GFormMode := fmRCablePaths; ShowPreparedReport(AParams); //ShowWizard([rkCablePath], true); //FreeAndNil(Params); end; except on E: Exception do AddExceptionToLogExt(ClassName, 'ShowCablePaths', 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; 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 : 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; Begin 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]; 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 SCSObject := SCSComponent.GetFirstParentCatalog; // верхний объект компонента(каталог) будет иметь отображение на Каде WAList := GetListByID(SCSObject.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,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]; // Y - координата MemTable_WACoordinates.FieldByName('Z').AsString := FormatFloat('0.00',MetreToUOM(Coordinata)); end; end; end; end; end; // если стоим на проекте 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]; 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]; // Y - координата 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; End; procedure TF_ResourceReport.ShowCablePathsWizard(ACable: TSCSComponent); begin //GFormMode := fmRCablePaths; //ShowPreparedReport(AParams); FComponent := ACable; FCatalog := ACable.GetFirstParentCatalog; ShowWizard([rkCablePath], 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.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 Val := DateToStr(Date)+' '+cResourceReport_Msg24 +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 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 Val := TSCSProject(SCSProjCatalog).Setting.CustomerName; { 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 Val := TSCSProject(SCSProjCatalog).Setting.ContractorName; 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 := ''; 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 Val := cRepMsg05 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 Val := ReelsCableFlow.Text else if p1 = 'CABLEREZERV' then Val := cRepMsg229 else if p1 = 'WACOORDINATES' then Val := cRepMsg238 else if p1 = 'PATH' then Val := cRepMsg230 else if p1 = 'THEN' then Val := cRepMsg206 else if p1 = 'PARTCABLELENGTH' then Val := cRepMsg237 else if p1 = 'PRIORCOSTOFPROJECT' then Val := cRepMsg192 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; 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; 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 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; 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; 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; 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; 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; begin ActualColumn := TFlyTreeViewPro(Sender).GetColumnOrder(TFlyTreeViewPro(Sender).Col); WasChanged := true; if ActualColumn = rciIsOn then begin if TReportItemParams(Node.Data).Mode = fmRDefectAct then begin WasChanged := false; S := bsFalse; end; if WasChanged then Timer_DefineReportNodeControls.Enabled := true; 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; Sleep(500); 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); 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); 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 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 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; end.