base2info.pas

进销存·完整的·有数据库的·非常完整·只得参考

unit Base2Info;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ListForm,
  ImgList, ExtCtrls, dxCntner, dxTL, dxDBCtrl, dxDBGrid, DBData, Db, Base2InfoUnit,
  Base2InfoEmp, Base2InfoWare, Base2InfoFixAdd, Base2InfoFixDec, ADODB, Base2InfoDepot,
  Menus, dxDBTL, DBGrids, dxBar, dxBarExtItems, KsSkinForms, KsSkinPanels,
  KsSkinTabs, Base2InfoSubject, KsSkinMessages, dxExEdtr, StdCtrls,
  dxDBTLCl, SysPublic, se_controls;
type
  TfrmBase2Info = class(TfrmListForm)
    daBase2Info: TDataSource;
    ADOSetBase2Info: TADODataSet;
    tabCtrl: TSeSkinTabControl;
    gridMain: TdxDBTreeList;
    procedure bbSelectClick(Sender: TObject);
    procedure bbAddClick(Sender: TObject);
    procedure bbEditClick(Sender: TObject);
    procedure bbDelClick(Sender: TObject);
    procedure bbExitClick(Sender: TObject);
    procedure bbFindClick(Sender: TObject);
    procedure bbFilterClick(Sender: TObject);
    procedure gridMainKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure gridMainDblClick(Sender: TObject);
    procedure bbSubClick(Sender: TObject);
    procedure gridMainChangeNodeEx(Sender: TObject);
    procedure gridMainGetImageIndex(Sender: TObject; Node: TdxTreeListNode;
      var Index: Integer);
    procedure gridMainGetSelectedIndex(Sender: TObject;
      Node: TdxTreeListNode; var Index: Integer);
    procedure tabCtrlChange(Sender: TObject);
    procedure bbSetColClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ADOSetBase2InfoAfterInsert(DataSet: TDataSet);
    procedure bbRefreshClick(Sender: TObject);
    procedure bbAllClick(Sender: TObject);
  private
    { Private declarations }
    sReturn: string;
    lMode, lParentMode, lOneRet: Integer;
    lSelect: Integer;
    lRootID, lTabIndex: Integer;
    bRead: Boolean;
    sFilter, sPlusSQL: string;
    AdoSetBase2: TADODataSet;
    procedure ToolShow;
    function FilterData: Integer;
    procedure LoadGrid;
    procedure MainShow;
    procedure LoadData;
    function CheckBillUse(sID: string): Integer;
  public
    { Public declarations }
    sDB: string;
    lParentID: Integer;
  end;

function Base2InfoShow(l1Mode, l1Select: Integer; s1Filter: string; b1Read: Boolean; l1ParentMode: Integer =
  0; l1OneRet: Integer = 0; s1PlusSQL: string = ''): string;
implementation

uses Base2InfoWageProcedure,
  Base2InfoWageItem;

{$R *.DFM}

function Base2InfoShow(l1Mode, l1Select: Integer; s1Filter: string; b1Read: Boolean; l1ParentMode: Integer =
  0; l1OneRet: Integer = 0; s1PlusSQL: string = ''): string;
var
  frmBase2Info: TfrmBase2Info;
begin
  frmBase2Info := TfrmBase2Info.Create(Application);
  with frmBase2Info do
  begin
    lMode := l1Mode;
    lParentMode := l1ParentMode;
    lSelect := l1Select;
    bRead := b1Read;
    lOneRet := l1OneRet;
    sFilter := s1Filter;
    sPlusSQL := s1PlusSQL;
    sReturn := '';
    MainShow;
    Result := sReturn;
    Free;
  end;
end;

procedure TfrmBase2Info.MainShow;
begin
  if lMode = 0 then Exit;
  ToolShow;
  LoadGrid;
  LoadData;
  if (lSelect = 1) and (FilterData = 1) and (lOneRet = 1) then
    bbSelectClick(nil)
  else
    ShowModal; //如果就选取择又只有一条记录就直接返回
  SetColWidth(Caption, TdxDBGrid(gridMain));
end;

