pchcheckinfrm.pas

群星医药系统源码

    try
      First;
      while not Eof do
      begin
        dGoodsQty := dGoodsQty+FieldByname('Qty').AsFloat;
        dGoodsSum := dGoodsSum+FieldByName('GoodsSum').AsFloat;
        dTaxSum   := dTaxSum + FieldByname('TaxSum').AsFloat;
        dAmount   := dAmount + FieldByName('Amount').AsFloat;
        Next;
      end;
      CdsPchCheckinGoodsQty.Value := dGoodsQty;
      CdsPchCheckinGoodsSum.Value := dGoodsSum;
      CdsPchCheckinTaxSum.Value   := dTaxSum;
      CdsPchCheckinAmount.Value   := dAmount;
    finally
      GotoBookmark(Mark1);
      FreeBookmark(Mark1);
      EnableControls;
    end;
  end;
end;

procedure TFmPchCheckin.RzDBButtonEdit4ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsPchCheckInEmpNO.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsPchCheckInEmpNO.Value := sEmpNo;
    CdsPchCheckInName.Value := sEmpName;
  End;
end;

procedure TFmPchCheckin.CdsPchCheckinReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Action:=RaAbort;
end;

procedure TFmPchCheckin.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName,sEmpNo,sPayModeNo:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsPchCheckInProvNo.Value;
  If SelectProv(sProvNo,sProvName,sEmpNo,sPayModeNo) Then Begin
    CdsPchCheckInProvNO.Value := sProvNo;
    CdsPchCheckInProvName.Value := sProvName;
    CdsPchCheckinEmpNO.Value := sEmpNo;
  End;
End;

procedure TFmPchCheckin.CdsPchCheckinNewRecord(DataSet: TDataSet);
begin
  edProvName.Button.Click;
  cdsPchCheckInBillNo.Value := BuildBillNo('PchCheckIn');
  CdsPchCheckinCreater.Value := LogonInfo^.UserID;
  CdsPchCheckInGrup.Value := LogonInfo^.UserGrupID;
  CdsPchCheckinFDate.Value := date;
  CdsPchCheckinGoodsQty.Value := 0;
  CdsPchCheckinGoodsSum.Value := 0;
  CdsPchCheckinTaxSum.Value := 0;
  CdsPchCheckinAmount.Value := 0;
end;

procedure TFmPchCheckin.ActRefershExecute(Sender: TObject);
begin
  inherited;
  CdsPchCheckin.MergeChangeLog;
//  CdsPchCheckin.Active := False;
//  CdsPchCheckin.Active := True;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  if (CdsPchCheckinDtlEligibleQty.value<0) or (CdsPchCheckinDtlQty.value<0) then
    MessageBox(handle,'数值不能小于0!','提示',MB_ICONWARNING+MB_OK);
  if CdsPchCheckinDtlEligibleQty.value>CdsPchCheckinDtlQty.value then
    MessageBox(handle,'合数品数量大于实际数量！','提示',MB_ICONWARNING+MB_OK);

  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchCheckInDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='oprice')or(str='rebate') then
  begin
    dRebate := CdsPchCheckinDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchCheckinDtlPrice.AsFloat := CdsPchCheckinDtlOPrice.AsFloat * (dRebate/100);
    CdsPchCheckinDtlUnTaxPrice.AsFloat := CdsPchCheckinDtlPrice.AsFloat / (1 +  self.cdsPchCheckinDtlTaxRate.AsFloat/ 100);
  end;

  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsPchCheckinDtlGoodsSum.AsFloat := CdsPchCheckinDtlQty.AsFloat * CdsPchCheckinDtlUnTaxPrice.AsFloat;
  CdsPchCheckinDtlAmount.AsFloat := CdsPchCheckinDtlQty.AsFloat * CdsPchCheckinDtlPrice.AsFloat;
  CdsPchCheckinDtlTaxSum.AsFloat := CdsPchCheckinDtlAmount.AsFloat - CdsPchCheckinDtlGoodsSum.AsFloat;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchCheckinDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchCheckinDtlOPrice.AsFloat := CdsPchCheckinDtlPrice.AsFloat / (dRebate/100);
    CdsPchCheckinDtlUnTaxPrice.AsFloat := CdsPchCheckinDtlPrice.AsFloat / ( 1 + CdsPchCheckinDtlTaxRate.AsFloat / 100 );
    CdsPchCheckinDtlGoodsSum.AsFloat := cdsPchCheckinDtlQty.AsFloat*CdsPchCheckinDtlUnTaxPrice.AsFloat;
    CdsPchCheckinDtlAmount.AsFloat := cdsPchCheckinDtlQty.AsFloat*cdsPchCheckinDtlPrice.AsFloat;
    CdsPchCheckinDtlTaxSum.AsFloat := CdsPchCheckinDtlAmount.AsFloat-CdsPchCheckinDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlTaxRateChange(Sender: TField);
