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

【 tulaoshi.com - 编程语言 】

　　
　　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.FieldCountFieldNo 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.SQLValue then FADOQuery.SQL.Assign(Value);
　　end;

　　procedure TDBLookUpEdit.Loaded;
　　begin
　　  inherited Loaded;
　　end;

　　end.