unit BatchSelect;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, DBCtrls, DB, Mask, DBCtrlsEh, FIBDataSet, pFIBDataSet,
  FIBDatabase, pFIBDatabase, Grids, DBGrids, DBGridEh, DBLookupEh, ExtCtrls,
  Buttons;

type
  TBatchSelectForm = class(TForm)
    dbdef: TpFIBDatabase;
    trModules: TpFIBTransaction;
    dsModules: TpFIBDataSet;
    dscModules: TDataSource;
    twModules: TpFIBTransaction;
    pFIBTransaction1: TpFIBTransaction;
    dsProduct: TpFIBDataSet;
    dscProduct: TDataSource;
    cmbProduct: TDBLookupComboboxEh;
    pFIBTransaction2: TpFIBTransaction;
    dsBatches: TpFIBDataSet;
    dscBatches: TDataSource;
    pFIBTransaction3: TpFIBTransaction;
    pFIBTransaction4: TpFIBTransaction;
    dsBatchOper: TpFIBDataSet;
    dscBatchOper: TDataSource;
    pFIBTransaction5: TpFIBTransaction;
    dsPlacesSrc: TpFIBDataSet;
    dscPlacesSrc: TDataSource;
    pFIBTransaction6: TpFIBTransaction;
    dsPlacesDst: TpFIBDataSet;
    dscPlacesDst: TDataSource;
    cmbOper: TDBLookupComboboxEh;
    cmbSrc: TDBLookupComboboxEh;
    cmbDst: TDBLookupComboboxEh;
    dsBatchesIDBATCH: TFIBIntegerField;
    dsBatchesIDBATCHOPER: TFIBIntegerField;
    dsBatchesIDPLACESRC: TFIBIntegerField;
    dsBatchesIDPLACEDST: TFIBIntegerField;
    dsBatchesIDPROD: TFIBIntegerField;
    dsBatchesDT: TFIBDateTimeField;
    dsBatchesDESCR: TFIBstringField;
    edDescr: TDBEditEh;
    edWName: TDBEditEh;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Bevel2: TBevel;
    btAppend: TBitBtn;
    btOk: TBitBtn;
    btCancel: TBitBtn;
    Label10: TLabel;
    Panel1: TPanel;
    pnlNew: TPanel;
    edDt: TDBEditEh;
    edId: TDBEditEh;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    Label9: TLabel;
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure btAppendClick(Sender: TObject);
    procedure btOkClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
  private
  public
    db: TpFIBDatabase;
    wname: string;
    idm: integer;
    idbatch: integer;
  end;

  function doBatchSelect(owner: TForm; db: TpFIBDatabase; wname: string): boolean;

implementation

{$R *.dfm}


function GenerateId(genname: string; Db: TFIBDatabase): integer;
var
  v: variant;
begin
  v := Db.QueryValue('SELECT GEN_ID(' + genname + ',1) AS ID FROM RDB$DATABASE', 0);
  if VarType(v) <> varBoolean then
    begin
      result := v;
    end
  else
    begin
      raise Exception.Create('GenerateId');
      result := 0;
    end;
end;


function doBatchSelect(owner: TForm; db: TpFIBDatabase; wname: string): boolean;
var
  wnd: TBatchSelectForm;
begin
  wnd := TBatchSelectForm.Create(owner);
  wnd.db := db;
  wnd.wname := wname;
  try
    result := wnd.ShowModal = mrOk;
  finally
    wnd.Free;
  end;
end;

procedure TBatchSelectForm.FormActivate(Sender: TObject);

  procedure initds(ds: TpFIBDataSet);
  begin
    ds.Database := db;
    ds.Transaction.DefaultDatabase := db;
    ds.UpdateTransaction.DefaultDatabase := db;
    ds.Active := true;
  end;

var
  flag: boolean;
begin
  initds(dsModules);
  initds(dsProduct);
  initds(dsBatchOper);
  initds(dsPlacesSrc);
  initds(dsPlacesDst);
  initds(dsBatches);


  flag := dsModules.Locate('NAME', wname, [] );
  if not flag then
    flag := dsModules.Locate('DESCR', wname, [] );

  if not flag then begin
    ShowMessage('Модуль ' + wname + ' не найден!');
    ModalResult := mrAbort;
  end else begin
    idm := dsModules.fieldByName('IDM').AsInteger;
    idbatch := dsModules.fieldByName('IDBATCH').AsInteger;
  end;

  if not dsBatches.Locate('IDBATCH', idbatch, [] ) then begin
  end;

end;

procedure TBatchSelectForm.Button1Click(Sender: TObject);
begin
  dsBatches.Post;
  close;
end;

procedure TBatchSelectForm.btAppendClick(Sender: TObject);
var
  idprod, idbatchoper, idplacesrc, idplacedst: integer;
begin
  idprod := dsBatchesIDPROD.AsInteger;
  idbatchoper := dsBatchesIDBATCHOPER.AsInteger;
  idplacesrc := dsBatchesIDPLACESRC.AsInteger;
  idplacedst := dsBatchesIDPLACEDST.AsInteger;

  dsBatches.Append;

  dsBatchesIDPROD.AsInteger := idprod;
  dsBatchesIDBATCHOPER.AsInteger := idbatchoper;
  dsBatchesIDPLACESRC.AsInteger := idplacesrc;
  dsBatchesIDPLACEDST.AsInteger := idplacedst;



  // enabling
  pnlNew.Visible := true;

  cmbProduct.Enabled := true;
  cmbProduct.ReadOnly := false;
  cmbProduct.Color := clWhite;

  cmbSrc.Enabled := true;
  cmbSrc.ReadOnly := false;
  cmbSrc.Color := clWhite;

  cmbDst.Enabled := true;
  cmbDst.ReadOnly := false;
  cmbDst.Color := clWhite;

  cmbOper.Enabled := true;
  cmbOper.ReadOnly := false;
  cmbOper.Color := clWhite;

  edDescr.Enabled := true;
  edDescr.ReadOnly := false;
  edDescr.Color := clWhite;

  btOk.Enabled := true;
  btAppend.Enabled := false;

end;

procedure TBatchSelectForm.btOkClick(Sender: TObject);
begin
  try
    idbatch := GenerateId('GEN_BATCHES_ID',db);
    dsBatches.FieldByName('IDBATCH').AsInteger := idbatch;
    dsBatches.FieldByName('DT').AsDateTime := now;
    dsBatches.Post;

    dsModules.Edit;
    dsModules.FieldByName('IDBATCH').AsInteger := idbatch;
    dsModules.FieldByName('IDPROD').AsInteger := dsBatches.FieldByName('IDPROD').AsInteger;
    dsModules.Post;

  except
    exit;
  end;
  close;
end;

procedure TBatchSelectForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if dsBatches.State in [dsEdit, dsInsert] then
    dsBatches.Cancel;

end;

procedure TBatchSelectForm.FormCreate(Sender: TObject);
begin
  db := dbdef;
end;

end.
