pchinretfrmqry.pas
来自「群星医药系统源码」· PAS 代码 · 共 352 行
PAS
352 行
unit PchInRetFrmQry;
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
TFmPchInRetQry = 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;
dsPchInRet: TDataSource;
cdsPchInRet: 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 cdsPchInRetAfterOpen(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
FmPchInRetQry: TFmPchInRetQry;
Const
sFieldProPerty='Select * From SysFieldProperty '+
' Where TableName=''PchReceive''';
implementation
uses SelectGoodsFrm,ceGlobal, ShowProGress, FieldsLayoutFrm, RepSelectFrm, DataExportFrm,
SelectProvFrm,SelectEmpFrm,SelectDepartFrm,
SelectPayMode;
{$R *.dfm}
procedure TFmPchInRetQry.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');
cdsPchInRet.RemoteServer := SvrCommon;
CdsFieldProPerty.ProviderName:='DspTemp';
CdsFieldProPerty.RemoteServer:=SvrCommon;
end;
procedure TFmPchInRetQry.FormShow(Sender: TObject);
var sTableNames: string;
begin
SetGressHint('初始化本地环境...');
IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPchReceiveQry.Xml');
sTableNames:='PchReceive';
SetFieldProperty(CdsFieldProPerty,CdsPchInRet,sTableNames);
SetGridEhColor([dbgPchOrders]);
ptBkPanel.Color := TitlePanelColor;
FreeGressForm;
end;
procedure TFmPchInRetQry.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 := ' AND GoodsID IN ('+str+')'
else
swDtl := ' AND GoodsID Like '''+edGoodsID.Text+'''';
end;
cdsPchInRet.Close;
cdsPchInRet.Data := SvrCommon.AppServer.QueryBill(iClientID, 'PchReceive', swMst, swDtl);
sTableNames := 'PchReceive';
SetFieldProperty(CdsFieldProPerty,cdsPchInRet,sTableNames);
end;
procedure TFmPchInRetQry.ActReportExecute(Sender: TObject);
begin
SelRepPrint(self.Name, [cdsPchInRet], '采购退回查询', ActDesignReport.Enabled);
end;
procedure TFmPchInRetQry.ActFieldsLayoutExecute(Sender: TObject);
begin
SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders], '采购退回查询');
end;
procedure TFmPchInRetQry.ActDataExportExecute(Sender: TObject);
begin
ExportData([cdsPchInRet], '采购退回查询', '');
end;
procedure TFmPchInRetQry.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 TFmPchInRetQry.cdsPchInRetAfterOpen(DataSet: TDataSet);
begin
LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgPchOrders]);
end;
procedure TFmPchInRetQry.ActViewBillExecute(Sender: TObject);
var //Form: TForm;
Values: Variant;
sBillNo, sBills: String;
mark: TBookmark;
begin
if cdsPchInRet.IsEmpty then Exit;
{ IFmMain.OnAction(Sender);
Form := FindForm('TFmPchOrder');
if (Form=nil)or not (Form is TxBaseForm) then Exit;
} with cdsPchInRet 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 TFmPchInRetQry.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 TFmPchInRetQry.edProvNoButtonClick(Sender: TObject);
Var
ProvNo,ProvName :String;
begin
ProvNo := '';
ProvName := '';
if SelectProv(ProvNo,ProvName) then
edProvNo.Text := ProvNo;
end;
procedure TFmPchInRetQry.edEmpNoButtonClick(Sender: TObject);
Var
EmpNo,EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
edEmpNo.Text := EmpNo;
end;
procedure TFmPchInRetQry.edDepartIDButtonClick(Sender: TObject);
Var
DptId :Integer;
DptNo :String;
DptName :String;
begin
if SelectDepart(DptId,DptNo,DptName) then
edDepartID.Text := DptNo;
end;
procedure TFmPchInRetQry.cbOptorButtonClick(Sender: TObject);
Var
EmpNo,EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
cbOptor.Text := EmpNo;
end;
procedure TFmPchInRetQry.edAuditButtonClick(Sender: TObject);
Var
EmpNo,EmpName :String;
begin
EmpNo := '';
EmpName := '';
if SelectEmp(EmpNo,EmpName) then
edAudit.Text := EmpNo;
end;
procedure TFmPchInRetQry.edAccountButtonClick(Sender: TObject);
Var
Payid :String;
PayName :String;
begin
PayId := '';
PayName := '';
if SelectPay(PayId,PayName) then
edAccount.Text := PayId;
end;
initialization
RegisterClass(TFmPchInRetQry);
finalization
UnRegisterClass(TFmPchInRetQry);
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?