ottdbedit.pas

OttLib套件使用说明： 1、OttEnter控件：该控件主要实现在窗口中按回车键跳转到下一控件的功能；该控件是非可视控件

{
*******************************************************************************
*  本控件由stuwe个人开发,其中部分加密代码来源于网络,如侵犯了您的权益,请联系我 *
*  本控件包包括ottEnter, ottDBGrid, ottEdit, ottDBEdit控件                    *
*  该控件请勿用于商业用途，如需商业使用请与本人联系                           *
*  本人联系方式:  QQ : 31926588                                               *
*                MSN : [e-mail]                                    *
*              EMail : [e-mail]                                          *
*  以下为ottDBEdit,ottDBGrid控件代码,还附带有ottPopupMenu的代码               *
*******************************************************************************
}
unit ottDBEdit;

interface

uses
  SysUtils, Classes, Controls, DBCtrls, DBGrids, ADODB, Menus, DB, Forms,
  Windows, ottThread, TypInfo;

type

  TottPopupMenu = class(TPopupMenu)
  private
    procedure ItemClick(Sender: TObject);
    procedure MenuPop(Sender: TObject);
  protected

  public
    constructor Create(AOwner: TComponent); override;
  published

  end;
  
type
  TottDBGrid = class(TCustomDBGrid)
  private
    FVersion: String;
    FActiveControl: TWinControl;  //保存当前调用者
  protected
    procedure ottOnClick(Sender: TObject);
    procedure ottOnExit(Sender: TObject);
    procedure ottKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure ottOnMouseDown(Sender: TObject; Button: TMouseButton;
        Shift: TShiftState; X, Y: Integer);
    procedure Notification(AComponent: TComponent;
        Operation: TOperation); override;    
  public
    constructor Create(AOwner: TComponent); override;
    procedure SetActiveControl(Value: TWinControl);
  published
    property Columns;
    property Version: String Read FVersion;
  end;  

