⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 base2info.pas

📁 进销存·完整的·有数据库的·非常完整·只得参考
💻 PAS
📖 第 1 页 / 共 2 页
字号:
    Result := sSQL;
  end;
  function CheckOrder(sPID: string): Boolean; //检查商品是否存在批次
  begin
    Result := GetDataSetCount(GetSQL(sPID)) > 1;
  end;
  function GetMaxOrder(sPID: string): string;
  begin
    Result := FormatFloat('0', GetTableMax(GetSQL(sPID), 'Order'));
  end;
  function GetMinOrder(sPID: string): string;
  begin
    Result := FormatFloat('0', GetTableMin(GetSQL(sPID), 'Order'));
  end;
begin
  inherited;
  sReturn := ADOSetBase2.FieldByName('ID').AsString; //返回选中ID
  if lParentMode = 1 then
    case lMode of
      BASE_WARE:
        begin
          lOrder := StrToInt2(GetIniValue(frmData.ADOConnet, 'OutOrder')); //读成本算法
          case lOrder of
            1: sReturn := sReturn + ',' + GetMinOrder(sReturn);
            2: sReturn := sReturn + ',' + GetMaxOrder(sReturn);
            3:
              if CheckOrder(sReturn) then //检查是否存在批次
              begin
                sCode := BaseSelect(BASE_STOCK_ORDER, 1, sReturn); //选择批次
                if StrToInt2(sCode) > 0 then
                  sReturn := sReturn + ',' + sCode
                else
                  Exit;
              end;
          end;
        end;
    end;
  Close;
end;

procedure TfrmBase2Info.bbAddClick(Sender: TObject);
var
  bRet: boolean;
begin
  inherited;
  bRet := false;
  lParentID := 0;
  lRootID := 0;
  if not ADOSetBase2.FieldByName('TreeParent').IsNull then
  begin
    lParentID := ADOSetBase2.FieldByName('TreeParent').asInteger;
    if lMode = BASE_SUBJECT then lRootID := ADOSetBase2.FieldByName('RootID').asInteger;
  end;
  ADOSetBase2.Filter := '';
  AdoSetBase2.Last;
  AdoSetBase2.Insert;
  case lMode of
    BASE_CLIENT: bRet := Base2InfoUnitShow(lMode);
    BASE_PROVIDE: bRet := Base2InfoUnitShow(lMode);
    BASE_EMPLOYE: bRet := Base2InfoEmpShow(lMode);
    BASE_WARE: bRet := Base2InfoWareShow(lMode);
    BASE_DEPOT: bRet := Base2InfoDepotShow(lMode);
    BASE_FIXED_ADD: bRet := Base2InfoFixAddShow(lMode);
    BASE_FIXED_DEC: bRet := Base2InfoFixDecShow(lMode);
    BASE_WAGE_PROCEDURE: bRet := Base2InfoWageProcedureShow(lMode);
    BASE_WAGE_ITEM: bRet := Base2InfoWageItemShow(lMode);
    BASE_SUBJECT:
      begin
        lTabIndex := tabCtrl.TabIndex + 1;
        bRet := Base2InfoSubjectShow(lMode, lTabIndex, lRootID);
      end;
  end;

  if bRet then
    SaveDataSet(AdoSetBase2, False)
  else
    AdoSetBase2.Cancel;
end;

procedure TfrmBase2Info.bbEditClick(Sender: TObject);
var
  bRet: Boolean;
