📄 tuneinvqty.pas

📁 文件包含程序源原文件
💻 PAS
📖 第 1 页 / 共 4 页
字号:
  except
    Exit;
  end;

  if (CtrlList = nil)or((CtrlList<>nil)and(CtrlList^.Address=nil)) then Exit;
  if not ReturnValueToVariable(lcP, CtrlList, True) then
  begin
    ReturnValueFromTag(CtrlList);
    try
      CtrlList^.Target.SetFocus;
    except
      Exit;
    end;
  end;
end;

procedure TfrmTuneInvQty.edtDateKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var WDate: TDateTime;
begin
  if (Key=VK_RETURN)and(ssShift in Shift)then
    if not(dm_Inventory.DateErrorCheck(edtDate.Text, WDate)) then begin
      Key := 0;
      edtNote.SetFocus;
      Exit;
    end;
  ControlKeyDown(Sender, Key, Shift);
end;

procedure TfrmTuneInvQty.edtNoteKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var WK: Word;
begin
  WK := Key;
  ControlKeyDown(Sender, Key, Shift);
  if (WK=VK_RETURN)and not(ssShift in Shift) then
    if ckbNew.Checked then begin
      FExitSkip := True;
      try
        btnNewClick(Sender);
      finally
        FExitSkip := False;
      end;
    end;
end;

procedure TfrmTuneInvQty.TabControlChanging(Sender: TObject;
  var AllowChange: Boolean);
begin
  inherited;
  AllowChange := True;
  if ErrorCheck(Selected) <> 0 then AllowChange := False
  else UpdateCheck;
end;

{**********************************************************************************}
{**********************************************************************************}
function  TfrmTuneInvQty.ReturnValueToVariable(lcP: PINVENTORY; CtrlList: PCONTROL_LIST; Msg: Boolean): Boolean;

  function SetUPrice: Boolean;
  var View: TINVENTORY;
      DBL: Double;
  begin
    Result := True;
    DBL := Abs(SetInventoryCnt(lcP^.REC_ID,lcP^.MAT_RID,lcp^.GUAGE_ID,lcp^.STK_ID,lcP^.DATE,InvCnt));
    edtstkPrice.Value  := DBL;
    edtCurrQty.Value   := InvCnt;
    edtStdPrice.Value  := dm_inventory.GetStdUnitPrice(lcp^.MAT_RID);

    lcP^.UNT_PRICE := edtPrice.Value;
    SetUpdateList(lcP^.REC_ID, @lcP^.UNT_PRICE, LongInt(@View.UNT_PRICE)-LongInt(@View), 0, lcP);
  end;
  //--
  procedure SetTPrice;
  var View: TINVENTORY;
      DBL: Double;
  begin
    DBL := abs(SetInventoryCnt(lcP^.REC_ID,lcP^.MAT_RID,lcp^.GUAGE_ID,lcp^.STK_ID,lcP^.DATE,InvCnt));
    edtstkPrice.Value  := DBL;
    edtCurrQty.Value   := InvCnt;
    edtStdPrice.Value  := dm_inventory.GetStdUnitPrice(lcp^.MAT_RID);

    lcp^.QUANTITY     := edtIssWeight.Value;
    SetUpdateList(lcP^.REC_ID, @lcP^.QUANTITY, LongInt(@View.QUANTITY)-LongInt(@View), 0, lcP);
    
    lcP^.TTL_PRICE    := lcP^.UNT_PRICE * lcP^.QUANTITY + lcp^.MAK_PRICE;
    lblTPrice.Caption := FormatFloat('#,##0.00', Abs(UserDecimalDefine(lcP^.TTL_PRICE,2)));
    SetUpdateList(lcP^.REC_ID, @lcP^.TTL_PRICE, LongInt(@View.TTL_PRICE)-LongInt(@View), 0, lcP);
  end;

var View: TINVENTORY;
    WDate: TDateTime;
    WRID:  LongInt;
    WCD:   Integer;
    WTmpStr: string;
