selsettlefrm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 752 行 · 第 1/2 页

unit SelSettleFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceBaseBillFrm, ActnList, ModuleAction, ImgList, TB2Dock,
  ExtCtrls, RzPanel, TB2Item, TB2Toolbar, DB, DBClient, MConnect, RzDBBnEd,
  ComCtrls, RzDTP, RzDBDTP, StdCtrls, Mask, RzEdit, RzDBEdit, RzLabel,
  Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzCmboBx, RzDBCmbo,IMainFrm, Menus, Buttons,
  RzButton, ckDBClient,uGlobal,DbFuncs,ShowProGress,uDataTypes, ceGlobal,
  SelectCustFrm,SelectEmpFrm,SelectDepartFrm,SelectCustLinkManFrm,
  SelectSelSendOutFrm,RzDBLbl;

type
  TFmSelSettle = class(TceBaseBillForm)
    DsSelSettleDtl: TDataSource;
    CdsSelSettleDtl: TckClientDataSet;
    DsSelSettle: TDataSource;
    CdsSelSettle: TckClientDataSet;
    RzLabel1: TRzLabel;
    RzDBEdit1: TRzDBEdit;
    RzLabel2: TRzLabel;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzLabel3: TRzLabel;
    RzLabel4: TRzLabel;
    RzLabel5: TRzLabel;
    RzLabel8: TRzLabel;
    RzLabel18: TRzLabel;
    RzDBDateTimePicker3: TRzDBDateTimePicker;
    RzLabel19: TRzLabel;
    Lab_State: TLabel;
    Comcnn: TDCOMConnection;
    Label7: TLabel;
    edProvName: TRzDBButtonEdit;
    RzDBEdit9: TRzDBEdit;
    RzDBEdit8: TRzDBEdit;
    dbgPchOrderDtl: TxDBGridEh;
    cbPayModes: TRzComboBox;
    DBEdit6: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    RzLabel15: TRzLabel;
    RzLabel21: TRzLabel;
    RzLabel13: TRzLabel;
    RzLabel14: TRzLabel;
    RzDBNumericEdit2: TRzDBEdit;
    RzDBNumericEdit3: TRzDBEdit;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    RzDBButtonEdit2: TRzDBButtonEdit;
    ActFinish: TModlAction;
    TBItem18: TTBItem;
    RzLabel17: TRzLabel;
    RzLabel20: TRzLabel;
    RzDBDateTimePicker6: TRzDBDateTimePicker;
    RzLabel23: TRzLabel;
    RzLabel24: TRzLabel;
    RzDBEdit2: TRzDBEdit;
    RzDBComboBox1: TRzDBComboBox;
    RzDBEdit11: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    RzDBEdit12: TRzDBEdit;
    RzLabel25: TRzLabel;
    RzLabel26: TRzLabel;
    RzLabel27: TRzLabel;
    RzDBEdit13: TRzDBEdit;
    RzLabel6: TRzLabel;
    RzLabel22: TRzLabel;
    RzDBEdit10: TRzDBEdit;
    edDepartName: TRzDBButtonEdit;
    CdsSelSettleBillNo: TStringField;
    CdsSelSettleFDate: TDateTimeField;
    CdsSelSettleInOutKind: TSmallintField;
    CdsSelSettleDepartID: TIntegerField;
    CdsSelSettleDepartNo: TStringField;
    CdsSelSettleDepartName: TStringField;
    CdsSelSettleLinkMan: TStringField;
    CdsSelSettleCompanyName: TStringField;
    CdsSelSettleTelephone: TStringField;
    CdsSelSettleAddress: TStringField;
    CdsSelSettleAccountBank: TStringField;
    CdsSelSettleAccountNo: TStringField;
    CdsSelSettleTaxNo: TStringField;
    CdsSelSettleOrderNo: TStringField;
    CdsSelSettleInvoiceType: TSmallintField;
    CdsSelSettleEmpNo: TStringField;
    CdsSelSettleEmpName: TStringField;
    CdsSelSettleAudit: TStringField;
    CdsSelSettleGoodsQty: TBCDField;
    CdsSelSettleGoodsSum: TBCDField;
    CdsSelSettleTaxSum: TBCDField;
    CdsSelSettleAmount: TBCDField;
    CdsSelSettlePayModeNo: TStringField;
    CdsSelSettlePayModeName: TStringField;
    CdsSelSettleTimeLimit: TIntegerField;
    CdsSelSettlePayDate: TDateTimeField;
    CdsSelSettleGatherAtOnce: TBCDField;
    CdsSelSettleTransfer: TBooleanField;
    CdsSelSettleRemark: TStringField;
    CdsSelSettleFlag: TStringField;
    CdsSelSettleCreater: TStringField;
    CdsSelSettleCreatTime: TDateTimeField;
    CdsSelSettleMender: TStringField;
    CdsSelSettleGrup: TIntegerField;
    CdsSelSettleDtlBillNo: TStringField;
    CdsSelSettleDtlItemNo: TIntegerField;
    CdsSelSettleDtlGoodsID: TStringField;
    CdsSelSettleDtlName: TStringField;
    CdsSelSettleDtlSpecs: TStringField;
    CdsSelSettleDtlUnit: TStringField;
    CdsSelSettleDtlBatchNo: TStringField;
    CdsSelSettleDtlQty: TBCDField;
    CdsSelSettleDtlPrice: TFloatField;
    CdsSelSettleDtlTaxRate: TBCDField;
    CdsSelSettleDtlUnTaxPrice: TFloatField;
    CdsSelSettleDtlGoodsSum: TBCDField;
    CdsSelSettleDtlTaxSum: TBCDField;
    CdsSelSettleDtlAmount: TBCDField;
    CdsSelSettleDtlCostPrice: TFloatField;
    CdsSelSettleDtlCostAmount: TBCDField;
    CdsSelSettleDtlPBillNo: TStringField;
    CdsSelSettleDtlPItemNo: TIntegerField;
    CdsSelSettleDtlPaidUp: TBCDField;
    CdsSelSettleDtlPayDone: TBooleanField;
    CdsSelSettleDtlPayDoneDate: TDateTimeField;
    CdsSelSettleDtlRemark: TStringField;
    cbInOutKind: TRzComboBox;
    RzDBComboBox3: TRzDBComboBox;
    RzDBEdit14: TRzDBEdit;
    RzDBEdit15: TRzDBEdit;
    CdsSelSettleInvoiceDate: TDateTimeField;
    CdsSelSettleInvoiceNo: TStringField;
    CdsSelSettleCustNo: TStringField;
    CdsSelSettleCustName: TStringField;
    CdsSelSettleAdsSelSettleDtl: TDataSetField;
    RzLabel10: TRzLabel;
    cbInvoiceType: TRzComboBox;
    RzLabel11: TRzLabel;
    RzDBEdit6: TRzDBEdit;
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsSelSettleAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsSelSettleDtlQtyChange(Sender: TField);
    procedure CdsSelSettleDtlNewRecord(DataSet: TDataSet);
    procedure CdsSelSettleDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsSelSettleDtlAfterPost(DataSet: TDataSet);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure edDepartNameButtonClick(Sender: TObject);
    procedure CdsSelSettleNewRecord(DataSet: TDataSet);
    procedure FormShow(Sender: TObject);
    procedure CdsSelSettleCustNOChange(Sender: TField);
    procedure ActSaveExecute(Sender: TObject);
    procedure CdsSelSettleReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure dbgPchOrderDtlEditButtonClick(Sender: TObject);
    procedure CdsSelSettleEmpNOChange(Sender: TField);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure ActBillTurnExecute(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure CdsSelSettleDtlTaxRateChange(Sender: TField);
    procedure CdsSelSettleDtlPriceChange(Sender: TField);
    procedure CdsSelSettleDtlUnTaxPriceChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
    procedure CdsSelSettleDtlGoodsIDChange(Sender: TField);
    procedure CdsSelSettleDtlAfterCancel(DataSet: TDataSet);
  private
    FCanInsert: boolean;    
    CdsFieldProperty :TckClientDataSet;
    iClientID :Integer;
    ItemId :Integer;
    bBrowGoods,CanAudit,CanRevert:Boolean;
    slPayModes:TStrings;
    LocSetting: PLocSetting;
    SvrPchSettle,SvrCommon:TDispatchConnection;
    BeforeEmpNo,BeforeGoodsID,FlagGoodsID,BeforeCustNo :String;
    Procedure SumCount;
    Procedure ShowPayModes;  //显示结算方式
    procedure ParseGoodsInfo;
  protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override;
  public

  end;

Const
  sPayModes='Select PayModeNo,PayModename,TimeLimit From PayModes order By PayModeNO';

  sFieldProPerty='Select * From SysFieldProperty '+
        ' Where TableName in (''SelSettle'', ''SelSettleDtl'', ''Goodses'')';

var
  FmSelSettle :TFmSelSettle;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm, ViewGoodsPriceFrm;
{$R *.dfm}

procedure TFmSelSettle.ActAddSubItemExecute(Sender: TObject);
Var sCustNo : String;
begin
  If FEditMode=0 Then Exit;
  If Not(CdsSelSettle.State In dsEditModes) Then Exit;
  FCanInsert := true;
  CdsSelSettleDtl.Append;
  sCustNo := CdsSelSettleCustNo.Value;
  SelectSelSendOut(CdsSelSettleDtl,sCustNo,True,True);
End;

procedure TFmSelSettle.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if CdsSelSettleDtl.IsEmpty then Exit;
  CdsSelSettleDtl.Delete;
  FCanInsert := false;
end;

procedure TFmSelSettle.CdsSelSettleAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=CdsSelSettlePayModeNo.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  If CdsSelSettleTransfer.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;
    ActRevert.Enabled:=False;
    Lab_State.Caption:='单据状态：未审核';
    Lab_State.Font.Color:=clHotLight;
  End;
end;

procedure TFmSelSettle.FormCreate(Sender: TObject);
begin
  inherited;
  slPayModes:=TStringList.Create;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到销售结算服务器...');
  SvrPchSettle:=iFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=LogonInfo^.ClientID;
  sBillNoList.Text := SvrPchSettle.AppServer.GetCurrMonthBills(iClientID, 'SelSettle');
  CdsSelSettle.RemoteServer:=SvrPchSettle;
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  MasterDataSet := CdsSelSettle;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsSelSettleDtl;
  BillType := 'SelSettle';
  RepDataSetNames := '销售结算;结算明细';
end;

procedure TFmSelSettle.FormShow(Sender: TObject);
Var
  sTableNames:String;
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor([dbgPchOrderDtl]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrderDtl]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelSettle.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSelSettle, 'SelSettle');
  SetFieldProperty(CdsFieldProPerty,CdsSelSettleDtl, 'SelSettleDtl,Goodses');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmSelSettle.CdsSelSettleDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchOrderDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='price')or(str='rebate') then
    CdsSelSettleDtlUnTaxPrice.AsFloat := CdsSelSettleDtlPrice.AsFloat / (1 +  self.CdsSelSettleDtlTaxRate.AsFloat/ 100);
  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsSelSettleDtlGoodsSum.AsFloat := CdsSelSettleDtlQty.AsFloat * CdsSelSettleDtlUnTaxPrice.AsFloat;
  CdsSelSettleDtlAmount.AsFloat := CdsSelSettleDtlQty.AsFloat * CdsSelSettleDtlPrice.AsFloat;
  CdsSelSettleDtlTaxSum.AsFloat := CdsSelSettleDtlAmount.AsFloat - CdsSelSettleDtlGoodsSum.AsFloat;
