goodspriceadjustfm.~pas

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

unit GoodsPriceAdjustFm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ceBaseBillFrm, ActnList, ModuleAction, ImgList, TB2Dock, ExtCtrls,
  RzPanel, TB2Item, TB2Toolbar, StdCtrls, Grids, DBGridEh, DbUtilsEh, EhLibCDS,
  xEhLibCtl, Buttons, RzDBBnEd, ComCtrls, RzDTP, RzDBDTP, Mask, RzEdit, DBClient,
  MConnect, Menus, RzRadChk, DB, DBFuncs, RzLstBox, RzChkLst, RzDBEdit, RzButton,
  RzLabel, RzDBChk, SConnect, RzDBLbl,
  xBaseFrm,IMainFrm, ckDBClient, uDataTypes, ceGlobal;

type
  TFmGoodsPriceAdjust = class(TceBaseBillForm)
    dbgGoodsPriceAdjustDtl: TxDBGridEh;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    RzDBEdit1: TRzDBEdit;
    edBillNo: TRzDBEdit;
    RzDBEdit5: TRzDBEdit;
    RzDBEdit7: TRzDBEdit;
    RzDBButtonEdit1: TRzDBButtonEdit;
    clbPriceModes: TRzCheckList;
    Label9: TLabel;
    DComConn: TDCOMConnection;
    cdsGoodsPriceAdjust: TckClientDataSet;
    DsGoodsPriceAdjust: TDataSource;
    CdsGoodsPriceAdjustdtl: TckClientDataSet;
    DsGoodsPriceAdjustdtl: TDataSource;
    cdsGoodsPriceAdjustBillNo: TStringField;
    cdsGoodsPriceAdjustFDate: TDateTimeField;
    cdsGoodsPriceAdjustApplyDate: TDateTimeField;
    cdsGoodsPriceAdjustEmpNo: TStringField;
    cdsGoodsPriceAdjustAudit: TStringField;
    cdsGoodsPriceAdjustGoodsCount: TIntegerField;
    cdsGoodsPriceAdjustRemark: TStringField;
    cdsGoodsPriceAdjustTransfer: TBooleanField;
    cdsGoodsPriceAdjustCreater: TStringField;
    cdsGoodsPriceAdjustCreatTime: TDateTimeField;
    cdsGoodsPriceAdjustMender: TStringField;
    cdsGoodsPriceAdjustUpdateTime: TDateTimeField;
    cdsGoodsPriceAdjustGrup: TIntegerField;
    cdsGoodsPriceAdjustAdsGoodsPriceAdjustDtl: TDataSetField;
    CdsGoodsPriceAdjustdtlBillNo: TStringField;
    CdsGoodsPriceAdjustdtlItemNo: TIntegerField;
    CdsGoodsPriceAdjustdtlGoodsID: TStringField;
    CdsGoodsPriceAdjustdtlOldPrice1: TBCDField;
    CdsGoodsPriceAdjustdtlOldPrice2: TBCDField;
    CdsGoodsPriceAdjustdtlNewPrice1: TBCDField;
    CdsGoodsPriceAdjustdtlNewPrice2: TBCDField;
    CdsGoodsPriceAdjustdtlRemark: TStringField;
    RzDBDateTimePicker1: TRzDBDateTimePicker;
    RzDBDateTimePicker2: TRzDBDateTimePicker;
    Label8: TLabel;
    RzDBEdit2: TRzDBEdit;
    CdsGoodsPriceAdjustdtlName: TStringField;
    CdsGoodsPriceAdjustdtlSpecs: TStringField;
    CdsGoodsPriceAdjustdtlAbcKind: TStringField;
    CdsGoodsPriceAdjustdtlPdcAddr: TStringField;
    CdsGoodsPriceAdjustdtlMaker: TStringField;
    CdsGoodsPriceAdjustdtlModeName: TStringField;
    CdsGoodsPriceAdjustdtlPriceModeNo: TIntegerField;
    RzLabel7: TRzLabel;
    RzDBLabel1: TRzDBLabel;
    RzLabel16: TRzLabel;
    RzDBLabel2: TRzDBLabel;
    cdsGoodsPriceAdjustExecuted: TBooleanField;
    RzDBCheckBox1: TRzDBCheckBox;
    cdsTemp: TckClientDataSet;
    procedure FormCreate(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure cdsGoodsPriceAdjustReconcileError(
      DataSet: TCustomClientDataSet; E: EReconcileError;
      UpdateKind: TUpdateKind; var Action: TReconcileAction);
    procedure cdsGoodsPriceAdjustNewRecord(DataSet: TDataSet);
    procedure CdsGoodsPriceAdjustdtlBeforeInsert(DataSet: TDataSet);
    procedure CdsGoodsPriceAdjustdtlNewRecord(DataSet: TDataSet);
    procedure ActAuditExecute(Sender: TObject);
    procedure ActRevertExecute(Sender: TObject);
    procedure ActAddSubItemExecute(Sender: TObject);
    procedure ActDelSubItemExecute(Sender: TObject);
    procedure cdsGoodsPriceAdjustAfterScroll(DataSet: TDataSet);
    procedure dbgGoodsPriceAdjustDtlEditButtonClick(Sender: TObject);
    procedure CdsGoodsPriceAdjustdtlBeforePost(DataSet: TDataSet);
    procedure CdsGoodsPriceAdjustdtlAfterPost(DataSet: TDataSet);
    procedure ActPrintExecute(Sender: TObject);
    procedure RzDBButtonEdit1ButtonClick(Sender: TObject);
    procedure CdsGoodsPriceAdjustdtlGoodsIDChange(Sender: TField);
    procedure ActFieldLayoutExecute(Sender: TObject);
    procedure ActDataExportExecute(Sender: TObject);
  private
    CanAudit, CanRevert, bBrowGoods, bDtlAppend, bSelfCopying: Boolean;
    SvrGoodsPriceAdjust, SvrCommon: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;

    LocSetting: PLocSetting;
    sBillNo: String;
    BeforeGoodsID, FlagGoodsID: String;
    sPriceModes: TStrings;
    iClientID, iLastItemNo: Integer;

    procedure BrowGoods;
  public
    { Public declarations }
  end;

var
  FmGoodsPriceAdjust: TFmGoodsPriceAdjust;

implementation

uses ShowProgress, SelectGoodsFrm, RepSelectFrm, SelectEmpFrm,
  DataExportFrm, FieldsLayoutFrm;

{$R *.dfm}

Const
  sFieldProperty = 'Select * from SysFieldProperty Where '
    + ' TableName in (''GoodsPriceAdjust'', ''GoodsPriceAdjustDtl'', ''Goodses'')' ;

procedure TFmGoodsPriceAdjust.FormCreate(Sender: TObject);
begin
  inherited;
  LocSetting := IFmMain.IFmMainEx.GetLocSetting;
  MasterDataSet := cdsGoodsPriceAdjust;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsGoodsPriceAdjustDtl;
  RepDataSetNames := '调价单;调价明细';
  sRepSection := '商品调价单';
  sPriceModes:=TStringList.Create;
  SetGressHint('正在连接商品调价服务器...');
  CanAudit := ActAudit.Enabled;
  CanRevert:= ActCancel.Enabled;
  SvrGoodsPriceAdjust:=IFmMain.GetConnection(Handle, '','CkGoodsPriceAdjustSvr.CKGoodsPriceAdjust');
  SetGressHint('正在连接商品资料服务器...');
  SvrCommon := IFmMain.GetConnection(Handle, '','CommonSvr.CommonRDM');
  CdsGoodsPriceAdjust.RemoteServer:=SvrGoodsPriceAdjust;

  CdsFieldProperty := TckClientDataset.Create(self);
  CdsFieldProPerty.RemoteServer := SvrCommon;
  CdsFieldProPerty.ProviderName := 'DspCommon';
  cdsTemp.RemoteServer := SvrCommon;
  cdsTemp.ProviderName := 'DspCommon';

  SetGressHint('正在读取用户权限...');
  IFmMain.SetActionStatus(ActionList1, hInstance, self.ClassName);
  iClientID:=IFmMain.IFmMainEx.ClientID;
  sBillNoList.Text := SvrGoodsPriceAdjust.AppServer.GetCurrMonthBills(iClientID, 'GoodsPriceAdjust');
  ActAddSubItem.Enabled := ActBillDetail.Enabled;
  ActDelSubItem.Enabled := ActBillDetail.Enabled;
  MasterDataSet := CdsGoodsPriceAdjust;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsGoodsPriceAdjustDtl;
  RepDataSetNames := '药品调价单;药品调价明细';
end;

procedure TFmGoodsPriceAdjust.FormShow(Sender: TObject);
Var  Str:String;
     A:Variant;
     k,i:Integer;
begin
  inherited;
  SetGridEhColor([dbgGoodsPriceAdjustDtl]);
  //显示价格休系
//  Str:='Select ModeNo,ModeName From PriceModes Where DataUsable=1 Order By ModeNO ';
  str := 'Select ModeNo,ModeName From PriceModes M '
        +'  where exists(select 1 from VI_UserRealPriv U where U.UserID='''+IFmMain.IFmMainEx.LogonInfo^.UserID+''' and -U.ModuleID=M.ModeNo) '
        +'  Order By ModeNO ';
  sPriceModes.Clear;
  clbPriceModes.Items.Clear;
  with cdsTemp do
  begin
    Close;
    CommandText := str;
    Open;
    First;
    while not Eof do
    begin
      clbPriceModes.Items.Add(Fields[1].AsString);
      sPriceModes.Add(Fields[0].AsString);
      Next;
    end;
    Close;
  end;

  //如果*.Xml不存在，那么把cdsFieldProperty.CommandText := sFieldProperty得到的结果存入*.Xml
  //否则就从*.Xml中Load字段
  SysFieldXml(CdsFieldProPerty,sFieldProPerty, ClassName+'.Xml');
  SetFieldProperty(CdsFieldProPerty, CdsGoodsPriceAdjust, 'GoodsPriceAdjust');
  SetFieldProperty(CdsFieldProPerty, CdsGoodsPriceAdjustDtl, 'GoodsPriceAdjustDtl,Goodses');
  SetFieldProperty(CdsFieldProperty, CdsGoodsPriceAdjustDtl, 'Goodses');

  SetGressHint('正在读取历史单据...');
  SetCurrBillIdx(0);
  FreeGressForm;
end;

procedure TFmGoodsPriceAdjust.cdsGoodsPriceAdjustReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  inherited;
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmGoodsPriceAdjust.cdsGoodsPriceAdjustNewRecord(
  DataSet: TDataSet);
begin
  inherited;
  sBillNo := BuildBillNo('GoodsPriceAdjust');
  CdsGoodsPriceAdjustFDate.Value  := Date;