datamodule1_b.pas

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

unit datamodule1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Db, DBTables,printers, ADODB,registry;

Const
  CopyRight='清远市飞恒软件工程公司';
  Developer='FeiHengSoftwareBuildedBySunXiaoMing';
  Software='酒店信息管理系统';
  EncodeKey=#143#7#91#37;
  
  MaxMDIChild=5; //may open mdichild

  ChenAnHotel=1;
  GuestHouse=2;
  ZXHotel=3;
  GuestFood=4;
  CYHotel=5;
  HCBBGHotel=6;
type
  TDataE2 = class(TDataModule)
    dsGoods: TDataSource;
    dsType: TDataSource;
    dsType1: TDataSource;
    dsType2: TDataSource;
    dsOpr: TDataSource;
    DSCus1: TDataSource;
    dsStore: TDataSource;
    dsBank: TDataSource;
    dsDept: TDataSource;
    dsUnit: TDataSource;
    dsDetail: TDataSource;
    adoConStore: TADOConnection;
    tblOpr: TADOTable;
    tblStore: TADOTable;
    tblBank: TADOTable;
    tblMemo: TADOTable;
    tblType: TADOTable;
    tblUnit: TADOTable;
    tblDept: TADOTable;
    tblType2: TADOTable;
    tblType1: TADOTable;
    ADOQuery1: TADOQuery;
    adoCmd: TADOCommand;
    QueryLedger: TADOCommand;
    QueryIO: TADOQuery;
    QueryGoods: TADOQuery;
    QuerySum: TADOQuery;
    QueryCusBill: TADOQuery;
    QueryCus: TADOQuery;
    QueryTmp: TADOQuery;
    QueryCus1: TADOQuery;
    DataSource1: TDataSource;
    tblTypetype: TWideStringField;
    tblTypename: TWideStringField;
    tblTypedesk: TSmallintField;
    tblTypecodeName: TStringField;
    tblType1type: TWideStringField;
    tblType1code1: TWideStringField;
    tblType1name: TWideStringField;
    tblType1codeName: TStringField;
    tblType2type: TWideStringField;
    tblType2code1: TWideStringField;
    tblType2code2: TWideStringField;
    tblType2name: TWideStringField;
    tblType2codeName: TStringField;
    AdoStp1: TADOStoredProc;
    QueryRpt: TADOQuery;
    dsRpt: TDataSource;
    dsven: TDataSource;
    queryDetail: TADOQuery;
    tblemploy: TADOTable;
    dsemploy: TDataSource;
    tblclienttype: TADOTable;
    dsclienttype: TDataSource;
    tblvdtype: TADOTable;
    dsvdtype: TDataSource;
    tblUnitunitId: TWordField;
    tblUnitunits: TWideStringField;
    tblUnitunit2: TWideStringField;
    tblStoreSTOREID: TAutoIncField;
    tblStoreNAME: TStringField;
    tblStoreLOCATION: TStringField;
    tblStoreCLOSED: TBooleanField;
    tblDeptdeptid: TAutoIncField;
    tblDeptdepartment: TWideStringField;
    tblclienttypeCTTYPEID: TSmallintField;
    tblclienttypeName: TStringField;
    tblclienttypeCLOSED: TBooleanField;
    queryDlg: TADOQuery;
    dsCus: TDataSource;
    dsSubarea: TDataSource;
    tblSubarea: TADOTable;
    dsDlg: TDataSource;
    tblIOTYPE: TADOTable;
    tblIOTYPETypeId: TIntegerField;
    tblIOTYPECode: TStringField;
    tblIOTYPENAME: TStringField;
    tblIOTYPEIsIn: TBooleanField;
    tblIOTYPEFlag: TBooleanField;
    tblIOTYPEMemo: TStringField;
    dsIOTYPE: TDataSource;
    tblPaytype: TADOTable;
    tblPaytypePayTypeID: TSmallintField;
    tblPaytypeCode: TStringField;
    tblPaytypeName: TStringField;
    tblPaytypeBankID: TSmallintField;
    tblPaytypeIsSend: TSmallintField;
    dspaytype: TDataSource;
    dsIetype: TDataSource;
    tblIetype: TADOTable;
    dsQGoods: TDataSource;
    tblSubareaAREAID: TIntegerField;
    tblSubareaNAME: TStringField;
    tblSubareaCLOSED: TBooleanField;
    tblemployEmployID: TAutoIncField;
    tblemployCode: TStringField;
    tblemployName: TStringField;
    tblemploydeptid: TIntegerField;
    tblemployDuty: TStringField;
    tblemployPostcode: TStringField;
    tblemployForefather: TStringField;
    tblemployPay: TFloatField;
    tblemploySex: TStringField;
    tblemployBirthday: TDateTimeField;
    tblemployIdCard: TStringField;
    tblemployAddress: TStringField;
    tblemployEmail: TStringField;
    tblemployCulture: TStringField;
    tblemployPhone: TStringField;
    tblemployMobilePhone: TStringField;
    tblemployEnterDate: TDateTimeField;
    tblemployMemo: TStringField;
    tblemployIsExeMan: TBooleanField;
    tblemployIsSent: TBooleanField;
    tblemploybsal: TSmallintField;
    tblemploymedi: TSmallintField;
    tblemployallday: TSmallintField;
    tblemployplus1: TSmallintField;
    tblemployplus2: TSmallintField;
    tblemployminus1: TSmallintField;
    tblemploypuni: TSmallintField;
    tblemploymemo1: TWideStringField;
    tblemployplus3: TSmallintField;
    tblBankBankId: TSmallintField;
    tblBankCode: TStringField;
    tblBankName: TStringField;
    tblBankBankName: TStringField;
    tblBankBankCode: TStringField;
    tblBankFirstAmount: TBCDField;
    tblBankAmount: TBCDField;
    tblBankType: TSmallintField;
    tblIetypeCode: TStringField;
    tblIetypeName: TStringField;
    tblIetypeFlag: TSmallintField;
    tblIetypeMemo: TStringField;
    qRrights: TADOQuery;
    dsRights: TDataSource;
    QueryGoodsGoodsId: TAutoIncField;
    QueryGoodsCode: TStringField;
    QueryGoodsName: TStringField;
    QueryGoodscodeName: TStringField;
    dsSum: TDataSource;
    dsCon: TDataSource;
    QueryCon: TADOQuery;
    dsTmp: TDataSource;
    tblGoods: TADOQuery;
    Tblvendor: TADOQuery;
    tblClient: TADOQuery;
    tblposmch: TADOTable;
    dsposmch: TDataSource;
    qryType1: TADOQuery;
    qryType2: TADOQuery;
    qryGet: TADOQuery;
    procedure tblStoreCalcFields(DataSet: TDataSet);
    procedure tblGoodsCalcFields(DataSet: TDataSet);
    procedure tblKindCalcFields(DataSet: TDataSet);
    procedure DataModule2Create(Sender: TObject);
    procedure tblType2CalcFields(DataSet: TDataSet);
    procedure DataModule2Destroy(Sender: TObject);
    procedure tblTypeCalcFields(DataSet: TDataSet);
    procedure tblType1CalcFields(DataSet: TDataSet);
    procedure queryDetailNewRecord(DataSet: TDataSet);
    procedure queryDetailCalcFields(DataSet: TDataSet);
    procedure tblTypeNewRecord(DataSet: TDataSet);
    procedure tblType1NewRecord(DataSet: TDataSet);
    procedure tblType2NewRecord(DataSet: TDataSet);
    procedure QueryGoodsCalcFields(DataSet: TDataSet);
    procedure tblGoodsNewRecord(DataSet: TDataSet);
    procedure tblGoodsAfterScroll(DataSet: TDataSet);
