Estimate/EstABCTypes.pas - master - YakuninAV/Convertors

Estimate/EstABCTypes.pas
434 строки17 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
{*******************************************************}
{                                                       }
{       Estimate                                        }
{                                                       }
{       Copyright (C) 2020 ДатаБазис Девелопмент        }
{                                                       }
{*******************************************************}
/// Модуль содержит объявления типов для работы со сметами ABC (текстовый формат)
unit EstABCTypes;

{$I mormot.defines.inc}
{$IFDEF FPC}
  {$MODESWITCH ADVANCEDRECORDS}
{$ENDIF}

interface

uses
  SysUtils, Classes, StrUtils,
  mormot.core.base, mormot.core.variants, mormot.core.os, mormot.core.unicode, mormot.core.text,
  DBDStrUtils,
  EstTypes;

var
  ExcelVersion: string;
  ExcelMajorVersion: Word;
  ExcelMinorVersion: Word;
  ZeroExtString: string = ' -- ';
  ZeroIntSring: string = '';
  ZeroString: string = ' -- ';
  DecSepar: Char = '.';

const
  abcColQty            = 11; // Количество колонок в таблице
  abcChapterEndLine    = 19; // Линия завершающая раздел открывает и закрывает итоги раздела
  abcChapterTotal      = 16; // Строка, содержащая итого по разделу
  abcPositionStart     =  4; // Первая строка содержащая информацию о позиции
  abcPositionName      = 17; // Наименование позиции
  abcPositionTotalLine = 17; // Линия завершающая итоги позиции
  abcPositionTotal     = 37; // Строка, содержащая итого позиции
  abcPositionTotalItem = 23; // Строка итогов позиции
  abcPositionComment   = 27; // Строка комментария перед позицией
  abcEstimateComment   = 71; // Строка комментария к смете разделу

var
//  abcPosTot: Integer = 17;
  abcHeightHdr: Integer = 10;
  abcHeightSub: Integer = 5;
  abcEmptyLines: Integer = 10;
  abcPriceBPos: Integer = 0;
  abcPriceCPos: Integer = 0;
  abcChapterPos: Integer = 30;
  abcSecTot: Integer = 19;
  abcTblLine, abcPerfLine, abcProgName: string;
  abcCnstrName: SynUnicode;
  abcObjNum: string;
  abcObjName: string;
  abcTomName: string;
  abcEstNo: string;
  abcEstName: string;
  abcTotal: string;
  abcFormFeed: string;
  abcPriceLevel: string;
  abcReason: string;
  abcPriceDate: string;
  abcEstPrice: string;
  abcEstLabor: string;
  abcPriceB, abcPriceC: string;
  abcRub: string;
  abcChapter, abcChapterLine, abcSubChapterLine: string;
  abcDivision: string;
  abcPositionSep: string;

  MagicStr: SynUnicode;

const
  Excel2007MajorVersion=12;