begin
  Result := True;
  //-- Get Field Text
  if CtrlList^.UpdateIndex = Longint(@View.STK_ID)-Longint(@View) then
  begin
    WTmpStr := (CtrlList^.Target as TCustomEdit).Text;
    Result := dm_Inventory.Get_StockCheck(WTmpStr,edtStkName);
    if not(Result) then Exit;
    StrPCopy(PChar(CtrlList^.Address), WTmpStr);
    if SetUPrice then SetTPrice;
  end else
  if CtrlList^.UpdateIndex = Longint(@View.ISS_PAPERNO)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text)
  else
  if CtrlList^.UpdateIndex = Longint(@View.Inout_id)-Longint(@View) then
  begin
    WTmpStr := (CtrlList^.Target as TCustomEdit).Text;
    Result := dm_Inventory.InOut_IDProc(WTmpStr,4, edtOutIDName);
    if not(Result) then Exit;
    StrPCopy(PChar(CtrlList^.Address), WTmpStr)
  end else
  if CtrlList^.UpdateIndex=Longint(@View.input_empid)-Longint(@View) then
  begin
    WTmpStr := (CtrlList^.Target as TCustomEdit).Text;
    Result := dm_Inventory.Emp_IDProc(WTmpStr, edtInputEmpName);
    if not(Result) then Exit;
    StrPCopy(PChar(CtrlList^.Address), WTmpStr)
  end else
  if CtrlList^.UpdateIndex = Longint(@View.PAPERNO)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text)
  else
  if CtrlList^.UpdateIndex = Longint(@View.DATE)-Longint(@View) then
  begin
    Result := dm_Inventory.DateProc((CtrlList^.Target as TEdit), WDate);
    if not(Result) then Exit;
    TDateTime(CtrlList^.Address^) := WDate;
    if SetUPrice then SetTPrice;
  end else
  if CtrlList^.UpdateIndex = Longint(@View.MAT_RID)-Longint(@View) then begin
    Result := dm_Inventory.REC_IDProc(0, (CtrlList^.Target as TEdit), WRID, -1);
    if not(Result) then Exit;
    LongInt(CtrlList^.Address^) := WRID;
    MatRID := WRID;
    SetTabCaption(lcP);
    if SetUPrice then SetTPrice;
    edtMatName.Text     := dm_Inventory.GetMaterialName(WRID);
    lblUType.Caption    := dm_Inventory.GetUnitTypeName(WRID);
    if StrComp(lcP^.MAT_NM, PChar(edtMatName.Text)) = 0 then Exit;
    StrPCopy(lcP^.MAT_NM, edtMatName.Text);
    SetUpdateList(lcP^.REC_ID, @lcP^.MAT_NM, LongInt(@View.MAT_NM)-LongInt(@View), 0, lcP);
  end else
  if CtrlList^.UpdateIndex = Longint(@View.GUAGE_ID)-Longint(@View) then begin
    WCD := Trunc((CtrlList^.Target as TEx2NumEdit).Value);
    MatRID := dm_inventory.GetMaterialRID(trim(edtMatCode.Text));
    Result := dm_Inventory.Get_GuageCheck(MatRID,WCD, edtIssGuageName);
    if not(Result) then Exit;
    LongInt(CtrlList^.Address^) := WCD;
    if SetUPrice then SetTPrice;
  end else
  if CtrlList^.UpdateIndex = Longint(@View.UNT_PRICE)-Longint(@View) then
    SetUPrice
  else
  if CtrlList^.UpdateIndex = Longint(@View.QUANTITY)-Longint(@View) then begin
    Double(CtrlList^.Address^):=(CtrlList^.Target as TEx2NumEdit).Value;
    SetTPrice;
  end
  else
  if CtrlList^.UpdateIndex=Longint(@View.ODR_RID)-Longint(@View) then begin
    Result := dm_Inventory.REC_IDProc(1, (CtrlList^.Target as TEdit), WRID, -1);
    if not(Result) then Exit;
    LongInt(CtrlList^.Address^) := WRID;
  end else
  if CtrlList^.UpdateIndex=Longint(@View.PAT_RID)-Longint(@View) then begin
      Result := dm_Inventory.REC_IDProc(2, (CtrlList^.Target as TEdit), WRID, lcP^.ODR_RID);
      if not(Result) then Exit;
      LongInt(CtrlList^.Address^) := WRID;
  end else //--
  if CtrlList^.UpdateIndex=Longint(@View.SEQUAL_NO)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text)
  else
  if CtrlList^.UpdateIndex=Longint(@View.HAT_RID)-Longint(@View) then begin
      Result := dm_Inventory.REC_IDProc(3, (CtrlList^.Target as TEdit), WRID, -1);
      if not(Result) then Exit;
      LongInt(CtrlList^.Address^) := WRID;
  end else
  if CtrlList^.UpdateIndex=Longint(@View.HAT_CODE)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text)
  else
  if CtrlList^.UpdateIndex = Longint(@View.SUP_CD)-Longint(@View) then begin
    WCD := Trunc((CtrlList^.Target as TEx2NumEdit).Value);
    Result := dm_Inventory.MasterProc(WCD, lblSupplierNM);
    if not(Result) then Exit;
    LongInt(CtrlList^.Address^) := WCD;
  end else
  if CtrlList^.UpdateIndex = Longint(@View.MAK_CD)-Longint(@View) then begin
    WCD := Trunc((CtrlList^.Target as TEx2NumEdit).Value);
    Result := dm_Inventory.MasterProc(WCD, lblMakerNM);
    if not(Result) then Exit;
    LongInt(CtrlList^.Address^) := WCD;
  end else
  if CtrlList^.UpdateIndex = Longint(@View.MAK_PRICE)-Longint(@View) then begin
    Double(CtrlList^.Address^):=(CtrlList^.Target as TEx2NumEdit).Value;
    SetTPrice;
  end
  else
  if CtrlList^.UpdateIndex=Longint(@View.invoice_no)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text)
  else
  if CtrlList^.UpdateIndex = Longint(@View.NOTE)-Longint(@View) then
    StrPCopy(PChar(CtrlList^.Address), (CtrlList^.Target as TCustomEdit).Text);
  ///////////////////////////////////////////////////////////////////
