inoutkindfm.pas

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

PAS
228
字号
unit INOutKindFm;

interface

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


type
  TFmInOutKind = class(TForm)
    Label1: TLabel;
    Lab_Caption: TLabel;
    Label5: TLabel;
    CdsInOutKind: TckClientDataSet;
    DsInOutKind: TDataSource;
    BtnSave: TRzBitBtn;
    BtnDel: TRzBitBtn;
    BtnEdit: TRzBitBtn;
    RzBitBtn2: TRzBitBtn;
    FlatButton2: TRzBitBtn;
    RzBitBtn1: TRzBitBtn;
    xDBGridEh1: TxDBGridEh;
    ActionList1: TActionList;
    Label2: TLabel;
    ActRefresh: TModlAction;
    ActNew: TModlAction;
    ActModify: TModlAction;
    ActDel: TModlAction;
    ActSave: TModlAction;
    ActExit: TModlAction;
    edName: TRzEdit;
    CdsInOutKindInOut: TIntegerField;
    CdsInOutKindKindID: TIntegerField;
    CdsInOutKindKindName: TStringField;
    edId: TRzNumericEdit;
    procedure ActRefreshExecute(Sender: TObject);
    procedure ActNewExecute(Sender: TObject);
    procedure BtnEditClick(Sender: TObject);
    procedure ActExitExecute(Sender: TObject);
    procedure ActSaveExecute(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure xDBGridEh1DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CdsInOutKindNewRecord(DataSet: TDataSet);
    procedure CdsInOutKindReconcileError(DataSet: TCustomClientDataSet;
      E: EReconcileError; UpdateKind: TUpdateKind;
      var Action: TReconcileAction);
    procedure ActDelExecute(Sender: TObject);
  private
    { Private declarations }
    iAppendIn:integer;
    SvrStock:TDispatchConnection;
  public
    { Public declarations }
    iKindNO:Integer;
  end;
  Function GetKindId(InOut,KindId:Integer;Var iAppendInOut:Integer):Integer;

var
  FmInOutKind: TFmInOutKind;

implementation

{$R *.dfm}
Function GetKindId(InOut:Integer;KindId:Integer;Var iAppendInOut:Integer):Integer;
Var
  B1:Boolean;
begin
  With TFmInOutKind.Create(Nil) Do
  Begin
    iAppendIn:=IAppendInOut;
    If InOut=0 then
    Begin
      CdsInOutKind.Filtered:=False;
      CdsInOutKind.Filter:='Inout=0 ';
      CdsInOutKind.Filtered:=True;
      Lab_Caption.Caption:='入库方式';
      Caption:='入库方式';
    End Else
    Begin
      CdsInOutKind.Filtered:=False;
      CdsInOutKind.Filter:='Inout=1 ';
      CdsInOutKind.Filtered:=True;
      Lab_Caption.Caption:='出库方式';
      Caption:='出库方式';
    End;
    B1:=ShowModal=MrOK;
    If B1 Then
    begin
      iAppendInOut:=iAppendIn;
      Result:=iKindNO;
      Free;
    End Else
      Exit;
  End;
End;

procedure TFmInOutKind.ActRefreshExecute(Sender: TObject);
begin
  CdsInOutKind.Active:=False;
  CdsInoutKind.Active:=True;
  edid.ReadOnly:=True;
  edname.ReadOnly:=True;
end;

procedure TFmInOutKind.ActNewExecute(Sender: TObject);
begin
  If CdsInOutKind.State In ([dsInsert,dsEdit]) Then
  Begin
    Application.MessageBox('现在已在编辑状态!','',64);
    Exit;
  End;
  CdsInOutKind.Append;
  edId.ReadOnly:=False;
  edName.ReadOnly:=False;
  edId.SetFocus; 
end;

procedure TFmInOutKind.BtnEditClick(Sender: TObject);
begin
  If CdsInOutKind.State In ([dsInsert,dsEdit]) Then
  Begin
    Application.MessageBox('现在已在编辑状态!','',64);
    Exit;
  End;
  CdsInOutKind.Edit;
  edId.ReadOnly:=False;
  edName.ReadOnly:=False;
  edId.SetFocus;
end;

procedure TFmInOutKind.ActExitExecute(Sender: TObject);
begin
  ModalResult:=MrOK;
end;

procedure TFmInOutKind.ActSaveExecute(Sender: TObject);
begin
  If Trim(Lab_Caption.Caption)='入库方式' Then
  Begin
    If edID.IntValue>=50 Then
    begin
      edID.SetFocus;
      Messagebox(Handle,'入库方式ID不能大于50!','',64);
      Exit;
    End;
  End Else
  begin
    If edID.IntValue<=50 Then
    begin
      Messagebox(Handle,'出库方式ID不能小于50!','',64);
      edId.SetFocus;
      Exit;
    End;
  End;
  If CdsInOutKind.State In ([DsInsert,dsEdit]) Then
  Begin
    CdsInOutKind.FieldByName('KindID').AsInteger:=edID.IntValue;
    CdsInOutKind.FieldByName('KindName').AsString:=edName.Text;
    If CdsInOutKind.ApplyUpdates(0)>0 Then
    begin
      Application.Messagebox('提交数据失败!','',64);
      Exit;
    End;
    iAppendIn:=1;
    edId.ReadOnly:=True;
    edName.ReadOnly:=True;
  End;
end;

procedure TFmInOutKind.FormCreate(Sender: TObject);
begin
  SvrStock:=(Application.MainForm As IMainForm).GetConnection(Handle,'','CkStockSvr.Stock');
  CdsInOutKind.RemoteServer:=SvrStock;
  CdsInOutKind.Open;
  iAppendIn:=0;
end;

procedure TFmInOutKind.xDBGridEh1DblClick(Sender: TObject);
begin
  iKindNO:=CdsInoutKind.FieldbyName('KindID').AsInteger;
  ModalResult:=MrOK;
end;

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

procedure TFmInOutKind.CdsInOutKindNewRecord(DataSet: TDataSet);
begin
  If Trim(Lab_Caption.Caption)='入库方式' Then
    CdsInOutKind.FieldByName('InOut').AsInteger:=0
  Else
    CdsInOutKind.FieldByName('InOut').AsInteger:=1;
end;

procedure TFmInOutKind.CdsInOutKindReconcileError(
  DataSet: TCustomClientDataSet; E: EReconcileError;
  UpdateKind: TUpdateKind; var Action: TReconcileAction);
begin
  Application.MessageBox(Pchar(E.Message),'',16);
  Action:=raAbort;
end;

procedure TFmInOutKind.ActDelExecute(Sender: TObject);
begin
  If CdsInOutKind.State In ([dsInsert,dsEdit]) Then
  Begin
    Application.MessageBox('当在在编辑状态,不能删除数据!','',64);
    Exit;
  End;
  CdsInOutKind.Delete;
  If CdsInOutKind.ApplyUpdates(0)>0 Then
  begin
    Application.MessageBox('删除数据失败!','',16);
    Exit;
  End;
  iAppendIn:=1;
  CdsInOutKind.RefreshRecord;
end;

End.

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?