pchspeer.pas

群星医药系统源码

unit PchSpeer;

interface

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

type
  TFmPchSpeer = class(TceBaseBillForm)
    CdsPchSpeer: TckClientDataSet;
    DsPchSpeerDtl: TDataSource;
    DsPchSpeer: TDataSource;
    CdsPchSpeerDtl: TckClientDataSet;
    ComCnn: TDCOMConnection;
    RzLabel1: TRzLabel;
    RzDBEdit2: TRzDBEdit;
    RzLabel2: TRzLabel;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzLabel3: TRzLabel;
    RzDBDateTimePicker2: TRzDBDateTimePicker;
    RzLabel10: TRzLabel;
    RzDBEdit1: TRzDBEdit;
    RzLabel17: TRzLabel;
    Lab_State: TLabel;
    RzLabel13: TRzLabel;
    RzLabel8: TRzLabel;
    RzLabel9: TRzLabel;
    RzLabel6: TRzLabel;
    RzLabel18: TRzLabel;
    Label7: TLabel;
    edProvName: TRzDBButtonEdit;
    RzDBEdit9: TRzDBEdit;
    cbPayModes: TRzComboBox;
    RzLabel4: TRzLabel;
    DBEdit6: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    RzLabel5: TRzLabel;
    RzDBEdit8: TRzDBEdit;
    dbgPchSpeerDtl: TxDBGridEh;
    CdsPchSpeerBillNo: TStringField;
    CdsPchSpeerFDate: TDateTimeField;
    CdsPchSpeerValidDate: TDateTimeField;
    CdsPchSpeerEmpNO: TStringField;
    CdsPchSpeerName: TStringField;
    CdsPchSpeerAudit: TStringField;
    CdsPchSpeerProvNo: TStringField;
    CdsPchSpeerProvName: TStringField;
    CdsPchSpeerLinkMan: TStringField;
    CdsPchSpeerGoodsSum: TBCDField;
    CdsPchSpeerTaxSum: TBCDField;
    CdsPchSpeerAmount: TBCDField;
    CdsPchSpeerCoinKind: TStringField;
    CdsPchSpeerCoinExRate: TBCDField;
    CdsPchSpeerGoodsQty: TBCDField;
    CdsPchSpeerPayModeNO: TStringField;
    CdsPchSpeerTransfer: TBooleanField;
    CdsPchSpeerFinish: TBooleanField;
    CdsPchSpeerRemark: TStringField;
    CdsPchSpeerCreater: TStringField;
    CdsPchSpeerMender: TStringField;
    CdsPchSpeerGrup: TIntegerField;
    CdsPchSpeerAdsPchSpeerDtl: TDataSetField;
    CdsPchSpeerDtlBillNo: TStringField;
    CdsPchSpeerDtlItemNo: TIntegerField;
    CdsPchSpeerDtlGoodsID: TStringField;
    CdsPchSpeerDtlName: TStringField;
    CdsPchSpeerDtlSpecs: TStringField;
    CdsPchSpeerDtlUnit: TStringField;
    CdsPchSpeerDtlQty: TBCDField;
    CdsPchSpeerDtlOprice: TFloatField;
    CdsPchSpeerDtlRebate: TBCDField;
    CdsPchSpeerDtlprice: TFloatField;
    CdsPchSpeerDtlTaxRate: TBCDField;
    CdsPchSpeerDtlUnTaxprice: TFloatField;
    CdsPchSpeerDtlGoodsSum: TBCDField;
    CdsPchSpeerDtlTaxSum: TBCDField;
    CdsPchSpeerDtlAmount: TBCDField;
    CdsPchSpeerDtlProvGoodsID: TStringField;
    CdsPchSpeerDtlReMark: TStringField;
    RzDBNumericEdit3: TRzDBEdit;
    RzDBNumericEdit5: TRzDBEdit;
    RzDBNumericEdit1: TRzDBEdit;
    RzDBNumericEdit2: TRzDBEdit;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsPchSpeerCreatTime: TDateTimeField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    ADOTable1: TADOTable;
    ADOTable1eew: TIntegerField;
    procedure FormCreate(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure ActRefershExecute(Sender: TObject);
    procedure CdsPchSpeerAfterScroll(DataSet: TDataSet);
    procedure CdsPchSpeerNewRecord(DataSet: TDataSet);
    procedure CdsPchSpeerDtlNewRecord(DataSet: TDataSet);
    procedure CdsPchSpeerDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsPchSpeerDtlAfterPost(DataSet: TDataSet);
    procedure CdsPchSpeerDtlQtyChange(Sender: TField);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure CdsPchSpeerDtlGoodsIDChange(Sender: TField);
    procedure FormShow(Sender: TObject);
    procedure CdsPchSpeerProvNoChange(Sender: TField);
    procedure CdsPchSpeerReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsPchSpeerEmpNOChange(Sender: TField);
    procedure dbgPchSpeerDtlEditButtonClick(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActBillTurnExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure CdsPchSpeerDtlpriceChange(Sender: TField);
    procedure CdsPchSpeerDtlTaxRateChange(Sender: TField);
    procedure CdsPchSpeerDtlUnTaxpriceChange(Sender: TField);
    procedure ActQueryExecute(Sender: TObject);
  private
    bBrowGoods,CanAudit, CanRevert:Boolean;
    slPayModes:TStrings;
    SvrCommon,SvrPchSpeer :TDisPatchConnection;
    CdsFieldProperty :TckClientDataSet;
    LastItemNo,iClientID: Integer;
    LocSetting: PLocSetting;
    BeforeGoodsID,BeforeEmpNo,FlagGoodsID,BeforeProvNo :String;
    Procedure ShowPayModes;  //显示结算方式
    Procedure SumCount;
    procedure ParseGoodsInfo;
  public
  Protected
    Function DoSome(cType: PChar; Values: Variant): Variant; override; 
  end;

Const
  sPayModes='Select PayModeNo,PayModename,TimeLimit From PayModes order By PayModeNO';
  sFieldProPerty='Select * From SysFieldProperty '+
        ' Where TableName in (''PchSpeer'', ''PchSpeerDtl'', ''Goodses'')';

var FmPchSpeer :TFmPchSpeer;

implementation

uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;

{$R *.dfm}

procedure TFmPchSpeer.FormCreate(Sender: TObject);
begin
  inherited;
  slPayModes:=TStringList.Create;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到采购询价服务器...');
  SvrPchSpeer := iFmMain.GetConnection(Handle,'','ckPurchBase.coPurchBase');
  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 := SvrPchSpeer.AppServer.GetCurrMonthBills(iClientID, 'PchSpeer');

  CdsPchSpeer.RemoteServer:=SvrPchSpeer;
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  MasterDataSet := CdsPchSpeer;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsPchSpeerDtl;
  BillType := 'PchSpeer';  
  RepDataSetNames := '询价单;询价明细';
  dbgPchSpeerDtl.SetAutoSort('');
end;

procedure TFmPchSpeer.FormShow(Sender: TObject);
Var
  sTableNames:String;
Begin
  SetGressHint('初始化本地环境...');
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchSpeerDtl]);
  SetGridEhColor([dbgPchSpeerDtl]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'FmPchSpeer.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsPchSpeer, 'PchSpeer');
  SetFieldProperty(CdsFieldProPerty,CdsPchSpeerDtl, 'PchSpeerDtl,Goodses');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  inherited;
  FreeGressForm;
end;

procedure TFmPchSpeer.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsPchSpeer.State In dsEditModes) Then Exit;
  CdsPchSpeerDtl.Append;
