ukingfilter.pas

delphi源码 delphi源码 delphi源码 delphi源码 delphi源码

unit uKingFilter;

interface

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

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)
    gbDefineCondition: TGroupBox;
    cbFields: TComboBox;
    Label1: TLabel;
    cbConditions: TComboBox;
    Label2: TLabel;
    Label3: TLabel;
    cbLink: TComboBox;
    cbValue: TComboBox;
    GroupBox1: TGroupBox;
    btNew: TSpeedButton;
    btDel: TSpeedButton;
    btOk: TSpeedButton;
    btCancel: TSpeedButton;
    btClear: TSpeedButton;
    btReplace: TSpeedButton;
    gbFilterConditions: TGroupBox;
    lbFilter: TListBox;
    Panel1: TPanel;
    Label4: TLabel;
    btAddtodb: TSpeedButton;
    btDelFromDb: TSpeedButton;
    cbSavedList: TComboBox;
 //   siLang1: TsiLang;
    procedure lbFilterDrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure lbFilterDblClick(Sender: TObject);
    procedure edtValueChange(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 cbSavedListChange(Sender: TObject);
    procedure btAddtodbClick(Sender: TObject);
    procedure btDelFromDbClick(Sender: TObject);
    procedure cbFieldsChange(Sender: TObject);
    procedure checkValueType(Sender: TObject);
  private
    { Private declarations }
    FFilterDialog: TKingFilterDialog;
  public
    DataSet: TDataSet;
    procedure LoadDBCondition;

    { 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;

{ 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 := AnsiCompareStr(Trim(Field.DisplayText), Value);
      // Result := Field.AsFloat - StrToFloat(Value);
   //        Result := FilterCondition in [fcEqual, fcNotEqual, fcGreat, fcGreatEqual,
   //          fcLess, fcLessEqual];
      ftBoolean: if (Field.AsBoolean = StrToBoolDef(Value, True)) 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
  st: TStringList; //用来存放当前DATASET的FILTER条件
begin
  //这个函数就厉害了,它是用数据集的onfilter事件做过滤的,而且还能保存其原有的过滤代码
  Accept := True;
  //  if Accept = False then ShowMessage('Accept');
//如果用户已经指定了数据集的过滤事件,则先调用

//if Assigned(FSaveOnFilterRecord) then
//  FSaveOnFilterRecord(DataSet, Accept);

  s := DataSet.Owner.Name + '.' + DataSet.Name;
  st := TStringList.Create;
  try
    st.Text := SaveTempFilterStr.Values[s];
    s := s + '=' + st.Text;
    TMethod(e).Code := SaveTempFilterStr.Objects[SaveTempFilterStr.IndexOf(s)];
    if Assigned(E) then
    begin
      e(DataSet, Accept);
    end;

    if Accept then
      for I := 0 to st.Count - 1 do
      begin
        // Temp := SaveTempFilterStr.Values[DataSet.Owner.Name + '.' + DataSet.Name];
         //      ShowMessage(Temp);
        temp := st[i];

        APos := 1;
        if I <> 0 then
        begin
          if ExtractSubStr(Temp, APos, ';') = '0' then // Logic AND
          begin
            if not Accept then
              Break
          end
          else if Accept then
            Break;
        end
        else
          ExtractSubStr(Temp, APos, ';');
        // FieldName := TField(FFilterStrings.Objects[I]).FieldName;
        FieldName := ExtractSubStr(Temp, APos, ';');
        //ExtractFieldName(Temp, APos);//IndexOfFieldName(FFilterFields, StrToInt(ExtractFieldName(Temp, APos)));
        Condition := TFilterCondition(StrToInt(ExtractSubStr(Temp, APos, ';')));
        Value := ExtractSubStr(Temp, APos, ';');
        //      if DataSet.FieldByName(FieldName).DataType in [ftDate, ftDateTime] then
        //        Value := DateToStr(StrToDate(Value));
        case Condition of
          fcEqual: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
              Value) = 0;
          fcNotEqual: Accept :=
            CompareFieldValue(DataSet.FieldByName(FieldName),
              Value) <> 0;
          fcGreat: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
              Value) > 0;
          fcGreatEqual: Accept :=
            CompareFieldValue(DataSet.FieldByName(FieldName), Value) >= 0;
          fcLess: Accept := CompareFieldValue(DataSet.FieldByName(FieldName),
              Value) < 0;
          fcLessEqual: Accept :=
            CompareFieldValue(DataSet.FieldByName(FieldName),
              Value) <= 0;
          fcBeginWith: Accept :=
            LeftStr(DataSet.FieldByName(FieldName).AsString,
              Length(Value)) = Value;
          fcNotBeginWith: Accept :=
            LeftStr(DataSet.FieldByName(FieldName).AsString, Length(Value)) <>
              Value;
          fcEndWith: Accept := RightStr(DataSet.FieldByName(FieldName).AsString,
              Length(Value)) = Value;
          fcNotEndWith: Accept :=
            RightStr(DataSet.FieldByName(FieldName).AsString, Length(Value)) <>
              Value;
          fcContain: Accept := AnsiPos(Value,
              DataSet.FieldByName(FieldName).AsString) > 0;
          fcNotContain: Accept := AnsiPos(Value,
              DataSet.FieldByName(FieldName).AsString) = 0;
        end;
        //      ShowMessage(DataSet.FieldByName(FieldName).AsString + ' - ' + Value + ' = ' +
        //        FloatToStr(CompareFieldValue(DataSet.FieldByName(FieldName), Value)));
      end;
  finally
    FreeAndNil(st);
  end;
end;

//function TKingFilterDialog.GetDataSet: TDataSet;
//begin
//  if Assigned(FDataSource) then Result := FDataSource.DataSet
//  else Result := nil;
//end;

function TKingFilterDialog.GetFilter;

  function ValueToFilterText(const FieldName, Value: string): string;
  begin
    if Assigned(DataSet) then
      case DataSet.FieldByName(FieldName).DataType of
        ftSmallint, ftInteger, ftWord, ftAutoInc: Result := Value;
        ftFloat, ftCurrency, ftBCD, ftVarBytes, ftBytes, ftTypedBinary: Result
          := Value;
        //       ftDate, ftTime, ftDateTime:
        ftBoolean:
          if Value = ('是') then
            Result := 'True'
          else
            Result := 'False';
      else
        Result := '''' + Value + '''';
      end
    else
      Result := Value;
  end;

var
  Temp, FieldName: string;
  I, Pos: Integer;
begin
  Result := '';
  for I := 0 to FFilterStrings.Count - 1 do
  begin
    Temp := FFilterStrings[I];
    Pos := 1;
    if I <> 0 then
    begin
      if ExtractSubStr(Temp, Pos, ';') = '0' then
        Result := Result + ' AND '
      else
        Result := Result + ' OR ';
    end