datamodule1.pas

飞恒进销存,从盒子上下来的,不知这里有没有.

  //debug use
{  bInputTip:=true;
  nSysLevel1:=1;//strtoint(sSelection[5]); //各级编码的总长（含上级）
  nSysLevel2:=2;//nSysLevel1+strtoint(sSelection[6]);
  nSysLevel3:=3;//nSysLevel2+strtoint(sSelection[7]);
}
end;

procedure TDataE2.DataModule2Create(Sender: TObject);
begin
//
end;

procedure TDataE2.InitTblName ;
var
  i:integer;
begin
  for i:=0 to 110 do aTblName[i]:='';

  aTblname[0]:='I_ORDER';
  aTblname[1]:='I_INSTORE';
  aTblname[2]:='I_RETURN';
  aTblname[3]:='I_PAY';

  aTblname[10]:='O_ORDER';
  aTblname[11]:='O_OUTSTORE';
  aTblname[12]:='O_RETURN';
  aTblname[13]:='O_CHARGE';

  aTblname[17]:='D_BankInOut';
  aTblname[18]:='D_REPAIR';

  aTblname[21]:='D_CHECK';
  aTblname[22]:='D_MOVE';

  aTblname[23]:='POS_BILL';

  aTblname[24]:='I_BUILD';
  aTblname[25]:='I_TEAR';

  aTblname[26]:='D_INOUT'; //in  其它出入库
  aTblname[27]:='D_INOUT'; //out

  aTblname[30]:='D_MATERIAL';

  aTblname[33]:='D_INCOME';
  aTblname[35]:='IO_Gas';

  aTblname[43]:='D_EXPENSE';
  aTblname[45]:='EXPENSE_Total'; //费用开支汇总表
  aTblname[46]:='EXPENSE_Detail'; //费用开支明细表

  //Instore
  aTblname[50]:=UpperCase('VendorPurchase_Total');
  aTblname[51]:=UpperCase('VendorPurchase_Detail');
  aTblname[52]:=UpperCase('GoodsPurchase_Total');
  aTblname[53]:=UpperCase('GoodsPurchase_Detail');
  aTblname[54]:=UpperCase('EmployPurchase_Total');
  aTblname[55]:=UpperCase('EmployPurchase_Detail');
  aTblname[56]:=UpperCase('PurchaseNoPayment');
  aTblname[57]:=UpperCase('RptI_OrderD');
  aTblname[58]:=UpperCase('PurchasePay_Total');
  aTblname[59]:=UpperCase('PurchasePay_Detail');

  //outstore
  aTblname[70]:=UpperCase('ClientSale_Total');
  aTblname[71]:=UpperCase('ClientSale_Detail');
  aTblname[72]:=UpperCase('GoodsSale_Total');
  aTblname[73]:=UpperCase('GoodsSale_Detail');
  aTblname[74]:=UpperCase('EmploySale_Total');
  aTblname[75]:=UpperCase('EmploySale_Detail');
  aTblname[76]:=UpperCase('StoreSale_Total');
  aTblname[77]:=UpperCase('StoreSale_Detail');
  aTblname[78]:=UpperCase('ClientProfit_Total');
  aTblname[79]:=UpperCase('ClientProfit_Detail');
  aTblname[80]:=UpperCase('ClientProfit_ByInvo');
  aTblname[81]:=UpperCase('SaleNoPayment');
  aTblname[82]:=UpperCase('RptO_OrderD');
  aTblname[83]:=UpperCase('SaleCharge_Total');
  aTblname[84]:=UpperCase('SaleCharge_Detail');
  aTblname[87]:='GoodsTypeProfit'; // 货品类别销售毛利表
  aTblname[88]:='DaySaleProfit'; // 日销售毛利汇总表
  aTblname[89]:=UpperCase('ClientSale_Detail2'); // 客户销售明细表-传统模式

  aTblname[85]:='Repair'; // 维修情况表
  aTblname[86]:='RepairProfit_Detail'; // 维修按单毛利表

  //goods
  aTblname[90]:=UpperCase('StoreCurrent_Detail');
  aTblname[91]:=UpperCase('GoodsStore_Total');
  aTblname[92]:=UpperCase('GoodsInOut_Total');
  aTblname[93]:=UpperCase('GoodsInOut_Detail');

  aTblname[94]:=UpperCase('OtherInOut_Total');
  aTblname[95]:=UpperCase('OtherInOut_Detail');

  aTblname[96]:=UpperCase('StoreLack_Detail');
  aTblname[97]:=UpperCase('StoreOver_Detail');

  aTblname[49]:=UpperCase('Bank_Total');
  aTblname[98]:=UpperCase('Bank_Detail');
  aTblname[99]:=UpperCase('Cash_Detail');

  aTblname[60]:=UpperCase('Operator_Total'); // 收银员销售汇总表
  aTblname[61]:=UpperCase('POSTURN');

  aTblname[100]:=UpperCase('eventLog');
  //POS资料
  aTblname[101]:='frmVIPCards'; //VIPCards 会员卡资料
  aTblname[102]:='frmPosVIPDiscount'; // 优惠卡消费折扣表
  aTblname[103]:='frmPosVIPTotal'; // 优惠卡消费汇总表
  aTblname[104]:='frmPosVIPDetail'; // 优惠卡消费明细表
