⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 selectselsendoutfrm.pas

📁 群星医药系统源码
💻 PAS
字号:
unit SelectSelSendOutFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, RzButton, DBCtrls, RzDBNav, RzPanel,
  StdCtrls, Mask, RzEdit, ExtCtrls, RzSplit, ImgList, DB, DBClient,
  ckDBClient, MConnect,IMainFrm, ComCtrls, RzDTP, RzRadChk,uDataTypes,
  RzTabs,DBGrids, DbFuncs,ShowProgress,FieldsLayoutFrm;

type
  TFrmSelectSelSendOut = class(TForm)
    DComm: TDCOMConnection;
    CdsSelectSelSendOut: TckClientDataSet;
    DsSelectSelSendOut: TDataSource;
    ImageList1: TImageList;
    DsSelectSelSendOutDtl: TDataSource;
    CdsSelectSelSendOutDtl: TckClientDataSet;
    RzPageControl1: TRzPageControl;
    TabSheet1: TRzTabSheet;
    TabSheet2: TRzTabSheet;
    dbgArrearage: TxDBGridEh;
    dbgArrearageDtl: TxDBGridEh;
    RzPanel1: TRzPanel;
    Label1: TLabel;
    ckProvNo: TRzCheckBox;
    ckBillNo: TRzCheckBox;
    ckDate: TRzCheckBox;
    dtpBeginDate: TRzDateTimePicker;
    dtpEndDate: TRzDateTimePicker;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn1: TRzBitBtn;
    edProvNo: TRzEdit;
    edBillNo: TRzEdit;
    ckEmpNo: TRzCheckBox;
    ckCreater: TRzCheckBox;
    edEmpNo: TRzEdit;
    edCreater: TRzEdit;
    CdsSelectSelSendOutBillNo: TStringField;
    CdsSelectSelSendOutFDate: TDateTimeField;
    CdsSelectSelSendOutCustNo: TStringField;
    CdsSelectSelSendOutCustName: TStringField;
    CdsSelectSelSendOutEmpNo: TStringField;
    CdsSelectSelSendOutName: TStringField;
    CdsSelectSelSendOutCreater: TStringField;
    CdsSelectSelSendOutCreateName: TStringField;
    CdsSelectSelSendOutAdsBrowSelSendOutDtl: TDataSetField;
    CdsSelectSelSendOutDtlBillNo: TStringField;
    CdsSelectSelSendOutDtlItemNo: TIntegerField;
    CdsSelectSelSendOutDtlGoodsID: TStringField;
    CdsSelectSelSendOutDtlName: TStringField;
    CdsSelectSelSendOutDtlUnit: TStringField;
    CdsSelectSelSendOutDtlQty: TBCDField;
    CdsSelectSelSendOutDtlPrice: TFloatField;
    CdsSelectSelSendOutDtlTaxRate: TBCDField;
    CdsSelectSelSendOutDtlUnTaxPrice: TFloatField;
    CdsSelectSelSendOutDtlGoodsSum: TBCDField;
    CdsSelectSelSendOutDtlTaxSum: TBCDField;
    CdsSelectSelSendOutDtlAmount: TBCDField;
    CdsSelectSelSendOutDtlBatchNo: TStringField;
    CdsSelectSelSendOutDtlProdDate: TDateTimeField;
    CdsSelectSelSendOutDtlValidDate: TDateTimeField;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure dbgArrearageDtlDblClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsSelectSelSendOutBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
  private
    { Private declarations }
    IFmMain:iMainForm;
    LocSetting: PLocSetting;
    CdsFieldProPerty:TCKClientDataSet;
    SvrCommon: TDispatchConnection;
    CanMulti : Boolean;
    SvrArrearage:TDispatchConnection;
    IClientID : Integer;
    Function FilterData:String;
  public
    { Public declarations }
  end;
Function SelectSelSendOut(DataSet: TDataSet;sCustNo:String;bAppend, bMultiSlt: Boolean): Boolean;

var
  FrmSelectSelSendOut: TFrmSelectSelSendOut;

Const
  sFieldProPerty='Select * From SysFieldProPerty Where TableName In(''PchReceive'',''PchReceiveDtl'', ''Goodses'')';

implementation
uses ceGlobal, DateUtils;

{$R *.dfm}
Function SelectSelSendOut(DataSet: TDataSet;sCustNo:String;bAppend, bMultiSlt: Boolean): Boolean;
const
  c_Fields1: Array[0..10] of String =('ItemNo','GoodsID','Unit','BatchNo','Qty','Price','TaxRate','UnTaxPrice','GoodsSum','TaxSum','Amount');
  c_Fields2: Array[0..10] of String =('ItemNo','GoodsID','Unit','BatchNo','Qty','Price','TaxRate','UnTaxPrice','GoodsSum','TaxSum','Amount');
var iCount,iLen,i,n : Integer;
    vField1, vField2: TField;
begin
  Result := false;
  With TFrmSelectSelSendOut.Create(Nil) Do Begin
    If not bAppend then Begin
      dbgArrearageDtl.Options := dbgArrearageDtl.Options-[dgMultiSelect];
      CanMulti := False;
    End Else
      CanMulti := True;
    CdsSelectSelSendOut.Filtered := False;
//    If (CdsSelectSelSendOut.Active) And bAppend Then
      If sCustNo<>'' Then Begin
        ckProvNo.Checked := True;
        edProvNo.Text := sCustNo;
