ukingfilter.pas

MIS工具 万能过滤 查询 网格编辑器S_CXV

unit uKingFilter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons, StdCtrls, DB, ExtCtrls, ComCtrls;

type

  {
    '等于;不等于;大于;大于或等于;小于;小于或等于;始于;并非起始于;' +
    '止于;并非结束于;包含;不包含';
  }

  TFilterLogical = (flAnd, flOr);

  TFilterCondition = (fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
    fcLess, fcLessEqual, fcBeginWith, fcNotBeginWith, fcEndWith, fcNotEndWith,
    fcContain, fcNotContain);

  { Forward declare }

  TKingFilterDialog = class;

  { TKingFilterForm }

  TKingFilter = class(TForm)
    gbFilterConditions: TGroupBox;
    lbFilter: TListBox;
    gbDefineCondition: TGroupBox;
    cbFields: TComboBox;
    Label1: TLabel;
    cbConditions: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    GroupBox1: TGroupBox;
    btNew: TSpeedButton;
    btDel: TSpeedButton;
    btOk: TSpeedButton;
    btCancel: TSpeedButton;
    btClear: TSpeedButton;
    Panel1: TPanel;
    btReplace: TSpeedButton;
    cbLink: TComboBox;
    cbValue: TComboBox;
    Label4: TLabel;
    procedure lbFilterDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbFilterDblClick(Sender: TObject);
    procedure edtValueChange(Sender: TObject);
    procedure cbFieldsChange(Sender: TObject);
    procedure btNewClick(Sender: TObject);
    procedure btDelClick(Sender: TObject);
    procedure btOkClick(Sender: TObject);
    procedure btCancelClick(Sender: TObject);
    procedure btClearClick(Sender: TObject);
    procedure btReplaceClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    FFilterDialog: TKingFilterDialog;
  public
    DataSet: TDataSet;
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  end;

  { TKingFilterDialog }

  TKingFilterDialogOption = (dfdOnlyBuildFilter);
  TKingFilterDialogOptions = set of TKingFilterDialogOption;

  //  TFilterStrings = class(TStrings)

  TKingFilterDialog = class(TComponent)
  private
    FFilterStrings: TStrings;
    FFilterFields: string;
    //    FFieldTypes: array of TFieldType;
    FDataSet: TDataSet;
    FConditions: TStrings;
    FTitle: string;
    FSaveOnFilterRecord: TFilterRecordEvent;
    FSaveFiltered: Boolean;
    FPreFiltered: Boolean;
    FOptions: TKingFilterDialogOptions;
    //    function GetDataSet: TDataSet;
    function GetFilterFields: string;
    procedure SetTitle(const Value: string);
    procedure SetDataSet(Value: TDataSet);
    procedure SetFilterFields(const Value: string);
    function CanUseFilterCondition(Field: TField; FilterCondition:
      TFilterCondition): Boolean;
    procedure FilterStringsChange(Sender: TObject);
  protected
    //    procedure InitFieldTypes;
    procedure DataSetFilterRecord(DataSet: TDataSet; var Accept: Boolean);
      virtual;
    //    property DataSet: TDataSet read GetDataSet;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean;
    function GetFilter: string; virtual;
    procedure GetFilterDescriptions(List: TStrings);
    property FilterStrings: TStrings read FFilterStrings;
  published
    property DataSet: TDataSet read FDataSet write SetDataSet;
    property FilterFields: string read GetFilterFields write SetFilterFields;
    property Title: string read FTitle write SetTitle;
    property Options: TKingFilterDialogOptions read FOptions write FOptions;
  end;

procedure ShowFilterForm(Dataset: TDataset);

var
  SaveTempFilterStr: TStringList; //保存临时的各个DATASETFILTER的记录

implementation

uses StrUtils;

{$R *.DFM}

function ExtractSubStr(const Str: string; var Pos: Integer; Delimiter: Char =
  ';'): string;
var
  I: Integer;
begin
  I := Pos;
  while (I <= Length(Str)) and (Str[I] <> Delimiter) do
    Inc(I);
  Result := Copy(Str, Pos, I - Pos);
  if (I <= Length(Str)) and (Str[I] = Delimiter) then
    Inc(I);
  Pos := I;
end;

function IndexOfFieldName(const Fields: string; Index: Integer): string;
var
  I, J, Pos: Integer;
begin
  Pos := 1;
  I := Pos;
  J := -1;
  while I <= Length(Fields) do
  begin
    if Fields[I] = ';' then
    begin
      Inc(J);
      if (J = Index) or (Index = -1) then
        Break;
      Pos := I + 1;
    end;
    Inc(I);
  end;
  Result := Trim(Copy(Fields, Pos, I - Pos));
  //  if (I <= Length(Fields)) and (Fields[I] = ';') then Inc(I);
