pchorder.~pas

群星医药系统源码

unit PchOrder;

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,
  SelectProvFrm,SelectEmpFrm,SelectProvLinkManFrm,RzDBLbl;

type
  TFmPchOrder = class(TceBaseBillForm)
    DsPchOrderDtl: TDataSource;
    CdsPchOrderDtl: TckClientDataSet;
    DsPchOrder: TDataSource;
    CdsPchOrder: TckClientDataSet;
    RzLabel1: TRzLabel;
    RzDBEdit1: TRzDBEdit;
    RzLabel2: TRzLabel;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzLabel3: TRzLabel;
    RzDBDateTimePicker2: TRzDBDateTimePicker;
    RzLabel4: TRzLabel;
    RzLabel5: TRzLabel;
    RzLabel8: TRzLabel;
    RzLabel18: TRzLabel;
    RzDBDateTimePicker3: TRzDBDateTimePicker;
    RzLabel19: TRzLabel;
    Lab_State: TLabel;
    CdsPchOrderDtlBillNo: TStringField;
    CdsPchOrderDtlItemNo: TIntegerField;
    CdsPchOrderDtlGoodsID: TStringField;
    CdsPchOrderDtlUnit: TStringField;
    CdsPchOrderDtlQty: TBCDField;
    CdsPchOrderDtlOPrice: TFloatField;
    CdsPchOrderDtlRebate: TBCDField;
    CdsPchOrderDtlPrice: TFloatField;
    CdsPchOrderDtlTaxRate: TBCDField;
    CdsPchOrderDtlUnTaxprice: TFloatField;
    CdsPchOrderDtlGoodsSum: TBCDField;
    CdsPchOrderDtlTaxSum: TBCDField;
    CdsPchOrderDtlAmount: TBCDField;
    CdsPchOrderDtlPaidUp: TBCDField;
    CdsPchOrderDtlProvGoodsID: TStringField;
    CdsPchOrderDtlname: TStringField;
    CdsPchOrderDtlSpecs: TStringField;
    Comcnn: TDCOMConnection;
    Label7: TLabel;
    edProvName: TRzDBButtonEdit;
    RzDBEdit9: TRzDBEdit;
    RzDBEdit8: TRzDBEdit;
    dbgPchOrderDtl: TxDBGridEh;
    cbPayModes: TRzComboBox;
    DBEdit6: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    CdsPchOrderBillNo: TStringField;
    CdsPchOrderFDate: TDateTimeField;
    CdsPchOrderDealDate: TDateTimeField;
    CdsPchOrderEmpNO: TStringField;
    CdsPchOrderName: TStringField;
    CdsPchOrderAudit: TStringField;
    CdsPchOrderContractNO: TStringField;
    CdsPchOrderProvNO: TStringField;
    CdsPchOrderProvName: TStringField;
    CdsPchOrderLinkMan: TStringField;
    CdsPchOrderDealMode: TStringField;
    CdsPchOrderCarrKind: TStringField;
    CdsPchOrderCarrAddr: TStringField;
    CdsPchOrderGoodsQty: TBCDField;
    CdsPchOrderGoodsSum: TBCDField;
    CdsPchOrderTaxSum: TBCDField;
    CdsPchOrderAmount: TBCDField;
    CdsPchOrderPayMentMode: TStringField;
    CdsPchOrderPayDate: TDateTimeField;
    CdsPchOrderReMark: TStringField;
    CdsPchOrderTransfer: TBooleanField;
    CdsPchOrderFinish: TBooleanField;
    CdsPchOrderadsPchOrderDtl: TDataSetField;
    RzLabel15: TRzLabel;
    RzLabel21: TRzLabel;
    RzLabel12: TRzLabel;
    RzLabel13: TRzLabel;
    RzLabel14: TRzLabel;
    RzLabel10: TRzLabel;
    RzLabel11: TRzLabel;
    RzLabel9: TRzLabel;
    RzDBEdit4: TRzDBEdit;
    RzDBEdit3: TRzDBEdit;
    RzDBNumericEdit2: TRzDBEdit;
    RzDBNumericEdit3: TRzDBEdit;
    RzDBEdit7: TRzDBEdit;
    CdsPchOrderPayModeName: TStringField;
    CdsPchOrderTimeLimit: TIntegerField;
    CdsPchOrderCreater: TStringField;
    CdsPchOrderGrup: TIntegerField;
    CdsPchOrderDtlBatchNo: TStringField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsPchOrderMender: TStringField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    ActFinish: TModlAction;
    TBItem18: TTBItem;
    RzLabel17: TRzLabel;
    RzLabel20: TRzLabel;
    RzDBDateTimePicker5: TRzDBDateTimePicker;
    RzLabel22: TRzLabel;
    RzDBDateTimePicker6: TRzDBDateTimePicker;
    RzLabel23: TRzLabel;
    RzLabel24: TRzLabel;
    RzLabel6: TRzLabel;
    RzDBEdit2: TRzDBEdit;
    RzDBEdit10: TRzDBEdit;
    RzDBComboBox1: TRzDBComboBox;
    RzDBEdit11: TRzDBEdit;
    CdsPchOrderSignAddr: TStringField;
    CdsPchOrderBeginDate: TDateTimeField;
    CdsPchOrderEndDate: TDateTimeField;
    CdsPchOrderContractType: TStringField;
    CdsPchOrderPickAddr: TStringField;
    CdsPchOrderCreatTime: TDateTimeField;
    RzDBEdit5: TRzDBEdit;
    RzDBEdit6: TRzDBEdit;
    RzDBEdit12: TRzDBEdit;
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure CdsPchOrderAfterScroll(DataSet: TDataSet);
    procedure FormCreate(Sender: TObject);
    procedure CdsPchOrderDtlQtyChange(Sender: TField);
    procedure CdsPchOrderDtlNewRecord(DataSet: TDataSet);
    procedure CdsPchOrderDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPchOrderDtlAfterPost(DataSet: TDataSet);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure RzDBButtonEdit3ButtonClick(Sender: TObject);
    procedure RzDBButtonEdit5ButtonClick(Sender: TObject);
    procedure CdsPchOrderNewRecord(DataSet: TDataSet);
    procedure FormShow(Sender: TObject);
    procedure CdsPchOrderDtlGoodsIDChange(Sender: TField);
    procedure CdsPchOrderProvNoChange(Sender: TField);
    procedure ActSaveExecute(Sender: TObject);
    procedure CdsPchOrderReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure dbgPchOrderDtlEditButtonClick(Sender: TObject);
    procedure CdsPchOrderEmpNoChange(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 CdsPchOrderDtlTaxRateChange(Sender: TField);
    procedure CdsPchOrderDtlPriceChange(Sender: TField);
    procedure CdsPchOrderDtlUnTaxpriceChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActFinishExecute(Sender: TObject);
  private
    CdsFieldProperty :TckClientDataSet;
    iClientID :Integer;
    ItemId :Integer;
    bBrowGoods,CanAudit,CanRevert:Boolean;
    slPayModes:TStrings;
    LocSetting: PLocSetting;
    SvrPchOrder,SvrCommon:TDispatchConnection;
    BeforeEmpNo,BeforeGoodsID,BeforeProvNo :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 (''PchOrder'', ''PchOrderDtl'', ''Goodses'', ''Goodses'')';

var
  FmPchOrder :TFmPchOrder;

implementation

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

procedure TFmPchOrder.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsPchOrder.State In dsEditModes) Then Exit;
  CdsPchOrderDtl.Append;