end;

procedure TfrmTuneInvQty.SetData(Item: Pointer);
var lcP: PINVENTORY;
begin
  lcP := Item;
  Selected := Item;
  
  edtStkID.Text         := lcp^.STK_ID;
  edtStkName.Text       := dm_Inventory.GetStockName(trim(edtStkID.Text));
  edtIssPaper.Text      := lcp^.ISS_PAPERNO;
  edtMatOutID.Text      := lcp^.Inout_ID;
  edtOutIDName.Text     := dm_Inventory.Get_IOIDName(trim(edtMatOutID.Text),4);
  edtInputEmpID.Text    := lcp^.input_empid;
  edtInputEmpName.Text  := dm_Inventory.Get_EmpName(trim(edtInputEmpID.Text));
  edtPaperNo.Text       := lcp^.PaperNo;

  if (lcP^.DATE<=2) then
    edtDate.Text        := FormatDatetime('yy/mm/dd',Now)
  else
    edtDate.Text        := FormatDateTime('yy/mm/dd', lcP^.DATE);

  edtMatCode.Text       := dm_Inventory.GetMaterialCode(lcP^.MAT_RID);
  edtMatName.Text       := lcP^.MAT_NM;
  edtIssGuageID.Value   := lcp^.GUAGE_ID;
  edtIssGuageName.Text  := dm_Inventory.Get_GuageName(lcp^.MAT_RID,lcp^.GUAGE_ID);
  edtPrice.Value        := lcP^.UNT_PRICE;
  edtIssWeight.Value    := lcP^.QUANTITY;
  lblUType.Caption      := dm_Inventory.GetUnitTypeName(lcP^.MAT_RID);
  lblTPrice.Caption     := FormatFloat('#,##0.00', UserDecimalDefine(lcP^.TTL_PRICE,2));

  edtMoldID.Text        := dm_Inventory.GetOrderNo(lcP^.ODR_RID);
  edtPartID.Text        := dm_Inventory.GetPartCode(lcP^.ODR_RID, lcP^.PAT_RID);
  edtSequalNo.Text      := lcp^.SEQUAL_NO;
  if lcP^.HAT_RID <= 0 then edtOrderSerial.Text := ''
  else edtOrderSerial.Text  := Format('%d', [lcP^.HAT_RID]);
  edtOrderCode.Text     := lcp^.HAT_CODE;
  
  edtSuplierCode.Value  := lcP^.SUP_CD;
  lblSupplierNM.Text    := dm_Inventory.GetShigenName(lcP^.SUP_CD);
  edtMakerCode.Value    := lcP^.MAK_CD;
  lblMakerNM.Text       := dm_Inventory.GetShigenName(lcP^.MAK_CD);
  edtMakPrice.Value     := lcp^.MAK_PRICE;
  edtInvoiceNo.Text     := lcp^.INVOICE_NO;
  edtNote.Text          := lcP^.NOTE;
