bufDataSet排序

https://wiki.lazarus.freepascal.org/How_to_write_in-memory_database_applications_in_Lazarus/FPC

https://wiki.lazarus.freepascal.org/Databases/zh_CN

 Sorting DBGrid on TitleClick event for TBufDataSet

If you wish to enable consecutive ascending and descending sorting of a DBGrid showing some data from TBufDataSet, you could use the following method:

Uses
  BufDataset, typinfo;

function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
var
  i: Integer;
  IndexDefs: TIndexDefs;
  IndexName: String;
  IndexOptions: TIndexOptions;
  Field: TField;
begin
  Result := False;
  Field := DataSet.Fields.FindField(FieldName);
  //If invalid field name, exit.
  if Field = nil then Exit;
  //if invalid field type, exit.
  if {(Field is TObjectField) or} (Field is TBlobField) or
    {(Field is TAggregateField) or} (Field is TVariantField)
     or (Field is TBinaryField) then Exit;
  //Get IndexDefs and IndexName using RTTI
  if IsPublishedProp(DataSet, 'IndexDefs') then
    IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
  else
    Exit;
  if IsPublishedProp(DataSet, 'IndexName') then
    IndexName := GetStrProp(DataSet, 'IndexName')
  else
    Exit;
  //Ensure IndexDefs is up-to-date
  IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
  IndexDefs.Update;
  //If an ascending index is already in use,
  //switch to a descending index
  if IndexName = FieldName + '__IdxA'
  then
    begin
      IndexName := FieldName + '__IdxD';
      IndexOptions := [ixDescending];
    end
  else
    begin
      IndexName := FieldName + '__IdxA';
      IndexOptions := [];
    end;
  //Look for existing index
  for i := 0 to Pred(IndexDefs.Count) do
  begin
    if IndexDefs[i].Name = IndexName then
      begin
        Result := True;
        Break
      end;  //if
  end; // for
  //If existing index not found, create one
  if not Result then
      begin
        if IndexName=FieldName + '__IdxD' then
          DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
        else
          DataSet.AddIndex(IndexName, FieldName, IndexOptions);
        Result := True;
      end; // if not
  //Set the index
  SetStrProp(DataSet, 'IndexName', IndexName);
end;

So, you can call this function from a DBGrid in this way:

procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
begin
 SortBufDataSet(Products, Column.FieldName);
end;

 

Sorting multiple columns in grid
I have written TDBGridHelper for sorting grid by multiple columns while holding shift key. Note MaxIndexesCount must be set quite large for TBufDataSet because there can be quite large combinations of possible sorting options. But I think people would not use more than 10 so setting it 100 should be teoretically Ok.

 

{ TDBGridHelper }

  TDBGridHelper = class helper for TDBGrid
  public const
    cMaxColCOunt = 3;
  private
    procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
    procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
    function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
  public
    procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
    procedure ClearSort;
  end;  

{ TDBGridHelper }

procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
var
  FldList: TStringList;
  DscList: TStringList;
  FldDesc, FldName: String;
  i: Integer;
begin
  if Fields.Count = 0 then
  begin
    FieldsList := '';
    DescFields := '';
    Exit;
  end;

  FldList := TStringList.Create;
  DscList := TStringList.Create;
  try
    FldList.Delimiter := ';';
    DscList.Delimiter := ';';

    for i := 0 to Fields.Count - 1 do
    begin
      Fields.GetNameValue(i, FldName, FldDesc);
      FldList.Add(FldName);

      if FldDesc = 'D' then
        DscList.Add(FldName);
    end;

    FieldsList := FldList.DelimitedText;
    DescFields := DscList.DelimitedText;
  finally
    FldList.Free;
    DscList.Free;
  end;
end;

procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
var
  i: Integer;
  FldDesc: String;
begin
  for i := 0 to Self.Columns.Count - 1 do
  begin
    FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];

    if FldDesc = 'A' then
      Self.Columns[i].Title.ImageIndex := AscIdx
    else
    if FldDesc = 'D' then
      Self.Columns[i].Title.ImageIndex := DescIdx
    else
      Self.Columns[i].Title.ImageIndex := -1
  end;
end;

function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
var
  i: Integer;
begin
  for i := 0 to IndexDefs.Count - 1 do
  begin
    if IndexDefs[i].Name = IndexName then
      Exit(True)
  end;

  Result := False
end;

procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
  DescIdx: Integer);
var
  Field: TField;
  DataSet: TBufDataset;
  IndexDefs: TIndexDefs;
  IndexName, Dir, DescFields, FieldsList: String;
  Fields: TStringList;
begin
  if not Assigned(DataSource.DataSet) or
     not DataSource.DataSet.Active or
     not (DataSource.DataSet is TBufDataset) then
    Exit;
  DataSet := DataSource.DataSet as TBufDataset;

  Field := DataSet.FieldByName(FieldName);
  if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
    Exit;

  IndexDefs := DataSet.IndexDefs;
  IndexName := DataSet.IndexName;

  if not IndexDefs.Updated then
    IndexDefs.Update;

  Fields := TStringList.Create;
  try
    Fields.DelimitedText := IndexName;
    Dir := Fields.Values[FieldName];

    if Dir = 'A' then
      Dir := 'D'
    else
    if Dir = 'D' then
      Dir := 'A'
    else
      Dir := 'A';

    //If shift is presed then add field to field list
    if ssShift in GetKeyShiftState then
    begin
      Fields.Values[FieldName] := Dir;
      //We do not add to sor any more field if total field count exids cMaxColCOunt
      if Fields.Count > cMaxColCOunt then
        Exit;
    end
    else
    begin
      Fields.Clear;
      Fields.Values[FieldName] := Dir;
    end;

    IndexName := Fields.DelimitedText;
    if not Internal_IndexNameExists(IndexDefs, IndexName) then
    begin
      Interbal_MakeNames(Fields, FieldsList, DescFields);
      TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
    end;

    DataSet.IndexName := IndexName;
    Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
  finally
    Fields.Free;
  end;
end;

procedure TDBGridHelper.ClearSort;
var
  DataSet: TBufDataset;
  Fields: TStringList;
begin
  if not Assigned(DataSource.DataSet) or
     not DataSource.DataSet.Active or
     not (DataSource.DataSet is TBufDataset) then
    Exit;
  DataSet := DataSource.DataSet as TBufDataset;

  DataSet.IndexName := '';

  Fields := TStringList.Create;
  try
    Internal_SetColumnsIcons(Fields, -1, -1)
  finally
    Fields.Free
  end
end;

To use sorting you need to call helper methods in OnCellClick and onTitleClick. OnTitleClick - If you hold shift ads new column to sot list ore changes direction to selected column or just sorts one column OnCellClick - If you double click on cell[0, 0] grid clears its sorting

procedure TForm1.grdCountriesCellClick(Column: TColumn);
begin
  if not Assigned(Column) then
    grdCountries.ClearSort
end;

procedure TForm1.grdCountriesTitleClick(Column: TColumn);
begin
  grdCountries.Sort(Column.Field.FieldName, 0, 1);
end;

If you have assigned TitleImageList then you can specify which image use for ascending and which for descending operations.