type
  /// Тип строки
  //  abcltEmpty         пустая строка
  //  abcltData
  //  abcltFirstLine     первая строка
  //  abcltContinue      строка продолжения
  //  abcltFrameLine     строка рамки таблицы
  //  abcltFormFeed      разрыв страницы
  //  abcltUnknown
  //  abcltEndData
  //  abcltPosTotal      итого позиции
  //  abcltSecTotal      итого раздела
  //  abcltEstTotal      всего по смете
  //  abcSectionName     наименование раздела
  //  abcStartSection    начало раздела
  //  abcltEndSection    конец раздела
  //  abcltSubposition   подчинённая позиция
  //  abcltComments      коментарий
  TabcLineType = (abcltEmpty, abcltData, abcltEndData, abcltFirstLine, abcltContinue, abcltFrameLine, abcltFormFeed,
                  abcltPosTotal, abcltSecTotal, abcltEstTotal, abcltSubposition,
                  abcSectionName, abcStartSection, abcltEndSection, abcltSecPrice, abcltSecPart, abcltSectLine, abcltComments,
                  abcltUnknown);
  TabcLineTypes = set of TabcLineType;

  /// Опции параметров заголовка сметы АБС
  //  abcpoMultiLine - распологается на нескольуих строках
  //  abcpoOptional  - может отсутствовать
  //  abcpoNoEmptyLine - для abcpoMultiLine пустая строка конец параметра
  //  abcpoSingle -
  //  abcpoSeveralParams - в строке могут быть ещё параметры
  TabcParamOption = (abcpoMultiLine, abcpoOptional, abcpoSingle, abcpoNoEmptyLine, abcpoSeveralParams);
  TabcParamOptions = set of TabcParamOption;

  PabcHeaderParam = ^TabcHeaderParam;
  /// Параметр размещённый в заголовке сметы
  TabcHeaderParam = record
    /// Название параметра
    Caption: string;
    /// Вид параметра:
    // 0-флаг  - определяется факт наличия caption в тексте. значение устанавливается в не '' ('1')
    // 1-текст
    // 2-число
    // 3-дата
    Kind: Byte;
    /// Опции параметра
    Options: TabcParamOptions;
    /// Позиция в строке (0-где угодно)
    Position:Integer;
    /// Смещение дополнительных строк
    Offset:Integer;
    /// Значение параметра
    Value: string;
    /// Ширина колонки, в которой размещен параметр
    Width: Integer;
    /// Очистить параметр
    procedure Clear;
    /// Создать параметр
    constructor Create(const aCap: string; const aKind: Byte; const aOpt: TabcParamOptions=[];
                       const aPos: Integer=0; const aWidth: Integer=0; const aOffset: Integer=0);
    /// Извлечь из строки значение параметра
    function ReadLine(const S: string; const Start: Boolean=false; const NextParam:PabcHeaderParam=nil): Boolean;
    /// Сканировать строки и извлечь из них параметр
    function ReadStrings(Text: TStrings; var iLine: Integer; const LastLine:Integer=0; NextParam:PabcHeaderParam=nil): Boolean;
  end;
  TabcHeaderParams = array of TabcHeaderParam;

  PabcTableCol = ^TabcTableCol;
  TabcTableCol = record
    /// позиция в строке
    iStart: Word;
    /// длина колонки
    iLen: Word;
    /// Тип значения в колонке
    //  0 - строка
    //  1 - номер
    //  2 - число
    Kind: Word;
  public
    constructor Create(const aSt,aLn,aKd: Word);
  end;
  TabcTableCols = array[0..abcColQty] of TabcTableCol;

  TabcTabLine = record
  private
    Line: string;
  public
    function GetAsString(const Index: word): string;
    function GetAsCurrency(const Index: word): Currency;
    function GetAsDouble(const Index: word): Double;
    function GetAsInteger(const Index: word): Integer;
    constructor Create(const S: string);
  end;

  /// Итоги
  TabcTotals = record

  end;
function isTabLine(const Line: string): Boolean;
function ABCCypherToPositionType(const Cyp: string): TEstimatePositionType;

function PriceItemTypeToString(const pt: TEstimatePriceItemType): string;

implementation

var
  abcCols: TabcTableCols;

procedure InitUnit;
  begin
    abcTblLine:=DupeString('-',20);
    abcPerfLine:=DupeString('.',20);
    abcProgName:='ПРОГРАММНЫЙ КОМПЛЕКС';
    abcCnstrName:= UTF8ToSynUnicode('НАИМЕНОВАНИЕ СТРОЙКИ-');
    abcObjNum:='ОБЬЕКТ НОМЕР';
    abcEstName:='НА ';
    abcObjName:='НАИМЕНОВАНИЕ ОБЪЕКТА-';
    abcTomName:='ТОМ';
    abcEstNo:='Л О К А Л Ь Н А Я   С М Е Т А   N';
    abcTotal:='ИТОГО';
    abcReason:='ОСНОВАНИЕ:';
    abcFormFeed:= Char($FF);
  //ФОРМА
  //НА
    abcEstPrice:='СМЕТНАЯ СТОИМОСТЬ,';
    abcEstLabor:='СРЕДСТВА НА ОПЛАТУ ТРУДА,';
    abcPriceLevel:='СОСТАВЛЕНА В ЦЕНАХ НА ';
    abcPriceDate:='В ЦЕНАХ ';
    abcPriceB:='БАЗ. Ц.';
    abcPriceC:='ТЕК. Ц.';
    abcRub:='РУБ.';
    abcChapter:='РАЗДЕЛ ';
    abcChapterLine:='===============================================';
    abcSubChapterLine:='-----------------------------------------------';
    abcPositionSep:='----------------------------------------------------------------------------------------------------------------';
    MagicStr:= Utf8ToSynUnicode('ПРОГРАММНЫЙ КОМПЛЕКС АВС-4 (РЕДАКЦИЯ 2019.1) МОСИНЖПРОЕКТ');

    abcCols[0]:=TabcTableCol.Create(1,128,0);                 // вся строка
    abcCols[1]:=TabcTableCol.Create(1,4,1);                   // номер по порядку
    abcCols[2]:=TabcTableCol.Create(6,10,0);                  // шифр расценки
    abcCols[3]:=TabcTableCol.Create(16,32,0);                 // наименование работ или затрат
    abcCols[4]:=TabcTableCol.Create(49,8,0);                  // единица измерения
    abcCols[5]:=TabcTableCol.Create(57,11,2);                 // объём работ
    abcCols[6]:=TabcTableCol.Create(68,11,2);                 // цена единицы
    abcCols[7]:=TabcTableCol.Create(80,7,2);                  // поправки
    abcCols[8]:=TabcTableCol.Create(88,7,2);                  // зимние
    abcCols[9]:=TabcTableCol.Create(96,12,2);                 // цена в базисных
    abcCols[10]:=TabcTableCol.Create(109,7,2);                // коэфы пересчета и НР СП
    abcCols[11]:=TabcTableCol.Create(117,12,2);               // цена в текущих
  end;

