如何使用TClientdatasets的Filter函数作为日期?

时间:2017-02-10 16:13:54

标签: delphi filter tclientdataset

我在Delphi 7中有一个TClientDataSet,我想将一个我输入的过滤器应用到一个简单的TEdit中,所以它看起来像这样:

DAY(EDATUM)=17  

现在我查看帮助文件以过滤记录 根据它,我应该能够过滤DateTime-Fields。 但每当我写这样的东西到我的编辑:

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

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

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

EDATUM='17.09.2016'                 //Works

唯一有效的是

{{1}}

但是我希望单独过滤几天和几年,而不是将它们放在一起。

我在网上找到的其他任何东西都没有。

任何想法我做错了什么?

Edatum是Firebird 1.5数据库中的TimeStamp。

1 个答案:

答案 0 :(得分:7)

如果你想使用Filter表达式而不是OnFilterRecord处理程序,那么值得看一下TExprParser类的来源,这是TClientDataSet用于文本的内容过滤器。它包含在Delphi源代码中的DBCommon.Pas单元文件中。 D7 TExprParser支持以下功能:

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()不是您用户的语言。

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

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;