.#selectberthfrm.pas.1.5

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

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);
  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=''GoodsBerth''';

{$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;
    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);
var
  sTableNames: string;
begin
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectBerth.Xml');
  sTableNames := 'GoodsBerth';
  if cdsFieldProperty.Active then
    SetFieldProperty(CdsFieldProPerty,cdsSelectBerth,sTableNames);
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
    PostMessage(dbgSelectBerth.Handle,WM_KEYDOWN,Key,0);
end;

End.