bufDataSet排序

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

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.