.#pchinretfrm.pas.1.35

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

35
806 行
字号
12
begin
  if dbgPchInRetDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchInRetDtlUnTaxPrice.AsFloat := CdsPchInRetDtlPrice.AsFloat / ( 1 + CdsPchInRetDtlTaxRate.AsFloat / 100 );
    CdsPchInRetDtlGoodsSum.AsFloat := cdsPchInRetDtlQty.AsFloat*CdsPchInRetDtlUnTaxPrice.AsFloat;
    CdsPchInRetDtlTaxSum.AsFloat := CdsPchInRetDtlAmount.AsFloat-CdsPchInRetDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchInRet.CdsPchInRetDtlAfterPost(DataSet: TDataSet);
var dQty,dGoodsSum,dTaxSum,dTaxRate,dAmount:Double;
		mark1: TBookmark;
begin
  BeforeGoodsID:='';
  dQty:=0;
  dGoodsSum:=0;
  dTaxSum:=0;
  dTaxRate:=0;
  dAmount:=0;
	with CdsPchInRetDtl 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;
      CdsPchInRet.FieldByName('GoodsQty').AsFloat:=dQty;
      CdsPchInRet.FieldByName('TaxRate').AsFloat:=dTaxRate;
      CdsPchInRet.FieldByName('TaxSum').AsFloat:=dTaxSum;
      CdsPchInRet.FieldByName('Amount').AsFloat:=dAmount;
      CdsPchInRet.FieldByName('GoodsSum').AsFloat:=dGoodsSum;
    finally
    	GotoBookmark(Mark1);
      FreeBookmark(Mark1);
    	EnableControls;
    end;
  end;
end;

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

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

procedure TFmPchInRet.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 TFmPchInRet.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  inherited;
  Action:=caFree;
end;

procedure TFmPchInRet.CdsPchInRetDtlGoodsIDChange(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:=CdsPchInRetDtlGoodsID.AsString;
  If sGoodsID='' Then Exit;
  if (BeforeGoodsID=sGoodsID) Then Exit;
  BeforeGoodsID:=sGoodsID;
  sSetFields:= 'Name,Specs,Unit';
  sProvNo := CdsPchInRetProvNo.Value;
  FlagGoodsID:=GetGoodsInfo(CdsPchInRetDtl,'Price',sGoodsID,sSetFields,sProvNo,'P',1);
  If FlagGoodsID='' Then Begin
    Messagebox(Handle,'无效药品编号',nil,16);
    Abort;
  End Else Begin
    if sGoodsID<>FlagGoodsID then
      CdsPchInRetDtl.FieldByName('GoodsID').AsString:=FlagGoodsID
    Else
      FlagGoodsID:='';
  End;
  CdsPchInRetDtlValidDate.AsVariant := SvrGetUsefulLife.AppServer.GetUsefulLife(iClientID,CdsPchInRetDtlGoodsID.AsString,CdsPchInRetDtlProdDate.Value);}
begin
  ParseGoodsInfo;
End;

procedure TFmPchInRet.CdsPchInRetDtlBeforeEdit(DataSet: TDataSet);
begin
  BeforeGoodsID:=CdsPchInRetDtlGoodsID.Value;
end;

procedure TFmPchInRet.CdsPchInRetEmpNoChange(Sender: TField);
Var
  sEmpNo,sEmpName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sEmpNo:=CdsPchInRetEmpNo.Value;
  If sEmpNo='' Then Exit;
  if sEmpNo=BeforeEmpNo Then Exit;
  BeforeEmpNo:=sEmpNO;
  sEmpName:=VarToStr(SvrCommon.AppServer.GetEmpInfo(iClientID,sEmpNo,1,'Name',LogText));
  CdsPchInRetName.Value:=sEmpName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误：',16);
    Abort;
  End;
end;

procedure TFmPchInRet.CdsPchInRetProvNoChange(Sender: TField);
Var
  sProvNo,sProvName,LogText:String;
begin
  IF FEditMode=0 Then Exit;
  sProvNo:=CdsPchInRetProvNo.Value;
  If sProvNo='' Then Exit;
  if sProvNo=BeforeProvNo Then Exit;
  BeforeProvNo:=sProvNO;
  sProvName:=VarToStr(SvrCommon.AppServer.GetProvInfo(iClientID,sProvNo,1,'ProvName',LogText));
  CdsPchInRetProvName.Value:=sProvName;
  If LogText<>'' Then Begin
    Messagebox(Handle,Pchar(LogText),'错误：',16);
    Abort;
  End;
end;

procedure TFmPchInRet.dbgPchInRetDtlEditButtonClick(Sender: TObject);
Var
  sField,sGoodsID,sProvNo,sUnit:String;
  dPrice:Double;
Begin
  If FEditMode=0 Then Exit;
  sField :='';
  sField := Trim(LowerCase(dbgPchInRetDtl.SelectedField.FieldName));
  If sField='goodsid' Then Begin
    ParseGoodsInfo;
  End Else
  Begin
    If sField='price' Then Begin
      dPrice := ViewGoodsPrice(CdsPchInRetDtlGoodsID.Value, CdsPchInRetDtlUnit.Value);
      If dPrice>=0 Then Begin
        CdsPchInRetDtl.Edit;
        CdsPchInRetDtlprice.Value := dPrice;
      End;
    End;
  End;
End;


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

procedure TFmPchInRet.ActAuditExecute(Sender: TObject);
Var
  sUserID,Str:String;
  sSysInfo : Variant;
