pchsettlefrm.pas

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

    CdsPchSettleEmpName.Value := sEmpName;
  End;
end;

procedure TFmPchSettle.edDepartNameButtonClick(Sender: TObject);
var iDepartID : Integer;
    sDepartNo, sDepartName: String;
begin
  iDepartID := CdsPchSettleDepartID.AsInteger;
  If SelectDepart(iDepartID, sDepartNo, sDepartName, 0) then begin
    CdsPchSettleDepartID.AsInteger := iDepartID;
    CdsPchSettleDepartNo.AsString := sDepartNo;
    CdsPchSettleDepartName.AsString := sDepartName;
  end;
end;

procedure TFmPchSettle.CdsPchSettleNewRecord(DataSet: TDataSet);
begin
  edProvName.Button.Click;
  edDepartName.Button.Click;
  CdsPchSettleBillNo.Value := BuildBillNo('PchSettle');    
  CdsPchSettleCreater.Value := LogonInfo^.UserID;
  CdsPchSettleGrup.Value := LogonInfo^.UserGrupID;
  CdsPchSettleFDate.Value:=Date;
  CdsPchSettlePayDate.Value:=Date;
  CdsPchSettleGoodsQty.Value := 0;
  CdsPchSettleGoodsSum.Value := 0;
  CdsPchSettleTaxSum.Value := 0;
  CdsPchSettleAmount.Value := 0;
end;

procedure TFmPchSettle.CdsPchSettleDtlGoodsIDChange(Sender: TField);
{Var
  LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
  IF FEditMode=0 Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  If bBrowGoods then Exit;
  sGoodsID:=CdsPchSettleDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sProvNo := CdsPchSettleProvNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsPchSettleDtl,'Price',sGoodsID,sSetFields,sProvNo,'P',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsPchSettleDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;}
begin
  ParseGoodsInfo;
End;

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

procedure TFmPchSettle.SumCount;
Var
  dUnTaxPrice,dQty,dAmount,D,E,T:Double;
begin
  T:=CdsPchSettleDtlTaxRate.AsFloat;            //税率
  dQty:=CdsPchSettleDtlQty.AsFloat;             //数量
  CdsPchSettleDtlPrice.AsFloat:=D*(E/100);      //实际售价(这个地方有疑问，D和E都没有赋值)
  dUnTaxPrice:=D*(E/100)/(1+T/100);             //未税单价
  CdsPchSettleDtlUnTaxPrice.AsFloat:=dUnTaxPrice;
  CdsPchSettleDtlGoodsSum.AsFloat:=dQty*dUnTaxPrice;     //货款;
  dAmount:=dQty*D*(E/100);                       //合计;
  CdsPchSettleDtlAmount.AsFloat:=dAmount;
  CdsPchSettleDtlTaxSum.AsFloat:=dAmount-dQty*dUnTaxPrice;  //税款
end;

procedure TFmPchSettle.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k,iIndex:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrPchSettle.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;
    iIndex := CdsPchSettleInOutKind.Value;
    cbInOutKind.ItemIndex := iIndex;
    iIndex := CdsPchSettleInvoiceType.Value;
    cbInvoiceType.ItemIndex := iIndex;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmPchSettle.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  If FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 Then
    CdsPchSettlePayModeNo.Value:=slPayModes[iIndex];
  iIndex := cbInOutKind.ItemIndex;
  if iIndex <> -1 Then
    CdsPchSettleInOutKind.Value := iIndex;
  iIndex := cbInvoiceType.ItemIndex;
  If iIndex <> -1 Then
    CdsPchSettleInvoiceType.Value := iIndex;
  If (CdsPchSettleDtl.State In dsEditModes) Then
    CdsPchSettleDtl.Post;
  Inherited;
end;

procedure TFmPchSettle.CdsPchSettleReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
end;

procedure TFmPchSettle.dbgPchOrderDtlEditButtonClick(Sender: TObject);
var sField: String;
    dPrice: Double;
begin
  if FEditMode=0 then Exit;
  sField := LowerCase(dbgPchOrderDtl.SelectedField.FieldName);
  if sField='goodsid' then begin
    ParseGoodsInfo;
  end else if sField='price' then begin
    dPrice := ViewGoodsPrice(CdsPchSettleDtlGoodsID.Value, CdsPchSettleDtlUnit.Value);
    if dPrice>=0 then begin
      CdsPchSettleDtl.Edit;
      CdsPchSettleDtlPrice.Value := dPrice;
    end;
  end;
end;

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

procedure TFmPchSettle.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str,sBranchMachine,sBillNo,MatchBillNo:String;
  sSysInfo : Variant;
  iBranchID,iMachineID : Integer;
begin
  Try
    If CdsPchSettle.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 CdsPchSettleFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不符，该月已完成月度结算...'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    sBillNo := CdsPchSettleBillNo.AsString;
    If sBillNo='' then Exit;
    iBranchID  := IFmMain.IFmMainEx.GetLocSetting^.BranchNo;
    iMachineId := IFmMain.IFmMainEx.GetLocSetting^.MachineNo;
    sBranchMachine := FormatFloat('000',iBranchID)+FormatFloat('00',iMachineID);
    IF SvrPchSettle.AppServer.BillTurn(iClientID,'PchSettle','PurchPay',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;
end;

procedure TFmPchSettle.ActRevertExecute(Sender: TObject);
Var BillNo: String;
begin
   Try
    If CdsPchSettle.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    Inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    BillNo  := CdsPchSettleBillNo.Value;
    CdsPchSettle.Edit;
    CdsPchSettleTransfer.Value:=False;
    CdsPchSettleAudit.Value := '';
    If CdsPchSettle.ApplyUpdates(0)>0 Then  
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    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 TFmPchSettle.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPchOrderDtl],'采购合同明细');
end;

procedure TFmPchSettle.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchSettle, CdsPchSettleDtl],'采购合同;采购合同明细', '');
end;

function TFmPchSettle.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 TFmPchSettle.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName,sEmpNo,sPayModeNo:String;
begin
  If Not CdsPchSettleDtl.IsEmpty Then Exit;
  If FEditMode=0 Then Exit;
  sProvNo := CdsPchSettleProvNO.Value;
  If SelectProv(sProvNo,sProvName,sEmpNo,sPayModeNo) Then
  Begin
    CdsPchSettleProvNO.Value := sProvNo;
    CdsPchSettleProvName.Value := sProvName;
    CdsPchSettleEmpNO.Value := sEmpNo;
    cbPayModes.ItemIndex := slPayModes.IndexOf(sPayModeNo);
  End;
End;

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

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

procedure TFmPchSettle.Button1Click(Sender: TObject);
begin
  Showmessage(cdsPchSettledtlBillNo.Value);
end;

procedure TFmPchSettle.ActUpdateExecute(Sender: TObject);
begin
  If Not CdsPchSettleDtl.IsEmpty Then Begin
    RzDBEdit9.ReadOnly := True;
    RzDBEdit9.Tag := -1;
  End;
  inherited;
end;

procedure TFmPchSettle.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(CdsPchSettleDtl, CdsPchSettleDtlGoodsID, CdsPchSettleDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsPchSettleDtlGoodsID.Value;
    sProvNo := CdsPchSettleProvNo.Value;
    sUnit := CdsPchSettleDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsPchSettleDtlPrice.Value := dPrice;
    End;
  finally
    bBrowGoods := false;
  end;
end;

initialization
  RegisterClass(TFmPchSettle);

finalization
  UnRegisterClass(TFmPchSettle);

end.