end;

procedure TDataE2.tblType2CalcFields(DataSet: TDataSet);
begin
  with tblType2 do
    if not (tbltype2.State in [dsInsert,dsEdit]) then
    begin
       FieldByName('codename').value:='  '+trim(FieldByName('code2').value)+'   '+trim(FieldByName('name').value);
    end;
end;

procedure TDataE2.DataModule2Destroy(Sender: TObject);
begin
  if gTableId>-1 then
  begin
    tblGoods.close;
    tbltype.close;
    tbltype1.close;
    tblType2.close;
    queryDetail.Close;
    AdoConStore.connected:=false;
  end;
end;

procedure TDataE2.tblTypeCalcFields(DataSet: TDataSet);
begin
  with tbltype do
    if not (tbltype.State in [dsInsert,dsEdit]) then
        FieldByName('codename').value:=' '+trim(FieldByName('type').value)+' '+trim(FieldByName('name').value);
end;

procedure TDataE2.tblType1CalcFields(DataSet: TDataSet);
begin
  with tbltype1 do
    if not (tbltype1.State in [dsInsert,dsEdit]) then
    begin
      FieldByName('codename').value:=' '+trim(FieldByName('code1').value)+' '+trim(FieldByName('name').value);
    end;
end;

//for access source :fhmrpData
//编码类型、进出选择
procedure TDataE2.CalGroup(nTypeindex,nIOindex:integer;dDate1,dDate2:Tdatetime;sBar,sName:string);
var
  s:string;
  nType:integer;
begin
     // delete tmp table
     adoCmd.commandtext:='delete from tmp1';
     adoCmd.execute;
     if ntypeindex=1 then
     begin;
       adoCmd.commandText:='delete from tmp2';
       adoCmd.execute;
     end;

     // instore 入仓分析
     if nIOindex=0 then
     begin
      nType:=1;
      if nTypeIndex=0 then nType:=dataE2.nSysLevel1;
      if nTypeIndex=1 then nType:=dataE2.nSysLevel2;
      s:='insert into tmp1 select units, ';
      if nTypeindex<>2 then
        s:=s+' left(barcode,'+inttostr(nType)+') as barcode1,'
      else
        s:=s+' barcode as barcode1,';
      s:=s+' sum(inqty) as sumQty,sum(inqty*inPrice) as sumAmount';
      s:=s+' from ledger a,instore where a.name like :name and a.iodate between :outdate1 and  :Outdate2 and a.invono=instore.invono';
      s:=s+' and barcode like :barcode and inPrice>0 group by ';
      if nTypeIndex<>2 then
        s:=s+' left(barcode,'+intTostr(nType)+'), units'
      else
        s:=s+' barcode,units';
      s:=s+' order by '+ ' left(barcode,'+intTostr(nType)+')'
     end; //end of rdoInout=0


     if nIOindex=1 then //出仓分析
     begin
      nType:=1;
      if nTypeIndex=0 then nType:=dataE2.nSysLevel1;
      if nTypeIndex=1 then nType:=dataE2.nSysLevel2;
      s:='insert into tmp1 select units,';
      if nTypeIndex<>2 then
        s:=s+' left(barcode,'+inttostr(nType)+') as barcode1,'
      else
        s:=s+' barcode as barcode1,';
      s:=s+' sum(Outqty) as sumQty,sum(Outqty*salePrice) as sumAmount';
      s:=s+' from ledger a,outstore where a.name like :name and a.iodate between :outdate1 and  :Outdate2 and a.invono=outstore.invono';
      s:=s+' and barcode like :barcode and salePrice>0 group by';
      if ntypeindex<>2 then
        s:=s+' left(barcode,'+intTostr(nType)+'),units'
      else
        s:=s+' barcode,units';
      s:=s+' order by '+' left(barcode,'+intTostr(nType)+')'
     end; //end of rdoInout=1

     adoCmd.commandText:=s;
     adoCmd.parameters[0].value:=sName;
     adoCmd.parameters[1].value:=dDate1;
     adoCmd.parameters[2].value:=dDate2;
     adoCmd.parameters[3].value:=sBar;
     adoCmd.execute;

     case nTypeindex of
     0: //一类
       s:=' select * from tmp1 a,goodskind b where a.barcode1=b.type';
     1:     begin //二类
       s:=' insert into tmp2 select a.type+a.code1 as type ,a.name  from goodstype a ,goodskind b ';
       s:=s+'where a.type=b.type';
       adoCmd.commandText:=s;
       adoCmd.execute;
       s:=' select * from tmp1 a,tmp2 b where a.barcode1=b.type order by a.barcode1';
       end;
     2: //不分类
       s:=' select * from tmp1 a,store b where a.barcode1=b.barcode order by a.barcode1';
     end;

     queryIo.close;
     queryIo.sql.clear;
     queryIO.sql.add(s);
     queryIO.open;