begin
  if dbgPchCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchCheckinDtlUnTaxPrice.AsFloat := CdsPchCheckinDtlPrice.AsFloat / ( 1 + CdsPchCheckinDtlTaxRate.AsFloat / 100 );
    CdsPchCheckinDtlGoodsSum.AsFloat := cdsPchCheckinDtlQty.AsFloat*CdsPchCheckinDtlUnTaxPrice.AsFloat;
    CdsPchCheckinDtlTaxSum.AsFloat := CdsPchCheckinDtlAmount.AsFloat-CdsPchCheckinDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlUnTaxPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchCheckInDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchCheckinDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchCheckinDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsPchCheckinDtlTaxRate.AsFloat / 100 );
    cdsPchCheckinDtlOprice.AsFloat  := CdsPchCheckinDtlPrice.AsFloat / (dRebate/100);
    CdsPchCheckinDtlGoodsSum.AsFloat:= cdsPchCheckinDtlQty.AsFloat * CdsPchCheckinDtlUnTaxPrice.AsFloat;
    CdsPchCheckinDtlAmount.AsFloat := cdsPchCheckinDtlQty.AsFloat*cdsPchCheckinDtlPrice.AsFloat;
    CdsPchCheckinDtlTaxSum.AsFloat  := CdsPchCheckinDtlAmount.AsFloat - CdsPchCheckinDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlProdDateChange(Sender: TField);
var sGoodsID: String;
    vDate: Variant;
begin
  if bDateChanging then Exit;
  sGoodsID := cdsPchCheckinDtlGoodsID.AsString;
  //这里响应了ProdDate和ValidDate两个字段的OnChange事件，所以要用Sender来代替确切的字段对象
  if (sGoodsID<>'')and not Sender.IsNull then
  begin
    bDateChanging := true;
    try
      if Sender=CdsPchCheckinDtlProdDate then
      begin
        vDate := SvrCommon.AppServer.GetUsefulLife(iClientID, sGoodsID, cdsPchCheckinDtlProdDate.Value);
        if vDate<>null then
          cdsPchCheckinDtlValidDate.AsVariant := vDate;
      end
      else if Sender=cdsPchCheckinDtlValidDate then
      begin
        vDate := SvrCommon.AppServer.GetUsefulLife(iClientID, '-'+sGoodsID, cdsPchCheckinDtlValidDate.Value);
        if vDate<>null then
         cdsPchCheckinDtlProdDate.AsVariant := vDate;
      end;
    finally
      bDateChanging := false;
    end;
  end;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlGoodsIDChange(Sender: TField);
Begin
  ParseGoodsInfo;
End;

procedure TFmPchCheckin.CdsPchCheckinEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=CdsPchCheckinEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsPchCheckinName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
end;

procedure TFmPchCheckin.CdsPchCheckinProvNoChange(Sender: TField);
Var
  sProvNo,sProvName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sProvNo:=CdsPchCheckinProvNo.Value;
  if sProvNo=BeforeProvNo Then Exit;
  If sProvNo='' Then Begin
    CdsPchCheckinProvName.Value:='';
    Exit;
  End;
  BeforeProvNo:=sProvNO;
  sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
  CdsPchCheckinProvName.Value:=sProvName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),nil,16);
    Abort;
  End;