End;

procedure TFmPchOrder.ActDelSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  if CdsPchOrderDtl.IsEmpty then Exit;
  CdsPchOrderDtl.Delete;
end;

procedure TFmPchOrder.CdsPchOrderAfterScroll(DataSet: TDataSet);
Var sModeNo:String;
    iIndex:Integer;
begin
  sModeNo:=CdsPchOrderPaymentMode.Value;
  iIndex:=slPayModes.IndexOf(sModeNO);
  cbPayModes.ItemIndex:=iIndex;
  ActFinish.Enabled := ActRevert.Enabled and not cdsPchOrderFinish.Value;
  If CdsPchOrderTransfer.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 TFmPchOrder.FormCreate(Sender: TObject);
begin
  inherited;
  slPayModes:=TStringList.Create;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到采购合同服务器...');
  SvrPchOrder:=iFmMain.GetConnection(Handle,'','ckPurchBase.coPurchBase');
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  SetGressHint('读取用户操作权限...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  iClientID:=LogonInfo^.ClientID;
  sBillNoList.Text := SvrPchOrder.AppServer.GetCurrMonthBills(iClientID, 'PchOrder');
  CdsPchOrder.RemoteServer:=SvrPchOrder;
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  MasterDataSet := CdsPchOrder;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsPchOrderDtl;
  BillType := 'PchOrder';
  RepDataSetNames := '采购合同;订购明细';
end;

procedure TFmPchOrder.FormShow(Sender: TObject);
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor([dbgPchOrderDtl]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrderDtl]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchOrder.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsPchOrder, 'PchOrder');
  SetFieldProperty(CdsFieldProPerty,CdsPchOrderDtl, 'PchOrderDtl,Goodses');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmPchOrder.CdsPchOrderDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchOrderDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='oprice')or(str='rebate') then
  begin
    dRebate := CdsPchOrderDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchOrderDtlPrice.AsFloat := CdsPchOrderDtlOPrice.AsFloat * (dRebate/100);
    CdsPchOrderDtlUnTaxPrice.AsFloat := CdsPchOrderDtlPrice.AsFloat / (1 +  self.cdsPchOrderDtlTaxRate.AsFloat/ 100);
  end;

  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsPchOrderDtlGoodsSum.AsFloat := CdsPchOrderDtlQty.AsFloat * CdsPchOrderDtlUnTaxPrice.AsFloat;
  CdsPchOrderDtlAmount.AsFloat := CdsPchOrderDtlQty.AsFloat * CdsPchOrderDtlPrice.AsFloat;
  CdsPchOrderDtlTaxSum.AsFloat := CdsPchOrderDtlAmount.AsFloat - CdsPchOrderDtlGoodsSum.AsFloat;