end; //end of calGroup

//新的用户无权限，先要加入权限，再打开
Procedure TdataE2.InsertRightsReopen(sNumber:string);
begin
  adoCmd.commandtext:='insert into rights ( number,name,type,ispermit) select :number1,name,type,ispermit  from rights where number= :number';
  adocmd.Parameters[0].Value :=sNumber;
  adocmd.Parameters[1].Value :='SYSTEM';
  adoCmd.execute;

  if querySum.active then querySum.Close;
  querySum.sql.clear;
  querySum.SQL.add('select * from rights where number= :number');
  querySum.Parameters[0].value:=sNumber;
  querySum.open;
end;

function TdataE2.OpenTable(Sql:string;nParm:integer):boolean;
begin
  if adoQuery1.active then adoQuery1.close;
  adoQuery1.sql.clear;
  adoQuery1.sql.add(Sql);
  adoQuery1.Parameters[0].Value :=nParm;
  adoQuery1.Open;
  result:= not adoQuery1.eof; //有此记录，返回true;
end;

function TdataE2.OpenTable(Sql:string;sParm:string):boolean;
begin
  if adoQuery1.active then adoQuery1.close;
  adoQuery1.sql.clear;
  adoQuery1.sql.add(Sql);
  adoQuery1.Parameters[0].Value :=sParm;
  adoQuery1.Open;
  result:= not adoQuery1.eof; //有此记录，返回true;
end;

function TdataE2.GetLastSalePrice(nVendorId,nGoodsId:integer;bdisc:Boolean):real;
var
  nprice,nprice2:real;
begin
  with adoQuery1 do
  begin
    Close;
    SQL.Clear;
    SQL.Add('select * from Goods where goodsid= :goodsid');
    Parameters[0].Value:=nGoodsId;
    Open;
  end;
  if nVendorId <0 then
  begin
    if not bdisc then
      result:=adoQuery1.fieldbyname('speprice').ascurrency
    else
      result:=adoQuery1.fieldbyname('speprice2').ascurrency; end
  else begin
    if QueryCusBill.active then QueryCusBill.close;
    QueryCusBill.Parameters[0].Value :=nVendorId;
    QueryCusBill.Parameters[1].Value :=nGoodsId;
    QueryCusBill.Open;
    if not queryCusBill.eof then
    begin
      nprice:=queryCusBill.fieldbyname('price').ascurrency;
      nprice2:=queryCusBill.fieldbyname('price2').ascurrency;
      if nprice=0 then
        nprice:=adoQuery1.fieldbyname('speprice').ascurrency;
      if nprice2=0 then
        nprice2:=adoQuery1.fieldbyname('speprice2').ascurrency;
      if not bdisc then
        result:= nprice
      else
        result:= nprice2; end
    else
    begin
      //result:=adoQuery1.fieldbyname('saleprice').ascurrency;
      if not bdisc then
        result:=adoQuery1.fieldbyname('speprice').ascurrency
      else
        result:=adoQuery1.fieldbyname('speprice2').ascurrency
    end;
  end;
