DELPHI/Часто задаваемые вопросы и ответы на них/Разработка баз данных

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

Автор: Nomadic

Песня о зависшем Windows: Кликну, а в ответ - тишина.

К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.

Источник получения информации: http://www.delphiworld.narod.ru