//    function  int2StrPad0(N:integer;Len:integer):string;
  private
    { Private declarations }
    sSql:string;
    procedure InitTblName;
  public
    FirstRun:Boolean;
    myNumber,myUsrName,myComputerName:string;
    nBillId,nid:integer;
    gTableId:integer;   //等于-1时为恢复数据
    //用于表单和报表控制
    aTblName:array [0..110] of string;

    bInputTip:boolean;  //输入编码出现提示DBGRID

    nDatabaseType,nDatabaseTypeTmp:integer;
    StoreName,barcode1,sUser,sCustomer,sBillTail:string;
    sPrinter,sAddress,sTelphone:string;     // store chinese name, app's caption
    sPassword:string;
    printOption:boolean;          // true print,false preview  , used in paydlg
    bBackup:boolean;              //have backup data

    sStoreName,sWHName,sWhId:string;

    HotelName,sName,HotelId:string;
    InstallDate:Tdatetime;

    //for same form use
    softName:string;
    // software set for one hotel
    HotelSpe:integer;
    myInvodate:tDatetime; //财务日
    ReportPath:string;    //报表路径
    OrderType:string;

    //in setemp seted
    bNoStore,bExtraPage,bPrintIn:boolean;
    bPrintFrame:boolean; //由打印边框 改为 作废单不保留
    bExpDate:boolean;
    bNetFresh:boolean;
    bZone:boolean;//分区价格管理
    bPenStyle:boolean; //出仓单为实线 改为 自动客户价
    nSysPaper,nSysCopy:integer;
    nSysLevel1,nSyslevel2,nSysLevel3:integer;
    bWholeSale:boolean;    //sale or whole sale
    nSysItemPerPage,nSysLine:integer;
    nSample:integer;     //样本数量
    b7Seq:boolean;       //采用7位顺序号
    nSaveDataDay:integer;//字体大小 default=11
    bFIFO:boolean;       //先进先出
    bSafe:boolean;       //清除删除数据，即：清除前，设为0，
                         //因为只删除，在二进制可见
    bOutUnit2:boolean;   //出仓零数价优先
    nSumbit:integer;     //保留小数位数
    nInpriceType:integer;//库存进价方式：平均价=0，最新价=1
    bPrnCusTel:boolean;  //出仓单打印客户电话
    bAutoIO:boolean;     //出入库自动统计
    nBillStyle:integer;  //出仓单样式号 0：普通 1:美雅装饰
    bZeroProfit:boolean;    //出仓价为0 计利润
    bPrintBarcode:boolean;    //出仓时打印条形码
    nPageTopMargin,nPageBottomMargin:integer;    //页顶,底部留空(1,9)
    bSalePos:boolean; //零售时用条形码
    bTwoUnit:boolean; //出入仓用双单位
    bBatchSale:boolean; //批发--改为现款销售2005-06-24

    sPrnMemo,sPrnMemo2:string;
    //Can search inprice
    bInPrice:boolean;
    sSelection,sDataPath:string;

    SavePlace: TBookmark; //进入商品浏览时，保存当前数据位置
    //sSetEmp:string;       //控制页面的可见


    //物品单位
    aUnit : array  [1..2,1..10] of string;

    // form's width and height
    nFormWidth:integer;//=627;
    nFormHeight:integer;//=414;// have toolbar is 386;

    nNowFormWidth,nNowFormHeight :integer;
    nOrgFormWidth,nOrgFormHeight:integer;

    procedure EncodeHotel;
    procedure DecodeOneHotel;

    function EncodeString(mCusName,mKey:string):string;
    function SerialNo(mString: string): string;
    function RegisterCode(mstring,mCusNo :string):string;
    function ReadRegistry:string;
    function WriteRegistry:boolean;
    function GetWindowsPlatFormId:integer;

    Function  StrTailInc(sSource:string):string;
    function  GetLastMonth(xDate:TDatetime):Tdatetime;
    procedure DecodeSelection;
    Function  ToMyValue(oldValue:real):real;

    Function  GetMaxOutId:integer;
    procedure CalGroup(nTypeindex,nIOindex:integer;dDate1,dDate2:Tdatetime;sBar,sName:string);
    Procedure DayInsLedger; //每日进行日结，生成一个ledger记录,方便统计利润成本
    Function  GetBillId(tablename:string):integer;
    procedure InsEvent(appopr,description:string);
    Procedure DayAuditPayed(Billdate:TdateTime);
    Procedure DayAuditNoPay(Billdate:TdateTime);
    Procedure UpOnhandQty1(nTarGoodsId,nTarStoreId:integer;qty1:real);

    Function  OpenTable(Sql:string;nParm:integer):boolean;overload;
    Function  OpenTable(Sql:string;sParm:string):boolean; overload;
    function  GetLastSalePrice(nVendorId,nGoodsId:integer):real;
    procedure  UpdateCusBill(nVendorId,nGoodsId:integer;nPrice:real);
    Function  GetInvoNo(tablename,sFunction:string):string;

    Function  GetRefTblName(nTblid:integer):string;

    Procedure InsertRightsReopen(sNumber:string);
    Procedure InsertOnHand(nStoreId,nGoodsId:integer);

    procedure InsertIOrder(nBillid,nVendorId,nEmployId:integer;dBillDate:tdatetime;sInvono,sMemo,sTable:string);
    procedure InsertIInstore(nTblId,nBillid,nVendorId,nEmployId,nStoreId:integer;dBillDate:tdatetime;sInvono,sMemo:string);
    procedure InsertIReturn(nBillid,nVendorId,nEmployId,nStoreId,IsRCash:integer;dBillDate:tdatetime;sInvono,sMemo,sChekcNo,sTable:string);
    procedure InsertIPay(nBillid,nCusId,nEmployid,nBankId,nPayTypeId:integer;dBillDate:Tdatetime;sInvoNo,sMemo,sCheckNo,sPayStyle,sTable:string);

    procedure InsertDIncome(nBillid,nEmployid,nBankId,nPayTypeId:integer;dBillDate:Tdatetime;sInvoNo,sMemo,sCheckNo,sTable:string);

    procedure InsertDCheck(nBillid,nStoreid:integer;dBillDate:tdatetime;sInvono,sMemo:string);
    procedure InsertDMove(nBillid,nStoreid,nOutStoreId:integer;dBillDate:tdatetime;sInvono,sMemo:string);
    procedure InsertDInOut(nBillid,nStoreid,nEmployid,nIoTypeId:integer;dBillDate:TDatetime;sInvono,sMemo:string);

    procedure InsertIBuildTear(bNew:boolean;nBillid,nStoreId,nOutStoreId,nEmployId,GoodsId:integer;dBillDate:tdatetime;sInvono,sMemo,sTable:string;nQty,nPrice:real);
    procedure InsertDMaterial(nBillid,nEmployId,GoodsId:integer;dBillDate:tdatetime;sInvono,sMemo,sSelfCode:string;nQty:real);

    Function  GetPriorNext(bPrior:boolean;tablename:string;nBillId:integer):boolean;
    //Function  GetNext(tablename:string;nBillId:integer):boolean;
    Function  UPdateMasterAmt(nTblId,nBillId:integer):boolean;
    Function  UPdateRefTableAmt(nTblId,nBillId:integer):boolean;
    Function checkprimarykey(Tablename,FieldValue,sValue:string):boolean;//检查主键是否重复
    Function getcomputname:string; //得到计算机名
    procedure ShowAdoError;
  end;

var
  DataE2: TDataE2;
  //frname, tablename,sName, frsqlstr:string;
  //nform:integer;

implementation
uses dataE2, Unitmb, vendor_D;
{$R *.DFM}

Function  TDataE2.StrTailInc(sSource:string):string;
var
  c:char;
  i:integer;
  s:string;
begin
  result:='';
  i:=Length(sSource);

  if i< 1 then exit;

  s:=copy(sSource,i,1);
  c:=chr(ord(s[1])+1);
  result:=copy(sSource,1,i-1)+c;
end;

function TDataE2.GetLastMonth(xDate:TDatetime):Tdatetime;
var
   y,m,d:word;
   n:word;
begin
  //result like 2000-6-24 ,if xdate=2000-07-23
  decodedate(xdate,y,m,d);
  n:=d;
  decodedate(xdate-n,y,m,d);
  inc(n);
  if n>d then n:=d;
  result:=encodeDate(y,m,n);
end;

procedure TDataE2.tblStoreCalcFields(DataSet: TDataSet);
begin
     with tblGoods do