{***************************************************************}
{ }
{ Siow写的第一个控件 }
{ }
{用途：主要用于数据录入界面 }
{特点：用选择代替输入，减少人工录入时的低级错误 }
{版本：V1.1 }
{已知Bugs:1、在设计期如果数据源Active就无法编译 }
{ 2、ConnectionString编缉问题。加上ADOReg,DesignIntf后，}
{ 控件可安装却有好多引用单元无法编译,郁闷-_-! }
{联系方式：E-Mail:[email protected] }
{ 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.
本文地址：http://com.8s8s.com/it/it4165.htm