如何使用 TClientdatasets 的 Filter 函数来获取日期？

Question

我在 Delphi 7 中有一个 TClientDataSet，我想应用一个我在简单 TEdit 中键入的过滤器，所以它看起来像这样：

CDS.Filter:=Edit1.Text;
CDS.Filtered:=True;

现在我查看了过滤记录的帮助文件 根据它，我也应该能够过滤 DateTime-Fields。 但是每当我在我的编辑中写这样的东西时：

DAY(EDATUM)=17  

并应用过滤器我得到“表达式中的类型不匹配”-异常。

我已经尝试了上述示例的多种不同格式。

DATE(DAY(EDATUM))=DATE(DAY(17))     //Doesn't work
DAY(EDATUM)='17'                    //Doesn't work
DAY(EDATUM)=DAY(17)                 //Doesn't work   
DAY(EDATUM)=DAY(DATE('17.09.2016'))
...
...

唯一有效的是

EDATUM='17.09.2016'                 //Works

但我想分别过滤 Days 月份和年份，而不是将它们放在一个字符串中。

我在其他地方网上找到的也没有任何效果。

知道我做错了什么吗？

Edatum 是 Firebird 1.5 数据库中的时间戳。

Answer 1

如果您想使用Filter 表达式而不是OnFilterRecord 处理程序，则值得查看TExprParser 类的源代码，这是TClientDataSet 用于文本过滤器的。它包含在 Delphi 源代码的 DBCommon.Pas 单元文件中。 D7TExprParser支持以下功能：

function TExprParser.TokenSymbolIsFunc(const S: string) : Boolean;
begin
  Result := (CompareText(S, 'UPPER') = 0) or
            (CompareText(S, 'LOWER') = 0) or
            [...]
            (CompareText(S, 'YEAR') = 0) or
            (CompareText(S, 'MONTH') = 0) or
            (CompareText(S, 'DAY') = 0) or
            [...]
end;

顺便说一句，看看 TExprParser 的其余部分源代码是值得的，因为它揭示了诸如支持 SQL 中的 IN 构造之类的东西。

在我的（英国）系统上，日期在 DBGrid 中显示为 dd/mm/yyyy。鉴于此，下面显示的所有过滤器表达式都在 D7 中工作，不会产生异常并返回预期结果：

procedure TForm1.Button1Click(Sender: TObject);
begin

  //  ADate field of CDS is initialised by
  //  CDS1.FieldByName('ADate').AsDateTime := Now - random(365);

  edFilter.Text := 'ADate = ''10/2/2017''';  //  works, date format = dd/mm/yyyy
  edFilter.Text := 'Month(ADate) = 2';       //  works
  edFilter.Text := 'Year(ADate) = 2017';     //  works
  edFilter.Text := '(Day(ADate) = 10) and (Year(ADate) = 2017)';        //  works

  CDS1.Filtered := False;
  CDS1.Filter := edFilter.Text;
  CDS1.Filtered := True;
end;

如果您没有得到类似的结果，我建议您先查看您的区域设置以及日期在 TDBGrid 中的显示方式。

与其他过滤方法（即使用OnFilterRecord 事件）相比，过滤表达式并不是特别有效。

在事件处理程序中，您可以使用例如DecodeDateTime 将其解码为年、月、日等组件，并对它们的值应用您喜欢的任何测试。然后将Accept 设置为 True 或 False。

更新我从您的评论中收集到这里的答案 Delphi: check if Record of DataSet is visible or filtered 你遇到的问题是日期函数支持 TExprParser.TokenSymbolIsFunc() 不是您用户的语言。

您可以使用下面的代码来翻译过滤器表达式中的日期函数名称。 请参阅嵌入式 cmets 以了解其工作原理

type
  TForm1 = class(TForm)
    [...]
  public
    NameLookUp : TStringList;
    [...]
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  NameLookUp := TStringList.Create;
  //  Assume Y, M & C are the local-language names
  NameLookUp.Add('Y=Year');
  NameLookUp.Add('M=Month');
  NameLookUp.Add('D=Day');
  [...]
end;

procedure TForm1.Log(const Title, Msg : String);
begin
  Memo1.Lines.Add(Title + ' : ' + Msg);
end;

function TForm1.TranslateExpression(const Input : String; ADataSet : TDataSet) : String;
var
  SS : TStringStream;
  TokenText : String;
  LookUpText : String;
  Parser : TParser;
  CH : Char;
begin
  SS := TStringStream.Create(Input);
  Parser := TParser.Create(SS);
  Result := '';
  try
    CH := Parser.Token;
    //  following translates Input by parsing it using TParser from Classes.Pas
    while Parser.Token <> #0 do begin
      TokenText :=  Parser.TokenString;
      case CH of
        toSymbol : begin
          //  The following will translate TokenText for symbols
          //  but only if TokenText is not a FieldName of ADataSet
          if ADataSet.FindField(TokenText) = Nil then begin
            LookUpText := NameLookUp.Values[TokenText];
            if LookUpText <> '' then
              Result := Result + LookUpText
            else
              Result := Result + TokenText;
          end
          else
            Result := Result + TokenText;
        end;
        toString :
          //  SingleQuotes surrounding TokenText in Input and ones embedded in it
          //  will have been stripped, so reinstate the surrounding ones and
          //  double-up the embedded ones
        Result := Result + '''' + StringReplace(TokenText, '''', '''''', [rfReplaceAll]) + '''';
        else
          Result := Result + TokenText;
      end; { case }
      if Result <> '' then
        Result := Result + ' ';
      CH := Parser.NextToken;
    end;
  finally
    Parser.Free;
    SS.Free;
  end;
  Log('TransResult', Result);
end;

procedure TForm1.btnSetFilterExprClick(Sender: TObject);
begin
  //  Following tested with e.g edFilter.Text =
  //  LastName = 'aaa' and Y(BirthDate)  = 2000
  UpdateFilter2;
end;

procedure TForm1.UpdateFilter2;
var
  T1 : Integer;
begin
  CDS1.OnFilterRecord := Nil;
  T1 := GetTickCount;
  CDS1.DisableControls;
  try
    CDS1.Filtered := False;
    CDS1.Filter := TranslateExpression(edFilter.Text, CDS1);
    if CDS1.Filter <> '' then begin
      CDS1.Filtered := True;
    end;
    Log('Filter update time', IntToStr(GetTickCount - T1) + 'ms');
  finally
    CDS1.EnableControls;
  end;
end;