电信主站 网通分站
购买流程 付款方式 常见问题 在线提问 续租服务 购物车
用户名: 密 码: 忘记密码?
首 页
域名注册
虚拟主机
双线主机
服务器租用
VPS主机
企业邮局
代理专区
客服中心
虚拟主机行业资讯 虚拟主机评测对比 互联网最新动态 技术学院 站长资讯 在线教程 网站运营
搜索优化 服务器 网络编程 图形图象 站长之家 网页制作 操作系统
冲浪宝典 软件教学 视频通信 办公软件 邮件系统 网络安全 认证考试
您当前位置:西部数码->资讯中心-> 网络编程 -> Delphi教程
偶写的第一个控件,一个用选择代替输入的edit控件_delphi教程
作者:网友供稿 点击:0
  西部数码-全国虚拟主机10强!20余项虚拟主机管理功能,全国领先!第6代双线路虚拟主机,南北访问畅通无阻!虚拟主机可在线rar解压,自动数据恢复设置虚拟目录等.虚拟主机免费赠送访问统计,企业邮局.Cn域名注册10元/年,自助建站480元起,免费试用7天,满意再付款!P4主机租用799元/月.月付免压金!
文章页数:[1] 
{***************************************************************}
{                                                               }
{             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.


文章整理:西部数码--专业提供域名注册虚拟主机服务
http://www.west263.com
以上信息与文章正文是不可分割的一部分,如果您要转载本文章,请保留以上信息,谢谢!
相关主题
文章页数:[1] 
Google
热门文章
·如何在启动机器时自动运行adsl拨号(1)_delphi教程
·delphi的通配符比较(第五版)_delphi教程
·delphi托盘编程实战演练_delphi教程
·关于中文折行及相关问题的解决方法_delphi教程
·字幕图标控件_delphi教程
·一个很简单的加密算法_delphi教程
·winapi编程关闭qq登录窗体_delphi教程
·组件开发方式_delphi教程
·用ehlib二次开发报表打印程序,实现财务凭证的打印(三)_delphi教程
·delphi+汇编例子1(求和的比较)_delphi教程

最新文章
·阻止windwos xp系统蓝屏的几大绝招_windows xp
·photoshop极坐标滤镜巧绘三维游泳圈_photoshop教程
·photoshop将美女照片转为手绘效果_photoshop教程
·zend studio5.5测试版 兼容三系统_php文摘
·photoshop调整图片对比度方法浅析_photoshop教程
·一个设置任意窗口透明度的命令行delphi程序_delphi教程
·photoshop基础教程:跟我学调色练习3-润色_photoshop教程
·windows xp空间:文件的属性也玩“花样”_windows xp
·轻松清理windows xp系统垃圾_windows xp
·配景的使用与创建_autocad教程


 
 


版权申明:本站文章均来自网络,如有侵权,请联系我们,我们收到后立即删除,谢谢!

特别注意:本站所有转载文章言论不代表本站观点,本站所提供的摄影照片,插画,设计作品,如需使用,请与原作者联系,版权归原作者所有。
  打印  刷新  关闭
返回首页 |关于我们 | 联系我们 | 付款方式 | 创业联盟 | 虚拟主机 | 资讯中心 | 友情链接 | 网站地图

版权所有 西部数码(www.west263.com)
CopyRight (c) 2002~2006 west263.com all right reserved.
公司地址:四川成都市万和路90号天象大厦4楼 邮编:610031
电话总机:028-86262244 86263048 86263408 86263960 86264018 86267838
售前咨询:总机转201 202 203 204 206 208
售后服务:总机转211 212 213 214
财务咨询:总机转224 223 传真:028-86264041 财务QQ:点击发送消息给对方635483282
售前咨询QQ:点击发送消息给对方2182518 点击发送消息给对方241975952 点击发送消息给对方275026793 点击发送消息给对方408235859
售后服务QQ:点击发送消息给对方17708515 点击发送消息给对方307742704 点击发送消息给对方287976517 点击发送消息给对方363783715
《中华人民共和国增值电信业务经营许可证》编号:川B2-20030065号