.#pchspeer.pas.1.38

群星医药系统源码

  end;
end;

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

procedure TFmPchSpeer.CdsPchSpeerDtlGoodsIDChange(Sender: TField);
Var
  LogText,Flag,sGoodsID,sSetFields,sProvNo:String;
Begin
  IF (FEditMode=0) or bBrowGoods Then Exit;
  IF FlagGoodsID<>'' Then Begin
    FlagGoodsID:='';
    Exit;
  End;
  sGoodsID:=CdsPchSpeerDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sProvNo := CdsPchSpeerProvNo.Value;
  Flag:=GetGoodsInfo(CdsPchSpeerDtl,'OPrice',sGoodsID,sSetFields,LogText,sProvNo,'Pch');
  If Flag<>'' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    FlagGoodsID:=LogText;
    If Copy(Trim(sGoodsID),1,1)='-' Then
      CdsPchSpeerDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
End;

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

procedure TFmPchSpeer.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrPchSpeer.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 TFmPchSpeer.CdsPchSpeerReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=RaAbort;
end;

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

procedure TFmPchSpeer.dbgPchSpeerEditButtonClick(Sender: TObject);
Var
  sField,sGoodsID,sProvNo,sUnit:String;
  dPrice:Double;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgPchSpeer.SelectedField.FieldName));
  If sField='goodsid' Then Begin
    bBrowGoods := true;
    SelectGoods(CdsPchSpeerDtl, CdsPchSpeerDtlGoodsID, CdsPchSpeerDtlUnit, true, False, false);
    sGoodsID := CdsPchSpeerDtlGoodsID.Value;
    sProvNo := CdsPchSpeerProvNo.Value;
    sUnit := CdsPchSpeerDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'Pch',sGoodsID,sProvNo,sUnit);
      if dPrice<>0 Then
        CdsPchSpeerDtlOprice.Value := dPrice;
    End;
    bBrowGoods := false;
  End Else
  Begin
    If sField='oprice' Then Begin
      dPrice := ViewGoodsPrice(CdsPchSpeerDtlGoodsID.Value, CdsPchSpeerDtlUnit.Value);
      If dPrice>=0 Then Begin
        CdsPchSpeerDtl.Edit;
        CdsPchSpeerDtlOprice.Value := dPrice;
      End;
    End;
  End;
End;

procedure TFmPchSpeer.ActDeleteExecute(Sender: TObject);
begin
  If CdsPchSpeerTransfer.Value Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能执行删除操作！'),'警告',64);
    Exit;
  End;
  inherited;
end;

procedure TFmPchSpeer.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  Try
    If FEditMode=0 Then Exit;
    iIndex:=cbPayModes.ItemIndex;
    if iIndex<>-1 Then
      CdsPchSpeerPayModeNo.Value:=slPayModes[iIndex];
    If (CdsPchSpeerDtl.State In dsEditModes) Then
      CdsPchspeerDtl.Post;
    Inherited;
  Except
   raise;
//    On E:Exception Do ;
  End;
End;

procedure TFmPchSpeer.SumCount;
Var
  dUnTaxPrice,dQty,dAmount,D,E,T:Double;
begin
  D:=CdsPchSpeerDtlOPrice.AsFloat;             //标准售价
  IF CdsPchSpeerDtlRebate.IsNull Then
    E := 100
  Else
    E:=CdsPchSpeerDtlRebate.AsFloat;             //折扣
  T:=CdsPchSpeerDtlTaxRate.AsFloat;            //税率
  dQty:=CdsPchSpeerDtlQty.AsFloat;             //数量
  CdsPchSpeerDtlPrice.AsFloat:=D*(E/100);      //实际售价             //实际售价
  dUnTaxPrice:=D*(E/100)/(1+T/100);             //未税单价
  CdsPchSpeerDtlUnTaxPrice.AsFloat:=dUnTaxPrice;
  CdsPchSpeerDtlGoodsSum.AsFloat:=dQty*dUnTaxPrice;     //货款;
  dAmount:=dQty*D*(E/100);                       //合计;
  CdsPchSpeerDtlAmount.AsFloat:=dAmount;
  CdsPchSpeerDtlTaxSum.AsFloat:=dAmount-dQty*dUnTaxPrice;  //税款
