📄 base2info.pas
字号:
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 + -