Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 30.11.2016, 13:09   #1
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,893
Сообщение ListView. Сортировка в обе стороны

Имеется
Код:
function StrCmpLogicalW(psz1, psz2: PWideChar): Integer; stdcall; external 'shlwapi.dll';

function LVCompareEx(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
var
  S1, S2: WideString;
begin
  S1 := TListItem(lParam1).Caption;
  S2 := TListItem(lParam2).Caption;
  Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
end;

procedure TFormMain.Button3Click(Sender: TObject);
var
  Item: TListItem;
begin
  LVUsers.Clear;

  Item := LVUsers.Items.Add;
  Item.Caption := '209';
  Item := LVUsers.Items.Add;
  Item.Caption := 'ИТО';
  Item := LVUsers.Items.Add;
  Item.Caption := '120';
  Item := LVUsers.Items.Add;
  Item.Caption := '115';
  Item := LVUsers.Items.Add;
  Item.Caption := '118';
  Item := LVUsers.Items.Add;
  Item.Caption := '114';
  Item := LVUsers.Items.Add;
  Item.Caption := '18';
  Item := LVUsers.Items.Add;
  Item.Caption := '211';
  Item := LVUsers.Items.Add;
  Item.Caption := '226а';
  Item := LVUsers.Items.Add;
  Item.Caption := '105';

  LVUsers.SortType := stNone;
  LVUsers.CustomSort(@LVCompareEx, 0);
end;

procedure TFormMain.LVUsersColumnClick(Sender: TObject; Column: TListColumn);
begin
  LVUsers.CustomSort(@LVCompareEx, Column.Index);
end;
Сортируется только в одном направлении от меньшего к большему. Помогите, пожалуйста организовать сортировку в обе стороны.
Shouldercannon вне форума Ответить с цитированием
Старый 30.11.2016, 13:33   #2
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Цитата:
Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
Здесь меняй знак для обратной сортировки. Или параметры местами поменять. Заведи булевую переменную (b), доступную и в LVUsersColumnClick, и в LVCompareEx. Начальное значение True. В LVUsersColumnClick b:=not b; Её и анализируй в LVCompareEx
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 30.11.2016, 13:49   #3
evg_m
Старожил
 
Регистрация: 20.04.2008
Сообщений: 5,515
По умолчанию

или ДВЕ (можно и больше) функции сравнения и менять ИХ
Код:
if ..... then 
  LVusers.customSort(@LVCompareUp, column.Index)
else
  LVusers.customSort(@LVCompareDown, column.Index);
Код:
function LVCompareUp(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
var
  S1, S2: WideString;
begin
  S1 := TListItem(lParam1).Caption;
  S2 := TListItem(lParam2).Caption;
  Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
end;

function LVCompareDown(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
var
  S1, S2: WideString;
begin
  S1 := TListItem(lParam1).Caption;
  S2 := TListItem(lParam2).Caption; 

//а здесь поменяем местами (cравним наоборот)
  Result := StrCmpLogicalW(PWideChar(S2), PWideChar(S1));
end;
программа — запись алгоритма на языке понятном транслятору
evg_m на форуме Ответить с цитированием
Старый 02.12.2016, 17:05   #4
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,893
По умолчанию

Данный способ сортирует только содержимое в Caption. В ListView есть так же и несколько SubItems. Можно ли как-то оптимизировать
Код:
function LVCompareUp(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
для сортировки в указанном столбце
Shouldercannon вне форума Ответить с цитированием
Старый 02.12.2016, 18:26   #5
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Caption же достаешь, что мешает достать и другу информацию?
Код:
  S1 := TListItem(lParam1).Caption;
  S2 := TListItem(lParam2).Caption;
  Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
  if Result=0 then begin 
    S1 := TListItem(lParam1).SubItems.Strings[0];
    S2 := TListItem(lParam2).SubItems.Strings[0];
    Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
  end;
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 23.12.2016, 23:15   #6
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,893
По умолчанию

Разобрался. Теперь напрягает один момент. Есть строка с данными, которая заполнена не полностью и при сортировке она всегда должна быть внизу.
Код:
procedure TFormMain.LVUsersColumnClick(Sender: TObject; Column: TListColumn);
begin
  if SortOrder = 0 then SortOrder := 1 else SortOrder := 0;

  case Column.Index of
  0: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol0Up, 0) else LVUsers.CustomSort(@CompareCol0Down, 0);
  1: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol1Up, 0) else LVUsers.CustomSort(@CompareCol1Down, 0);
  2: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol2Up, 0) else LVUsers.CustomSort(@CompareCol2Down, 0);
  3: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol3Up, 0) else LVUsers.CustomSort(@CompareCol3Down, 0);
  4: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol4Up, 0) else LVUsers.CustomSort(@CompareCol4Down, 0);
  5: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol5Up, 0) else LVUsers.CustomSort(@CompareCol5Down, 0);
  6: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol6Up, 0) else LVUsers.CustomSort(@CompareCol6Down, 0);
  7: if SortOrder = 0 then LVUsers.CustomSort(@CompareCol7Up, 0) else LVUsers.CustomSort(@CompareCol7Down, 0);
  end;
end;

function CompareCol1Up(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
var
  S1, S2: WideString;
begin
  S1 := TListItem(lParam1).SubItems[0];
  S2 := TListItem(lParam2).SubItems[0];
  if TListItem(lParam1).SubItems[2] = '' then Exit;
  if TListItem(lParam2).SubItems[2] = '' then Exit;
  Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));
end;

function CompareCol1Down(lParam1, lParam2, lParamSort: Integer): Integer stdcall;
var
  S1, S2: WideString;
