findclass.pas

一个很好用的万能查询控件。部分代码经过更改。

{*******************************************************}
{       查询控件1.0     Unit                            }
{                                                       }
{       Copyright (c) 2001-2002, 广东亿康公司           }
{       实现Form中通用查询功能                          }
{       Athor:乔有钢                                    }
{*******************************************************}
unit FindClass;

interface

uses
  Windows, Messages, SysUtils, DBGridEh, Classes, DBGrids, Forms,
  FindSelect, Graphics, Controls, Dialogs, EditHint, FindPopular,
  AdoDB, ExtCtrls, FindMultiSelect, FindForm,FieldSelect,DBTables;

type
  //全局记录
  RecFind = record
    FForm: TForm;
    FQuery: TQuery;
    FAdoQuery: TAdoQuery;
    FAdoDataSet:TAdoDataSet;
    sCount,
      sGridName,
      sOldCaption,
      sSQLText,
      sSQLTextAnd,
      sSQLTextOr: string;
  end;
  PRec = ^RecFind;


  //方法指针
  TNotifyEvent = procedure(Sender: Tobject) of object;

  //窗体的标题和提示
  //对象型属性
{  TFindHint = class(TPersistent)
  private
    FormCaption: string;
    FHint: string;
  public
    //property FindHint: string read FHint write FHint;
  published
    property FindHint: string read FHint write FHint;
    property FindFormCaption: string read FormCaption write FormCaption;
  end;  }


  TImeName = type string;

  //集合属性
  TGridEnum = (fsDBGrid, fsDBGridEh);
  TFSet = set of TGridEnum;

  //查询控件TFind
  TFind = class(TComponent)
  private
    { Private declarations }
    FParentFont: Boolean;
    FShowDateTimePicker:Boolean;
    FormCaption: string;
    FHint: string;
    FTimer: TTimer;
    FAfterFindEvent: TNotifyEvent; //事件

    procedure FTimerTimer(Sender: TObject);
    procedure LoadStrList;
    procedure Loadproperty;
    procedure OpenFindSelectForm(slStrList: TStringList);
    procedure OpenFindForm(slStrList: TStringList);
    procedure OpenFindPopularForm(slStrList: TStringList);
    function IsHintStrored: Boolean;
  protected
    { Protected declarations }
    bShowHint: Boolean;
    procedure DoAfterFind;
  public
    FForm: TForm;
    sGridName, sSqlString: string;
    FQuery: TQuery;
    FAdoQuery: TAdoQuery;
    FAdoDataSet: TAdoDataSet;
    FFindSet: TFSet;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy;
    //多条件查询
    procedure FindLoadMulti;
    //任意组合条件查询
    procedure FindLoadCommon;
    //单一条件查询
    procedure FindLoadUnique;
    //多条件组合查询
    procedure FindLoadPopular;
    //选择要显示的字段
    procedure FindLoadSelectField;



  published
    property FormName: TForm read FForm write FForm;
    property GridName: string read sGridName write sGridName;
    property SqlText: string read sSqlString write sSqlString;
    property Query: TQuery read FQuery write FQuery;
    property AdoQuery: TAdoQuery read FAdoQuery write FAdoQuery;
    property AdoDataSet: TAdoDataSet read FAdoDataSet write FAdoDataSet;
    property FindSet: TFSet read FFindSet write FFindSet;
   // property ShowFindHint: Boolean read bShowHint write bShowHint default False;
    property ParentFont: Boolean read FParentFont write FParentFont default False;
    property ShowDateTimePicker: Boolean read FShowDateTimePicker write FShowDateTimePicker default False;
    property AfterFind: TNotifyEvent read FAfterFindEvent write FAfterFindEvent;
   // property FindHint: string read FHint write FHint stored IsHintStrored;
    property FindFormCaption: string read FormCaption write FormCaption;


  end;
//全局变量
var Rec: PRec;
  FDBGridEh: TDBGridEh;
  FDBGrid: TDBGrid;
  gFForm: TForm;
  gFQuery: TQuery;
  gFAdoQuery: TAdoQuery;
  gAdoDataSet:TAdoDataSet;
  gsGridName,
    gsSqlPutIn,
    gsCount,
    gsSQLText,
    gsFindFormCaption,
    gsFindHint,
    gsOldCaption: string;
  gbIsDBGrid, gbIsDBGridEh, gbIsParentFont, gbShowFindHint,gbShowDateTimePicker: Boolean;