//        CdsSelectSelSendOut.Locate('ProvNo',sProvNo,[loCaseInsensitive]);
      End;
    if ShowModal=mrOk then begin
      if bMultiSlt And bAppend Then
        iCount := dbgArrearageDtl.SelectedRows.Count
      Else
        iCount := 1;
      For n:= 0 to iCount-1 do begin
        If bAppend Then Begin
          CdsSelectSelSendOutDtl.Bookmark := dbgArrearageDtl.SelectedRows[n];
          DataSet.Append
        End Else
          DataSet.Edit;
        iLen := Length(c_Fields1);
        For i:=0 to iLen-1 do begin
          vField1 := DataSet.FindField(c_Fields1[i]);
          if vField1=nil then Continue;
          vField2 := CdsSelectSelSendOutDtl.FindField(c_Fields2[i]);
          if vField2=nil then Continue;
          vField1.Value := vField2.Value;
        end;
        DataSet.Post;
      End;
    End;
  End;
  Result := true;
end;

procedure TFrmSelectSelSendOut.FormCreate(Sender: TObject);
begin
  IFmMain := (Application.MainForm as IMainForm);
  IClientID := IFmMain.IFmMainEx.ClientID;
  SvrArrearage := IFmMain.GetConnection(Handle,'','ckSalesBase.SalesBase');
  CdsFieldProPerty:=TCKClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsSelectSelSendOut.RemoteServer := SvrArrearage;
end;

procedure TFrmSelectSelSendOut.FormShow(Sender: TObject);
begin
  CdsSelectSelSendOut.Open;
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgArrearage,dbgArrearageDtl]);
  SetGressHint('初始化本地环境...');
  SetGridEhColor([dbgArrearage,dbgArrearageDtl]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectSelSendOut.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSelectSelSendOut,'SelSendOut');
  SetFieldProperty(CdsFieldProPerty,CdsSelectSelSendOutDtl, 'SelSendOutDtl,Goodses');
  FreeGressForm;
  //将开始日期设为本月第一天,结束日期设为今天 add by yyh
  dtpEndDate.Date := Today;
  dtpBeginDate.Date := Today - DayOf(Today) + 1;
end;

procedure TFrmSelectSelSendOut.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

function TFrmSelectSelSendOut.FilterData: String;
Var
  SqlText:String;
begin
  SqlText:='';
  If ckBillNo.Checked Then
    If edBillNo.Text<>'' Then
      SqlText:='BillNo Like '''+edBillNo.Text+'%''';
  If ckProvNo.Checked Then
    If edProvNo.Text<>'' Then
      If SqlText<>'' Then
        SqlText:=SqlText+' OR (CustNo Like '+''''+edProvNo.Text+'%'+''' Or CustName Like '+''''+edProvNo.Text+'%'+''')'
      Else
        SqlText:=' (CustNo Like '+''''+edProvNo.Text+'%'+''' Or CustName Like '+''''+edProvNo.Text+'%'+''')';
  If ckDate.Checked Then
    If SqlText<>'' Then
      SqlText:=SqlText+' OR (Fdate<= '+DateToStr(dtpEndDate.Date)+' And FDate>= '+DateToStr(dtpBeginDate.Date)+')'
    Else
      SqlText:=' (Fdate<= '+DateToStr(dtpEndDate.Date)+' And FDate>= '+DateToStr(dtpBeginDate.Date)+')';
  If ckEmpNo.Checked Then
    If edEmpNo.Text <>'' Then
      If SqlText<>'' Then
        SqlText:=SqlText+' OR (EmpNo Like '+''''+edEmpNo.Text+'%'+''' Or Name Like '+''''+edEmpNo.Text+'%'+''')'
      Else
        SqlText:=' (EmpNo Like '+''''+edEmpNo.Text+'%'+''' Or Name Like '+''''+edEmpNo.Text+'%'+''')';
  If ckCreater.Checked Then
    If edCreater.Text<>'' Then
      If SqlText<>'' Then
        SqlText:=SqlText+' OR (Creater Like '+''''+edCreater.text+'%'+''' Or CreateName Like '+''''+edCreater.Text+'%'+''')'
      Else
        SqlText:=' (Creater Like '+''''+edCreater.Text+'%'+''' Or CreateName Like '+''''+edCreater.Text+'%'+''')';
  Result:=SqlText;
end;

procedure TFrmSelectSelSendOut.RzBitBtn2Click(Sender: TObject);
begin
  CdsSelectSelSendOut.Filtered:= False;
  CdsSelectSelSendOut.Filter := FilterData;
  CdsSelectSelSendOut.Filtered := True;
end;

procedure TFrmSelectSelSendOut.RzBitBtn1Click(Sender: TObject);
Var iCount : Integer;
begin
  If NOt(CanMulti) Then
    iCount := 0
  Else
    iCount := 1;
  If dbgArrearageDtl.SelectedRows.Count< iCount Then Begin
    MessageBox(Handle,Pchar('请选择入库通知单据明细数据!'),'提示',64);
    Exit;
  End;
  ModalResult := mrOK;
end;

procedure TFrmSelectSelSendOut.dbgArrearageDtlDblClick(Sender: TObject);
begin
  RzBitBtn1Click(niL);
end;

procedure TFrmSelectSelSendOut.CdsSelectSelSendOutBeforeGetRecords(
  Sender: TObject; var OwnerData: OleVariant);
Var sProvNo : string;
  A: Variant;
begin
  if edProvNo.Text ='' Then
    sProvNo := '%'
  Else
    sProvNo := edProvNo.Text;
  A:= VarArrayCreate([0,1],VarVariant);
  A[0]:= iClientID;
  A[1] := sProvNo;
  OwnerData := A;
end;

end.

⌨️ 快捷键说明

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