procedure TfrmBase2Info.LoadGrid;
begin
  tabCtrl.Tabs.Text := '';
  sDB := '';
  if lSelect = 1 then
  begin
    Height := Height - 40;
    Width := Width - 40;
  end;
  case lMode of
    BASE_CLIENT:
      begin
        Caption := '基础资料-客户';
        StrToTreeField(gridMain,
          'ID,UserCode,Name,LinkMan,Phone,PhoneFax,Receive,OverARTotal',
          'ID,用户编号,用户全名,联系人,联系电话,传真,期初应收款,当前应收款',
          '30,80,150,80,70,70,70,70');
        SetColSum(gridMain, 'Receive,OverARTotal');
        sDB := 'unit';
      end;
    BASE_PROVIDE:
      begin
        Caption := '基础资料-供应商';
        StrToTreeField(gridMain,
          'ID,UserCode,Name,LinkMan,Phone,PhoneFax,Payable,OverARTotal',
          'ID,用户编号,用户全名,联系人,联系电话,传真,期初应付款,当前应付款',
          '30,80,150,80,70,70,70,70');
        SetColSum(gridMain, 'Payable,OverARTotal');
        sDB := 'unit';
      end;
    BASE_EMPLOYE:
      begin
        Caption := '基础资料-员工';
        StrToTreeField(gridMain,
          'ID,UserCode,Name,ComeDate,Sex,Dept,Learning,Place,Phone,PhoneMove',
          'ID,员工编号,员工名称,出生日期,性别,部门,学历,籍贯,电话,手机',
          '30,80,100,80,50,70,60,60,60,60');
        sDB := 'Employe';
      end;
    BASE_WARE:
      begin
        Caption := '基础资料-商品';
        StrToTreeField(gridMain,
          'ID,UserCode,Name,Sort,Unit,Model,Spec,SumNumber,SumTotal,Pos_purch,Pos_Price,Up_Limit,Down_Limit',
          'ID,商品编号,商品名称,商品分类,计量单位,型号,规格,存货数量,总金额,参考进价,参考售价,库存上限,库存下限',
          '30,80,120,70,70,70,70,70,70,70,70,70,70');
        sDB := 'Ware';
      end;
    BASE_DEPOT:
      begin
        Caption := '基础资料-仓库';
        StrToTreeField(gridMain, 'ID,UserCode,Name,PinYin,Address,Explain',
          'ID,仓库编号,仓库名称,拼音编码,位置,说明',
          '30,80,150,70,100,100');
        sDB := 'Depot';
      end;
    BASE_FIXED_ADD:
      begin
        Caption := '基础资料-固定资产增加';
        StrToTreeField(gridMain,
          'ID,UserCode,Name,Spec,InDate,UseMonth,BornValue,NetValue',
          'ID,资产编号,资产名称,规格型号,入账日期,使用月份, 入账原值,净值',
          '30,80,120,70,70,70,70,70');
        sDB := 'FixedAssets';
      end;
    BASE_FIXED_DEC:
      begin
        Caption := '基础资料-固定资产减少';
        StrToTreeField(gridMain,
          'ID,FixedCode,FixedName, DecMode, DecDate,  Income,  Outlay,Why',
          'ID, 资产编号, 资产名称,减少方式,清理日期,清理收入,清理费用,清理原因',
          '30,80,120,80,70,70,70,100');
        sDB := 'FixedAssetsDec';
      end;
    BASE_WAGE_PROCEDURE:
      begin
        Caption := '基础资料-工资工序';
        StrToTreeField(gridMain, 'ID,WageOrder,WageKind, WagePrice',
          'ID, 工序名称, 所属工种,工价',
          '30,150,120,120');
        sDB := 'WageOrder';
      end;
    BASE_WAGE_ITEM:
      begin
        Caption := '基础资料-工资项目定义';
        StrToTreeField(gridMain, 'ID,Name,Type,state,CanExp,Expression,Memo',
          'ID,项目名称,类型,当前状态,使用公式,计算公式,备注',
          '30,120,80,90,90,150,150');
        bbSub.Visible := ivNever;
        sDB := 'WageItem';
      end;
    BASE_SUBJECT:
      begin
        Caption := '基础资料-会计科目';
        StrToTreeField(gridMain, 'ID,UserCode,Name,direction,CashFlow,Memo',
          'ID, 科目编号, 科目名称,借贷方向,核算现金流量,备注',
          '30,80,120,70,80,100');
        tabCtrl.Tabs.Text := '资产' + #13 + '负债' + #13 + '权益' + #13 + '成本' + #13 + '损益';
        tabCtrl.TabIndex := 0;
        sDB := 'Subject';
      end;
  else
    ShowMsg('内部参数出错,请与开发商联系！');
  end;
  gridMain.ColumnByFieldName('ID').Visible := false;
  gridMain.Columns[1].SummaryFooterType := cstCount;
  gridMain.Columns[1].SummaryFooterFormat := '记录条数: 0';
  SetCol(Caption, TdxDBGrid(gridMain), 1);
end;

function TfrmBase2Info.FilterData: Integer;
var
  s1: string;
