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.

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;

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;

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;

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.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.

推荐分享