偶写的第一个控件,一个用选择代替输入的Edit控件

核心提示：{***}{ }{ Siow写的第一个控件 }{ }{用途：主要用于数据录入界面 }{特点：用选择代替输入，减少人工录入时的低级错误 }{版本：V1.1 }{已知Bugs:1、在设计期如果数据源Active就无法编译 }{ 2、ConnectionString编缉问题，偶写的第一个控件,一个用选择代替输入的Edit控

{***************************************************************}
{　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{　　　　　　 Siow写的第一个控件　　　　　　　　　　　　　　　  }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{用途：主要用于数据录入界面　　　　　　　　　　　　　　　　　　 }
{特点：用选择代替输入，减少人工录入时的低级错误　　　　　　　　 }
{版本：V1.1　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{已知Bugs:1、在设计期如果数据源Active就无法编译　　　　　　　　 }
{　　　　 2、ConnectionString编缉问题。加上ADOReg,DesignIntf后，}
{　　　　　  控件可安装却有好多引用单元无法编译,郁闷-_-!　　　  }
{联系方式：E-Mail:fuyushui@sohu.com　　　　　　　　　　　　　　 }
{　　　　  QQ:1253366　　　　　　　　　　　　　　　　　　　　　 }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　　 }
{***************************************************************}

unit DBLookUpEdit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Grids, DBGrids, StdCtrls, DB, ADODB;
  //,ADOReg,DesignIntf,DesignEditors
type

  {TDBLookUpEdit}

  TDBLookUpEdit = class(TEdit)
  PRivate
　  FCreating:　 Boolean;
　  FKeyField:　 WideString;
　  FDBGrid :　  TDBGrid;
　  FADOQuery:　 TADOQuery;
　  FDataSource: TDataSource;
　  FOnEnter:　  TNotifyEvent;
　  FOnExit:　　 TNotifyEvent;
　  FOnChange:　 TNotifyEvent;
　  //FOnClick: TNotiFyEvent;
　  //FOnDblClick:TNotifyEvent;
　  procedure CNCommand(var Message: TWMCommand);
　　  message CN_COMMAND;
　  function GetActive: Boolean;
　  procedure SetActive(Value: Boolean);
　  function  GetDataSource: TDataSource;
　  procedure SetDataSource(Value: TDataSource);
　  function GetConnectionString: WideString;
　  procedure SetConnectionString(const Value: WideString);
　  function GetConnection: TADOConnection;
　  procedure SetConnection(const Value: TADOConnection);
　  function GetSQL: TStrings;
　  procedure SetSQL(const Value: TStrings);
　  procedure SetRecText(FieldNo: integer);
　  procedure DoFDBGridMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
　  procedure DoFDBGridKeyDown(Sender: TObject; var Key: Word;Shift: TShiftState);
  protected
　  procedure SetParent(AParent: TWinControl); override;
　  procedure Notification(AComponent: TComponent; Operation: TOperation); override;
　  procedure CMVisiblechanged(var Message: TMessage);
　　  message CM_VISIBLECHANGED;
　  procedure CMEnabledchanged(var Message: TMessage);
　　  message CM_ENABLEDCHANGED;
　  procedure CMBidimodechanged(var Message: TMessage);
　　  message CM_BIDIMODECHANGED;
　  procedure FDoEnter(Sender: TObject);
　  procedure FDoExit(Sender: TObject);
　  procedure KeyDown(var Key: Word; Shift: TShiftState); override;
　  procedure KeyPress(var Key: Char); override;
　  procedure KeyUp(var Key: Word; Shift: TShiftState); override;
　  procedure Loaded; override;
　  procedure CreateWnd; override;
  public
　  constructor Create(AOwner: TComponent); override;
　  procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer); override;

  published
　  //procedure Click;override;
　  property KeyFieldName:WideString read FKeyField write FKeyField;
　  procedure DblClick; override;
　  property OnEnter: TNotifyEvent read FOnEnter write FOnEnter;
　  property OnExit: TNotifyEvent read FOnExit write FOnExit;
　  property OnChange: TNotifyEvent read FOnChange write FOnChange;
　  //property OnClick: TNotifyEvent read FOnClick write FOnClick;
　  //property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
　  //property DataSource: TDataSource read GetDataSource write SetDataSource;
　  property Active: Boolean read GetActive write SetActive default False;
　  property ConnectionString: WideString read GetConnectionString write SetConnectionString;
　  property Connection: TADOConnection read GetConnection write SetConnection;
　  property SQL: TStrings read GetSQL write SetSQL;
  end;

procedure Register;

implementation

{ TDBLookUpEdit }

procedure Register;
begin
  RegisterComponents('LD Controls', [TDBLookUpEdit]);
  //RegisterPropertyEditor(TypeInfo(WideString), TDBLookUpEdit, 'ConnectionString', TConnectionStringProperty);
end;

constructor TDBLookUpEdit.Create(AOwner: TComponent);
begin
  inherited;
  FDBGrid　　 :=TDBGrid.Create(Self);
  FADOQuery　 :=TADOQuery.Create(self);
  FDataSource :=TDataSource.Create(self);

  FDBGrid.FreeNotification(self);
  FADOQuery.FreeNotification(self);
  FDataSource.FreeNotification(self);

  FDataSource.DataSet:=FADOQuery;
  with FDBGrid do
  begin
　  DataSource:=FDataSource;
　  Ctl3D:=false;
　  Visible:=false;
　  ParentCtl3D:=false;
　  Options:=[dgColLines,dgRowLines,dgRowSelect,dgAlwaysShowSelection,dgConfirmDelete,dgCancelOnExit];
　  OnMouseUp:=DoFDBGridMouseUp;
　  OnKeyDown:=DoFDBGridKeyDown;
  end;

  with self do
  begin
　  ParentCtl3D:=false;
　  Ctl3D:=false;
  end;
end;

procedure TDBLookUpEdit.CreateWnd;
begin
  FCreating := True;
  try
　  inherited CreateWnd;
  finally
　  FCreating := False;
  end;
end;

procedure TDBLookUpEdit.CMBidimodechanged(var Message: TMessage);
begin
  inherited;
  FDBGrid.BiDiMode := BiDiMode;
end;

procedure TDBLookUpEdit.CMEnabledchanged(var Message: TMessage);
begin
  inherited;
  FDBGrid.Enabled := Enabled;
end;

procedure TDBLookUpEdit.CMVisiblechanged(var Message: TMessage);
begin
  inherited;
end;

procedure TDBLookUpEdit.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (AComponent = FDBGrid) and (Operation = opRemove) then  FDBGrid:= nil;
  if (AComponent = FADOQuery) and (Operation = opRemove) then  FADOQuery:= nil;
  if (AComponent = FDataSource) and (Operation = opRemove) then  FDataSource:= nil;
end;

procedure TDBLookUpEdit.SetParent(AParent: TWinControl);
begin
  inherited SetParent(AParent);
  if FDBGrid <> nil then FDBGrid.Parent := self.Owner as TForm;
end;

procedure TDBLookUpEdit.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited;
  if FDBGrid <> nil then
　  with FDBGrid do
　  begin
　　  Top:=-Height;
　　  Left:=-Width;
　  end;
end;

procedure TDBLookUpEdit.SetRecText(FieldNo: integer);
begin
  self.SetFocus;
  self.SelectAll;
  if (FADOQuery.Connection <>nil) or (FADOQuery.ConnectionString <>'') then
　  if FADOQuery.Active then
　　  if FADOQuery.RecordCount >0 then
　　　  if FADOQuery.FieldCount>FieldNo then
　　　  begin
　　　　  self.Text:=FDBGrid.Fields[FieldNo].Text;
　　　　  self.SelectAll;
　　　　  self.SetFocus;
　　　  end;
end;

procedure TDBLookUpEdit.FDoEnter(Sender: TObject);
var
  p  :TPoint;
begin
  P:=self.ClientToParent(point(0,self.Height),(self.Owner as TForm));
  if (FDBGrid.Height+p.y+2)<=(self.Owner as TForm).Height then
  begin
　  FDBGrid.Top  :=p.y+2;
  end
  else begin
　  FDBGrid.Top  :=p.y-2-self.Height -FDBGrid.Height;
  end;
  FDBGrid.Left :=p.x+2;
  FDBGrid.BringToFront;
  FDBGrid.Visible:=true;
  if self.Text='' then SetRecText(1);
  self.SelectAll;
  if (self.Text<>'') and FADOQuery.Active then
　  FADOQuery.Locate(FKeyField, self.text,[lopartialkey]);
end;

procedure TDBLookUpEdit.FDoExit(Sender: TObject);
begin
  if not FDBGrid.Focused then  FDBGrid.Visible:=false;
end;

procedure TDBLookUpEdit.DoFDBGridMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  SetRecText(1);
  FDBGrid.Visible:=false;
end;

procedure TDBLookUpEdit.DoFDBGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if key=13 then
  begin
　  SetRecText(1);
　  FDBGrid.Visible:=false;
　  key:=0;
  end;
end;

procedure TDBLookUpEdit.CNCommand(var Message: TWMCommand);
begin
  case Message.NotifyCode of
　  EN_CHANGE:
　  begin
　　  if not FCreating then
　　　  if Assigned(FOnChange) then FOnChange(self);
　  end;
　  EN_KILLFOCUS:
　  begin
　　  if Assigned(FOnExit) then FOnExit(self);
　　  FDoExit(self);
　  end;
　  EN_SETFOCUS:
　  begin
　　  if Assigned(FOnEnter) then FOnEnter(self);
　　  FDoEnter(self);
　  end;
  end;
end;

procedure TDBLookUpEdit.DblClick;
begin
  inherited;
  FDoEnter(self);
end;

function TDBLookUpEdit.GetDataSource: TDataSource;
begin
  Result := FDBGrid.DataSource;
end;

procedure TDBLookUpEdit.SetDataSource(Value: TDataSource);
begin
  if Value <> FDBGrid.Datasource then  FDBGrid.DataSource := Value;
  if Value <> nil then Value.FreeNotification(Self);
end;

procedure TDBLookUpEdit.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if FDBGrid.Visible then
  begin
　  if (key=38) or (key=40) then
　  begin
　　  SendMessage(FDBGrid.Handle,WM_KEYDOWN,key,0);
　　  key:=0;
　  end;
　  if key=13 then
　  begin
　　  SetRecText(1);
　　  FDBGrid.Visible:=false;
　　  key:=0;
　  end;
  end;
end;

//判断是否全是数字
function IsAllInteger(Text:widestring):boolean;
var
  Temp:string;
  i:integer;
begin
  try
　  Result:=true;
　  Temp:=trim(text);
　  if (length(Temp)<=0) then
　  begin
　　  Result:=false;
　　  exit;
　  end;
　  for i:=1 to length(Temp) do
　  begin
　　  if not (Temp[i] in ['0'..'9']) then
　　  begin
　　　  Result:=false;
　　　  break;
　　  end;
　  end;
  except
　  Result:=false;
  end;
end;

//生成筛选语句
function CSQL(EditText,FieldName:WideString):WideString;
var
  i:integer;
  sql:WideString;
  tmEditText1,tmEditText2:WideString;
begin
  Result:='';
  if IsAllInteger(EditText) then
  begin
　  tmEditText1:=trim(EditText);
　  tmEditText2:=trim(EditText);
　  SQL:=SQL+'('+FieldName+'>='+trim(EditText)+' and '+FieldName+'<='+inttostr((StrToInt(EditText) div 10)*10+9)+')';
　  for i:=length(EditText) to 6 do
　  begin
　　  tmEditText1:=tmEditText1+'0';
　　  tmEditText2:=tmEditText2+'9';
　　  sql:=sql+' or ('+FieldName+'>='+tmEditText1+' and '+FieldName+'<='+tmEditText2+')';
　  end;
　  Result:=sql;
  end;
end;

procedure TDBLookUpEdit.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  if FDBGrid.Visible then
  begin
　  if (key=38) or (key=40) then
　  begin
　　  SetRecText(1);
　  end
　  else if IsAllInteger(self.Text) then
　  begin
　　  FADOQuery.Filtered:=false;
　　  FADOQuery.Filter:=CSQL(self.Text,FKeyField);
　　  FADOQuery.Filtered:=true;
　  end;
  end;
end;

procedure TDBLookUpEdit.KeyPress(var Key: Char);
begin
  inherited;
end;

function TDBLookUpEdit.GetConnection: TADOConnection;
begin
  Result := FADOQuery.Connection;
end;

procedure TDBLookUpEdit.SetConnection(const Value: TADOConnection);
begin
  if Value <> FADOQuery.Connection then
  begin
　  FADOQuery.Connection := Value;
  end;
  if Value <> nil then Value.FreeNotification(Self);
end;

function TDBLookUpEdit.GetConnectionString: WideString;
begin
  Result := FADOQuery.ConnectionString;
end;

procedure TDBLookUpEdit.SetConnectionString(const Value: WideString);
begin
  if Value <> FADOQuery.ConnectionString then  FADOQuery.ConnectionString := Value;
end;

function TDBLookUpEdit.GetActive: Boolean;
begin
  Result :=FADOQuery.Active;
end;

procedure TDBLookUpEdit.SetActive(Value: Boolean);
begin
  if Value <> FADOQuery.Active then
  begin
　  FADOQuery.Active := Value;
  end;
end;

function TDBLookUpEdit.GetSQL: TStrings;
begin
  Result := FADOQuery.SQL;
end;

procedure TDBLookUpEdit.SetSQL(const Value: TStrings);
begin
  if FADOQuery.SQL<>Value then FADOQuery.SQL.Assign(Value);
end;

procedure TDBLookUpEdit.Loaded;
begin
  inherited Loaded;
end;

end.