.#selectprovfrm.pas.1.5

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

unit SelectProvFrm;

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
  TFrmSelectProv = class(TForm)
    dbgSelectProvNo: TxDBGridEh;
    Panel1: TPanel;
    Panel2: TPanel;
    DComm: TDCOMConnection;
    CdsSelectProv: TckClientDataSet;
    DsSelectProv: TDataSource;
    Label1: TLabel;
    edValue: TRzEdit;
    RzPanel3: TRzPanel;
    RzDBNavigator1: TRzDBNavigator;
    RzBitBtn2: TRzBitBtn;
    ImageList1: TImageList;
    RzBitBtn1: TRzBitBtn;
    CdsSelectProvProvNo: TStringField;
    CdsSelectProvProvName: TStringField;
    CdsSelectProvFullName: TStringField;
    CdsSelectProvTrade: TStringField;
    CdsSelectProvSubjectDept: TStringField;
    CdsSelectProvWorkingMode: TStringField;
    CdsSelectProvAddress: TStringField;
    CdsSelectProvLinkMan: TStringField;
    CdsSelectProvMobile: TStringField;
    CdsSelectProvRemark: TStringField;
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure dbgSelectProvNoDblClick(Sender: TObject);
    procedure RzBitBtn2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure edValueChange(Sender: TObject);
    procedure edValueKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain:iMainForm;
    SvrProviders:TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSelectProv: TFrmSelectProv;

Function SelectProv(Var sProvNo:String) : Boolean;  overload;
Function SelectProv(Var sProvNo,sProvName:String) : Boolean;  overload;

implementation

uses DBFuncs;

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

{$R *.dfm}

Function SelectProv(Var sProvNo:String) : Boolean;
Var Str1:String;
Begin
  Result := SelectProv(sProvNo,Str1);
End;

Function SelectProv(Var sProvNo,sProvName:String) : Boolean;  overload;
Begin
  Result := false;
  with TFrmSelectProv.Create(NIl) do begin
    If Not(CdsSelectProv.Active) Then CdsSelectProv.Open;
    CdsSelectProv.Filtered := False;
    if sProvNo<>'' Then Begin
      edValue.Text := sProvNo;
      CdsSelectProv.Filter := ' ProvNo ='''+sProvNo+'''';
    End;
    CdsSelectProv.Filtered := True;
    if ShowModal=mrOk then begin
      sProvNo := CdsSelectProv.FieldByName('ProvNo').AsString;
      sProvName := CdsSelectProv.FieldByName('ProvName').AsString;
      Result := true;
    End;
  End;
End;

procedure TFrmSelectProv.FormCreate(Sender: TObject);
begin
  IFmMain := (Application.MainForm as IMainForm);
  SvrProviders := IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsSelectProv.RemoteServer := SvrProviders;

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

procedure TFrmSelectProv.FormShow(Sender: TObject);
var
  sTableNames: string;
begin
  SysFieldXml(CdsFieldProPerty,sFieldProPerty,'TFrmSelectProv.Xml');
  sTableNames := 'Providers';
  if cdsFieldProperty.Active then
    SetFieldProperty(CdsFieldProPerty,cdsSelectProv,sTableNames);
end;

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

procedure TFrmSelectProv.dbgSelectProvNoDblClick(Sender: TObject);
begin
  if not CdsSelectProv.IsEmpty then
    RzBitBtn2Click(Nil);
end;

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

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

procedure TFrmSelectProv.edValueChange(Sender: TObject);
const
  MatchFields: array[0..6] of string=('ProvNo','ProvName','FullName','Trade','SubjectDept','WorkingMode','Address');
var
  i: integer;
begin
  i := 0;
  try
    if edValue.Text = '' then exit;
    while (i<7)and(not CdsSelectProv.Locate(MatchFields[i],edValue.Text,[loPartialKey,loCaseInsensitive])) do
      inc(i);
  except
  end;
end;

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

End.