invdm.~pas

文件包含程序源原文件

    lcP: PSHIZAI;
begin
  Result := '';
  for IX:=0 to FShiZaiList.Count-1 do begin
    lcp := FShiZaiList[IX];
    if (lcp^.REC_ID=RID) then begin
      if lcP^.UNT_TYPE > High(cUType) then Result := ''
      else Result := cUType[lcP^.UNT_TYPE];
      Exit;
    end;
  end;
end;

function  Tdm_Inventory.GetStdUnitPrice(RID: LongInt): Double;
var IX:  Integer;
    lcP: PSHIZAI;
begin
  Result := 0;
  for IX:=0 to FShiZaiList.Count-1 do begin
    lcp := FShiZaiList[IX];
    if (lcp^.REC_ID=RID) then begin
      Result := lcP^.UNT_PRICE;
      Exit;
    end;
  end;
end;

Function  Tdm_Inventory.GetHatNoUnitPrice(hat_no: LongInt): Double;
var sqls: string;
begin
  result := 0.00;
  sqls := 'select hatchu_bango,shizai_rec_id,tanka from kotei (nolock) ' +
          'where hatchu_bango>0 and jk_cd=3 and visible>0 and unyo_rec_id<=0 and hatchu_bango='+inttostr(hat_no);
  with Query do begin
    Active      := False;
    RequestLive := False;
    Sql.Clear;
    Sql.Add(Sqls);
    try
      Open;
      result  := Fields[2].AsFloat;
    finally
      Close;
    end;
  end;
end;

function  Tdm_Inventory.GetUPNameFromID(iMode: Integer): String;
begin
  if (iMode=-1) then iMode := StrToIntDef(IniData.OutPrice, 5);
  case iMode of
    0: result := '动态平均单价';
    1: result := '先进后出单价';
    2: result := '先进先出单价';
    3: result := '物料标准单价';
    4: result := '订单入库单价';
    5: result := '手动输入单价';
  end;
end;

function  Tdm_Inventory.GetSafeStockQty(RID: LongInt): Double;
var IX:  Integer;
    lcP: PSHIZAI;
begin
  Result := 0;
  for IX:=0 to FShiZaiList.Count-1 do begin
    lcp := FShiZaiList[IX];
    if (lcp^.REC_ID=RID) then begin
      Result := lcP^.SAFE_QTY;
      Exit;
    end;
  end;
end;

Function  Tdm_Inventory.Get_MatGuageSafety(mat_rec_id,guage_id: LongInt): double;
var IX:  Integer;
    lcP: PGuageInfo;
begin
  Result := 0;
  for IX:=0 to FGuageList.Count-1 do begin
    lcp := FGuageList[IX];
    if ((lcp^.mat_rec_id=mat_rec_id)and(lcp^.guage_id=guage_id)) then begin
      Result := lcP^.safety;
      Exit;
    end;
  end;
end;

function  Tdm_Inventory.GetStockName(stkid: string): string;
begin
  if uppercase(stkid) = 'A' then
    result := 'Material Inventory'
  else
  if uppercase(stkid) = 'B' then
    result := 'Other Material Inventory'
  else result := '';
end;

function  Tdm_Inventory.Get_StockCheck(stkid: string; var edt: TEdit): Boolean;
var WStr: string;
begin
  Result := True;
  WStr := dm_Inventory.GetStockName(stkid);
  if ((trim(stkid)='') or ((stkid<>'')and(WStr=''))) then
    if MessageDlg('该编码不存在/确定使用不存在的该编码？', mtWarning, [mbOk], 0) = mrOK then begin
      Result := False;
      Exit;
    end;
  edt.Text := WStr;
end;

procedure Tdm_Inventory.Read_GuageInfoToCbx(edt: TEdit; cbx: TComboBox);
var lcp: PGuageInfo;
    i,WRID: integer;
    iBool: Boolean;
begin
  iBool := true;
  cbx.Items.Clear;

  iBool := dm_Inventory.REC_IDProc(0, edt, WRID, -1);
  if trim(edt.Text)='' then begin
    MessageDlg('please input material code!',mtWarning,[mbOK],0);
    edt.SetFocus;
    iBool := false;
  end;
  if not(iBool) then Exit;
  for i := 0 to FGuageList.Count-1 do
  begin
    lcp := FGuageList.Items[i];
    if lcp^.mat_rec_id = WRID then cbx.Items.Add(IntToStr(lcp^.guage_id)+'_'+lcp^.guage_name);
  end;
end;

procedure Tdm_Inventory.Read_GuageInfoToCbx2(edt: TEdit; cbx: TComboBox);
var lcp: PGuageInfo;
    i,WRID: integer;
    iBool: Boolean;