type
  TottDBEdit = class(TDBEdit)
  private
    FVersion: string;
    DataPack: _RecordSet;
    FConnection: TADOConnection; //查询数据所使用的连接 ADOConnection
    FFindQuery: TADOQuery; //查询数据所用的 ADOQuery
    FFindSource: TDataSource; //查询数据所用的数据集关联的 数据源
    FListGrid: TottDBGrid; 
    FSQL: TStrings;
    FPopupMenu: TottPopupMenu; //保存右键菜单
    FDefaultField: string;//保存默认的DataField;
    FKeyField: String;  //关联字段名
    FListField: String;   // LookupResult 字段名
    FLookupKeyField: String;
    FLookupResultField: String;
    FLookupDataSet: TDataSet;
    FListColumnWidth: String;  //显示Grid的各列宽度
    FListGridWidth: Integer; //显示Grid的宽度
    FListGridHeight: Integer; //显示Grid的高度

    FIsLike: Boolean;//是否进行全部模糊查询
    FAutoList: Boolean; //是否自动列出数据标识true为自动列出,false为输入时列出
    FInputFlag: Boolean; //标志输入状态 true为输入状态,  false为正常状态
    FInputParam: Integer; //当前输入参数为第几参数
    FMaxRecord: Integer; //显示的记录数
    FLocalFilter: Boolean; //是否进行本地过滤查询,如果进行本地查询的话需要调用初始化数据过程对数据进行初始化
    FLocalFilterFields: TStrings; //本地过滤查询的对应字段
    FLocalFilterSQL: WideString; //本地过滤查询初始化数据使用的语句
    FAutoInit: Boolean;//设置是否自动初始化（配合本地过滤设置使用），如果设置了自动初始化，控件创建过程自动初始化
    FInitThread: TInitThread;//初始化数据线程
    FParams: TParams; //设置其它查询参数，从第5个起


    FOnEnter: TNotifyEvent;//保存控件的OnEnter事件
    FOnExit: TNotifyEvent;//保存控件的OnExist事件
    FOnChange: TNotifyEvent; //保存控件的OnChange事件
    FOnKeyDown: TKeyEvent; //保存控件的KeyDown事件
    FOnSelectValue: TNotifyEvent; //选择上值后所做的操作

    procedure SetConnection(Value: TADOConnection);//设置连接的ADOConnection
    procedure SetListGrid(Value: TottDBGrid); //设置显示的数据的Grid;
    function GetSQL: TStrings;
    procedure SetSQL(const Value: TStrings);
    function GetFilterField: TStrings;
    procedure SetFilterField(const Value: TStrings);
    procedure SetInputParam(Value: Integer);
    procedure SetLocatFilter(Value: Boolean);
    procedure SetListColumnWidth(Value: String);
    procedure SetListGridWidth(Value: Integer);
    procedure SetListGridHeight(Value: Integer);
    procedure SetParams(Value: TParams);
    procedure SetLocalFilterSQL(Value: WideString);
    procedure SetAutoInit(Value: Boolean);
    procedure OnThreadDown(Sender: TObject);
  protected
    procedure ottChange(Sender: TObject); //改变数据事件
    procedure ottEnter(Sender: TObject); //获得焦点事件
    procedure ottExit(Sender: TObject); //失去焦点事件
    procedure ottKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure SearchData; //根据数据状态查找数据
    procedure HideListGrid; //隐藏掉选值列表
    procedure CheckInvaildValue;//检查输入内容是否正确，不正确清除掉数据或返回
    procedure BuilderField;
    procedure SetListGridColumn; //根据FListColumnWidth设置的值设置ListGrid的列宽
    procedure Notification(AComponent: TComponent;
        Operation: TOperation); override;
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Init(); //如果设置启用LocatFilter（本地过滤)，则必须调用init初始化数据过程
  published
    property SQL: TStrings read GetSQL write SetSQL;
    property IsLike: Boolean read FIsLike write FIsLike default False;
    property KeyField: String read FKeyField;
    property ResultField: string read FListField;
    property LookupKeyField: string read FLookupKeyField;
    property LookupResultField: string read FLookupResultField;
    property Connection: TADOConnection read FConnection write SetConnection;
    property AutoList: Boolean read FAutoList write FAutoList;
    property OnSelectValue: TNotifyEvent read FOnSelectValue write FOnSelectValue;
    property ListGrid: TottDBGrid read FListGrid write SetListGrid;
    property InputParam: Integer read FInputParam write SetInputParam;
    property ListColumnWidth: String Read FListColumnWidth write SetListColumnWidth;
    property ListGridWidth: Integer read FListGridWidth write SetListGridWidth default 0;
    property ListGridHeight: Integer read FListGridHeight write SetListGridHeight default 0;
    property Params: TParams read FParams write SetParams;
    property LocalFilterFields: TStrings read GetFilterField write SetFilterField;
    property LocalFilterSQL: WideString read FLocalFilterSQL write SetLocalFilterSQL;
    property LocalFilter: Boolean read FLocalFilter write SetLocatFilter;
    property AutoInit: Boolean read FAutoInit write SetAutoInit default false;
    property MaxRecord: Integer read FMaxRecord write FMaxRecord;
    property Version: String Read FVersion;   
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('OttLib', [TottDBEdit]);
  RegisterComponents('OttLib', [TottDBGrid]);
end;

{ TottPopupMenu }

constructor TottPopupMenu.Create(AOwner: TComponent);
var i: integer;
begin
  inherited Create(AOwner);
  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 1;
  Items.Items[Items.Count-1].Tag := 0;
  Items.Items[Items.Count-1].Caption := '拼音码';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 1;
  Items.Items[Items.Count-1].Tag := 1;
  Items.Items[Items.Count-1].Caption := '自定义码';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 1;
  Items.Items[Items.Count-1].Tag := 2;
  Items.Items[Items.Count-1].Caption := '编码';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 1;
  Items.Items[Items.Count-1].Tag := 3;
  Items.Items[Items.Count-1].Caption := '名称';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].Tag := 0;
  Items.Items[Items.Count-1].Caption := '-';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 2;
  Items.Items[Items.Count-1].Tag := 10;
  Items.Items[Items.Count-1].Caption := '显示10条记录';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 2;
  Items.Items[Items.Count-1].Tag := 20;
  Items.Items[Items.Count-1].Caption := '显示20条记录';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 2;
  Items.Items[Items.Count-1].Tag := 50;
  Items.Items[Items.Count-1].Caption := '显示50条记录';

  Items.Add(TMenuItem.Create(self));
  Items.Items[Items.Count-1].GroupIndex := 2;
  Items.Items[Items.Count-1].Tag := 200;
  Items.Items[Items.Count-1].Caption := '显示200条记录';

  for i:=0 to Items.Count - 1 do
  begin
    Items.Items[i].OnClick := ItemClick;
  end;
  OnPopup := MenuPop;
end;

procedure TottPopupMenu.ItemClick(Sender: TObject);
begin
  if TMenuItem(Sender).GroupIndex = 1 then
  begin
    if IsPublishedProp(Owner, 'InputParam') then
    begin
      SetPropValue(Owner, 'InputParam', TMenuItem(Sender).Tag);
    end;
  end
  else if TMenuItem(Sender).GroupIndex = 2 then
  begin
    if IsPublishedProp(Owner, 'MaxRecord') then
    begin
      SetPropValue(Owner, 'MaxRecord', TMenuItem(Sender).Tag);
    end;
  end;
end;

procedure TottPopupMenu.MenuPop(Sender: TObject);
var i: integer;
  iTag, iRecord: Integer;
  bV: Boolean;
  obj: TObject;
begin
  iTag := 0;
  iRecord := 10;
  if IsPublishedProp(Owner, 'InputParam') then
    iTag := GetPropValue(Owner, 'InputParam');
  if IsPublishedProp(Owner, 'MaxRecord') then
    iRecord := GetPropValue(Owner, 'MaxRecord');
  bV := false;
  if IsPublishedProp(Owner, 'ListGrid') then
    if GetObjectProp(Owner, 'ListGrid')<>nil then
    begin
      obj := GetObjectProp(Owner, 'ListGrid');
      if obj is TottDBGrid then
      begin
        if Assigned(TottDBGrid(obj).DataSource) then
          if Assigned(TottDBGrid(obj).DataSource.DataSet) then
            if TottDBGrid(obj).DataSource.DataSet is TADOQuery then
              bV := true;
      end;
    end;
             
  for i:= 0 to Items.Count - 1 do
  begin
    if Items.Items[i].GroupIndex = 1 then
    begin
      Items.Items[i].Checked := false;
      if Items.Items[i].Tag = iTag then
        Items.Items[i].Checked := true;
    end
    else if Items.Items[i].GroupIndex = 2 then
    begin
      Items.Items[i].Enabled := false;
      Items.Items[i].Checked := false;
      if Items.Items[i].Tag = iRecord then
        Items.Items[i].Checked := true;
      Items.Items[i].Enabled := bV;
    end;
  end;  
end;

{ TottDBEdit }

procedure TottDBEdit.BuilderField;
begin
  if (FKeyField = '') and (FListField = '') and (FLookupKeyField = '') and (FLookupResultField = '') then
  if Assigned(DataSource) then
  if Assigned(DataSource.DataSet) then
  begin
    FKeyField := DataSource.DataSet.FieldByName(DataField).KeyFields;
    FListField := DataField;
    FLookupKeyField := DataSource.DataSet.FieldByName(DataField).LookupKeyFields;
    FLookupResultField := DataSource.DataSet.FieldByName(DataField).LookupResultField;
    FLookupDataSet := DataSource.DataSet.FieldByName(DataField).LookupDataSet;
  end;
end;

procedure TottDBEdit.CheckInvaildValue;
begin
  if not (csLoading in ComponentState) then
  begin
    if Assigned(DataSource) then
    if Assigned(DataSource.DataSet) then
    if DataSource.DataSet.Active then
    if Assigned(FLookupDataSet) then
    begin
      if not FLookupDataSet.Active then
        FLookupDataSet.Open;
      if not DataSource.DataSet.FieldByName(FKeyField).IsNull then
      if not FLookupDataSet.Locate(FLookupKeyField, DataSource.DataSet.FieldByName(FKeyField).Value, [loCaseInsensitive, loPartialKey]) then
      begin
        if not(DataSource.DataSet.State in [dsEdit, dsInsert]) then
          DataSource.DataSet.Edit;
        DataSource.DataSet.FieldByName(FKeyField).Value := DataSource.DataSet.FieldByName(FKeyField).OldValue;
      end;
    end
    else
      raise Exception.Create('无关联数据集，录入数据有误时将无法正确判断');
  end;
end;

constructor TottDBEdit.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FVersion := 'OttLib 1.0';
  FMaxRecord := 10;   //初始化查询条目为10
  FInputParam := 0;   //初始化查询参数为第一个
  FDefaultField  := DataField;
  FSQL := TStringList.Create;
  FLocalFilterFields := TStringList.Create;
  FParams := TParams.Create(self);
  if Assigned(OnChange) then
    FOnChange := OnChange;
  OnChange := ottChange;

  if Assigned(OnEnter) then
    FOnEnter := OnEnter;
  OnEnter := ottEnter;

  if Assigned(OnExit) then
    FOnExit := OnExit;
  OnExit := ottExit;

  if Assigned(OnKeyDown) then