Delphi World - Как заставить DBGrid сортировать данные по щелчку на заголовке столбца
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Как заставить 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.

Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования