{ выбор учреждений из списка }

function ChoiceGrantInvestmentListEx( aDirIni: string;
                                      aBudget_ID: string;
                                      aOrgID_Uchr: string = '';
                                      aOutListKbk: boolean = TRUE;
                                      aOutAllCodes: boolean = TRUE): string;
var
  xSQL: string;
  xXml: Variant;
  xFilter: TStringList;
  xQuery: TRunQuery;
  xSubSQL: string;
begin

    try
      // exchange #2724
      // из-за проблем перевода даты из variant, приходится вместо QueryXml
      // делать запрос через TRunQuery.
      // эта реализация не нужна, но оставлена для возможной доработки
      // проверки НПА
      // exchange #2896
      // проверка дат закрытия и открытия строк НПА добавлена в запрос.
      // в результате, в списке выбора будут видны только те коды,
      // которые реально будут выгружены.

      xQuery:= TRunQuery.Create;
      try
        // exchange #3027
        // если "выгружать кбк из списка"=нет и выгружать все коды
        // - выгружаем все коды у которых дата выгрузки не указана
        if (NOT(aOutListKbk) AND aOutAllCodes)
          then xSubSQL := ' and G.SEND_DATE is null'
          else xSubSQL := '';

        xSQL :=
           // exchange #3027
           // добавлена дата выгрузки
           ' Select G.ID, G.CODE, G.CAPTION, G.SEND_DATE,'
          +' (case G.ftype when 0 then '#39'госзадание'#39
          +' when 1 then '#39'бюджетные инвестиции'#39
          +' when 2 then '#39'субсидии на иные цели'#39
          +' else '#39#39' end) FTYPE, O.DESCRIPTION '
      //     'Select G.ID, G.CODE, G.caption, G.ftype, O.description '
          +' From Grantinvestment G '
          +' left Join ORG O on G.org_id=O.id '
          +' where '//--G.code<>'+#39+'0' + #39 +' and '
      //    +'(not G.code is null or G.code<>' + #39#39 + ') and G.budget_id=?';
          +' not G.code is null and G.budget_id=?'
          // exchange #2477
          // При выгрузке проверять наличие признака «Контроль в ФК» в карточке
          // «Кода субсидии», если признак активен – выгружать значение, если нет,
          // не выгружать.
          +' and G.CONTROLFK=1'
              // exchange #2645
              // добавлена проверка даты закрытия и открытия строк НПА
              // допускается выгружать только одну строку, вот и приходится проверять
              // какую из нескольких выбрать.
              // эта реализация не нужна, но оставлена для возможной доработки
              // проверки НПА
              // exchange #2896
              // проверка дат закрытия и открытия строк НПА добавлена в запрос.
              // в результате, в списке выбора будут видны только те коды,
              // которые реально будут выгружены.
          +'   and      not exists('
          +' select gl.* from GRANTINV_LAWACT GL'
          +' left join PL_LAWACT L on GL.LAWACT_ID = L.ID'
          +' where GL.GRANTINVESTMENT_ID = G.ID and'
          +'       ((L.START_DATE is not null and L.START_DATE > ?) or'
          +'       (L.END_DATE is not null and L.END_DATE <= ?)))'
          + xSubSQL;

        xQuery.AddStr( aBudget_ID);
        xQuery.AddDate( Work_Date);
        xQuery.AddDate( Work_Date);

        if (LENGTH( TRIM( aOrgID_Uchr)) > 0) then begin
      	  xSQL := xSQL + ' and o.id=?';
      	  xQuery.AddStr( aOrgID_Uchr);
      	end;

        xXML := QueryRun( xQuery, xSQL);
        finally
          xQuery.Free;
      end;

