.#goodspriceadjustfm.pas.1.8

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

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, Buttons, RzDBBnEd,
  ComCtrls, RzDTP, RzDBDTP, Mask, RzEdit, DBClient, MConnect, Menus, xEhLibCtl,
  ShowProgress, DB, DBFuncs, RzLstBox, RzChkLst, RzDBEdit, RzButton, RzLabel,
  SConnect, RzDBLbl, ckDBClient, xBaseFrm,IMainFrm, uDataTypes;

type
  TFmGoodsPriceAdjust = class(TceBaseBillForm)
    dbgGoodsPriceAdjust: 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;
    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 dbgGoodsPriceAdjustEditButtonClick(Sender: TObject);
    procedure CdsGoodsPriceAdjustdtlBeforePost(DataSet: TDataSet);
    procedure CdsGoodsPriceAdjustdtlAfterPost(DataSet: TDataSet);
    procedure ActPrintExecute(Sender: TObject);
  private
    bDtlAppend, bSelfCopying: Boolean;
    SvrGoodsPriceAdjust:TDispatchConnection;
    SvrGoodsBase:TDispatchConnection;

    SvrTable: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;

    sPriceModes:TStrings;
    iClientID, iLastItemNo:Integer;
    sBillNo:String;

    procedure BrowGoods;
  public
    { Public declarations }
  end;

var
  FmGoodsPriceAdjust: TFmGoodsPriceAdjust;

implementation

uses SelectGoodsFrm, RepSelectFrm, ceGlobal;

{$R *.dfm}

Const
  sFieldProperty = 'Select * from SysFieldProperty Where '
    + ' TableName= ''GoodsPriceAdjustDtl'' or tablename = ''Goodses'' or TableName = ''PriceModes''' ;

procedure TFmGoodsPriceAdjust.FormCreate(Sender: TObject);
begin
  SetGressHint('before inherited...');
  inherited;
  SetGressHint('after inherited...');
  MasterDataSet := cdsGoodsPriceAdjust;
  SetLength(FDetailDataSets, 1);
  FDetailDataSets[0] := cdsGoodsPriceAdjustDtl;
  RepDataSetNames := '调价单;调价明细';
  sRepSection := '商品调价单';
  sPriceModes:=TStringList.Create;
  SetGressHint('正在连接商品调价服务器...');
  SvrGoodsPriceAdjust:=IFmMain.GetConnection(Handle, '','CkGoodsPriceAdjustSvr.CKGoodsPriceAdjust');
  SetGressHint('正在连接商品资料服务器...');
  SvrGoodsBase:=IFmMain.GetConnection(Handle, '','CKGoodsBase.DmGoodses');
  CdsGoodsPriceAdjust.RemoteServer:=SvrGoodsPriceAdjust;

  CdsFieldProperty := TckClientDataset.Create(self);
  CdsFieldProPerty.RemoteServer:=SvrGoodsbase;
  CdsFieldProPerty.ProviderName:='DspPublic';

  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, sTableNames:String;
     A:Variant;
     k,i:Integer;
begin
  inherited;
  SetGridEhColor([dbgGoodsPriceAdjust]);
  //显示价格休系
  sPriceModes.Clear;
  clbPriceModes.Items.Clear;
//  Str:='Select ModeNo,ModeName From PriceModes Where DataUsable=1 Order By ModeNO ';
  Str:='Select ModeNo,ModeName From PriceModes Order By ModeNO ';
  A:=SvrGoodsBase.AppServer.GetNeedValue(iClientID,2,Str);
  If (Not VarIsNull(A)) And (VarIsArray(A)) Then
  Begin
    k := VarArrayHighBound(A,2);
    for i:=VarArrayLowBound(A,2) to k do
    Begin
      clbPriceModes.Items.Add({'['+A[0,i]+']'+}A[1,i]);
      sPriceModes.Add(A[0,i]);
    End;
  End;

  //如果TFmGoodsPriceAdjustDtl.Xml不存在，那么把cdsFieldProperty.CommandText := sFieldProperty得到的结果存入TFmGoodsPriceAdjustDtl.Xml
  //否则就从TFmGoodsPriceAdjustDtl.Xml中Load字段
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmGoodsPriceAdjustDtl.Xml');
  sTableNames := 'GoodsPriceAdjustDtl,Goodses,PriceModes';
  //根据字段名，依次设置字段的DisplayLabel
  ShowFieldDisp(CdsFieldProPerty, CdsGoodsPriceAdjustDtl, sTableNames);

  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;
  CdsGoodsPriceAdjustFDate.Value:=Date;
  CdsGoodsPriceAdjustApplyDate.Value:=Date;
  CdsGoodsPriceAdjustCreater.Value := LogonInfo^.UserID;
  CdsGoodsPriceAdjustGrup.Value := LogonInfo^.UserGrupID;
  cdsGoodsPriceAdjustGoodsCount.Value := 0;
end;

procedure TFmGoodsPriceAdjust.CdsGoodsPriceAdjustdtlBeforeInsert(
  DataSet: TDataSet);
begin
  if clbPriceModes.ItemsChecked=0 then
    raise Exception.Create('请先右上角的方框中选择要调价的价格体系！');
  iLastItemNo:=GetFieldMaxInt(CdsGoodsPriceAdjustdtl, 'ItemNo')+1;
  sBillNo:=CdsGoodsPriceAdjustBillNo.Value;
end;

procedure TFmGoodsPriceAdjust.CdsGoodsPriceAdjustdtlNewRecord(
  DataSet: TDataSet);
