pchreceiveqry.pas
来自「医药连锁经营管理系统源码」· PAS 代码 · 共 359 行
PAS
359 行
unit PchReceiveQry;
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, StrUtils;
type
TFmPchReceiveQry = 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;
dsPchReceive: TDataSource;
cdsPchReceive: TckClientDataSet;
RzGroupBox1: TRzGroupBox;
RzBitBtn1: TRzBitBtn;
RzBitBtn2: TRzBitBtn;
RzBitBtn3: TRzBitBtn;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label6: TLabel;
Label7: TLabel;
Label9: TLabel;
Label10: TLabel;
Label15: TLabel;
Label16: TLabel;
DTCtrl3: TRzDateTimePicker;
DTCtrl4: TRzDateTimePicker;
edBillNo1: TRzEdit;
edBillNo2: TRzEdit;
edProvNo: TRzButtonEdit;
edGoodsID: TRzButtonEdit;
edEmpNo: 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;
edAccount: TRzButtonEdit;
RzLabel18: TRzLabel;
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 cdsPchReceiveAfterOpen(DataSet: TDataSet);
procedure ActViewBillExecute(Sender: TObject);
procedure edGoodsIDButtonClick(Sender: TObject);
procedure edProvNoButtonClick(Sender: TObject);
procedure edEmpNoButtonClick(Sender: TObject);
procedure edDepartIDButtonClick(Sender: TObject);
procedure cbOptorButtonClick(Sender: TObject);
procedure edAuditButtonClick(Sender: TObject);
procedure edAccountButtonClick(Sender: TObject);
private
IFmMain: IMainForm;
LocSetting: PLocSetting;
iClientID: Integer;
SvrCommon: TDispatchConnection;
CdsFieldProperty :TckClientDataSet;
public
{ Public declarations }
end;
var
FmPchReceiveQry: TFmPchReceiveQry;
Const
sFieldProPerty='Select * From SysFieldProperty '+
' Where TableName=''PchReceive''';
implementation
uses SelectGoodsFrm,ceGlobal, ShowProGress, FieldsLayoutFrm, RepSelectFrm, DataExportFrm,
SelectProvFrm,SelectEmpFrm,SelectDepartFrm,
SelectPayMode;
{$R *.dfm}
procedure TFmPchReceiveQry.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;
DTCtrl3.Date := DTCtrl1.Date;
DTCtrl4.Date := Date;
DTCtrl3.Checked := false;
DTCtrl4.Checked := false;
IFmMain := Application.MainForm as IMainForm;
LocSetting := IFmMain.IFmMainEx.GetLocSetting;
iClientID := IFmMain.IFmMainEx.ClientID;
SetGressHint('正在连接到公用信息服务器...');
SvrCommon := IFmMain.GetConnection(Handle, '', 'CommonSvr.CommonRDM');
cdsPchReceive.RemoteServer := SvrCommon;
CdsFieldProPerty.ProviderName:='DspTemp';
CdsFieldProPerty.RemoteServer:=SvrCommon;
end;
procedure TFmPchReceiveQry.FormShow(Sender: TObject);
var sTableNames: string;
begin
SetGressHint('初始化本地环境...');
IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmReceiveQry.Xml');
sTableNames:='PchReceive';
SetFieldProperty(CdsFieldProPerty,CdsPchReceive,sTableNames);
SetGridEhColor([dbgPchOrders]);
ptBkPanel.Color := TitlePanelColor;
FreeGressForm;
end;
procedure TFmPchReceiveQry.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 DTCtrl3.Checked then begin
if not DTCtrl4.Checked then
swMst := swMst+' and M.PayDate='''+FormatDateTime('yyyy-mm-dd', DTCtrl3.Date)+''''
else
swMst := swMst+' and M.PayDate>='''+FormatDateTime('yyyy-mm-dd', DTCtrl3.Date)
+''' AND M.PayDate<'''+FormatDateTime('yyyy-mm-dd', DTCtrl4.Date+1)+'''';
end;
if edAccount.Text<>'' then
swMst := swMst+' AND M.PayModeNo='''+edAccount.Text+'''';
// if edDepotID.Text<>'' then
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 := edEmpNo.Text;
if str<>'' then
swMst := swMst+' AND M.EmpNo='''+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 := swDtl + ' and GoodsID in(''' + AnsiReplaceText(str, ',', ''',''') + ''')'
else
swDtl := ' AND GoodsID Like '''+edGoodsID.Text+'''';
end;
cdsPchReceive.Close;
cdsPchReceive.Data := SvrCommon.AppServer.QueryBill(iClientID, 'PchReceive', swMst, swDtl);
sTableNames := 'PchReceive';
SetFieldProperty(CdsFieldProPerty,cdsPchReceive,sTableNames);
end;
procedure TFmPchReceiveQry.ActReportExecute(Sender: TObject);
begin
SelRepPrint(self.Name, [cdsPchReceive], '入库单查询', ActDesignReport.Enabled);
end;
procedure TFmPchReceiveQry.ActFieldsLayoutExecute(Sender: TObject);
begin
SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders], '入库单查询');
end;
procedure TFmPchReceiveQry.ActDataExportExecute(Sender: TObject);
begin
ExportData([cdsPchReceive], '入库单查询', '');
end;
procedure TFmPchReceiveQry.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 TFmPchReceiveQry.cdsPchReceiveAfterOpen(DataSet: TDataSet);
begin
LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders]);
end;
procedure TFmPchReceiveQry.ActViewBillExecute(Sender: TObject);
var //Form: TForm;
Values: Variant;
sBillNo, sBills: String;
mark: TBookmark;
begin
if cdsPchReceive.IsEmpty then Exit;
{ IFmMain.OnAction(Sender);
Form := FindForm('TFmPchOrder');
if (Form=nil)or not (Form is TxBaseForm) then Exit;
} with cdsPchReceive 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 TFmPchReceiveQry.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;
procedure TFmPchReceiveQry.edProvNoButtonClick(Sender: TObject);
Var
ProvNo :String;
ProvName :String;
begin
ProvNo := '';
ProvName := '';
if SelectProv(ProvNo,ProvName) then
edProvNo.Text := ProvNo;
end;
procedure TFmPchReceiveQry.edEmpNoButtonClick(Sender: TObject);
Var
EmpNo :String;
EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
edEmpNo.Text := EmpNo;
end;
procedure TFmPchReceiveQry.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 TFmPchReceiveQry.cbOptorButtonClick(Sender: TObject);
Var
EmpNo :String;
EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
cbOptor.Text := EmpNo;
end;
procedure TFmPchReceiveQry.edAuditButtonClick(Sender: TObject);
Var
EmpNo :String;
EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
edAudit.Text := EmpNo;
end;
procedure TFmPchReceiveQry.edAccountButtonClick(Sender: TObject);
Var
PayId :String;
PayName :String;
begin
PayId := '';
PayName := '';
if SelectPay(PayId,PayName) then
edAccount.Text := PayId;
end;
initialization
RegisterClass(TFmPchReceiveQry);
finalization
UnRegisterClass(TFmPchReceiveQry);
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?