function isTabLine(const Line: string): Boolean;
begin
  Result := Copy(Line,1,20)=abcTblLine;
end;

function ABCCypherToPositionType(const Cyp: string): TEstimatePositionType;
var i,n: Integer;
begin
  Result:=eptTSN; i:=1;
  if TDBDString.StartsWith(Cyp,'15.') then begin
    Result := eptTSSCpg;
  end else if TDBDString.StartsWith(Cyp,'1.') then begin
    Result := eptTSSC;
  end else if TDBDString.isDigit(Cyp,i) then begin
    Result := eptTSN;
  end else begin
//    Result := eptPriceEqu;
    Result := eptPriceMat;
  end;
end;

function PriceItemTypeToString(const pt: TEstimatePriceItemType): string;
begin
  case pt of
    epiPrice: ;
    epiWorkersSalary: Result := 'ЗП';
    epiMachinistSalary: Result := 'В.Т.Ч ЗПМ';
    epiOverhead: Result := '';
    epiProfit: Result := '';
    epiMachines: Result := 'ЭМ';
    epiMaterial: Result := 'МР';
    epiConstruction: Result := '';
    epiInstallation: Result := '';
    epiEquipment: Result := '';
    epiOPWorkSalary: Result := '';
    epiOPMachSalary: Result := 'НР И СП ОТ ЗПМ ( 98% И  77%)';  /////
    epiOverheadWorkSalary: Result := 'НР ОТ ЗП (Н16)';
    epiOverheadMachSalary: Result := '';
    epiProfitWorkSalary: Result := 'СП ОТ ЗП';
    epiProfitMachSalary: Result := '';
    epiOther: ;
  end;
end;

  { TabcHeaderParam }

procedure TabcHeaderParam.Clear;
begin
  Caption:=''; Options:=[]; Position:=0; Offset:=0; Value:=''; Kind:=0; Width:=0;
end;

constructor TabcHeaderParam.Create(const aCap: string; const aKind: Byte; const aOpt: TabcParamOptions; const aPos, aWidth, aOffset: Integer);
begin
  Caption:=aCap; Kind:=aKind; Options:=aOpt; Position:=aPos; Offset:=aOffset; Value:=''; Width:=aWidth;
end;

function TabcHeaderParam.ReadLine(const S: string; const Start: Boolean; const NextParam: PabcHeaderParam): Boolean;
var i, iStart, iNext: Integer;
begin
  Result:=False;
  if Start then begin  // начинаем поиск строки, содержащий название параметра
    if S='' then Exit;
    if Position=0 then iStart:=1 else iStart:=Position;
    i:= StrUtils.PosEx(Caption,S,iStart);
    if i>=iStart then Result := true else Exit;
    iStart:=iStart+Length(Caption);
    if Kind=0 then Value:='1'
    else if Width>0 then Value:= Trim(Copy(S,iStart,Width))
                    else Value:= Trim(Copy(S,iStart, Length(S)-iStart+1));
  end else begin     // продолжаем собирать значение параметра
    iStart := Position+Length(Caption)+Offset;
    i:=1;
    Result := TDBDString.SkipWhiteSpaces(S,i);                    //в строке продолжения текст должен начинаться после отступа
    if not Result then begin
      Result:= not (abcpoNoEmptyLine in Options);
      if Result then Value:=Value+#13#10;
      Exit;
    end;
    if NextParam<>nil then begin
      if NextParam^.Position=0 then iNext:=1 else iNext:=NextParam^.Position;
      Result:= iNext>i;
      if Result then Result:=StrUtils.PosEx(NextParam^.Caption,S,iNext)<iNext;
      if not Result then Exit;         //переходим к следующему параметру
    end;
    if Position>0 then begin
      Result := (i>=iStart);
      if not Result then Exit;
    end else iStart:=1;
    if Width>0 then Value:= Value + ' ' + Trim(Copy(S,iStart,Width))
               else Value:= Trim(Copy(S,iStart, Length(S)-iStart+1));
  end;
end;

