unit uAct1N;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, DateUtils, Grids, DBGrids,
  ADODb, DB, DBGridEh, DBGridEhImpExp, DBGridEhGrouping, ToolCtrlsEh,
  DBGridEhToolCtrls, DynVarsEh, EhLibVCL, GridsEh, DBAxisGridsEh, Vcl.Mask,
  DBCtrlsEh, DBLookupEh, System.UITypes;

type
  TfrmAct1N = class(TForm)
    TopPanel: TPanel;
    Label3: TLabel;
    Label4: TLabel;
    Label7: TLabel;
    FirstPicker: TDateTimePicker;
    SecPicker: TDateTimePicker;
    FindBtn: TSpeedButton;
    BottomPanel: TPanel;
    SverkaDBGridEh: TDBGridEh;
    FilterRG: TRadioGroup;
    CheckItemsGB: TGroupBox;
    CheckAllCB: TCheckBox;
    UnCheckAllCB: TCheckBox;
    ProtokolMemo: TMemo;
    ShowProtokolBtn: TButton;
    PBar1: TProgressBar;
    BottomStatusBar: TStatusBar;
    ClearTrashBtn: TBitBtn;
    ZeroNDSChB: TCheckBox;
    SelectTypeRG: TRadioGroup;
    DiffSprAndTovChB: TCheckBox;
    RemoveTaraChB: TCheckBox;
    PredprComBox: TDBLookupComboboxEh;
    FormBtn: TButton;
    CompleteSverkaBtn: TButton;
    ExcelExportBtn: TButton;
    ExcelSaveDialog: TSaveDialog;
    Button1: TButton;
    procedure FormBtnClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormBtnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FindBtnClick(Sender: TObject);
    procedure ExcelExportBtnClick(Sender: TObject);
    procedure CompleteSverkaBtnClick(Sender: TObject);
    procedure FilterRGClick(Sender: TObject);
    procedure CheckAllCBClick(Sender: TObject);
    procedure UnCheckAllCBClick(Sender: TObject);
    procedure ShowProtokolBtnClick(Sender: TObject);
    procedure DBGridEh1DrawFooterCell(Sender: TObject; DataCol, Row: Integer;
      Column: TColumnEh; Rect: TRect; State: TGridDrawState);
    procedure SverkaDBGridEhGetCellParams(Sender: TObject; Column: TColumnEh;
      AFont: TFont; var Background: TColor; State: TGridDrawState);
    procedure ClearTrashBtnClick(Sender: TObject);
    procedure SverkaDBGridEhSortMarkingChanged(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    Path, Path3, PathMove, DateSpr: string;
    IdVal: integer;
    procedure MultiSorting(DBGridEh: TDBGridEh);
    procedure ResetSortMarker(DBGridEh: TDBGridEh);
  public
    { Public declarations }
    Tara: double;
    CrT: boolean;
    procedure FilterOnOff();
  end;

var
  frmAct1N: TfrmAct1N;

implementation

{$R *.dfm}

uses
  uSVDM, uDateSpr, uClearTrashThread, uCompareThread, uSearch;

procedure TfrmAct1N.FormBtnClick(Sender: TObject);
begin
  if FirstPicker.Date > SecPicker.Date then
  begin
    Application.MessageBox(PChar('Неверно заданы даты !'), 'Предупреждение', MB_OK + MB_ICONWarning);
    Exit;
  end;

  ResetSortMarker(SverkaDBGridEh);

  Tara := 0;
  CheckAllCB.Checked := false;
  UnCheckAllCB.Checked := false;

  PBar1.Position := 0;

  CompareThread := TCompareThread.Create(True, PBar1, BottomStatusBar, TopPanel, BottomPanel, SverkaDBGridEh);
  CompareThread.FreeOnTerminate := true;
  CompareThread.Priority := tpNormal;
  CompareThread.Start;
end;

procedure TfrmAct1N.FormCreate(Sender: TObject);
var
  F: TextFile;
  S: string;
begin
  with SVDM do
  begin
    BuhConnection.Close();
    AssignFile(F, ExtractFilePath(Application.ExeName) + 'BuhConnect.ini');
    Reset(F);
    Read(F, S);
    CloseFile(F);
    BuhConnection.ConnectionString := '';
    BuhConnection.ConnectionString := S;
    BuhConnection.Open();
  end;
///
  AssignFile(F, ExtractFilePath(Application.ExeName) + 'RecV.ini');
  Reset(F);
  Read(F, S);
  CloseFile(F);
  Path := S;
//
  AssignFile(F, ExtractFilePath(Application.ExeName) + 'RecV3.ini');
  Reset(F);
  Read(F, S);
  CloseFile(F);
  Path3 := S;
//
//
  AssignFile(F, ExtractFilePath(Application.ExeName) + 'Path.ini');
  Reset(F);
  ReadLn(F, S);
  ReadLn(F, S);
  CloseFile(F);
  PathMove := S;
///

  FirstPicker.Date := StrToDate('01.' + IntToStr(monthOf(now())) + '.' + IntToStr(YearOf(now())));
  SecPicker.Date := now();

  CrT := false;
  DateSpr := '';

  with SVDM do
  begin
    qNPredpr.Close;
    qNPredpr.Open;

    qNVal.Close;
    qNVal.Open;

    if qNVal.Locate('Name$', 'Белорусский рубль', []) then
      IdVal := qNval.FieldByName('Id$R').value;
  end;

  BottomStatusBar.Font.Style := BottomStatusBar.Font.Style + [fsBold];
end;

procedure TfrmAct1N.FilterOnOff();
begin
  with SVDM.qSF do
  begin
    Close;

    if FilterRG.ItemIndex = 0 then
    begin
      Filtered := false;
      Filter := '';
    end
    else
    begin
      Filtered := false;

      if FilterRG.ItemIndex = 2 then
        Filter := '(RasBezNDS<>0 and RasBezNDS<>null) or (RasNDS<>0 and RasNDS<>null)'
      else
        Filter := '(RasBezNDS = null) and (RasNDS = null)';

      Filtered := true;
    end;

    if CrT then
      Open;

    SverkaDBGridEh.Columns[0].Visible := not (FilterRG.ItemIndex = 0);
    CompleteSverkaBtn.Enabled := not (FilterRG.ItemIndex = 0);
    ShowProtokolBtn.Enabled := not (FilterRG.ItemIndex = 0);
    CheckItemsGB.Visible := not (FilterRG.ItemIndex = 0);
    CheckAllCB.Visible := not (FilterRG.ItemIndex = 0);
    UnCheckAllCB.Visible := not (FilterRG.ItemIndex = 0);

    if CrT and IsEmpty then
      Application.MessageBox('Нет информации', '', MB_OK + MB_ICONInformation);
  end;
end;

procedure TfrmAct1N.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    SelectNext(ActiveControl as TWincontrol, true, true);
end;

procedure TfrmAct1N.FormBtnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Key = 13 then
    FormBtnClick(FormBtn);
end;

procedure TfrmAct1N.FindBtnClick(Sender: TObject);
begin
  frmSearch := TfrmSearch.Create(Self, PredprComBox);
  frmSearch.ShowModal;
  frmSearch.Free;
end;

procedure TfrmAct1N.ExcelExportBtnClick(Sender: TObject);
begin
  if ExcelSaveDialog.Execute then
  begin
    SaveDbGridEhToExportFile(TDBGridEhExportAsXLS, SverkaDBGridEh, ExcelSaveDialog.FileName, true);
//    SaveDbGridEhToExportFile(TDBGridEhExportAsXLS, SverkaDBGridEh, XlsFileName, true);
    Application.MessageBox('Выгрузка в Excel завершена !!!', '', MB_OK + MB_ICONInformation);
  end;
end;

procedure TfrmAct1N.CompleteSverkaBtnClick(Sender: TObject);
var
  FileName, NSF: string;
  I, KV, KNV: integer;
  KProv: integer;  //кол-во проводок
  Protokol: TStrings;
  bool: boolean;
begin
  if not CrT then
    Exit;

  TopPanel.Enabled := False;

  Protokol := TStringList.Create;
  KV := 0;
  KNV := 0;
  KProv := 0;

  with SVDM do
  begin
    with qSF do
    begin
      First;
      DisableControls;

      for I := 0 to RecordCount - 1 do
      begin
        if ((not FieldByName('NSF').IsNull) and (FilterRG.ItemIndex = 1)) or (FilterRG.ItemIndex = 2) then
        begin
          if SverkaDBGridEh.Columns[0].Field.AsBoolean then
            qUpdSF.Parameters.ParamByName('ch').Value := 1
          else
            qUpdSF.Parameters.ParamByName('ch').Value := 0;

          qUpdSF.Parameters.ParamByName('Id1').Value := FieldByName('Id1').Value;
          qUpdSF.ExecSQL;
        end;
        Next;
      end;
      EnableControls;
//      qqq.ExecSQL;
    end;

    with qSFTrue do
    begin
      Close;

      if FilterRG.ItemIndex = 1 then
      begin
        Sql.Delete(Sql.Count - 1);
        SQL.Add('and IsNull(RasBezNDS,0)=0 and IsNull(RasNDS,0)=0');
      end;

      if FilterRG.ItemIndex = 2 then
      begin
        Sql.Delete(Sql.Count - 1);
        SQL.Add('and (IsNull(RasBezNDS,0)<>0 or IsNull(RasNDS,0)<>0)');
      end;
      Open;

      if IsEmpty then
        Application.MessageBox('Нет документов для выгрузки', '', MB_OK + MB_ICONInformation)
      else
      begin
        PBar1.Position := 0;
        PBar1.Max := RecordCount;
        First;

        while not eof do
        begin
          NSF := FieldByName('NSF').Value;
          FileName := 'invoice-' + NSF + '.sgn.xml';
//          Showmessage(Path +FileName);

          if FileExists(Path + FileName) then    // есть в RecV
          begin
            if FileExists(Path3 + FileName) then     // есть в RecV3
              DeleteFile(Path3 + FileName);

            if CopyFile(pchar(Path + FileName), pchar(Path3 + FileName), False) then
            begin
              DeleteFile(Path + FileName);
              KV := KV + 1;
              Protokol.Add(NSF + '  - выгружена (RecV1,RecV3)')
            end
            else
              with qNotCopy do
              begin
                KNV := KNV + 1;
                Protokol.Add(NSF + '  - не выгружена (RecV1,RecV3)');
                Parameters.ParamByName('NSF').Value := NSF;
                ExecSQL;
              end
          end
          else   //нет в RecV
          begin
            if (not FileExists(Path3 + FileName)) and (not FileExists(PathMove +
              FileName)) then     // нет в RecV3
            begin
              with qNotCopy do
              begin
                // нет ни в RecV,RecV3
                Protokol.Add(NSF + '  - нет xml-файла для ЭСЧФ');
                KNV := KNV + 1;
                Parameters.ParamByName('NSF').Value := NSF;
                ExecSQL;
              end;
            end
            else
            begin
              KV := KV + 1;
              Protokol.Add(NSF + '  - выгружена (RecV3)')
            end;
          end;

          Pbar1.Position := Pbar1.Position + 1;
          Next;
        end;

        // Запрашивание даты справки
        bool := False;
        qIsProv.Close;
        qIsProv.Open;

        if qIsProv.RecordCount <> 0 then
        begin
          if not Assigned(frmDateSpr) then
            frmDateSpr := TfrmDateSpr.Create(Self);

          while (not bool) do
          begin
            frmDateSpr.ShowModal;

            if frmDateSpr.ModalResult = mrOk then
            begin
              DateSpr := DateToStr(frmDateSpr.SprPicker.Date);

              // Проверка на закрытый период
              qIsClosed.Close;
              qIsClosed.Parameters.ParamByName('mm').Value := MonthOf(StrToDate(DateSpr));
              qIsClosed.Parameters.ParamByName('yy').Value := YearOf(StrToDate(DateSpr));
              qIsClosed.Open;

              if qIsClosed.RecordCount <> 0 then
                Application.MessageBox('     Период закрыт!' + #10#13 +
                  '  Добавление проводок невозможно!', '', MB_OK + MB_ICONError)
              else
                bool := true;
            end
            else
              Exit;
          end;
        end;
///
        try
          BuhConnection.BeginTrans;

          if FilterRG.ItemIndex = 1 then
          begin
            qUpdSv.ExecSQL;
            qUpdSv1.ExecSQL;

            if DateSpr <> '' then
            begin
              qFormProv1.Close;
              qFormProv1.Parameters.ParamByName('DateSpr').Value := StrToDate(DateSpr);
              qFormProv1.Parameters.ParamByName('IdVal').Value := IdVal;
              qFormProv1.Open;
              KProv := qFormProv1.FieldByName('RowCount').Value;
            end;
          end
          else
          begin
            qUpdSv2.ExecSQL;
            qUpdSv3.ExecSQL;

            if DateSpr <> '' then
            begin
              qFormProv2.Close;
              qFormProv2.Parameters.ParamByName('DateSpr').Value := StrToDate(DateSpr);
              qFormProv2.Parameters.ParamByName('IdVal').Value := IdVal;
              qFormProv2.Open;

              KProv := qFormProv2.FieldByName('RowCount').Value;
            end;
          end;

          BuhConnection.CommitTrans;

          if (KV <> 0) and (KNV = 0) then
          begin
            Application.MessageBox(PChar('Выгрузка прошла успешно.' + #10#13 +
              'Выгружено ЭСЧФ - ' + IntToStr(KV) + #10#13 +
              'Сформировано проводок - ' + IntToStr(KProv)), '', MB_OK + MB_ICONInformation);
            FormBtnClick(FormBtn);
          end
          else if (KV <> 0) and (KNV <> 0) then
          begin
            Application.MessageBox(PChar('Выгружено ЭСЧФ - ' + IntToStr(KV) +
              #10#13 + 'Не выгружено - ' + IntToStr(KNV) + #10#13 +
              'Сформировано проводок - ' + IntToStr(KProv) + #10#13 +
              'Смотрите протокол.'), '', MB_OK + MB_ICONInformation);
            FormBtnClick(FormBtn);
          end
          else
            Application.MessageBox(PChar('Выгружено ЭСЧФ - 0 ' + #10#13 +
              'Смотрите протокол.'), '', MB_OK + MB_ICONInformation);

          Protokol.SaveToFile('Протокол выгрузки ЭСЧФ');
        except
          on E: exception do
          begin
            BuhConnection.RollbackTrans;
            Application.MessageBox(PChar('Ошибка при выгрузке: ' + E.Message),
              'Ошибка', MB_OK + MB_ICONERROR);
          end;
        end;
      end;
    end;
  end;

  BottomStatusBar.SimpleText := 'Выгрузка завершена.';
  TopPanel.Enabled := True;
end;

procedure TfrmAct1N.FilterRGClick(Sender: TObject);
begin
  FilterOnOff();
  CheckAllCB.Checked := False;
  UnCheckAllCB.Checked := False;

  if TRadioGroup(Sender).ItemIndex = 0 then
    SverkaDBGridEh.FrozenCols := 4
  else
    SverkaDBGridEh.FrozenCols := 5;

  ResetSortMarker(SverkaDBGridEh);
end;

procedure TfrmAct1N.Button1Click(Sender: TObject);
var i: Integer;
begin
  with SVDM do
  begin
    with qSF do
    begin
      First;
      DisableControls;

      for I := 0 to RecordCount - 1 do
      begin
        if ((not FieldByName('NSF').IsNull) and (FilterRG.ItemIndex = 1)) or (FilterRG.ItemIndex = 2) then
        begin
          if SverkaDBGridEh.Columns[0].Field.AsBoolean then
            qUpdSF.Parameters.ParamByName('ch').Value := 1
          else
            qUpdSF.Parameters.ParamByName('ch').Value := 0;

          qUpdSF.Parameters.ParamByName('Id1').Value := FieldByName('Id1').Value;
          qUpdSF.ExecSQL;
        end;
        Next;
      end;

      EnableControls;
      qqq.ExecSQL;
    end;

    testProv.Close;
    testProv.Parameters.ParamByName('DateSpr').Value := StrToDate('30.04.2021');
    testProv.Parameters.ParamByName('IdVal').Value := 933;
    testProv.Open;
  end;
end;

procedure TfrmAct1N.CheckAllCBClick(Sender: TObject);
begin
  if (not (CheckAllCB.Checked) and not (UnCheckAllCB.Checked)) or (not CrT) then
    Exit;

  with SVDM do
    with qWork do
    begin
      Close;
      SQL.Clear;

      if FilterRG.ItemIndex = 1 then
        if CheckAllCB.Checked then
        begin
          UnCheckAllCB.Checked := false;
          SQL.Add('Update #tbSver3 set Ch=1 where IsNull(RasBezNDS,0)= 0 and IsNull(RasNDS,0)=0 and NSF is not null');
        end
        else
        begin
          UnCheckAllCB.Checked := true;
          SQL.Add('Update #tbSver3 set Ch=0 where IsNull(RasBezNDS,0)= 0 and IsNull(RasNDS,0)=0 and NSF is not null');
        end
      else if CheckAllCB.Checked then
      begin
        UnCheckAllCB.Checked := false;
        SQL.Add('Update  #tbSver3 set Ch=1 where (IsNull(RasBezNDS,0)<> 0 or IsNull(RasNDS,0)<>0) and NSF is not null');
      end
      else
      begin
        UnCheckAllCB.Checked := true;
        SQL.Add('Update  #tbSver3 set Ch=0 where (IsNull(RasBezNDS,0)<> 0 or IsNull(RasNDS,0)<>0) and NSF is not null');
      end;

      ExecSQL;
      qSF.Close;
      qSF.Open;
      FilterOnOff();
    end;
end;

procedure TfrmAct1N.UnCheckAllCBClick(Sender: TObject);
begin
  if (not (CheckAllCB.Checked) and not (UnCheckAllCB.Checked)) or (not CrT) then
    Exit;

  with SVDM do
    with qWork do
    begin
      Close;
      SQL.Clear;

      if FilterRG.ItemIndex = 1 then
        if UnCheckAllCB.Checked then
        begin
          CheckAllCB.Checked := false;
          SQL.Add('Update  #tbSver3 set Ch=0 where IsNull(RasBezNDS,0)= 0 and IsNull(RasNDS,0)=0 and NSF is not null');
        end
        else
        begin
          CheckAllCB.Checked := true;
          SQL.Add('Update  #tbSver3 set Ch=1 where IsNull(RasBezNDS,0)= 0 and IsNull(RasNDS,0)=0 and NSF is not null');
        end
      else if UnCheckAllCB.Checked then
      begin
        CheckAllCB.Checked := false;
        SQL.Add('Update  #tbSver3 set Ch=0 where (IsNull(RasBezNDS,0)<> 0 or IsNull(RasNDS,0)<>0) and NSF is not null');
      end
      else
      begin
        CheckAllCB.Checked := true;
        SQL.Add('Update  #tbSver3 set Ch=1 where (IsNull(RasBezNDS,0)<> 0 or IsNull(RasNDS,0)<>0) and NSF is not null');
      end;

      ExecSQL;
      qSF.Close;
      qSF.Open;
      FilterOnOff();
    end;
end;

procedure TfrmAct1N.ShowProtokolBtnClick(Sender: TObject);
begin
  if not ProtokolMemo.Visible then
  begin
    ProtokolMemo.Visible := true;
    ProtokolMemo.Lines.LoadFromFile('Протокол выгрузки ЭСЧФ');
    ShowProtokolBtn.Caption := 'Скрыть протокол выгрузки';
  end
  else
  begin
    ShowProtokolBtn.Caption := 'Показать протокол выгрузки';
    ProtokolMemo.Visible := false;
    ProtokolMemo.Lines.Clear;
  end;
end;

procedure TfrmAct1N.DBGridEh1DrawFooterCell(Sender: TObject; DataCol, Row:
  Integer; Column: TColumnEh; Rect: TRect; State: TGridDrawState);
var
  r: TRect;
  s: string;
  SumBezNDS: double;
begin
  (Sender as TDBGridEh).ReadOnly := False;

  with SVDM do
  begin
    case FilterRG.ItemIndex of
      0:
        dsItog.DataSet := qItogAll;
      1:
        dsItog.DataSet := qItogEq;
      2:
        dsItog.DataSet := qItogNoEq;
    end;

    with dsItog.DataSet do
    begin
      Close;
      Open;

      case FilterRG.ItemIndex of
        0, 1:
          SumBezNDS := FieldByName('SumBezNDS').Value - Tara;
        2:
          SumBezNDS := FieldByName('SumBezNDS').Value;
      else
        SumBezNDS := 0;
      end;

      if (not IsEmpty) then
      begin
        case DataCol of
          1:
            s := '       ИТОГО :';
          6:
            s := FieldByName('SumBezNDSsf').AsString;
          7:
            s := FieldByName('SumNDSsf').AsString;
          8:
            s := FieldByName('SumSNDSsf').AsString;
          9:
            s := FloatToStr(SumBezNDS);
          10:
            s := FieldByName('SumNDS').AsString;
          11:
            s := FloatToStr(FieldByName('SumNDS').Value + SumBezNDS);
          12:
            s := FloatToStr(FieldByName('SumBezNDSsf').Value - SumBezNDS);
          13:
            s := FloatToStr(FieldByName('SumNDSsf').Value - FieldByName('SumNDS').Value);
        end;

        r := Rect;

        with (Sender as TDBGridEh).Canvas do
        begin
          FillRect(Rect);
          Font.Color := clBlack;

          if DataCol = 1 then
            TextOut(r.Left, r.Top + 1, s)
          else
            TextOut((r.Right - TextWidth(s) - 1), r.Top + 1, s);
        end;
      end;
    end;
  end;
end;

procedure TfrmAct1N.SverkaDBGridEhGetCellParams(Sender: TObject; Column:
  TColumnEh; AFont: TFont; var Background: TColor; State: TGridDrawState);
begin
  if SVDM.qSF.FieldByName('chColor').AsBoolean then
    Background := clYellow
  else
    Background := clWindow;
end;

procedure TfrmAct1N.ClearTrashBtnClick(Sender: TObject);
begin
  ClearTrashThread := TClearTrashThread.Create(True, PBar1, BottomStatusBar,
    TopPanel, BottomPanel, SverkaDBGridEh);
  ClearTrashThread.FreeOnTerminate := true;
  ClearTrashThread.Priority := tpNormal;
  ClearTrashThread.Start;
end;

procedure TfrmAct1N.SverkaDBGridEhSortMarkingChanged(Sender: TObject);
var
  bm: TBookMark;
begin
  bm := (Sender as TDBGridEh).DataSource.DataSet.GetBookmark;
  MultiSorting(Sender as TDBGridEh);
  (Sender as TDBGridEh).DataSource.DataSet.GotoBookmark(bm);
end;

procedure TfrmAct1N.MultiSorting(DBGridEh: TDBGridEh);
var
  I: Integer;
  s: WideString;
begin
  with DBGridEh.SortMarkedColumns do
  begin
    if Count = 0 then
      Exit;

    s := DBGridEh.Columns[Items[0].Index].FieldName;

    if Items[0].Title.SortMarker = smUpEh then
      s := s + ' ASC'
    else
      s := s + ' DESC';

    try
      for I := 1 to Count - 1 do
      begin
        s := s + ', ' + DBGridEh.Columns[Items[I].Index].FieldName;

        if Items[I].Title.SortMarker = smUpEh then
          s := s + ' ASC'
        else
          s := s + ' DESC';
      end;
    except
    end;
  end;

  TADOQuery(DBGridEh.DataSource.DataSet).Sort := s;
end;

procedure TfrmAct1N.ResetSortMarker(DBGridEh: TDBGridEh);
var
  i: Integer;
begin
  for i := 0 to DBGridEh.Columns.Count - 1 do
    DBGridEh.Columns[i].Title.SortMarker := smNoneEh;
end;

end.

