stocksinglecheckfrm.pas

来自「群星医药系统源码」· PAS 代码 · 共 629 行 · 第 1/2 页

unit StockSingleCheckFrm;

interface

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


type
  TFmStockSingleCheck = class(TxBaseForm)
    cdsStockSingleCheck: TckClientDataSet;
    DataSource1: TDataSource;
    DCOMConnection1: TDCOMConnection;
    ImageList1: TImageList;
    ActionList1: TActionList;
    ActInsert: TModlAction;
    ActUpdate: TModlAction;
    ActDelete: TModlAction;
    ActAudit: TModlAction;
    ActRevert: TModlAction;
    ActPrint: TModlAction;
    ActDesignReport: TModlAction;
    ActViewMoney: TModlAction;
    ActBillDetail: TModlAction;
    ActFieldLayout: TModlAction;
    ActDataExport: TModlAction;
    actQuery: TModlAction;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    RzSplitter1: TRzSplitter;
    RzPanel1: TRzPanel;
    chkDefDepot: TRzCheckBox;
    RzBitBtn1: TRzBitBtn;
    chkDefBerth: TRzCheckBox;
    chkDefGoods: TRzCheckBox;
    RzPanel2: TRzPanel;
    edDepotNo: TRzButtonEdit;
    edBerthNo: TRzButtonEdit;
    edGoodsID: TRzButtonEdit;
    edQty: TRzDBEdit;
    edBatchNo: TRzDBButtonEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    edGroupNo: TRzDBEdit;
    edFDate: TRzDBDateTimePicker;
    Label5: TLabel;
    RzBitBtn2: TRzBitBtn;
    Label6: TLabel;
    cbFilter: TRzComboBox;
    ptBkPanel: TFlatPanel;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    Bevel1: TBevel;
    edUnits: TRzDBComboBox;
    cdsStockSingleCheckItemNo: TAutoIncField;
    cdsStockSingleCheckFDATE: TDateTimeField;
    cdsStockSingleCheckDepotID: TIntegerField;
    cdsStockSingleCheckBerthNo: TStringField;
    cdsStockSingleCheckGoodsID: TStringField;
    cdsStockSingleCheckUnit: TStringField;
    cdsStockSingleCheckGroupNo: TIntegerField;
    cdsStockSingleCheckBatchNo: TStringField;
    cdsStockSingleCheckQty: TBCDField;
    cdsStockSingleCheckPosted: TBooleanField;
    cdsStockSingleCheckName: TStringField;
    cdsStockSingleCheckMaker: TStringField;
    cdsStockSingleCheckPDCAddr: TStringField;
    cdsStockSingleCheckSpecs: TStringField;
    btnSave: TRzBitBtn;
    btnCancel: TRzBitBtn;
    btnRefresh: TRzBitBtn;
    cdsStockSingleCheckDepotNo: TStringField;
    cdsStockSingleCheckDepotName: TStringField;
    Panel6: TRzPanel;
    dbgStockSingleCheck: TxDBGridEh;
    cdsPreview: TckClientDataSet;
    DataSource2: TDataSource;
    stPreview: TRzSizePanel;
    dbgPreview: TxDBGridEh;
    ActViewBill: TModlAction;
    RzBitBtn3: TRzBitBtn;
    btnPreview: TRzBitBtn;
    RzBitBtn4: TRzBitBtn;
    RzDBNavigator1: TRzDBNavigator;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure chkDefDepotClick(Sender: TObject);
    procedure chkDefBerthClick(Sender: TObject);
    procedure chkDefGoodsClick(Sender: TObject);
    procedure edDepotNoButtonClick(Sender: TObject);
    procedure edBerthNoButtonClick(Sender: TObject);
    procedure edGoodsIDButtonClick(Sender: TObject);
    procedure ActInsertExecute(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure btnRefreshClick(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure cdsStockSingleCheckBeforeDelete(DataSet: TDataSet);
    procedure cbFilterClick(Sender: TObject);
    procedure ActAuditExecute(Sender: TObject);
    procedure cdsStockSingleCheckBeforePost(DataSet: TDataSet);
    procedure cdsStockSingleCheckAfterCancel(DataSet: TDataSet);
    procedure cdsStockSingleCheckAfterPost(DataSet: TDataSet);
    procedure cdsStockSingleCheckAfterOpen(DataSet: TDataSet);
    procedure cdsStockSingleCheckBeforeInsert(DataSet: TDataSet);
    procedure edBatchNoButtonClick(Sender: TObject);
    procedure edDepotNoChange(Sender: TObject);
    procedure btnPreviewClick(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure cdsStockSingleCheckBeforeEdit(DataSet: TDataSet);
    procedure dbgStockSingleCheckEditButtonClick(Sender: TObject);
    procedure cdsStockSingleCheckGoodsIDChange(Sender: TField);
    procedure cdsStockSingleCheckAfterScroll(DataSet: TDataSet);
  private
    { Private declarations }
    FCanInsert: boolean;
    FCanAudit: boolean;
    FCanRevert: boolean;
    FHasUnAuditBills: boolean;
    cdsFieldProPerty: TckClientDataSet;
    LocSetting: PLocSetting;
    iClientID: Integer;
    SvrStockSingleCheck,SvrCommon:TDispatchConnection;
    IFmMain: IMainForm;
    procedure ResetColumnWidthForPreview;
  public
    { Public declarations }
  end;


Const
  sFieldProPerty='Select * From SysFieldProPerty '+
      ' Where TableName in(''StockSingleCheck'',''Goodses'',''Depots'')';
  sPreviewCmdText = 'EXEC PROC_StockSingleCheckPreview %d,%d,%d';
  
var
  FmStockSingleCheck: TFmStockSingleCheck;

implementation
uses  ceGlobal, ShowProgress, DbFuncs, FieldsLayoutFrm, RepSelectFrm,
      DataExportFrm, GetDepotAndBerthFrm, SelectGoodsFrm,
      SelectDepotFrm, SelectBerthFrm, SelectBatchNoFrm;
{$R *.dfm}

procedure TFmStockSingleCheck.FormCreate(Sender: TObject);
begin
  inherited;
  IFmMain := Application.MainForm as IMainForm;
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  cdsFieldProPerty:=TckClientDataSet.Create(Self);
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接仓库服务器...');
  iClientID:=IFmMain.IFmMainEx.ClientID;
  SvrStockSingleCheck:=IFmMain.GetConnection(Handle,'','CkStockSvr.Stock');
  cdsStockSingleCheck.RemoteServer := SvrStockSingleCheck;
  cdsPreview.RemoteServer := SvrStockSingleCheck;
  cdsPreview.ProviderName := 'DspPublic';
  SetGressHint('正在连接到公用信息服务器...');
  SvrCommon:=IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  cdsFieldProPerty.ProviderName:='DspTemp';
  cdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('正在读取用户操作权限...');
end;

procedure TFmStockSingleCheck.FormShow(Sender: TObject);
Var sTableNames:String;
begin
  SetGressHint('初始化本地环境...');
  SetGridEhColor([dbgStockSingleCheck,dbgPreview]);
  ptBkPanel.Color := TitlePanelColor;
  RzPanel1.Color := Color;
  stPreview.Color := color;
  RzDBNavigator1.Color := Color;
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmStockSingleCheck.Xml');
  SetFieldProperty(CdsFieldProPerty,cdsStockSingleCheck, 'StockSingleCheck,Goodses,Depots');
  inherited;
  FreeGressForm;
  cbFilterClick(nil);
end;

procedure TFmStockSingleCheck.FormActivate(Sender: TObject);
const
  bExecuted: boolean=false;
begin
  inherited;
  if not (CanFocus and Visible and Assigned(cdsPreview)and(cdsPreview.ProviderName <> '')) then exit;
  with cdsPreview do
  try
    close;
    CommandText := 'exec proc_AllStockCheckSurplusBillIsAudited';
    open;
    if IsEmpty then exit;
    FHasUnAuditBills := Fields[0].AsInteger > 0;
  finally
    Close;
  end;
  if bExecuted then exit;
  if FHasUnAuditBills then
  begin
    if MessageBox(Handle,'系统检查到还有未审核的盘点盈亏单。'#13'强烈建议你先审核所有盘点盈亏单再继续盘点！否则，系统将无法保证数据有效性。'#13'真的要继续进行不安全的盘点吗？','警告',MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2)=IDNO then
      Self.Close;
    bExecuted := true;
  end;
end;

procedure TFmStockSingleCheck.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  btnSave.Click;
end;

procedure TFmStockSingleCheck.FormDestroy(Sender: TObject);
begin
  cdsFieldProPerty.Free;
  inherited;
end;

procedure TFmStockSingleCheck.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 TFmStockSingleCheck.chkDefDepotClick(Sender: TObject);
begin
  if not chkDefDepot.Checked then
  begin
    edDepotNo.Text := '';   //如果取消使用默认值，则重置仓库编号
    edBerthNo.Text := '';
  end;
end;

procedure TFmStockSingleCheck.chkDefBerthClick(Sender: TObject);
begin
  if not chkDefBerth.Checked then
    edBerthNo.Text := '';   //如果取消使用默认值，则重置货位编号
end;

procedure TFmStockSingleCheck.chkDefGoodsClick(Sender: TObject);
begin
  if not chkDefGoods.Checked then
    edGoodsID.Text := '';   //如果取消使用黙认值，则重置药品编号
end;

procedure TFmStockSingleCheck.edDepotNoButtonClick(Sender: TObject);
var
  iDepotID: integer;
  sDepotNo, s: String;
begin
  iDepotID := edDepotNo.Tag;
  if (cdsStockSingleCheck.Active)and(iDepotID = 0) then
    iDepotID := cdsStockSingleCheckDepotID.Value;
  if SelectDepot(iDepotID, sDepotNo, s) then
  begin
    edDepotNo.Tag := iDepotID;
    edDepotNo.Text := sDepotNo;
    if cdsStockSingleCheck.State in dsEditModes then
    begin
      cdsStockSingleCheckDepotID.Value := iDepotID;
      cdsStockSingleCheckDepotNo.Value := sDepotNo;
    end;
  end;
end;

procedure TFmStockSingleCheck.edBerthNoButtonClick(Sender: TObject);
var
  sBerthNo: string;
  iDepotID: integer;
begin
  sBerthNo := edBerthNo.Text ;
  iDepotID := edDepotNo.Tag;
  if (cdsStockSingleCheck.Active)and(iDepotID = 0) then
    iDepotID := cdsStockSingleCheckDepotID.Value;
  if SelectBerth(iDepotID,sBerthNo) then
  begin
    edBerthNo.Text := sBerthNo;
    if cdsStockSingleCheck.State in dsEditModes then
      cdsStockSingleCheckBerthNo.Value := sBerthNo;
  end;
end;

procedure TFmStockSingleCheck.edGoodsIDButtonClick(Sender: TObject);
var
  A,B: TStrings;
  s1,s2: string;
begin
  A := TStringList.Create;
  B := TStringList.Create;
  try
    s1 := 'GoodsID'#13'Unit1'#13'Unit2';
    s2 := edGoodsID.Text;
    if SelectGoods(s1,s2) then
    begin
      A.Text := s1;
      B.Text := s2;
      edUnits.Clear;