datamrp.pas

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

   y,m,d:word;
   n:word;
begin
  //result like 2000-6-23 ,if xdate=2000-07-23
  decodedate(xdate,y,m,d);
  n:=d;
  decodedate(xdate-n,y,m,d);
  if n>d then n:=d;
  result:=encodeDate(y,m,n);
end;

function TDataPub.GetMonthFirst(xDate:TDatetime):Tdatetime;
var
   y,m,d:word;
begin
  //result like 2000-07-01 ,if xdate=2000-07-23
  decodedate(xdate,y,m,d);
  result:=encodeDate(y,m,1);
end;

Function TDataPub.CheckNewStore(sTableName:string):boolean;
var
  locateoptions:TLocateOptions;
begin
  with datamodule2.tblWH do
    if locate('storename',sTableName,locateoptions) then
    begin
       sWHId:=fieldbyname('WHid').asstring;
       sWHName:=fieldbyname('WHname').asstring;
       sStoreName:=fieldbyname('storename').asstring;
       result:=true;end
    else begin
      sWHName:='无';
      sWhid:='';
      result:=false;
    end;
end;


procedure TDataPub.DataModuleCreate(Sender: TObject);
var
  s:string;
  i,j,k:integer;
begin
  bBackup:=false;//not in backup status
  printOption:=false;
  sPrinter:=printer.printers.strings[0] ;
  sprinter:=copy(sPrinter,1,12);
  nFormWidth:=633;
  nFormHeight:=420;// have toolbar is 386;}

  nDatabaseType:=1; //default main database is sqlanywhere 5
  nDatabaseTypeTmp:=2; //default tmp database  is Access
  HotelSpe :=0 ; //deafult is limited copy

  s:=Uppercase(dataModule2.Database1.AliasName);
  if s='JYISTORE' then nDatabaseType:=DataSQL5;
  if (s='MYMRP') or (s='MYMRP1') or (s='MYMRP2') then nDatabaseType:=DataAccess;
  if s='MSSQLSTORE' then nDatabaseType:=DataSQL7;

  s:=Uppercase(dataModule2.Database2.AliasName);
  if s='JYISTORE' then nDatabaseTypeTmp:=DataSQL5;
  if (s='MYMRP') or (s='MYMRP1') or (s='MYMRP2') then nDatabaseTypeTmp:=DataAccess;
  if s='MSSQLSTORE' then nDatabaseTypeTmp:=DataSQL7;

  //单位
  with datamodule2.tblUnit do
  begin
    open;
    j:=1;
    k:=1;
    for i:=1 to 10 do
    if not eof then
    begin
      s:=fieldbyname('units').asstring;
      if s<> '' then
      begin
        aUnit[1,j]:=s;inc(j); //件数单位，为空忽略
      end;
      s:=fieldbyname('unit2').asstring;
      if s<> '' then
      begin
        aUnit[2,k]:=s;inc(k);//零单位，为空忽略
      end;
      next;
    end;
    datamodule2.tblUnit.close;
  end;

end;


procedure TDataPub.InsertLedger(sInvono,sName,sInout,sSaler,sBuyer,sWarehouseman,sOthers:string;nPay,nPay1:real;dIODate:Tdatetime);
begin
  with datamodule2 do
  begin
  queryLedger.params[0].asstring:=sInvoNO;
  queryLedger.params[1].asstring:=sName;
  queryLedger.params[2].asfloat:=nPay;
  queryLedger.params[3].asfloat:=nPay1;
  queryLedger.params[4].asstring:=sInOut;
  queryLedger.params[5].asdatetime:=dIODate;
  queryLedger.params[6].asstring:=copy(timetostr(time),1,5);
  queryLedger.params[7].asfloat:=0;
  queryLedger.params[8].asfloat:=0;
  queryLedger.params[9].asstring:=sUsrName;
  queryLedger.params[10].asstring:=sSaler;
  queryLedger.params[11].asstring:=sBuyer;
  queryLedger.params[12].asstring:=sWarehouseman;
  queryLedger.params[13].asstring:=sOthers;
  //转仓入
  if nPay1=-9999 then
    queryLedger.params[14].asstring:=sSaler //whid
  else
    queryLedger.params[14].asstring:=sWhid;
  queryLedger.execsql;
  end;