end;

procedure ShowFilterForm(Dataset: TDataset);
var
  kFilter: TKingFilterDialog;
begin
  kFilter := TKingFilterDialog.Create(nil);
  try
    kFilter.DataSet := Dataset;
    kFilter.Execute;
  finally
    FreeAndNil(kFilter);
  end;
end;

{ TKingFilterForm }

constructor TKingFilter.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TKingFilterDialog then
    FFilterDialog := AOwner as TKingFilterDialog;
end;

procedure TKingFilter.lbFilterDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
const
  Offset = 2;
var
  I: Integer;
  S, Temp: string;
begin
  with (Control as TListBox) do
  begin
    Temp := Items[Index];
    I := 1;
    if Index <> 0 then
    begin
      if ExtractSubStr(Temp, I, ';') = '0' then
        S := '并且'
      else
        S := '或者';
    end
    else
      ExtractSubStr(Temp, I);
    //取得字段的DisplayLabel
    S := S + ' ' + DataSet.FieldByName(ExtractSubStr(Temp, I)).DisplayLabel;
    //    S := S + ' ' + TField(Items.Objects[Index]).DisplayLabel;
        //[StrToInt(ExtractSubStr(Temp, I))];
    S := S + ' ' + cbConditions.Items[StrToInt(ExtractSubStr(Temp, I))];
    S := S + ' ' + ExtractSubStr(Temp, I) + ' ;';
    Canvas.FillRect(Rect);
    Canvas.TextOut(Rect.Left + Offset, Rect.Top, S);
  end;
end;

procedure TKingFilter.lbFilterDblClick(Sender: TObject);
var
  I: Integer;
  Temp: string;
begin
  Temp := lbFilter.Items[lbFilter.ItemIndex];
  I := 1;
  cbLink.ItemIndex := StrTointdef(ExtractSubStr(Temp, I), 0); //连接符,and=0 or 1

  cbFields.ItemIndex :=
    cbFields.Items.IndexOfObject(DataSet.FieldByName(ExtractSubStr(Temp, I)));
  // cbFields.ItemIndex :=
  //   cbFields.Items.IndexOfObject(lbFilter.Items.Objects[lbFilter.ItemIndex]);
   // StrToInt(ExtractSubStr(Temp, I));
  cbFields.OnChange(cbFields);
  cbConditions.ItemIndex := cbConditions.Items.IndexOfObject(
    TObject(StrToInt(ExtractSubStr(Temp, I))));
  //  case nbValue.PageIndex of
  //    0: edtValue.Text := ExtractSubStr(Temp, I);
  //    1: cbValue.ItemIndex := cbValue.Items.IndexOf(ExtractSubStr(Temp, I));
  //    2: dtpDate.Date := StrToDateTime(ExtractSubStr(Temp, I));
  //  end;
  cbValue.Text := ExtractSubStr(Temp, I);
end;

procedure TKingFilter.edtValueChange(Sender: TObject);
begin
  //  btnAddToList.Enabled := TEdit(Sender).Text <> '';
end;

procedure TKingFilter.cbFieldsChange(Sender: TObject);
const
  maxtime = 500; //如果1000毫秒内还未完成填充动作,则就不再填充
var
  I: Integer;
  d: DWORD;
  bm: string;
begin
  //设置条件项目
  cbConditions.Clear;
  for I := 0 to FFilterDialog.FConditions.Count - 1 do
    if
      FFilterDialog.CanUseFilterCondition(TField(cbFields.Items.Objects[cbFields.ItemIndex]),
      TFilterCondition(FFilterDialog.FConditions.Objects[I])) then
      cbConditions.Items.AddObject(FFilterDialog.FConditions[I],
        FFilterDialog.FConditions.Objects[I]);
  cbConditions.Enabled := cbConditions.Items.Count > 0;
  if cbConditions.Enabled then
    cbConditions.ItemIndex := 0;
  //设置可供选择的项目
