Я у себя в программе использую составные заголовки. в качестве разделителя в моих примерах используется ' - '. То, что до разделителя - параметры столбца, которые я заполняю по своим правилам. После разделителя - непосредственно название столбца.
В качестве параметров я указываю в т.ч. тип данных (у меня там параметры просто через запятую) - int (целые), float (дробные), check (логические, 0 - ложь, 1 - истина), txt (строковые), dat (дата и время)
отрисовку ячеек делаю в ручную, в которой убираю параметры из заголовков, рисую данные в ячейках в соответствии с форматом (например логические показываю в виде галочки checkbox).
ну и соответственно, реализована сортировка по любой колонке по целчку мышкой по заголовку.
т.к. сортировка используется много где, непосредственно сортировка реализована в отдельной процедуре, а непосредственно на гриде:
| Код |
procedure TForm1.StringGrid1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
Coord: TGridCoord;
begin
Coord := StringGrid1.MouseCoord(X, Y);
if Coord.Y = 0 then
Global.SortGrid(StringGrid1, Coord.X);\\ это процедура сортировки в общем модуле
end;
|
ну и непосредственно сортировка:
| Код |
procedure SortGrid(Grid: TStringGrid; Col: integer);
var
SortType, i, j, step: integer;
buf: string;
sBuf1, sBuf2: string;
dBuf1, dBuf2: TDateTime;
fBuf1, fBuf2: real;
flag: boolean;
begin
buf := Grid.Cells[Col, 0];
SortType := 0; // строка
if pos(' - ', buf) <> 0 then
begin
buf := copy(buf, 1, pos(' - ', buf) - 1);
if (pos('int', buf) <> 0) or (pos('float', buf) <> 0) or(pos('check', buf) <> 0) then
SortType := 1; // число
if (pos('dat', buf) <> 0) then
SortType := 2; // датавремя
end;
if SortType = 0 then
begin
// сортировка по строковым правилам
step := Grid.RowCount div 2;
while step > 0 do
begin
flag := true;
while flag do
begin
flag := false;
for i := 1 to Grid.RowCount - step - 1 do
begin
try
sBuf1 := trim(Grid.Cells[Col, i]);
except
sBuf1 := '';
end;
try
sBuf2 := trim(Grid.Cells[Col, i + step]);
except
sBuf2 := '';
end;
Application.ProcessMessages;
if sBuf1 > sBuf2 then
begin
flag := true;
for j := 0 to Grid.ColCount do
begin
buf := Grid.Cells[j, i];
Grid.Cells[j, i] := Grid.Cells[j, i + step];
Grid.Cells[j, i + step] := buf;
end;
end;
end;
end;
step := step div 2;
end;
end;
if SortType = 1 then
begin
// сортировка по числовым правилам
step := Grid.RowCount div 2;
while step > 0 do
begin
flag := true;
while flag do
begin
flag := false;
for i := 1 to Grid.RowCount - step - 1 do
begin
try
fBuf1 := StrToFloat(Grid.Cells[Col, i]);
except
fBuf1 := 0;
end;
try
fBuf2 := StrToFloat(Grid.Cells[Col, i + step]);
except
fBuf2 := 0;
end;
Application.ProcessMessages;
if fBuf1 > fBuf2 then
begin
flag := true;
for j := 0 to Grid.ColCount do
begin
buf := Grid.Cells[j, i];
Grid.Cells[j, i] := Grid.Cells[j, i + step];
Grid.Cells[j, i + step] := buf;
end;
end;
end;
end;
step := step div 2;
end;
end;
if SortType = 2 then
begin
// сортировка по правилам датывремени
step := Grid.RowCount div 2;
while step > 0 do
begin
flag := true;
while flag do
begin
flag := false;
for i := 1 to Grid.RowCount - step - 1 do
begin
try
dBuf1 := StrToDateTime(Grid.Cells[Col, i]);
except
dBuf1 := 0;
end;
try
dBuf2 := StrToDateTime(Grid.Cells[Col, i + step]);
except
dBuf2 := 0;
end;
Application.ProcessMessages;
if dBuf1 > dBuf2 then
begin
flag := true;
for j := 0 to Grid.ColCount do
begin
buf := Grid.Cells[j, i];
Grid.Cells[j, i] := Grid.Cells[j, i + step];
Grid.Cells[j, i + step] := buf;
end;
end;
end;
end;
step := step div 2;
end;
end;
end;
|
ну и до кучи процедура отрисовки ячейки (свойство DefaultDrawing отключить!):
| Код |
procedure TForm1.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
Rect: TRect; State: TGridDrawState);
var
s, params: string;
format: Cardinal;
Header: string;
r: TRect;
step: Integer;
style, TypeButton: word;
sg: TStringGrid;
begin
sg := TStringGrid(Sender);
r := Rect;
step := -1;
r.Left := r.Left + step;
r.Top := r.Top + step;
r.Right := r.Right - step;
r.Bottom := r.Bottom - step;
s := sg.Cells[ACol, ARow];
Header := sg.Cells[ACol, 0];
params := '';
if pos(' - ', Header) <> 0 then
begin
params := copy(Header, 1, pos(' - ', Header) - 1);
Header := copy(Header, pos(' - ', Header) + 3, length(Header));
end;
if (ARow = 0) or (ACol = 0) then
begin
// заголовок
sg.Canvas.Font.Color := clWindowText;
sg.Canvas.Font.style := [fsBold];
sg.Canvas.Brush.Color := clBtnFace;
sg.Canvas.Pen.Color := clBlack;
sg.Canvas.Pen.style := psSolid;
format := DT_CENTER or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
if ARow = 0 then
s := Header;
end
else
begin
// Рисуем основное поле
sg.Canvas.Font.Color := clWindowText;
sg.Canvas.Brush.Color := clWindow;
sg.Canvas.Font.style := [];
sg.Canvas.Pen.Color := clSilver;
sg.Canvas.Pen.style := psDot;
format := DT_LEFT or DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
end;
sg.Canvas.FillRect®;
sg.Canvas.Rectangle®;
if sg.Canvas.TextWidth(s) > sg.ColWidths[ACol] - 2 then
sg.ColWidths[ACol] := sg.Canvas.TextWidth(s) + 2;
if pos('hidden', params) <> 0 then
sg.ColWidths[ACol] := -1;
if (pos('check', params) <> 0) and (ARow > 0) then
begin
if sg.Cells[ACol, ARow] = '1' then
style := DFCS_CHECKED
else
style := DFCS_BUTTONCHECK;
TypeButton := DFCS_BUTTONCHECK;
r.Left := Rect.Left + ((Rect.Right - Rect.Left) div 2) -
(Global.CheckSize div 2);
r.Top := Rect.Top + ((Rect.Bottom - Rect.Top) div 2) -
(Global.CheckSize div 2);
r.Right := Rect.Left + ((Rect.Right - Rect.Left) div 2) -
(Global.CheckSize div 2) + Global.CheckSize;
r.Bottom := Rect.Top + ((Rect.Bottom - Rect.Top) div 2) -
(Global.CheckSize div 2) + Global.CheckSize;
DrawFrameControl(sg.Canvas.Handle, r, DFC_BUTTON, TypeButton or style);
end
else
DrawText(sg.Canvas.Handle, PChar(s), -1, Rect, format);
if gdFocused in State then
sg.Canvas.DrawFocusRect(Rect);
end;
|
Надеюсь поможет кому-нибудь. Со своей стороны могу попросить помощи в реализации иной задачи: необходимо добавить фильтрацию на этот грид.
интерфейс вижу таким:
Если в параметрах есть 'filter' - значит по колонке возможна фильтрация и надо нарисовать кнопку-раскрывашку как у комбобокса (это ерунда, а не вопрос).
при клике мышкой смотреть попал на раскрывашку или мимо. Если мимо, то сортировать по приведенному выше алгоритму. Если попал, то показать а-ля чекбокс, заполненный всеми возможными значениями из этого столбца. и кнопки "Отметить все", "Снять все отметки", "Инвертировать выбор", "ОК", "Отмена"
по жамку на "ОК" пробежать по стобцу и установить высоту строки -1 для всех, неудовлетворяющих фильтру.
Сложностями вижу алгоритм применения фильтра при условии фильтрации по нескольким колонкам. Подсказки как реализовать все остальное не требуются.
|