stockconfectqry.pas

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

PAS
362
字号
unit StockConfectQry;

interface

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

type
  TFmStockConfectQry = class(TxBaseForm)
    ImageList1: TImageList;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ActionList1: TActionList;
    ActQuery: TModlAction;
    ActReport: TModlAction;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    ActViewBill: TModlAction;
    DCOMConnection1: TDCOMConnection;
    cdsStockConfect: TckClientDataSet;
    dsStockConfect: TDataSource;
    ptBkPanel: TFlatPanel;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    RzSizePanel1: TRzSizePanel;
    RzGroupBox1: TRzGroupBox;
    RzBitBtn1: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    Label1: TLabel;
    Label3: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label13: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    ckMultiSelect: TRzCheckBox;
    Label15: TLabel;
    edBillNo2: TRzEdit;
    Label16: TLabel;
    Label17: TLabel;
    edFDate1: TRzDateTimePicker;
    edValidDate1: TRzDateTimePicker;
    edFDate2: TRzDateTimePicker;
    edValidDate2: TRzDateTimePicker;
    dbgStockConfect: TxDBGridEh;
    edDepotID: TRzButtonEdit;
    edBerthNo: TRzButtonEdit;
    edProvNo: TRzButtonEdit;
    edEmpNo: TRzButtonEdit;
    edBatchNo: TRzEdit;
    edBillNo1: TRzEdit;
    edUnit: TRzComboBox;
    edGoodsID: TRzButtonEdit;
    edCreater: TRzButtonEdit;
    edGrup: TRzButtonEdit;
    Label5: TLabel;
    Label8: TLabel;
    cbAudit: TRzComboBox;
    edAudit: TRzButtonEdit;
    Label7: TLabel;
    Label14: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure edDepotIDButtonClick(Sender: TObject);
    procedure edBerthNoButtonClick(Sender: TObject);
    procedure edEmpNoButtonClick(Sender: TObject);
    procedure edProvNoButtonClick(Sender: TObject);
    procedure edGoodsIDButtonClick(Sender: TObject);
    procedure ActReportExecute(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActViewBillExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure edAuditButtonClick(Sender: TObject);
    procedure edGrupButtonClick(Sender: TObject);
    procedure edCreaterButtonClick(Sender: TObject);
  private
    { Private declarations }
    IFmMain: IMainForm;
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
  public
    { Public declarations }
  end;

var
  FmStockConfectQry: TFmStockConfectQry;

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


implementation

uses SelectGoodsFrm,ceGlobal, ShowProGress, FieldsLayoutFrm, RepSelectFrm, DataExportFrm,
     SelectProvFrm,SelectEmpFrm,SelectDepartFrm,SelectPayMode,DBFuncs,SelectProvLinkManFrm,
     SelectBerthFrm,SelectDepotFrm;


{$R *.dfm}

procedure TFmStockConfectQry.FormCreate(Sender: TObject);
var SystemTime: TSystemTime;
begin
  CdsFieldProperty := TckClientDataSet.Create(Self);
  GetLocalTime(SystemTime);
  with SystemTime do
    edFDate1.Date := EncodeDate(wYear, wMonth, 1);
  edFDate2.Date := Date;
  edValidDate1.Date := edFDate1.Date;
  edValidDate2.Date := Date;
  IFmMain := Application.MainForm as IMainForm;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  iClientID := IFmMain.IFmMainEx.ClientID;
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon := IFmMain.GetConnection(Handle, '', 'CommonSvr.CommonRDM');

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

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

procedure TFmStockConfectQry.ActQueryExecute(Sender: TObject);
var s,swMst,swDtl,sTableNames:string;
begin
  swMst := swMst+' and FDate >= ''' + FormatDateTime('yyyy-mm-dd', edFDate1.date)
      + ''' and FDate <= ''' + FormatDateTime('yyyy-mm-dd', edFDate2.Date) + '''';
  if edValidDate1.Checked then
  begin
    if not edValidDate2.Checked then
      swMst := swMst+' and ValidDate='''+FormatDateTime('yyyy-mm-dd', edValidDate1.Date)+''''
    else
      swMst := swMst+' and ValidDate>='''+FormatDateTime('yyyy-mm-dd', edValidDate1.Date)
              +''' AND ValidDate<'''+FormatDateTime('yyyy-mm-dd', edValidDate2.Date+1)+'''';
  end;
  s := edBillNo1.Text;
  if s <> '' then
  begin
    if edBillNo2.Text <> '' then
      swMst := swMst + ' and BillNo >= ''' + s + ''' and BillNo <= ''' + edBillNo2.Text + ''''
    else
      swMst := swMst + ' and BillNo = ''' + s + '''';
  end;
  s := edDepotID.Text;
  if  s <> '' then
    swMst := swMst + ' and DepotID = ' + IntToStr(edDepotID.Tag);
  s:=edCreater.Text;
  if s<>'' then
    swMst:=swMst+' and Creater='''+s+'''';
  s:=edGrup.Text;
  if s<>'' then
    swMst:=swMst+' and Grup='+IntToStr(edGrup.tag);
  s := edBerthNo.Text;
  if  s <> '' then
    swMst := swMst + ' and BerthNo = ''' + s +'''';
  s := edUnit.Text;
  if  s <> '' then
    swMst := swMst + ' and Unit = ''' + s +'''';
  s := edEmpNo.Text;
  if s <> '' then
    swMst := swMst + ' and EmpNo = ''' + s + '''';
  s := edBatchNo.Text;
  if s <> '' then
    swMst := swMst + ' and BatchNo = ''' + s + '''';
  s := edProvNo.Text;
  if s <> '' then
    swMst := swMst + ' and ProvNo = ''' + s + '''';
  s := edAudit.Text;
  if s <>'' then
    swMst := swMst + ' and Audit = ''' + s + '''';
  if cbAudit.ItemIndex>0 then
    swMst := swMst + ' and Transfer='+IntToStr(cbAudit.ItemIndex-1);

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

  cdsStockConfect.Close;
  cdsStockConfect.Data := SvrCommon.AppServer.QueryBill(iClientID, 'StockConfect', swMst, swDtl);
  sTableNames := 'StockConfect';
  SetFieldProperty(CdsFieldProPerty,cdsStockConfect,sTableNames);
end;

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

procedure TFmStockConfectQry.edBerthNoButtonClick(Sender: TObject);
var iDepotID:integer;
    sBerthNo:string;
begin
  iDepotID:=edDepotID.Tag;
  if selectBerth(iDepotID,sBerthNo) then
    edBerthNo.Text:=sBerthNo;
end;

procedure TFmStockConfectQry.edEmpNoButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edEmpNo.Text := sEmpNo;
end;

procedure TFmStockConfectQry.edProvNoButtonClick(Sender: TObject);
var
  sProvNo, sProvName: string;
begin
  sProvNo := '';
  sProvName := '';
  if SelectProv(sProvNo, sProvName) then
    edProvNo.Text := sProvNo;
end;

procedure TFmStockConfectQry.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 TFmStockConfectQry.ActReportExecute(Sender: TObject);
begin
  SelRepPrint(self.Name, [cdsStockConfect], '药品组合加工单查询', ActDesignReport.Enabled);
end;

procedure TFmStockConfectQry.ActFieldsLayoutExecute(Sender: TObject);
begin
  SetFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name, [dbgStockConfect], '药品组合加工单查询');
end;

procedure TFmStockConfectQry.ActViewBillExecute(Sender: TObject);
var Values: Variant;
    sBillNo, sBills: String;
    mark: TBookmark;
begin
  if cdsStockConfect.IsEmpty then Exit;
  with cdsStockConfect 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 TFmStockConfectQry.ActDataExportExecute(Sender: TObject);
begin
  ExportData([cdsStockConfect], '药品组合加工单查询', '');
end;

procedure TFmStockConfectQry.edAuditButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edAudit.Text := sEmpNo;
end;

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

procedure TFmStockConfectQry.edCreaterButtonClick(Sender: TObject);
var
  sEmpNo, sEmpName: string;
begin
  sEmpNo := '';
  sEmpName := '';
  if SelectEmp(sEmpNo, sEmpName) then
    edCreater.Text := sEmpNo;
end;

initialization
  RegisterClass(TFmStockConfectQry);

finalization
  UnRegisterClass(TFmStockConfectQry);

end.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?