end;

procedure TFmSelSettle.CdsSelSettleDtlTaxRateChange(Sender: TField);
begin
  if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsSelSettleDtlUnTaxPrice.AsFloat := CdsSelSettleDtlPrice.AsFloat / ( 1 + CdsSelSettleDtlTaxRate.AsFloat / 100 );
    CdsSelSettleDtlGoodsSum.AsFloat := CdsSelSettleDtlQty.AsFloat*CdsSelSettleDtlUnTaxPrice.AsFloat;
    CdsSelSettleDtlTaxSum.AsFloat := CdsSelSettleDtlAmount.AsFloat-CdsSelSettleDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelSettle.CdsSelSettleDtlUnTaxPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsSelSettleDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsSelSettleDtlTaxRate.AsFloat / 100 );
    CdsSelSettleDtlGoodsSum.AsFloat:= CdsSelSettleDtlQty.AsFloat * CdsSelSettleDtlUnTaxPrice.AsFloat;
    CdsSelSettleDtlAmount.AsFloat := CdsSelSettleDtlQty.AsFloat*CdsSelSettleDtlPrice.AsFloat;
    CdsSelSettleDtlTaxSum.AsFloat  := CdsSelSettleDtlAmount.AsFloat - CdsSelSettleDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelSettle.CdsSelSettleDtlPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsSelSettleDtlUnTaxPrice.AsFloat := CdsSelSettleDtlPrice.AsFloat / ( 1 + CdsSelSettleDtlTaxRate.AsFloat / 100 );
    CdsSelSettleDtlGoodsSum.AsFloat := CdsSelSettleDtlQty.AsFloat*CdsSelSettleDtlUnTaxPrice.AsFloat;
    CdsSelSettleDtlAmount.AsFloat := CdsSelSettleDtlQty.AsFloat*CdsSelSettleDtlPrice.AsFloat;
    CdsSelSettleDtlTaxSum.AsFloat := CdsSelSettleDtlAmount.AsFloat-CdsSelSettleDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmSelSettle.CdsSelSettleDtlNewRecord(DataSet: TDataSet);
