Delphi:检查数据集的记录是否可见或过滤 [英] Delphi: check if Record of DataSet is visible or filtered

问题描述

在工作中，我们有一个名为ClientdatasetGrid"的组件，它允许用户通过单击一个或多个列标题来对网格的记录进行排序.

At work we have a component called a "ClientdatasetGrid", which allows the user to sort the records of the grid by clicking on one or multiple column-titles.

我还制作了一个用于工作的组件，它是 TEdit 的后代，我称之为 TDBFilterEdit.

I have made a component for work also, a descendant from TEdit, which I call TDBFilterEdit.

一旦您为其分配了 DataSet 或 DBGrid，它就会为 DataSet 创建一个 OnFilterRecord 事件，并且在您停止更改该事件执行的文本之后.

once you assign a DataSet or DBGrid to it, it creates an OnFilterRecord event for the DataSet and after you stop changing the text that Event is executed.

只要数据集已经过滤并且用户对网格进行排序，就会出现问题.

the problem arises whenever the Dataset is already filtered and the user sorts the grid.

网格组件通过首先删除当前 IndexDef、更新、添加新索引并再次更新来将 IndexDefs 添加到 Clientdataset.

the grid-component adds IndexDefs to the Clientdataset by first deleteing the current IndexDef, Updating, Adding the new Index and updating again.

每当删除或添加索引时，都会触发我的 OnFilterRecord 事件.我通过禁用控件并从网格内部对 OnFilterRecord 事件进行 NIL 处理来缓解这种情况，直到添加新索引.

whenever an index is deleted or added my OnFilterRecord event is triggered. I mitigated this by disableing controls and NIL-ing the OnFilterRecord event from inside the grid until the new index is added.

cds.DisableControls();
try
  extProc:=nil;  
  if (TMethod(cds.OnFilterRecord).Code<>nil) and (TMethod(cds.OnFilterRecord).Data<>nil) then 
  begin
    TMethod(extProc):=TMethod(cds.OnFilterRecord);
    cds.OnFilterRecord:=nil;
  end; 
  ...
  ...  //<-- Delete Index & create new Index
  ...
finally
  cds.OnFilterRecord:=extProc;
  cds.EnableControls();  
end;

一旦再次分配事件，它会立即被调用并遍历所有 X 记录，即使用户可能只看到 5 条记录.

Once the Event is assigned again, it is immeadeately called and is iterating through all X records even though the user may only see 5.

现在我正在寻找一种方法来查看记录是否已被过滤掉，以便如果文本没有更改，我可以在过滤器方法中跳过它.

Now I am searching for a way to see if a record is already filtered out so I can skip it inside my filter-method if the text hasn't changed.

由于需要 MVCE，我将发布我的 OnFilterRecord 过程的简短版本.

Since a MVCE has been demanded I'll post a short version of my OnFilterRecord procedure.

• 每次组件在 1 秒内未收到输入时，都会执行以下过程
• fStringtypes 和 fTimeTypes 都是一组 TFieldType
• fStringTypes:=[ftString,ftMemo,ftFMTMemo,ftFixedChar,ftWideString];
• fTimeTypes:=[ftDate,ftTime,ftDateTime,ftTimeStamp];

• 程序完成后，定时器被禁用，控件再次启用.

• the following procedure is executed everytime the component hasn't recieved an input for 1 second
• fStringtypes and fTimeTypes are both a set of TFieldType
• fStringTypes:=[ftString,ftMemo,ftFMTMemo,ftFixedChar,ftWideString];
• fTimeTypes:=[ftDate,ftTime,ftDateTime,ftTimeStamp];

• after the procedure is completely finished the timer is disabled and controls are enabled again.

procedure TDBEditFilter.FilterRecords(DataSet:TDataSet; var Accept:Boolean);
var
  ...
begin
  //initiliaztion//
  s:=FilterText;  //Filtertext=User Input into the TDBEditFilters Textfield
  TestFloat:=0;    
  Accept:=False;
  /////////////////

  for i:=0 to fDBGrid.Columns.Count-1 do  //for all DBGrid-Columns
  begin           
    if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType in fStringTypes then
    begin                 
      Strvalue:=fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).AsString;

      Accept:=AnsiContainsText(Strvalue,s); //<--to ignore Upper/lowercase
    end
    else if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType in fTimeTypes then  
    begin

       StrValue:=DateTimeToStr(fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).As   DateTime,Local_Form_Settings);
      Accept:=Pos(StrValue,s)<>0;
    end
    else if fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).DataType=ftBlob then
    begin
      //ignore Blob
    end
    else //whatever fieldtype is left must be a numeric Field-type like integer or float
    begin 
      if TryStrToFloat(s,TestFloat)=True then
      begin
        Accept:=(TestFloat=fDataSet.FieldByName(fDBGrid.Columns[i].FieldName).AsFloat);
      end;
    end;

    if Accept=True then break;  //stop checking this record and check next record
  end; 