begin
  Result := 0;
  if sFilter = '' then
    ADOSetBase2Info.Filtered := false
  else
    ADOSetBase2Info.Filtered := True;
  if sFilter <> '' then
  begin
    if GetStringType(sFilter) = 'PY' then
      s1 := 'UserCode Like ''*' + sFilter + '*'' or Name Like ''*' + sFilter +
        '*'' or PinYin Like ''' + sFilter + '*'''
    else
    begin
      s1 := 'UserCode Like ''*' + sFilter + '*'' or Name Like ''*' + sFilter + '*''';
      case lMode of
        BASE_WARE: s1 := 'UserCode Like ''*' + sFilter + '*'' or Name Like ''*' +
          sFilter + '*'' or BarCode Like ''*' + sFilter + '*''';
      end;
    end;
  end
  else
    s1 := '';
  try
    ADOSetBase2Info.Filter := s1;
    Result := ADOSetBase2Info.RecordCount;
  except
    Exit;
  end;
end;

procedure TfrmBase2Info.LoadData;
var
  sSql, sClassID: string;
begin
  sSql := '';
  sClassID := '';
  case lMode of
    BASE_CLIENT:
      sSql := ' SELECT U.*,(U.Receive+UM.ARTotal-UM.DoARTotal)as OverARTotal' +
        ' FROM Unit AS U LEFT JOIN UnitMoney AS UM ON U.ID = UM.UnitID' +
        ' WHERE  U.Mode = ' + IntTostr(lMode);
    BASE_PROVIDE:
      sSql := ' SELECT U.*,(U.Payable+UM.ARTotal-UM.DoARTotal)as OverARTotal' +
        ' FROM Unit AS U LEFT JOIN UnitMoney AS UM ON U.ID = UM.UnitID' +
        ' WHERE  U.Mode = ' + IntTostr(lMode);
    BASE_EMPLOYE:
      sSql := 'SELECT * FROM Employe';
    BASE_WARE:
      sSql := ' SELECT W.ID, W.TreeParent, W.UserCode, W.Name, W.ShortName, W.PinYin, W.Model, W.Spec,' +
        ' W.Area, W.Type, W.Unit, W.Unit2, W.Scale, W.Sort, W.BarCode, W.Pos_Price, W.Pos_Purch,' +
        ' W.ConstPrice, W.Price1, W.Price2, W.Price3, W.Price4, W.Up_Limit, W.Down_Limit, W.Memo, W.Use, W.Mode,' +
        ' Sum(WS.Number) AS SumNumber, Sum(WS.Total) AS SumTotal' +
        ' FROM Ware AS W LEFT JOIN WareStock AS WS ON W.ID = WS.WareID ' +
        ' GROUP BY W.ID, W.TreeParent, W.UserCode, W.Name, W.ShortName, W.PinYin, W.Model, W.Spec,' +
        ' W.Area, W.Type, W.Unit, W.Unit2, W.Scale, W.Sort, W.BarCode, W.Pos_Price, W.Pos_Purch,' +
        ' W.ConstPrice, W.Price1, W.Price2, W.Price3, W.Price4, W.Up_Limit, W.Down_Limit, W.Memo, W.Use, W.Mode';
    BASE_DEPOT:
      sSql := 'SELECT * FROM Depot';
    BASE_FIXED_ADD:
      sSql := 'SELECT * FROM FixedAssets WHERE [Delete]=FALSE';
    BASE_FIXED_DEC:
      sSql := 'SELECT * FROM FixedAssetsDec ';
    BASE_WAGE_PROCEDURE:
      sSql := 'SELECT * FROM WageOrder';
    BASE_WAGE_ITEM:
      sSql := 'SELECT * FROM WageItem';
    BASE_SUBJECT:
      begin
        sSql := 'SELECT * FROM Subject where ClassID=' + IntToStr(tabCtrl.TabIndex + 1) + ' ' + sPlusSQL;
      end;
  end;
  AdoSetBase2 := AdoSetBase2Info;
  OpenDataSet(AdoSetBase2, sSql);
end;

procedure TfrmBase2Info.ToolShow;
begin
  if lSelect = 0 then
  begin
    bbSelect.Visible := ivNever;
    bbDel.Visible := ivAlways;
  end
  else
  begin
    bbDel.Visible := ivNever;
    bbSelect.Visible := ivAlways;
  end;
  bbAll.Visible := bbSelect.Visible;
  bbSelect.Enabled := true;
  bbSub.Enabled := true;
  bbEdit.Enabled := true;
  bbDel.Enabled := true;
  if gridMain.FocusedNode = nil then
  begin
    bbSelect.Enabled := false;
    bbSub.Enabled := false;
    bbEdit.Enabled := false;
    bbDel.Enabled := false;
  end
  else
  begin
    if gridMain.FocusedNode.HasChildren then
      bbDel.Enabled := false;
  end;
end;

procedure TfrmBase2Info.bbSelectClick(Sender: TObject);
var
  lOrder: Integer;
  sCode: string;
  function GetSQL(sPID: string): string;
  var
    sSQL: string;
  begin
    sSql := ' SELECT Ws.ID,WS.WareID,WS.Number, WS.Price,Ws.Total,WS.Order' +
      ' FROM WareStock AS WS' +
      ' WHERE WS.WareID=' + sPID;