selectcustfrm.~pas

来自「医药连锁经营管理系统源码」· ~PAS 代码 · 共 185 行

~PAS
185
字号
unit SelectCustFrm;

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
  TFrmSelectCust = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    CdsSelectCust: TckClientDataSet;
    DsSelectCust: TDataSource;
    Label1: TLabel;
    edValue: TRzEdit;
    RzPanel3: TRzPanel;
    RzDBNavigator1: TRzDBNavigator;
    RzBitBtn2: TRzBitBtn;
    ImageList1: TImageList;
    RzBitBtn1: TRzBitBtn;
    dbgSelectCustNo: TxDBGridEh;
    CdsSelectCustCustNO: TStringField;
    CdsSelectCustCustName: TStringField;
    CdsSelectCustFullName: TStringField;
    CdsSelectCustTrade: TStringField;
    CdsSelectCustSubjectDept: TStringField;
    CdsSelectCustWorkingMode: TStringField;
    CdsSelectCustAddress: TStringField;
    CdsSelectCustLinkMan: TStringField;
    CdsSelectCustMobile: TStringField;
    CdsSelectCustRemark: TStringField;
    CdsSelectCustPayModeNo: TStringField;
    CdsSelectCustEmpNo: TStringField;
    CdsSelectCustCustPyCode: TStringField;
    procedure FormCreate(Sender: TObject);
    procedure RzBitBtn1Click(Sender: TObject);
    procedure dbgSelectCustNoDblClick(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);
    procedure dbgSelectCustNoKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    IFmMain:iMainForm;
    SvrCustomers:TDispatchConnection;
    CdsFieldProperty :TckClientDataSet;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FrmSelectCust: TFrmSelectCust;

Function SelectCust(Var sCustNo:String) : Boolean; OverLoad;
Function SelectCust(Var sCustNo,sCustName:String) : Boolean; OverLoad;
Function SelectCust(Var sCustNo,sCustName,sEmpNo,sPayModeNo: string): boolean; overload;

implementation

uses DBFuncs;

Const
  sFieldProPerty='Select * From SysFieldProperty Where TableName=''Customers''';
{$R *.dfm}

Function SelectCust(Var sCustNo:String) : Boolean;
Var Str1:String;
Begin
  Result := SelectCust(sCustNo,Str1);
End;

Function SelectCust(Var sCustNo,sCustName:String) : Boolean;
Var Str1:String;
Begin
  Result := SelectCust(sCustNo,sCustName,Str1,Str1);
End;

Function SelectCust(Var sCustNo,sCustName,sEmpNo,sPayModeNo: string): boolean;
begin
  Result := false;
  with TFrmSelectCust.Create(NIl) do begin
    If Not(CdsSelectCust.Active) Then CdsSelectCust.Open;
    if sCustNo<>'' Then Begin
      CdsSelectCust.Locate('CustNo',sCustNo,[loPartialKey]);
      edValue.Text := sCustNo;
    End;
    if ShowModal=mrOk then begin
      sCustNo := CdsSelectCust.FieldByName('CustNo').AsString;
      sCustName:=CdsSelectCust.FieldByName('CustName').AsString;
      sEmpNo := CdsSelectCust.FieldByName('EmpNo').AsString;
      sPayModeNo:=CdsSelectCust.FieldByName('PayModeNo').AsString;
      Result := true;
    End;
  End;
end;

procedure TFrmSelectCust.FormCreate(Sender: TObject);
begin
  IFmMain := (Application.MainForm as IMainForm);
  SvrCustomers := IFmMain.GetConnection(Handle,'','CommonSvr.CommonRDM');
  CdsSelectCust.RemoteServer := SvrCustomers;

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

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

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

procedure TFrmSelectCust.dbgSelectCustNoDblClick(Sender: TObject);
begin
  if not CdsSelectCust.IsEmpty then
    RzBitBtn2Click(Nil);
end;

procedure TFrmSelectCust.RzBitBtn2Click(Sender: TObject);
begin
  If dbgSelectCustNo.SelectedRows.Count<0 Then Begin
    Application.MessageBox('请先选择客户编号!', '警告', MB_ICONINFORMATION);
    Exit;
  end;
  ModalResult := mrOK;    
end;

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

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

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

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

End.

⌨️ 快捷键说明

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