end;

推荐答案

我想我会把这个作为单独的答案发布，因为我一直在尝试使用过滤器 TEdit"，它的工作方式与我猜你的类似，但它没有似乎表现出任何特定的性能问题.我的主要假设是，您对每个感兴趣的数据字段使用一个过滤器 TEdit，而不是用户在其中键入复合 Sql 式表达式(包括字段名称、比较运算符等)的单个过滤器.

I thought I would post this as a separate answer because I've been experimenting with a "Filter TEdit" that works in a similar way as I'm guessing yours does, and it doesn't seem to exhibit any particular performance problems. My main assumption is that you are using one filter TEdit per datafield of interest, rather that a single one into which the user types a compound Sql-like expression including the field names, comparison operators, etc.

我不得不做出的猜测数量就是为什么我说包含 MCVE 会对您有所帮助.

The number of guesses I've had to make is why I said it would have been helpful for you to include an MCVE.

我把它写成独立的，即它生成自己的数据而不是需要一个外部数据库.

I've written it to be self-contained, i.e. it generates its own data instead of needing an external database.

如果您尝试一下，您就会发现，使用包含 3000 条记录的 CDS，更新过滤器的时间是几十毫秒(在我的笔记本电脑上不到 20 毫秒).如果 CDS 包含 30000 条记录，则过滤器更新时间大致呈线性增长大约 200 毫秒，这对于 gui-responsivenes pov 来说似乎是完全可以接受的.

As you'll see if you try it, with a CDS containing, say, 3000 records, the time to update the filters is a few tens of milliseconds (under 20 on my laptop). If the CDS contains 30000 records, the filter update time increases roughly linearly to about 200 ms which seems perfectly acceptable from a gui-responsivenes pov.

(传统上，当记录数达到数万时，TCDS 被认为在性能方面会遇到障碍)

(Traditionally, TCDSs have been regarded as hitting a brick wall performance-wise when the number of records gets into the tens of thousands)

请注意，为简单起见

a) 我没有将 DateTime 字段用于 BirthDate 或其他任何内容，因为处理用户输入的部分日期很复杂.

a) I haven't used a DateTime fiield for BirthDate or whatever, because of the complications of dealing with partial dates inputted by the user.

b) 在 OnFilterRecord 事件中，LastName、FirstName 和 Age 比较通过将字段作为字符串与相应的过滤器表达式进行比较来完成.

b) In the OnFilterRecord event, the LastName, FirstName and Age comparisons are done by comparing the field as a string with the corresponding filter expression.

c) 过滤器表达式，如果非空白，则用星号左右填充值比较是使用 Masks 单元中的 MatchesMask 函数完成的.请参阅 FilterExpr.

c) The Filter expressions, if non-blank are left- and right-padded with asterisks and the value comparisons are done using the MatchesMask function from the Masks unit. See FilterExpr.

d) IndexDef 的 FieldNames 由字段的名称组成过滤器编辑的文本是非空白的.

d) The IndexDef's FieldNames are composed of the names of the fields for which the filter edit's text is non-blank.

e) 如果用户快速键入几个 gui 更新太慢字符连续进入 TEdits，您可以通过以下方式解决此问题用他们的 KeyUp 事件中的代码替换 TEdits 的 OnChange 事件代码这启用了一个间隔为 150 毫秒的 TTimer.然后，在其 OnTimer 中，调用 UpdateFilter.

e) If the gui-updating is too slow if the user rapidly types several characters in succession into the TEdits, you can work around this by replacing the TEdits' OnChange event code by code in their KeyUp event which enables a TTimer which has an interval of, say, 150 ms. Then, in its OnTimer, call UpdateFilter.

代码:

  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    CDS1: TClientDataSet;
    DataSource1: TDataSource;
    Memo1: TMemo;
    CDS1ID: TIntegerField;
    CDS1Age: TIntegerField;
    CDS1LastName: TStringField;
    CDS1FirstName: TStringField;
    edLastNameFilter: TEdit;
    edFirstNameFilter: TEdit;
    edAgeFilter: TEdit;
    procedure CDS1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
    procedure edLastNameFilterChange(Sender: TObject);  //  Set the OnChange events for the
    //  FirstName and Age TEdits to this, too
    procedure FormCreate(Sender: TObject);
  private
    procedure Log(const Title, Msg: String);
    function FilterExpr(const Input: String): String;
  protected
  public
    LastNameFilter,
    FirstNameFilter,
    AgeFilter : String;
    IndexFields : String;
    IndexDef : TIndexDef;
    procedure UpdateFilterExprsAndIndex;
    procedure UpdateFilter;
  end;