End;

procedure TFmPchSpeer.ActDelSubItemExecute(Sender: TObject);
begin
  if FEditMode=0 then Exit;
  if CdsPchSpeerDtl.IsEmpty then Exit;
  CdsPchSpeerDtl.Delete;
end;

procedure TFmPchSpeer.ActRefershExecute(Sender: TObject);
begin
  inherited;
  CdsPchSpeer.Active:=False;
  CdsPchSpeer.Active:=True;
end;

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

procedure TFmPchSpeer.CdsPchSpeerNewRecord(DataSet: TDataSet);
begin
  LastItemNo := 0;
  edProvName.Button.Click;
  CdsPchSpeerBillNo.Value := BuildBillNo('PchSpeer');
  CdsPchSpeerCreater.Value := LogonInfo^.UserID;
  CdsPchSpeerGrup.Value := LogonInfo^.UserGrupID;
  CdsPchSpeerFDate.Value:=Date;
  CdsPchSpeerValidDate.Value:=Date;
  CdsPchSpeerAmount.Value := 0;
  CdsPchSpeerTaxSum.Value := 0;
  CdsPchSpeerGoodsSum.Value := 0;
  CdsPchSpeerGoodsQty.Value := 0;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlNewRecord(DataSet: TDataSet);
begin
  BeforeGoodsID:='';
  CdsPchSpeerDtlBillNo.Value := CdsPchSpeerBillNo.Value;
  CdsPchSpeerDtlItemNo.Value := LastItemNo+1;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlBeforeInsert(DataSet: TDataSet);
begin
  LastItemNo := GetFieldMaxInt(CdsPchSpeerDtl,'ItemNo')
end;

procedure TFmPchSpeer.CdsPchSpeerDtlAfterPost(DataSet: TDataSet);
var
  mark:TBookMark;
  GoodsQtyTotal,GoodsMeyTotal,GoodsTaxTotal:Double;