function TabcHeaderParam.ReadStrings(Text: TStrings; var iLine: Integer; const LastLine: Integer; NextParam: PabcHeaderParam): Boolean;
var i,iEnd, iSt, iCnt, iNext, j, wdt: Integer; s: string;
begin
  Assert(iLine>=0, 'Номер текущей строки списка строк для извлечения параметра не верен: (<0)');
  Assert(Text<>nil, 'Список строк для извлечения параметра на задан');
  Result:=False;
  iEnd:=Text.Count-1; i:=iLine;
  if (LastLine>0) and (LastLine<iEnd) then iEnd:= LastLine;
  if Position=0 then iSt:=1 else iSt:=Position;
  while i<=iEnd do begin
    s:=Text[i];
    if isTabLine(s) then Exit;
    if not Result then begin
       if not DBDisEmpty(s) then begin
         j:=StrUtils.PosEx(Caption,S,iSt);
         if j>=iSt then begin
           Result := true;
           iNext:=Length(Caption);
           iSt:=j+iNext;
           if Kind=0 then begin Value:='1'; Break; end
           else if Width>0 then Value:= Trim(Copy(S,iSt,Width))
                           else Value:= Trim(Copy(S,iSt, Length(S)-iSt+1));
           if not (abcpoMultiLine in Options) then Break;
           if (Offset<=-100) or (Offset>=100) then begin iCnt:=1; wdt:=0; end
           else if Offset<0 then begin iCnt:=iSt+Offset; wdt:= Width-Offset; end
           else begin iCnt:=iSt+Offset; wdt:= Width; end;
           if NextParam=nil then iNext:=1
           else if NextParam^.Position=0 then iNext:=1
           else iNext:=NextParam^.Position;
         end else begin
           //текст который не содержит искомой информации
         end;
       end;
    end else begin
      if DBDisEmpty(s) then begin
        if abcpoNoEmptyLine in Options then Break;
        Value:=Value+#13#10;
      end else begin
        iSt:=1; DBDSkipWhiteSpaces(S,iSt);
        if (iSt<iCnt) or (iSt>iCnt+10) then Break;                //!!!!
        if NextParam=nil then begin
          if Wdt>0 then Value:= Value + ' ' + Trim(Copy(S,iSt,Wdt))
                   else Value:= Value + ' ' + Trim(Copy(S,iSt, Length(S)-iSt+1));
        end else if (StrUtils.PosEx(NextParam^.Caption,S,iNext)<iNext) then begin
          if Wdt>0 then Value:= Value + ' ' + Trim(Copy(S,iSt,Wdt))
                   else Value:= Value + ' ' + Trim(Copy(S,iSt, Length(S)-iSt+1));
        end else begin
             //нашли следующий
             Break;
        end;
      end;
    end;
    Inc(i);
  end;
  if Result then iLine:=i;
end;

{ TabcTabLine }

constructor TabcTabLine.Create(const S: string);
begin
  Line:=S;
end;

function TabcTabLine.GetAsCurrency(const Index: word): Currency;
var i,l: Integer; s: string; d: Double;
begin
  Assert(index<=High(abcCols),'Неверный индекс колонки');
  i:=abcCols[Index].iStart; l:=abcCols[Index].iLen;
  s:=Copy(Line,i,l); i:=1;
  if DBDReadDouble(s,i,d) then Result := d
                          else Result := 0;
end;

function TabcTabLine.GetAsDouble(const Index: word): Double;
var i,l: Integer; s: string; d: Double;
begin
  Assert(index<=High(abcCols),'Неверный индекс колонки');
  i:=abcCols[Index].iStart; l:=abcCols[Index].iLen;
  s:=Copy(Line,i,l); i:=1;
  if DBDReadDouble(s,i,d) then Result := d
                          else Result := 0;
end;

function TabcTabLine.GetAsInteger(const Index: word): Integer;
var i,l: Integer; s: string; c: Cardinal;
begin
  Assert(index<=High(abcCols),'Неверный индекс колонки');
  i:=abcCols[Index].iStart; l:=abcCols[Index].iLen;
  s:=Trim(Copy(Line,i,l)); i:=1;
  if DBDReadInteger(s,i,l) then Result := l
                          else Result := 0;
end;

function TabcTabLine.GetAsString(const Index: word): string;
var i,l: Integer;
begin
  Assert(index<=High(abcCols),'Неверный индекс колонки');
  i:=abcCols[Index].iStart; l:=abcCols[Index].iLen;
  Result:=Copy(Line,i,l);
end;

{ TabcTableCol }

constructor TabcTableCol.Create(const aSt, aLn, aKd: Word);
begin
  iStart:=aSt; iLen:= aLn; Kind:=aKd;
end;


initialization
InitUnit;
end.