[...]
rocedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
  Ch1,
  Ch2 : Char;
  LastName,
  FirstName : String;
  Age : Integer;
begin
  CDS1.CreateDataSet;
  CDS1.DisableControls;
  try
    for i := 1 to 30000 do begin
      Ch1 := Chr(Ord('a') + random(26));
      Ch2 := Chr(Ord('a') + random(26));
      LastName:= StringOfChar(Ch1, 1 + Random(10));
      FirstName := StringOfChar(Ch2, 1 + Random(10));
      Age := Trunc(Random(71));
      CDS1.InsertRecord([i, LastName, FirstName, Age]);
    end;
  finally
    CDS1.First;
    CDS1.EnableControls;
  end;
end;

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

procedure TForm1.CDS1FilterRecord(DataSet: TDataSet; var Accept: Boolean);
begin
  Accept := True;
  if LastNameFilter <> '' then
    Accept := MatchesMask(CDS1LastName.AsString, LastNameFilter);
  if not Accept then exit;

  if FirstNameFilter <> '' then
    Accept := Accept and MatchesMask(CDS1FirstName.AsString, FirstNameFilter);
  if not Accept then exit;

  if AgeFilter <> '' then
    Accept := Accept and MatchesMask(CDS1Age.AsString, AgeFilter);
end;

procedure TForm1.edLastNameFilterChange(Sender: TObject);
begin
  UpdateFilter;
end;

procedure TForm1.UpdateFilter;
var
  T1 : Integer;
begin
  T1 := GetTickCount;
  UpdateFilterExprsAndIndex;
  CDS1.DisableControls;
  try
    CDS1.Filtered := False;
    if (edLastNameFilter.Text <> '') or (edFirstNameFilter.Text <> '') or (edAgeFilter.Text <> '') then begin
      CDS1.Filtered := True;
    end;
    if IndexFields <> '' then
      CDS1.IndexDefs[0].Fields := IndexFields;  //  Warning: This IndexDef needs to exist
    Log('Filter update time', IntToStr(GetTickCount - T1) + 'ms');
  finally
    CDS1.EnableControls;
  end;
end;

function TForm1.FilterExpr(const Input : String) : String;
begin
  Result := Input;
  if Result <> '' then
    Result := '*' + Result + '*';
end;

procedure TForm1.UpdateFilterExprsAndIndex;
begin
  LastNameFilter := FilterExpr(edLastNameFilter.Text);
  FirstNameFilter := FilterExpr(edFirstNameFilter.Text);
  AgeFilter := FilterExpr(edAgeFilter.Text);

  IndexFields := '';
  if LastNameFilter <> '' then
    IndexFields := 'LastName';
  if FirstNameFilter <> '' then begin
    if IndexFields <> '' then
      IndexFields := IndexFields + ';';
    IndexFields := IndexFields + 'FirstName';
  end;
  if AgeFilter <> '' then begin
    if IndexFields <> '' then
      IndexFields := IndexFields + ';';
    IndexFields := IndexFields + 'Age';
  end;
end;

我希望这至少能给你一个与你自己比较的基础代码，以便您可以识别任何瓶颈.

I hope this at least gives you a basis for comparison with your own code so that you can identify any bottlenecks.

更新令我惊讶的是，我发现使用我用于测试的复合过滤器表达式，设置 CDS 的 Filter 快得多代码> 到表达式，并使用 OnFilterRecord 进行过滤，对于 30000 条记录，UpdateFilter2 需要不到 20 毫秒，而使用类似的表达式集则需要 200 毫秒`UpdateFilter'.

Update Rather to my surprise, I found that with the compound filter expression I used for testing, it is much faster to set the CDS's Filter to the expression and leave it do to the filtering using OnFilterRecord, With 30000 records, UpdateFilter2 takes under 20 ms, compared with 200 ms for a similar expression set using the `UpdateFilter'.

procedure TForm1.btnSetFilterExprClick(Sender: TObject);
begin
  edFilter.Text := 'LastName=''aaa'' and FirstName = ''zz'' and Age > 30 ';
  UpdateFilter2;
end;

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

这篇关于Delphi:检查数据集的记录是否可见或过滤的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！