mylib.pas

delphi作得信息业进销存源码.功能全面,运行稳定.

unit MyLib;

interface

uses Windows, Dialogs, SysUtils, DBCtrls, DB, DBGrids, DBTables, Grids,
  stdctrls,clipbrd, menus,comctrls,Forms, Messages, Classes, Graphics, Controls,
  ExtCtrls, ImgList, ToolWin, Mask, Buttons, DBClient, syncobjs, FileCtrl, Variants;


function  GetDjbh(strDj: string; datRq: TDate; strTable: string): string; 	//取新的单号
function  GetSj(AHPID, ASJZLID: integer): Double; 	//取售价
function  ClearHotKey(strCaption: string): string; 	//取消字符串中的快捷键字符串
procedure ValuesToStrings(ssItem: TStrings; strSql: string);  //把SQL返回的第一个值放入Strings
procedure SetDBGridColor(Sender: TObject;
  const Rect: TRect; DataCol: Integer; Column: TColumn;
  State: TGridDrawState; ColColor: TColor);  //DBGrid 的行颜色
procedure StrToFile(Str, FileName: string);
//Create SQL
function  GetSqlHpqc(CKID, HPID: integer): string; 	//ID, BH, PM, DW, QCS1, QCJE1
function  GetSqlJcmx(RQA, RQB: TDate; CKID, HPID: integer): string; 	//All JC CC
function  GetSqlZhmx(RQA, RQB: TDate; ZHID: integer): string; 	//All ZHJC
function  GetSqlCgmx(RQA, RQB: TDate; strTj: string): string; 	//CGSH + CGTH (CHTH.SL -> -CGTH.SL)
function  GetSqlXsmx(RQA, RQB: TDate; strTj: string): string; 	//XSKD + XSTH (XSTH.SL -> -XSTH.SL)
function  GetSqlKhwl(RQA, RQB: TDate; KHID: integer): string; 	//XSKD(LX=2) + XSSK + XSTH(LX=2)
function  GetSqlYsmx(RQ: TDate; KHID: integer): string; 	//XSKD
function  GetSqlGyswl(RQA, RQB: TDate; GYSID: integer): string; 	//CGSH(LX=2) + CGFK + CGTH(LX=2)
function  GetSqlYfmx(RQ: TDate; GYSID: integer): string; 	//CGSH
function  GetSqlSzmx(RQA, RQB: TDate; SRZCLBID: integer): string; 	//FYKZ + QTSR
function  GetSqlRqLsz(RQA, RQB: TDate): string; 	//DJZB
function  GetSqlKhLsz(RQA, RQB: TDate; KHID: integer): string; 	//KHLSZ
function  GetSqlGysLsz(RQA, RQB: TDate; GYSID: integer): string; 	//GYSLSZ
function  GetSqlSzLsz(RQA, RQB: TDate): string; 	//SZLSZ
function  GetSqlLrmx(RQA, RQB: TDate): string; 	//XSKD + XSTH (XSTH.SL -> -XSTH.SL) + QTSR + FYKZ
//Open Dj
procedure OpenDj(LX, ZBID: Variant);
procedure OpenXsdd(ZBID: Variant);  //'销售订单'
procedure OpenXskd(ZBID: Variant);  //'现金销售' '挂帐销售'
procedure OpenXsth(ZBID: Variant);  //'销售退货'
procedure OpenXssk(ZBID: Variant);  //'销售收款'
procedure OpenXsSkgc(ZBID: Variant);  //'销售收款过程'
procedure OpenXsThgc(ZBID: Variant);  //'销售提货过程'
procedure OpenCgdd(ZBID: Variant);  //'采购订单'
procedure OpenCgsh(ZBID: Variant);  //'采购收货'
procedure OpenCgth(ZBID: Variant);  //'现金采购' '挂帐采购'
procedure OpenCgfk(ZBID: Variant);  //'采购付款'
procedure OpenCgFkgc(ZBID: Variant);  //'采购付款过程'
procedure OpenLl(ZBID: Variant);  //'领料'
procedure OpenTl(ZBID: Variant);  //'退料'
procedure OpenCpjc(ZBID: Variant);  //'产品进仓'
procedure OpenKcpd(ZBID: Variant);  //'库存盘点'
procedure OpenCkdb(ZBID: Variant);  //'仓库调拨' '仓库调入' '仓库调出'
procedure OpenQtkcbd(ZBID: Variant);  //'库存变动' '其它库存变动-减少' '其它库存变动-增加'
procedure OpenThgc(ZBID: Variant);  //'退还过程' '其它库存变动-退还增加' '其它库存变动-退还减少'
procedure OpenFykz(ZBID: Variant);  //'费用开支'
procedure OpenQtsr(ZBID: Variant);  //'其它收入'
procedure OpenYhckqk(ZBID: Variant);  //'其它收入'

