unitmb.pas

飞恒进销存(超市批发)管理系统V5.1（含源程序） 语言：Delphi 6/7 相关控件：FastReport 2.4以上, Ehlib 3.4以上 1.数据库为fhe2db_V51.da

unit Unitmb;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, ToolWin, ComCtrls, Buttons, StdCtrls, Grids, DBGridEh, DB,Math,
  ADODB, Mask, DBCtrlsEh, DBLookupEh, ImgList, Menus, DBGrids, FR_Ctrls,
  DBCtrls, dbcgrids, StrUtils;
type
  TmbForm = class(TForm)
    mbPanel1: TPanel;
    mbPanel2: TPanel;
    mbPanel4: TPanel;
    mbPanel3: TPanel;
    DBGrid1: TDBGridEh;
    edtBillDate: TDateTimePicker;
    lblBillDate: TLabel;
    lblInvoNo: TLabel;
    edtInvoNo: TEdit;
    lblFormName: TLabel;
    lblStore: TLabel;
    lblEmp: TLabel;
    lblOther: TLabel;
    PopMprint: TPopupMenu;
    Print: TMenuItem;
    Preview: TMenuItem;
    ILinfo: TImageList;
    ToolBar1: TToolBar;
    cmdAdd: TToolButton;
    cmdEdit: TToolButton;
    cmdDel: TToolButton;
    ToolButton4: TToolButton;
    cmdSearch: TToolButton;
    cmdPrint: TToolButton;
    ToolButton7: TToolButton;
    cmdExit: TToolButton;
    cmdSave: TToolButton;
    cmdDelLine: TToolButton;
    ToolButton3: TToolButton;
    cmdPrior: TToolButton;
    cmdNext: TToolButton;
    ToolButton8: TToolButton;
    cmdUndo: TToolButton;
    SpeedButton1: TSpeedButton;
    cmdBill: TToolButton;
    ToolButton2: TToolButton;
    edtEmp: TfrComboEdit;
    edtStore: TfrComboEdit;
    edtName: TfrComboEdit;
    lblMemo: TLabel;
    edtMemo: TEdit;
    lblName: TLabel;
    dbGoods: TDBGridEh;
    Splitter1: TSplitter;
    DBComboBoxEh1: TDBComboBoxEh;
    stinprice: TStaticText;
    stQty: TStaticText;
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure DBGrid1ColExit(Sender: TObject);
    procedure cmdPriorClick(Sender: TObject);
    procedure cmdExitClick(Sender: TObject);
    procedure cmdEditClick(Sender: TObject);
    procedure cmdDelLineClick(Sender: TObject);
    procedure cmdNextClick(Sender: TObject);
    procedure cmdAddClick(Sender: TObject);
    procedure cmdSaveClick(Sender: TObject);
    procedure cmdUndoClick(Sender: TObject);
    procedure cmdBillClick(Sender: TObject);
    procedure edtStoreButtonClick(Sender: TObject);
    procedure edtEmpButtonClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure edtNameButtonClick(Sender: TObject);
    procedure DBGrid1KeyPress(Sender: TObject; var Key: Char);
    procedure DBGrid1ColEnter(Sender: TObject);
    procedure DBGrid1CellClick(Column: TColumnEh);
    procedure PrintClick(Sender: TObject);
    procedure PreviewClick(Sender: TObject);
    procedure cmdSearchClick(Sender: TObject);
    procedure DBGrid1Enter(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure dbGoodsCellClick(Column: TColumnEh);
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
      DataCol: Integer; Column: TColumnEh; State: TGridDrawState);
    procedure DBComboBoxEh1Change(Sender: TObject);
    procedure DBComboBoxEh1KeyPress(Sender: TObject; var Key: Char);
    procedure edtNameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure edtNameExit(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure DBComboBoxEh1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  protected
     w1,w2,w5,w6,w7,i:integer;
     sCodeBuff,sOldCode:string;  //keyboard buffer char;保存旧的编码
     //刚查询的货品情况
     sSchCode,sSchUnits,sSchUnit2:string;
     nSchPerQty,nSchPrice,nSchPrice2,nCost1,nCost2,nInprice,nInprice2,rQty,rQty1:real;
     nSpePrice,nSpePrice2:real;

     sDelItemNO:string;//itemno'string will be deleted
     bNew:boolean; //true is new ,other is old
     mySql,myTable:string; //queryDetail's sql,table name

     bTips:boolean; //输入编码不在大类中（为条形码，或未分类），无提示信息
     nGoodsId,oBillid:integer; //货品，相关单据
     bDisc:boolean;            //0 :件，1：零, querydetail.disc
     nQty:real;
     nStoreId,nOutStoreId,nCusid,nEmployId,iGoodsid,nCusFileId:integer;    //仓库,调出仓库,供应商或客户，业务员
     nOldStoreId,nOldOutStoreId,nOldCusid,nOldEmployId:integer;  //未修改前的值
     oInvoNo,sMasterMemo,sOldMasterMemo:string;                 //订单号,主单备注
     oIsChecked:Boolean;  //是否选择订单
     sInOut:string;  //其它出入库的出入仓类型

     Function  GetRefTblSql(nType,nTblId:integer):string;
     Function  GetOnhandDirection(nType,nTblId:integer):string;

     procedure InitInfo;virtual;
     procedure ShowMasterInfo(bPrior:boolean);
     procedure ShowMasterSpecial(bAdd:boolean);virtual;

     procedure UpdateBatchDetail(sStatus:TRecordStatusSet);

     procedure InsertDetail;virtual;//dynamic;
     procedure UpdateDetail;virtual;
     procedure DeleteDetail;

     procedure UpdateRefTbl;
     procedure UpdateOnHand(bUnit:boolean);
     procedure UpdateGoodsInPrice;
     Function  GetLeftAmt(xBillId:integer):real;//收付款:获取当前修改可取最大本次付(收)金额

     procedure UpdateRefTblBack(nType:integer);
     procedure UpdateOnHandBack(nType,nNowStoreId,nDire:integer);

     procedure InsertMaster(sInvono:string);virtual;
     procedure UpdateMaster;virtual;

     procedure SetCommandStatus(nStatus:integer);

     Function  GetDetailSql:string;
     procedure AddCalcField(ADOSet1: TADOQuery; sFieldName: string; sMode: Char = 'D');
     procedure SetDBComboBox;
     procedure GetCode;
     Procedure GetStock(AHint:Boolean);
  public
    { Public declarations }
     nTableId:integer;                  //为相交表所指定的序号，以利于书定代码
  end;

var
  mbForm: TmbForm;

implementation

uses datamodule1, selBill, selPaytype, selVC, selIoBill, report2, selBill1;

{$R *.DFM}
//获得要修改的SQL 0=INSERT,1=updat,2=delete
Function  TmbForm.GetRefTblSql(nType,nTblId:integer):string;
begin
  result:='';
  if nType=0 then  //insert,直接更新
    case nTblId of
      1:  result:= 'Update I_ORDERD    set ExeQty= (case when ( ExeQty + :exeQty)> qty then qty else ExeQty + :exeQty end) where billid= :billid and itemno= :itemno';
      2:  result:= 'Update I_INSTORED  set RtnQty= (case when ( RtnQty + :rtnQty)> qty then qty else rtnQty + :rtnQty end) where billid= :billid and itemno= :itemno';
      3:  result:= 'Update I_INSTORE   set TakeAmt= takeAmt+ :TakeAmt where billid= :billid ';
      11: result:= 'Update O_ORDERD    set ExeQty= (case when ( ExeQty + :exeQty)> qty then qty else ExeQty + :exeQty end) where billid= :billid and itemno= :itemno';
      12: result:= 'Update O_OUTSTORED set RtnQty= (case when ( RtnQty + :rtnQty)> qty then qty else rtnQty + :rtnQty end) where billid= :billid and itemno= :itemno';
      13: result:= 'Update O_OutSTORE  set TakeAmt= takeAmt+ :TakeAmt where billid= :billid ';
    end
  else  begin           //update,由还未修改明细表去更新
    result:=' where n.BillId= :billid ';

    if nType=1 then
      result:=result+' and n.Itemno= :itemno '
    else
      result:=result+' and charindex('''+','''+'+ltrim(str(n.itemno))+'''+','''+', '''+sDelItemNo+''''+') >0 ';

    if nTblId mod 10 =3 then
      result:=result+' and r.billid=n.xbillid '
    else
      result:=result+' and r.billid=n.xbillid and r.itemno=n.itemno and r.goodsid=n.goodsid';;

    case nTblId of
      1:  result:= 'Update I_ORDERD    set ExeQty= (case when r.ExeQty - n.qty < 0 then 0 else r.ExeQty - n.qty end) from I_ORDERD r,   I_INSTORED  n'+result;
      2:  result:= 'Update I_INSTORED  set RtnQty= (case when r.RtnQty - n.qty < 0 then 0 else r.RtnQty - n.qty end) from I_INSTORED r, I_RETURND  n'+result;
      3:  result:= 'Update I_INSTORE   set TakeAmt= r.takeAmt- n.Amount from I_INSTORE r, I_PayD  n'+result;
      11: result:= 'Update O_ORDERD    set ExeQty= (case when r.ExeQty - n.qty < 0 then 0 else r.ExeQty - n.qty end) from O_ORDERD r,   O_OUTSTORED  n'+result;
      12: result:= 'Update O_OUTSTORED set RtnQty= (case when r.RtnQty - n.qty < 0 then 0 else r.RtnQty - n.qty end) from O_OUTSTORED r,O_RETURND  n'+result;
      13: result:= 'Update O_OutSTORE  set TakeAmt= r.takeAmt- n.Amount from O_OutSTORE r, O_ChargeD  n'+result;
      else result:='';
    end; //case
  end;  //if
end;

//获取当前修改可取最大本次付(收)金额
Function  TMbForm.GetLeftAmt(xBillId:integer):real;
begin
  result:=0;
  with dataE2 do
  if OpenTable('select billamt-TakeAmt-RtnAmt as Total from '+aTblName[nTableId-2]+ ' where billid= :billid',xBillid) then
    result:=AdoQuery1.fieldbyname('total').asCurrency;
end;

//insert 由当前表更新相关的订单执行，出入库退货
//=3,13 为收付款，只修改相关主表的已收付额
procedure TmbForm.UpdateRefTbl ;
var
  sRefTblsql:string;
  nLeftAmt:real;
begin
  sRefTblsql:=GetRefTblSql(0,nTableid);

  //退货时，退现款不修改相关表
  if ((nTableId =2) or (nTableId=12) ) and (nOutStoreId= 1) then
       sRefTblSql:='';

  //无相关更新，退出
  if sRefTblSql='' then exit;

  //相关单据为空，不更新
  if dataE2.queryDetail.fieldbyname('xBillId').asinteger <=0 then exit;

  with dataE2 do
  begin
    adoCmd.commandtext:=sRefTblSql ;
    if nTableId mod 10 =3 then  //收付款,更改master
    begin
      nLeftAmt:=GetLeftAmt(queryDetail.fieldbyname('xBillId').asinteger);
      //如果当前付超出，修改临时表为最大可付金额
      //这样更新Detail时不用，再取leftAmt
      if queryDetail.fieldbyname('amount').ascurrency > nLeftAmt then
      begin
        queryDetail.Edit;
        queryDetail.fieldbyname('amount').ascurrency:=nLeftAmt;
      end;

      adoCmd.parameters[0].value:=queryDetail.fieldbyname('amount').asCurrency;
      adoCmd.parameters[1].value:=queryDetail.fieldbyname('xBillId').asinteger;
    end else begin
      adoCmd.parameters[0].value:=queryDetail.fieldbyname('qty').asfloat;
      adoCmd.parameters[1].value:=queryDetail.fieldbyname('qty').asfloat;
      adoCmd.parameters[2].value:=queryDetail.fieldbyname('xBillId').asinteger;
      adoCmd.parameters[3].value:=queryDetail.fieldbyname('xItemNo').asinteger;
    end;
    adoCmd.execute;

    //退货时，冲应收付款要修改相关表，以及主表的退款金额
    if (nTableId =2) or (nTableId=12)  then
    begin
      adoCmd.CommandText :='update '+aTblName[nTableId-1]+' set RtnAmt= (select sum(RtnQty*Price) from '+aTblName[nTableId-1]+'D where Billid= :billid) where Billid= :billid';
      adoCmd.parameters[0].value:=queryDetail.fieldbyname('xBillId').asinteger;
      adoCmd.parameters[1].value:=queryDetail.fieldbyname('xBillId').asinteger;
      adoCmd.execute;
    end;

  end;
end;

//update=1,delete=2 由当前表更新相关的订单执行，出入库退货
procedure TmbForm.UpdateRefTblBack(nType:integer);
var
  sRefTblsql:string;
begin
  sRefTblsql:=GetRefTblSql(nType,nTableid);

  //退货时，退现款不修改相关表
  if ((nTableId =2) or (nTableId=12) ) and (nOldOutStoreId= 1) then
       sRefTblSql:='';

  //无相关更新，退出
  if sRefTblSql='' then exit;

  with dataE2 do
  begin
    adoCmd.commandtext:=sRefTblSql;
    adoCmd.parameters[0].value:=nBillId;//queryDetail.fieldbyname('BillId').asinteger;
    if nType=1 then
      adoCmd.parameters[1].value:=queryDetail.fieldbyname('ItemNo').asinteger;

    adoCmd.execute;
  end;
end;

//确定修改库存的方向，由出入仓,退货等
//storeid, nType :0=normal,1=back
Function  TmbForm.GetOnhandDirection(nType,nTblId:integer):string;
begin
  case nTblId of
      1  :  result:='+';
      2  :  result:='-';
      11 :  result:='-';
      18 :  result:='-'; //维修出库
      12 :  result:='+';
      21 :  result:='+';
      22 :  result:='+';
      24 :  result:='-';
      25 :  result:='+';
      26 :  result:='+';
      27 :  result:='-';
      else  result:='+';
  end;
  if nType<>0 then
    if result='+' then result:='-' else result:='+';
end;

//由现有明细单,修改库存
procedure TmbForm.UpdateOnHand(bUnit:boolean) ;
var
  sTmp,sSql,sMemo1,sMemo2:string;
  nTarStoreId,i:integer;
  nTmpQty:real;
begin
  sTmp:=GetOnHandDirection(0,nTableId);
  //组装是从明细中出仓来减少库存
  if nTableId = 24 then
    nTarStoreId:=nOutStoreid
  else
    nTarStoreId:=nStoreid;

  with dataE2 do
  begin
    //增加库存时要检查在onhand中是否有该品，否则要插入一行为0记录，以免更新有误
    if sTmp='+' then InsertOnhand(nStoreId,nGoodsId);

    if bUnit and bTwoUnit then  //零数出仓并且用双单位,自动借位各进位
    begin
      //adoCmd.commandtext:='update onHand set  qty1= qty1 '+sTmp+' :qty where storeid= :storeid and goodsid= :goodsid'
      if sTmp= '-' then nTmpQty:=-nQty else nTmpQty:=nQty;
        UpOnhandQty1(nGoodsId,nTarStoreid,ntmpQty);
    end
    else begin
      adoCmd.commandtext:='update onHand set  qty= qty '+sTmp+' :qty where storeid= :storeid and goodsid= :goodsid';
      adoCmd.parameters[0].value:=nqty;
      adoCmd.parameters[1].value:=nTarStoreId;
      adoCmd.parameters[2].value:=nGoodsid;

      adoCmd.execute;
    end;

    //for move use only
    if nTableId = 22 then
    begin
      if sTmp='+' then sTmp:='-' else sTmp:='+';
      if sTmp='+' then InsertOnhand(nOutStoreId,nGoodsId);

      if bUnit and bTwoUnit then  //零数出仓并且用双单位
      begin
        //adoCmd.commandtext:='update onHand set  qty1= qty1 '+sTmp+' :qty where storeid= :storeid and goodsid= :goodsid'
        if sTmp= '-' then nTmpQty:=-nQty else nTmpQty:=nQty;
          UpOnhandQty1(nGoodsId,nOutStoreId,ntmpQty);
      end
      else  begin
        adoCmd.commandtext:='update onHand set  qty= qty '+sTmp+' :qty where storeid= :storeid and goodsid= :goodsid';
        adoCmd.parameters[0].value:=nqty;
        adoCmd.parameters[1].value:=nOutStoreId;
        adoCmd.parameters[2].value:=nGoodsid;
        adoCmd.execute;