begin
  inherited;
  if AdoSetBase2.IsEmpty then exit;
  bRet := false;
  lRootID := 0;
  if ADOSetBase2.FieldByName('TreeParent').IsNull then
    lParentID := -1
  else
    lParentID := ADOSetBase2.FieldByName('TreeParent').asInteger;
  if lMode = BASE_SUBJECT then lRootID := ADOSetBase2.FieldByName('RootID').asInteger;
  AdoSetBase2.Edit;
  case lMode of
    BASE_CLIENT: bRet := Base2InfoUnitShow(lMode);
    BASE_PROVIDE: bRet := Base2InfoUnitShow(lMode);
    BASE_EMPLOYE: bRet := Base2InfoEmpShow(lMode);
    BASE_WARE: bRet := Base2InfoWareShow(lMode);
    BASE_DEPOT: bRet := Base2InfoDepotShow(lMode);
    BASE_FIXED_ADD: bRet := Base2InfoFixAddShow(lMode);
    BASE_FIXED_DEC: bRet := Base2InfoFixDecShow(lMode);
    BASE_WAGE_PROCEDURE: bRet := Base2InfoWageProcedureShow(lMode);
    BASE_WAGE_ITEM: bRet := Base2InfoWageItemShow(lMode);
    BASE_SUBJECT:
      begin
        lTabIndex := tabCtrl.TabIndex + 1;
        bRet := Base2InfoSubjectShow(lMode, lTabIndex, lRootID);
      end;
  end;
  if bRet then
    SaveDataSet(AdoSetBase2, false)
  else
    AdoSetBase2.Cancel;
end;

function TfrmBase2Info.CheckBillUse(sID: string): Integer;
var
  sSQL: string;
begin
  Result := 0;
  sSQL := '';
  if StrToInt2(sID) <= 0 then
    Exit;
  case lMode of
    BASE_CLIENT, BASE_PROVIDE: sSQL := 'SELECT ID FROM BillIndex WHERE UnitID=' + sID;
    BASE_EMPLOYE: sSQL := 'SELECT ID FROM BillIndex WHERE EmployeID=' + sID;
    BASE_DEPOT: sSQL := 'SELECT ID FROM BillIndex WHERE DepotID=' + sID;
    BASE_WARE: sSQL := ' SELECT ID FROM BillStock WHERE WareID=' + sID +
      ' UNION SELECT ID FROM BillSale WHERE WareID=' + sID;
    BASE_SUBJECT: sSQL := 'SELECT ID FROM AccountTable WHERE SubjectID=' + sID;
  end;
  if not GetDataSetEmpty(sSQl) then
    Result := 1;
end;

procedure TfrmBase2Info.bbDelClick(Sender: TObject);
begin
  inherited;
  if AdoSetBase2.IsEmpty then
    Exit;
  case lMode of //使用过的不准删除
    BASE_CLIENT, BASE_PROVIDE, BASE_EMPLOYE, BASE_WARE, BASE_DEPOT, BASE_SUBJECT:
      if CheckBillUse(ADOSetBase2.FieldByName('ID').AsString) > 0 then
      begin
        ShowMsg('该基础资料在单据或凭证中有使用,不能删除,请先删除相应单据!');
        Exit;
      end;
  end;

  case lMode of //更新固定资产删除标记
    BASE_FIXED_DEC: UpdateFixTable(AdoSetBase2.FieldByName('FixedID').AsString, 'FALSE');
  end;
  if MsgBox('数据删除后不可恢复,确认要删除?', '提示', MB_OKCancel) = IDOK then
    AdoSetBase2.Delete;
end;

procedure TfrmBase2Info.bbExitClick(Sender: TObject);
begin
  inherited;
  sReturn := '';
end;

procedure TfrmBase2Info.bbFindClick(Sender: TObject);
begin
  inherited;
  FindPublic(gridMain, sPubFindText, lPubFindFiled);
end;

procedure TfrmBase2Info.bbFilterClick(Sender: TObject);
begin
  inherited;
  FilterPublic(gridMain);
end;

procedure TfrmBase2Info.gridMainKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  inherited;
  case KEY of
    VK_RETURN:
      begin
        if bbSelect.Visible = ivAlways then
        begin
          if bbSelect.Enabled then
            bbSelectClick(nil);
        end
        else
          bbEditClick(nil);
      end;
    VK_ESCAPE: bbExitClick(nil);
    VK_INSERT: bbAddClick(nil);
    VK_DELETE: bbDelClick(nil);
  end;
end;

