unit U_SmetaExport; interface uses Classes, Dialogs, Windows, SysUtils, Controls, Forms, U_BaseCommon, U_BaseConstants, U_SCSComponent, U_IBDUP, RzButton, U_Common_Classes, StdCtrls, Mask, RzEdit, ExtCtrls, RzPanel, siComp, siLngLnk, RzRadChk; const T1TAG = 'T1'; T1TAGR = 'Т1'; T2TAG = 'T2'; T2TAGR = 'Т2'; T3TAG = 'T3'; T3TAGR = 'Т3'; T4TAG = 'T4'; T4TAGR = 'Т4'; T5TAG = 'T5'; T5TAGR = 'Т5'; T6TAG = 'T6'; T6TAGR = 'Т6'; T7TAG = 'T7'; T7TAGR = 'Т7'; T8TAG = 'T8'; T8TAGR = 'Т8'; T9TAG = 'T9'; T9TAGR = 'Т9'; T10TAG = 'T10'; T10TAGR = 'Т10'; HK1TAG = 'HK1'; HK1TAGR = 'НК1'; HK2TAG = 'HK2'; HK2TAGR = 'НК2'; TAG1 = '1'; TAG2 = '2'; TAG3 = '3'; TAG4 = '4'; TAG5 = '5'; TAG6 = '6'; TAG7 = '7'; TAG8 = '8'; TAG9 = '9'; ETAG = 'E'; ETAGR = 'Е'; MTAG = 'M'; MTAGR = 'М'; TTAG = 'T'; TTAGR = 'Т'; PTAG = 'P'; PTAGR = 'Р'; PPTAG = 'П'; VTAG = 'B'; VTAGR = 'В'; GTAG = 'Ж'; SHTAG = 'Ш'; KTAG = 'K'; KTAGR = 'К'; K5TAG = 'K5'; K5TAGR = 'К5'; CTAG = 'C'; CTAGR = 'С'; C1TAG = 'C1'; C1TAGR = 'С1'; C2TAG = 'C2'; C2TAGR = 'С2'; C3TAG = 'C3'; C3TAGR = 'С3'; C311TAG = 'C311'; C311TAGR = 'С311'; C331TAG = 'C331'; C331TAGR = 'С331'; ATAG = 'A'; ATAGR = 'А'; BTAG = 'Б'; ZTAG = 'Z'; RTAG = 'R'; YTAG = 'Y'; HTAG = 'H'; HTAGR = 'Н'; S1TAG = 'S1'; S2TAG = 'S2'; S10TAG = 'S10'; LS1TAG = 'LS1'; OS1TAG = 'OS1'; OS2TAG = 'OS2'; KIBDTAG = 'КИБД'; LSATAG = 'LSA'; LS2TAG = 'LS2'; LS4TAG = 'LS4'; LS6TAG = 'LS6'; LS8TAG = 'LS8'; LSBTAG = 'LSB'; LS3TAG = 'LS3'; LS5TAG = 'LS5'; LS7TAG = 'LS7'; LS9TAG = 'LS9'; SBlockCount = 11; STypes: array[1..SBlockCount] of integer = (1,2,14,3,4,5,6,7,8,9,10); //Порядок блоков SIndexes: array[1..14] of integer = (1,2,4,5,6,7,8,9,10,11,0,0,0,3); // порядковый индекс блока по его номеру FloatPrecIBD = FloatPrecision; IsImmediateSmetaPrice = True; IsUsePosVariants = True; // Использовать ли позицию варианта, если нет, //то будет браться максимальная стоимость из всех одинаковых шифров type TIBD = class; TSmetaExport = class; TSmetaExportClass = class of TSmetaExport; TF_SmetaExport = class(TForm) RzPanel1: TRzPanel; pnOkCancel: TRzPanel; btOk: TRzBitBtn; btCancel: TRzBitBtn; lng_Forms: TsiLangLinked; cbCanHaveActiveComponents: TRzCheckBox; cbCanHaveDismountAccount: TRzCheckBox; cbCanResources: TRzCheckBox; cbCanHaveZeroPriceComponents: TRzCheckBox; cbShowLists: TRzCheckBox; cbShowRooms: TRzCheckBox; cbCanComponents: TRzCheckBox; procedure pnOkCancelResize(Sender: TObject); procedure FormCreate(Sender: TObject); private FSrcHeight: Integer; public function Execute(AExportObj: TSmetaExport): Boolean; end; TSmetaExport = class(TObject) protected FProject: TSCSProject; FCountryCurrency: TNBCurrency; FFileName: string; FData: TStringList; FCanHaveActiveComponents: Boolean; FCanHaveDismountAccount: Boolean; FCanResources: Boolean; FCanComponents: Boolean; FCanHaveZeroPriceComponents: Boolean; FShowLists: Boolean; FShowRooms: Boolean; protected function GetCatalogAllNormsResources(ACatalog: TSCSCatalog): TSCSNormsResources; public constructor Create; virtual; destructor Destroy; override; function Save: Boolean; virtual; procedure Init(const FileName: string; AProject: TSCSProject); virtual; end; TResInfo = record RType, VarNum: integer; Shifr: String; Name_r: String; // Название ресурса Izm_r: String; // Единица измерения Kolvo, Stoim, Vsego: double; PosVariant: Integer; IsResource: Boolean; end; TS1Fields = record S1_STROIKARegistrNO: integer; end; TS2Fields = record S2_STROIKANameFull: string; S2_UtvergdOrg: string; S2_STROIKAProjectShifr: string; S2_TipStroiki: integer; S2_STROIKADirector_p: string; S2_STROIKAGlavEngineer: string; S2_STROIKAOtdel: string; S2_STROIKANachOtdela: string; S2_STROIKASostavil: string; S2_STROIKAProveril: string; S2_SPRAVData: array[1..13] of real; S2_STROIKADistance: real; end; PS9Record = ^TS9Record; TS9Record = record S9_OSGlava: integer; S9_OSNoOsNum: integer; S9_OSNoOs: string; S9_OSName: string; S9_StoitelObem: real; S9_IzmStroitObem: string; S9_Comment: string; end; PS10Record = ^TS10Record; TS10Record = record S10_OSGlava: integer; S10_OSNoOsNum: integer; S10_LSNoLsNum: integer; S10_LSNoLs: string; S10_LSName: string; S10_StoitelObem: real; S10_IzmStroitObem: string; S10_LSChertezh: string; S10_LSSostavil: String; S10_LSProveril: string; end; TIBDLog = class(TStringList) private public FFileName: string; procedure AddToLog(LogString: String); constructor Create(FileName: String); destructor Destroy; override; end; TSBlock = class(TObject) private SBlock: TStringList; SFieldsList: TList; public HEADER_LNG: integer; HEADER_PRGNAME: string; published end; THeader = class(TSBlock) private function SetHeaderFields: Boolean; public HEADER_SHIFR: string; HEADER_PRGNAME: string; HEADER_CREATIONDATE: TDateTime; HEADER_IBDPRIZNAK: integer; constructor Create; destructor Destroy; override; end; TSAll = class(TSBlock) private AS9Record: PS9Record; AS10Record: PS10Record; SType: integer; FFirstRec: Boolean; S_Records: TList; function SetSFields1: Boolean; function SetSFields2: Boolean; function SetSFields3: Boolean; function SetSFields4: Boolean; function SetSFields5: Boolean; function SetSFields6: Boolean; function SetSFields7: Boolean; function SetSFields8: Boolean; function SetSFields8_IBD2: Boolean; function SetSFields9: Boolean; function SetSFields10: Boolean; function SetSFields14: Boolean; protected FIBD: TIBD; function SaveToIBD: Boolean; public S1_Fields: TS1Fields; S2_Fields: TS2Fields; constructor Create(BlockType: integer); destructor Destroy; override; end; TLastRec = class(TSBlock) private function SetLastRecFields(i: integer): Boolean; public constructor Create; destructor Destroy; override; end; TIBD = class(TSmetaExport) private //FFileName: string; //IBDData: TStringList; public Header: THeader; SAll: array[1..SBlockCount] of TSAll; LastRec: TLastRec; InitSuccess: boolean; NumberPos: integer; constructor Create; override; destructor Destroy; override; function Save: Boolean; override; procedure Init(const FileName: string; AProject: TSCSProject); override; end; TARPS = class(TSmetaExport) private FNormNpp: Integer; protected FRowData: TStringList; FPrecision: Integer; procedure ClearRowData; procedure SaveArticle(ALevel, ANum: Integer; const aArticleName: String); function SaveNormsFromCatalog(ACatalog: TSCSCatalog; ALevel, aArticleNum: Integer; const aArticleName: String): Boolean; procedure SaveRowData(const ADataType: String); public constructor Create; override; destructor Destroy; override; function Save: Boolean; override; procedure Init(const FileName: string; AProject: TSCSProject); override; end; //****************************************************************************** // Дополнительные функции //****************************************************************************** function MakeCorrectName(S: string): string; procedure SetBlock(Source: TStringList; var Destination: TStringList); procedure InsertCarret(var TempString: string); procedure SaveWithCorrectSizeAndPack(AIBD: TStringList; AFileName: string); //****************************************************************************** function ShowSmetaExportParams(AExportObj: TSmetaExport): Boolean; procedure SaveProjectToIBD(AProject: TSCSProject); procedure SaveProjectToSmeta(AProject: TSCSProject); var F_SmetaExport: TF_SmetaExport; Vedomost: array of TResInfo; MaxVedIdx: Integer; CurrDate: TDate; implementation uses USCS_Main, U_ESCadClasess, U_Common, U_ProtectionCommon, U_Main; {$R *.dfm} var IBDLog: TIBDLog; IBD: TIBD; IBDShifr: string; function ShowSmetaExportParams(AExportObj: TSmetaExport): Boolean; begin Result := false; if F_SmetaExport = nil then F_SmetaExport := TF_SmetaExport.Create(Application); Result := F_SmetaExport.Execute(AExportObj); end; procedure SaveProjectToIBD(AProject: TSCSProject); var IBDSaveDialog: TSaveDialog; begin if Not AProject.Active then //05.01.2012 if GetCurrProjectName = '' then begin MessageModal('Откройте необходимый проект и попробуйте снова.', 'Внимание!', MB_ICONINFORMATION); exit; end; IBDSaveDialog := TSaveDialog.Create(IBDSaveDialog); IBDSaveDialog.InitialDir := ExtractSaveDir; IBDSaveDialog.Title := 'Сохранение файла ИБД'; IBDSaveDialog.FileName := FileNameCorrect(AProject.Name); //05.01.2012 FileNameCorrect(GetCurrProjectName); IBDSaveDialog.Filter := 'Файлы инвесторского ИБД (*.bds)|*.bds'; IBDSaveDialog.DefaultExt := '*.bds'; IBDSaveDialog.Options := [ofNoChangeDir,ofHideReadOnly,ofPathMustExist,ofOverwritePrompt]; if not IBDSaveDialog.Execute then begin Exit; end; BeginProgress('Запись проекта в ИБД...'); try IBD := TIBD.Create; IBD.Init(IBDSaveDialog.FileName, AProject); if not IBD.Save then begin EndProgress; MessageModal('Ошибка записи проекта!', 'Внимание!', MB_ICONWARNING); end else begin EndProgress; MessageModal('Проект успешно сохранен!', 'Внимание!', MB_ICONINFORMATION); end; except EndProgress; MessageModal('Ошибка записи проекта!', 'Внимание!', MB_ICONWARNING); end; if Assigned(IBD) then FreeAndNil(IBD); end; procedure SaveProjectToSmeta(AProject: TSCSProject); var SaveDialog: TSaveDialog; ProcessMsg: String; SmetaExportClass: TSmetaExportClass; SmetaExport: TSmetaExport; begin if Not AProject.Active then //05.01.2012 if GetCurrProjectName = '' then begin MessageModal(cSmeta_Msg01, cWarningSlowCap, MB_ICONINFORMATION); exit; end; SaveDialog := TSaveDialog.Create(nil); SaveDialog.InitialDir := ExtractSaveDir; SaveDialog.Title := cSmeta_Msg02; // Сохранение файла в сметную программу SaveDialog.FileName := FileNameCorrect(AProject.Name); {$IF Defined(SCS_RF)} SaveDialog.Filter := cSmeta_Msg03_02_DialogFilter +'|'+ cSmeta_Msg03_01_DialogFilter; //'Файлы инвесторского ИБД (*.bds)|*.bds'; SaveDialog.DefaultExt := '*.arp'; {$ELSE} SaveDialog.Filter := cSmeta_Msg03_01_DialogFilter +'|'+ cSmeta_Msg03_02_DialogFilter; //'Файлы инвесторского ИБД (*.bds)|*.bds'; SaveDialog.DefaultExt := '*.bds'; {$IFEND} SaveDialog.Options := [ofNoChangeDir,ofHideReadOnly,ofPathMustExist,ofOverwritePrompt]; if SaveDialog.Execute then begin ProcessMsg := ''; SmetaExportClass := nil; if ExtractFileExt(SaveDialog.FileName) = '.bds' then begin ProcessMsg := cSmeta_Msg04; SmetaExportClass := TIBD; end else if ExtractFileExt(SaveDialog.FileName) = '.arp' then begin ProcessMsg := cSmeta_Msg05; SmetaExportClass := TARPS; end; if SmetaExportClass <> nil then begin SmetaExport := SmetaExportClass.Create; SmetaExport.Init(SaveDialog.FileName, AProject); if ShowSmetaExportParams(SmetaExport) then begin BeginProgress(ProcessMsg); try if not SmetaExport.Save then begin Application.ProcessMessages; EndProgress; Application.ProcessMessages; MessageModal(cSmeta_Msg06, cWarningSlowCap, MB_ICONWARNING); end else begin Application.ProcessMessages; EndProgress; Application.ProcessMessages; MessageModal(cSmeta_Msg07, cWarningSlowCap, MB_ICONINFORMATION); end; except on E: Exception do begin Application.ProcessMessages; EndProgress; Application.ProcessMessages; MessageModal(cSmeta_Msg06, cWarningSlowCap, MB_ICONWARNING); AddExceptionToLogEx('', E.Message); end; end; end; if Assigned(SmetaExport) then FreeAndNil(SmetaExport); end; end; FreeAndNil(SaveDialog); end; //****************************************************************************** { TSmetaExport } constructor TSmetaExport.Create; begin inherited; FData := TStringList.Create; FCanHaveActiveComponents := true; FCanHaveDismountAccount := true; FCanResources := true; FCanComponents := true; FCanHaveZeroPriceComponents := false; FShowLists := true; FShowRooms := false; end; destructor TSmetaExport.Destroy; begin if Assigned(FData) then FreeAndNil(FData); inherited; end; procedure TSmetaExport.Init(const FileName: string; AProject: TSCSProject); begin FFileName := FileName; FProject := AProject; FCountryCurrency := FProject.Spravochnik.GetCurrencyCountry; end; function TSmetaExport.Save: Boolean; begin end; function TSmetaExport.GetCatalogAllNormsResources(ACatalog: TSCSCatalog): TSCSNormsResources; var NormResourcesKinds: TNormResourcesKinds; begin NormResourcesKinds := [nrAll]; if Not FCanResources or Not FCanComponents then begin NormResourcesKinds := [nrNorms]; if FCanResources then NormResourcesKinds := NormResourcesKinds + [nrResources, nrAccessories]; if FCanComponents then NormResourcesKinds := NormResourcesKinds + [nrComponents]; end; Result := ACatalog.GetAllNormsResources(NormResourcesKinds, true, FCanHaveActiveComponents, FCanHaveDismountAccount, FCanHaveZeroPriceComponents); end; { TIBD } constructor TIBD.Create; var i: integer; LogDir: String; begin inherited; LogDir := ExeDir + '\' + dnLog; IBDLog := TIBDLog.Create(LogDir + '\IBD.Log'); //05.01.2012 IBDData := TStringList.Create; Header := THeader.Create; for i := 1 to 11 do begin SAll[i] := TSAll.Create(STypes[i]); SAll[i].FIBD := Self; end; LastRec := TLastRec.Create; end; destructor TIBD.Destroy; var i: integer; begin inherited; //if Assigned(IBDData) then // FreeAndNil(IBDData); if Assigned(Header) then FreeAndNil(Header); for i := 1 to SBlockCount do begin if Assigned(SAll[i]) then FreeAndNil(SAll[i]); end; if Assigned(LastRec) then FreeAndNil(LastRec); if Assigned(IBDLog) then FreeAndNil(IBDLog); end; procedure TIBD.Init(const FileName: string; AProject: TSCSProject); var i: integer; begin inherited ; //FFileName := FileName; //Header.HEADER_SHIFR := 'ИБД_2004_2'; Header.HEADER_SHIFR := 'ИБД_2'; IBDLog.AddToLog('Begin - ' + DateTimeToStr(Now)); IBDLog.AddToLog('Initialization IBD for save - success'); Header.HEADER_IBDPRIZNAK := 1; //'.bds' // Header.HEADER_IBDPRIZNAK := 2; - '.bdd' CurrDate := Now; end; //****************************************************************************** function TIBD.Save: Boolean; var i: integer; begin ProcessMessagesEx; result := True; if not Header.SetHeaderFields then begin IBDLog.AddToLog('!!!!!!!!!! Ошибка формирования заголовка!!!'); result := false; exit; end; ProcessMessagesEx; for i := 1 to 6 do begin IBDLog.AddToLog('~~~Processing S' + IntToStr(i)); ProcessMessagesEx; if not SAll[SIndexes[i]].SaveToIBD then begin result := false; exit; end; end; for i := 9 to 10 do begin IBDLog.AddToLog('~~~Processing S' + IntToStr(i)); ProcessMessagesEx; if not SAll[SIndexes[i]].SaveToIBD then begin result := false; exit; end; end; IBDLog.AddToLog('~~~Processing S' + IntToStr(i)); ProcessMessagesEx; if not SAll[SIndexes[14]].SaveToIBD then begin result := false; exit; end; IBDLog.AddToLog('~~~Processing S' + IntToStr(8)); ProcessMessagesEx; if not SAll[SIndexes[8]].SaveToIBD then begin result := false; exit; end; IBDLog.AddToLog('~~~Processing S' + IntToStr(7)); ProcessMessagesEx; if not SAll[SIndexes[7]].SaveToIBD then begin result := false; exit; end; ProcessMessagesEx; //если подготовка блоков прошла успешно - пытаемся писать if Result then begin IBDLog.AddToLog('~~~~Moving Header to IBDData'); SetBlock(Header.SBlock, FData); ProcessMessagesEx; for i := 1 to SBlockCount do begin IBDLog.AddToLog('~~~~Moving S' + IntToStr(STypes[i]) + ' to IBDData'); SetBlock(SAll[i].SBlock, FData); ProcessMessagesEx; end; try if not LastRec.SetLastRecFields(length(FData.Text)) then begin IBDLog.AddToLog('!!!!!!!!!! Ошибка формирования КИБД!!!'); result := false; exit; end; ProcessMessagesEx; except end; IBDLog.AddToLog('~~~~Moving LastRec to IBDData'); SetBlock(LastRec.SBlock, FData); ProcessMessagesEx; //IBDData.SaveToFile(FFileName); SaveWithCorrectSizeAndPack(FData, FFileName); FData.SaveToFile(FFileName+'_'); ProcessMessagesEx; IBDLog.AddToLog('End - ' + DateTimeToStr(Now)); Sleep(1000); end; end; //****************************************************************************** { THeader } constructor THeader.Create; begin SBlock := TStringList.Create; SFieldsList := TList.Create; end; destructor THeader.Destroy; var i: integer; begin SBlock.Free; for i := 0 to SFieldsList.Count - 1 do TStringList(SFieldsList.Items[i]).Free; SFieldsList.Free; inherited; end; function THeader.SetHeaderFields: Boolean; var temp: string; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; { if ukrver then HEADER_LNG := 0 else } HEADER_LNG := 1; temp := IntToStr(HEADER_LNG); IBDShifr := HEADER_SHIFR; temp := temp + '`' + HEADER_SHIFR; {$IF Defined(TRIAL_SCS)} HEADER_PRGNAME := ApplicationName + ' (версия ' + versionEXE + ' от ' + DateEXE + ' Trial)'; {$ELSE} HEADER_PRGNAME := ApplicationName + ' (версия ' + versionEXE + ' от ' + DateEXE + ')'; {$IFEND} HEADER_PRGNAME := MakeCorrectName(HEADER_PRGNAME); temp := temp + '`' + HEADER_PRGNAME; HEADER_CREATIONDATE := Now; temp := temp + '`' + DateToStr(HEADER_CREATIONDATE); try temp := temp + '`' + inttostr(HEADER_IBDPRIZNAK); except temp := temp + '`1'; end; temp := temp + '*'; SBlock.Add(temp); result := true; except IBDLog.AddToLog('!!!!!!!!!! Ошибка обработки Header'); result := false; end; end; //****************************************************************************** {TSAll} //****************************************************************************** constructor TSAll.Create(BlockType: integer); begin SBlock := TStringList.Create; SFieldsList := TList.Create; SType := BlockType; S_Records := TList.Create; end; destructor TSAll.Destroy; var i: integer; TempSRecord: Pointer; begin SBlock.Free; for i := 0 to SFieldsList.Count - 1 do TStringList(SFieldsList.Items[i]).Free; SFieldsList.Free; for i := 0 to S_Records.Count - 1 do begin TempSRecord := S_Records.Items[i]; Dispose(TempSRecord); end; S_Records.Free; inherited; end; //****************************************************************************** function TSAll.SaveToIBD: Boolean; begin result := false; case SType of 1: begin if SetSFields1 then begin IBDLog.AddToLog('~~~~S1 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 2: begin if SetSFields2 then begin IBDLog.AddToLog('~~~~S2 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 3: begin if SetSFields3 then begin IBDLog.AddToLog('~~~~S3 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 4: begin if SetSFields4 then begin IBDLog.AddToLog('~~~~S4 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 5: begin if SetSFields5 then begin IBDLog.AddToLog('~~~~S5 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 6: begin if SetSFields6 then begin IBDLog.AddToLog('~~~~S6 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 7: begin if SetSFields7 then begin IBDLog.AddToLog('~~~~S7 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 8: begin if SetSFields8_IBD2 then begin IBDLog.AddToLog('~~~~S8 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 9: begin if SetSFields9 then begin IBDLog.AddToLog('~~~~S9 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 10: begin if SetSFields10 then begin IBDLog.AddToLog('~~~~S10 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; 14: begin if SetSFields14 then begin IBDLog.AddToLog('~~~~S14 - Сформирован успешно'); result := true; end else IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка формирования блока'); end; end; end; //****************************************************************************** function TSAll.SetSFields1: Boolean; var temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S1'; try temp := temp + '`' + IntToStr(FIBD.FProject.MarkID); //05.01.2012 IntToStr(F_ProjMan.GSCSBase.CurrProject.MarkID); except // если не сложилось преобразовать, а надо что-то передать temp := temp + '`' + '123'; end; // по формату ИБД - [S1`< регистрационный номер ( целое, 9 )>*], поэтому temp := temp + '*'; SBlock.Add(temp); ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S1'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields2: Boolean; var i: integer; temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; //1-11 temp := 'S2'; if FIBD.FProject.Name <> '' then temp := temp + '`' + MakeCorrectName(FIBD.FProject.Name) else temp := temp + '`' + MakeCorrectName(FIBD.FProject.GetParams.Caption); temp := temp + '`'; try temp := temp + '`' + MakeCorrectName(FIBD.FProject.Name) + ' ' + IntToStr(FIBD.FProject.MarkID); except // если не сложилось преобразовать, а надо что-то передать temp := temp + '`' + '123'; end; temp := temp + '`0'; //тип стройки 0-СМР, 1-ПН, 2-Минпром temp := temp + '`';//MakeCorrectName(dm.STROIKADirector_p.Value); temp := temp + '`';//MakeCorrectName(dm.STROIKAGlavEngineer.Value); temp := temp + '`';//MakeCorrectName(dm.STROIKAOtdel.Value); temp := temp + '`';//MakeCorrectName(dm.STROIKANachOtdela.Value); temp := temp + '`';//MakeCorrectName(dm.STROIKASostavil.Value); temp := temp + '`';//MakeCorrectName(dm.STROIKAProveril.Value); { [<цена бензина, грн./кг ( число )>]` [<цена дизельного топлива, грн./кг ( число )>]` [<цена электроэнергии, грн./кВт.ч ( число )>]` [<цена сжатого воздуха, грн./м3 ( число )>]` [<цена смазочных материалов, грн./кг ( число )>]` [<цена гидравлической жидкости, грн./кг ( число )>]` [<цена мазута, грн./кг ( число )>]` [<цена смеси керосина и моторного топлива, грн./кг ( число )>]` [<цена дров, грн./м3 ( число )>]` [<цена сжатого газа, грн./м3 ( число )>]` [<цена сжиженного газа, грн./л ( число )>]` [<цена охлаждающей жидкости ( тосол ), грн./кг ( число )>]` [<цена охлаждающей жидкости ( вода ), грн./м3 ( число )>]` [<среднее расстояние перевозки строительных грузов, км ( число )>]* } for i := 1 to 14 do begin temp := temp + '`'; end; temp := temp + '30'; //[<среднее расстояние перевозки строительных грузов, км ( число )>] temp := temp + '*'; SBlock.Add(temp); ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S2'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields3: Boolean; var temp: string; IntShifr: integer; f: double; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S3'; temp := temp + '*'; SBlock.Add(temp); // пока пропускаем инф. о тариф сетках ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S3'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields4: Boolean; var temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S4'; temp := temp + '*'; SBlock.Add(temp); ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S4'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields5: Boolean; var temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S5'; temp := temp + '*'; SBlock.Add(temp); // пока пропускаем ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S5'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields6: Boolean; var temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S6'; temp := temp + '*'; SBlock.Add(temp); // пока пропускаем ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S6'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields7: Boolean; var temp: string; i: Integer; LookedShifr: TStringList; procedure WriteMatToS7(ri: TResInfo); var temp: string; i: integer; //ri: TResInfo; MassaInTonna: Double; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := AnsiUpperCase(ri.Shifr); // SMETAONLY //if (not {F_NormBase.} JumpToResShifr(temp, ri)) // and (not {F_NormBase.} JumpToPriceShifr(temp, ri)) then //begin // IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка - не найден ресурс ' + temp); // exit; //end; // FROMSMETA //// если Opr - пустой, а писать чё-то надо //ri.Opr := '33'; //if ri.Opr <> '' then // temp := temp + '`' + ri.Opr //else //begin // i := _F_Stroika.GetOprFromShifr(ri.Shifr); // if i > 0 then // temp := temp + '`' + inttostr(i) // else // temp := temp + '`1'; //end; //*** орr вида работ temp := temp + '`' + '33'; // FROMSMETA if GetOldKodTransport(ri.mat.KodTransport) <> '' then //begin // temp := temp + '`' + GetOldKodTransport(ri.mat.KodTransport); //end //else //begin // if (ri.Mat.Massa <= 0.15) then // temp := temp + '`Л21' // else // temp := temp + '`Л44'; //end; //*** Масса оборудования в тоннах - нужна для установки вида транспорта MassaInTonna := 0; if (MassaInTonna <= 0.15) then temp := temp + '`Л21' else temp := temp + '`Л44'; // FROMSMETA if UkrVer then //begin // temp := temp + '`' + MakeCorrectName(ri.Name_u); // if ri.Izm_u <> '' then // begin // temp := temp + '`' + MakeCorrectName(ri.Izm_u); // end // else // begin // temp := temp + '`' + 'без вим.'; // end; //end //else //begin // temp := temp + '`' + MakeCorrectName(ri.Name_r); // if ri.Izm_r <> '' then // begin // temp := temp + '`' + MakeCorrectName(ri.Izm_r); // end // else // begin // temp := temp + '`' + 'без изм.'; // end; //end; //*** Наименование оборудования temp := temp + '`' + MakeCorrectName(ri.Name_r); //*** Ед изм if ri.Izm_r <> '' then begin temp := temp + '`' + MakeCorrectName(ri.Izm_r); end else begin temp := temp + '`' + 'без изм.'; end; // FROMSMETA try // temp := temp + '`' + FormatFloat('0.########', ri.mat.massa) + '`'; //floattostr(ri.mat.massa) + '`'; //except // temp := temp + '`' + '`'; //end; //*** Масса оборудования try temp := temp + '`' + FormatFloat('0.########', MassaInTonna) + '`'; //floattostr(ri.mat.massa) + '`'; except temp := temp + '`' + '`'; end; temp := temp + '*'; // заменяем перевед строки на # InsertCarret(temp); SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S7 - ' + ri.Shifr); end; end; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S7'; temp := temp + '*'; SBlock.Add(temp); LookedShifr := TStringList.Create; for i := 0 to High(Vedomost) do if Not Vedomost[i].IsResource then if Vedomost[i].Shifr <> '' then begin if LookedShifr.IndexOf(AnsiUpperCase(Vedomost[i].Shifr)) = -1 then begin WriteMatToS7(Vedomost[i]); LookedShifr.Add(AnsiUpperCase(Vedomost[i].Shifr)); end; end; result := true; FreeAndNil(LookedShifr); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S7'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields8: Boolean; var temp: string; i, j: integer; // C17Warning: boolean; // DoubleResWarning, DoublePerevozWarning: boolean; procedure WriteMS(Idx: integer); begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'MS`' + Vedomost[Idx].Shifr; // temp := temp + '`' + IntToStr(Vedomost[Idx].VarNum); // temp := temp + '`' + Vedomost[Idx].Name_r; try temp := temp + '`' + FormatFloat('0.########', Vedomost[Idx].Kolvo); except temp := temp + '`'; end; temp := temp + '`'; //Дата формирования цены temp := temp + '`'; // Обоснование temp := temp + '`0'; //TzMach temp := temp + '`0'; //TzRemont temp := temp + '`0'; //TzRebase temp := temp + '`0#1'; // ср. разряд и тариф сетка temp := temp + '`0'; //Amort temp := temp + '`0'; //Zamena temp := temp + '`0'; ////энергоносители и гидравлическая жидкость temp := temp + '`0'; //Smazka temp := temp + '`0'; //NetRemont temp := temp + '`0'; //NetRebase temp := temp + '`0'; //прочие затраты try temp := temp + '`' + FloatToStrU(RoundX(Vedomost[Idx].Stoim, FloatPrecIBD)); except temp := temp + '`'; end; // temp := temp + '#0'; //затрат заказчика - 0 temp := temp + '`1'; //непосредственно задана сметная цена temp := temp + '*'; SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + Vedomost[Idx].Shifr); end; end; //=========================== procedure WriteBR(Idx: integer); begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'BR`' + Vedomost[Idx].Shifr; // temp := temp + '`' + IntToStr(Vedomost[Idx].VarNum); // temp := temp + '`' + Vedomost[Idx].Name_r; try temp := temp + '`' + FormatFloat('0.########', Vedomost[Idx].Kolvo); except temp := temp + '`'; end; temp := temp + '`'; //Дата формирования цены temp := temp + '`'; // Обоснование try temp := temp + '`' + FloatToStrU(RoundX(Vedomost[Idx].Stoim, FloatPrecIBD)); except temp := temp + '`'; end; // temp := temp + '#0'; //затрат заказчика - 0 temp := temp + '*'; SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + Vedomost[Idx].Shifr); end; end; //=========================== //=========================== procedure WriteMT(Idx: integer); var i: integer; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'MT`'+ Vedomost[Idx].Shifr; // temp := temp + '`' + IntToStr(Vedomost[Idx].VarNum); // temp := temp + '`' + Vedomost[Idx].Name_r; temp := temp + '`0'; //признак возвращаемого материала (0 - нет; 1- да) try temp := temp + '`' + FormatFloat('0.########', Vedomost[Idx].Kolvo); except temp := temp + '`'; end; temp := temp + '`'; //Дата формирования цены temp := temp + '`'; // Обоснование // OtpPrice try temp := temp + '`' + FloatToStrU(RoundX(Vedomost[Idx].Stoim, FloatPrecIBD)); except temp := temp + '`'; end; temp := temp + '`Т1=0'; // Transport temp := temp + '`0'; // Sklad try temp := temp + '`' + FloatToStrU(RoundX(Vedomost[Idx].Stoim, FloatPrecIBD)); except temp := temp + '`'; end; temp := temp + '#0'; //затрат заказчика - 0 temp := temp + '`1'; //непосредственно задана сметная цена temp := temp + '*'; SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + Vedomost[Idx].Shifr); end; end; //=========================== begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S8'; temp := temp + '*'; SBlock.Add(temp); for i := 0 to High(Vedomost) do begin case Vedomost[i].RType of //Строительные машины и механизмы (MS) rtMachMech: begin WriteMS(i); end; //Строительные материалы, изделия и конструкции (MT) rtMat: begin WriteMT(i); end; //Оборудование (BR) rtPrice: begin WriteBR(i); end; end; end; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8'); result := false; end; end; function TSAll.SetSFields8_IBD2: Boolean; var temp: string; i, j: integer; procedure WriteMS_IBD2(ri: TResInfo); var i: integer; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'MS`' + ri.Shifr; //dm.VEDOMOSTShifr.Value; try if ri.PosVariant > 0 then temp := temp + '`' + IntToStr(ri.PosVariant) else temp := temp + '`'; except temp := temp + '`'; end; temp := temp + '`' + MakeCorrectName(ri.Name_r); try temp := temp + '`' + FormatFloat('0.########', ri.Kolvo);//floattostr(ri.Kolvo1); //dm.VEDOMOSTKolvo.Value); except temp := temp + '`'; end; try ShortDateFormat := 'dd.mm.yy'; temp := temp + '`' + DateToStr(CurrDate); except temp := temp + '`'; end; temp := temp + '`';// Обоснование //*** <затраты труда машинистов, чел.-ч (число,n, 2)> //try // temp := temp + '`' + floattostr(Round2(ri.Mach.TzMach)); //dm.VEDOMOSTTzMach.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** <затраты труда на ремонт и техобслуживание, чел.-ч (число,n,2)> //try // temp := temp + '`' + floattostr(Round2(ri.Mach.TzRemont)); //dm.VEDOMOSTTzRemont.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** <затраты труда на перебазировку, чел.-ч (число,n,2)> //try // temp := temp + '`' + floattostr(Round2(ri.Mach.TzRebase)); //dm.VEDOMOSTTzRebase.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** {<тарифная ставка рабочих, занятых обслуживанием машин, грн. (число, n,2)>| // ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ ХЗ //*** |<средний разряд работ рабочих, занятых обслуживанием машин, (число,n,1) > //try //// средний разряд работ рабочих, занятых обслуживанием машин, (число,n,1) //// округлять до 1-го знака не получается - СТС передаёт тарифную ставку и //// приходится вычислять разряд, причём он не всегда округляется до десятых // temp := temp + '`' + floattostr(Round2(ri.Mach.SrRazrad)); //dm.VEDOMOSTSrRazrad.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** #<номер тарифной сетки (число,n) >} //try // temp := temp + '#' + IntToStr(Main_SetkaDef); //#. номер тарифной сетки //except // temp := temp + '#1'; //end; temp := temp + '#1'; //*** [< амортизационные отчисления, грн. (число,n,2) >] //try // temp := temp + '`' + floattostr(Round2(ri.Mach.Amort)); //dm.VEDOMOSTAmort.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** [< быстроизнашивающиеся части, грн. (число,n,2) >]` //try // temp := temp + '`' + floattostr(Round2(ri.Mach.Zamena)); //dm.VEDOMOSTZamena.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** {[ < энергоносители и гидравлическая жидкость, грн. (число,n,2) >] //try // temp := temp + '`' + FloatToStr(Round2(ri.Mach.GSM.Benzin)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Benzin)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Dizel)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Dizel)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Energy)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Energy)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Hydro)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Hydro)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Mazut)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Mazut)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Smes)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Smes)); // temp := temp + '#' + FloatToStr(Round2(ri.Mach.GSM.Drova)) + '$' + FloatToStr(Round2(ri.Mach.GSMPrices.Drova)); // // газа и охлаждающих жидкостей у нас нет!!! // temp := temp + '#0$0'; // temp := temp + '#0$0'; // temp := temp + '#0$0'; // temp := temp + '#0$0'; //except // temp := temp + '`'; //end; temp := temp + '`' + '0$0'; // Benzin temp := temp + '#0$0'; // Dizel temp := temp + '#0$0'; // Energy temp := temp + '#0$0'; // Hydro temp := temp + '#0$0'; // Mazut temp := temp + '#0$0'; // Smes temp := temp + '#0$0'; // Drova // газа и охлаждающих жидкостей у нас нет!!! temp := temp + '#0$0'; temp := temp + '#0$0'; temp := temp + '#0$0'; temp := temp + '#0$0'; //temp := temp + '`'; //**************************************** //*** {[ < смазочные материалы, грн. (число,n,2) >] // СТС пишут в позиции список ГСМ с ценами, а смазочные задают общей суммой //try // temp := temp + '`' + floattostr(Round2(ri.Mach.GSM.Smazka)); // temp := temp + '$' + floattostr(Round2(ri.Mach.GSMPrices.Smazka)); //dm.VEDOMOSTSmazka.Value * dm.VEDOMOSTSmazkaPrice.Value); //except // temp := temp + '`'; //end; {} temp := temp + '`' + '0$0'; //temp := temp + '`'; //*** [< ремонт и налоги без учета заработной платы, грн. (число,n,2) >] //try // temp := temp + '`' + floattostr(Round2(ri.Mach.NetRemont)); //dm.VEDOMOSTNetRemont.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** [ < перебазировка без учета заработной платы, грн. (число,n,2) >] //try // temp := temp + '`' + floattostr(Round2(ri.Mach.NetRebase)); //dm.VEDOMOSTNetRebase.Value); //except // temp := temp + '`'; //end; temp := temp + '`0'; //*** [ < прочие затраты, грн. (число,n,2) >] try temp := temp + '`0';// + floattostr(dm.VEDOMOST???.Value); прочие затраты except temp := temp + '`'; end; //*** [< цена машино-часа, грн. (число,n,2) > try temp := temp + '`' + floattostrU(RoundX(ri.Stoim, FloatPrecIBD)); //dm.VEDOMOSTStoim1.Value); except temp := temp + '`'; end; //*** [#< в том числе затраты заказчика, грн. (число,n,2) >] //try // if ri.PZak then // begin // if (pos('IBD',dm.STROIKAStadiynost.Value) <> 0) then//(dm.STROIKAStadiynost.Value = 'IBD') then // temp := temp + '#' + FormatFloat('0.########', ri.PZakSum) //floattostr(Round2(ri.Stoim1))// dm.VEDOMOSTStoim1.Value) // else // temp := temp + '#' + FormatFloat('0.########', Round2(ri.Stoim1));// dm.VEDOMOSTStoim1.Value) // end // else // temp := temp + '#0'; //except // temp := temp + '#0'; //end; temp := temp + '#0'; //*** <признак непосредственного задания сметной цены ( 0 - нет, 1 - да> //try // СТС передаёт позиции типа машина с признаком непосредственного задания цены // к тому же АВК криво поднимает переданную инфу о ГСМ, поэтому МЫ будем поступать как СТС - хай звыняють // Как выяснилось в итоге, если данные переданы с признаком непосредственного задания цены, // то применённые коэф. там до спины, поэтому пытаемся делать по-людски // if ri.AutoCalc then // temp := temp + '`0' // else {} // temp := temp + '`1'; //except // temp := temp + '`'; //end; if IsImmediateSmetaPrice then temp := temp + '`1' else temp := temp + '`0'; temp := temp + '*'; // заменяем перевед строки на # InsertCarret(temp); SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + ri.Shifr); end; end; procedure WriteBR_IBD2(ri: TResInfo); var i: integer; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'BR`' + ri.Shifr; //dm.VEDOMOSTShifr.Value; try if ri.PosVariant > 0 then temp := temp + '`' + IntToStr(ri.PosVariant) else temp := temp + '`'; except temp := temp + '`'; end; temp := temp + '`' + MakeCorrectName(ri.Name_r); try temp := temp + '`' + FormatFloat('0.########', ri.Kolvo);// неважная ф-я можно 1 или 0 //floattostr(ri.Kolvo1); //dm.VEDOMOSTKolvo.Value); except temp := temp + '`'; end; //*** Дата цен - можно тек-ю try ShortDateFormat := 'dd.mm.yy'; temp := temp + '`' + DateToStr(CurrDate); except temp := temp + '`'; end; temp := temp + '`';// Обоснование try //АВК поднимает Stoim1 как Отпускную, но добавляет доп затраты в ЛС и др. // нужно использовать именно отп. цену, т.к. в АВК добавляются доп затраты к оборудованию, // а у нас они уже сидят в ri.Stoim1 - поэтому передаём отп. цену, а при чтении не снимаем // автопросчёт и получаем ri.Stoim1 с доп затратами // SMETA temp := temp + '`' + floattostr(Round2(ri.Mat.OtpPrice));//ri.Stoim1); //dm.VEDOMOSTOtpPrice.Value); temp := temp + '`' + floattostrU(RoundX(ri.Stoim, FloatPrecIBD)); except // temp := temp + '`'; end; temp := temp + '*'; // заменяем перевед строки на # InsertCarret(temp); SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + ri.Shifr); end; end; procedure WriteMT_IBD2(ri: TResInfo); var i: integer; begin try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'MT`' + ri.Shifr;//dm.VEDOMOSTShifr.Value; try if ri.PosVariant > 0 then temp := temp + '`' + IntToStr(ri.PosVariant) else temp := temp + '`'; except temp := temp + '`'; end; temp := temp + '`' + MakeCorrectName(ri.Name_r); //*** [<признак возвращаемого материала (0 - нет; 1- да)> ] //if ri.Vozvrat then //dm.VEDOMOSTVozvrat.Value then // temp := temp + '`1' //else // temp := temp + '`0'; temp := temp + '`0'; //*** < количество, (число) > try temp := temp + '`' + FormatFloat('0.########', ri.Kolvo);//FloatToStr(ri.Kolvo1);// dm.VEDOMOSTKolvo.Value); except temp := temp + '`'; end; //*** [< дата формирования цены, (дата) >] try ShortDateFormat := 'dd.mm.yy'; temp := temp + '`' + DateToStr(CurrDate); except temp := temp + '`'; end; temp := temp + '`';// Обоснование //*** [< отпускная цена без учета понижающего коэффициента к отпускной цене возвращаемых материалов, грн. (число,n,2) >] //try // temp := temp + '`' + floattostr(Round2(ri.Mat.OtpPrice));// dm.VEDOMOSTOtpPrice.Value); //except // temp := temp + '`'; //end; try temp := temp + '`' + floattostrU(RoundX(ri.Stoim, FloatPrecIBD)); except temp := temp + '`'; end; //T1 & T2 //[{Т1=<транспортные расходы, грн. (число,n,2) >[#< заработная плата в транспортных расходах, грн.(число,n,2)># // < трудозатраты в транспортных расходах, чел.-ч (число)>#< амортизационные отчисления, грн. (число,n,2)>] | // Т2=< идентификатор, однозначно определяющий строку для определения провозной платы, ( текст ) > // [#<расстояние перевозки строительных грузов, км (число)>]}] //if (ri.Mat.KodTransport = '') or (not ri.AutoCalc) then //begin // try // temp := temp + '`Т1=' + FloatToStr(Round2(ri.Mat.Transport));// dm.VEDOMOSTTransport.Value); // except // temp := temp + '`'; // end; //end //else //begin // temp := temp + '`Т2=' + GetOldKodTransport(ri.Mat.KodTransport); //dm.VEDOMOSTKodTransport.Value; // try // temp := temp + '#' + IntToStr(ri.Mat.Distance);// dm.VEDOMOSTDistance.Value); // except // temp := temp + '#'; // end; //end; temp := temp + '`Т1='+FloatToStrU(RoundX(0, FloatPrecIBD)); //temp := temp + '`'; //*** [< заготовительно-складские расходы, грн. (число,n,2) >] //try // temp := temp + '`' + FloatToStr(Round2(ri.Mat.Sklad));// dm.VEDOMOSTSklad.Value); //except // temp := temp + '`'; //end; temp := temp + '`'; //*** [< сметная цена, грн. (число,n,2) > try temp := temp + '`' + FloatToStrU(RoundX(ri.Stoim, FloatPrecIBD)); except temp := temp + '`'; end; //*** [#< в том числе затраты заказчика, грн. (число,n,2) >] //try // if ri.PZak then // begin // if (pos('IBD',dm.STROIKAStadiynost.Value) <> 0) then//(dm.STROIKAStadiynost.Value = 'IBD') then // temp := temp + '#' + FormatFloat('0.########', ri.PZakSum) //floattostr(Round2(ri.Stoim1))// dm.VEDOMOSTStoim1.Value) // else // temp := temp + '#' + FormatFloat('0.########', Round2(ri.Stoim1));// dm.VEDOMOSTStoim1.Value) // end // else // temp := temp + '#0'; //except // temp := temp + '#0'; //end; temp := temp + ''; //*** <признак непосредственного задания сметной цены ( 0 - нет, 1 - да> //try // if ri.AutoCalc then // temp := temp + '`0' // else // temp := temp + '`1'; //except // temp := temp + '`'; //end; if IsImmediateSmetaPrice then temp := temp + '`1' else temp := temp + '`0'; temp := temp + '*'; // заменяем перевед строки на # InsertCarret(temp); SBlock.Add(temp); except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8 - ' + ri.Shifr); end; end; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S8'; temp := temp + '*'; SBlock.Add(temp); for i := 0 to High(Vedomost) do begin case Vedomost[i].RType of //Строительные машины и механизмы (MS) rtMachMech: begin WriteMS_IBD2(Vedomost[i]); end; //Строительные материалы, изделия и конструкции (MT) rtMat: begin WriteMT_IBD2(Vedomost[i]); end; //Оборудование (BR) rtPrice: begin WriteBR_IBD2(Vedomost[i]); end; end; end; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S8'); result := false; end; end; //-------------------------------------- //-------------------------------------- function TSAll.SetSFields9: Boolean; var temp: string; i: Integer; // P_os: Pointer; GlavaNum, OSNumInGlava: integer; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S9'; temp := temp + '*'; SBlock.Add(temp); GlavaNum := 2; for i := 0 to FIBD.FProject.ProjectLists.Count - 1 do begin OSNumInGlava := i + 1; temp := 'OS1'; temp := temp + '`' + IntToStr(GlavaNum); temp := temp + '`' + inttostr(OSNumInGlava); temp := temp + '`' + IntToStr(GlavaNum) + '-' + inttostr(OSNumInGlava); temp := temp + '`' + MakeCorrectName(FIBD.FProject.ProjectLists[i].GetNameForVisible); temp := temp + '``';//строительный объём temp := temp + '*'; SBlock.Add(temp); temp := 'OS2'; temp := temp + '*'; SBlock.Add(temp); end; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S9'); result := false; end; end; //-------------------------------------- function TSAll.SetSFields10: Boolean; //type // PosType = (Norm, Price, Res, Perevozka); var temp, temp1: string; i, j, k, TempPos: Integer; GlavaNum, OSNumInGlava, LSNum: integer; CurrCatalog: TSCSCatalog; VirtualRoom: TSCSCatalog; NoRoomObjects: TSCSCatalogs; NormResources: TSCSNormsResources; Norm: TSCSNorm; Resource: TSCSResourceRel; //****************************************************************************** // Возвращает индекс массива Ведомость, по заданным параметрам // вернет индекс либо следующий за пустой записью, либо индекс // записи (ресурса) который уже существует в массиве // (для формирования запроса) function GetIdxInVedomost(Shifr, Name, EdIzm: string; Kolvo, Stoim: double; RType: integer; IsResource: Boolean): Integer; var i: Integer; Vsego1, Vsego2, Delta: double; PosVariant: Integer; IsEqualStoim: Boolean; begin Result := 0; PosVariant := 1; for i := 0 to High(Vedomost) do begin if (Vedomost[i].Shifr = Shifr) and (Vedomost[i].Name_r = Name) and (Vedomost[i].Izm_r = EdIzm) then begin IsEqualStoim := CmpFloatByPrecision(Vedomost[i].Stoim, Stoim, FloatPrecIBD); //*** Если цены сходятся if IsEqualStoim or Not IsUsePosVariants then begin //Vsego1 := Vedomost[i].Kolvo * Vedomost[i].Stoim; //Vsego2 := Kolvo * Stoim; //Delta := (Vsego1 + Vsego2) / (Vedomost[i].Kolvo + Kolvo); //Vedomost[i].Kolvo := Vedomost[i].Kolvo + Kolvo; //Vedomost[i].Stoim := Delta; Vedomost[i].Kolvo := Vedomost[i].Kolvo + Kolvo; if Not IsUsePosVariants then if Stoim > Vedomost[i].Stoim then Vedomost[i].Stoim := Stoim; Result := i; Break; end else PosVariant := Vedomost[i].PosVariant + 1; end; //*** Если не удалось найти позицию if Result = 0 then if (Vedomost[i].Name_r = '') and (Vedomost[i].Shifr = '') then begin Vedomost[i].Shifr := Shifr; Vedomost[i].Name_r := Name; Vedomost[i].Izm_r := EdIzm; Vedomost[i].Kolvo := Kolvo; Vedomost[i].Stoim := Stoim; Vedomost[i].VarNum := i+1; Vedomost[i].RType := RType; if IsUsePosVariants then if Not IsResource then Vedomost[i].PosVariant := PosVariant; Vedomost[i].IsResource := IsResource; Result := i; Break; end; end; if Result = High(Vedomost) - 1 then SetLength(Vedomost, High(Vedomost) + 100); end; //****************************************************************************** procedure AddPosToIBD(PMPos: TSCSResourceRel); overload; var VedIdx: integer; begin if PMPos.Cypher = '' then exit; VedIdx := -1; temp := ''; temp := temp + '`' + PMPos.Cypher; try // пишем чистое кол-во - без коэффициентов temp := temp + '`' + FormatFloat('0.########', PMPos.Kolvo); except temp := temp + '`'; end; //temp := temp + '`Т2=' + PMPos.Name; VedIdx := GetIdxInVedomost(PMPos.Cypher, PMPos.Name, PMPos.Izm, PMPos.Kolvo, PMPos.Price, PMPos.RType, PMPos.ServIsResource); if IsUsePosVariants and Not PMPos.ServIsResource then begin temp := temp + '`Т15=' + IntToStr(Vedomost[VedIdx].PosVariant); end else temp := temp + '`Т2=' + PMPos.Name; //if (VedIdx + 1) > MaxVedIdx then // MaxVedIdx := VedIdx + 1; if (VedIdx) > MaxVedIdx then MaxVedIdx := VedIdx; { if Vedomost[VedIdx].VarNum >= 0 then begin // rus temp := temp + '`Т15=' + IntToStr(Vedomost[VedIdx].VarNum); end; } { case PMPos.RType of rtMat: begin temp := '`Р='; temp := temp + MakeCorrectName(PMPos.Name) + '$' + MakeCorrectName(PMPos.Izm) + '$1$0'; end; rtPrice: begin temp := '`Р='; temp := temp + MakeCorrectName(PMPos.Name) + '$' + MakeCorrectName(PMPos.Izm) + '$33$0'; end; end; } InsertCarret(temp); temp := temp + '*'; //if PMPos.ServIsResource then SBlock.Add(temp); end; //****************************************************************************** procedure AddPosToIBD(PMPos: TSCSNorm); overload; begin if PMPos.Cypher = '' then exit; temp := ''; temp := temp + '`' + PMPos.Cypher; try // пишем чистое кол-во - без коэффициентов temp := temp + '`' + FormatFloat('0.########', PMPos.Kolvo); except temp := temp + '`'; end; temp := temp + '`Т2=' + PMPos.Name; InsertCarret(temp); temp := temp + '*'; SBlock.Add(temp); end; {//06.01.2012 procedure GroupSamePreyscurantsByVariousPrice(AResources: TSCSResources); var i, j: Integer; ResourceI: TSCSResourceRel; ResourceJ: TSCSResourceRel; begin try i := 0; for i := 0 to AResources.Count - 1 do begin ResourceI := AResources[i]; if (ResourceI <> nil) and Not ResourceI.ServIsResource then for j := 0 to AResources.Count - 1 do begin ResourceJ := AResources[j]; if (ResourceJ <> nil) and Not ResourceJ.ServIsResource then begin if (ResourceI.Cypher = ResourceJ.Cypher) and (ResourceI.Name = ResourceJ.Name) and (ResourceI.Izm = ResourceJ.Izm) then if Not CmpFloatByPrecision(ResourceI.Price, ResourceJ.Price, FloatPrecIBD) then begin if ResourceJ.Price > ResourceI.Price then ResourceI.Price := ResourceJ.Price; ResourceI.Kolvo := ResourceI.Kolvo + ResourceJ.Kolvo; FreeAndNil(ResourceJ); AResources[j] := nil; Break; //// BREAK //// end; end; end; end; AResources.Pack; except on E: Exception do AddExceptionToLogEx('GroupSameResourcesByVariousPrice', E.Message); end; end;} //****************************************************************************** begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S10'; temp := temp + '*'; SBlock.Add(temp); VirtualRoom := TSCSCatalog.Create(F_ProjMan); VirtualRoom.ChildCatalogs.Free; NoRoomObjects := TSCSCatalogs.Create(false); VirtualRoom.ChildCatalogs := NoRoomObjects; GlavaNum := 2; SetLength(Vedomost, 10000); MaxVedIdx := -1; for i := 0 to High(Vedomost) do FillChar(Vedomost[i], SizeOf(Vedomost[i]), 0); try for i := 0 to FIBD.FProject.ProjectLists.Count - 1 do begin OSNumInGlava := i + 1; VirtualRoom.Clear; VirtualRoom.ComponentReferences.Clear; VirtualRoom.SetParentWithNoReferences(FIBD.FProject.ProjectLists[i]); LSNum := 1; for j := 0 to FIBD.FProject.ProjectLists[i].ChildCatalogs.Count -1 do begin CurrCatalog := FIBD.FProject.ProjectLists[i].ChildCatalogs[j]; if CurrCatalog.ItemType = itRoom then begin NormResources := nil; //12.01.2012 NormResources := CurrCatalog.GetAllNormsResources([nrAll], true, true, true, false); NormResources := FIBD.GetCatalogAllNormsResources(CurrCatalog); // if (NormResources.Norms.Count > 0) or (NormResources.Resources.Count > 0) then begin temp := 'LS1'; temp := temp + '`' + inttostr(GlavaNum); temp := temp + '`' + IntToStr(OSNumInGlava); temp := temp + '`' + IntToStr(LSNum); temp := temp + '`' + inttostr(GlavaNum)+ '-' + IntToStr(OSNumInGlava) + '-' + IntToStr(LSNum); temp := temp + '`' + MakeCorrectName(CurrCatalog.GetNameForVisible); temp := temp + '`'; //[< строительный объем, (число) >] temp := temp + '`'; //[< единица измерения строительного объема ( текст ) >] temp := temp + '`'; //[< список чертежей ( текст ) >] temp := temp + '`'; //[< Ф.И.О. составителя, (текст) >] temp := temp + '`'; //[< Ф.И.О. проверяющего, (текст) >] temp := temp + '*'; SBlock.Add(temp); temp := 'LS3'; temp := temp + '*'; SBlock.Add(temp); for k := 0 to NormResources.Norms.Count - 1 do begin AddPosToIBD(NormResources.Norms[k]); end; if Not IsUsePosVariants then GroupSamePreyscurantsByVariousPrice(NormResources.Resources, FloatPrecIBD); for k := 0 to NormResources.Resources.Count - 1 do begin AddPosToIBD(NormResources.Resources[k]); end; end; FreeAndNil(NormResources); Inc(LSNum); end; if CurrCatalog.ItemType in [itSCSLine, itSCSConnector] then begin VirtualRoom.ChildCatalogs.Add(CurrCatalog); VirtualRoom.ComponentReferences.Assign(CurrCatalog.ComponentReferences, laOr); end; end; //--------------------------- VirtualRoom -------------------------------------- NormResources := nil; //12.01.2012 NormResources := VirtualRoom.GetAllNormsResources([nrAll], true, true, true, false); NormResources := FIBD.GetCatalogAllNormsResources(VirtualRoom); // if (NormResources.Norms.Count > 0) or (NormResources.Resources.Count > 0) then begin temp := 'LS1'; temp := temp + '`' + inttostr(GlavaNum); temp := temp + '`' + IntToStr(OSNumInGlava); temp := temp + '`' + IntToStr(LSNum); temp := temp + '`' + inttostr(GlavaNum)+ '-' + IntToStr(OSNumInGlava) + '-' + IntToStr(LSNum); temp := temp + '`' + MakeCorrectName(FIBD.FProject.ProjectLists[i].GetNameForVisible); temp := temp + '`'; //[< строительный объем, (число) >] temp := temp + '`'; //[< единица измерения строительного объема ( текст ) >] temp := temp + '`'; //[< список чертежей ( текст ) >] temp := temp + '`'; //[< Ф.И.О. составителя, (текст) >] temp := temp + '`'; //[< Ф.И.О. проверяющего, (текст) >] temp := temp + '*'; SBlock.Add(temp); temp := 'LS3'; temp := temp + '*'; SBlock.Add(temp); for k := 0 to NormResources.Norms.Count - 1 do begin AddPosToIBD(NormResources.Norms[k]); end; if Not IsUsePosVariants then GroupSamePreyscurantsByVariousPrice(NormResources.Resources, FloatPrecIBD); for k := 0 to NormResources.Resources.Count - 1 do begin AddPosToIBD(NormResources.Resources[k]); end; end; FreeAndNil(NormResources); //------------------------------------------------------------------------------ end; finally VirtualRoom.SetParentWithNoReferences(nil); VirtualRoom.Free; end; SetLength(Vedomost, MaxVedIdx + 1); result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S10'); result := false; end; end; function TSAll.SetSFields14: Boolean; var temp: string; begin result := false; try if Not Assigned(SBlock) then SBlock := TStringList.Create; temp := 'S14'; temp := temp + '*'; SBlock.Add(temp); // пока пропускаем Данные для расчета общепроизводственных расходов ProcessMessagesEx; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке S14'); result := false; end; end; //****************************************************************************** { LastRec } //****************************************************************************** constructor TLastRec.Create; begin SBlock := TStringList.Create; SFieldsList := TList.Create; end; destructor TLastRec.Destroy; var i: integer; begin SBlock.Free; for i := 0 to SFieldsList.Count - 1 do TStringList(SFieldsList.Items[i]).Free; SFieldsList.Free; inherited; end; function TLastRec.SetLastRecFields(i: integer): Boolean; var temp: string; begin result := false; try temp := 'КИБД'; temp := temp + '`' + inttostr(i); temp := temp + '*'; SBlock.Add(temp); Application.ProcessMessages; result := true; except IBDLog.AddToLog('!!!!!!!!!! Error - Ошибка (exception) при обработке LastRec'); result := false; end; end; //****************************************************************************** { TIbdLog } //****************************************************************************** procedure TIbdLog.AddToLog(LogString: String); begin LoadFromFile(FFileName); Add(LogString); try SaveToFile(FFileName); except randomize; FFileName := FFileName + inttostr(random(1000)); try SaveToFile(FFileName); except end; end; end; constructor TIBDLog.Create(FileName: String); begin inherited create(); // Tolik 09/12/2019 -- в Delphi 6 проскакивало и так, здесь -- ни хера, // нужно вызывать конструктор парента по науке...а то будет бяка FFileName := FileName; try SaveToFile(FFileName); except randomize; FFileName := FFileName + inttostr(random(1000)); try SaveToFile(FFileName); except end; end; end; destructor TIBDLog.Destroy; begin inherited; end; //****************************************************************************** // Дополнительные функции //****************************************************************************** function MakeCorrectName(S: string): string; begin Result := ''; while Pos('`', S) > 0 do begin S[Pos('`', S)] := ''''; end; while Pos('*', S) > 0 do begin S[Pos('*', S)] := 'x'; end; Result := S; end; //-------------------------------------- //****************************************************************************** procedure SetBlock(Source: TStringList; var Destination: TStringList); var LineNum: integer; begin try LineNum := 0; while (LineNum < Source.Count) do begin Destination.Add(Source.Strings[LineNum]); inc(LineNum); end; except end; end; //****************************************************************************** procedure InsertCarret(var TempString: string); var TempPos: integer; begin while pos(#13#10, TempString) > 0 do begin TempPos := pos(#13#10, TempString); Delete(TempString, TempPos, 2); Insert(' '{#'}, TempString, TempPos); end; end; procedure SaveWithCorrectSizeAndPack(AIBD: TStringList; AFileName: string); var IBDList: TStringList; temp: string; begin IBDList := TStringList.Create; IBDList.Assign(AIBD); IBDList.Delete(IBDList.Count - 1); temp := 'КИБД'; temp := temp + '`' + inttostr(length(IBDList.Text)); temp := temp + '*'; IBDList.Add(temp); PackAndSaveIBD(IBDList, AFileName); FreeAndNil(IBDList); end; //****************************************************************************** { TARPS } constructor TARPS.Create; begin inherited ; FPrecision := 4; end; destructor TARPS.Destroy; begin inherited; end; procedure TARPS.Init(const FileName: string; AProject: TSCSProject); begin inherited; FNormNpp := 1; end; function TARPS.Save: Boolean; var i, j: integer; ListIdx: Integer; RoomIdx: Integer; WasSaveForList: Boolean; ProjList: TSCSList; Catalog: TSCSCatalog; VirtualRoom: TSCSCatalog; //StrAnsi: String; StrAnsi: AnsiString; //StrOEM: PChar; StrOEM: PAnsiChar; FHandle: TextFile; begin Result := true; //FData.Add('1#АРПС 1.10#Сметный эксперт#73'); //FData.Add('3####1###########2001#0#1###'); FData.Add('1#АРПС 1.10#'+ApplicationName+'#'+VersionEXE); FData.Add('3####1###########2001#0#1#'+FProject.GetNameForVisible+'##'); FRowData := TStringList.Create; for i := 0 to 27 do FRowData.Add(''); VirtualRoom := nil; if FShowRooms then begin VirtualRoom := TSCSCatalog.Create(F_ProjMan); VirtualRoom.ChildCatalogs.OwnsObjects := false; end; if Not FShowLists then SaveNormsFromCatalog(FProject, 0, 1, '') else begin ListIdx := 1; for i := 0 to FProject.ProjectLists.Count - 1 do begin ProjList := FProject.ProjectLists[i]; if ProjList.Setting.ListType = lt_Normal then begin WasSaveForList := false; if Not FShowRooms then begin if SaveNormsFromCatalog(ProjList, 0, ListIdx, ProjList.GetNameForVisible) then WasSaveForList := true; end else begin RoomIdx := 1; VirtualRoom.Clear; VirtualRoom.ComponentReferences.Clear; VirtualRoom.SetParentWithNoReferences(ProjList); for j := 0 to ProjList.ChildCatalogs.Count - 1 do begin Catalog := ProjList.ChildCatalogs[j]; if IsSCSObjectItemType(Catalog.ItemType) then begin VirtualRoom.ChildCatalogs.Add(Catalog); VirtualRoom.ComponentReferences.Assign(Catalog.ComponentReferences, laOr); end; end; if SaveNormsFromCatalog(VirtualRoom, 0, ListIdx, ProjList.GetNameForVisible) then WasSaveForList := true; VirtualRoom.SetParentWithNoReferences(nil); for j := 0 to ProjList.ChildCatalogs.Count - 1 do begin Catalog := ProjList.ChildCatalogs[j]; if Catalog.ItemType = itRoom then begin if SaveNormsFromCatalog(Catalog, 1, RoomIdx, Catalog.GetNameForVisible) then begin WasSaveForList := true; Inc(RoomIdx); end; end; end; end; if WasSaveForList then Inc(ListIdx); end; end; end; if VirtualRoom <> nil then VirtualRoom.Free; FRowData.Free; StrAnsi := FData.Text; GetMem(StrOEM, Length(StrAnsi)); //AnsiToOem(PChar(StrAnsi), StrOEM); AnsiToOem(PAnsiChar(StrAnsi), PAnsiChar(StrOEM)); AssignFile(FHandle, FFileName); //if FileExists(FFileName) then // Reset(FHandle) //else // Rewrite(FHandle); Rewrite(FHandle); try Write(FHandle, StrOEM); finally CloseFile(FHandle); end; FreeMem(StrOEM); //FData.SaveToFile(FFileName); end; procedure TARPS.ClearRowData; var i: integer; begin for i := 0 to 27 do FRowData[i] := ''; end; procedure TARPS.SaveArticle(ALevel, ANum: Integer; const aArticleName: String); begin if aArticleName <> '' then begin FData.Add('10#' +IntToStr(ALevel)+'#'+ IntToStr(ANum)+'#'+ aArticleName); end; end; function TARPS.SaveNormsFromCatalog(ACatalog: TSCSCatalog; ALevel, aArticleNum: Integer; const aArticleName: String): Boolean; var i: Integer; NormResources: TSCSNormsResources; Norm: TSCSNorm; Resource: TSCSResourceRel; begin Result := false; //NormResources := ACatalog.GetAllNormsResources([nrAll], true, true, true, false); NormResources := Self.GetCatalogAllNormsResources(ACatalog); if (NormResources.Norms.Count > 0) or (NormResources.Resources.Count > 0) then begin SaveArticle(ALevel, aArticleNum, aArticleName); for i := 0 to NormResources.Norms.Count - 1 do begin Norm := NormResources.Norms[i]; ClearRowData; // Номер по порядку FRowData[0] := IntToStr(FNormNpp); // Обоснование - Шифр FRowData[1] := Norm.Cypher; // Единица измерения FRowData[2] := Norm.Izm_; // Наименование FRowData[3] := Norm.Name; // Количество FRowData[25] := FloatToStr(RoundX(Norm.Kolvo, FPrecision)); SaveRowData('20#'); //FData.Add('20#' + FRowData.Text); Inc(FNormNpp); end; if Not IsUsePosVariants then GroupSamePreyscurantsByVariousPrice(NormResources.Resources, FloatPrecIBD); for i := 0 to NormResources.Resources.Count - 1 do begin Resource := NormResources.Resources[i]; {ClearRowData; // Код ресурса FRowData[0] := Resource.Cypher; // Единица измерения FRowData[1] := Resource.Izm; // Наименование ресурса FRowData[2] := Resource.Name; // Признак типа ресурса (0–зп 1-эксплуатация машин и механизмов 2-материал) if Resource.RType = rtMachMech then FRowData[3] := '1' else FRowData[3] := '2'; // Норма расхода ресурса на единицу объема работ FRowData[4] := '1'; //FloatToStr(RoundX(Resource.Kolvo, FPrecision)); // Пока ставим количество (объем) ресурса // Цены if FCountryCurrency <> nil then begin // Цена единицы ресурса нормативная (число, руб.) FRowData[5] := FloatToStr(RoundX(Resource.Cost, FPrecision)); // Цена единицы ресурса фактическая (число, руб.). FRowData[6] := FRowData[5]; // Цена единицы ресурса местная (число, руб.). FRowData[7] := FRowData[5]; end; SaveRowData('30#'); //FData.Add('30#' + FRowData.Text);} // Номер по порядку FRowData[0] := IntToStr(FNormNpp); // Обоснование - Шифр FRowData[1] := Resource.Cypher; // Единица измерения FRowData[2] := Resource.Izm; // Наименование FRowData[3] := Resource.Name; // 26) Количество FRowData[25] := FloatToStr(RoundX(Resource.Kolvo, FPrecision)); // 5) Прямые затраты (всего) (число, руб.). FRowData[4] := FloatToStr(RoundX(Resource.Price, FPrecision)); //'0'; // 6) Основная заработная плата (число, руб.). FRowData[5] := '0'; // 7) Стоимость эксплуатации машин и механизмов (число, руб.). FRowData[6] := '0'; // 8) Заработная плата машинистов (число, руб.) FRowData[7] := '0'; // 9) Стоимость материалов (число, руб.). FRowData[8] := {'0'; //}FloatToStr(RoundX(Resource.Price, FPrecision)); // 10) Возврат материалов (число, руб.). FRowData[9] := '0'; // 11) Транспорт материалов (число, руб.). FRowData[10] := '0'; // 12) Шефмонтаж (число, руб.). FRowData[11] := '0'; SaveRowData('20#'); //FData.Add('20#' + FRowData.Text); Inc(FNormNpp); end; Result := true; end; FreeAndNil(NormResources); end; procedure TARPS.SaveRowData(const ADataType: String); var i: Integer; RowDataStr: String; begin RowDataStr := ''; for i := 0 to FRowData.Count - 1 do RowDataStr := RowDataStr + FRowData[i] + '#'; FData.Add(ADataType + RowDataStr); end; function TF_SmetaExport.Execute(AExportObj: TSmetaExport): Boolean; begin Result := false; cbShowLists.Visible := AExportObj is TARPS; cbShowRooms.Visible := AExportObj is TARPS; if AExportObj is TARPS then Height := FSrcHeight else Height := FSrcHeight - 24*(2); if ShowModal = mrOk then begin Result := true; AExportObj.FCanHaveActiveComponents := cbCanHaveActiveComponents.Checked; AExportObj.FCanHaveDismountAccount := cbCanHaveDismountAccount.Checked; AExportObj.FCanResources := cbCanResources.Checked; AExportObj.FCanComponents := cbCanComponents.Checked; AExportObj.FCanHaveZeroPriceComponents := cbCanHaveZeroPriceComponents.Checked; AExportObj.FShowLists := cbShowLists.Checked; AExportObj.FShowRooms := cbShowRooms.Checked; end; end; procedure TF_SmetaExport.pnOkCancelResize(Sender: TObject); begin SetMiddleControlChilds(TControl(Sender), TControl(Self)); end; procedure TF_SmetaExport.FormCreate(Sender: TObject); begin FSrcHeight := Height; end; end.