.#goodsesfm.pas.1.36

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

unit GoodsesFm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, RzButton, RzBorder, ExtCtrls, DB, DBClient, MConnect,
  Grids, DBGridEh, DbUtilsEh, EhLibCDS, ActnList, ComCtrls, RzSplit, RzPanel,
  ModuleAction, ImgList,xEhLibCtl, TFlatSpeedButtonUnit, RzRadChk, RzStatus,
  TFlatTabControlUnit,ckDBClient, Buttons, Menus, TFlatPanelUnit, Mask, RzEdit,
  xBaseFrm, iMainFrm, uDataTypes;

type
  TFmGoodses = class(TxBaseForm)
//  TFmGoodses = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Label1: TLabel;
    BtnNew: TRzBitBtn;
    BitBtn2: TRzBitBtn;
    BtnPrint: TRzBitBtn;
    BtnEdit: TRzBitBtn;
    BtnCopy: TRzBitBtn;
    BtnDel: TRzBitBtn;
    BtnFind: TRzBitBtn;
    edQuickSearch: TRzEdit;
    dsGoodses: TDataSource;
    DCom1: TDCOMConnection;
    ActionList1: TActionList;
    ActNew: TModlAction;
    ActModify: TModlAction;
    ActCopy: TModlAction;
    ActDel: TModlAction;
    ActQuery: TModlAction;
    RzSplitter1: TRzSplitter;
    cdsGoodsPrices: TckClientDataSet;
    dsGoodsPrices: TDataSource;
    RzBitBtn1: TRzBitBtn;
    Actrefresh: TModlAction;
    RzBitBtn3: TRzBitBtn;
    CkAllRecords: TRzCheckBox;
    ImageList1: TImageList;
    ActMore: TModlAction;
    ActPrint: TModlAction;
    ActExit: TModlAction;
    cdsGoodses: TckClientDataSet;
    RzSizePanel1: TRzSizePanel;
    Tab1: TFlatTabControl;
    Notebook1: TNotebook;
    Panel6: TPanel;
    RzBitBtn2: TRzBitBtn;
    dbgBatchRebate: TxDBGridEh;
    DsGoodsBatchRebate: TDataSource;
    cdsGoodsBatchRebate: TckClientDataSet;
    cdsGoodsBatchRebateGoodsID: TStringField;
    cdsGoodsBatchRebateBatMinQty: TBCDField;
    cdsGoodsBatchRebateBatMaxQty: TBCDField;
    cdsGoodsBatchRebateUNIT: TStringField;
    cdsGoodsBatchRebateRebate: TBCDField;
    cdsGoodsBatchRebateprice: TFloatField;
    cdsGoodsPricesGoodsId: TStringField;
    cdsGoodsPricesModeNo: TIntegerField;
    cdsGoodsPricesModeName: TStringField;
    cdsGoodsPricesPrice1: TFloatField;
    cdsGoodsPricesPrice2: TFloatField;
    dbgGoodses: TxDBGridEh;
    Timer1: TTimer;
    ckAutoViewPrice: TRzCheckBox;
    ActViewPrice: TModlAction;
    ActModifyPrice: TModlAction;
    ActViewPriceModes: TModlAction;
    RzBitBtn4: TRzBitBtn;
    RzBitBtn5: TRzBitBtn;
    ckViewPriceOnDbclick: TRzCheckBox;
    ptBkPanel: TFlatPanel;
    ptCaption: TRzMarqueeStatus;
    FlatPanel2: TPanel;
    BtnWhatIs: TFlatSpeedButton;
    BtnHelp: TFlatSpeedButton;
    FlatPanel3: TPanel;
    BtnPopMenu: TFlatSpeedButton;
    TopPopMenu: TPopupMenu;
    SetFields1: TMenuItem;
    refresh1: TMenuItem;
    ActFieldsLayout: TModlAction;
    ActDataExport: TModlAction;
    ActDesignReport: TModlAction;
    cdsTemp: TckClientDataSet;
    chkAutoMatch: TRzCheckBox;
    RzPanel1: TRzPanel;
    RzBitBtn6: TRzBitBtn;
    RzBitBtn7: TRzBitBtn;
    RzBitBtn8: TRzBitBtn;
    RzBitBtn9: TRzBitBtn;
    ActAddBatchRebate: TModlAction;
    ActEdtBatchRebate: TModlAction;
    ActDelBatchRebate: TModlAction;
    ActChkBatchRebate: TModlAction;
    cdsGoodsBatchRebateRetailAble: TBooleanField;
    chkAutoShowBatRebate: TRzCheckBox;
    ActViewBatchRebate: TModlAction;
    cdsGoodsesGoodsID: TStringField;
    cdsGoodsesEName: TStringField;
    cdsGoodsesAlias: TStringField;
    cdsGoodsesBarCode: TStringField;
    cdsGoodsesBarCode2: TStringField;
    cdsGoodsesPym: TStringField;
    cdsGoodsesSpecs: TStringField;
    cdsGoodsesDoseType: TStringField;
    cdsGoodsesMainKind: TIntegerField;
    cdsGoodsesKindNo: TStringField;
    cdsGoodsesKindName: TStringField;
    cdsGoodsesHypoKind: TStringField;
    cdsGoodsesABCKind: TStringField;
    cdsGoodsesUnit1: TStringField;
    cdsGoodsesUnit2: TStringField;
    cdsGoodsesConvRate1: TIntegerField;
    cdsGoodsesConvRate2: TIntegerField;
    cdsGoodsesCanSplit: TBooleanField;
    cdsGoodsesUsefullife: TBCDField;
    cdsGoodsesUsefulUnit: TStringField;
    cdsGoodsesWarnAhead: TIntegerField;
    cdsGoodsesTaxRate: TBCDField;
    cdsGoodsesPDCADDR: TStringField;
    cdsGoodsesMAKER: TStringField;
    cdsGoodsesMakerName: TStringField;
    cdsGoodsesBrand: TStringField;
    cdsGoodsesPassNo: TStringField;
    cdsGoodsesQuality: TStringField;
    cdsGoodsesStoreClaim: TStringField;
    cdsGoodsesGuise: TStringField;
    cdsGoodsesGMPProperty: TStringField;
    cdsGoodsesProvNo: TStringField;
    cdsGoodsesBaseBerthNo: TStringField;
    cdsGoodsesPurchMode: TSmallintField;
    cdsGoodsesMedicare: TBooleanField;
    cdsGoodsesSpecial: TBooleanField;
    cdsGoodsesGspCheckType: TSmallintField;
    cdsGoodsesGSPTypeName: TStringField;
    cdsGoodsesFlag: TStringField;
    cdsGoodsesRemark: TStringField;
    cdsGoodsesDataUsable: TBooleanField;
    cdsGoodsesGrade: TStringField;
    cdsGoodsesMidPackQty: TIntegerField;
    cdsGoodsesBigPackQty: TIntegerField;
    cdsGoodsesBidVariety: TBooleanField;
    cdsGoodsesClarityCheck: TBooleanField;
    cdsGoodsesNewGoods: TBooleanField;
    cdsGoodsesBuyerEmpNo: TStringField;
    cdsGoodsesBuyerName: TStringField;
    cdsGoodsesPchCycle: TIntegerField;
    cdsGoodsesPchMinQty: TBCDField;
    cdsGoodsesPchMultiple: TIntegerField;
    cdsGoodsesPausePurch: TBooleanField;
    cdsGoodsesSellerEmpNo: TStringField;
    cdsGoodsesSellerName: TStringField;
    cdsGoodsesSellBatchQty: TBCDField;
    cdsGoodsesPauseSell: TBooleanField;
    cdsGoodsesMinStock: TBCDField;
    cdsGoodsesMaxStock: TBCDField;
    cdsGoodsesCreater: TStringField;
    cdsGoodsesCreatTime: TDateTimeField;
    cdsGoodsesMarkUp: TBooleanField;
    cdsGoodsesMender: TStringField;
    cdsGoodsesUpdateTime: TDateTimeField;
    cdsGoodsesGrup: TIntegerField;
    RzBitBtn10: TRzBitBtn;
    cdsGoodsesConvRate: TStringField;
    cdsGoodsesName: TStringField;
    dbgGoodsPrices: TxDBGridEh;
    mnAutoPinYin: TMenuItem;
    procedure ActNewExecute(Sender: TObject);
    procedure ActModifyExecute(Sender: TObject);
    procedure ActDelExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ActrefreshExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ActExitExecute(Sender: TObject);
    procedure ActPrintExecute(Sender: TObject);
    procedure ActQueryExecute(Sender: TObject);
    procedure cdsGoodsesBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure cdsGoodsesAfterOpen(DataSet: TDataSet);
    procedure cdsGoodsesBeforeOpen(DataSet: TDataSet);
    procedure ActMoreExecute(Sender: TObject);
    procedure Tab1TabChanged(Sender: TObject);
    procedure cdsGoodsesReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure CdsGoodsesPurchModeGetText(Sender: TField; var Text: String;
      DisplayText: Boolean);
    procedure CdsGoodsesPurchModeSetText(Sender: TField;
      const Text: String);
    procedure cdsGoodsBatchRebateNewRecord(DataSet: TDataSet);
    procedure cdsGoodsesAfterGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure cdsGoodsPricesNewRecord(DataSet: TDataSet);
    procedure FormShow(Sender: TObject);
    procedure cdsGoodsesAfterScroll(DataSet: TDataSet);
    procedure ActViewPriceModesExecute(Sender: TObject);
    procedure ActViewPriceExecute(Sender: TObject);
    procedure ActModifyPriceExecute(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure cdsGoodsesCalcFields(DataSet: TDataSet);
    procedure Button1Click(Sender: TObject);
    procedure dbgGoodsesDblClick(Sender: TObject);
    procedure BtnPopMenuClick(Sender: TObject);
    procedure ActFieldsLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
    procedure cdsGoodsesNewRecord(DataSet: TDataSet);
    procedure ActCopyExecute(Sender: TObject);
    procedure cdsGoodsesUnit2Change(Sender: TField);
    procedure edQuickSearchChange(Sender: TObject);
    procedure edQuickSearchKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormActivate(Sender: TObject);
    procedure dbgGoodsesKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure ActAddBatchRebateExecute(Sender: TObject);
    procedure ActViewBatchRebateExecute(Sender: TObject);
    procedure ActEdtBatchRebateExecute(Sender: TObject);
    procedure ActDelBatchRebateExecute(Sender: TObject);
    procedure ActChkBatchRebateExecute(Sender: TObject);
    procedure cdsGoodsBatchRebateBeforeRefresh(DataSet: TDataSet);
    procedure cdsGoodsBatchRebatePostError(DataSet: TDataSet;
      E: EDatabaseError; var Action: TDataAction);
    procedure mnAutoPinYinClick(Sender: TObject);
  private
    IFmMain: IMainForm;
    PacketRecs: Integer;
    vOwnerData:Variant;
    bTrueEof:Boolean;
    LocSetting: PLocSetting;
    sUnitList, sDosetypeList, sHypoKinds: TStrings;
    CdsFieldProperty :TckClientDataSet;
    SvrGoodses,SvrCommon:TDispatchConnection;
    PublicMark:TBookMark;
    iClientID: integer;
  public
    { Public declarations }
  end;
Const
  sFieldProPerty='Select * From SysFieldProperty '+
        ' Where TableName In(''Goodses'',''GoodsBatchRebate'',''GoodsGspProperty'',''GoodsPrices'')';

var
  FmGoodses: TFmGoodses;

implementation

uses GoodsEdFm, PriceModelFm, GoodsKindsFm,RepSelectFrm,EditBatchRebateFrm,
  DBPopupForm, DataExportFrm, FieldsLayoutFrm, ceGlobal, ShowProGress,DbFuncs;

{$R *.dfm}
procedure TFmGoodses.FormCreate(Sender: TObject);
//var i: Dword;
begin
//  i := GetTickCount;
  sUnitList := TStringList.Create;
  sDosetypeList := TStringList.Create;
  sHypoKinds := TStringList.Create;
  CdsFieldProperty:=TCkClientDataSet.Create(Self);
  IFmMain := Application.MainForm as IMainForm;
  iClientID:=IFmMain.IFmMainEx.ClientID;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  SetGressHint('正在连接药品资料服务器...');
  SvrGoodses:=IFmMain.GetConnection(Handle,'','CKGoodsBase.DmGoodses');
  CdsGoodses.RemoteServer:=SvrGoodses;
  cdsGoodsPrices.RemoteServer:=SvrGoodses;
  cdsTemp.RemoteServer := SvrGoodses;
  CdsGoodsBatchRebate.RemoteServer:=SvrGoodses;
  SetGressHint('正在连接公用信息服务器...');
  SvrCommon:=iFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrCommon;
  SetGressHint('读取用户操作权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  SetGressHint('读取药品资料...');
  PacketRecs := LocSetting^.PacketRecs;
  CdsGoodses.PacketRecords := PacketRecs;
  CdsGoodses.Open;
  Tab1.ActiveTab :=0;
//  i := GetTickCount-i;
//  Caption := Caption+'('+IntToStr(i)+')';
end;

procedure TFmGoodses.FormShow(Sender: TObject);
Var sTableNames:String;
begin
  SetGressHint('初始化本地环境...');
  ptBkPanel.Color := TitlePanelColor;
  ptCaption.FillColor := TitlePanelColor;
  SetGridEhColor([dbgGoodses,dbgGoodsPrices,dbgBatchRebate]);
  LoadFieldsLayOut(LocSetting^.FieldLayoutCfgFile, Name,
                   [dbgGoodses,dbgGoodsPrices]);
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmGoodses.Xml');
  sTableNames:='Goodses';
  SetFieldProperty(CdsFieldProPerty,CdsGoodses,sTableNames);
  sTableNames:='GoodsPrices';
  SetFieldProperty(CdsFieldProPerty,cdsGoodsPrices,sTableNames);
  sTableNames:='GoodsBatchRebate';
  SetFieldProperty(CdsFieldProPerty,CdsGoodsBatchRebate,sTableNames);
  sTableNames:='GoodsGspProperty';
  SetFieldProperty(CdsFieldProPerty,CdsGoodsBatchRebate,sTableNames);
  GetInfoValues(cdsTemp, 'DoseType', sDoseTypeList);
  GetInfoValues(cdsTemp, 'Units', sUnitList);
  GetInfoValues(cdsTemp, 'HypoKind', sHypoKinds);
  FreeGressForm;
end;

procedure TFmGoodses.ActNewExecute(Sender: TObject);
begin
  Try
    cdsGoodses.Append;
    with TFmGoodsEd.Create(self) do begin
      SvrGoodsEd:=SvrGoodses;
      cmbUnit1.Items.Assign(sUnitList);
      cmbUnit2.Items.Assign(sUnitList);
      cmbDosetype.Items.Assign(sDosetypeList);
      cmbHypoKind.Items.Assign(sHypoKinds);
      ShowModal;
      Free;
    end;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmGoodses.ActCopyExecute(Sender: TObject);
begin
  Try
    CopyRecSelf(cdsGoodses, 'GoodsID', false);
    with TFmGoodsEd.Create(self) do begin
      SvrGoodsEd:=SvrGoodses;
      cmbUnit1.Items.Assign(sUnitList);
      cmbUnit2.Items.Assign(sUnitList);
      cmbDosetype.Items.Assign(sDosetypeList);
      cmbHypoKind.Items.Assign(sHypoKinds);
      ShowModal;
      Free;
    end;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmGoodses.ActModifyExecute(Sender: TObject);
begin
  Try
    if cdsGoodses.IsEmpty then Exit;
    cdsGoodses.Edit;
    with TFmGoodsEd.Create(self) do begin
      edGoodsID.ReadOnly := true;
      SvrGoodsEd:=SvrGoodses;
      iKindId:=CdsGoodses.FieldbyName('MainKind').asInteger;
      cmbUnit1.Items.Assign(sUnitList);
      cmbUnit2.Items.Assign(sUnitList);
      cmbDosetype.Items.Assign(sDosetypeList);
      cmbHypoKind.Items.Assign(sHypoKinds);
      ShowModal;
      Free;
    end;
  Except
    On E:Exception Do
      Messagebox(Handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmGoodses.ActDelExecute(Sender: TObject);
begin
  If CdsGoodses.IsEmpty Then Exit;
  If Application.MessageBox('确实要删除当前药品吗？','提示：',4+32)<>6 Then Exit;
  cdsGoodses.Delete;
  cdsGoodses.ApplyUpdates(0);
end;



procedure TFmGoodses.ActrefreshExecute(Sender: TObject);
Var iRecords,iTotal:Integer;
begin
  If CkAllRecords.Checked Then
  Begin
    vOwnerData:=Null;
    iRecords:=PacketRecs;
    iTotal:=CdsGoodses.RecordCount;
    CdsGoodses.PacketRecords:=iTotal;
    CdsGoodses.Active:=False;
    CdsGoodses.Active:=True;
    bTrueEof:=False;
    PacketRecs:=iRecords;
  End Else
    CdsGoodses.RefreshRecord;
end;

procedure TFmGoodses.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Inherited;