end;

procedure  TDataE2.UpdateCusBill(nVendorId,nGoodsId:integer;nPrice:real;bdisc:Boolean);
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pcdUpdateCusbill;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=nVendorId;
      AdoStp1.Parameters[2].value:=nGoodsid;
      AdoStp1.Parameters[3].value:=nPrice;
      AdoStp1.Parameters[4].value:=bDisc;
    except
    end;
    Adostp1.execproc;
end;

Function TDataE2.GetMaxOutid:integer;
begin
  // get max outmp1 's id, not is 1
  if adoQuery1.active then adoQuery1.close;
  adoQuery1.sql.clear;
  adoQuery1.sql.add('select max(id) as maxid from outmp1');
  adoQuery1.Open;
  if not adoQuery1.eof then
    result:=adoQuery1.fieldbyname('maxid').asinteger
  else
    result:=0;

end;

Procedure TDataE2.DayInsLedger;
begin
  if adoQuery1.active then adoQuery1.close;
  adoQuery1.sql.clear;
  adoQuery1.sql.add('exec pcdDayInsLedger ');
  adoQuery1.execsql;
end;

Function  TDataE2.GetBillId(tablename:string):integer;
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pr_IDs;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=uppercase(tablename);
      AdoStp1.Parameters[2].value:=1;
      AdoStp1.Parameters[3].value:='NEW';
      Adostp1.Parameters[2].Direction:=pdInputOutput;
    except
    end;
    Adostp1.execproc;

    result:=Adostp1.Parameters[2].value;
end;

Function  TDataE2.GetInvoNo(tablename,sFunction:string):string;
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pcdInvono;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=uppercase(tablename);
      AdoStp1.Parameters[2].value:=1;
      AdoStp1.Parameters[3].value:=sFunction;
      AdoStp1.Parameters[4].value:='';
      Adostp1.Parameters[4].Direction:=pdInputOutput;
    except
    end;
    Adostp1.execproc;

    result:=Adostp1.Parameters[4].value;
end;

procedure TDataE2.InsEvent(appopr,description:string);
begin
  AdoStp1.Close;
  AdoStp1.ProcedureName :='pcdInsEvent;1';
  try
    AdoStp1.Parameters.Refresh;
  except
  end;

  AdoStp1.Parameters[1].value:=myUsrname;
  AdoStp1.Parameters[2].value:=myComputerName;
  AdoStp1.Parameters[3].value:=appopr;
  AdoStp1.Parameters[4].value:=description;
  AdoStp1.ExecProc;
end;

Procedure  TDataE2.DayAuditPayed(Billdate:TdateTime);
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pcdDayAuditPayed;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=BillDate;
    except
    end;
    Adostp1.execproc;
end;

Procedure  TDataE2.DayAuditNoPay(Billdate:TdateTime);
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pcdDayAuditNoPay;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=BillDate;
    except
    end;
    Adostp1.execproc;
end;

Procedure  TDataE2.UpOnhandQty1(nTarGoodsId,nTarStoreId:integer;qty1:real);
begin
    AdoStp1.Close;
    AdoStp1.ProcedureName :='dbo.pcdUpOnhandQty1;1';
    try
      AdoStp1.Parameters.Refresh;
      AdoStp1.Parameters[1].value:=nTarStoreId;
      AdoStp1.Parameters[2].value:=nTarGoodsId;
      AdoStp1.Parameters[3].value:=Qty1;
    except
    end;
    Adostp1.execproc;
end;

procedure TDataE2.InsertIOrder(nBillid,nVendorId,nEmployId:integer;dBillDate:tdatetime;sInvono,sMemo,sTable:string);
begin
    adoCmd.commandtext:='insert into '+sTable+' values ( :BillId, :invono , :Venderid, 0, :billdate, :ddate, :dPlace, :operator, :EmployId, null,null,1,0,0,0, :memo)';
    adoCmd.parameters[0].value:=nBillId;
    adoCmd.parameters[1].value:=sInvono;
    adoCmd.parameters[2].value:=nVendorId;
    adoCmd.parameters[3].value:=dBillDate;
    adoCmd.parameters[4].value:=now;
    adoCmd.parameters[5].value:='';