通用记录筛选

{*******************************************************}
{                                                       }
{       记录筛选                                        }
{                                                       }
{       版权所有 (C) 2007 咏南工作室(陈新光)          }
{                                                       }
{*******************************************************}

unit uKingFilter;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, db;

type
  TColParams = record
    FieldName: string;
    Title: string;
  end;
 
  TFormSetColor = class(TForm)
    lbl1: TLabel;
    lbl2: TLabel;
    lbl3: TLabel;
    cbb1: TComboBox;
    cbb2: TComboBox;
    edt1: TEdit;
    cbb3: TComboBox;
    lst1: TMemo;
    grp1: TGroupBox;
    btn1: TButton;
    btn2: TButton;
    btn3: TButton;
    btn4: TButton;
    procedure btn4Click(Sender: TObject);
    procedure btn3Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormDestroy(Sender: TObject);
  private
    FDataset: TDataSet;
    ColArray: array of TColParams;
    procedure FillFieldCombx;
    { 确定 }
    procedure Ok;
    { 增加查询条件 }
    procedure Add;
    { 清空条件 }
    procedure Clear;
    function ConvertStr(AStr: string): string;
  public
    { Public declarations }
  end;

var
  FormSetColor: TFormSetColor;

procedure ShowFilterForm(ADataset:TDataSet); 

implementation

{$R *.dfm}

procedure ShowFilterForm(ADataset:TDataSet);
begin
  if ADataset.IsEmpty then exit;
  FormSetColor:=TFormSetColor.Create(nil);
  try
    FormSetColor.FDataset:=ADataset;
    FormSetColor.FDataset.Filtered:=False;
    FormSetColor.FillFieldCombx;
    FormSetColor.ShowModal;
  finally
    FreeAndNil(FormSetColor);
  end;
end;

procedure TFormSetColor.FillFieldCombx;
var
  I: Integer;
begin
  with FDataset do
  begin
    SetLength(ColArray,FieldCount);
    for i:=0 to FieldCount-1 do
    begin
      if Fields[i].Visible then
      begin
        ColArray[i].FieldName:=Fields[i].FieldName;
        ColArray[i].Title:=Fields[i].DisplayLabel;
        cbb1.Items.Add(Fields[i].DisplayLabel);
      end;
    end;
  end;
  cbb1.ItemIndex:=0;
end;

procedure TFormSetColor.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action:=caFree;
end;

procedure TFormSetColor.FormDestroy(Sender: TObject);
begin
  FormSetColor:=nil;
end;

procedure TFormSetColor.add;
var
  s:string;

  function GetFieldName:string;
  var
    i:Integer;
  begin
    for i:=Low(colarray) to High(colarray) do
      if ColArray[i].Title=cbb1.Text then
        Result:=ColArray[i].fieldname;
  end;

begin
  if (Trim(cbb1.Text)='') or (Trim(cbb2.Text)='') then exit;
  if (cbb2.Text<>'包含') and (edt1.Text='') then exit;
  if (cbb2.Text<>'不包含') and (edt1.Text='') then exit;
  s:=GetFieldName+' '+ConvertStr(cbb2.Text);
  if lst1.lines.Count<=0 then
  begin
    if (cbb2.Text<>'包含') and (cbb2.Text<>'不包含') then
      lst1.lines.Add(s+' '+quotedstr(edt1.Text))
    else lst1.lines.Add(s+' '+quotedstr('%'+edt1.Text+'%'));
  end else
  begin
    if cbb3.Text='' then exit;
      if (cbb2.Text<>'包含') and (cbb2.Text<>'不包含') then
        lst1.lines.Add(cbb3.Text+' '+s+' '+quotedstr(edt1.Text))
      else lst1.lines.Add(cbb3.Text+' '+s+' '+quotedstr('%'+edt1.Text+'%'));
  end;
end;

procedure TFormSetColor.Ok;
begin
  if lst1.lines.Count=0 then
    if Trim(edt1.Text)='' then Exit else Add;
  FDataset.Filtered:=True;
  FDataset.Filter:=lst1.lines.Text;
  Self.Close;
end;

procedure TFormSetColor.Clear;
begin
  if lst1.lines.Count=0 then exit;
  if Application.MessageBox('确认清除', '提示', MB_YESNOCANCEL +
    MB_ICONQUESTION) = IDYES then
    lst1.lines.Clear;
end;

function TFormSetColor.ConvertStr(AStr: string): string;
begin
  if AStr='包含' then Result:='like';
  if AStr='等于' then Result:='=';
  if AStr='不等于' then Result:='<>';
  if AStr='大于' then Result:='>';
  if AStr='小于' then Result:='<';
  if AStr='大于或等于' then Result:='>=';
  if AStr='小于或等于' then Result:='<=';
  if AStr='不包含' then Result:='not like';
end;

procedure TFormSetColor.btn4Click(Sender: TObject);
begin
  Close;
end;

procedure TFormSetColor.btn3Click(Sender: TObject);
begin
  ok;
end;

procedure TFormSetColor.btn2Click(Sender: TObject);
begin
  Clear;
end;

procedure TFormSetColor.btn1Click(Sender: TObject);
begin
  add;
end;

end.

posted @ 2008-01-24 09:07  delphi中间件  阅读(273)  评论(0编辑  收藏  举报