转至繁体中文版     | 网站首页 | 图文教程 | 资源下载 | 站长博客 | 图片素材 | 武汉seo | 武汉网站优化 | 
最新公告:     敏韬网|教学资源学习资料永久免费分享站!  [mintao  2008年9月2日]        
您现在的位置: 学习笔记 >> 图文教程 >> 软件开发 >> Delphi程序 >> 正文
偶写的第一个控件,一个用选择代替输入的Edit控件         ★★★★

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

作者:闵涛 文章来源:闵涛的学习笔记 点击数:1606 更新时间:2009/4/23 18:26:32


{***************************************************************}
{                                                               }
{             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

[1] [2]  下一页


[Delphi程序]可以左右居中对齐并可设置DisplayFormat的Edit控件  [Delphi程序]Sender 的應用:所有Edit共用一個過濾格式
教程录入:mintao    责任编辑:mintao 
  • 上一篇教程:

  • 下一篇教程:
  • 【字体: 】【发表评论】【加入收藏】【告诉好友】【打印此文】【关闭窗口
      注:本站部分文章源于互联网,版权归原作者所有!如有侵权,请原作者与本站联系,本站将立即删除! 本站文章除特别注明外均可转载,但需注明出处! [MinTao学以致用网]
      网友评论:(只显示最新10条。评论内容只代表网友观点,与本站立场无关!)

    同类栏目
    · C语言系列  · VB.NET程序
    · JAVA开发  · Delphi程序
    · 脚本语言
    更多内容
    热门推荐 更多内容
  • 没有教程
  • 赞助链接
    更多内容
    闵涛博文 更多关于武汉SEO的内容
    500 - 内部服务器错误。

    500 - 内部服务器错误。

    您查找的资源存在问题,因而无法显示。

    | 设为首页 |加入收藏 | 联系站长 | 友情链接 | 版权申明 | 广告服务
    MinTao学以致用网

    Copyright @ 2007-2012 敏韬网(敏而好学,文韬武略--MinTao.Net)(学习笔记) Inc All Rights Reserved.
    闵涛 投放广告、内容合作请Q我! E_mail:admin@mintao.net(欢迎提供学习资源)

    站长:MinTao ICP备案号:鄂ICP备11006601号-18

    闵涛站盟:医药大全-武穴网A打造BCD……
    咸宁网络警察报警平台