selpayqryfrm.~pas

群星医药系统源码

unit SelPayQryFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, xBaseFrm, Grids, DBGridEh, xEhLibCtl, RzButton, RzRadChk,
  ComCtrls, RzDTP, StdCtrls, RzCmboBx, RzBtnEdt, Mask, RzEdit, RzLabel,
  RzPanel, RzSplit, TFlatSpeedButtonUnit, ExtCtrls, RzStatus,
  TFlatPanelUnit, DB, DBClient, ckDBClient, MConnect, ActnList,
  ModuleAction, ImgList, Menus, IMainFrm, uDataTypes, ceGlobal;

type
  TFrmSelPayQry = class(TxBaseForm)
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ImageList1: TImageList;
    ActionList1: TActionList;
    ActQuery: TModlAction;
    ActReport: TModlAction;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    ActViewBill: TModlAction;
    cdsSelPay: TckClientDataSet;
    dsPurchPay: TDataSource;
    ptBkPanel: TFlatPanel;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    RzSizePanel1: TRzSizePanel;
    RzGroupBox1: TRzGroupBox;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label5: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    Label1: TLabel;
    edtBillNo1: TRzEdit;
    edtBillNo2: TRzEdit;
    edtCustNO: TRzButtonEdit;
    edtCreater: TRzButtonEdit;
    cmbAudit: TRzComboBox;
    edtAudit: TRzButtonEdit;
    dtpDate1: TRzDateTimePicker;
    dtpDate2: TRzDateTimePicker;
    edtGrup: TRzButtonEdit;
    chkMultiSelect: TRzCheckBox;
    edtInvoice: TRzEdit;
    edtChequeNo: TRzEdit;
    edtGoodsID: TRzButtonEdit;
    Panel1: TPanel;
    grdSelPay: TxDBGridEh;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    cmbPayKind: TRzComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edtCustNOButtonClick(Sender: TObject);
    procedure edtCreaterButtonClick(Sender: TObject);
    procedure edtAuditButtonClick(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActReportExecute(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActViewBillExecute(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure edtGrupButtonClick(Sender: TObject);
    procedure edtGoodsIDButtonClick(Sender: TObject);
  private
    { Private declarations }
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
    
    function SetText(Obj: TRzEdit): Boolean;
  public
    { Public declarations }
  end;

var
  FrmSelPayQry: TFrmSelPayQry;

implementation

uses DBFuncs, SelectEmpFrm, SelectCustFrm, SelectGoodsFrm, ShowProgress, RepSelectFrm,
  FieldsLayoutFrm, DataExportFrm, SelectDepartFrm;

{$R *.dfm}

Const
  sFieldProPerty='Select * From SysFieldProperty Where TableName=''SellPay''';

procedure TFrmSelPayQry.FormCreate(Sender: TObject);
var SystemTime: TSystemTime;
    sTableNames: string;
begin
  CdsFieldProperty := TckClientDataSet.Create(Self);
  GetLocalTime(SystemTime);
  with SystemTime do
    dtpDate1.Date := EncodeDate(wYear, wMonth, 1);
  dtpDate2.Date := Date;

  IFmMain := Application.MainForm as IMainForm;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iClientID := IFmMain.IFmMainEx.ClientID;
  SetGressHint('正在连接到公用信息服务器...');

  SvrCommon := IFmMain.GetConnection(Handle, '', 'CommonSvr.CommonRDM');
  cdsSelPay.RemoteServer := SvrCommon;
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  CdsFieldProPerty.ProviderName:='DspTemp';
end;

procedure TFrmSelPayQry.FormShow(Sender: TObject);
var sTableNames: string;
begin
  SetGressHint('初始化本地环境...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmSelPayQry.Xml');
  sTableNames:='SelPayDtl';
  SetFieldProperty(CdsFieldProPerty,cdsSelPay,sTableNames);
  SetGridEhColor([grdSelPay]);
  ptBkPanel.Color := TitlePanelColor;
  FreeGressForm;
end;

function TFrmSelPayQry.SetText(Obj: TRzEdit): Boolean;
var
  sEmpNo, sEmpName: string;
begin
  result := false;
  if not(Obj is TRzEdit) or (Obj = nil) then exit;
  if SelectEmp(sEmpNo, sEmpName) then
    Obj.Text := sEmpNo;
  result := true;
end;

procedure TFrmSelPayQry.edtCustNOButtonClick(Sender: TObject);
begin
  SetText(Sender as TRzEdit);
end;

procedure TFrmSelPayQry.edtCreaterButtonClick(Sender: TObject);
begin
  SetText(Sender as TRzEdit);
end;

procedure TFrmSelPayQry.edtAuditButtonClick(Sender: TObject);
begin
  SetText(Sender as TRzEdit);
end;

procedure TFrmSelPayQry.ActQueryExecute(Sender: TObject);
var
  sTableNames, m, d, s: string;
  n: integer;
begin
  m := ' and M.FDate >= ''' + FormatDateTime('yyyy-mm-dd', dtpDate1.Date) + '''';
  m := m + ' and M.FDate <= ''' + FormatDateTime('yyyy-mm-dd', dtpDate2.Date) + '''';
  s := edtCustNo.Text;
  if s <> '' then
    m := m + ' and M.CustNo = ''' + s + '''';
  s := edtCreater.Text;
  if s <> '' then
    m := m + ' and M.Creater = ''' + s + '''';
  s := edtchequeNO.Text;
  if s <> '' then
    m := m + ' and M.ChequeNo = ''' + s + '''';
  s := edtAudit.Text;
  if s <> '' then
    m := m + ' and M.Audit = ''' + s + '''';
  if cmbAudit.ItemIndex = 1 then
    m := m + ' and M.Transfer Is Not Null'
  else if cmbAudit.ItemIndex = 2 then
    m := m + ' and M.Transfer Is Null';
  if cmbPayKind.ItemIndex = 1 then
    m := m + ' and M.PayKind = 1'
  else if cmbPayKind.ItemIndex = 2 then
    m := m + ' and M.PayKind = 0';
  s := edtInvoice.Text;
  if s <> '' then
    m := m + ' and M.invoice = ''' + s + '''';
  s := edtGrup.Text;
  if s <> '' then
    m := m + ' and M.Grup = ' + IntToStr(edtGrup.Tag);
  s := edtBillNo1.Text;
  if s <> '' then
  begin
    if s<>'' then
      if edtBillNo2.Text='' then
        m := m + ' and M.BILLNO=''' + s + ''''
      else
        m := m + ' and M.BILLNO>=''' + s + ''' AND M.BillNo<=''' + edtBillNo2.Text + '''';
  end;

  s := edtGoodsID.Text;
  if s <> '' then
    if AnsiPos(',', s) > 0 then
      d := 'AND GoodsID IN (' + s + ')'
    else
      d := 'AND GoodsID Like ''' + edtGoodsID.Text + '''';

  cdsSelPay.Close;
  cdsSelPay.Data := SvrCommon.AppServer.QueryBill(iClientID, 'SellPay', m, d);
  sTableNames := 'SellPay';
  SetFieldProperty(CdsFieldProPerty,cdsSelPay,sTableNames);
end;

procedure TFrmSelPayQry.ActReportExecute(Sender: TObject);
begin
  SelRepPrint(self.Name, [cdsSelPay], '销售收款查询', ActDesignReport.Enabled);
end;

procedure TFrmSelPayQry.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [grdSelPay], '销售收款查询');
end;

procedure TFrmSelPayQry.ActDataExportExecute(Sender: TObject);
begin
  ExportData([cdsSelPay], '销售收款查询', '');
end;

procedure TFrmSelPayQry.ActViewBillExecute(Sender: TObject);
var Values: Variant;
    sBillNo, sBills: String;
    mark: TBookmark;
begin
  if cdsSelPay.IsEmpty then Exit;
  with cdsSelPay do begin
    sBillNo := FieldByName('BillNo').AsString; //取得单号
    mark := GetBookmark;
    DisableControls;
    try
      First;
      while not Eof do begin //单号有可能是多个，
        sBills := sBills+FieldByName('BillNo').AsString+#13; //取出所有单号
        Next;
      end;
    finally
      GotoBookmark(mark);
      FreeBookmark(mark);
      EnableControls;
    end;
  end;
  Values := VarArrayCreate([0,1], varOleStr); //
  Values[0] := sBillNo; //查询后的第一张单据
  Values[1] := sBills; //查询后的所有单据
  IFmMain.DoSome(ActViewBill.ModuleFile, 'ViewBill', Values); 
  Values := NULL;
end;

procedure TFrmSelPayQry.BtnPopMenuClick(Sender: TObject);
var tp:TPoint;
begin
  tp.X:=BtnPopMenu.Left;
  tp.Y:=BtnPopMenu.Top+BtnPopMenu.Height+1;
  tp:=ClientToScreen(tp);
	TopPopmenu.Popup(tp.x,tp.Y);
end;

procedure TFrmSelPayQry.edtGrupButtonClick(Sender: TObject);
var
  idepartID: integer;
  sDepartNo, sDepartName: string;
begin
  if SelectDepart(iDepartID, sDepartNo, sDepartName) then
  begin
    edtGrup.Tag := iDepartID;
    edtGrup.Text := sDepartName;
  end;
end;

procedure TFrmSelPayQry.edtGoodsIDButtonClick(Sender: TObject);
var
  sGoodsId :String;
begin
  sGoodsID := '';
  if chkMultiSelect.Checked then
  begin
    if SelectGoodsID(sGoodsID, true) then
      If edtGoodsID.Text<>'' Then
        edtGoodsId.Text := edtGoodsId.Text+','+sGoodsId
      else
        edtGoodsId.Text := sGoodsID;
  End
  else if SelectGoodsID(sGoodsID, false) then
    edtGoodsID.text := sGoodsID;
end;

initialization
  RegisterClass(TFrmSelPayQry);

finalization
  UnRegisterClass(TFrmSelPayQry);

end.