overflowqryfrm.~pas

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

unit OverflowQryFrm;

interface

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

type
  TFmOverflowQuery = class(TxBaseForm)
    ptBkPanel: TFlatPanel;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    Panel1: TRzSizePanel;
    Panel2: TPanel;
    RzGroupBox1: TRzGroupBox;
    Label3: TLabel;
    Label4: TLabel;
    Label7: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label5: TLabel;
    Label11: TLabel;
    Label13: TLabel;
    Label2: TLabel;
    edtBillNo1: TRzEdit;
    edtBillNo2: TRzEdit;
    edtGoodsID: TRzButtonEdit;
    edtEmpNo: TRzButtonEdit;
    edtCreater: TRzButtonEdit;
    cmbAudit: TRzComboBox;
    edtAudit: TRzButtonEdit;
    dtpBegin: TRzDateTimePicker;
    dtpEnd: TRzDateTimePicker;
    chkMultiSelect: TRzCheckBox;
    edtDepotID: TRzButtonEdit;
    edtGrup: TRzButtonEdit;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn1: TRzBitBtn;
    btnAll: TRzBitBtn;
    grdOverflow: TxDBGridEh;
    DCOM: TDCOMConnection;
    cdsOverflow: TckClientDataSet;
    DataSource: TDataSource;
    ActionList1: TActionList;
    ActQuery: TModlAction;
    ActReport: TModlAction;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    ActViewBill: TModlAction;
    ImageList1: TImageList;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure ActReportExecute(Sender: TObject);
    procedure edtEmpNoButtonClick(Sender: TObject);
    procedure edtCreaterButtonClick(Sender: TObject);
    procedure edtAuditButtonClick(Sender: TObject);
    procedure edtDepotIDButtonClick(Sender: TObject);
    procedure edtGrupButtonClick(Sender: TObject);
    procedure edtGoodsIDButtonClick(Sender: TObject);
    procedure SetFields1Click(Sender: TObject);
    procedure refresh1Click(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure ActViewBillExecute(Sender: TObject);
    procedure cmbAuditKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
    IFmMain: IMainForm;           
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
  public
    { Public declarations }
  end;

var
  FmOverflowQuery: TFmOverflowQuery;

implementation

uses ShowProgress, DBFuncs, SelectProvFrm, SelectBerthFrm, SelectDepartFrm, SelectGoodsFrm, SelectEmpFrm,
  FieldsLayoutFrm, SelectDepotFrm, INOutKindFm, DataExportFrm, RepSelectFrm;

{$R *.dfm}

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

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

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

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

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

procedure TFmOverflowQuery.ActQueryExecute(Sender: TObject);
var
  s, MStr, DStr: string;
  sTableNames: string;
begin
  MStr := ' and M.FDate >= ''' + FormatDateTime('yyyy-mm-dd', dtpBegin.date)
      + ''' and M.FDate <= ''' + FormatDateTime('yyyy-mm-dd', dtpEnd.Date) + '''';
  s := edtDepotID.Text;
  if  s <> '' then
    MStr := MStr + ' and M.DepotID = ' + IntToStr(edtDepotID.Tag);
  s := edtEmpNo.Text;
  if s <> '' then
    MStr := MStr + ' and M.EmpNo = ''' + s + '''';
  s := edtAudit.Text;
  if s <> '' then
    MStr := MStr + ' and M.Audit = ''' + s + '''';
  s := edtCreater.Text;
  if s <> '' then
    MStr := MStr + ' and M.Creater = ''' + s + '''';
  if edtGrup.Text <> '' then
    MStr := MStr + ' and M.Grup = ' + IntToStr(edtGrup.Tag);

  if cmbAudit.ItemIndex>0 then
    MStr := MStr + ' and M.Transfer='+IntToStr(cmbAudit.ItemIndex-1);

  s := edtBillNo1.Text;
  if s <> '' then
  begin
    if edtBillNo2.Text <> '' then
      MStr := MStr + ' and M.BillNo >= ''' + s + ''' and M.BillNo <= ''' + edtBillNo2.Text + ''''
    else
      MStr := MStr + ' and M.BillNo = ''' + s + '''';
  end;

  s := edtGoodsID.Text;
  if s <> '' then
  begin
    if AnsiPos(',', s) <> 0 then
      DStr := DStr + ' and GoodsID in(''' + AnsiReplaceText(s, ',', ''',''') + ''')'
    else
      DStr := DStr + ' and GoodsID Like ''' + s + '''';
  end;

  cdsOverflow.Close;
  cdsOverflow.Data := SvrCommon.AppServer.QueryBill(iClientID, 'Overflow', MStr, DStr);
  sTableNames := 'Overflow';
  SetFieldProperty(CdsFieldProPerty,cdsOverflow,sTableNames);
end;

procedure TFmOverflowQuery.ActReportExecute(Sender: TObject);
begin
  SelRepPrint(self.Name, [cdsOverflow], '报溢单查询', ActDesignReport.Enabled);
end;

procedure TFmOverflowQuery.edtEmpNoButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edtEmpNo.Text := sEmpNO;
end;

procedure TFmOverflowQuery.edtCreaterButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edtCreater.Text := sEmpNo;
end;

procedure TFmOverflowQuery.edtAuditButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edtAudit.Text := sEmpNo;
end;

procedure TFmOverflowQuery.edtDepotIDButtonClick(Sender: TObject);
var
  nDepotID: integer;
  sDepotNO, sDepotName: string;
begin
  nDepotID := 0;
  sDepotNO := '';
  sDepotName := '';
  if SelectDepot(nDepotID, sDepotNo, sDepotName) then
  begin
    edtDepotID.Tag := nDepotID;
    edtDepotID.Text := sDepotName;
  end;
end;

procedure TFmOverflowQuery.edtGrupButtonClick(Sender: TObject);
var iID: Integer;
    sNo, sName: String;
begin
  iID := 0;
  if SelectDepart(iID, sNo, sName) then
  begin
    edtGrup.Tag := iID;
    edtGrup.Text:= sNo;
  end;
end;

procedure TFmOverflowQuery.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;

procedure TFmOverflowQuery.SetFields1Click(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [grdOverflow], '报溢单查询');
end;

procedure TFmOverflowQuery.refresh1Click(Sender: TObject);
begin
  ExportData([cdsOverflow], '报溢单查询', '');
end;

procedure TFmOverflowQuery.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 TFmOverflowQuery.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [grdOverflow], '报溢单查询');
end;

procedure TFmOverflowQuery.ActDataExportExecute(Sender: TObject);
begin
  ExportData([cdsOverflow], '报溢单查询', '');
end;

procedure TFmOverflowQuery.ActViewBillExecute(Sender: TObject);
var Values: Variant;
    sBillNo, sBills: String;
    mark: TBookmark;
begin
  if cdsOverflow.IsEmpty then Exit;
  with cdsOverflow 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; //查询后的所有单据
  //'StockMain.bpl;TFmStockIn','ViewBill', values
  IFmMain.DoSome(ActViewBill.ModuleFile, 'ViewBill', Values);
  Values := NULL;
end;

procedure TFmOverflowQuery.cmbAuditKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   if Key=13 then
    ActQuery.Execute;
end;

initialization
  RegisterClass(TFmOverflowQuery);

finalization
  UnRegisterClass(TFmOverflowQuery);

end.