begin
  if not FCanInsert then Abort;
  BeforeGoodsID:='';
  CdsSelSettleDtlBillNo.Value:=CdsSelSettleBillNo.Value;
  CdsSelSettleDtlItemNo.Value := ItemId+1;
end;

procedure TFmSelSettle.CdsSelSettleDtlBeforeInsert(DataSet: TDataSet);
begin
  if not FCanInsert then Abort;
  inherited;
  ItemId := GetFieldMaxInt(CdsSelSettleDtl,'ItemNO')
end;

procedure TFmSelSettle.CdsSelSettleDtlAfterPost(DataSet: TDataSet);
var dGoodsSum,dTaxSum,dQty:Double;
		mark1: TBookmark;
begin
  BeforeGoodsID:='';
  dGoodsSum:=0;
  dTaxSum:=0;
  dQty:=0;
  FCanInsert := false;
	with CdsSelSettleDtl do begin
  	Mark1 := GetBookmark;
    DisableControls;
    try
    	First;
      while not Eof do begin
        dGoodsSum:=dGoodsSum+FieldByName('GoodsSum').AsFloat;
        dTaxSum:=dTaxSum+FieldByName('TaxSum').AsFloat;
        dQty:=dQty+FieldByName('Qty').AsFloat;
        next;
      end;
      CdsSelSettle.FieldByName('GoodsQty').AsFloat:=dQty;
      CdsSelSettle.FieldByName('GoodsSum').AsFloat:=dGoodsSum;
      CdsSelSettle.FieldByName('TaxSum').AsFloat:=dTaxSum;
      CdsSelSettle.FieldByName('Amount').AsFloat :=dGoodsSum+dTaxSum;
    finally