purchpayqry.pas

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

unit PurchPayQry;

interface

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

type
  TFmPchPayQry = class(TxBaseForm)
    RzSizePanel1: TRzSizePanel;
    ptBkPanel: TFlatPanel;
    ptCaption: TRzMarqueeStatus;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    DCOMConnection1: TDCOMConnection;
    dsPurchPay: TDataSource;
    cdsPurchPay: TckClientDataSet;
    RzGroupBox1: TRzGroupBox;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    Label3: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    edBillNo1: TRzEdit;
    edBillNo2: TRzEdit;
    edProvNo: TRzButtonEdit;
    cbOptor: TRzButtonEdit;
    cbAudit: TRzComboBox;
    edAudit: TRzButtonEdit;
    Label5: TLabel;
    Label11: TLabel;
    DTCtrl1: TRzDateTimePicker;
    DTCtrl2: TRzDateTimePicker;
    Label12: TLabel;
    edDepartID: TRzButtonEdit;
    Panel1: TPanel;
    dbgPchOrders: TxDBGridEh;
    ActionList1: TActionList;
    ImageList1: TImageList;
    ActQuery: TModlAction;
    ActReport: TModlAction;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    ckMultiSelect: TRzCheckBox;
    ActViewBill: TModlAction;
    RzLabel1: TRzLabel;
    RzLabel2: TRzLabel;
    edPayMode: TRzButtonEdit;
    edBillNo: TRzEdit;
    edCheckNo: TRzEdit;
    edGoodsID: TRzButtonEdit;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActReportExecute(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure cdsPurchPayAfterOpen(DataSet: TDataSet);
    procedure ActViewBillExecute(Sender: TObject);
    procedure edProvNoButtonClick(Sender: TObject);
    procedure edDepartIDButtonClick(Sender: TObject);
    procedure cbOptorButtonClick(Sender: TObject);
    procedure edAuditButtonClick(Sender: TObject);
    procedure edPayModeButtonClick(Sender: TObject);
    procedure edGoodsIDButtonClick(Sender: TObject);
  private
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
  public
    { Public declarations }
  end;

var
  FmPchPayQry: TFmPchPayQry;

Const
  sFieldProPerty='Select * From SysFieldProperty '+
        ' Where TableName=''PurchPay''';

implementation
uses SelectGoodsFrm,ceGlobal, ShowProGress, FieldsLayoutFrm, RepSelectFrm, DataExportFrm,
     SelectProvFrm,SelectEmpFrm,SelectDepartFrm,
     SelectPayMode;

{$R *.dfm}

procedure TFmPchPayQry.FormCreate(Sender: TObject);
var SystemTime: TSystemTime;
begin
  CdsFieldProperty := TckClientDataSet.Create(Self);
  GetLocalTime(SystemTime);
  with SystemTime do
    DTCtrl1.Date := EncodeDate(wYear, wMonth, 1);
  DTCtrl2.Date := Date;

  IFmMain := Application.MainForm as IMainForm;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iClientID := IFmMain.IFmMainEx.ClientID;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon := IFmMain.GetConnection(Handle, '', 'CommonSvr.CommonRDM');
  cdsPurchPay.RemoteServer := SvrCommon;

  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;

end;

procedure TFmPchPayQry.FormShow(Sender: TObject);
var sTableNames: string;
begin
  SetGressHint('初始化本地环境...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPurchPayQry.Xml');
  sTableNames:='PurchPay';
  SetFieldProperty(CdsFieldProPerty,CdsPurchPay,sTableNames);
  SetGridEhColor([dbgPchOrders]);
  ptBkPanel.Color := TitlePanelColor;
//  cdsPurchPay.Open;
  FreeGressForm;
end;

procedure TFmPchPayQry.ActQueryExecute(Sender: TObject);
var swMst, swDtl, str: String;
   sTableNames:String;
begin
	swMst := 'and M.FDATE>='''+FormatDateTime('yyyy-mm-dd', DTCtrl1.Date)
  				+''' AND M.FDATE<'''+FormatDateTime('yyyy-mm-dd', DTCtrl2.Date+1)+'''';
  if edBillNo.Text<>'' then
    swMst := swMst+'AND M.Invoice='''+edBillNo.Text+'''';
  if edPayMode.Text<>'' then
    swMst := swMst+'AND M.PayKind='''+edPayMode.Text+'''';
	str := edProvNo.Text;
	if str<>'' then
  	swMst := swMst+' AND M.ProvNo='''+str+'''';
  str := edBillNo1.Text;
  if str<>'' then begin
  	if edBillNo2.Text='' then
      swMst := swMst+' AND M.BILLNO='''+str+''''
    else
    	swMst := swMst+' AND M.BILLNO>='''+str+''' AND M.BillNo<='''+edBillNo2.Text+'''';
  end;
  str := edCheckNo.Text;
  if str<>'' then
  	swMst := swMst+' AND M.ChequeNo='''+str+'''';
  str := cbOptor.Text;
  if str<>'' then
  	swMst := swMst+' AND M.Creater='''+str+'''';
  str := edAudit.Text;
  if str<>'' then
  	swMst := swMst+' AND M.Audit='''+str+'''';
  if cbAudit.ItemIndex=1 then
  	swMst := swMst+' AND M.Audit IS NOT NULL '
  else if cbAudit.ItemIndex=2 then
  	swMst := swMst+' AND M.Audit IS NULL ';

  str := edGoodsID.Text;
  if str<>'' then begin
    if AnsiPos(',', str)>0 then
      swDtl := ' AND GoodsID IN ('''+str+''')'
    else
      swDtl := ' AND GoodsID Like '''+edGoodsID.Text+'''';
  end;
  cdsPurchPay.Close;
  cdsPurchPay.Data := SvrCommon.AppServer.QueryBill(iClientID, 'PurchPay', swMst, swDtl);
  sTableNames := 'PurchPay';
  SetFieldProperty(CdsFieldProPerty,cdsPurchPay,sTableNames);
end;

procedure TFmPchPayQry.ActReportExecute(Sender: TObject);
begin
  SelRepPrint(self.Name, [cdsPurchPay], '采购付款查询', ActDesignReport.Enabled);
end;

procedure TFmPchPayQry.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders], '采购付款查询');
end;

procedure TFmPchPayQry.ActDataExportExecute(Sender: TObject);
begin
	ExportData([cdsPurchPay], '采购付款查询', '');
end;

procedure TFmPchPayQry.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 TFmPchPayQry.cdsPurchPayAfterOpen(DataSet: TDataSet);
begin
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders]);
end;

procedure TFmPchPayQry.ActViewBillExecute(Sender: TObject);
var //Form: TForm;
    Values: Variant;
    sBillNo, sBills: String;
    mark: TBookmark;
begin
  if cdsPurchPay.IsEmpty then Exit;
{  IFmMain.OnAction(Sender);
  Form := FindForm('TFmPchOrder');
  if (Form=nil)or not (Form is TxBaseForm) then Exit;
}  with cdsPurchPay 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;
//  TxBaseForm(Form).DoSome('ViewBill', Values);
//  Form.BringToFront;
  IFmMain.DoSome(ActViewBill.ModuleFile, 'ViewBill', Values);
  Values := NULL;
end;

procedure TFmPchPayQry.edProvNoButtonClick(Sender: TObject);
Var
  ProvNo :String;
  ProvName :String;
begin
  ProvNo := '';
  ProvName := '';
  if SelectProv(ProvNo,ProvName) then
  edProvNo.Text := ProvNo;
end;

procedure TFmPchPayQry.edDepartIDButtonClick(Sender: TObject);
Var
  DptId :Integer;
  DptNo :String;
  DptName :String;
begin
  DptId := 0;
  DptNo := '';
  DptName := '';
  if SelectDepart(DptId,DptNo,DptName) then
  edDepartID.Text := DptNo;
end;

procedure TFmPchPayQry.cbOptorButtonClick(Sender: TObject);
Var
  EmpNo,EmpName :string;
begin
  EmpNo := '';
  EmpName := '';
  if SelectEmp(EmpNo,EmpName) then
  cbOptor.Text := EmpNo;
end;

procedure TFmPchPayQry.edAuditButtonClick(Sender: TObject);
Var
  EmpNo,EmpName :string;
begin
  EmpNo := '';
  EmpName := '';
  if SelectEmp(EmpNo,EmpName) then
  edAudit.Text := EmpNo;
end;

procedure TFmPchPayQry.edPayModeButtonClick(Sender: TObject);
Var
  PayId,PayName :String;
begin
  Payid :='';
  PayName := '';
  if SelectPay(PayId,PayName) then
  edPayMode.Text := PayId;
end;

procedure TFmPchPayQry.edGoodsIDButtonClick(Sender: TObject);
var
  sGoodsId :String;
begin
  sGoodsID := '';
  if ckMultiSelect.Checked then
  begin
    if SelectGoodsID(sGoodsID, true) then
      If edGoodsID.Text<>'' Then
        edGoodsId.Text := edGoodsId.Text+','+sGoodsId
      else
        edGoodsId.Text := sGoodsID;
  End
  else if SelectGoodsID(sGoodsID, false) then
    edGoodsID.text := sGoodsID;
end;

initialization
  RegisterClass(TFmPchPayQry);

finalization
  UnRegisterClass(TFmPchPayQry);

end.