Как заставить DBGrid сортировать данные по щелчку на заголовке столбца

Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с опpеделенным макpосом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unit
 vgRXutil;

interface


uses

  SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }
procedure
 RefreshRXLookup(Lookup: TrxLookupControl);
procedure
 RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function
 RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }
procedure
 HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }
procedure
 InsertOrderBy(Query: TRxQuery; NewOrder: string
);

{ Converts list of order fields if defined and refreshes query }
procedure
 UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation

uses

  vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type

  TRXLookupControlHack = class
(TrxLookupControl)
    property
 DataSource;
    property
 LookupSource;
    property
 Value;
    property
 EmptyValue;
  end
;

procedure
 RefreshRXLookup(Lookup: TrxLookupControl);
var

  SaveField: string
;
begin

  with
 TRXLookupControlHack(Lookup) do

  begin

    SaveField := DataField;
    DataField := '';
    DataField := SaveField;
  end
;
end
;

procedure
 RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
var

  SaveField: string
;
begin

  with
 TRXLookupControlHack(Lookup) do

  begin

    SaveField := LookupDisplay;
    LookupDisplay := '';
    LookupDisplay := SaveField;
  end
;
end
;

function
 RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
begin

  with
 TRXLookupControlHack(Lookup) do

  try

    if
 Value <> EmptyValue then

      Result := StrToInt(Value)
    else

      Result := 0;
  except

    Result := 0;
  end
;
end
;

procedure
 InsertOrderBy(Query: TRxQuery; NewOrder: string
);
var

  Param: TParam;
  OldActive: Boolean;
  OldOrder: string
;
  Bmk: TPKBookMark;
begin

  Param := FindParam(Query.Macros, 'Order');
  if
 not
 Assigned(Param) then

    Exit;

  OldOrder := Param.AsString;

  if
 OldOrder <> NewOrder then

  begin

    OldActive := Query.Active;
    if
 OldActive then

      Bmk := GetPKBookmark(Query, '');
    try

      Query.Close;
      Param.AsString := NewOrder;
      try

        Query.Prepare;
      except

        Param.AsString := OldOrder;
      end
;
      Query.Active := OldActive;
      if
 OldActive then

        SetToPKBookMark(Query, Bmk);
    finally

      if
 OldActive then

        FreePKBookmark(Bmk);
    end
;
  end
;
end
;

procedure
 UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
var

  NewOrderFields: TStrings;

  procedure
 AddOrderField(S: string
);
  begin

    if
 NewOrderFields.IndexOf(S) < 0 then

      NewOrderFields.Add(S);
  end
;

var

  I, J: Integer;
  Field: TField;
  FieldDef: TFieldDef;
  S: string
;
begin

  NewOrderFields := TStringList.Create;
  with
 Query do

  try

    for
 I := 0 to
 OrderFields.Count - 1 do

    begin

      S := OrderFields[I];
      Field := FindField(S);
      if
 Assigned(Field) and
 (Field.FieldNo > 0) then

        AddOrderField(IntToStr(Field.FieldNo))
      else

      try

        J := StrToInt(S);
        if
 J < FieldDefs.Count then

          AddOrderField(IntToStr(J));
      except

      end
;
    end
;
    OrderFields.Assign(NewOrderFields);
  finally

    NewOrderFields.Free;
  end
;
end
;

procedure
 HandleOrderMacro(Query: TRxQuery; Field: TField);
var

  Param: TParam;
  Tmp, OldOrder, NewOrder: string
;
  I: Integer;
  C: Char;
  TmpField: TField;
  OrderFields: TStrings;
begin

  Param := FindParam(Query.Macros, 'Order');
  if
 not
 Assigned(Param) or
 Field.Calculated or
 Field.Lookup then

    Exit;
  OldOrder := Param.AsString;
  I := 0;
  Tmp := '';
  OrderFields := TStringList.Create;
  try

    OrderFields.Ad(Field.FieldName);
    while
 I < Length(OldOrder) do

    begin

      Inc(I);
      C := OldOrder[I];
      if
 C in
 FieldNameChars then

        Tmp := Tmp + C;

      if
 (not
 (C in
 FieldNameChars) or
 (I = Length(OldOrder))) and
 (Tmp <> '')
        then

      begin

        TmpField := Field.DataSet.FindField(Tmp);
        if
 OrderFields.IndexOf(Tmp) < 0 then

          OrderFields.Add(Tmp);
        Tmp := '';
      end
;
    end
;

    UpdateOrderFields(Query, OrderFields);
    NewOrder := OrderFields[0];
    for
 I := 1 to
 OrderFields.Count - 1 do

      NewOrder := NewOrder + ', ' + OrderFields[1];
  finally

    OrderFields.Free;
  end
;
  InsertOrderBy(Query, NewOrder);
end
;

end
.

Другое по теме:

• FindKey для нескольких полей
• Быстрый поиск в базах данных
• Поиск в базе данных