pricemodelfm.~pas

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

unit PriceModelFm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, RzButton, StdCtrls, Mask, RzEdit, Grids, DBGridEh, DbUtilsEh, EhLibCDS, ExtCtrls, DB,
  DBClient, ComCtrls, MConnect,xBaseFrm, ActnList, ModuleAction,iMainFrm,
  xEhLibCtl, RzPanel, ckDBClient;

type
  TFmPriceModes = class(TxBaseForm)
    CdsPriceModes: TckClientDataSet;
    DsPriceodes: TDataSource;
    ActionList1: TActionList;
    ActNew: TModlAction;
    ActModify: TModlAction;
    ActSave: TModlAction;
    ActDel: TModlAction;
    ActClose: TModlAction;
    ActRefresh: TModlAction;
    Panel1: TRzPanel;
    Panel2: TPanel;
    BtnNew: TRzBitBtn;
    BtnDel: TRzBitBtn;
    BtnEdit: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    RzBitBtn3: TRzBitBtn;
    RzPanel1: TRzPanel;
    Label1: TLabel;
    Label2: TLabel;
    RzBitBtn1: TRzBitBtn;
    edModeName: TRzEdit;
    edModeID: TRzNumericEdit;
    Label3: TLabel;
    DCOMConnection1: TDCOMConnection;
    CdsPriceModesModeNo: TIntegerField;
    CdsPriceModesModeName: TStringField;
    CdsPriceModesDataUsable: TBooleanField;
    CdsPriceModesCreater: TStringField;
    CdsPriceModesCreatTime: TDateTimeField;
    CdsPriceModesMender: TStringField;
    CdsPriceModesUpdateTime: TDateTimeField;
    CdsPriceModesGrup: TIntegerField;
    CdsPriceModesRemark: TStringField;
    dbgPriceModes: TxDBGridEh;
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ActNewExecute(Sender: TObject);
    procedure ActModifyExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure ActDelExecute(Sender: TObject);
    procedure ActCloseExecute(Sender: TObject);
    procedure ActRefreshExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure CdsPriceModesReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
  private
    IFmMain:IMainForm;
    SvrGoodses{, SvrCommon}: TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
  public
    { Public declarations }
  end;

var
  FmPriceModes: TFmPriceModes;

implementation

uses ShowProgress, ceGlobal, DBFuncs;

{$R *.dfm}

Const
  sFieldProPerty='Select * From SysFieldProperty Where TableName=''PriceModes''';

procedure TFmPriceModes.FormCreate(Sender: TObject);
begin
  inherited;
  Panel1.BorderColor := Color;
  IFmMain := Application.MainForm as IMainForm;
  SetGressHint('正在连接药品资料服务器...');
  CdsFieldProperty := TckClientDataSet.Create(Self);
  SvrGoodses:=IFmMain.GetConnection(Handle,'','CKGoodsBase.DmGoodses');
  cdsPriceModes.RemoteServer:=SvrGoodses;
  cdsPriceModes.Open;

  CdsFieldProPerty.RemoteServer:=SvrGoodses;
  CdsFieldProPerty.ProviderName:='dspPublic';
end;

procedure TFmPriceModes.FormShow(Sender: TObject);
var
  sTableNames: String;
begin
  Inherited;
  SetGressHint('初始化本地设置...');
  IFmMain.SetActionStatus(ActionList1, hInstance, ClassName);
  SetGridEhColor([dbgPriceModes]);
  FreeGressForm;

  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFmPriceModes.Xml');
  sTableNames := 'PriceModes';
  SetFieldProperty(CdsFieldProPerty,cdsPriceModes,sTableNames);
end;

procedure TFmPriceModes.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Inherited;
  Action:=CaFree;
end;

procedure TFmPriceModes.RzBitBtn2Click(Sender: TObject);
begin
  Close;
end;

procedure TFmPriceModes.ActNewExecute(Sender: TObject);
var i: integer;
begin
  edModeId.ReadOnly:=False;
  edModeName.ReadOnly:=False;
  CdsPriceModes.Last;
  i := cdsPriceModesModeNo.Value;
  if i<100 then i:=100;
  CdsPriceModes.Append;
  edModeId.IntValue := i+1;
  edModeName.Text:='';
  edModeId.SetFocus;
end;

procedure TFmPriceModes.ActModifyExecute(Sender: TObject);
begin
  If cdsPriceModes.IsEmpty or (cdsPriceModesModeNo.Value<100) Then Exit;
  edModeId.ReadOnly:=False;
  edModeName.ReadOnly:=False;
  edModeId.IntValue:=cdsPriceModes.fieldbyname('ModeNo').AsInteger;
  edModeName.Text:=cdsPriceModes.fieldbyname('ModeName').AsString;
  cdsPriceModes.Edit;
  edModeId.SetFocus;
end;

procedure TFmPriceModes.ActSaveExecute(Sender: TObject);
begin
  Try
    If edModeId.ReadOnly Then exit;
    If (edModeId.Text='') Or (edModeName.Text='') Then
    Begin
      Messagebox(Handle,'价格体系代码和名称不能为空！','',64);
      edModeID.SetFocus;
      Exit;
    End;
    If CdsPriceModes.State in [DsInsert,DsEdit] then
    Begin
      CdsPriceModes.FieldByName('ModeNo').AsInteger:=edModeId.IntValue;
      CdsPriceModes.FieldByName('ModeName').AsString:=edModeName.Text;
      If CdsPriceModes.ApplyUpdates(0)>0 Then
      Begin
        Messagebox(Handle,'提交数据失败！','',16);
        CdsPriceModes.Edit;
        Exit;
      End Else Begin
        CdsPriceModes.RefreshRecord;
        edModeId.ReadOnly:=True;
        edModeName.ReadOnly:=True;
      End;
    End;
  Except
    On E:Exception Do
      Messagebox(handle,Pchar(E.Message),'',16);
  End;
end;

procedure TFmPriceModes.ActDelExecute(Sender: TObject);
Var
  iModeNo:Integer;
  LogText,Str:String;
begin
  If CdsPriceModes.IsEmpty Then Exit;
  If Application.MessageBox('确实要删除当前的价格体系吗？','提示',4+32)<>6 Then Exit;
  Try
    iModeNo:=CdsPriceModes.fieldbyname('ModeNo').Value;
    Str:='Delete From PriceModes Where ModeNo='''+InttoStr(iModeNo)+'''';
    CdsPriceModes.RemoteServer.AppServer.DelRecord(IFmMain.IFmMainEx.ClientID,Str,LogText);
  Except
    If LogText<>'' Then
      Messagebox(Handle,'提交数据失败!','',16)
    Else Begin
      CdsPriceModes.Refresh;
    End;
End;
end;


procedure TFmPriceModes.ActCloseExecute(Sender: TObject);
begin
  Close;
end;

procedure TFmPriceModes.ActRefreshExecute(Sender: TObject);
begin
  CdsPriceModes.Active:=False;
  CdsPriceModes.Open;
end;

procedure TFmPriceModes.FormResize(Sender: TObject);
begin
  {Panel1.Left := (Width-Constraints.MinWidth) div 2;
  Panel1.Top  := (Height-Constraints.MinHeight) div 2;}
  Panel1.Left := (ClientWidth - Panel1.Width) div 2;
  Panel1.Top := (ClientHeight - Panel1.Height) div 2;
end;

procedure TFmPriceModes.CdsPriceModesReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Messagebox(Handle,Pchar(E.Message),'',16);
  Action := RaAbort;
end;

initialization
  RegisterClass(TFmPriceModes);

finalization
  UnRegisterClass(TFmPriceModes);

end.