end;

procedure TFmPchOrder.CdsPchOrderDtlTaxRateChange(Sender: TField);
begin
 if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchOrderDtlUnTaxPrice.AsFloat := CdsPchOrderDtlPrice.AsFloat / ( 1 + CdsPchOrderDtlTaxRate.AsFloat / 100 );
    CdsPchOrderDtlGoodsSum.AsFloat := cdsPchOrderDtlQty.AsFloat*CdsPchOrderDtlUnTaxPrice.AsFloat;
    CdsPchOrderDtlTaxSum.AsFloat := CdsPchOrderDtlAmount.AsFloat-CdsPchOrderDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchOrder.CdsPchOrderDtlUnTaxpriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchOrderDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchOrderDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsPchOrderDtlTaxRate.AsFloat / 100 );
    cdsPchOrderDtlOprice.AsFloat  := CdsPchOrderDtlPrice.AsFloat / (dRebate/100);
    CdsPchOrderDtlGoodsSum.AsFloat:= cdsPchOrderDtlQty.AsFloat * CdsPchOrderDtlUnTaxPrice.AsFloat;
    CdsPchOrderDtlAmount.AsFloat := cdsPchOrderDtlQty.AsFloat*cdsPchOrderDtlPrice.AsFloat;
    CdsPchOrderDtlTaxSum.AsFloat  := CdsPchOrderDtlAmount.AsFloat - CdsPchOrderDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchOrder.CdsPchOrderDtlPriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchOrderDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchOrderDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchOrderDtlOPrice.AsFloat := CdsPchOrderDtlPrice.AsFloat / (dRebate/100);
    CdsPchOrderDtlUnTaxPrice.AsFloat := CdsPchOrderDtlPrice.AsFloat / ( 1 + CdsPchOrderDtlTaxRate.AsFloat / 100 );
    CdsPchOrderDtlGoodsSum.AsFloat := cdsPchOrderDtlQty.AsFloat*CdsPchOrderDtlUnTaxPrice.AsFloat;
    CdsPchOrderDtlAmount.AsFloat := cdsPchOrderDtlQty.AsFloat*cdsPchOrderDtlPrice.AsFloat;
    CdsPchOrderDtlTaxSum.AsFloat := CdsPchOrderDtlAmount.AsFloat-CdsPchOrderDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchOrder.CdsPchOrderDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  cdsPchOrderDtlBillNo.Value := cdsPchOrderBillNo.Value;
  cdsPchOrderDtlItemNo.Value := ItemId+1;
end;

procedure TFmPchOrder.CdsPchOrderDtlBeforeInsert(DataSet: TDataSet);
begin
  inherited;
  ItemId := GetFieldMaxInt(CdsPchOrderDtl,'ItemNO')
end;

procedure TFmPchOrder.CdsPchOrderDtlAfterPost(DataSet: TDataSet);
var dGoodsSum,dTaxSum,dQty:Double;
		mark1: TBookmark;
begin
  BeforeGoodsID:='';
  dGoodsSum:=0;
  dTaxSum:=0;
  dQty:=0;
	with CdsPchOrderDtl 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;
      CdsPchOrder.FieldByName('GoodsQty').AsFloat:=dQty;
      CdsPchOrder.FieldByName('GoodsSum').AsFloat:=dGoodsSum;
      CdsPchOrder.FieldByName('TaxSum').AsFloat:=dTaxSum;
      CdsPchOrder.FieldByName('Amount').AsFloat :=dGoodsSum+dTaxSum;
    finally
    	GotoBookmark(Mark1);
      FreeBookmark(Mark1);
    	EnableControls;
    end;
  end;
end;

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

procedure TFmPchOrder.RzDBButtonEdit3ButtonClick(Sender: TObject);
var Value: Variant;
begin
  inherited;
  if FEditMode=0 then Exit;
  Value := VarArrayCreate([0,2], VarOleStr);
  Value[0] := '选择厂商';