selectberthfrm.pas

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

unit SelectBerthFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, TFlatSpeedButtonUnit, ExtCtrls, RzStatus, TFlatPanelUnit,
  ActnList, ModuleAction, DB, DBClient, ckDBClient, MConnect, Grids,
  DBGridEh, DbUtilsEh, EhLibCDS, xEhLibCtl, StdCtrls, RzCmboBx, Mask, RzEdit, RzButton, ImgList,
  iMainFrm, DBCtrls, RzDBNav, RzPanel;

type
  TFrmSelectBerth = class(TForm)
    dbgSelectBerth: TxDBGridEh;
    Panel1: TPanel;
    Panel2: TPanel;
    DComm: TDCOMConnection;
    CdsSelectBerth: TckClientDataSet;
    DsSelectBerth: TDataSource;
    Label1: TLabel;
    edValue: TRzEdit;
    RzPanel3: TRzPanel;
    RzDBNavigator1: TRzDBNavigator;
    RzBitBtn2: TRzBitBtn;
    ImageList1: TImageList;
    RzBitBtn1: TRzBitBtn;
    CdsSelectBerthBerthNo: TStringField;
    CdsSelectBerthLength: TBCDField;
    CdsSelectBerthWidth: TBCDField;
    CdsSelectBerthHeight: TBCDField;
    CdsSelectBerthLengthUnit: TStringField;
    CdsSelectBerthHoldWeight: TBCDField;
    CdsSelectBerthWeightUnit: TStringField;
    CdsSelectBerthLocation: TStringField;
    CdsSelectBerthCheckDesc: TStringField;
    CdsSelectBerthStockUsable: TBooleanField;
    CdsSelectBerthRemark: TStringField;
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure dbgSelectBerthDblClick(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure CdsSelectBerthBeforeGetRecords(Sender: TObject;
      var OwnerData: OleVariant);
    procedure FormShow(Sender: TObject);
    procedure edValueChange(Sender: TObject);
    procedure edValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure dbgSelectBerthKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain:iMainForm;
    SvrBerth:TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
    { Private declarations }
  public
    iSendDepotID : Integer;
    { Public declarations }
  end;

var
  FrmSelectBerth: TFrmSelectBerth;

Function SelectBerth(HostCtrl: TControl; var iDepotID:Integer; var sBerthNo:String): Boolean; overload;
Function SelectBerth(var iDepotID:Integer; var sBerthNo:String): Boolean; overload;

implementation

uses DBFuncs;

const
  sFieldProPerty='Select * From SysFieldProperty Where TableName=''DepotBerths''';

{$R *.dfm}

Function SelectBerth(Var iDepotID:Integer;Var sBerthNo:String) : Boolean;
Begin
  Result := false;
  with TFrmSelectBerth.Create(NIl) do begin
    iSendDepotID := iDepotID;
    If Not(CdsSelectBerth.Active) Then CdsSelectBerth.Open;
    edValue.Text := sBerthNo;
    //CdsSelectBerth.Filtered := False;   不用过滤，因为如果传了一个货位号便不能显示其它的货位
    //if sBerthNo<>'' Then Begin
    //  edValue.Text := sBerthNo;
    //  CdsSelectBerth.Filter := ' BerthNo ='''+sBerthNo+'''';
    //End;
    //CdsSelectBerth.Filtered := True;
    if ShowModal=mrOk then begin
      sBerthNo  := CdsSelectBerth.FieldByName('BerthNo').AsString;
      Result := true;
    End;
  End;
End;

Function SelectBerth(HostCtrl: TControl; var iDepotID:Integer; var sBerthNo:String): Boolean;
begin
  Result := false;
end;

procedure TFrmSelectBerth.FormCreate(Sender: TObject);
begin
  IFmMain := (Application.MainForm as IMainForm);
  SvrBerth := IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsSelectBerth.RemoteServer := SvrBerth;

  CdsFieldProperty := TckClientDataSet.Create(Self);
  CdsFieldProPerty.ProviderName:='DspTemp';
  CdsFieldProPerty.RemoteServer:=SvrBerth;
end;

procedure TFrmSelectBerth.FormShow(Sender: TObject);
begin
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectBerth.Xml');
  SetFieldProperty(CdsFieldProPerty,cdsSelectBerth, 'DepotBerths');
  dbgSelectBerth.SetAutoSort('');
end;

procedure TFrmSelectBerth.RzBitBtn1Click(Sender: TObject);
begin
  Close;
end;

procedure TFrmSelectBerth.dbgSelectBerthDblClick(Sender: TObject);
begin
  if not CdsSelectBerth.IsEmpty then
    RzBitBtn2Click(Nil);
end;

procedure TFrmSelectBerth.RzBitBtn2Click(Sender: TObject);
begin
  If dbgSelectBerth.SelectedRows.Count<0 Then Begin
    Application.MessageBox('请先选择货位编号！', '警告', MB_ICONINFORMATION);
    Exit;
  end;
  ModalResult := mrOK;    
end;

procedure TFrmSelectBerth.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
end;

procedure TFrmSelectBerth.CdsSelectBerthBeforeGetRecords(Sender: TObject;
  var OwnerData: OleVariant);
var val: Variant;
begin
  val := OwnerData;
  OwnerData := VarArrayCreate([0,1], varVariant);
  OwnerData[0] := val;
  OwnerData[1] := iSendDepotID;
end;

procedure TFrmSelectBerth.edValueChange(Sender: TObject);
const
  MatchFields: array[0..2] of string=('BerthNo','Location','CheckDesc');
var
  i: integer;
begin
  i := 0;
  try
    while (i<3) and (not CdsSelectBerth.Locate(MatchFields[i],edValue.Text,[loPartialKey,loCaseInsensitive]))do
      inc(i);
  except
  end;
end;

procedure TFrmSelectBerth.edValueKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Key=VK_UP)or(Key=VK_DOWN) then begin
    PostMessage(dbgSelectBerth.Handle,WM_KEYDOWN,Key,0);
    key :=0;
  end;
end;

procedure TFrmSelectBerth.dbgSelectBerthKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if key=13 then begin
    edValue.SetFocus ;
    key :=0;
  end;
end;

End.