end;

procedure TDataPub.InsertOrder(sInvono,sName,sCompanyId,sSaler,sInout:string;nAmount:real;dIoDate:TDatetime);
begin
  with datamodule2 do
  begin
    if query1.active then query1.close;
    query1.sql.clear;
    if (nDatabaseType=DataSQL7) then
      query1.sql.add('insert into orders values ( :Invono, :name , :Amount, :inout, :iodate, :iotime, :operator, :saler, :buyer, :scompanyid, :others, :whid,0)')
    else
      query1.sql.add('insert into orders values ( :Invono, :name , :Amount, :inout, :iodate, :iotime, :operator, :saler, :buyer, :scompanyid, :others, :whid,false)');
    query1.params[0].asstring:=sInvoNO;
    query1.params[1].asstring:=sName;
    query1.params[2].asfloat:=nAmount;
    query1.params[3].asstring:=sInout;
    query1.params[4].asdatetime:=dIODate;
    query1.params[5].asstring:=copy(timetostr(time),1,5);
    query1.params[6].asstring:=sUsrName;
    query1.params[7].asstring:=sSaler;
    query1.params[8].asstring:='';
    query1.params[9].asstring:=sCompanyid;
    query1.params[10].asstring:='';
    query1.params[11].asstring:=sWhid;

    query1.execsql;

    query1.sql.clear;
    query1.sql.add('update items set invono= :invono,oldprice=price where invono= :invono1');
    query1.params[0].asstring:=sInvoNO;
    query1.params[1].asstring:=sCompanyId;

    query1.execsql;
  end;

end;

procedure TDataPub.UpdateOrder(sInvono:string;nAmount:real);
begin
  with datamodule2 do
  begin
    if query1.active then query1.close;
    query1.sql.clear;
    query1.sql.add('update orders set amount= :amount where invono= :invono');
    query1.params[0].asfloat:=nAmount;
    query1.params[1].asstring:=sInvoNO;

    query1.execsql;

    query1.sql.clear;
    query1.sql.add('update items set oldprice=price where invono= :invono1 and oldPrice<>price');
    query1.params[0].asstring:=sInvoNO;

    query1.execsql;

  end;
end;

procedure TDataPub.CancelOrder(sInvono:string);
begin
  with datamodule2 do
  begin
    if query1.active then query1.close;
    query1.sql.clear;
    query1.sql.add('update orders set amount= 0,IsProceed=true,others1= :others where invono= :invono');
    query1.params[0].asstring:='取消';
    query1.params[1].asstring:=sInvoNO;

    query1.execsql;
  end;
end;

procedure TDataPub.UpCusbill(sId,sBarcode:string;nOldPrice,nNewPrice:real);
begin
  //***security use
  with dataModule2 do
  begin
   if (nOldPrice<>nNewPrice) and (nOldPrice>0)  and bPenStyle and (datapub.nDatabaseType<>DataError) then
   begin
     if query1.Active then query1.close;
     query1.sql.clear;
     query1.sql.add('update cusbill set saleprice= :saleprice where id= :id and barcode= :barcode');
     query1.params[0].asfloat:=nNewPrice;
     query1.params[1].asstring:=sId;
     query1.params[2].asstring:=sBarcode;
     query1.execsql;
   end;
   //not this old price,insert
   if (nOldPrice=0) and (nNewPrice>0) then
   begin
     if query1.Active then query1.close;
     query1.sql.clear;
     query1.sql.add('insert into cusbill values( :id, :barcode, :saleprice)');
     query1.params[0].asstring:=sId;
     query1.params[1].asstring:=sBarcode;
     query1.params[2].asfloat:=nNewPrice;
     query1.execsql;
   end;
  end; //end of datamodule2
end;

procedure TDataPub.InsertIOstore(bClearSql:boolean;nDirection,nSeq:integer;sInvo,
      sbarcode,sunits,smemo1:string;nQty,
      nprice,nProfit,nBal_qty,nBal_price,nCost:real;IODate,pro_date,exp_date:Tdatetime);
var
  sSql:string;