implementation

uses
	Dm, Main, ComFun, Common, Xsdd, Xskd, Xsth, Cgdd, Cgsh, Cgth, XsSkgc, CgFkgc,
  Ll, Tl, Cpjc, Kcpd, Ckdb, Qtkcbd, Thgc, Xssk, Cgfk, Qtsr, Fykz, YhckqkCk, XsThgc;

//取新的单号
function GetDjbh(strDj: string; datRq: TDate; strTable: string): string;
var
  strDjbh: string;
  strRq: string;
begin
  strDjbh := '';
  strRq := strDj + FormatDateTime('YYMMDD', datRq);
  with CurDs do
  begin
    Close;
    CommandText := 'select top 1 DJBH from ' + strTable + ' ' +
      'where ID > 0 and DJBH like ''' + strRq + '%'' ' +
      'order by DJBH desc';
    Open;
    strDjbh := Fields[0].AsString;
    Close;
  end;
  if strDjbh = '' then
    strDjbh := strRq + '0001'
  else
  begin
    strDjbh := FormatFloat('0000', StrToInt(Copy(strDjbh, 9, 4)) + 1);
    strDjbh := strRq + strDjbh;
  end;
  result := strDjbh;
end;

//取售价
function GetSj(AHPID, ASJZLID: integer): Double;
begin
  with CurDs do
  begin
    Close;
    CommandText := 'select SJ from HPSJ ' +
      'where HPID = ' + IntToStr(AHPID) + ' and SJZLID = ' + IntToStr(ASJZLID);
    Open;
    if IsEmpty then
      result := 0
    else
      result := Fields[0].AsFloat;
    Close;
  end;
end;

//取消字符串中的快捷键字符串
function  ClearHotKey(strCaption: string): string;
begin
  if Pos('(&', strCaption) = 0 then
    result := strCaption
  else
    result := Copy(strCaption + 'a', 1, Pos('(&', strCaption) - 1);
end;

//把SQL返回的第一个值放入Strings
procedure ValuesToStrings(ssItem: TStrings; strSql: string);
begin
  ssItem.Clear;
  with CurDs do
  begin
    CommandText := strSql;
    Open;
    while not Eof do
    begin
      ssItem.Add(Fields[0].AsString);
      Next
    end;
    Close;
  end;
end;

//打开单据
procedure OpenDj(LX, ZBID: Variant);
var
  strLX: string;
