-- Шаблон создан мастером бланков
-- 10.10.2005 15:31:46
--
BlankWithTemplate "Программный генератор двухмерного штрих кода Aztec";


-- Для работы библиотеки необходимо скопировать в системный каталог Windows 
-- (обычно, C:\Windows\System для Windows 98/Me или C:\WINNT\System32 для Windows NT/2000) 
-- следующие файлы:
--        AztEn32.dll,
--        VCompLib.dll,
--        VAztecBarCode.dll.
--        TBAztecBarCode.dll

-- OLEAutomation Объект: TBAztecBarCode.Application
-- Метод: CreateAztecBarCodeFiles(aFileName: String; aOutDirMask: String; aOrientation: Integer): Integer;
--
-- Данная функция предназначена для формирования файлов с изображениями (Bitmap) штрих-кода 
-- в стандарте Aztec из текстовых файлов установленного формата налоговой декларации.
-- Параметры:
--  aFileName   - Задается полный путь и имя файла текстового файла 
--                  (сформированного в соответствии с установленным форматом) 
--                  налоговой декларации, для которого формируются штрих-коды;
--  aOutDirMask - Задается полный путь к выходному каталогу и маска для формируемых 
--                  файлов с изображениями штрих-кодов. В маске имени файла можно 
--                  использовать символ %, который будет заменен номером файла 
--                  (4-х значное число с ведущими нулями).
--
-- Примеры возможных значений параметра OutDirMask.
--
--  OutDirMask              Имя файла
--  D:\Images\image%        D:\Images\image0001.bmp
--  D:\Images\image%th.bmp  D:\Images\image0001th.bmp
--
--  Orientation - ориентация штрих-кодов (0 - горизонтальная, 1 - вертикальная).
-- В случае необходимости изменения ориентации отдельных картинок для размещения 
--   на листах декларации нужно программным способом считанную из файла картинку 
--   (Bitmap) повернуть на 90 градусов в любую сторону.
-- Для считывания штрих-код ориентация значения не имеет.


  Inited: Logical = [False];

  proc Init;
    var vFileName :String;

    if РАБ.AztecBarCode.Inited then
      Exit;
    else
      ExecuteProgram(Format('RegSvr32.exe /s "%s"', 'TBAztecBarCode.dll'), True);
      РАБ.AztecBarCode.Inited = True;
    end;
  end; -- Init

  func CreateAztecBarCodeFiles(aFileName: String; aOutDirMask: String; aOrientation: Integer): Integer;
    var vAztecBarCodeApp :AutoObject;
    var vResult          :Integer;

    Init;

    vAztecBarCodeApp = CreateAutoObject('TBAztecBarCode.Application');
    try
      vResult = AsInteger(vAztecBarCodeApp.CreateAztecBarCodeFiles(aFileName, aOutDirMask, aOrientation));
    finally
      ClearVariable(vAztecBarCodeApp);
    end;

    Return(vResult);
  end; -- CreateAztecBarCodeFiles

  ---------------------------------------------------------------------------------
      BarCode1          :Object;
  ---------------------------------------------------------------------------------
  var BarCodePath       :String  = PlanVar('Cache')+"\CreateBarCode";            --
  var BarCodeW_V_A4     :Integer = 2000;                                         --
  var BarCodeW_G_A4     :Integer = 2870;                                         --
  var BarCodeSpace      :Integer = 150;                                          --
  var BarCodeWidth      :Integer = 100;                                          --
  var BarCodeCounts     :Integer = 3;                                            -- Количество бар-кодов на странице
      BarCodeMaximum    :Integer; --                                             --
      BarCodeObjects[]  :Logical; -- Видимость объекта       (True-вид.)         --
      BarCodePrint[]    :Logical; -- Какие бар-коды печатать (True-печ.)         --
      BarCodePrinted[]  :Logical; -- Какие печатать в текущий момент запуска.... --
      BarCodeOrient[]   :Logical; -- Ориентация бар-кодов    (True-верт)         --
      BarCodeRepeat[]   :Integer; -- Повторение              (>1  -есть)         --
      BarCodeSequence[] :Integer; -- Последовательность блока страниц            --
  ---------------------------------------------------------------------------------
      BarCodeBMP[]      :String;
      BarCodeBMP_O[]    :Logical; -- Ориентация картинки с бар-кодом
      BarCodeBMP_W[]    :Numeric; -- Ширина
      BarCodeBMP_H[]    :Numeric; -- Высота
      BarCodeBMP_P[]    :Logical; -- Использовано
  ---------------------------------------------------------------------------------

  proc BarCode_ClearArrays;
    ClearVariable(Раб.AztecBarCode.BarCodeMaximum);
    ClearVariable(Раб.AztecBarCode.BarCodeObjects);
    ClearVariable(Раб.AztecBarCode.BarCodePrint);
    ClearVariable(Раб.AztecBarCode.BarCodePrinted);
    ClearVariable(Раб.AztecBarCode.BarCodeOrient);
    ClearVariable(Раб.AztecBarCode.BarCodeRepeat);
    ClearVariable(Раб.AztecBarCode.BarCodeSequence);
    ClearVariable(Раб.AztecBarCode.BarCodeBMP);
    ClearVariable(Раб.AztecBarCode.BarCodeBMP_O);
    ClearVariable(Раб.AztecBarCode.BarCodeBMP_W);
    ClearVariable(Раб.AztecBarCode.BarCodeBMP_H);
    ClearVariable(Раб.AztecBarCode.BarCodeBMP_P);
  end;

  proc BarCode_DeleteTemp;
    BarCode_ClearArrays;
    if ExistsFolder(BarCodePath) then
      DeleteFolder(BarCodePath);
    end;
  end;

  func BarCode_CreateTemp :String;
    var vErrorCode :String;

    BarCode_DeleteTemp;
    if ExistsFolder(BarCodePath) then
      vErrorCode = "Ошибка обращения к папке '"+BarCodePath+"'";
    else
      CreateFolder(BarCodePath);
    end;
    Return(vErrorCode);
  end;

  proc BarCode_Destroy(aBlankName :String);
    var I       :Integer;
    var vObject :Object;

    for I=1..LengthOfArray(BarCodeObjects) do
      if FindObject(aBlankName+".BarCode"+Str(I), vObject) then
        vObject.Visible = False;
        vObject.CanPrint= False;
      end;
    end;
    BarCode_DeleteTemp;
  end;

  proc BarCode_AddList(aPrint  :Logical;
                       aVert   :Logical;
                       aCount  :Integer;
                       aRepeat :Integer);

    var K, I, vIndex :Integer;

    for K=1 to aCount do
      for I=1 to BarCodeCounts do
        vIndex                  = LengthOfArray(BarCodePrint)+1;
        BarCodePrint[vIndex]    = if(aPrint,  True,    False);
        BarCodeOrient[vIndex]   = if(aVert,   True,    False);
        BarCodeRepeat[vIndex]   = if(aPrint,  aRepeat, 0);
        -- Последовательность прохода бар-кодов
        vIndex                  = LengthOfArray(BarCodeSequence)+1;
        BarCodeSequence[vIndex] = aCount;
      end;
    end;
  end;

  proc BarCode_PagesToPrint(aPageFrom :Integer;
                            aPageTo   :Integer);
    var I, J, Index :Integer;

    ClearVariable(Раб.AztecBarCode.BarCodePrinted);
    for I=1..aPageFrom-1 do
      for J=1..BarCodeCounts do
        Index                 = LengthOfArray(BarCodePrinted)+1;
        BarCodePrinted[Index] = False;
      end;
    end;
    for I=aPageFrom..aPageTo do
      for J=1..BarCodeCounts do
        Index                 = LengthOfArray(BarCodePrinted)+1;
        BarCodePrinted[Index] = True;
      end;
    end;
  end;

  func BarCode_РазбитьКоличествоНаЛист(aBlankName    :String;
                                       aIndex        :Integer;
                                       aObjectsCount :Integer;
                                       aFileCount    :Integer):Integer;
    var I, J, Index, vList :Integer;
    var vCount, vRepeat    :Integer;
    var vObject :Object;

    Index = aIndex;
    while Index<=aObjectsCount and aFileCount>0 and BarCodeSequence[Index]>0 do
      vList = BarCodeSequence[Index];
      for I=1 to vList do
        if FindObject(aBlankName+".BarCode"+Str(Index), vObject) and 
           BarCodePrint[Index] and BarCodeRepeat[Index]>0 and aFileCount>0 then

          if BarCodeRepeat[Index]=1 then
            vRepeat = 1;
          else
            vRepeat = 0;
            vCount  = I;
            for J=1 to BarCodeRepeat[Index] do
              if vCount<=aFileCount and (aFileCount-vRepeat)>0 then
                vRepeat = vRepeat+1;
                vCount  = vCount+vList;
              else
                Break;
              end;
            end;
          end;
          aFileCount            = aFileCount-vRepeat;
          BarCodeRepeat[Index]  = vRepeat;
          BarCodeObjects[Index] = True;
        end;
        Index = Index+BarCodeCounts;
      end;
    end;
    Return(aFileCount);
  end;

  proc BarCode_ОпределитьРазмеры(aIndex     :Integer;
                                 aFileName  :String);
    var vObject :Object;

    if aFileName<>"" then
      if FindObject("BarCode1", vObject) then
        vObject.LoadPicture(aFileName);
        vObject.AutoSize     = True;
        BarCodeBMP_W[aIndex] = AsInteger(vObject.Width);
        BarCodeBMP_H[aIndex] = AsInteger(vObject.Height);
        vObject.AutoSize     = False;
        vObject.Width        = 100;
        vObject.Height       = 100;
      end;
    end;
  end;

  func BarCode_GetIndexNextPictures :Integer;
    var I :Integer;

    for I=1..LengthOfArray(BarCodeBMP) do
      if Not BarCodeBMP_P[I] then
        Return(I);
      end;
    end;
  end;

  Func BarCode_Build(aBlankName :String;
                     aFileMNS   :String):String;
    var vObject                                    :Object;
    var vFileName, vFileMask_V, vFileMask_G        :String;
    var vEnd                                       :Logical;
    var I, vIndex, vIndexBMP                       :Integer;
    var vErrorCode                                 :String;
    var vFileCount, vObjectsCount                  :Integer;
    var vMax_W_V, vMax_H_V, vMax_W_G, vMax_H_G     :Integer;
    var Масшт_В, Масшт_Г, Соотношение              :Numeric;
    var КолДопОбъектов                             :Integer;

    vErrorCode = "";
    if aBlankName<>"" and aFileMNS<>"" then
      vFileMask_V   = BarCodePath+"\ImageV";
      vFileMask_G   = BarCodePath+"\ImageG";

      -- Формируем файлы *.bmp
      Hint("AztecBarCode -> Получение кодов...");
      Раб.AztecBarCode.CreateAztecBarCodeFiles(aFileMNS, vFileMask_V+"%", 1);
      Раб.AztecBarCode.CreateAztecBarCodeFiles(aFileMNS, vFileMask_G+"%", 0);

      -- Считаем количество объектов для расположения бар-кодов
      Hint("AztecBarCode -> Определение количества объектов на форме...");
      vObjectsCount = 0;
      vIndex        = 0;
      vEnd          = False;
      While Not vEnd do
        vIndex = vIndex+1;
        if FindObject(aBlankName+".BarCode"+Str(vIndex), vObject) then
          vObject.Visible        = False;
          vObject.CanPrint       = True;
          BarCodeObjects[vIndex] = False;
          vObjectsCount          = vObjectsCount+1;
        else
          vEnd = True;
        end;
      end;

      -- Проверяем служебные строки на длину...
      if vObjectsCount<>LengthOfArray(BarCodeOrient) or
         vObjectsCount<>LengthOfArray(BarCodeRepeat) or
         vObjectsCount<>LengthOfArray(BarCodePrint)  then

        vErrorCode = "Шаблон настроен неверно. Дальнейшее исполнение невозможно!^M(Объектов на шаблоне: "+Str(vObjectsCount)+")^M(Элементов в массивах: "+Str(LengthOfArray(BarCodeOrient))+", "+Str(LengthOfArray(BarCodeRepeat))+", "+Str(LengthOfArray(BarCodePrint))+")";
      else
        -- Считаем количество картинок с бар-кодами для определения их размещения
        Hint("AztecBarCode -> Получение списка файлов...");
        vIndex = 0;
        vEnd   = False;
        While Not vEnd do
          vIndex    = vIndex+1;
          vFileName = vFileMask_V+Раб.Формат.StrZ(vIndex, 4)+".bmp";
          if ExistFile(vFileName) then
            vFileCount = vFileCount+1;
          else
            vEnd = True;
          end;
        end;

        -- Определяем количество бар-кодов на каждой странице...
        Hint("AztecBarCode -> Определение позиций для размещения на страницах формы...");
        if vFileCount>0 then
          vFileCount = BarCode_РазбитьКоличествоНаЛист    (aBlankName, 1, vObjectsCount, vFileCount);
          if vFileCount>0 then
            vFileCount = BarCode_РазбитьКоличествоНаЛист  (aBlankName, 2, vObjectsCount, vFileCount);
            if vFileCount>0 then
              vFileCount = BarCode_РазбитьКоличествоНаЛист(aBlankName, 3, vObjectsCount, vFileCount);
            end;
          end;
        end;

        -- Определяем ориентацию картинок по зарезервированным местам на шаблоне
        Hint("AztecBarCode -> Определение ориентации для отображения...");
        for vIndex=1..LengthOfArray(BarCodeObjects) do
          if BarCodeObjects[vIndex] then
            for I=1..BarCodeRepeat[vIndex] do
              vIndexBMP               = LengthOfArray(BarCodeBMP_O)+1;
              BarCodeBMP_O[vIndexBMP] = BarCodeOrient[vIndex];  -- Вертикальное ли расположение?
            end;
          end;
        end;

        -- Считываем имена сформированных файлов в массив и еще раз подсчитываем их количество
        Hint("AztecBarCode -> Определение первоначальных размеров...");
        vIndex = 0;
        vEnd   = False;
        While Not vEnd do
          vIndex    = vIndex+1;
          vIndexBMP = LengthOfArray(BarCodeBMP)+1;
          vFileName = if(BarCodeBMP_O[vIndexBMP], vFileMask_V, vFileMask_G)+Раб.Формат.StrZ(vIndex, 4)+".bmp";
          if ExistFile(vFileName) then
            BarCodeBMP[vIndexBMP]   = vFileName;
            BarCodeBMP_P[vIndexBMP] = False;
            BarCode_ОпределитьРазмеры(vIndexBMP, vFileName);
          else
            vEnd = True;
          end;
        end;

        -- Выбираем максимальный рисунок и масштаб...
        Hint("AztecBarCode -> Определение масштаба...");
        vMax_W_V = 0; vMax_H_V = 0;
        vMax_W_G = 0; vMax_H_G = 0;
        for I=1..LengthOfArray(BarCodeBMP_W) do
          if BarCodeBMP_O[I] then -- Вертикальное расположение
            vMax_W_V = Int(Max(BarCodeBMP_W[I], vMax_W_V));
            vMax_H_V = Int(Max(BarCodeBMP_H[I], vMax_H_V));
          else
            vMax_W_G = Int(Max(BarCodeBMP_W[I], vMax_W_G));
            vMax_H_G = Int(Max(BarCodeBMP_H[I], vMax_H_G));
          end;
        end;

        BarCodeMaximum = Int(Max(vMax_H_V, vMax_W_G));
        Масшт_В        = vMax_W_V/BarCodeWidth;
        Масшт_Г        = vMax_H_G/BarCodeWidth;

        Hint("AztecBarCode -> Установка размеров...");
        for I=1..LengthOfArray(BarCodeBMP_W) do
          if BarCodeBMP_O[I] then -- Вертикальное расположение
            Соотношение     = BarCodeBMP_H[I]/BarCodeBMP_W[I];
            BarCodeBMP_W[I] = BarCodeBMP_W[I]/Масшт_В;
            BarCodeBMP_H[I] = BarCodeBMP_W[I]*Соотношение;
          else
            Соотношение     = BarCodeBMP_W[I]/BarCodeBMP_H[I];
            BarCodeBMP_H[I] = BarCodeBMP_H[I]/Масшт_Г;
            BarCodeBMP_W[I] = BarCodeBMP_H[I]*Соотношение;
          end;
        end;
      end;
    else
      if    aBlankName="" then vErrorCode = "Не задано имя бланка";
      elsif aFileMNS=""   then vErrorCode = "Отсутствует файл формата ФНС";
      else
      end;
    end;
    Hint("");
    Return(vErrorCode);
  end;

  proc BarCode_Print(aBlankName  :String;
                     aPrinter    :String;
                     aSchema     :String;
                     aUseBarCode :Logical;
                     aPageFrom   :Integer;
                     aPageTo     :Integer;
                     aPortrait   :Logical;
                     aPrintFrom  :Integer;
                     aPrintTo    :Integer);

    var vObject                                    :Object;
    var I, vIndex, vIndexBMP, vStep                :Integer;
    var vCodeIndex1,  vCodeIndex2,  vCodeIndex3    :Integer;
    var vCodeTop1,    vCodeTop2,    vCodeTop3      :Integer;
    var vCodeLeft1,   vCodeLeft2,   vCodeLeft3     :Integer;
    var vCodeWidth1,  vCodeWidth2,  vCodeWidth3    :Integer;
    var vCodeHeight1, vCodeHeight2, vCodeHeight3   :Integer;
    var vCodePrint1,  vCodePrint2,  vCodePrint3    :Logical;

    if aUseBarCode then
      BarCode_PagesToPrint(aPageFrom, aPageTo);

      for vIndex=1..LengthOfArray(BarCodeObjects) do
        if FindObject(aBlankName+".BarCode"+Str(vIndex), vObject) then -- Найден объект?
          if BarCodePrint[vIndex]    and                              -- Печатать ли вообще текущий объект?
             BarCodePrinted[vIndex]  and                              -- Печатать ли объект в данный момент?
             BarCodeRepeat[vIndex]>0 then                             -- Сколько осталось сделать повторов

