ListView. Сортировка в обе стороны

[Shouldercannon]

Имеется

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;

Сортируется только в одном направлении от меньшего к большему. Помогите, пожалуйста организовать сортировку в обе стороны.

[Аватар]

Result := StrCmpLogicalW(PWideChar(S1), PWideChar(S2));

Здесь меняй знак для обратной сортировки. Или параметры местами поменять. Заведи булевую переменную (b), доступную и в LVUsersColumnClick, и в LVCompareEx. Начальное значение True. В LVUsersColumnClick b:=not b; Её и анализируй в LVCompareEx

[evg_m]

или ДВЕ (можно и больше) функции сравнения и менять ИХ

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;

[Shouldercannon]

Данный способ сортирует только содержимое в Caption. В ListView есть так же и несколько SubItems. Можно ли как-то оптимизировать

function LVCompareUp(lParam1, lParam2, lParamSort: Integer): Integer stdcall;

для сортировки в указанном столбце

[Аватар]

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;

[Shouldercannon]

Разобрался. Теперь напрягает один момент. Есть строка с данными, которая заполнена не полностью и при сортировке она всегда должна быть внизу.

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

[Аватар]

Нормальные предупреждения. Функция должна возвращать результат. А у тебя что? В Result до Exit ни чего не присвоено

[kropotkina-alice]

Сообщение от 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;

[Shouldercannon]

Задался вопросом, нужен ли вообще 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;