Сортировка TDBGrid по клику на колонке?
На форме расположены TQuery, TDatasource и TDbGrid связанные вместе.
QuerySQL, это глобальная строка, которая содержит SQL-выражение.
begin QuerySQL := 'SELECT * FROM Customer.DB'; Query1.SQL.Add(QuerySQL); Query1.Open; end;
В DBGrid в событии OnTitleClick, достаточно добавить ORDER-BY к sql-строке и обновить запрос.
procedure TForm1.DBGrid1TitleClick(Column: TColumn);
begin
witzh Query1 do
begin
DisableControls;
Close;
SQL.Clear;
SQL.Add(QuerySQL);
SQL.Add('ORDER BY ' + Column.FieldName);
Open;
// Восстанавливаем настройки заголовка, иначе всё станет синим
DBGrid1.Columns.RestoreDefaults;
Column.Title.Font.Color := clBlue;
EnableControls;
end;
end;
Взято из https://forum.sources.ru
К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.
Взято с https://delphiworld.narod.ru
Многие профессиональные приложения отображают данные в полях табличной сетки и позволяют Вам сортировать любую колонку, просто щелкая по ее заголовку. То, что здесь изложено - не наилучший путь для решения задачи, данная технология ничто иное, как простая имитация такого поведения компонента.
Главное препятствие в решении задачи - сам DBGrid. Проблема в отсутствии событий OnClick или OnMouseDown, позволяющие реагировать на элементарные манипуляции с заголовком. Правда, существует событие OnDoubleClick, но для данной цели оно не слишком изящно. Все что нам нужно - сделать заголовок, реагирующий на однократный щелчок мышью. Обратимся к компоненту THeaderControl.
THeaderControl - компонент, введенный в палитру еще в Delphi 2.0 и обеспечивающий необходимые нам функции. Главное достоинство - реакция компонента при щелчке на отдельных панелях, панели также обеспечивают визульное отображение подобно кнопке (могут вдавливаться и отжиматься). Нам необходимо "прикрутить" THeaderControl к DBGrid. Вот как это сделать:
Во-первых, создайте новое приложение. Положите THeaderControl на форму. Он автоматически выровняется по верхнему краю формы. Затем поместите на форму DBGrid и присвойте свойству Align значение alClient. Затем добавьте компоненты TTable и TDataSource. В компоненте TTable присвойте свойству DatabaseName значение DBDEMOS, а свойству TableName значение EVENTS.DB. В TDataSource укажите в свойстве DataSet на компонент Table1, а в TDBGrid в свойстве DataSource на DataSource1. Если свойство Active компонента TTable было неактивно, включите его (значение True). Теперь немного поколдуем!
Сделаем так, чтобы компонент THeaderControl выглядел похожим на заголовок компонента DBGrid. Произведем необходимые манипулиции в момент создания формы. Дважды щелкните на событии OnCreate формы и введите следующий код:
procedure TForm1.FormCreate(Sender: TObject);
var
TheCap: string;
TheWidth, a: Integer;
begin
DBGrid1.Options := DBGrid1.Options - [dgTitles];
HeaderControl1.Sections.Add;
HeaderControl1.Sections.Items[0].Width := 12;
Table1.Exclusive := True;
Table1.Active := True;
for a := 1 to DBGrid1.Columns.Count do
begin
with DBGrid1.Columns.Items[a - 1] do
begin
TheCap := Title.Caption;
TheWidth := Width;
end;
with HeaderControl1.Sections do
begin
Add;
Items[a].Text := TheCap;
Items[a].Width := TheWidth + 1;
Items[a].MinWidth := TheWidth + 1;
Items[a].MaxWidth := TheWidth + 1;
end;
try
Table1.AddIndex(TheCap, TheCap, []);
except
HeaderControl1.Sections.Items[a].AllowClick := False;
end;
end;
Table1.Active := False;
Table1.Exclusive := False;
Table1.Active := True;
end;
После того как THeaderControl заменил стандартный заголовок DBGrid, в первую очередь мы сбрасываем (устанавливаем в False) флаг dgTitles в свойстве Options компонента DBGrid. Затем мы добавляем колонку в HeaderControl и устанавливаем ее ширину, равную 12. Это будет пустой колонкой, которая имеет ту же ширину, что и левая колонка статуса в DBGrid.
Затем нужно убедиться что таблица открыта для эксклюзивного доступа (никакие другие пользователи использовать ее не смогут). Причину я объясню немного позже.
Теперь добавляем секции в HeaderControl. Для каждой добавленной колонки мы создаем в заголовке тот же текст, что и в соответствующей колонке DBGrid. В цикле мы проходим по всем колонкам DBGrid и повторяем текст заголовка колонки и его высоту. Мы также устанавливаем для HeaderControl значения свойств MinWidth и MaxWidth, равными ширине соответствующей колонки в DBGrid. Это предохранит колонки от изменения их ширины. Для изменяющих размер колонок нужно дополнительное кодирование, и я решил не лишать Вас этого удовольствия.
Теперь самое интересное. Мы собираемся создать индекс для каждой колонки в DBGrid. Имя индекса будет таким же, как и название колонки. Данный код мы должны заключить в конструкцию try..finally, поскольку существуют некоторые поля, которые не могут быть проиндексированы (например, Blob- и Memo-поля). При попытке индексации этих полей генерится исключительная ситуация. Мы перехватываем это исключение и недопускаем возможности щелчка на данной колонке. Это означает, что колонки, содержащие неиндексированные поля, не будут реагировать на щелчок мышью. Создание этих индексов служит объяснением тому, почему таблица должна быть открыта в режиме эксклюзивного доступа. И в заключение мы закрываем таблицу, сбрасываем флаг эксклюзивности и снова делаем таблицу активной.
Последний шаг. При щелчке на HeaderControl нам необходимо включить правильный индекс таблицы. Создадим обработчик события OnSectionClick компонента HeaderControl как показано ниже:
procedure TForm1.HeaderControl1SectionClick( HeaderControl: THeaderControl; Section: THeaderSection); begin Table1.IndexName := Section.Text; end;
Это все! После щелчка на заголовке колонки значение свойства таблицы IndexName становится равным заголовку компонента HeaderControl.
Просто и красиво, да? Тем не менее есть масса мест, требующих улучшения. К примеру, вторичный щелчок должен возобновлять порядок сортировки. Или возможность изменения размера самих колонок. Попробуйте сами, это не сложно!
Улучшения
Здесь приведен улучшенный код по сравнению с предыдущей версией "Совета", он заключается в использовании в качестве имени индекса имя поля вместо заголовка.
Это улучшает гибкость. Изменения указаны наклонным курсивом.
procedure TfrmDoc.FormCreate(Sender: TObject);
var
TheCap: string;
TheFn: string;
TheWidth: Integer;
a: Integer;
begin
Dbgrid1.Options := DBGrid1.Options - [DGTitles];
Headercontrol1.sections.Add;
Headercontrol1.Sections.Items[0].Width := 12;
for a := 1 to DBGRID1.Columns.Count do
begin
with DBGrid1.Columns.Items[a - 1] do
begin
TheFn := FieldName;
TheCap := Title.Caption;
TheWidth := Width;
end;
with Headercontrol1.Sections do
begin
Add;
Items[a].Text := TheCap;
Items[a].Width := TheWidth + 1;
Items[a].MinWidth := TheWidth + 1;
Items[a].MaxWidth := TheWidth + 1;
end;
try
{ Используем индексы с тем же именем, что и имя поля }
(DataSource1.Dataset as TTable).IndexName := TheFn;
{ Пробуем задать имя индекса }
except
HeaderControl1.Sections.Items[a].AllowClick := False; { Индекс недоступен }
end;
end;
end;
Используйте свойство FieldName компонента DBGrid для задания индекса с тем же именем, что и имя поля.
procedure TfrmDoc.HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection); begin (DataSource1.Dataset as TTable).IndexName := DBGrid1.Columns.Items[ Section.Index - 1 ].FieldName; end;
Взято с https://delphiworld.narod.ru