begin
  //1:instore ,2:outstore, 3:iostore,4:转仓
  if nDirection=1 then
  begin
    sSql:='insert into instore  values ( :invono, :seq, :barcode, :qty, :price,';
    ssql:=sSql+'   :units, :iodate, :iotime, :pro_date, :exp_date,0)';
  end;
  if nDirection=4 then
  begin
    sSql:='insert into instore  values ( :invono, :seq, :barcode, :qty, :price,';
    ssql:=sSql+'   :units, :iodate, :iotime, :pro_date, :exp_date, :qty1)';
  end;
  if nDirection=2 then
  begin
    sSql:='insert into outstore (invono,barcode,outqty,saleprice,profit,units,outdate,outime,memo1,pro_date,exp_date,cost';
    if nDatabaseType=2 then
       sSql:=sSql+' ,seq )'
    else  sSql:=sSql+' )';
    sSql:=sSql+'  values ( :invono, :barcode, :qty, :price, :profit,';
    ssql:=sSql+'  :units, :iodate, :iotime, :memo1, :pro_date, :exp_date, :cost';
    if nDatabaseType=2 then
      sSql:=sSql+', :seq )'
    else
      sSql:=sSql+' )'
  end;

  with datamodule2 do
  begin
  if bClearsql then
  begin
    queryIO.sql.clear;
    queryIO.sql.add(sSql);
  end;

  if (nDirection=1) or (nDirection=4) then
  begin
    queryIo.params[0].asstring:=sInvo;
    queryIo.params[1].asinteger:=nSeq;
    queryIo.params[2].asstring:=sbarcode;
    queryIo.params[3].asfloat:=nQty;
    queryIo.params[4].asfloat:=nPrice;
    queryIo.params[5].asstring:=sUnits;
    queryIO.params[6].asDatetime:=IOdate;
    queryIo.params[7].asstring:=copy(timetostr(time),1,5);
    queryIO.params[8].asDatetime:=pro_date;
    queryIO.params[9].asDatetime:=exp_date;
    if nDirection=4 then
      queryIo.params[10].asfloat:=nQty*2;//避免入先进先出的退货
  end
  else  if nDirection=2 then begin
    queryIo.params[0].asstring:=sInvo;
    queryIo.params[1].asstring:=sbarcode;
    queryIo.params[2].asfloat:=nQty;
    queryIo.params[3].asfloat:=nPrice;
    queryIo.params[4].asfloat:=nprofit;
    queryIo.params[5].asstring:=sUnits;
    queryIO.params[6].asDatetime:=IOdate;
    queryIo.params[7].asstring:=copy(timetostr(time),1,5);
    queryIO.params[8].asString:=sMemo1;
    queryIO.params[9].asDatetime:=pro_date;
    queryIO.params[10].asDatetime:=exp_date;
    queryIo.params[11].asfloat:=nCost;
    if nDatabaseType=2 then
      queryIo.params[12].asinteger:=nSeq;
  end;
  QueryIo.execsql;
  end;//end of datamoudle2
end;

//FIFO,件数、零数、售价、包装规格、出仓单位
Function TDataPub.DoFIFO(nQty,nLastQty,nSaleprice,nPerQty,nInprice:real;sBarcode,sUnits:string):real;
var
  nQty1,nLastQty1,nOutQty:real;
  nProfit:real;