end;

procedure TfrmTuneInvQty.SetNull;
begin
  Selected := nil;
  edtStkID.Text         := default_stkid;
  edtIssPaper.Text      := '';
  edtMatOutID.Text      := '';
  edtOutIDName.Text     := '';
  edtInputEmpID.Text    := '';
  edtInputEmpName.Text  := '';
  edtPaperNo.Text       := '';
  edtDate.Text          := '';
  edtMatCode.Text       := '';
  edtMatName.Text       := '';
  edtIssGuageID.Value   := 0;
  edtIssGuageName.Text  := '';
  edtPrice.Value        := 0;
  edtIssWeight.Value    := 0;
  lblUType.Caption      := '';
  lblTPrice.Caption     := '0';
  edtCurrQty.Value      := 0;
  edtstkPrice.Value     := 0;
  edtStdPrice.Value     := 0;
  edtMoldID.Text        := '';
  edtPartID.Text        := '';
  edtSequalNo.Text      := '';
  edtOrderSerial.Text   := '';
  edtOrderCode.Text     := ''; 
  edtSuplierCode.Value  := 0;
  lblSupplierNM.Text    := '';
  edtMakerCode.Value    := 0;
  lblMakerNM.Text       := '';
  edtInvoiceNo.Text     := '';
  edtNote.Text          := '';
end;

function  TfrmTuneInvQty.ErrorCheck(Item: PINVENTORY): Integer;
var
  lcP: PINVENTORY;
  ErrNo: integer;
  ErrMsg: string;