procedure Register;

implementation
var slStrList: TstringList;

procedure Register;
begin
  RegisterComponents('Standard', [TFind]);
end;

{ TFind }

procedure TFind.FindLoadCommon;
begin
  sSqlString := gsSqlPutIn;
  FQuery := gFQuery;
  FAdoQuery := gFAdoQuery;
  AdoDataSet := gAdoDataSet;
  LoadStrList;
  OpenFindForm(slStrList);
  if gsSQLText <> '' then begin
  if FAdoQuery<>nil then
    with FAdoQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FAdoQuery.RecordCount);
    end;
  if AdoDataSet<>nil then
    with AdoDataSet do begin
      Close;
      if Pos('where', gsSqlPutIn)>0 then
      CommandText :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      CommandText :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(AdoDataSet.RecordCount);
    end;
  if FQuery<>nil then
    with FQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FQuery.RecordCount);
    end;
    end;
  DoAfterFind; //触发查询完毕事件
end;

constructor TFind.Create(AOwner: TComponent);
var i:integer;
begin
  inherited Create(AOwner); //先创建TFind的实例
  if not (csDesigning in ComponentState) then //如果在设计期就禁止FTimer
  begin
    FTimer := TTimer.Create(self);
    FTimer.Enabled := False;
    FTimer.Interval := 5000;
    FTimer.OnTimer := FTimerTimer;
  end;
  FShowDateTimePicker:=True;
  FParentFont:=True;

  {New(Rec);
  Rec^.FForm:=FormName;
  Rec^.sOldCaption:=FForm.Caption;//记下原窗体的标题
  Rec^.FAdoQuery:=AdoQuery;
  Rec^.sGridName:=GridName; }
  slStrList := TStringList.Create;
 // FAdoQuery:=TAdoQuery.Create(nil);
end;

destructor TFind.Destroy;
begin
  slStrList.Free;
  frmMultiFindSelect.Free;
  frmFieldSelect.Free;
  frmFindPopular.Free;
  frmFind.Free;
  inherited Destroy; //删除TFind的实例
end;

procedure TFind.DoAfterFind;
begin
  FTimer.Enabled := True;
 // if gsCount <> '0' then
   // FForm.Caption := gsOldCaption + ' 查询完毕, 共有 ' + gsCount + '条数据';
  //如果建立了处理AfterFind事件的句柄就调用这句柄
  if Assigned(AfterFind) then
    FAfterFindEvent(Self); //触发客户写的脚本
end;

procedure TFind.FTimerTimer(Sender: TObject);
begin
 FTimer.Enabled := False;
 // FForm.Caption := gsOldCaption; //五秒钟后还原窗口的标题
end;


function TFind.IsHintStrored: Boolean;
begin
 // Result := (FindHint = '');
end;

procedure TFind.Loadproperty;
var sCaption: string;
  i: integer;
begin
  gFForm := FForm;
  sCaption := Trim(gFForm.Caption);
  i := Pos(' ', sCaption);
  if i > 0 then
    sCaption := Copy(sCaption, 1, i);
  gsOldCaption := sCaption; //记下原窗体的标题
  gFAdoQuery := FAdoQuery;
  gFQuery := FQuery;
  gAdoDataSet := AdoDataSet;
  gsGridName := sGridName;
  gsSqlPutIn := sSqlString;
  if FFindSet = [fsDBGrid] then
    gbIsDBGrid := True;
  if FFindSet = [fsDBGridEh] then
    gbIsDBGridEh := True;
    if   FParentFont     then
  gbIsParentFont :=True;
  gsFindFormCaption := FindFormCaption;
  gsFindHint := FHint;
  if   bShowHint  then
  gbShowFindHint :=True;
  if FShowDateTimePicker then
  gbShowDateTimePicker:=True;
end;