--                Trace("Проверка!!! Объект="+Str(vIndex)+"_Повт="+Str(BarCodeRepeat[vIndex]));
            if BarCodeObjects[vIndex] then
              vIndexBMP                 = BarCode_GetIndexNextPictures;
              if vIndexBMP>0 then
                BarCodeBMP_P[vIndexBMP] = True;

                vObject.LoadPicture(BarCodeBMP[vIndexBMP]);
--                Trace("Проверка!!! Объект="+Str(vIndex)+"_Имя="+BarCodeBMP[vIndexBMP]);
                vObject.Visible         = True;
                vObject.Width           = Int(BarCodeBMP_W[vIndexBMP]);
                vObject.Height          = Int(BarCodeBMP_H[vIndexBMP]);

                BarCodePrinted[vIndex]  = False;
                BarCodeRepeat[vIndex]   = BarCodeRepeat[vIndex]-1;

                vStep                   = vIndex-BarCodeCounts*Int(Trunc(vIndex/BarCodeCounts));
                if    vStep=1 then -- Первый код на странице
                  vCodeIndex1      = vIndex;
                  vCodeWidth1      = AsInteger(vObject.Width);
                  vCodeHeight1     = AsInteger(vObject.Height);

                  if BarCodeBMP_O[vIndexBMP] then  -- Вертикальное расположение
                    vObject.Left   = BarCodeW_V_A4-BarCodeWidth-1; -- Координата по ширине
                  else
                    vObject.Left   = BarCodeW_G_A4-BarCodeSpace-vCodeWidth1;
                  end;
                  vCodeTop1        = AsInteger(vObject.Top);
                  vCodeLeft1       = AsInteger(vObject.Left);

                elsif vStep=2 then -- Второй
                  vCodeIndex2      = vIndex;
                  vCodeWidth2      = AsInteger(vObject.Width);
                  vCodeHeight2     = AsInteger(vObject.Height);

                  if vCodeIndex2=vCodeIndex1+1 then -- Если второй элемент на тойже стр., что и первый
                    if BarCodeBMP_O[vIndexBMP] then -- Вертикальное расположение
                      vObject.Left = vCodeLeft1;
                      vObject.Top  = vCodeTop1+BarCodeSpace+BarCodeMaximum;
                    else
                      vObject.Left = BarCodeW_G_A4-BarCodeSpace-BarCodeMaximum-BarCodeSpace-vCodeWidth2;
                      vObject.Top  = vCodeTop1;
                    end;
                  end;
                  vCodeTop2        = AsInteger(vObject.Top);
                  vCodeLeft2       = AsInteger(vObject.Left);

                elsif vStep=0 then -- Третий
                  vCodeIndex3      = vIndex;
                  vCodeWidth3      = AsInteger(vObject.Width);
                  vCodeHeight3     = AsInteger(vObject.Height);

                  if vCodeIndex3=vCodeIndex2+1 then -- Если третий элемент на тойже стр., что и второй
                    if BarCodeBMP_O[vIndexBMP] then -- Вертикальное расположение
                      vObject.Left = vCodeLeft2;
                      vObject.Top  = vCodeTop2+BarCodeSpace+BarCodeMaximum;
                    else
                      vObject.Left = BarCodeW_G_A4-BarCodeSpace-BarCodeMaximum-BarCodeSpace-BarCodeMaximum-BarCodeSpace-vCodeWidth3;
                      vObject.Top  = vCodeTop2;
                    end;
                  end;
                else
                end;
              else
                vObject.Visible = False;
              end;
            else