end;

procedure TFmPchSpeer.edProvNameButtonClick(Sender: TObject);
Var sProvNo,sProvName:String;
begin
  If FEditMode=0 Then Exit;
  sProvNo := CdsPchSpeerProvNo.Value;
  If SelectProv(sProvNo,sProvName) Then Begin
    CdsPchSpeerProvNo.Value := sProvNo;
    CdsPchSpeerProvName.Value := sProvName;
  End;
End;

procedure TFmPchSpeer.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str:String;
  sSysInfo : Variant;
begin
  Try
    If CdsPchSpeer.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 CdsPchSpeerFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不对，系统已对该月做个月结...'),nil,16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),nil,16);
      Exit;
    End;
    CdsPchSpeer.Edit;
    CdsPchSpeerTransfer.Value:=True;
    sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
    CdsPchSpeerAudit.Value := sUserID;
    If CdsPchSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('审核数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=False;
      ActRevert.Enabled:=True;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(Nil);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),nil,16);
  End;
end;

procedure TFmPchSpeer.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsPchSpeer.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    inherited;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示',4+32)<>6 Then Exit;
    CdsPchSpeer.Edit;
    CdsPchSpeerTransfer.Value:=False;
    CdsPchSpeerAudit.Value := '';
    If CdsPchSpeer.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),nil,16)
    Else Begin
      ActAudit.Enabled:=True;
      ActRevert.Enabled:=False;
      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 TFmPchSpeer.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchSpeer],'采购询价明细');
end;

procedure TFmPchSpeer.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchSpeer, CdsPchSpeerDtl],'采购询价;采购询价明细', '');
end;

procedure TFmPchSpeer.ActBillTurnExecute(Sender: TObject);
var sBillNo, sToBillNo, str ,MatchBillNo: String;
begin
  if FEditMode>0 then Exit;
  If Not(CdsPchSpeerTransFer.Value) Then Begin
    Messagebox(Handle,Pchar('当前单据尚没[审核],不能进行转单操作!'),'警告',64);
    Exit;
  End;
  sBillNo := cdsPchSpeerBillNo.AsString;
  if sBillNo='' then Exit;
  if Application.MessageBox('确定要将此采购询价单转出到采购订单吗？', '消息', MB_YESNO+MB_ICONQUESTION)=IDNO then
    Exit;
  sToBillNo := BuildBillNo('PchOrder');
  if SvrPchSpeer.AppServer.BillTurn(iClientID, 'PchSpeer', 'PchOrder', sBillNo, sToBillNo,MatchBillNo) then begin
    ActRefresh.Execute;
    str := sBillNo+'号询价单已成功转出到['+MatchBillNo+']号采购订单，要查看该单据吗？';
    if Application.MessageBox(PChar(str), '消息', MB_YESNO+MB_ICONINFORMATION)=IDYES then
      IFmMain.DoSome(ActBillTurn.ModuleFile, 'ViewBill', MatchBillNo);
  end;
end;

function TFmPchSpeer.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;
      SetCurrBillNo(str);
    end;
  end;
end;

procedure TFmPchSpeer.ActUpdateExecute(Sender: TObject);
begin
  If CdsPchSpeerTransFer.Value Then Begin
    Messagebox(Handle,Pchar('当前单据已[审核]，不能进行修改操作!'),'警告',64);
    Exit;
  End;
  inherited;
end;

procedure TFmPchSpeer.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 := CdsPchSpeerProvNo.Value;
  If SelectProvLinkMan(sProvNo,sLinkMan) Then
    CdsPchSpeerLinkMan.Value := sLinkMan ;
end;

initialization
  RegisterClass(TFmPchSpeer);

finalization
  UnRegisterClass(TFmPchSpeer);

end.