begin
  iBool := true;
  cbx.Items.Clear;

  iBool := dm_Inventory.REC_IDProc(0, edt, WRID, -1);
  if trim(edt.Text)='' then begin
    MessageDlg('please input material code!',mtWarning,[mbOK],0);
    edt.SetFocus;
    iBool := false;
  end;
  if not(iBool) then Exit;
  for i := 0 to FGuageList.Count-1 do
  begin
    lcp := FGuageList.Items[i];
    if lcp^.mat_rec_id = WRID then cbx.Items.Add(lcp^.guage_name);
  end;
end;

procedure Tdm_Inventory.Read_MatGuageInfo(sList: TList);
var lcp: PGuageInfo;
    Sqls,sSQL: string;
    i: Integer;
    tmpQry: TQuery;
begin
  sSQL := ' update t1 '+
          ' set t1.guage_name=case Ltrim(Rtrim(t2.standard)) '+
          ' when '+Quotedstr('')+' then '''+'none guage'''+' else t2.Standard end'+
          ' from inv_guageinfo t1 (nolock), '+
          '      shizai        t2 (nolock) '+
          ' where t1.mat_rec_id=t2.rec_id and '+
          ' t1.guage_id=0 and'+
          ' t2.visible>0 and t2.flag=1 ';
  {
  sSQL := ' delete t1 ' +
          ' from inv_guageinfo t1 where ((guage_id=0) or guage_name='+Quotedstr('none guage') + ')'+
          //' and (t1.mat_rec_id not in(select mat_rec_id from inv_guageinfo)))' +
          ' insert into inv_guageinfo(mat_rec_id,guage_id,guage_name) '+
          ' select rec_id,guage_id=0, ' +
          ' standard=case Ltrim(Rtrim(standard)) '+
          ' when '+Quotedstr('')+' then '''+'none guage'''+' else Standard end'+
          ' from shizai (nolock) '+
          ' where visible>0 and flag=1';
          }

  try
    tmpQry := CreateQuery('tmpQry','POPDB');
    tmpQry.Close;
    tmpQry.SQL.Clear;
    tmpQry.SQL.Add(sSQL);
    tmpQry.ExecSQL;
  finally
    tmpQry.Free;
  end;

  Sqls := 'SELECT mat_rec_id,guage_id,guage_name,safety,max_stkqty,fixed_buyqty,buy_days,weight_pcs '+
          'FROM inv_guageinfo (nolock) order by mat_rec_id,guage_id';
  sList.Clear;
  with Query do begin
    Active      := False;
    RequestLive := False;
    Sql.Clear;
    Sql.Add(Sqls);
    try
      Open;
      for i:=0 to RecordCount-1 do begin
        New(lcp);
        ZeroMemory(lcp, Sizeof(TGuageInfo));
        //--
        lcp^.mat_rec_id := Fields[0].AsInteger;
        lcp^.guage_id   := Fields[1].AsInteger;
        strPCopy(lcp^.guage_name, Fields[2].AsString);
        lcp^.safety       := Fields[3].AsInteger;
        lcp^.max_stkqty   := Fields[4].AsInteger;
        lcp^.fixed_buyqty := Fields[5].AsInteger;
        lcp^.buy_days     := Fields[6].AsInteger;
        lcp^.weight_pcs   := Fields[7].AsFloat;
        Next;
        sList.Add(lcp);
      end;
    finally
      Close;
    end;
  end;
end;

Function  Tdm_Inventory.Get_GuageName(mat_recid,guage_id: integer): string;
var IX:  Integer;
    lcP: PGuageInfo;
begin
  Result := '';
  if guage_id = 0 then
  begin
    if (dm_Inventory.GetMaterialStandardName(mat_recid)='') then result := 'none guage'
    else result := dm_Inventory.GetMaterialStandardName(mat_recid);
  end;

  for IX:=0 to FGuageList.Count-1 do begin
    lcp := FGuageList[IX];
    if ((lcp^.mat_rec_id=mat_recid)and(lcp^.guage_id = guage_id)) then begin
       result := lcP^.guage_name;
       Exit;
    end;
  end;
end;

function  Tdm_Inventory.Get_GuageCheck(mat_recid,guage_id: integer; var edt: TEdit): Boolean;
var WStr: string;
begin
  Result := True;
  WStr := dm_Inventory.Get_GuageName(mat_recid,guage_id);
  if (guage_id>0)and(WStr='') then
    if MessageDlg('该编码不存在/确定使用不存在的该编码？', mtWarning, [mbOk], 0) = mrOK then begin
      Result := False;
      Exit;
    end;
  edt.Text := WStr;
