Сортировка данных в колонках Listview

Shouldercannon

Well-known member
25.05.2010
128
0
#1
Так делается сортировка для двух колонок;
Код:
procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if FSortKey = Column.Index + 1 then FSortKey := -FSortKey else FSortKey := Column.Index + 1;
if ListView1.SortType <> stText then ListView1.SortType := stText else ListView1.AlphaSort;
end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
N1, N2: Integer;
begin
if Abs(FSortKey) = 1 then Compare := AnsiCompareText(Item1.Caption, Item2.Caption)
else
begin
N1 := StrToInt(Item1.SubItems[Abs(FSortKey) - 2]);
N2 := StrToInt(Item2.SubItems[Abs(FSortKey) - 2]);

if N1 = N2 then Compare := 0 else if N1 < N2 then Compare := -1 else Compare := 1;
end;
Compare := Compare * (FSortKey div Abs(FSortKey));
end;
Но это только для двух колонок, а если их три, четыре или более?
FSortKey - номер колонки.
Код:
 if Abs(FSortKey) = 1 then
begin
end
else
if Abs(FSortKey) = 2 then
begin
end
else
if Abs(FSortKey) = 3 then
begin
end;
Как тут сделать сортировку не знаю.
 

sinkopa

Well-known member
17.06.2009
344
4
#2
Так делается сортировка для двух колонок;
Код:
procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if FSortKey = Column.Index + 1 then FSortKey := -FSortKey else FSortKey := Column.Index + 1;
if ListView1.SortType <> stText then ListView1.SortType := stText else ListView1.AlphaSort;
end;
...
Но это только для двух колонок, а если их три, четыре или более?
FSortKey - номер колонки.
...
Зачем такие ужастные извращения? Жалко 1 байт на Булиновую переменную? :)
Вот так будет работать с любым количеством колонок:
Код:
 ...

FSortKey: Integer;	 // Теперь в самом деле используется как номер колонки
FBackSort: Boolean; //  Направление сортировки

...

procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if (FSortKey = Column.Index) then // Если это та же самая колонка - меняем направление сортировки
FBackSort := not FBackSort
else											 // иначе - прямая сортировка
FBackSort := False;

FSortKey := Column.Index;
ListView1.AlphaSort;
end;

procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
N1, N2, SubItemInd: Integer;
begin
if (FSortKey > 0) then // Сортируем по субайтемсам
begin
SubItemInd := FSortKey -1;

// StrToInt не годится, потому как вызовет ошибку если строчка пустая
// либо не приводится к числу. Поэтому StrToIntDef

N1 := StrToIntDef(Item1.SubItems[SubItemInd],0);
N2 := StrToIntDef(Item2.SubItems[SubItemInd],0);

if FBackSort then		// Обратная сортировка
Compare := N2 - N1
else					 // Прямая сортировка
Compare := N1 - N2;
end
else					// Сортируем по капшену айтемса
begin
if FBackSort then	 // Обратная сортировка
Compare := AnsiCompareText(Item2.Caption,Item1.Caption)
else				 // Прямая сортировка
Compare := AnsiCompareText(Item1.Caption,Item2.Caption);
end;
end;
Кстати... поскольку Вы сортируете вручную... то строчка из Вашего примера:
Код:
 if ListView1.SortType <> stText then ListView1.SortType := stText else ListView1.AlphaSort;
Вообще смысла не имеет никакого... разве что Вы собирались запретить пользователю программы сортировку, ели это он в первый раз вообще кликнул по колонке... B)
 

Shouldercannon

Well-known member
25.05.2010
128
0
#3
Спасибо, работает. Но сортировка перестаёт работать если в колонках есть что-то на подобии: 00:12:05 или русские буквы (один символ), или латиские буквы (один символ), или данные типа 1/2.
 

sinkopa

Well-known member
17.06.2009
344
4
#4
Спасибо, работает. Но сортировка перестаёт работать если в колонках есть что-то на подобии: 00:12:05 или русские буквы (один символ), или латиские буквы (один символ), или данные типа 1/2.
Естественно... :)
В Вашем же примере было (неявно) указано что в 1 колонке строки, а во всех остальных - числа...
Можно в принципе любую колонку сортитовать как строки. Единственная неприятность (в случае с числами) следом за "1" встанет не "2" как ожидалось а "11"...
Но... если переписать процедуру вот таким образом:
Код:
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
N1, N2, SubItemInd: Integer;
begin
if (FSortKey > 0) then // Сортируем по субайтемсам
begin
SubItemInd := FSortKey -1;

