firstdealgoodsfrm.pas

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

unit FirstDealGoodsFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ChainGSPBaseFrm, Menus, ActnList, ModuleAction, TB2Dock,
  ImgList, ExtCtrls, Buttons, RzButton, TB2Item, TB2Toolbar, DB, DBClient,
  MConnect, ckDBClient, StdCtrls, Mask, RzEdit, RzDBEdit, DBCtrls,
  ComCtrls, RzDTP, RzDBDTP, DbFuncs, RzDBBnEd;

type
  TFmFirstDealGoods = class(TFmChainGSPBase)
    cdsMainBillNo: TStringField;
    cdsMainDepartID: TIntegerField;
    cdsMainDepartName: TStringField;
    cdsMainFDate: TDateTimeField;
    cdsMainGoodsName: TStringField;
    cdsMainSpecs: TStringField;
    cdsMainDoseType: TStringField;
    cdsMainUnit: TStringField;
    cdsMainSuperior: TStringField;
    cdsMainBarCode: TStringField;
    cdsMainDescriptions: TStringField;
    cdsMainCertificate: TStringField;
    cdsMainRatifyNo: TStringField;
    cdsMainQualityNo: TStringField;
    cdsMainPackSpecs: TStringField;
    cdsMainUsefulLife: TBCDField;
    cdsMainStorageCondition: TStringField;
    cdsMainProducersTime: TStringField;
    cdsMainFactoryPrice: TBCDField;
    cdsMainFactPrice: TBCDField;
    cdsMainTradePrice: TBCDField;
    cdsMainDealCompany: TStringField;
    cdsMainLicenseNo: TStringField;
    cdsMainShopCard: TStringField;
    cdsMainConfirmDocument: TStringField;
    cdsMainBrand: TStringField;
    cdsMainRegCard: TStringField;
    cdsMainCheckReport: TStringField;
    cdsMainSamples: TStringField;
    cdsMainBatchNo: TStringField;
    cdsMainPackStatus: TStringField;
    cdsMainLabelStatus: TStringField;
    cdsMainExponent: TStringField;
    cdsMainApplyReason: TStringField;
    cdsMainBuyerNotion: TStringField;
    cdsMainBuyerResult: TStringField;
    cdsMainBuyerID: TStringField;
    cdsMainBuyer: TStringField;
    cdsMainOperationNotion: TStringField;
    cdsMainOperationResult: TStringField;
    cdsMainOperationID: TStringField;
    cdsMainOperation: TStringField;
    cdsMainQCNotion: TStringField;
    cdsMainQCResult: TStringField;
    cdsMainQCID: TStringField;
    cdsMainQC: TStringField;
    cdsMainPricerNotion: TStringField;
    cdsMainPricerResult: TStringField;
    cdsMainPricerID: TStringField;
    cdsMainPricer: TStringField;
    cdsMainManagerNotion: TStringField;
    cdsMainManagerResult: TStringField;
    cdsMainManagerID: TStringField;
    cdsMainManager: TStringField;
    cdsMainAudit: TBooleanField;
    cdsMainApprove: TBooleanField;
    Label1: TLabel;
    edBillNo: TRzDBEdit;
    edDepart: TRzDBButtonEdit;
    Label2: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    Label4: TLabel;
    RzDBEdit3: TRzDBEdit;
    Label5: TLabel;
    RzDBEdit4: TRzDBEdit;
    Label6: TLabel;
    RzDBEdit5: TRzDBEdit;
    Label7: TLabel;
    RzDBEdit6: TRzDBEdit;
    Label8: TLabel;
    Label9: TLabel;
    RzDBEdit7: TRzDBEdit;
    RzDBEdit8: TRzDBEdit;
    RzDBEdit9: TRzDBEdit;
    Label10: TLabel;
    Label11: TLabel;
    RzDBEdit10: TRzDBEdit;
    Label12: TLabel;
    RzDBEdit11: TRzDBEdit;
    Label13: TLabel;
    RzDBMemo1: TRzDBMemo;
    Label14: TLabel;
    RzDBEdit12: TRzDBEdit;
    RzDBEdit13: TRzDBEdit;
    Label15: TLabel;
    Label16: TLabel;
    RzDBEdit14: TRzDBEdit;
    Label17: TLabel;
    RzDBEdit15: TRzDBEdit;
    Label18: TLabel;
    RzDBEdit16: TRzDBEdit;
    RzDBEdit17: TRzDBEdit;
    Label19: TLabel;
    Label20: TLabel;
    RzDBEdit18: TRzDBEdit;
    RzDBEdit19: TRzDBEdit;
    Label21: TLabel;
    Label22: TLabel;
    RzDBEdit20: TRzDBEdit;
    Label23: TLabel;
    RzDBEdit21: TRzDBEdit;
    Label24: TLabel;
    RzDBEdit22: TRzDBEdit;
    RzDBEdit23: TRzDBEdit;
    Label25: TLabel;
    Label26: TLabel;
    RzDBEdit24: TRzDBEdit;
    RzDBEdit25: TRzDBEdit;
    Label27: TLabel;
    Label28: TLabel;
    RzDBEdit26: TRzDBEdit;
    Label29: TLabel;
    RzDBEdit27: TRzDBEdit;
    Label30: TLabel;
    RzDBEdit28: TRzDBEdit;
    RzDBEdit29: TRzDBEdit;
    Label31: TLabel;
    Label32: TLabel;
    RzDBEdit30: TRzDBEdit;
    Label33: TLabel;
    RzDBEdit31: TRzDBEdit;
    Label34: TLabel;
    RzDBEdit32: TRzDBEdit;
    Bevel2: TBevel;
    Label35: TLabel;
    RzDBEdit33: TRzDBEdit;
    Label36: TLabel;
    RzDBEdit34: TRzDBEdit;
    cdsMainCreater: TStringField;
    cdsMainCreaterName: TStringField;
    cdsMainCreatTime: TDateTimeField;
    cdsMainMender: TStringField;
    cdsMainMenderName: TStringField;
    cdsMainUpdateTime: TDateTimeField;
    cdsMainGrup: TIntegerField;
    cdsMainProvName: TStringField;
    ActShowAudited: TModlAction;
    mnuShowAudited: TMenuItem;
    cdsMainApprover: TStringField;
    cdsMainApproverName: TStringField;
    cdsMainApprovalDate: TDateTimeField;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure edDepartButtonClick(Sender: TObject);
    procedure cdsMainNewRecord(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActShowAuditedExecute(Sender: TObject);
    procedure ActUpdateExecute(Sender: TObject);
    procedure ActDeleteExecute(Sender: TObject);
    procedure cdsMainAfterOpen(DataSet: TDataSet);
    procedure cdsMainAfterScroll(DataSet: TDataSet);
    procedure cdsMainAfterRefresh(DataSet: TDataSet);
    procedure ActInsertExecute(Sender: TObject);
  private
    { Private declarations }
    procedure SetBillNoFontColor;
  public
    { Public declarations }
  end;

const
  sFieldProPerty='select * from SysFieldProperty ' +
                 'where TableName = ''Gsp_FirstDealGoodsInfo''';

var
  FmFirstDealGoods: TFmFirstDealGoods;

implementation
uses  ShowProgress, xBaseFrm, SelectDepartFrm;

{$R *.dfm}

procedure TFmFirstDealGoods.FormCreate(Sender: TObject);
begin
  inherited;
  RecState := rsDoNothing; //只显示未审核也未审批的记录
  svrMain := IFmMain.GetConnection(Handle,'','SvrChainGSP.CoChainGSP');
  cdsMain.RemoteServer := svrMain;
  cdsMain.ProviderName := 'dspFirstDealGoods';
end;

procedure TFmFirstDealGoods.FormShow(Sender: TObject);
begin
  inherited;
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmFirstDealGoods.Xml');
  SetFieldProperty(CdsFieldProPerty, cdsMain, 'Gsp_FirstDealGoodsInfo');
  SetGressHint('读取历史记录...');
  FreeGressForm;
  cdsMain.Params[0].AsInteger := Integer(RecState);
  cdsMain.Open;
end;

procedure TFmFirstDealGoods.edDepartButtonClick(Sender: TObject);
var
  iDepartID: integer;
  sDepartNo,sDepartName: string;
begin
  if EditMode=0 then exit;
  iDepartID := cdsMainDepartID.Value;
  if SelectDepart(iDepartID,sDepartNo,sDepartName) then
  begin
    cdsMainDepartName.Value := sDepartName;
    cdsMainDepartID.Value := iDepartID;
  end;
end;

procedure TFmFirstDealGoods.cdsMainNewRecord(DataSet: TDataSet);
begin
  inherited;
  cdsMainBillNo.Value := GetBillNo('Gsp_FirstDealGoodsInfo');
  cdsMainFDate.Value := Date;
end;

procedure TFmFirstDealGoods.ActAuditExecute(Sender: TObject);
begin
  inherited;
  CheckAudit(cdsMainAudit.Value);
  if MessageBox(Handle,'即将审核首营药品记录。审核之后将不能再修改数据。'#13'要继续吗？','警告',MB_ICONEXCLAMATION or MB_YESNO or MB_DEFBUTTON2)=IDNO then
    exit;
  EditMode := 1;
  cdsMain.Edit;
  cdsMainAudit.Value := true;
  ActSave.Execute;
  ActRefresh.Execute;
end;

procedure TFmFirstDealGoods.ActShowAuditedExecute(Sender: TObject);
begin
  CheckEditMode;
  if RecState = rsDoNothing then
    RecState := rsDoNothingAndAudited
  else
    RecState := rsDoNothing;
  ActShowAudited.Checked := (RecState = rsDoNothingAndAudited);
  with cdsMain do
  begin
    Params[0].AsInteger := Integer(RecState);
    if Active then Refresh else Open;
  end;
end;

procedure TFmFirstDealGoods.ActUpdateExecute(Sender: TObject);
begin
  CheckAudit(cdsMainAudit.Value);
  inherited;
end;

procedure TFmFirstDealGoods.ActDeleteExecute(Sender: TObject);
begin
  CheckAudit(cdsMainAudit.Value);
  inherited;
end;

procedure TFmFirstDealGoods.SetBillNoFontColor;
var
  c: TColor;
begin
  c := clWindowText;
  if cdsMainAudit.Value then
    c := clMaroon;
  if cdsMainApprove.Value then
    c := clRed;
  edBillNo.Font.Color := c;
end;

procedure TFmFirstDealGoods.cdsMainAfterOpen(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealGoods.cdsMainAfterScroll(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealGoods.cdsMainAfterRefresh(DataSet: TDataSet);
begin
  inherited;
  SetBillNoFontColor;
end;

procedure TFmFirstDealGoods.ActInsertExecute(Sender: TObject);
begin
  inherited;
  edDepart.SetFocus;
end;

initialization
  RegisterClass(TFmFirstDealGoods);

finalization
  UnRegisterClass(TFmFirstDealGoods);

end.