begin
  if (VarToStr(LX) = '') or (VarToInt(ZBID) <= 0) then
  begin
    Application.MessageBox('不能打开此单据。', '操作失败', MB_OK + MB_ICONWARNING);
    Exit;
  end;
  strLX := VarToStr(LX);
  if (strLX = '销售订单') then
    OpenXsdd(ZBID)
  else if (strLX = '销售开单') or (strLX = '现金销售') or (strLX = '挂帐销售') then
    OpenXskd(ZBID)
  else if (strLX = '销售退货') then
    OpenXsth(ZBID)
  else if (strLX = '销售收款') then
    OpenXssk(ZBID)
  else if (strLX = '销售收款过程') then
    OpenXsSkgc(ZBID)
  else if (strLX = '采购订单') then
    OpenCgdd(ZBID)
  else if (strLX = '采购收货') or (strLX = '现金采购') or (strLX = '挂帐采购') then
    OpenCgsh(ZBID)
  else if (strLX = '采购退货') then
    OpenCgth(ZBID)
  else if (strLX = '采购付款') then
    OpenCgfk(ZBID)
  else if (strLX = '采购付款过程') then
    OpenCgFkgc(ZBID)
  else if (strLX = '领料') then
    OpenLl(ZBID)
  else if (strLX = '退料') then
    OpenTl(ZBID)
  else if (strLX = '产品进仓') then
    OpenCpjc(ZBID)
  else if (strLX = '库存盘点') then
    OpenKcpd(ZBID)
  else if (strLX = '仓库调拨') or (strLX = '仓库调入') or (strLX = '仓库调出') then
    OpenCkdb(ZBID)
  else if (strLX = '库存变动') or (strLX = '其它库存变动-减少') or (strLX = '其它库存变动-增加') then
    OpenQtkcbd(ZBID)
  else if (strLX = '退还过程') or (strLX = '其它库存变动-退还增加') or (strLX = '其它库存变动-退还减少') then
    OpenThgc(ZBID)
  else if (strLX = '费用开支') then
    OpenFykz(ZBID)
  else if (strLX = '其它收入') then
    OpenQtsr(ZBID)
  else if (strLX = '帐户转入') or (strLX = '帐户转出') then
    OpenYhckqk(ZBID)
  else
    Application.MessageBox('不能打开此单据。', '操作失败', MB_OK + MB_ICONWARNING);
end;