begin
  inherited;
  If iLastItemNo<>-1 Then
    CdsGoodsPriceAdjustdtlItemNo.Value:=iLastItemNo;
  CdsGoodsPriceAdjustdtlBillNo.Value:=sBillNo;
end;

procedure TFmGoodsPriceAdjust.ActAuditExecute(Sender: TObject);
begin
//
end;

procedure TFmGoodsPriceAdjust.ActRevertExecute(Sender: TObject);
begin
//
end;

procedure TFmGoodsPriceAdjust.ActAddSubItemExecute(Sender: TObject);
begin
  if cdsGoodsPriceAdjustDtl.State<>dsInsert then
    cdsGoodsPriceAdjustDtl.Append;
  BrowGoods;
end;

procedure TFmGoodsPriceAdjust.ActDelSubItemExecute(Sender: TObject);
begin
  cdsGoodsPriceAdjustDtl.Delete;
end;

procedure TFmGoodsPriceAdjust.cdsGoodsPriceAdjustAfterScroll(
  DataSet: TDataSet);
begin
  RefreshNavState;
end;

procedure TFmGoodsPriceAdjust.dbgGoodsPriceAdjustEditButtonClick(Sender: TObject);
begin
  if FEditMode=0 then Exit;
  if LowerCase(dbgGoodsPriceAdjust.SelectedField.FieldName)='goodsid' then begin
    BrowGoods;
  end;
end;

procedure TFmGoodsPriceAdjust.BrowGoods;
var i: Integer;
    bAppend: Boolean;
begin
  bAppend := cdsGoodsPriceAdjustDtl.State=dsInsert;
  if bAppend then
    i := cdsGoodsPriceAdjustDtl.RecordCount;
  SelectGoods(cdsGoodsPriceAdjustDtl, CdsGoodsPriceAdjustdtlGoodsID, nil, true, bAppend, true);
  if bAppend then
    cdsGoodsPriceAdjustDtl.RecNo := i+1;
end;

procedure TFmGoodsPriceAdjust.CdsGoodsPriceAdjustdtlBeforePost(
  DataSet: TDataSet);
var i, k: Integer;
begin
  if DataSet.FieldByName('GoodsID').IsNull then
    raise Exception.Create('请行输入或选择药品代码！');
  bDtlAppend := DataSet.State=dsInsert;
  if bDtlAppend and not bSelfCopying then begin
    k := clbPriceModes.Count;
    for i:=0 to k-1 do 
      if clbPriceModes.ItemChecked[i] then begin
        DataSet.FieldByName('ModeName').Value := clbPriceModes.Items[i];
        DataSet.FieldByName('PriceModeNo').Value:= sPriceModes[i];
        Break;
      end;
  end;
end;

procedure TFmGoodsPriceAdjust.CdsGoodsPriceAdjustdtlAfterPost(
  DataSet: TDataSet);
var sGoodsID, sName, sSpecs, sAbcKind, sPdcAddr, sMaker: String;
//    Bookmark: TBookmark;
    i, k, j: integer;
begin
  if bDtlAppend and not bSelfCopying then begin
    if clbPriceModes.ItemsChecked=1 then Exit;
    sGoodsID := DataSet.FieldByName('GoodsID').AsString;
    sName    := DataSet.FieldByName('Name').AsString;
    sSpecs   := DataSet.FieldByName('Specs').AsString;
    sAbcKind := DataSet.FieldByName('AbcKind').AsString;
    sPdcAddr := DataSet.FieldByName('PdcAddr').AsString;
    sMaker   := DataSet.FieldByName('Maker').AsString;
  //   := DataSet.FieldByName('').AsString;
    j := 0;
    k := clbPriceModes.Count;
    bSelfCopying := true;
    DataSet.DisableControls;
//    Bookmark := DataSet.GetBookmark;
    try
      for i:=0 to k-1 do begin
        if not clbPriceModes.ItemChecked[i] then Continue;
        Inc(j);
        if j=1 then Continue;
        with DataSet do begin
          Append;
          DataSet.FieldByName('PriceModeNo').Value:= sPriceModes[i];
          DataSet.FieldByName('ModeName').Value   := clbPriceModes.Items[i];
          DataSet.FieldByName('GoodsID').AsString := sGoodsID;
          DataSet.FieldByName('Name').AsString    := sName   ;
          DataSet.FieldByName('Specs').AsString   := sSpecs  ;
          DataSet.FieldByName('AbcKind').AsString := sAbcKind;
          DataSet.FieldByName('PdcAddr').AsString := sPdcAddr;
          DataSet.FieldByName('Maker').AsString   := sMaker  ;
          Post;
        end;
      end;
    finally
      bSelfCopying := false;
//      DataSet.GotoBookmark(Bookmark);
//      DataSet.FreeBookmark(Bookmark);
      dbgGoodsPriceAdjust.SetFocus;
      dbgGoodsPriceAdjust.SelectedIndex := dbgGoodsPriceAdjust.FieldColumns['NewPrice1'].Index;
      DataSet.EnableControls;
    end;
  end;
end;

procedure TFmGoodsPriceAdjust.ActPrintExecute(Sender: TObject);
begin
  inherited;
//  SelRepPrint(self.Name, [cdsGoodsPriceAdjust, cdsGoodsPriceAdjustDtl], '调价单;调价明细', nil);
end;

initialization
  RegisterClass(TFmGoodsPriceAdjust);
finalization
  UnRegisterClass(TFmGoodsPriceAdjust);

end.