selectarrearagefrm.~pas

来自「医药连锁经营管理系统源码」· ~PAS 代码 · 共 244 行

unit SelectArrearageFrm;

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
  TFrmSelectArrearage = class(TForm)
    DComm: TDCOMConnection;
    CdsSelectArrearage: TckClientDataSet;
    DsSelectArrearage: TDataSource;
    ImageList1: TImageList;
    DsSelectArrearageDtl: TDataSource;
    CdsSelectArrearageDtl: 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;
    CdsSelectArrearageBillNo: TStringField;
    CdsSelectArrearageFDate: TDateTimeField;
    CdsSelectArrearageInOutKind: TSmallintField;
    CdsSelectArrearageDepartID: TIntegerField;
    CdsSelectArrearageDepartNo: TStringField;
    CdsSelectArrearageDepartName: TStringField;
    CdsSelectArrearageProvNo: TStringField;
    CdsSelectArrearageProvName: TStringField;
    CdsSelectArrearageLinkMan: TStringField;
    CdsSelectArrearageEmpNo: TStringField;
    CdsSelectArrearageName: TStringField;
    CdsSelectArrearageCreater: TStringField;
    CdsSelectArrearageCreateName: TStringField;
    CdsSelectArrearageAdsBrowArrearageDtl: TDataSetField;
    CdsSelectArrearageDtlBillNo: TStringField;
    CdsSelectArrearageDtlItemNo: TIntegerField;
    CdsSelectArrearageDtlGoodsID: TStringField;
    CdsSelectArrearageDtlName: TStringField;
    CdsSelectArrearageDtlSpecs: TStringField;
    CdsSelectArrearageDtlUnit: TStringField;
    CdsSelectArrearageDtlBatchNo: TStringField;
    CdsSelectArrearageDtlQty: TBCDField;
    CdsSelectArrearageDtlPrice: TFloatField;
    CdsSelectArrearageDtlTaxRate: TBCDField;
    CdsSelectArrearageDtlUnTaxPrice: TFloatField;
    CdsSelectArrearageDtlGoodsSum: TBCDField;
    CdsSelectArrearageDtlTaxSum: TBCDField;
    CdsSelectArrearageDtlAmount: TBCDField;
    CdsSelectArrearageDtlCostPrice: TFloatField;
    CdsSelectArrearageDtlCostAmount: TBCDField;
    CdsSelectArrearageDtlPBillNo: TStringField;
    CdsSelectArrearageDtlPItemNo: TIntegerField;
    CdsSelectArrearageDtlPaidUp: TBCDField;
    CdsSelectArrearageDtlPayDone: TBooleanField;
    CdsSelectArrearageDtlPayDoneDate: TDateTimeField;
    CdsSelectArrearageDtlRemark: TStringField;
    CdsSelectArrearageDtlUnPaid: TBCDField;
    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);
  private
    { Private declarations }
    IFmMain:iMainForm;
    LocSetting: PLocSetting;
    CdsFieldProPerty:TCKClientDataSet;
    SvrCommon: TDispatchConnection;
    CanMulti : Boolean;
    SvrArrearage:TDispatchConnection;

    Function FilterData:String;
  public
    { Public declarations }
  end;
Function SelectArrearage(DataSet: TDataSet;sBillNo:String;bAppend, bMultiSlt: Boolean): Boolean;

var
  FrmSelectArrearage: TFrmSelectArrearage;

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

implementation

{$R *.dfm}
Function SelectArrearage(DataSet: TDataSet;sBillNo:String;bAppend, bMultiSlt: Boolean): Boolean;
const
  c_Fields1: Array[0..6] of String = ('PBillNo', 'PItemNo', 'PInOutKind','PDate', 'PAmount', 'PPaidUp', 'PUnPaid');
  c_Fields2: Array[0..6] of String = ('PBillNo', 'PItemNo', 'InOutKind','PayDate','Amount', 'PaidUp', 'UnPaid');
var iCount,iLen,i,n : Integer;
    vField1, vField2: TField;
begin
  Result := false;
  with TFrmSelectArrearage.Create(NIl) do begin
    If not bAppend then Begin
      dbgArrearageDtl.Options := dbgArrearageDtl.Options-[dgMultiSelect];
      CanMulti := False;
    End Else
      CanMulti := True;
    CdsSelectArrearage.Filtered := False;
    If (CdsSelectArrearage.Active) And Not(bAppend) Then
      If sBillNo<>'' Then Begin
        edBillNo.Text := sBillNo;
        CdsSelectArrearage.Locate('BillNo',sBillNo,[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
          CdsSelectArrearageDtl.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 := CdsSelectArrearageDtl.FindField(c_Fields2[i]);
          if vField2=nil then Continue;
          vField1.Value := vField2.Value;
        end;
        DataSet.Post;
      End;
    End;
  End;
  Result := true;
end;

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

procedure TFrmSelectArrearage.FormShow(Sender: TObject);
begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgArrearage,dbgArrearageDtl]);
  SetGressHint('初始化本地环境...');
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectArrearage.Xml');
  SetFieldProperty(CdsFieldProPerty,CdsSelectArrearage,'Arrearage');
  SetFieldProperty(CdsFieldProPerty,CdsSelectArrearageDtl, 'ArrearageDtl,Goodses');
  FreeGressForm;
end;

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

function TFrmSelectArrearage.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 (ProvNo Like '+''''+edProvNo.Text+'%'+''' Or ProvName Like '+''''+edProvNo.Text+'%'+''')'
      Else
        SqlText:=' (ProvNo Like '+''''+edProvNo.Text+'%'+''' Or ProvName 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 TFrmSelectArrearage.RzBitBtn2Click(Sender: TObject);
begin
  CdsSelectArrearage.Filtered:= False;
  CdsSelectArrearage.Filter := FilterData;
  CdsSelectArrearage.Filtered := True;
end;

procedure TFrmSelectArrearage.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 TFrmSelectArrearage.dbgArrearageDtlDblClick(Sender: TObject);
begin
  RzBitBtn1Click(niL);
end;

end.