// Если удалось привести к числу - сортируем как числа
if (TryStrToInt(Item1.SubItems[SubItemInd],N1) and TryStrToInt(Item2.SubItems[SubItemInd],N2)) then
begin
if FBackSort then		// Обратная сортировка
Compare := N2 - N1
else					 // Прямая сортировка
Compare := N1 - N2;
end
else	// если к числу не приводится - сортируем как строки
begin
if FBackSort then	 // Обратная сортировка
Compare := AnsiCompareText(Item2.SubItems[SubItemInd],Item1.SubItems[SubItemInd])
else				 // Прямая сортировка
Compare := AnsiCompareText(Item1.SubItems[SubItemInd],0,Item2.SubItems[SubItemInd]);
end;
end
else					// Сортируем по капшену айтемса
begin
if FBackSort then	 // Обратная сортировка
Compare := AnsiCompareText(Item2.Caption,Item1.Caption)
else				 // Прямая сортировка
Compare := AnsiCompareText(Item1.Caption,Item2.Caption);
end;
end;
То, по всей видимости "будет Вам счясте"... B)
 

Shouldercannon

Well-known member
25.05.2010
128
0
#5
Работает. Остались ещё два вопроса:
1. Как запертить сортировку в пустой колонке
2. При запуске программы отсортировать второй столбец автоматически, допустим от 99 до 0
 

sinkopa

Well-known member
17.06.2009
344
4
#6
Работает. Остались ещё два вопроса:
1. Как запертить сортировку в пустой колонке
2. При запуске программы отсортировать второй столбец автоматически, допустим от 99 до 0
:KillMe:
1.
Код:
...
implementation

{$R *.dfm}
function ColumnEmpty(LV: TListView; ColNo: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if (ColNo < 0) then
Exit;

if (ColNo > 0) then
begin
Dec(ColNo);
for i := 0 to LV.Items.Count-1 do
if (Trim(LV.Items[i].SubItems[ColNo]) <> '') then
begin
Result := False;
Break;
end;
end
else
begin
for i := 0 to LV.Items.Count-1 do
if (Trim(LV.Items[i].Caption) <> '') then
begin
Result := False;
Break;
end;
end;
end;

...

procedure TForm1.ListView1ColumnClick(Sender: TObject;
Column: TListColumn);
begin
if (FSortKey = Column.Index) then // Если это та же самая колонка - меняем направление сортировки
FBackSort := not FBackSort
else							 // иначе - прямая сортировка
FBackSort := False;

FSortKey := Column.Index;

if not ColumnEmpty(ListView1,FSortKey) then // если не пустая - сортируем
ListView1.AlphaSort;
else
FSortKey := -1;
end;
2.
Код:
...
FSortKey := 1;	 // 2-я колонка
FBackSort := True; // Обратная сортировка

if not ColumnEmpty(ListView1,FSortKey) then // если не пустая - сортируем
ListView1.AlphaSort;
else
FSortKey := -1;
 

Shouldercannon

Well-known member
25.05.2010
128
0
#7
Странно, но при клике на столбце, который полностью пустой возникает ошибка на строке List index out of bounds (3)
Код:
 if not ColumnEmpty(ListView1,FSortKey) then ListView1.AlphaSort // если не пустая - сортируем
Видимо в функции ошибка есть.
 

sinkopa

Well-known member
17.06.2009
344
4
#8
Странно, но при клике на столбце, который полностью пустой возникает ошибка на строке List index out of bounds (3)
Код:
 if not ColumnEmpty(ListView1,FSortKey) then ListView1.AlphaSort // если не пустая - сортируем
Видимо в функции ошибка есть.
:KillMe: :KillMe: :KillMe:
Нет. Видимо у некоторых Ваших айтемсов меньше субайтемсов чем (<кол-во колонок>-1 )
А посему надо "ручками" добавлять недостающее количество пустых субайтемсов,
либо отказаться сортировать за пределами "корректной ширины" таблички:
Код:
function ColumnEmpty(LV: TListView; ColNo: Integer): Boolean;
var
i: Integer;
begin
Result := True;
if (ColNo < 0) then
Exit;

if (ColNo > 0) then
begin
Dec(ColNo);

// Проверяем - А достаточно ли у данного айтема субайтемсов
// чтобы можно было сортировать?

for i := 0 to LV.Items.Count-1 do
if (ColNo >= LV.Items[i].SubItems.Count) then
Exit;

for i := 0 to LV.Items.Count-1 do
if (Trim(LV.Items[i].SubItems[ColNo]) <> '') then
begin
Result := False;
Break;
end;
end
else
begin
for i := 0 to LV.Items.Count-1 do
if (Trim(LV.Items[i].Caption) <> '') then
begin
Result := False;
Break;
end;
end;
end;
Может сразу уж прогу всю за вас написать? :)
Я кстати TListView для "комбинированных" таблиц никогда не стал бы использовать...
 

