stockoutqryfrm.~pas

来自「群星医药系统源码」· ~PAS 代码 · 共 417 行

unit StockOutQryFrm;

interface

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

type
  TFmStockOutQuery = 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;
    RzLabel18: TRzLabel;
    Label6: TLabel;
    Label13: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    Label8: TLabel;
    edtBillNo1: TRzEdit;
    edtBillNo2: TRzEdit;
    edtCustNo: TRzButtonEdit;
    edtGoodsID: TRzButtonEdit;
    edtEmpNo: TRzButtonEdit;
    edtCreater: TRzButtonEdit;
    cmbAudit: TRzComboBox;
    edtAudit: TRzButtonEdit;
    dtpBegin: TRzDateTimePicker;
    dtpEnd: TRzDateTimePicker;
    chkMultiSelect: TRzCheckBox;
    edtPBillNo: TRzEdit;
    edtDepotID: TRzButtonEdit;
    edtGrup: TRzButtonEdit;
    cmbInOutKind: TRzComboBox;
    btnReport: TRzBitBtn;
    btnQuery: TRzBitBtn;
    btnAll: TRzBitBtn;
    grdStockOut: TxDBGridEh;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ActionList1: TActionList;
    ActQuery: TModlAction;
    ActReport: TModlAction;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    ActViewBill: TModlAction;
    ImageList1: TImageList;
    DataSource: TDataSource;
    cdsStockOut: TckClientDataSet;
    Label12: TLabel;
    edtShipper: TRzButtonEdit;
    cdsInOutKind: TckClientDataSet;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edtCustNoButtonClick(Sender: TObject);
    procedure edtDepotIDButtonClick(Sender: TObject);
    procedure edtEmpNoButtonClick(Sender: TObject);
    procedure edtAuditButtonClick(Sender: TObject);
    procedure edtShipperButtonClick(Sender: TObject);
    procedure edtCreaterButtonClick(Sender: TObject);
    procedure edtGrupButtonClick(Sender: TObject);
    procedure edtGoodsIDButtonClick(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure ActReportExecute(Sender: TObject);
    procedure ActViewBillExecute(Sender: TObject);
    procedure dtpBeginKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
  private
    { Private declarations }
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrStock, SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
    procedure GetInOutKind;
  public
    { Public declarations }
  end;

var
  FmStockOutQuery: TFmStockOutQuery;

implementation

uses SelectGoodsFrm, SelectEmpFrm, SelectDepotFrm, SelectCustFrm, SelectDepartFrm,
  FieldsLayoutFrm, DataExportFrm;

{$R *.dfm}

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

procedure  TFmStockOutQuery.FormCreate(Sender: TObject);
var SystemTime: TSystemTime;
begin
  inherited;
  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');
  cdsStockOut.RemoteServer := SvrCommon;
  cdsInOutKind.RemoteServer := SvrCommon;
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  CdsFieldProPerty.ProviderName:='DspTemp';
end;

procedure TFmStockOutQuery.FormShow(Sender: TObject);
var sTableNames: string;
begin
  SetGressHint('初始化本地环境...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmStockOut.Xml');
  sTableNames:='StockOut';
  SetFieldProperty(CdsFieldProPerty,cdsStockOut,sTableNames);
  SetGridEhColor([grdStockOut]);
  ptBkPanel.Color := TitlePanelColor;
  GetInOutKind;
  FreeGressForm;
  inherited;
end;

procedure TFmStockOutQuery.edtCustNoButtonClick(Sender: TObject);
var
  sCustNo, sCustName: string;
begin
  sCustNo := '';
  sCustName := '';
  if SelectCust(sCustNo, sCustName) then
    edtCustNo.Text := sCustNo;
end;

procedure TFmStockOutQuery.edtDepotIDButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sDepotNo, sDepotName: string;
begin
  iDepotID := 0;
  sDepotNo := '';
  sDepotName := '';
  if SelectDepot(iDepotID, sDepotNo, sDepotName) then
  Begin
    edtDepotID.Tag := iDepotID;
    edtDepotID.Text := sDepotNo + '(' + sDepotName + ')';
  end;
end;

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

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

procedure TFmStockOutQuery.edtShipperButtonClick(Sender: TObject);
var
  sEmpNO, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edtShipper.Text := sEmpNo;
end;

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

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

procedure TFmStockOutQuery.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 TFmStockOutQuery.ActQueryExecute(Sender: TObject);
var
  MStr, DStr, s, c, fld: string;
  sTableNames: string;
  n: integer;
begin
  Mstr := ' and M.FDate >= ''' + FormatDateTime('yyyy-mm-dd', dtpBegin.Date) + '''';
  MStr := MStr + ' and M.FDate <= ''' + FormatDateTime('yyyy-mm-dd', dtpEnd.Date) + '''';
  s := edtCustNo.Text;
  if s <> '' then
    MStr := MStr + ' and M.CustNo = ''' + s + '''';
  s := edtDepotID.Text;
  if s <> '' then
    MStr := MStr + ' and M.DepotID = ' + IntToStr(edtDepotID.Tag);
  s := cmbInOutKind.Text;
  if s <> '' then
  begin
    n := AnsiPos('-', s);
    if n > 0 then
      s := copy(cmbInOutKind.Text, 1, n - 2)
    else
      s := cmbInOutKind.Text;
    try
      n := StrToInt(s);
    except
      Application.MessageBox('出库方式无效！请检验[出库方式]！','警告',MB_OK+MB_ICONINFORMATION);
      exit;
    end;
    MStr := MStr + ' and M.InOutKind = ' + s;
  end;
  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 := edtPBillNo.Text;
  if s <> '' then
    MStr := MStr + ' and M.PBillNo = ''' + s + '''';
  s := edtShipper.Text;
  if s <> '' then
    MStr := MStr + ' and M.Shipper = ''' + s + '''';
  s := edtCreater.Text;
  if s <> '' then
    MStr := MStr + ' and M.Creater = ''' + s + '''';
  s := edtGrup.Text;
  if s <> '' then
    MStr := MStr + ' and M.Grup = ' + IntToStr(edtGrup.Tag);
  if cmbAudit.ItemIndex = 1 then
    MStr := MStr + ' and M.Transfer IS NULL '
  else
    MStr := MStr + ' and M.Transfer IS NOT NULL ';
  s := cmbInOutKind.Text;
  if s <> '' then
  begin
    n := AnsiPos('-', s);
    if n > 0 then
      s := copy(cmbInOutKind.Text, 1, n - 2)
    else
      s := cmbInOutKind.Text;
    MStr := MStr + ' and M.InOutKind = ' + s;
  end;
  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 := ' and GoodsID in(''' + AnsiReplaceText(s, ',', ''',''') + ''')'
    else
      DStr := DStr + ' and D.GoodsID like ''' + s + '''';
  end;

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

procedure TFmStockOutQuery.GetInOutKind;
var
  i: integer;
begin
  cdsInOutKind.Data := SvrCommon.AppServer.GetInOutKind(iClientID, '1');
  if cdsInOutKind.IsEmpty then exit;
  cdsInOutKind.first;
  for i:=0 to cdsInOutKind.RecordCount - 1 do
  begin
    cmbInOutKind.Items.Add(cdsInOutKind.fieldbyname('KindID').AsString
      + ' - ' + cdsInOutKind.fieldbyname('KindName').AsString);
    next;
  end;
  cdsInOutKind.Close;
end;

procedure TFmStockOutQuery.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 TFmStockOutQuery.ActReportExecute(Sender: TObject);
begin
  SelRepPrint(self.Name, [cdsStockOut], '出库单查询', ActDesignReport.Enabled);
end;

procedure TFmStockOutQuery.ActViewBillExecute(Sender: TObject);
var Values: Variant;
    sBillNo, sBills: String;
    mark: TBookmark;
begin
  if cdsStockOut.IsEmpty then Exit;
  with cdsStockOut 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 TFmStockOutQuery.dtpBeginKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key = 13 then
    actQuery.Execute;
end;

procedure TFmStockOutQuery.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [grdStockOut], '出库单查询');
end;

procedure TFmStockOutQuery.ActDataExportExecute(Sender: TObject);
begin
  ExportData([cdsStockOut], '出库单查询', '');
end;

initialization
  RegisterClass(TFmStockOutQuery);

finalization
  UnRegisterClass(TFmStockOutQuery);

end.