unit U_IBD; interface uses Classes, Dialogs, Windows, SysUtils, Controls, Forms, U_BaseCommon, U_BaseConstants, U_IBDUP; 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 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; TIBD = class; 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(TObject) private FFileName: string; IBDData: TStringList; public Header: THeader; SAll: array[1..SBlockCount] of TSAll; LastRec: TLastRec; InitSuccess: boolean; NumberPos: integer; constructor Create; destructor Destroy; override; function SaveIBD: Boolean; procedure Init(FileName: string); end; //****************************************************************************** // Дополнительные функции //****************************************************************************** function MakeCorrectName(S: string): string; procedure SetBlock(Source: TStringList; var Destination: TStringList); procedure InsertCarret(var TempString: string); procedure SaveWithCorrectSizeAndPack(AIBD: TStringList; AFileName: string); //****************************************************************************** procedure SaveProjectToIBD; var Vedomost: array of TResInfo; MaxVedIdx: Integer; CurrDate: TDate; implementation uses USCS_Main, U_Common, U_ProtectionCommon, U_Main, U_SCSComponent; var IBDLog: TIBDLog; IBD: TIBD; IBDShifr: string; procedure SaveProjectToIBD; var IBDSaveDialog: TSaveDialog; begin if GetCurrProjectName = '' then begin MessageModal('Откройте необходимый проект и попробуйте снова.', 'Внимание!', MB_ICONINFORMATION); exit; end; IBDSaveDialog := TSaveDialog.Create(IBDSaveDialog); IBDSaveDialog.InitialDir := ExtractSaveDir; IBDSaveDialog.Title := 'Сохранение файла ИБД'; IBDSaveDialog.FileName := FileNameCorrect(GetCurrProjectName); IBDSaveDialog.Filter := 'Файлы инвесторского ИБД (*.bds)|*.bds'; IBDSaveDialog.DefaultExt := '*.bds'; IBDSaveDialog.Options := [ofNoChangeDir,ofHideReadOnly,ofPathMustExist,ofOverwritePrompt,ofNoDereferenceLinks]; if not IBDSaveDialog.Execute then begin Exit; end; BeginProgress('Запись проекта в ИБД...'); try IBD := TIBD.Create; IBD.Init(IBDSaveDialog.FileName); if not IBD.SaveIBD 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; //****************************************************************************** { TIBD } constructor TIBD.Create; var i: integer; LogDir: String; begin LogDir := ExeDir + '\' + dnLog; IBDLog := TIBDLog.Create(LogDir + '\IBD.Log'); 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(FileName: string); var i: integer; begin 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.SaveIBD: 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, IBDData); ProcessMessagesEx; for i := 1 to SBlockCount do begin IBDLog.AddToLog('~~~~Moving S' + IntToStr(STypes[i]) + ' to IBDData'); SetBlock(SAll[i].SBlock, IBDData); ProcessMessagesEx; end; try if not LastRec.SetLastRecFields(length(IBDData.Text)) then begin IBDLog.AddToLog('!!!!!!!!!! Ошибка формирования КИБД!!!'); result := false; exit; end; ProcessMessagesEx; except end; IBDLog.AddToLog('~~~~Moving LastRec to IBDData'); SetBlock(LastRec.SBlock, IBDData); ProcessMessagesEx; //IBDData.SaveToFile(FFileName); SaveWithCorrectSizeAndPack(IBDData, FFileName); IBDData.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(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 F_ProjMan.GSCSBase.CurrProject.Name <> '' then temp := temp + '`' + MakeCorrectName(F_ProjMan.GSCSBase.CurrProject.Name) else temp := temp + '`' + MakeCorrectName(F_ProjMan.GSCSBase.CurrProject.GetParams.Caption); temp := temp + '`'; try temp := temp + '`' + MakeCorrectName(F_ProjMan.GSCSBase.CurrProject.Name) + ' ' + IntToStr(F_ProjMan.GSCSBase.CurrProject.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 F_ProjMan.GSCSBase.CurrProject.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(F_ProjMan.GSCSBase.CurrProject.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; 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 F_ProjMan.GSCSBase.CurrProject.ProjectLists.Count - 1 do begin OSNumInGlava := i + 1; VirtualRoom.Clear; VirtualRoom.ComponentReferences.Clear; VirtualRoom.SetParentWithNoReferences(F_ProjMan.GSCSBase.CurrProject.ProjectLists[i]); LSNum := 1; for j := 0 to F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].ChildCatalogs.Count -1 do begin CurrCatalog := F_ProjMan.GSCSBase.CurrProject.ProjectLists[i].ChildCatalogs[j]; if CurrCatalog.ItemType = itRoom then begin NormResources := nil; NormResources := CurrCatalog.GetAllNormsResources([nrAll], true, true, true, false); // 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); 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; NormResources := VirtualRoom.GetAllNormsResources([nrAll], true, true, true, false); // 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(F_ProjMan.GSCSBase.CurrProject.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); 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 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; //****************************************************************************** end.