selspeer.~pas

医药连锁经营管理系统源码

unit SelSpeer;

interface

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

type
  TFmSelSpeer = class(TceBaseBillForm)
    CdsSelSpeer: TckClientDataSet;
    CdsSelSpeerDtl: TckClientDataSet;
    DsSelSpeer: TDataSource;
    DsSelSpeerDtl: TDataSource;
    DcomCnn: TDCOMConnection;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    RzLabel3: TRzLabel;
    Lab_State: TLabel;
    RzLabel6: TRzLabel;
    RzLabel18: TRzLabel;
    Label7: TLabel;
    RzLabel4: TRzLabel;
    RzLabel5: TRzLabel;
    RzDBEdit1: TRzDBEdit;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzDBDateTimePicker2: TRzDBDateTimePicker;
    edProvName: TRzDBButtonEdit;
    RzDBEdit9: TRzDBEdit;
    cbPayModes: TRzComboBox;
    DBEdit6: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    RzDBEdit8: TRzDBEdit;
    RzLabel10: TRzLabel;
    RzLabel17: TRzLabel;
    RzLabel13: TRzLabel;
    RzLabel8: TRzLabel;
    RzLabel9: TRzLabel;
    RzDBEdit2: TRzDBEdit;
    RzDBNumericEdit3: TRzDBEdit;
    RzDBNumericEdit5: TRzDBEdit;
    RzDBNumericEdit1: TRzDBEdit;
    RzDBNumericEdit2: TRzDBEdit;
    dbgSelSpeerDtl: TxDBGridEh;
    CdsSelSpeerBillNO: TStringField;
    CdsSelSpeerFDate: TDateTimeField;
    CdsSelSpeerValidDate: TDateTimeField;
    CdsSelSpeerEmpNo: TStringField;
    CdsSelSpeerName: TStringField;
    CdsSelSpeerAudit: TStringField;
    CdsSelSpeerCustNo: TStringField;
    CdsSelSpeerCustName: TStringField;
    CdsSelSpeerLinkMan: TStringField;
    CdsSelSpeerGoodsSum: TBCDField;
    CdsSelSpeerTaxSum: TBCDField;
    CdsSelSpeerAmount: TBCDField;
    CdsSelSpeerGoodsQty: TBCDField;
    CdsSelSpeerPayModeNo: TStringField;
    CdsSelSpeerTransFer: TBooleanField;
    CdsSelSpeerFinish: TBooleanField;
    CdsSelSpeerReMark: TStringField;
    CdsSelSpeerCreater: TStringField;
    CdsSelSpeerMender: TStringField;
    CdsSelSpeerGrup: TIntegerField;
    CdsSelSpeerAdsSelSpeerDtl: TDataSetField;
    CdsSelSpeerDtlBillNo: TStringField;
    CdsSelSpeerDtlItemNo: TIntegerField;
    CdsSelSpeerDtlGoodsID: TStringField;
    CdsSelSpeerDtlName: TStringField;
    CdsSelSpeerDtlSpecs: TStringField;
    CdsSelSpeerDtlUnit: TStringField;
    CdsSelSpeerDtlQty: TBCDField;
    CdsSelSpeerDtlOprice: TFloatField;
    CdsSelSpeerDtlRebate: TBCDField;
    CdsSelSpeerDtlprice: TFloatField;
    CdsSelSpeerDtlTaxRate: TBCDField;
    CdsSelSpeerDtlUnTaxprice: TFloatField;
    CdsSelSpeerDtlGoodsSum: TBCDField;
    CdsSelSpeerDtlTaxSum: TBCDField;
    CdsSelSpeerDtlAmount: TBCDField;
    CdsSelSpeerDtlCustGoodsID: TStringField;
    CdsSelSpeerDtlRemark: TStringField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    CdsSelSpeerCreatTime: TDateTimeField;
    RzDBButtonEdit2: TRzDBButtonEdit;
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure ActRefershExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure CdsSelSpeerDtlBeforeInsert(DataSet: TDataSet);
    procedure CdsSelSpeerDtlNewRecord(DataSet: TDataSet);
    procedure CdsSelSpeerDtlAfterPost(DataSet: TDataSet);
    procedure CdsSelSpeerDtlOPriceChange(Sender: TField);
    procedure CdsSelSpeerDtlQtyChange(Sender: TField);
    procedure CdsSelSpeerDtlTaxRateChange(Sender: TField);
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsSelSpeerNewRecord(DataSet: TDataSet);
    procedure CdsSelSpeerEmpNoChange(Sender: TField);
    procedure CdsSelSpeerCustNoChange(Sender: TField);
    procedure CdsSelSpeerDtlGoodsIDChange(Sender: TField);
    procedure dbgSelSpeerDtlEditButtonClick(Sender: TObject);
    procedure CdsSelSpeerDtlRebateChange(Sender: TField);
    procedure CdsSelSpeerAfterScroll(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActBillTurnExecute(Sender: TObject);
    procedure edProvNameButtonClick(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure RzDBButtonEdit2ButtonClick(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
  private
    { Private declarations }
    bBrowGoods, CanAudit, CanRevert:Boolean;
    slPayModes:TStrings;
    FlagGoodsID,BeforeGoodsID,BeforeEmpNo,BeforeCustNo:String;
    CdsFieldProperty :TckClientDataSet;
    LocSetting: PLocSetting;       
    SvrCommon,SvrSelSpeer :TDisPatchConnection;
    iClientID :Integer;
    Procedure SumCount;    
    Procedure ShowPayModes;  //显示结算方式
    procedure ParseGoodsInfo;
  public
    { Public declarations }
  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(''SelSpeer'',''SelSpeerDtl'', ''Goodses'')';

var
  FmSelSpeer: TFmSelSpeer;
  ItemId: Integer=0;
implementation
Uses SelectGoodsFrm,FieldsLayoutFrm,DataExportFrm,ViewGoodsPriceFrm;
{$R *.dfm}

procedure TFmSelSpeer.ActAddSubItemExecute(Sender: TObject);
begin
  If FEditMode=0 Then Exit;
  If Not(CdsSelSpeer.State In dsEditModes) Then Exit;
  CdsSelSpeerDtl.Append;
end;

procedure TFmSelSpeer.ActDelSubItemExecute(Sender: TObject);
begin
  if FEditMode=0 then Exit;
  if CdsSelSpeerDtl.IsEmpty then Exit;
  CdsSelSpeerDtl.Delete;
End;

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

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

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

procedure TFmSelSpeer.ActSaveExecute(Sender: TObject);
Var iIndex:Integer;
begin
  If FEditMode=0 Then Exit;
  iIndex:=cbPayModes.ItemIndex;
  if iIndex<>-1 Then
    CdsSelSpeerPayModeNo.Value:=slPayModes[iIndex];
  If (CdsSelSpeerDtl.State In dsEditModes) Then
    CdsSelSpeerDtl.Post;
  Inherited;
End;

procedure TFmSelSpeer.CdsSelSpeerDtlBeforeInsert(DataSet: TDataSet);
begin
  inherited;
  ItemId :=GetFieldMaxInt(CdsSelSpeerDtl,'ItemNO')
end;

procedure TFmSelSpeer.CdsSelSpeerDtlNewRecord(DataSet: TDataSet);
begin
  inherited;
  BeforeGoodsID:='';
  CdsSelSpeerDtlItemNo.Value := ItemId+1;
  CdsSelSpeerDtlBillNo.Value:=CdsSelSpeerBillNo.value;
end;

procedure TFmSelSpeer.CdsSelSpeerDtlAfterPost(DataSet: TDataSet);
var
  mark:TBookMark;
  GoodsQtyTotal,GoodsMeyTotal,GoodsTaxTotal:Double;
begin
  BeforeGoodsID:='';
  mark := CdsSelSpeerDtl.GetBookmark;
  CdsSelSpeerDtl.DisableControls;
  GoodsQtyTotal := 0;
  GoodsMeyTotal := 0;
  GoodsTaxTotal := 0;
  With CdsSelSpeerDtl do
    begin
      First;
      Try
      While Not(Eof) do
        begin
          GoodsQtyTotal := GoodsQtyTotal+CdsSelSpeerDtlQty.AsFloat;
          GoodsMeyTotal := GoodsMeyTotal+CdsSelSpeerDtlGoodsSum.AsFloat;
          GoodsTaxTotal :=GoodsTaxTotal+CdsSelSpeerDtlTaxSum.AsFloat;
          Next;
        end;
      Finally
        CdsSelSpeerDtl.EnableControls;
        CdsSelSpeerDtl.GotoBookmark(mark);
      End;
    end;
  CdsSelSpeerAmount.AsFloat := GoodsMeyTotal+GoodsTaxTotal;
  CdsSelSpeerGoodsSum.AsFloat := GoodsMeyTotal;
  CdsSelSpeerTaxSum.AsFloat := GoodsTaxTotal;
  CdsSelSpeerGoodsQty.AsFloat := GoodsQtyTotal;
end;

procedure TFmSelSpeer.CdsSelSpeerDtlOPriceChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelSpeer.CdsSelSpeerDtlQtyChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelSpeer.CdsSelSpeerDtlTaxRateChange(Sender: TField);
begin
  SumCount;
end;

procedure TFmSelSpeer.FormCreate(Sender: TObject);
begin
  inherited;
  slPayModes:=TStringList.Create;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  iClientID:=LogonInfo^.ClientID;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在登录到客户询价服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  SvrSelSpeer:=iFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');

  sBillNoList.Text := SvrSelSpeer.AppServer.GetCurrMonthBills(iClientID, 'SelSpeer');
  CdsSelSpeer.RemoteServer:=SvrSelSpeer;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  BillType := 'SelSpeer';
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActRevert.Enabled;
  MasterDataSet := CdsSelSpeer;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := CdsSelSpeerDtl;
  RepDataSetNames := '客户询价;客户询价明细';
  sRepSection := '客户询价';
  dbgSelSpeerDtl.SetAutoSort('');
end;

procedure TFmSelSpeer.FormShow(Sender: TObject);
Begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgSelSpeerDtl]); 
  SetGressHint('初始化本地环境...');
  SetGridEhColor(dbgSelSpeerDtl);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelSpeer.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSelSpeer, 'SelSpeer');
  SetFieldProperty(CdsFieldProPerty,CdsSelSpeerDtl, 'SelSpeerDtl,Goodses');
  SetGressHint('读取历史单据...');
  ShowPayModes;
  SetCurrBillIdx(0);
  FreeGressForm;
  inherited;  
end;

procedure TFmSelSpeer.ShowPayModes;
Var
  A:Variant;
  iClientID, I, k:Integer;
begin
  Try
    iClientID := IFmMain.IFmMainEx.ClientID;
    A:=SvrSelSpeer.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 TFmSelSpeer.CdsSelSpeerNewRecord(DataSet: TDataSet);
begin