Shouldercannon

Well-known member
25.05.2010
128
0
#9
Может сразу уж прогу всю за вас написать?
Здесь я сам :KillMe:
Я кстати TListView для "комбинированных" таблиц никогда не стал бы использовать.
Возможно тоже бы не стал этого делать, но вынудили обстоятельства
Заинтересовало, как заставить определённую строку, например |неизвестен| при любом направлении сортировки держать в самом внизу списка. Это строка имеет значение только в одной колонке (самая первая колонка) все остальные пустые.
 

sinkopa

Well-known member
17.06.2009
344
4
#10
Заинтересовало, как заставить определённую строку, например |неизвестен| при любом направлении сортировки держать в самом внизу списка. Это строка имеет значение только в одной колонке (самая первая колонка) все остальные пустые.
Этож элементарно
Код:
...
if (Item2.Caption = '|неизвестен|') then
Compare := -1
else if (Item1.Caption = '|неизвестен|') then
Compare := 1
else if FBackSort then	 // Обратная сортировка
Compare := AnsiCompareText(Item2.Caption,Item1.Caption)
else				 // Прямая сортировка
Compare := AnsiCompareText(Item1.Caption,Item2.Caption);
...
 

Shouldercannon

Well-known member
25.05.2010
128
0
#11
Видимо я где-то напортачил. Сортировка чисел снова стала -1, 0, 1, 11, 13, 2, 24, 26 вместо -1, 0, 1, 2, 11, 13, 24 и после того как три раза кликнешь по какой-либо колонке, то любая другая колонка будет отсортирована только после второго клика.
 

Вложения

  • 6.2 КБ Просмотры: 9

sinkopa

Well-known member
17.06.2009
344
4
#12
Видимо я где-то напортачил. Сортировка чисел снова стала -1, 0, 1, 11, 13, 2, 24, 26 вместо -1, 0, 1, 2, 11, 13, 24 и после того как три раза кликнешь по какой-либо колонке, то любая другая колонка будет отсортирована только после второго клика.
Код:
procedure TForm1.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
Data: Integer; var Compare: Integer);
var
N1, N2, SubItemInd: Integer;
begin
if (FSortKey > 0) then // Сортируем по субайтемсам
begin
SubItemInd := FSortKey -1;

// Если удалось привести к числу - сортируем как числа
if (TryStrToInt(Item1.SubItems[SubItemInd], N1) and TryStrToInt(Item2.SubItems[SubItemInd], N2)) then
begin
if FBackSort then Compare := N2 - N1 // Обратная сортировка
else Compare := N1 - N2; // Прямая сортировка
end
else // Если к числу не приводится - сортируем как строки
begin
if FBackSort then Compare := AnsiCompareText(Item2.SubItems[SubItemInd], Item1.SubItems[SubItemInd]) // Обратная сортировка
else Compare := AnsiCompareText(Item1.SubItems[SubItemInd], Item2.SubItems[SubItemInd]); // Прямая сортировка
end;
end
else // Сортируем по капшену айтемса
begin

if FBackSort then Compare := AnsiCompareText(Item2.Caption, Item1.Caption) // Обратная сортировка
else Compare := AnsiCompareText(Item1.Caption, Item2.Caption); // Прямая сортировка
end;

if (Item2.Caption = '< Новое подключение >') then Compare := -1
else
if (Item1.Caption = '< Новое подключение >') then Compare := 1
(* !!!!!!! Лишний код !!!!!
else
if FBackSort then Compare := AnsiCompareText(Item2.Caption,Item1.Caption) // Обратная сортировка
else Compare := AnsiCompareText(Item1.Caption,Item2.Caption); // Прямая сортировка
*)

end;