begin
  BeforeGoodsID:='';
  mark := CdsPchSpeerDtl.GetBookmark;
  CdsPchSpeerDtl.DisableControls;
  GoodsQtyTotal := 0;
  GoodsMeyTotal := 0;
  GoodsTaxTotal := 0;
  With CdsPchSpeerDtl Do Begin
    First;
    Try
      While Not(Eof) do
      begin
        GoodsQtyTotal := GoodsQtyTotal+CdsPchSpeerDtlQty.AsFloat;
        GoodsMeyTotal := GoodsMeyTotal+CdsPchSpeerDtlGoodsSum.AsFloat;
        GoodsTaxTotal :=GoodsTaxTotal+CdsPchSpeerDtlTaxSum.AsFloat;
        Next;
      end;
    Finally
      CdsPchSpeerAmount.AsFloat := GoodsMeyTotal+GoodsTaxTotal;
      CdsPchSpeerGoodsSum.AsFloat := GoodsMeyTotal;
      CdsPchSpeerTaxSum.AsFloat := GoodsTaxTotal;
      CdsPchSpeerGoodsQty.AsFloat := GoodsQtyTotal;
      EnableControls;
      GotoBookmark(mark);
      FreeBookmark(Mark);
    End;
  End;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlQtyChange(Sender: TField);
var dRebate: Double;
    str: String;
begin
  //实际单价 = 单价 * 折扣
  str := LowerCase(dbgPchSpeerDtl.SelectedField.FieldName);
  if (str='goodsid')or(str='oprice')or(str='rebate') then
  begin
    dRebate := CdsPchSpeerDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchSpeerDtlPrice.AsFloat := CdsPchSpeerDtlOPrice.AsFloat * (dRebate/100);
    CdsPchSpeerDtlUnTaxPrice.AsFloat := CdsPchSpeerDtlPrice.AsFloat / (1 +  self.cdsPchSpeerDtlTaxRate.AsFloat/ 100);
  end;
  //货款 = 数量 * 未税单价    合计 = 数量 * 单价    税款 = 合计 - 货款
  CdsPchSpeerDtlGoodsSum.AsFloat := CdsPchSpeerDtlQty.AsFloat * CdsPchSpeerDtlUnTaxPrice.AsFloat;
  CdsPchSpeerDtlAmount.AsFloat := CdsPchSpeerDtlQty.AsFloat * CdsPchSpeerDtlPrice.AsFloat;
  CdsPchSpeerDtlTaxSum.AsFloat := CdsPchSpeerDtlAmount.AsFloat - CdsPchSpeerDtlGoodsSum.AsFloat;
  //SumCount;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlpriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchSpeerDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchSpeerDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchSpeerDtlOPrice.AsFloat := CdsPchSpeerDtlPrice.AsFloat / (dRebate/100);
    CdsPchSpeerDtlUnTaxPrice.AsFloat := CdsPchSpeerDtlPrice.AsFloat / ( 1 + CdsPchSpeerDtlTaxRate.AsFloat / 100 );
    CdsPchSpeerDtlGoodsSum.AsFloat := cdsPchSpeerDtlQty.AsFloat*CdsPchSpeerDtlUnTaxPrice.AsFloat;
    CdsPchSpeerDtlAmount.AsFloat := cdsPchSpeerDtlQty.AsFloat*cdsPchSpeerDtlPrice.AsFloat;
    CdsPchSpeerDtlTaxSum.AsFloat := CdsPchSpeerDtlAmount.AsFloat-CdsPchSpeerDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlTaxRateChange(Sender: TField);
begin
  if dbgPchSpeerDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    CdsPchSpeerDtlUnTaxPrice.AsFloat := CdsPchSpeerDtlPrice.AsFloat / ( 1 + CdsPchSpeerDtlTaxRate.AsFloat / 100 );
    CdsPchSpeerDtlGoodsSum.AsFloat := cdsPchSpeerDtlQty.AsFloat*CdsPchSpeerDtlUnTaxPrice.AsFloat;
    CdsPchSpeerDtlTaxSum.AsFloat := CdsPchSpeerDtlAmount.AsFloat-CdsPchSpeerDtlGoodsSum.AsFloat;
  end;
end;

procedure TFmPchSpeer.CdsPchSpeerDtlUnTaxpriceChange(Sender: TField);
var dRebate: Double;
begin
  if dbgPchSpeerDtl.SelectedField.FieldName = Sender.FieldName then
  begin
    dRebate := CdsPchSpeerDtlRebate.AsFloat;
    if dRebate=0 then dRebate:=100;
    CdsPchSpeerDtlPrice.AsFloat   := Sender.AsFloat * ( 1 + CdsPchSpeerDtlTaxRate.AsFloat / 100 );
    cdsPchSpeerDtlOprice.AsFloat  := CdsPchSpeerDtlPrice.AsFloat / (dRebate/100);
    CdsPchSpeerDtlGoodsSum.AsFloat:= cdsPchSpeerDtlQty.AsFloat * CdsPchSpeerDtlUnTaxPrice.AsFloat;
    CdsPchSpeerDtlAmount.AsFloat := cdsPchSpeerDtlQty.AsFloat*cdsPchSpeerDtlPrice.AsFloat;
    CdsPchSpeerDtlTaxSum.AsFloat  := CdsPchSpeerDtlAmount.AsFloat - CdsPchSpeerDtlGoodsSum.AsFloat;
  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;