end;

procedure TFmPchCheckin.dbgPchCheckInDtlEditButtonClick(Sender: TObject);
Var
  sGoodsID,sProvNo,sUnit:String;
  dPrice : Double;
begin
  if FEditMode=0 then Exit;
  if LowerCase(dbgPchCheckInDtl.SelectedField.FieldName)='goodsid' then Begin
    ParseGoodsInfo;
  End;
end;

procedure TFmPchCheckin.CdsPchCheckinAfterScroll(DataSet: TDataSet);
begin
  If CdsPchCheckinTransfer.Value Then Begin
    ActAudit.Enabled:=False and CanAudit;
    ActRevert.Enabled:=True and CanRevert;
    Lab_State.Caption:='单据状态：已审核';
    Lab_State.Font.Color:=clRed;
  End Else Begin
    ActAudit.Enabled:=True and CanAudit;
    ActRevert.Enabled:=False and CanRevert;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
end;

procedure TFmPchCheckin.ActUpdateExecute(Sender: TObject);
Var BillNo,RetStr : String;
begin
  If CdsPchCheckinTransfer.Value  Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),nil,16);
    Exit;
  End;
  BillNo := CdsPchCheckInBillNo.Value;
  If Not(SvrCdsPchCheckIn.AppServer.CanDoAction(iClientID,'GoodsCheckAccept',BillNo,'',RetStr)) Then Begin
    Messagebox(Handle,Pchar(RetStr+'不能进行修改操作...'),nil,16);
    Exit;
  End;
  inherited;
end;

procedure TFmPchCheckin.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPchCheckInDtl],'来货登记明细');
end;

procedure TFmPchCheckin.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchCheckin, CdsPchCheckinDtl],'来货登记;来货登记明细', '');
end;

function TFmPchCheckin.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i, k: integer;
    str, str2: String;
begin
  sTypes := TStringList.Create;
  sTypes.Text := cTypes;
  i := sTypes.IndexOf(cType);
  case i of
    0: begin//ViewBill
      if VarIsArray(Values) then begin
        str := Values[0];
        str2:= Values[1];
      end else begin
        str := Values;
        str2:= '';
      end;
      if str2='' then begin
        if sBillNoList.IndexOf(str)<0 then
          sBillNoList.Add(str);
      end else
        sBillNoList.Text := str2;
      self.BringToFront;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmPchCheckin.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var
  sProvNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If RzDBEdit4.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
    Exit;
  End;
  sProvNo := CdsPchCheckInProvNo.Value;
  If SelectProvLinkMan(sProvNo,sLinkMan) Then
    CdsPchCheckInLinkMan.Value := sLinkMan ;
end;

procedure TFmPchCheckin.CdsPchCheckinDtlAfterOpen(DataSet: TDataSet);
begin
  inherited;
  TNumericField(DataSet.FieldByName('UnTaxPrice')).DisplayFormat :='##.000000';
  TNumericField(DataSet.FieldByName('OPrice')).DisplayFormat :='##.000000';
  TNumericField(DataSet.FieldByName('Price')).DisplayFormat :='##.000000';
end;

procedure TFmPchCheckin.ActQueryExecute(Sender: TObject);
begin
  IFmMain.OnAction(Sender);
end;

procedure TFmPchCheckin.ParseGoodsInfo;
var sGoodsID,sProvNo,sUnit:String;
    dPrice : Double;
    b1: Boolean;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsPchCheckinDtl, CdsPchCheckinDtlGoodsID, CdsPchCheckinDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsPchCheckinDtlGoodsID.Value;
    sProvNo := CdsPchCheckinProvNo.Value;
    sUnit := CdsPchCheckinDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then
    begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsPchCheckinDtlOPrice.Value := dPrice;
    end;
    cdsPchCheckinDtlProdDateChange(cdsPchCheckinDtlProdDate);
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmPchCheckin);

finalization
  UnRegisterClass(TFmPchCheckin);

end.