Галактика в вопросах и ответах

Код: Выделить всё

      If sqlCreateTmpTable(  'Table tblTempMC1 (cMC : Comp, cMOL : Comp, cParty : Comp, cPodr : Comp, cOrg : Comp, ' +
                          ' sOrgName : String, sDocNumber : String, dDocDate : Date, wDocType : Word, sDocTypeName : String, ' +
                          ' sNomNumber : String, sMCName : String, sCOCode : String, sCOName : String, ' +
                          ' dblRestBeg : Double, dblRestEnd : Double, dblKolFact : Double, ' +
                          ' dblPrice : Double, dblTotal : Double, dblSumByMC : Double, sDogNumber  : String);',
                           ctmNormal
                       ) = tsOk Then
        sqlDropTmpTable ( 'tblTempMC1' );

Код: Выделить всё

function sqlCreateTmpTableAs(tableName: string; tableNum: integer; mode: word): integer;

Код: Выделить всё

function ReinitTableAsTmp(tableNum: integer; tableName: string): word;

Код: Выделить всё

Interface MemoryTablesAndGroup 'Таблицы в памяти и группировка данных' ('', hcNoContext, sci1Esc);
  Show at(,,60,5);

  table struct MySuperPick = Pick;

  Create view
  As select *
  From
    oborot (readOnly) //во избежание непреднамеренной порчи данных...
  , pick
  , MySuperPick

  //При сортировке открытой в ТП физической таблы не по индексу (см SchetSubschKau1), обязательно ограничения
  //реализуем через баунды, иначе при восстановлении режима работы, выхватим ошибку.
  bounds B1 =
    0000000000000000h           == oborot.CPLANSSCH and  //План счетов
    date(01,01,Year(cur_date)) <<= oborot.datob and
    date(31,12,Year(cur_date)) >>= oborot.datob

  //Дефайн, чтобы не ломалась структура кода, на работу программы он не влияет
  #define def_order order SchetSubschKau1 external by = oborot.SCHETO, oborot.SUBOSSCH, oborot.KAUOS[1]
  #def_order
  ;

  file ResultFile;

  Screen scMemoryTablesAndGroup '' ('', hcNoContext, sci1Esc);
    Show at(,,,);
    noTableNavigation ;
  Fields
  Buttons
    cmOborot     , [singleLine];
    cmPick       , [singleLine];
    cmMySuperPick, [singleLine];
  <<
 <.Поехали.> Выгрузить OBOROT в ТП и вывести отчет в разрезе Счёт/Субсчёт/Кау1

 <.Поехали.> Переключить таблицу PICK в режим работы в BD

 <.Поехали.> Открыть несловарную временную таблицу во VIEW
  >>
  End;

  function FSUMM(value : double) : string;
  {
    result := DoubleToStr(value, '[|-]366666666666666666666.\2p88')
  }

  procedure MyLogStrToFile(value : wideString) ;
  {
    ResultFile.WriteLn(value);
  }

  #declare WriteToFile(Indent, grName, Itog)
    MyLogStrToFile(
      #Indent+' '
    + 'Сумма = "' + FSUMM(#grName.grSum(Oborot.SUMOB))+ '" '
    + 'Минимум = "' + FSUMM(#grName.grMin(Oborot.SUMOB))+ '" '
    + 'Среднее = "' + FSUMM(#grName.grAvg(Oborot.SUMOB))+ '" '
    + 'Максимум = "' + FSUMM(#grName.grMax(Oborot.SUMOB))+ '" '
    + 'Количество = "' + FSUMM(#grName.grCount(Oborot.SUMOB))+ '" '
    + 'ПерваяСумма = "' + FSUMM(#grName.grFirst(Oborot.SUMOB))+ '" '
    + 'ПоследняяСумма = "' + FSUMM(#grName.grLast(Oborot.SUMOB)) + '"/>'
    );
  #end

  HandleEvent // Interface

    cmOborot :
    {
      ResultFile.OpenFile('Oborot.txt', stCreate)
      //Открываем таблицу oborot, как таблицу в памяти
      if ReinitTable(tnOborot, fmMemory) <> tsOk then exit;

      //Накладываем ограничения
      PushBounds(tbB1);

      //Закачиваем во временную таблицу данные С УЧЁТОМ ОГРАНИЧЕНИЙ!
      //mfFilters - посмотрит на ограничений во view и загрузит только данные,
      //удовлетворяющие им. Если нужны все данные - mfNormal.
      //mfFilters + mfClear закачает данные и очистит таблицу в памяти перед закачкой.
      //На стороне СУБД отработает запрос а-ля:
      //SELECT T0.* FROM OBOROT T0 WHERE T0."SCHETO"=:P1 AND T0."DATOB">=:P2 AND T0."DATOB"<=:P3 ORDER BY T0."SCHETO",T0."DATOB"
      //Важный момент. В ограничения 100% попадают ТОЛЬКО ПОДЦЕПКИ! Узловые фильтры не всегда попадают, однако результирующий набор данных
      //будет такой, как будто попали.
      if mtRetrieve(tnOborot, mfFilters + mfClear) <> tsOk then exit;

      //Ограничения нам тут больше не нужны, т.к. в ТП есть только те данные,
      //которые этим ограничениям соответствуют. Ну или можно другие наложить, если нужно...
      ResetBounds(tbB1);

      //Чтобы группировки работали предсказуемо, нужно предварительно сортировать данные в разрезах группировок
      if mtSetTableOrder(tnOborot, tiSchetSubschKau1) <> tsOk then exit;

      StartNewVisual(vtIndicatorVisual, vfTimer + vfBreak + vfConfirm, 'Формирование отчёта', recordsInTable(tnOborot) );

      //Тут цикл идет по таблице в памяти, а не по таблице в БД
      _loop Oborot{

        MyLogStrToFile('<Счёт Код ="' + Oborot.SCHETO + '">')

        var tmpSubSch : string;
        //Группируем данные по счёту
        groupBy grScheto : Oborot.SCHETO {
          MyLogStrToFile(chr(9)+'<Субсчёт Код = "' + Oborot.SUBOSSCH + '">')

          //Группируем данные по субсчёту
          groupBy grSubOsSch : Oborot.SUBOSSCH {

            //Функции группировки для сложных типов(строка - это массив чаров, дата - вордов и т.д.) недоступны
            //Поэтому для использования таких типов нужно их запоминать в переменные.
            tmpSubSch := Oborot.SUBOSSCH;
            MyLogStrToFile(chr(9)+chr(9)+'<КАУ Код = "' + string(Oborot.KAUOS[1],0,0) + '">')
            //Группируем данные по КАУ1
            groupBy grKau1 : Oborot.KAUOS[1] {

              //Обновление глобальной визуализации следует размещать
              //в нижнем уровне группировки
              if not NextVisual then break;
              SetVisualHeader(
                'Обработка'
              + ''#13'Счет: ' + Oborot.SCHETO + '.' + Oborot.SUBOSSCH
              + ''#13'КАУ1: ' + string(Oborot.KAUOS[1],0,0)
              );

              MyLogStrToFile(
                chr(9)+chr(9)+chr(9)+'<ТекущаяСумма nRec = "' + string(Oborot.nRec,0,0) + '" '
              + 'Сумма = "' + FSUMM(Oborot.SUMOB) + '" '
              + 'НарастающийИтог = "' + FSUMM(grKau1.grSum(Oborot.SUMOB))+ '"/>'
              )
            }
            #WriteToFile(chr(9)+chr(9)+chr(9)+'<ИтогоСумма',grKau1, string(grKau1.grFirst(Oborot.KAUOS[1]),0,0))
            MyLogStrToFile(chr(9)+chr(9)+'</КАУ>')
          }
          #WriteToFile(chr(9)+chr(9)+'<Итого',grSubOsSch, tmpSubSch)
          MyLogStrToFile(chr(9)+'</Субсчёт>')
        }
        #WriteToFile(chr(9)+'<Итого', grSubOsSch, Oborot.SCHETO)
        MyLogStrToFile('</Счёт>')
      }
      StopVisual( '', 0 );

      //ProcessText('Oborot.txt', vfDefault + vfNewTitle, 'Отчёт по оборотам');
      ResultFile.Close;
      //Удаляем созданный индекс в памяти
      mtDropIndex(tnOborot, tiSchetSubschKau1);

      //Открываем таблицу в обычном режиме, т.е. в режиме работы в БД.
      if ReinitTable(tnOborot, fmNormal) <> tsOk then exit;
    }

    cmPick :
    {
      delete all from pick;

      insert Pick set cRec := 0064000000000003h;
      insert Pick set cRec := 0064000000000004h;
      insert Pick set cRec := 0064000000000005h;
      insert Pick set cRec := 0064000000000006h;
      insert Pick set cRec := 0064000000000007h;
      insert Pick set cRec := 0064000000000008h;
      insert Pick set cRec := 0064000000000009h;
      insert Pick set cRec := 006400000000000Ah;
      insert Pick set cRec := 006400000000000Bh;
      insert Pick set cRec := 006400000000000Ch;

      //По умолчанию, таблицы с флагом "Пользовательская таблица", "Временная таблица"
      //открываются, как таблицы в памяти (DataBase.TempTableInMem, DataBase.UserTableInMem).
      //Поэтому тут принудительно сбрасываем все изменения в БД.
      //Можно вызвать сразу после, например, выбора с пометкой записей.
      //При этом, изменения из верхнего delete all тоже залетают, т.е. в базе у нас будет 10 записей.
      mtFlush(tnPick, mfBulkCopy+mfCreateNREC);

      //И эти записи теперь доступны на стороне БД
      var q : iQuery = queryManager.CreateQuery('select name from katmc where exists(select 1 from pick where crec = katmc.nrec)');
      var Results : IResultSet = q.getResultSet;

      if Results = nullRef or Results.Count = 0 then exit;

      do {
        logStrToFile('katmc_from_pick.txt', Results.row.ValAt(1))
      } while Results.getPrev = tsOk;
    }

    cmMySuperPick :
    {
      _try {
        //Создаём временную таблицу на сервере СУБД.
        if sqlCreateTmpTableAs('MySuperDBMSPick', tnMySuperPick, ctmNormal ) <> tsOk then _raise ExVip;
        //Связываем временную таблицу в СУБД с таблицей в памяти
        if ReinitTableAsTmp(tnMySuperPick, 'MySuperDBMSPick') <> tsOk then _raise ExVip;

        //А вот тут работаем уже с нашей временной таблицей в СУБД, как будто она словарная
        //Такую штуку можно использовать для фильтрации через жёсткие подцепки.
        delete all MySuperPick;
        insert MySuperPick set cRec := 0064000000000003h;
        insert MySuperPick set cRec := 0064000000000004h;
        insert MySuperPick set cRec := 0064000000000005h;
        insert MySuperPick set cRec := 0064000000000006h;
        insert MySuperPick set cRec := 0064000000000007h;
        insert MySuperPick set cRec := 0064000000000008h;
        insert MySuperPick set cRec := 0064000000000009h;
        insert MySuperPick set cRec := 006400000000000Ah;
        insert MySuperPick set cRec := 006400000000000Bh;
        insert MySuperPick set cRec := 006400000000000Ch;

        //Вставили VIP'ом, а читаем напрямую с сервера для наглядности
        var q : iQuery = queryManager.CreateQuery('select cRec from MySuperDBMSPick');
        var Results : IResultSet = q.getResultSet;

        if Results = nullRef or Results.Count = 0 then _raise ExVip;

        do {
          logStrToFile('MySuperDBMSPick.txt', string(Results.row.ValAt(1),0,0))
        } while Results.getPrev = tsOk;
      }
      //Удаляем временную таблицу на сервере СУБД
      _finally sqlDropTmpTable('MySuperDBMSPick');
    }
  End;
End.