//'销售订单'
procedure OpenXsdd(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Xsddzb do
  begin
    Close;
    CommandText :=
      'select Z.*, iif(Z.ZT,''是'',''否'') as aZT, ' +
      'K.BH as aKHBH, K.MC as aKHMC ' +
      'from XSDDZB Z, KH K, Z inner join K on Z.KHID = K.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmXsdd := TfrmXsdd.Create(Application);
  with frmXsdd do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'现金销售' or '挂帐销售'
procedure OpenXskd(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Xskdzb do
  begin
    Close;
    CommandText :=
      'select Z.*, iif(XSLX=1, JE, YSJE) as YSJE1, JE - YSJE1 as MSJE, ' +
      'switch(XSLX=1,''现款'', XSLX=2,''挂帐'') as aXSLX, ' +
      'switch(FPLX=1,''收据'', FPLX=2,''普通发票'',FPLX=3,''增值税发票'') as aFPLX, ' +
      'K.BH as aKHBH, K.MC as aKHMC, ' +
      'C.MC as aCKMC, ' +
      'S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from XSKDZB Z,KH K,CK C, SFKFS S, ZH H, ' +
      'Z inner join K on Z.KHID = K.ID, ' +
      'Z inner join C on Z.CKID = C.ID, ' +
      'Z left join S on Z.SFKFSID = S.ID, ' +
      'Z left join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmXskd := TfrmXskd.Create(Application);
  with frmXskd do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'销售退货'
procedure OpenXsth(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Xsthzb do
  begin
    Close;
    CommandText :=
      'select Z.*, ' +
      'switch(THLX=1,''退现款给客户'', THLX=2,''退款转入客户预收款'') as aTHLX, ' +
      'K.BH as aKHBH, K.MC as aKHMC, ' +
      'C.MC as aCKMC,S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from XSTHZB Z,KH K,CK C,SFKFS S,ZH H, ' +
      'Z inner join K on Z.KHID = K.ID, ' +
      'Z inner join C on Z.CKID = C.ID, ' +
      'Z left join S on Z.SFKFSID = S.ID, ' +
      'Z left join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmXsth := TfrmXsth.Create(Application);
  with frmXsth do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'销售收款'
procedure OpenXssk(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Xsskzb do
  begin
    Close;
    CommandText :=
      'select Z.*, ' +
      'switch(FKLX=1,''应收款'', FKLX=2,''预收款'') as aFKLX, ' +
      'K.BH as aKHBH, K.MC as aKHMC, ' +
      'S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from XSSKZB Z, KH K, SFKFS S, ZH H, ' +
      'Z inner join K on Z.KHID = K.ID, ' +
      'Z inner join S on Z.SFKFSID = S.ID, ' +
      'Z inner join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmXssk := TfrmXssk.Create(Application);
  with frmXssk do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'采购订单'
procedure OpenCgdd(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Cgddzb do
  begin
    Close;
    CommandText :=
      'select Z.*, iif(Z.ZT,''是'',''否'') as aZT, ' +
      'K.BH as aGYSBH, K.MC as aGYSMC ' +
      'from CGDDZB Z, GYS K, Z inner join K on Z.GYSID = K.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmCgdd := TfrmCgdd.Create(Application);
  with frmCgdd do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'采购收货'
procedure OpenCgsh(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Cgshzb do
  begin
    Close;
    CommandText :=
      'select Z.*, iif(CGLX=1, JE, YFJE) as YFJE1, JE - YFJE1 as MFJE, ' +
      'switch(CGLX=1,''现款'', CGLX=2,''挂帐'') as aCGLX, ' +
      'switch(FPLX=1,''收据'', FPLX=2,''普通发票'', FPLX=3,''增值税发票'') as aFPLX, ' +
      'K.BH as aGYSBH, K.MC as aGYSMC, ' +
      'C.MC as aCKMC, ' +
      'S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from CGSHZB Z,GYS K,CK C, SFKFS S, ZH H, ' +
      'Z inner join K on Z.GYSID = K.ID, ' +
      'Z inner join C on Z.CKID = C.ID, ' +
      'Z left join S on Z.SFKFSID = S.ID, ' +
      'Z left join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmCgsh := TfrmCgsh.Create(Application);
  with frmCgsh do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'现金采购' '挂帐采购'
procedure OpenCgth(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Cgthzb do
  begin
    Close;
    CommandText :=
      'select Z.*, ' +
      'switch(THLX=1,''供应商退现款'', THLX=2,''退款转入预付款'') as aTHLX, ' +
      'K.BH as aGYSBH, K.MC as aGYSMC, ' +
      'C.MC as aCKMC, S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from CGTHZB Z, GYS K, CK C, SFKFS S, ZH H, ' +
      'Z inner join K on Z.GYSID = K.ID, ' +
      'Z inner join C on Z.CKID = C.ID, ' +
      'Z left join S on Z.SFKFSID = S.ID, ' +
      'Z left join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmCgth := TfrmCgth.Create(Application);
  with frmCgth do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'采购付款'
procedure OpenCgfk(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.Cgfkzb do
  begin
    Close;
    CommandText :=
      'select Z.*, ' +
      'switch(FKLX=1,''应付款'', FKLX=2,''预付款'') as aFKLX, ' +
      'K.BH as aGYSBH, K.MC as aGYSMC, ' +
      'S.MC as aSFKFSMC, H.MC as aZHMC ' +
      'from CGFKZB Z, GYS K, SFKFS S, ZH H, ' +
      'Z inner join K on Z.GYSID = K.ID, ' +
      'Z inner join S on Z.SFKFSID = S.ID, ' +
      'Z inner join H on Z.ZHID = H.ID where Z.ID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmCgfk := TfrmCgfk.Create(Application);
  with frmCgfk do
  begin
    strState := 'V';
    blnStopScroll := True;
    ShowModal;
    Free;
  end;
  Screen.Cursor := crDefault;
end;

//'销售收款过程'
procedure OpenXsSkgc(ZBID: Variant);
begin
  Screen.Cursor := crHourGlass;
  with Data.XsSkgc do
  begin
    Close;
    CommandText :=
      'select Z.DJBH, Z.RQ, Z.JE as ZJE, M.JE as BCJE ' +
      'from XSSKZB Z,XSSK M ' +
      'where Z.ID=M.ZBID and M.JE <> 0 and M.DDID = ' + Float2Str(ZBID) + ' ' +
      'order by Z.DJBH';
    Open;
  end;
  frmXsSkgc := TfrmXsSkgc.Create(Application);
  with frmXsSkgc do
  begin