begin
  nQty1:=nQty;
  nLastQty1:=nLastqty;
  nProfit:=0;
  with dataModule2 do
  begin
    if querySum.Active then querySum.close;
    querySum.sql.clear;
    querySum.sql.add('select * from instore where barcode= :barcode and inQty>Qty1 order by inDate');
    querySum.params[0].asString:=sBarcode;
    querySum.Open;

    while not querySum.eof do
    begin
      if (sUnits=QuerySum['units']) or (nPerQty<=1) then //单位相同 或规格<=1可以忽略
      begin
        nOutQty:=Querysum['Inqty']- Querysum['qty1'];
        if nQty1+nLastQty1 <= nOutQty then  //一次减完
          nOutQty:=nQty1+nLastQty1;

        //累计每次利润
        nProfit:=nProfit+nOutQty*(nSalePrice-QuerySum['inprice']);
        //nCost:=nCost+nOutQty*QuerySum['inprice']; //成本

        //每次减数
        if nQty=0 then
          nLastQty1:=nLastQty1-nOutQty
        else nQty1:=nQty1-nOutQty;

        //更新instore'qty1
        UpdateOneFIFO(querySum['invono'],querySum['seq'],nOutQty);

        //已减完，返回
        if nLastqty1+nQty1<=0 then break;
      end
      else //单位不同
      begin
        nOutQty:=Querysum['Inqty']- Querysum['qty1'];
        if nQty>0 then //进零，出件
        begin
          if (nQty1+nLastQty1)*nPerQty <= nOutQty then  //一次减完
            nOutQty:=(nQty1+nLastQty1)*nPerQty;

          //累计每次利润
          nProfit:=nProfit+nOutQty*(nSalePrice/nPerQty-QuerySum['inprice']);
          //每次减数
          nQty1:=nQty1-int(nOutQty*100/nPerqty+0.5)/100;
        end
        else    //进件,出零
        begin
          if (nQty1+nLastQty1)/nPerQty <= nOutQty then  //一次减完
            nOutQty:=int((nQty1+nLastQty1)*1000/nPerQty+0.5)/1000;

          //累计每次利润
          nProfit:=nProfit+nOutQty*nPerQty*(nSalePrice-QuerySum['inprice']/nPerqty);

          //每次减数
          nLastqty1:=nLastQty1-nOutQty*nPerqty;
        end;

        //更新instore'qty1
        UpdateOneFIFO(querySum['invono'],querySum['seq'],nOutQty);

        //已减完，返回
        if nLastqty1+nQty1<=0.005 then break;
      end; //else end

      QuerySum.next;
    end; //end of QuerySum.eof

    QuerySum.close;
  end; //end of datamodule2

  //未有进仓记录,用平均价计利润
  if nLastQty1+nQty1>0.005 then
    if nQty>0 then
      nProfit:=nProfit+(nQty1+nLastQty1/nPerQty)*(nSalePrice-nInprice)
    else
      nProfit:=nProfit+nLastQty1*(nSalePrice-nInprice);
  //保留三位小数
  result:=int(nProfit*1000)/1000;
end;

procedure TDataPub.UpdateOneFIFO(sInvo:string;nseq:integer;nQty1:real);
begin
  with dataModule2 do
  begin
    if query1.Active then query1.close;
    query1.sql.clear;
    query1.sql.add('update instore set qty1=qty1+ :qty1 where invono= :invono and seq= :seq');
    query1.params[0].asfloat:=nQty1;
    query1.params[1].asstring:=sInvo;
    query1.params[2].asinteger:=nSeq;

    query1.execsql;
  end;
end;

//back FIFO,件数、零数、售价、包装规格、出仓单位
Function TDataPub.BackFIFO(nQty,nLastQty,nSaleprice,nPerQty,nInprice:real;sBarcode,sUnits:string):real;
var
  nQty1,nLastQty1,nOutQty:real;
  nProfit:real;
begin
  nQty1:=nQty; //件数
  nLastQty1:=nLastqty; //零数
  nProfit:=0;
  with dataModule2 do
  begin
    //已进行过先进先出的进仓条目 qty1>0 desc(入仓日期递减)
    if querySum.Active then querySum.close;
    querySum.sql.clear;
    querySum.sql.add('select * from instore where barcode= :barcode and Qty1>0 and qty1 <= inqty order by inDate desc');
    querySum.params[0].asString:=sBarcode;
    querySum.Open;

    while not querySum.eof do
    begin
      if (sUnits=QuerySum['units']) or (nPerQty<=1) then //单位相同 或规格<=1可以忽略
      begin
        nOutQty:=Querysum['qty1'];
        if nQty1+nLastQty1 <= nOutQty then  //一次退完
          nOutQty:=nQty1+nLastQty1;

        //累计每次利润
        nProfit:=nProfit+nOutQty*(nSalePrice-QuerySum['inprice']);

        //每次减数,nQty=0,减零数
        if nQty=0 then
          nLastQty1:=nLastQty1-nOutQty
        else nQty1:=nQty1-nOutQty;

        //更新instore'qty1
        UpdateOneFIFO(querySum['invono'],querySum['seq'],-nOutQty);

        //已减完，返回
        if nLastqty1+nQty1<=0 then break;