procedure TfrmBase2Info.gridMainDblClick(Sender: TObject);
begin
  inherited;
  if not gridMain.FocusedNode.HasChildren then
  begin
    if bbSelect.Visible = ivAlways then
      bbSelectClick(nil)
    else
      bbEditClick(nil);
  end;
end;

procedure TfrmBase2Info.bbSubClick(Sender: TObject);
var
  bRet: boolean;
begin
  inherited;
  bRet := false;
  case lMode of //使用过的不准分类
    BASE_CLIENT, BASE_PROVIDE, BASE_EMPLOYE, BASE_WARE, BASE_DEPOT, BASE_SUBJECT:
      if CheckBillUse(ADOSetBase2.FieldByName('ID').AsString) > 0 then
      begin
        ShowMsg('该基础资料在单据或凭证中有使用,不能分类,请先删除相应单据!');
        Exit;
      end;
  end;
  lParentID := TdxDBTreeListNode(gridMain.FocusedNode).Id;
  if lMode = BASE_SUBJECT then lRootID := ADOSetBase2.FieldByName('RootID').asInteger;
  AdoSetBase2.Last;
  AdoSetBase2.Insert;
  if lMode = BASE_CLIENT then
    bRet := Base2InfoUnitShow(lMode)
  else
    if lMode = BASE_PROVIDE then
      bRet := Base2InfoUnitShow(lMode)
    else
      if lMode = BASE_EMPLOYE then
        bRet := Base2InfoEmpShow(lMode)
      else
        if lMode = BASE_WARE then
          bRet := Base2InfoWareShow(lMode)
        else
          if lMode = BASE_DEPOT then
            bRet := Base2InfoDepotShow(lMode)
          else
            if lMode = BASE_FIXED_ADD then
              bRet := Base2InfoFixAddShow(lMode)
            else
              if lMode = BASE_FIXED_DEC then
                bRet := Base2InfoFixDecShow(lMode)
              else
                if lMode = BASE_SUBJECT then
                begin
                  lTabIndex := tabCtrl.TabIndex + 1;
                  bRet := Base2InfoSubjectShow(lMode, lTabIndex, lRootID);
                end;
  if bRet then
  begin
    SaveDataSet(AdoSetBase2, false);
    UpdateICCount(sDB, ADOSetBase2.FieldByName('TreeParent').AsInteger);
  end
  else
    AdoSetBase2.Cancel;
end;

procedure TfrmBase2Info.gridMainChangeNodeEx(Sender: TObject);
begin
  inherited;
  ToolShow;
end;

procedure TfrmBase2Info.gridMainGetImageIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmBase2Info.gridMainGetSelectedIndex(Sender: TObject;
  Node: TdxTreeListNode; var Index: Integer);
const
  ImagesIndex: array[Boolean] of Integer = (16, 17);
begin
  inherited;
  if Node.HasChildren then
    Index := ImagesIndex[Node.Expanded]
  else
    Index := 16;
end;

procedure TfrmBase2Info.tabCtrlChange(Sender: TObject);
begin
  inherited;
  if (lMode > 0) and ADOSetBase2.Active then LoadData;
end;

procedure TfrmBase2Info.bbSetColClick(Sender: TObject);
begin
  inherited;
  SetCol(Caption, TdxDBGrid(gridMain), 0);
end;

procedure TfrmBase2Info.FormShow(Sender: TObject);
begin
  inherited;
  gridMain.SetFocus;
end;

procedure TfrmBase2Info.ADOSetBase2InfoAfterInsert(DataSet: TDataSet);
begin
  inherited;
  DataSet.FieldByName('TreeParent').AsInteger := lParentID;
  case lMode of
    BASE_WAGE_ITEM: DataSet.FieldByName('Order').AsFloat :=
      GetTableNoExists('WageItem', 'Order');
  end;
end;

procedure TfrmBase2Info.bbRefreshClick(Sender: TObject);
begin
  inherited;
  ADOSetBase2Info.Filter := '';
end;

procedure TfrmBase2Info.bbAllClick(Sender: TObject);
begin
  inherited;
  sReturn := '0';
  Close;
end;

end.

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -