pchreceivefrm.pas

来自「医药连锁经营管理系统源码」· PAS 代码 · 共 815 行 · 第 1/2 页

procedure TFmPchReceive.CdsPchReceiveDtlpriceChange(Sender: TField);
begin
  if dbgPchReceiveDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchReceiveDtlUnTaxPrice.AsFloat := CdsPchReceiveDtlPrice.AsFloat / ( 1 + CdsPchReceiveDtlTaxRate.AsFloat / 100 );
    CdsPchReceiveDtlGoodsSum.AsFloat := cdsPchReceiveDtlQty.AsFloat*CdsPchReceiveDtlUnTaxPrice.AsFloat;
    CdsPchReceiveDtlAmount.AsFloat := cdsPchReceiveDtlQty.AsFloat*cdsPchReceiveDtlPrice.AsFloat;
    CdsPchReceiveDtlTaxSum.AsFloat := CdsPchReceiveDtlAmount.AsFloat-CdsPchReceiveDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchReceive.CdsPchReceiveDtlAfterPost(DataSet: TDataSet);
var dQty,dGoodsSum,dTaxSum,dTaxRate,dAmount:Double;
		mark1: TBookmark;
begin
  BeforeGoodsID:='';  
  dQty:=0;
  dGoodsSum:=0;
  dTaxSum:=0;
  dTaxRate:=0;
  dAmount:=0;
  with CdsPchReceiveDtl do begin
    Mark1 := GetBookmark;
    DisableControls;
    try
      First;
      while not Eof do begin
        dQty:=dQty+FieldByName('Qty').AsFloat;
        dGoodsSum := dGoodsSum+FieldbyName('GoodsSum').AsFloat;
        dTaxSum := dTaxSum+ FieldbyName('TaxSum').AsFloat;
        dTaxRate := dTaxRate+ FieldbyName('TaxRate').AsFloat;
        dAmount := dAmount+ FieldbyName('Amount').AsFloat;
        next;
      end;
      CdsPchReceive.FieldByName('GoodsQty').AsFloat:=dQty;
      CdsPchReceive.FieldByName('TaxRate').AsFloat:=dTaxRate;
      CdsPchReceive.FieldByName('TaxSum').AsFloat:=dTaxSum;
      CdsPchReceive.FieldByName('Amount').AsFloat:=dAmount;
      CdsPchReceive.FieldByName('GoodsSum').AsFloat:=dGoodsSum;
    finally
      GotoBookmark(Mark1);
      FreeBookmark(Mark1);
      EnableControls;
    end;
  end;
end;

procedure TFmPchReceive.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName,sEmpNo,sPayModeNo:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsPchReceiveProvNo.Value;
  If SelectProv(sProvNo,sProvName,sEmpNo,sPayModeNo) Then Begin
    CdsPchReceiveProvNo.Value := sProvNo;
    CdsPchReceiveProvName.Value := sProvName;
    CdsPchReceiveEmpNo.Value := sEmpNo;
    CdsPchReceivePayModeNo.Value := sPayModeNo;
  End;
End;

procedure TFmPchReceive.RzDBButtonEdit1ButtonClick(Sender: TObject);
Var sEmpNo,sEmpName:String;
begin
  If FEditMode=0 Then Exit;
  sEmpNo := CdsPchReceiveEmpNo.Value;
  If SelectEmp(sEmpNo,sEmpName) Then begin
    CdsPchReceiveEmpNo.Value := sEmpNo;
    CdsPchReceiveName.Value := sEmpName;
  End;
end;

procedure TFmPchReceive.ShowPayModes;
Var
  A:Variant;                      
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrPchReceive.AppServer.GetNeedValue(iClientID,3,sPayModes);
    If (Not VarIsNull(A)) And (VarIsArray(A)) Then
    Begin
      slPayModes.Clear;
      cbPayModes.Items.Clear;
      k := VarArrayHighBound(A,2);
      for i:=VarArrayLowBound(A,2) to k do
      Begin
        slPayModes.Add(A[0,i]);
        cbPayModes.Items.Add(A[0,i]+':'+A[1,i]+'('+A[2,i]+')');
      End;
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmPchReceive.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  Action:=caFree;
end;

procedure TFmPchReceive.dbgPchReceiveDtlEditButtonClick(Sender: TObject);
Var
  sField:String;
  dPrice:Double;
  iDepotID: Integer;
  sDepotNo,sDepotName: string;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgPchReceiveDtl.SelectedField.FieldName));
  If sField='goodsid' Then
    ParseGoodsInfo
  Else If sField='price' Then
  Begin
    dPrice := ViewGoodsPrice(CdsPchReceiveDtlGoodsID.Value, CdsPchReceiveDtlUnit.Value);
    If dPrice>=0 Then Begin
      CdsPchReceiveDtl.Edit;
      CdsPchReceiveDtlprice.Value := dPrice;
    End;
  End
  else if sField='depotno' then
  begin
    iDepotID := CdsPchReceiveDtlDepotID.Value;
    if not (CdsPchReceiveDtl.State in dsEditModes) then
      CdsPchReceiveDtl.Edit;
    if SelectDepot(iDepotID,sDepotNo,sDepotName) then
    begin
      CdsPchReceiveDtlDepotID.Value := iDepotID;
      CdsPchReceiveDtlDepotNo.Value := sDepotNo;
      CdsPchReceiveDtlDepotName.Value := sDepotName;
    end;
  end Else if sField='wholedepotno' then
  begin
    iDepotID := CdsPchReceiveDtlWholeDepot.Value;
    if not (CdsPchReceiveDtl.State in dsEditModes) then
      CdsPchReceiveDtl.Edit;
    if SelectDepot(iDepotID,sDepotNo,sDepotName) then
    begin
      CdsPchReceiveDtlWholeDepot.Value := iDepotID;
      CdsPchReceiveDtlWholeDepotNo.Value := sDepotNo;
      CdsPchReceiveDtlWholeDepotName.Value := sDepotName;
    end;
  end;
End;

procedure TFmPchReceive.CdsPchReceiveDtlGoodsIDChange(Sender: TField);
begin
  ParseGoodsInfo;
End;

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

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

procedure TFmPchReceive.CdsPchReceiveDtlDepotNoChange(Sender: TField);
Var
  sDepotNo,LogText:String;
  A:Variant;
begin
  Try
    IF FEditMode=0 Then Exit;
    sDepotNo:=CdsPchReceiveDtlDepotNo.Value;
    If sDepotNo='' Then Exit;
    if sDepotNo=BeforeDepotNo Then Exit;
    BeforeDepotNo:=sDepotNo;
    A := SvrCommon.AppServer.GetDepotInfo(iClientID,sDepotNo,2,'DepotID,DepotName',LogText);
    CdsPchReceiveDtlDepotID.Value  := A[0];
    CdsPchReceiveDtlDepotName.Value:= A[1];
    If LogText<>'' Then Begin
      Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
      Abort;
    End;
  Except
    Messagebox(Handle,Pchar('无效的仓库编号...'),nil,16);
    Abort;
  End;
end;

procedure TFmPchReceive.ActAuditExecute(Sender: TObject);
Var
  sBillNo, MatchBillNo,sBranchMachine,Str: String;
  iBranchID,iMachineID: Integer;
  sSysInfo: Variant;
  sBillList : TStrings;
begin
  sBillList := TStringList.Create;
  Try
    If CdsPchReceive.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    Inherited;
    If Application.MessageBox('确实要审核当前数据吗？','提示',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsPchReceiveFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('该月已结算，不能操作已月结的单据！'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    sBillNo := CdsPchReceiveBillNo.AsString;
    If sBillNo='' then Exit;
    iBranchID  := IFmMain.IFmMainEx.GetLocSetting^.BranchNo;
    iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
    sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
    IF SvrPchReceive.AppServer.BillTurn(iClientID,'PchReceive','StockIn',sBranchMachine,sBillNo, MatchBillNo) Then
    Begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(NIL);
      str := sBillNo+'号入库通知单已成功转出到['+MatchBillNo+']号药品入库单，要查看该单据吗？';
      if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
        IFmMain.DoSome(ActAudit.ModuleFile, 'ViewBill', MatchBillNo);
    end Else
      Messagebox(Handle,Pchar('[审核]数据不成功,可能是转单错误！'),nil,16)
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
  sBillList.Free;
end;

procedure TFmPchReceive.ActRevertExecute(Sender: TObject);
Var BillNo : String;
begin
  Try
    If CdsPchReceive.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsPchReceiveBillNo.Value;
    If Not(SvrPchReceive.AppServer.BillRevert(iClientID,'PchReceive',BillNo,'')) Then Begin
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16);
    End Else Begin
      ActAudit.Enabled:=True and CanAudit;
      ActRevert.Enabled:=False and CanRevert;
      Lab_State.Caption:='单据状态：未审核';
      Lab_State.Font.Color:=clHotLight;
      ActRefreshExecute(Nil);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
End;

procedure TFmPchReceive.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPchReceiveDtl,dbgPchExpense],'入库通知单明细;入库通知费用');
end;

procedure TFmPchReceive.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchReceive, CdsPchReceiveDtl,CdsPchExpense],'入库通知单;入库通知单明细;入库通知单费用', '');
end;

function TFmPchReceive.DoSome(cType: PChar; Values: Variant): Variant;
const
  cTypes = 'viewbill'#13'query';
  //       查看某单     查询
var sTypes: TStrings;
    i: 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 TFmPchReceive.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sProvNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If DBEdit7.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),nil,16);
    Exit;
  End;
  sProvNo := CdsPchReceiveProvNo.Value;
  If SelectProvLinkMan(sProvNo,sLinkMan) Then
    CdsPchReceiveLinkMan.Value := sLinkMan ;
end;

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

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

procedure TFmPchReceive.ParseGoodsInfo;
var sGoodsID,sProvNo,sUnit:String;
    b1: Boolean;
    dPrice:Double;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsPchReceiveDtl, CdsPchReceiveDtlGoodsID, CdsPchReceiveDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsPchReceiveDtlGoodsID.Value;
    sProvNo := CdsPchReceiveProvNo.Value;
    sUnit := CdsPchReceiveDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsPchReceiveDtlPrice.Value := dPrice;
    End;
    cdsPchReceiveDtlProdDateChange(cdsPchReceiveDtlProdDate);
  finally
    bBrowGoods := false;
  end;
end;

Initialization
  RegisterClass(TFmPchReceive);
Finalization
  RegisterClass(TFmPchReceive);
end.