begin
  Try
    If CdsPchInRet.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要审核当前数据吗？','提示：',4+32)<>6 Then Exit;
    str := 'CurrMonth';
    sSysInfo := SvrCommon.AppServer.GetSysInfo(iClientID,Str,1);
    If Not(VarIsNull(sSysInfo)) Then Begin
      If CdsPchInRetFDate.Value<VarToDateTime(sSysInfo) Then Begin
        Messagebox(Handle,Pchar('单据日期不对，系统已对该月做过月结...'),'错误',16);
        Exit;
      End;
    End Else Begin
      Messagebox(Handle,Pchar('请先设置开帐日期...'),'错误',16);
      Exit;
    End;
    CdsPchInRet.Edit;
    CdsPchInRetTransfer.Value:=True;
    sUserID := iFmMain.IFmMainEx.LogonInfo^.UserID;
    CdsPchInRetAudit.Value := sUserID;
    try
      CdsPchInRet.Post;
    Except
      CdsPchInRet.Cancel;
      Raise;
    end;
    If CdsPchInRet.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('复核数据不成功！'),'错误：',16)
    Else Begin
      ActAudit.Enabled:=False and CanAudit;
      ActRevert.Enabled:=True and CanRevert;
      Lab_State.Caption:='单据状态：已审核';
      Lab_State.Font.Color:=clRed;
      ActRefreshExecute(Nil);
    End;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'错误：',16);
  End;
end;

procedure TFmPchInRet.ActRevertExecute(Sender: TObject);
begin
  Try
    If CdsPchInRet.IsEmpty Then Exit;
    If FEditMode>0 then Exit;
    If Application.MessageBox('确实要还原当前已审核过的数据吗？','提示：',4+32)<>6 Then Exit;
    CdsPchInRet.Edit;
    CdsPchInRetTransfer.Value:=False;
    CdsPchInRetAudit.Value := '';
    try
      CdsPchInRet.Post;
    Except
      CdsPchInRet.Cancel;
      Raise;
    end;
    If CdsPchInRet.ApplyUpdates(0)>0 Then
      Messagebox(Handle,Pchar('还原数据不成功！'),'错误：',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),'错误：',16);
  End;
end;

procedure TFmPchInRet.ActFieldLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                  [dbgPchInRetDtl,dbgPchInRetExpense],'药品购进退回明细;药品购进退回费用');
end;

procedure TFmPchInRet.ActDataExportExecute(Sender: TObject);
begin
	ExportData([CdsPchInRet, CdsPchInRetDtl,CdsPchInRetExpense],'药品购进退回;药品购进退回明细;药品购进退回费用', '');
end;

function TFmPchInRet.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 TFmPchInRet.dbgPchInRetDtlColumns15EditButtonClick(
  Sender: TObject; var Handled: Boolean);
var iDepotID: Integer;
    DepotNo,DepotName: string;
begin
  If FEditMode=0 Then Exit;
  iDepotID := CdsPchInRetDtlDepotID.Value;
  If SelectDepot(iDepotID,DepotNo,DepotName) Then Begin
    CdsPchInRetDtlDepotID.Value := iDepotID;
    CdsPchInRetDtlDepotNo.Value := DepotNo;
    CdsPchInRetDtlDepotName.Value := DepotName;
  End;
End;

procedure TFmPchInRet.RzDBButtonEdit2ButtonClick(Sender: TObject);
Var
  sProvNo,sLinkMan : String;
begin
  If FEditMode=0 Then Exit;
  If DBEdit7.Text='' Then Begin
    MessageBox(Handle,Pchar('请先指定供应厂商!'),'错误:',16);
    Exit;
  End;
  sProvNo := CdsPchInRetProvNo.Value;
  If SelectProvLinkMan(sProvNo,sLinkMan) Then
    CdsPchInRetLinkMan.Value := sLinkMan ;
end;

procedure TFmPchInRet.CdsPchInRetDtlProdDateChange(Sender: TField);
begin
  CdsPchInRetDtlValidDate.AsVariant := SvrGetUsefulLife.AppServer.GetUsefulLife(iClientID,CdsPchInRetDtlGoodsID.AsString,CdsPchInRetDtlProdDate.Value);
end;

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

procedure TFmPchInRet.ParseGoodsInfo;
var b1: Boolean;
    dPrice:Double;
    sGoodsID,sProvNo,sUnit:String;
begin
  if FEditMode=0 then Exit;
  if bBrowGoods then Exit;
  bBrowGoods := true;
  try
    b1:=SelectGoods(CdsPchInRetDtl, CdsPchInRetDtlGoodsID,CdsPchInRetDtlUnit, true, False, False);
    if not b1 then Abort;
    sGoodsID := CdsPchInRetDtlGoodsID.Value;
    sProvNo := CdsPchInRetProvNo.Value;
    sUnit := CdsPchInRetDtlUnit.Value;
    if (sGoodsID<>'') And (sUnit<>'') Then Begin
      dPrice := SvrCommon.AppServer.GetGoodsPrice(IClientID,'P',sProvNo,sGoodsID,sUnit);
      if dPrice<>0 Then
        CdsPchInRetDtlprice.Value := dPrice;
    End;
    CdsPchInRetDtlValidDate.AsVariant := SvrGetUsefulLife.AppServer.GetUsefulLife(iClientID,CdsPchInRetDtlGoodsID.AsString,CdsPchInRetDtlProdDate.Value);
  finally
    bBrowGoods := false;
  end;
end;

Initialization
  RegisterClass(TFmPchInRet);
Finalization
  RegisterClass(TFmPchInRet);
end.
12

.#pchinretfrm.pas.1.35 - 源码说明

本页面展示了「医药连锁经营管理系统源码」中的 .#pchinretfrm.pas.1.35 源码文件，采用 35 编程语言编写，共 806 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与医药连锁相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?