--                Trace("Проверка!!! Объект="+Str(vIndex)+"_Имя=...");
            end;
          else
            vObject.Visible = False;
          end;
        end;
      end;
    end;
    if aPrintFrom>0 and aPrintTo>0 then
      Print(aBlankName, aSchema, aPrinter, aPortrait, aPrintFrom, aPrintTo);
    else
      Print(aBlankName, aSchema, aPrinter);
    end;
  end;

  proc PDF417_Print(MNS_BlankName:String;aNumber:String;vErrorCode:String;aFileMNS:String;aPrinter:String;НалИнсп:String);
    var vPDFPath, vXMLFile :String;
    var vBarCode           :AutoObject;

    vPDFPath = PlanVar('Общие')+"\PDF417";
    if not ExistsFolder(vPDFPath):
       message("Папка с шаблонами отчетных форм не найдена!^MУкажите путь к папке PDF417 вручную.");
       if ChooseFolder(vPDFPath, "Выбор папки PDF417")=cmOK then
          vPDFPath = vPDFPath;
       else
          Exit;
       end;
    end;
    vXMLFile = vErrorCode;
    vXMLFile = aFileMNS;

    if vPDFPath<>"" and vXMLFile<>"" then
      try
        vBarCode                 = CreateAutoObject("TAXDOCPrt.TAXDOCPrint");
        try
          vBarCode.PrintTiffFolder = vPDFPath;
          vBarCode.SetPrintTiffParam('Наименование налогового органа-получателя', НалИнсп);
          vBarCode.PrintFile(vXMLFile, "", aPrinter, 1);
        finally
          ClearVariable(vBarCode);
          DeleteFile(vXMLFile);
        end;
      except
        message("Генерация баркодов невозможна. Вероятно, не установлены библиотеки для печати баркода.^MУстановку можно произвести инсталлятором Печать НД с PDF417(3.0.9).msi, который находится^Mв папке Free_programs установочного диска.");
        message("Дополнительную информацию можно получить на сайте ГНИВЦ:^Mhttp://www.gnivc.ru/Default.aspx?id=204");
     end;
    end;
  end;

End