begin
  Result := 0;
  ErrNo  := 0;
  lcP := Selected;
  if (lcP <> nil) and (GetTabCaption(Selected)='')  then ErrNo := -1;
  if (lcp <> nil) and (trim(edtPaperNo.Text)='')    then ErrNo := -3;
  if (lcp <> nil) and (trim(edtMatOutID.Text)='')   then ErrNo := -4;
  if (lcp <> nil) and (trim(edtInputEmpID.Text)='') then ErrNo := -6;
  if (lcp <> nil) and (trim(edtNote.Text)='')       then ErrNo := -8;

  if ErrNo = 0 then begin
    //if Abs(lcP^.QUANTITY) > InvCnt then ErrNo := -2;
    if Abs(lcP^.QUANTITY) = 0 then ErrNo := -7;
  end;

  //--  检查日期是否有效
  if ErrNo = 0 then begin
    if lcP^.DATE <= 2 then ErrNo := -10;
  end;
  
  //--  检查输入的日期是否在已月结关帐区间
  if ErrNo = 0 then begin
    if dm_Inventory.is_DateInAccountedMonth(trim(lcp^.STK_ID),lcp^.DATE) then ErrNo := -11;
  end;

  if ErrNo<>0 then begin
    Result := -1;
    case ErrNo of
      -1: ErrMsg := GetMultiLingalMsg(90207, '该物料编码没有纳入在库管理!');
      -2: ErrMsg := GetMultiLingalMsg(90212, '调整数量大于目前在库量!');
      -3: ErrMsg := GetMultiLingalMsg(90213, '调整单号没有输入!');
      -4: ErrMsg := GetMultiLingalMsg(90214, '调整类别没有区分!');
      -6: ErrMsg := GetMultiLingalMsg(90215, '调整人员没有输入!');
      -7: ErrMsg := GetMultiLingalMsg(90216, '调整数量为零没有意义!');
      -8: ErrMsg := GetMultiLingalMsg(90217, '没有输入调整原因!');
      -11: ErrMsg := '该日期已月结结帐，已结帐区间不能再输入入库数据!';
      -10: ErrMsg := '该入库数据的入库日期无效!';
    end;
    MessageDlg(ErrMsg, mtWarning, [mbOK], 0);
  end;
end;

function  TfrmTuneInvQty.UpdateProc(UpdateListList: TList): Boolean;
var List: TList;
    lcP:  PUPDATE_LIST;
    lcInvP: PINVENTORY;
    IX_1, IX_2, Recid, Error: LongInt;
    ReReadFlg: Boolean;
    ErrMsg: string;
begin
  Result := False;
  Screen.Cursor  := crSqlWait;
  RecIdType := 0;
  try
    for IX_1:=0 to UpdateListList.Count-1 do begin
      List  := UpdateListList[IX_1];
      lcP   := List[0];
      Recid := lcP^.REC_ID;
      ReReadFlg := (Recid < 0);
      Error := dm_Inventory.UpdateDatabase('inventory_sheet', Recid, List);
      if Error < 0 then begin
        Screen.Cursor := crDefault;
        ErrMsg := '数据库进行处理时发生错误';
        MessageDlg(ErrMsg, mtError, [mbOk], 0);
        Exit;
      end;
      lcInvP := nil;
      for IX_2:=0 to List.Count-1 do begin
        lcInvP := PUPDATE_LIST(List[IX_2])^.Parent;
        if lcInvP^.REC_ID <> Recid then lcInvP^.REC_ID := Recid;
      end;
      Inc(ReRead_Cnt);
      SetLength(ReRead_RID, ReRead_Cnt);
      ReRead_RID[ReRead_Cnt-1] := lcInvP^.REC_ID;
      if not(ReReadFlg) then begin
        Inc(Delete_Cnt);
        SetLength(Delete_RID, Delete_Cnt);
        Delete_RID[Delete_Cnt-1] := lcInvP^.REC_ID;
      end;
    end;
  finally
    RecIdType := 1;
    Screen.Cursor := crDefault;
  end;
  for IX_1:=0 to FUpdateList.Count-1 do Dispose(FUpdateList[IX_1]);
  FUpdateList.Clear;
  Result := True;
end;

procedure TfrmTuneInvQty.UpdateCheck;
var UpdateListList: TList;
begin
  UpdateListList := GetUpdateListList;
  if (UpdateListList.Count>0)then begin
    if ErrorCheck(Selected) <> 0 then Exit;
    UpdateProc(UpdateListList);
    //if ReRead_Cnt > 0 then frmInvHistory.ReReadProc(False);
  end;
end;

procedure TfrmTuneInvQty.SetCopy;
var lcP, lcNewP: PINVENTORY;
    View: TINVENTORY;
    iPaper: integer;
begin
  lcP := Selected;
  New(lcNewP);
  ZeroMemory(lcNewP, SizeOf(TINVENTORY));
  CopyMemory(lcNewP, lcP, SizeOf(TINVENTORY));
⌨️ 快捷键说明

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