procedure TFind.LoadStrList;
var i, j: integer;
begin
  if gbIsDBGridEh then
    with gFForm do begin
      for j := 0 to ComponentCount - 1 do
        if Components[j] is TDBGridEh then begin
          if (Components[j] as TDBGridEh).Name = gsGridName then begin
            FDBGridEh := TDBGridEh(Components[j]);
            for i := 0 to FDBGridEh.Columns.Count - 1 do
            begin
              slStrList.Add((Components[j] as TDBGridEh).Columns[i].Title.Caption);
            end;
          end;
        end;
    end;
  if gbIsDBGrid then
    with gFForm do begin
      for j := 0 to ComponentCount - 1 do
        if Components[j] is TDBGrid then begin
          if (Components[j] as TDBGrid).Name = gsGridName then begin
            FDBGrid := TDBGrid(Components[j]);
            for i := 0 to FDBGrid.Columns.Count - 1 do
            begin
              slStrList.Add((Components[j] as TDBGrid).Columns[i].Title.Caption);
            end;
          end;
        end;
    end;
end;

procedure TFind.FindLoadMulti;
begin
  Loadproperty;
  slStrList := TStringList.Create;
  FAdoQuery := gFAdoQuery;
  FQuery := gFQuery;
  AdoDataSet := gAdoDataSet;
  LoadStrList;
  OpenFindSelectForm(slStrList);
  if gsSQLText <> '' then  begin
  if  FAdoQuery<>nil then
    with FAdoQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FAdoQuery.RecordCount);
    end;
  if  AdoDataSet<>nil then
    with AdoDataSet do begin
      Close;
      if Pos('where', gsSqlPutIn)>0 then
      CommandText :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      CommandText :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(AdoDataSet.RecordCount);
    end;
  if  FQuery<>nil then
    with FQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FQuery.RecordCount);
    end;
    end;
  DoAfterFind;
end;

procedure TFind.OpenFindForm(slStrList: TStringList);
begin
  if frmFind = nil then
    frmFind := TfrmFind.Create(nil);
  frmFind.slList := slStrList;
  frmFind.ShowModal;
end;

procedure TFind.OpenFindSelectForm(slStrList: TStringList);
begin
  if frmMultiFindSelect = nil then
    frmMultiFindSelect := TfrmMultiFindSelect.Create(nil);
  frmMultiFindSelect.slList := slStrList;
  frmMultiFindSelect.ShowModal;
end;


procedure TFind.FindLoadUnique;
begin
  Loadproperty;
  FindLoad(gsSqlPutIn);
  DoAfterFind;
end;

procedure TFind.FindLoadSelectField;
begin
  Loadproperty;
  if frmFieldSelect = nil then
    frmFieldSelect := TfrmFieldSelect.Create(nil);
  frmFieldSelect.ShowModal;
end;

procedure TFind.FindLoadPopular;
begin
  Loadproperty;
  slStrList := TStringList.Create;
  FAdoQuery := gFAdoQuery;
  FQuery := gFQuery;
  AdoDataSet := gAdoDataSet;
  LoadStrList;
  OpenFindPopularForm(slStrList);
  if gsSQLText <> '' then  begin
  if  FAdoQuery<>nil then
    with FAdoQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FAdoQuery.RecordCount);
    end;
  if  AdoDataSet<>nil then
    with AdoDataSet do begin
      Close;
      if Pos('where', gsSqlPutIn)>0 then
      CommandText :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      CommandText :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(AdoDataSet.RecordCount);
    end;
  if  FQuery<>nil then
    with FQuery do begin
      Close;
      Sql.Clear;
      if Pos('where', gsSqlPutIn)>0 then
      Sql.Text :=  gsSqlPutIn + ' and ' + gsSQLText
      else
      Sql.Text :=  gsSqlPutIn + ' where ' + gsSQLText;
      Open;
      gsCount := IntToStr(FQuery.RecordCount);
    end;
    end;
  DoAfterFind;
end;

procedure TFind.OpenFindPopularForm(slStrList: TStringList);
begin
  if frmFindPopular = nil then
  frmFindPopular := TfrmFindPopular.Create(nil);
  frmFindPopular.slList := slStrList;
  frmFindPopular.ShowModal;
end;

end.