Delphi DBGrids 组件内实现查询

本文整理自网络，侵删。

 

Unit1文件
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, DBClient, Grids, DBGrids, StdCtrls, ComCtrls,
  System.Generics.Collections, MidasLib;

type
  TfrmMain = class(TForm)
    ClientDataSet1: TClientDataSet;
    DataSource1: TDataSource;
    DBGrid1: TDBGrid;
    procedure DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect; DataCol: Integer; Column: TColumn; State: TGridDrawState);
    procedure DBGrid1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    SearchText : string;
  end;

var
  frmMain: TfrmMain;


implementation

uses
  Types, UdlgSearch;

{$R *.dfm}

procedure TfrmMain.DBGrid1DrawColumnCell(Sender: TObject; const Rect: TRect;
          DataCol: Integer; Column: TColumn; State: TGridDrawState);
var
  r1, r2, r3: TRect;
  s1, s2, s3: string;
begin

  if (SearchText = EmptyStr) or (Pos(UpperCase(SearchText), UpperCase(Column.Field.AsString)) = 0) then
    exit;


  r1 := Rect;
  r2 := Rect;
  r3 := Rect;


  s3 := Copy(Column.Field.AsString, 1, Pos(SearchText, Column.Field.AsString)-1);

  DBGrid1.Canvas.FillRect(Rect);
  DBGrid1.Canvas.Font.Color := clBlue;
  DBGrid1.Canvas.Font.Style := [fsbold];
  DrawText(DBGrid1.Canvas.Handle, PChar(s3), Length(s3), r3, DT_CALCRECT);
  DBGrid1.Canvas.TextOut(r3.Left, r2.Top, s3);

  //www.delphitop.com
  s1 := copy(Column.Field.AsString,Pos(SearchText,Column.Field.AsString),length(SearchText));
  DBGrid1.Canvas.Font.Assign(DBGrid1.Font);
  DBGrid1.Canvas.Font.Color := clGreen;
  DBGrid1.Canvas.Font.Style := [fsbold];
  r1.Left := r3.Right;
  DrawText(DBGrid1.Canvas.Handle, pchar(s1), length(s1), r1, DT_CALCRECT);
  DBGrid1.Canvas.TextOut(r1.Left, r1.Top, s1);


  s2 := StringReplace(Column.Field.AsString, s3+s1, '', []);
  DBGrid1.Canvas.Font.Assign(DBGrid1.Font);
  DBGrid1.Canvas.Font.Color := clBlue;
  DBGrid1.Canvas.Font.Style := [fsbold];
  r2.Left := r1.Right;
  DrawText(DBGrid1.Canvas.Handle, pchar(s2), length(s2), r2, 0);
  DBGrid1.Canvas.TextOut(r2.Left, r2.Top, s2);
end;

procedure TfrmMain.DBGrid1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (ssCtrl in Shift) and (Key = 70) then
    begin
      CreateSearchForm(ClientDataSet1);
    end;
end;

end.

UdlgSearch.pas
unit UdlgSearch;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms,DB,DBClient, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ImgList, System.Generics.Collections,
  Vcl.ComCtrls, System.ImageList;