//  if not showing then
//    exit;
  d := GetTickCount;
  cbValue.Clear;
  bm := DataSet.Bookmark;
  DataSet.Filtered := False;
  DataSet.DisableControls;
  try
    try
      with DataSet do
      begin
        First;
        while not Eof do
        begin
          //填充值到cbValue中了
          if
            cbValue.Items.IndexOf(TField(cbFields.Items.Objects[cbFields.ItemIndex]).AsString) = -1 then
            cbValue.Items.Add(TField(cbFields.Items.Objects[cbFields.ItemIndex]).AsString);
          if (GetTickCount - d) >= maxtime then
            Break; //如果时间到了,则退出不执行了
          Next;
        end;
      end;
      //      Caption:=IntToStr(cbValue.Items.Count);
      DataSet.Bookmark := bm;
    except
    end;
  finally
    DataSet.EnableControls;
  end;

  //  case TField(cbFields.Items.Objects[cbFields.ItemIndex]).DataType of
  //    ftBoolean: nbValue.PageIndex := 1;
  //    ftDate, ftDateTime: nbValue.PageIndex := 2;
  //    ftString, ftWideString, ftFixedChar, ftMemo, ftFmtMemo:
  //      cbConditions.ItemIndex :=
  //        cbConditions.Items.IndexOfObject(TObject(fcContain));
  //  else
  //    nbValue.PageIndex := 0;
  //  end;
end;

{ TKingFilterDialog }

constructor TKingFilterDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FConditions := TStringList.Create;
  with FConditions do
  begin
    AddObject('等于', TObject(fcEqual));
    AddObject('不等于', TObject(fcNotEqual));
    AddObject('大于', TObject(fcGreat));
    AddObject('大于或等于', TObject(fcGreatEqual));
    AddObject('小于', TObject(fcLess));
    AddObject('小于或等于', TObject(fcLessEqual));
    AddObject('始于', TObject(fcBeginWith));
    AddObject('并非起始于', TObject(fcNotBeginWith));
    AddObject('止于', TObject(fcEndWith));
    AddObject('并非结束于', TObject(fcNotEndWith));
    AddObject('包含', TObject(fcContain));
    AddObject('不包含', TObject(fcNotContain));
  end;
  FTitle := '智能筛选';
  FFilterStrings := TStringList.Create;
  TStringList(FFilterStrings).OnChange := FilterStringsChange;
end;

destructor TKingFilterDialog.Destroy;
begin
  FConditions.Free;
  FFilterStrings.Free;
  FDataSet := nil;
  inherited;
end;

function TKingFilterDialog.CanUseFilterCondition(Field: TField;
  FilterCondition: TFilterCondition): Boolean;
begin
  case Field.DataType of
    ftUnknown, ftString, ftFixedChar, ftWideString, ftMemo, ftVariant, ftBlob,
      ftFmtMemo:
      Result := True;
    ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftBytes,
      ftVarBytes, ftAutoInc, ftLargeint:
      Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
        fcLess, fcLessEqual];
    ftBoolean: Result := FilterCondition in [fcEqual, fcNotEqual];
    ftDate, ftTime, ftDateTime:
      Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
        fcLess, fcLessEqual];
    {ftGraphic, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT
    ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
    ftIDispatch, ftGuid}
  else
    Result := False;
  end;
end;

procedure TKingFilterDialog.DataSetFilterRecord(DataSet: TDataSet; var Accept:
  Boolean);

  function CompareFieldValue(Field: TField; Value: string): Double;
  begin
    case Field.DataType of
      //      ftUnknown, ftString, ftFixedChar, ftWideString, ftMemo, ftVariant, ftBlob,
      //      ftFmtMemo:
      //        Result := True;
      ftSmallint, ftInteger, ftWord, ftAutoInc, ftLargeint:
        Result := Field.AsInteger - StrToInt(Value);
      ftFloat, ftCurrency, ftBCD, ftBytes, ftVarBytes:
        Result := Field.AsFloat - StrToFloat(Value);
      //        Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
      //          fcLess, fcLessEqual];
      ftBoolean: if Field.AsBoolean and (Value = '是') or
        (not Field.AsBoolean and (Value = '否')) then
          Result := 0
        else
          Result := 1; //FilterCondition in [fcEqual, fcNotEqual];
      ftDate: Result := Trunc(Field.AsDateTime) - StrToDate(Value);
      ftDateTime: Result := Field.AsDateTime - StrToDateTime(Value);
      ftTime: Result := Frac(Field.AsDateTime) - StrToTime(Value);
      //        Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
      //          fcLess, fcLessEqual];
            {ftGraphic, ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftADT
            ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob, ftInterface,
            ftIDispatch, ftGuid}
    else
      Result := AnsiCompareStr(Trim(Field.DisplayText), Value);
    end;
  end;

var
  I, APos: Integer;
  Condition: TFilterCondition;
  FieldName, Value, Temp: string;
  e: TFilterRecordEvent;
  s: string; //用来存放Dataset的全局命称,如Form1.Dataset1
begin
  //这个函数就厉害了,它是用数据集的onfilter事件做过滤的,而且还能保存其原有的过滤代码
  Accept := True;
  //  if Accept = False then ShowMessage('Accept');
//如果用户已经指定了数据集的过滤事件,则先调用