//    xXML := QueryXml( xSQL, [ aBudget_ID]);

      xFilter:= TStringList.Create;
      try
        ChoiceGrantInvestmentList( 'Список субсидий и инвестиций для экспорта.',
                                   aDirIni,
                                   xXml.documentElement,
                                   xFilter,
                                   aOutListKbk);
        Result := StringReplace( StringReplace( TRIM( xFilter.Text), #13#10, ','),
                                 ',,', '');
        finally
          xFilter.Free;
      end;
      except
        ExceptionProc( 'ChoiceGrantInvestmentListEx');
    end;


end;

function ChoiceGrantInvestmentList( xCaption: string;
                                    xDirIni: string;
                                    xXml: Variant;
                                    xFilter: TStringList=nil;
                                    aOutListKbk: boolean = TRUE): variant;

function BookmarkCheckEvents: Boolean;
begin
  Result := true;
end; {End BookmarkCheckEvents}

  procedure  DoStorySelected( xCdsList: TClientDataSet; xDBGrid: TDBGridEh; xTo: TStringList);
  var i: integer;
  begin
    for i:= 0 to xDBGrid.Bookmark.Count-1 do
      if xCdsList.Locate( xDBGrid.FieldKey.FieldName, xDBGrid.Bookmark[i], nil)
        then xTo.Add( xCdsList.FieldByName('ID').AsString);
  end;

var
  xForm: TForm;
  xCdsList: TClientDataSet;
  xDBGrid: TDBGridEh;
  iRow: integer;
  xXML_Item: variant;
  SL: TStringList;
  xResultRoot: variant;
  xLbOrgID: TLabel;
begin

    try
      Result := null;

      // если выбор из списка = нет - выбираем все коды для выгрузки.
      // при этом форму не открываем
      if NOT aOutListKbk then begin
        xFilter.Clear;
        for iRow := 0 to xXML.childNodes.Length - 1 do begin
          xXML_Item := xXML.childNodes.Item[iRow];
          xFilter.Add( xXML_Item.getAttribute('ID'));
        end;//for//
        Result := CreateOleObject('Microsoft.XmlDom');
        Result.LoadXML( xXml.Xml);
        EXIT;
      end;

      xForm := TFormCustomList.Create(Application);
      try
        LoadForm(xDirIni + 'Forms\Fm_GrantInvestmentList.dfm', xForm);
        xForm.Caption := '  Субсидии и инвестиции';
        xLbOrgID:= TLabel( xForm.FindComponent('LbOrgID'));
        xLbOrgID.Caption := xCaption;
        xCdsList := TClientDataSet( xForm.FindComponent('cdsData'));
        xDBGrid  := TDBGridEh( xForm.FindComponent('DBGrid'));
        xDBGrid.onBookmarkCheckEvents := @BookmarkCheckEvents;
      //  CdsFilterData := TClientDataSet(Fm_FilterKbk.FindComponent('CdsData'));
      except
        showmessage(LastException.Message);
        exit;
      end;

      try
        xCdsList.Filter := '';
        // это нужно чтобы внутри формы создался объект для работы с таблицей!
        xForm.Show;
        xForm.Close;

        xCdsList.DisableControls;
        xDBGrid.Enabled := False;
        try
          try
            xCdsList.First;
            while not xCdsList.Eof do xCdsList.Delete;
          except
            showmessage(LastException.Message);
            exit;
          end;

          for iRow := 0 to xXML.childNodes.Length - 1 do begin
            xXML_Item := xXML.childNodes.Item[iRow];
            try
              xCdsList.Append;
              xCdsList.FieldByName('CODE').AsString:= xXML_Item.getAttribute('CODE');
              xCdsList.FieldByName('CAPTION').AsString:= xXML_Item.getAttribute('CAPTION');
              xCdsList.FieldByName('DESCRIPTION').AsString:= xXML_Item.getAttribute('DESCRIPTION');
              xCdsList.FieldByName('FTYPE').AsString:= xXML_Item.getAttribute('FTYPE');
              xCdsList.FieldByName('ID').AsString:= xXML_Item.getAttribute('ID');

              // exchange #3027 - добавлена дата выгрузки
              if (VarToStr( xXML_Item.getAttribute('SEND_DATE')) <> '')
                then xCdsList.FieldByName('SEND_DATE').AsDateTime :=
                        XmlToDateTime( xXML_Item.getAttribute('SEND_DATE'));

              xCdsList.Post;
              except
                showmessage(LastException.Message);
                exit;
            end;
          end;//for//

        xDBGrid.Bookmark.Clear;
        if (xFilter <> nil) then
          for iRow:= 0 to xFilter.Count-1
            do xDBGrid.Bookmark.Add( xFilter.Strings[iRow]);
          finally
      //      xCdsList.First;
      //      DBGridFilter.Enabled := True;
            xCdsList.EnableControls;
            xDBGrid.Enabled := True;
        end;

        if (xForm.ShowModal = mrCancel) then Exit;

        if (xFilter <> nil) then begin
          xFilter.Clear;
          if (xDBGrid.Bookmark.Count <= 0) then begin
            xCdsList.First;
            while not xCdsList.Eof do begin
              xFilter.Add( xCdsList.FieldByName('ID').AsString);
              xCdsList.Next;
            end;
            Exit;
          end;
          DoStorySelected( xCdsList, xDBGrid, xFilter);
          EXIT;
        end;

        // фильтр xml
        Result := CreateOleObject('Microsoft.XmlDom');

      //  showmessage(result.xml);

        if (xDBGrid.Bookmark.Count <= 0) then begin
          Result.LoadXML( xXml.Xml);
          EXIT;
        end;

        xResultRoot := Result.appendChild( Result.CreateElement( 'EXCHQUERY'));

        SL := TStringList;
        try
          DoStorySelected( xCdsList, xDBGrid, SL);
          try
            for iRow := xXML.childNodes.Length - 1 downto 0 do begin
              xXML_Item := xXML.childNodes.Item[iRow];
              if (SL.IndexOf( xXML_Item.getAttribute('ID')) >= 0)
                then xResultRoot.appendChild( xXML_Item.CloneNode(false));
            end;
            except
              showmessage(LastException.Message);
              exit;
          end;
          finally
            SL.Free;
        end;
        finally
          xForm.Free;
      end;
      except
        ExceptionProc( 'ChoiceGrantInvestmentList');
    end;

end; {End initialization}


//var zXml,zRes: Variant;
//  zFilter: TStringList;
begin
  {
//  Xml := LoadXmlTest(TestFileName);
  zXml := CreateOleObject('Microsoft.XmlDom');
  zXml.Load('C:\Temp\GrantInvestmentList.xml');
//  zFilter:= TStringList.Create;
//  zFilter.Add('1');
//  zFilter.Add('3');
//  ChoiceGrantInvestmentList('D:\work\AzkScript\FK2009\', zXml, zFilter);
  zRes:= ChoiceGrantInvestmentList('test','D:\work\AzkScript\FK2009\', zXml.childNodes.Item[0], nil);//zFilter);
//  showmessage(zFilter.Text);
  showmessage(zRes.xml);
//  showmessage(zXml.xml);
   }
end.