type
  TdlgSearch = class(TForm)
    edtSearch: TEdit;
    btnNext: TButton;
    btnPrior: TButton;
    btnFirst: TButton;
    btnLast: TButton;
    ImageList1: TImageList;
    lvFind: TListView;
    procedure edtSearchChange(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure btnFirstClick(Sender: TObject);
    procedure btnLastClick(Sender: TObject);
    procedure btnNextClick(Sender: TObject);
    procedure btnPriorClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure lvFindDblClick(Sender: TObject);
  private
    FClientDataSet : TClientDataSet;
  public
    procedure OnCDSFilterRecord(DataSet: TDataSet; var Accept: Boolean);
  published
    property ClientDataSet : TClientDataSet read FClientDataSet write FClientDataSet;
  end;

  TSeachItem = class
    FRecNo : Integer;
    FColName : string;
    FValue : string;
  end;

function CreateSearchForm(CDS:TClientDataSet):TdlgSearch;

var
  dlgSearch: TdlgSearch;
  CurrSearchIndex : Integer;
  FindList: TList<TSeachItem>;

implementation

uses
  Unit1;

{$R *.dfm}

function CreateSearchForm(CDS:TClientDataSet):TdlgSearch;
begin
  Result := TdlgSearch.Create(nil);
  Result.ClientDataSet := CDS;
  Result.Show;
end;

procedure TdlgSearch.btnFirstClick(Sender: TObject);
begin
  if FindList.Count > 0 then
    FClientDataSet.Locate(
                          FindList[0].FColName,
                          FindList[0].FValue,
                          []
                          );
  CurrSearchIndex := 0;
end;

procedure TdlgSearch.btnLastClick(Sender: TObject);
begin
  if FindList.Count > 0 then
    FClientDataSet.Locate(
                          FindList[FindList.Count-1].FColName,
                          FindList[FindList.Count-1].FValue,
                          []
                          );
  CurrSearchIndex := FindList.Count-1;
end;

procedure TdlgSearch.btnNextClick(Sender: TObject);
begin
  if CurrSearchIndex < FindList.Count-1 then
    begin
      FClientDataSet.Locate(
                            FindList[CurrSearchIndex+1].FColName,
                            FindList[CurrSearchIndex+1].FValue,
                            []
                            );
      Inc(CurrSearchIndex);
    end;
end;

procedure TdlgSearch.btnPriorClick(Sender: TObject);
begin
  if CurrSearchIndex > 0 then
    begin
      FClientDataSet.Locate(
                            FindList[CurrSearchIndex-1].FColName,
                            FindList[CurrSearchIndex-1].FValue,
                            []
                            );
      Inc(CurrSearchIndex,-1);
    end;
end;

procedure TdlgSearch.edtSearchChange(Sender: TObject);
begin
  lvFind.Clear;
  CurrSearchIndex := -1;
  FindList.Clear;
  FClientDataSet.Filtered := False;
  FClientDataSet.Filtered := edtSearch.Text <> '';
  FClientDataSet.Filtered := False;
  frmMain.SearchText := edtSearch.Text;
end;

procedure TdlgSearch.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FindList.Free;
  frmMain.SearchText := EmptyStr;
  frmMain.DBGrid1.Invalidate;
end;

procedure TdlgSearch.FormCreate(Sender: TObject);
begin
  FindList := TList<TSeachItem>.Create();
end;

procedure TdlgSearch.FormShow(Sender: TObject);
begin
  FClientDataSet.OnFilterRecord := OnCDSFilterRecord;
end;

procedure TdlgSearch.lvFindDblClick(Sender: TObject);
begin
  if Not Assigned(lvFind.Selected) then Exit;

  FClientDataSet.Locate(
                        TSeachItem(lvFind.Selected.Data).FColName,
                        TSeachItem(lvFind.Selected.Data).FValue,
                        []
                        );
  CurrSearchIndex := StrToInt(lvFind.Selected.Caption)-1;
end;

procedure TdlgSearch.OnCDSFilterRecord(DataSet: TDataSet; var Accept: Boolean);
var
  i,j: integer;
  SrcItem : TSeachItem;
  lvItem : TListItem;
begin
  for i := 0 to DataSet.FieldCount - 1 do
  begin
    Accept := Pos(UpperCase(edtSearch.Text), UpperCase(DataSet.Fields[i].AsString)) > 0;
    if Accept then
      begin
        SrcItem := TSeachItem.Create;
//      SrcItem.FRecNo   := DataSet.;
        SrcItem.FColName := DataSet.Fields[i].FieldName;
        SrcItem.FValue   := DataSet.Fields[i].AsString;
        FindList.Add(SrcItem);

        lvItem := lvFind.Items.Add;
        with lvItem do
          begin
            Data := SrcItem;
            Caption := Inttostr(FindList.Count);
            SubItems.Add(SrcItem.FColName);
            SubItems.Add(SrcItem.FValue);
          end;

        Exit;
      end;
  end;
end;

end.

 

相关阅读 >>

Delphi获取宽带ip

Delphi让tedit控件的内容居中或右对齐，限制位数，仅允许输入数字

Delphi qq尾巴病毒的编写

Delphi utf-8

Delphi 安卓蓝牙动态权限

Delphi 调用ie隐藏的命令

Delphi 使用 tedgebrowser 组件

Delphi利用文件流把文件拆分与合并

线程池的概念

Delphi发送邮件

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » Delphi DBGrids 组件内实现查询