begin
  S1 := TListItem(lParam1).SubItems[0];
  S2 := TListItem(lParam2).SubItems[0];
  if TListItem(lParam1).SubItems[2] = '' then Exit; // Напрягает
  if TListItem(lParam2).SubItems[2] = '' then Exit; // Напрягает
  Result := StrCmpLogicalW(PWideChar(S2), PWideChar(S1));
end;
Данный способ работает, но напрягают предупреждения:
[dcc32 Warning] Sorting.pas(56): W1035 Return value of function 'CompareCol1Up' might be undefined
[dcc32 Warning] Sorting.pas(67): W1035 Return value of function 'CompareCol1Down' might be undefined
Shouldercannon вне форума Ответить с цитированием
Старый 23.12.2016, 23:53   #7
Аватар
Старожил
 
Аватар для Аватар
 
Регистрация: 17.11.2010
Сообщений: 19,042
По умолчанию

Нормальные предупреждения. Функция должна возвращать результат. А у тебя что? В Result до Exit ни чего не присвоено
Если бы архитекторы строили здания так, как программисты пишут программы, то первый залетевший дятел разрушил бы цивилизацию
Аватар вне форума Ответить с цитированием
Старый 24.12.2016, 15:43   #8
kropotkina-alice
Форумчанин
 
Аватар для kropotkina-alice
 
Регистрация: 27.10.2014
Сообщений: 594
По умолчанию

Цитата:
Сообщение от Shouldercannon Посмотреть сообщение
напрягают предупреждения:
[dcc32 Warning] Sorting.pas(56): W1035 Return value of function 'CompareCol1Up' might be undefined
[dcc32 Warning] Sorting.pas(67): W1035 Return value of function 'CompareCol1Down' might be undefined
Ну, если вы такой нервный, подскажу способ, как избавляться от таких варнингов.
Просто в этих функциях первой строкой вставьте
Код:
result:=0;
kropotkina-alice вне форума Ответить с цитированием
Старый 28.12.2016, 12:00   #9
Shouldercannon
Участник клуба Подтвердите свой е-майл
 
Аватар для Shouldercannon
 
Регистрация: 26.01.2008
Сообщений: 1,893
По умолчанию

Задался вопросом, нужен ли вообще AlphaSort в FormCreate?
Если его убрать, то разницы никакой
Код:
var
  FormMain: TFormMain;
  SortColumn: Integer = 0; // Колонка для сортировки
  SortOrder: Integer = 0; // Направление сортировки

implementation

{$R *.dfm}

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ListView1.AlphaSort; // Надо ли вообще оно тут?
end;

procedure TFormMain.Button1Click(Sender: TObject);
var
  Item: TListItem;
begin
  ListView1.Clear;
  ListView1.SortType := stNone;

  Item := ListView1.Items.Add;
  Item.Caption := '1';
  Item.SubItems.Add('п');
  Item.SubItems.Add('m');

  Item := ListView1.Items.Add;
  Item.Caption := '3';
  Item.SubItems.Add('а');
  Item.SubItems.Add('z');

  Item := ListView1.Items.Add;
  Item.Caption := '8';
  Item.SubItems.Add('я');
  Item.SubItems.Add('r');

  Item := ListView1.Items.Add;
  Item.Caption := 'а';
  Item.SubItems.Add('з');
  Item.SubItems.Add('<');

  Item := ListView1.Items.Add;
  Item.Caption := '';
  Item.SubItems.Add('к');
  Item.SubItems.Add('c');

  ListView1.SortType := stBoth;
end;

procedure TFormMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if Column.Index <> SortColumn then
  begin
    SortColumn := Column.Index;
    SortOrder := 0;
  end
  else if SortOrder = 0 then SortOrder := 1 else SortOrder := 0;

  if ListView1.Items.Count > 0 then
  begin
    ListView1.AlphaSort;
    ListView1.Selected := ListView1.Items[0];
    ListView1.ItemFocused := ListView1.Items[0];
    ListView1.Selected.MakeVisible(True);
  end;
end;

procedure TFormMain.ListView1Compare(Sender: TObject; Item1, Item2: TListItem;
  Data: Integer; var Compare: Integer);
begin
  Compare := 0;
  // Запрет сортировки
  if Length(Item1.Caption) = 0 then Exit;
  if Length(Item2.Caption) = 0 then Exit;

  case SortColumn of
  0: if SortOrder = 0 then Compare := StrCmpLogicalW(PWideChar(Item1.Caption), PWideChar(Item2.Caption)) else Compare := StrCmpLogicalW(PWideChar(Item1.Caption), PWideChar(Item2.Caption)) * -1;
  1: if SortOrder = 0 then Compare := StrCmpLogicalW(PWideChar(Item1.SubItems[0]), PWideChar(Item2.SubItems[0])) else Compare := StrCmpLogicalW(PWideChar(Item1.SubItems[0]), PWideChar(Item2.SubItems[0])) * -1;
  2: if SortOrder = 0 then Compare := StrCmpLogicalW(PWideChar(Item1.SubItems[1]), PWideChar(Item2.SubItems[1])) else Compare := StrCmpLogicalW(PWideChar(Item1.SubItems[1]), PWideChar(Item2.SubItems[1])) * -1;
  end;
end;

Последний раз редактировалось Shouldercannon; 28.12.2016 в 14:30.
Shouldercannon вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Сортировка в виртуальном Listview CraZZZy-GameRRR Общие вопросы Delphi 6 15.11.2016 20:55
сортировка в listview HTTqp Общие вопросы Delphi 6 30.01.2014 18:04
Сортировка в ListView and1733 C++ Builder 11 27.06.2013 12:50
Стороны света ≈ стороны монитора Alex Cones Свободное общение 21 26.08.2010 17:15
ListView сортировка Viten2 Компоненты Delphi 6 25.03.2007 00:28