end;

procedure Tdm_Inventory.Read_IOIDInfo_ToCbx(cbx: TComBoBox; sIndex: integer);
var i: integer;
    lcP: PClassInfo;
begin
   cbx.Items.Clear;
   for i :=0 to FInOutIDList.Count-1 do
   begin
    lcp := FInOutIDList[i];
    if lcp^.sClassIndex = sIndex then cbx.Items.Add(lcp^.sCode+'_'+lcp^.sName);
  end;
end;

function  Tdm_Inventory.Read_IOIDInfo(sIndex: integer; sList: TList): Integer;
var lcp: PClassInfo;
    Sqls: string;
    i: Integer;
begin
  result := 0;
  if sIndex = -1 then  begin
    Sqls := 'SELECT paperno,classindex,scode,sname,smemo '+
            'FROM stk_inouttypedef (nolock) '+
            'ORDER BY classindex,scode ASC';
  end
  else begin
    Sqls := 'SELECT paperno,classindex,scode,sname,smemo '+
            'FROM stk_inouttypedef (nolock) '+
            'WHERE classindex= '+ inttostr(sIndex) + ' '+
            'ORDER BY classindex,scode ASC';
  end;
  sList.Clear;
  with Query do begin
    Active      := False;
    RequestLive := False;
    Sql.Clear;
    Sql.Add(Sqls);
    try
      Open;
      for i:=0 to RecordCount-1 do begin
        New(lcp);
        ZeroMemory(lcp, Sizeof(TClassInfo));
        //--
        lcp^.sMainKey    := Fields[0].AsString;
        lcp^.sClassIndex := Fields[1].AsInteger;
        lcp^.sCode       := Fields[2].AsString;
        lcp^.sName       := Fields[3].AsString;
        lcp^.sMemo       := Fields[4].AsString;
        Next;
        sList.Add(lcp);
      end;
    finally
      result := 1;
      Close;
    end;
  end;
end;

function  Tdm_Inventory.InOut_IDProc(scode: string;IType: integer; var edt: TEdit): Boolean;
var WStr: string;
begin
  Result := True;
  WStr := dm_Inventory.Get_IOIDName(scode,IType);
  if (scode<>'')and(WStr='') then
    if MessageDlg('该编码不存在/确定使用不存在的该编码？', mtWarning, [mbOk], 0) = mrOK then begin
      Result := False;
      Exit;
    end;
  edt.Text := WStr;
end;

function  Tdm_Inventory.Get_IOIDName(sCode: string; itype: integer): string;
var IX:  Integer;
    lcP: PClassInfo;
begin
  Result := '';
  for IX:=0 to FInOutIDList.Count-1 do begin
    lcp := FInOutIDList[IX];
    if lcp^.sClassIndex = itype then begin
      if (lcp^.sCode = scode) then begin
       Result := lcP^.sName;
       Exit;
      end;
    end;
  end;
end;

///////////////////////////////////////////////////////////////////////
Procedure Tdm_Inventory.Read_SupplyMake_ToCbx(cbx: TComBoBox);
var i: integer;
    lcP: PSHIGEN;
begin
   cbx.Items.Clear;
   //cbx.Items.Add(' '+'_'+'UN-SETUP');
   for i :=0 to ShigenTBL.Count-1 do
   begin
    lcp := ShigenTBL[i];
    if lcp^.REC_ID>0 then cbx.Items.Add(inttostr(lcp^.SIGEN_CD)+'_'+lcp^.SIGEN_NM);
  end;
end;

procedure Tdm_Inventory.Read_EmpInfoToCbx(cbx: TComBoBox);
var i: integer;
    lcP: PShigen;
begin
   cbx.Items.Clear;
   for i :=0 to FEmpList.Count-1 do
   begin
    lcp := FEmpList[i];
    cbx.Items.Add(IntToStr(lcp^.SIGEN_CD)+'_'+lcp^.SIGEN_NM);
  end;
end;

Procedure Tdm_Inventory.Read_empInfo;
var lcp: PShigen;
    Sqls: string;
    i: Integer;
begin
  Sqls := 'SELECT rec_id, shigen_cd, meisho, shozoku_cd9 '+
          'FROM shigen '+
          'WHERE (group_cd=1) AND (visible>0) '+
          'ORDER BY shigen_cd ASC';
  with Query do begin
    Active      := False;
    RequestLive := False;
    Sql.Clear;
    Sql.Add(Sqls);
    try
      Open;
      for i:=0 to RecordCount-1 do begin
        New(lcp);
        ZeroMemory(lcp, Sizeof(TShigen));