0

在 Delphi 11 Alexandria 的 Windows 10 中的 32 位 VCL 应用程序中，我有TListView两列，客户端与表单对齐。我正在使用此代码来处理 ListView Header 中的排序箭头：

procedure TformMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  FSortedColumn := Column.Index; 
  case FSortedColumn of
    0: FColumn0SortedUp := not FColumn0SortedUp;
    1: FColumn1SortedUp := not FColumn1SortedUp;
  end;
  SetListHeaderSortArrow(FSortedColumn);
end;

procedure TformMain.SetListHeaderSortArrow(const aColumnIndex: Integer);
begin
  var Header: HWND;
  var Item: Winapi.CommCtrl.THDItem;
  case aColumnIndex of
    0:
      begin
        Header := Winapi.CommCtrl.ListView_GetHeader(ListView1.Handle);
        Winapi.Windows.ZeroMemory(@Item, SizeOf(Item));
        Item.Mask := Winapi.CommCtrl.HDI_FORMAT;
        Winapi.CommCtrl.Header_GetItem(Header, 0, Item);
        Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN); // remove both flags

        if FColumn0SortedUp then
          Item.fmt := Item.fmt or HDF_SORTUP // include the sort ascending flag
        else
          Item.fmt := Item.fmt or HDF_SORTDOWN; // include the sort descending flag

        Header_SetItem(Header, 0, Item);
      end;
    1:
      begin
        Header := Winapi.CommCtrl.ListView_GetHeader(ListView1.Handle);
        Winapi.Windows.ZeroMemory(@Item, SizeOf(Item));
        Item.Mask := Winapi.CommCtrl.HDI_FORMAT;
        Winapi.CommCtrl.Header_GetItem(Header, 1, Item);
        Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN); // remove both flags

        if FColumn1SortedUp then
          Item.fmt := Item.fmt or HDF_SORTUP // include the sort ascending flag
        else
          Item.fmt := Item.fmt or HDF_SORTDOWN; // include the sort descending flag

        Header_SetItem(Header, 1, Item);
      end;
  end;
end;

procedure TformMain.ListView1Resize(Sender: TObject);
begin
  // This gets inexplicably automatically executed 3 times at program start!!
  // This must be in OnResize, otherwise the sort-arrows get hidden when resizing the ListView:
  SetListHeaderSortArrow(FSortedColumn);
end;

当我点击 SECOND 列的列标题时，出现了第二列的排序箭头，但第一列的排序箭头并没有消失！只有当我调整 ListView 的大小（通过调整表单的大小）时，第一列上的排序箭头才会消失。那么如何在单击第二列标题时使第一列上的排序箭头立即消失？

4

2 回答 2

2

更改标志时，在将标志添加到新列之前，您不会从先前选定的列中删除标志。

尝试更多类似的东西：

private:
  FColumnSortedUp: array[0..1] of Boolean;
  FSortedColumn: Integer;

...

procedure TformMain.FormCreate(Sender: TObject);
begin
  FSortedColumn := -1;
end;

procedure TformMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  if FSortedColumn <> -1 then
    SetListHeaderSortArrow(FSortedColumn, False);

  if FSortedColumn = Column.Index then
    FColumnSortedUp[FSortedColumn] := not FColumnSortedUp[FSortedColumn];
  else
    FSortedColumn := Column.Index;

  SetListHeaderSortArrow(FSortedColumn, True);

  // sort ListView items as needed...
end;

procedure TformMain.SetListHeaderSortArrow(const aColumnIndex: Integer;
  const aEnabled: Boolean);
var
  Header: HWND;
  Item: THDItem;
begin
  Header := ListView_GetHeader(ListView1.Handle);
  ZeroMemory(@Item, SizeOf(Item));
  Item.Mask := HDI_FORMAT;
  Header_GetItem(Header, aColumnIndex, Item);
  Item.fmt := Item.fmt and not (HDF_SORTUP or HDF_SORTDOWN); // remove both flags

  if aEnabled then
  begin
    if FColumnSortedUp[aColumnIndex] then
      Item.fmt := Item.fmt or HDF_SORTUP // include the sort ascending flag
    else
      Item.fmt := Item.fmt or HDF_SORTDOWN; // include the sort descending flag
  end;

  Header_SetItem(Header, aColumnIndex, Item);
end;

另请注意，在调整ListView大小时排序箭头不会消失，而是在调整列大小时。因此，您必须挂钩 ListView 来处理HDN_ENDTRACK通知，以检测每列何时调整大小，例如：

private
  ...
  OldWndProc: TWndMethod;
  procedure ListViewWndProc(var Message: TMessage);

...

uses
  ..., Winapi.Messages, Winapi.CommCtrl;

procedure TformMain.FormCreate(Sender: TObject);
begin
  ...
  OldWndProc := ListView1.WindowProc;
  ListView1.WindowProc := ListViewWndProc;
end;

procedure TformMain.ListViewWndProc(var Message: TMessage);
begin
  OldWndProc(Message);
  if Message.Msg = WM_NOTIFY then
  begin
    if TWMNotify(Message).NMHdr.code = HDN_ENDTRACK then
    begin
      if PHDNotify(TWMNotify(Message).NMHdr).Item = FSortedColumn then
        SetListHeaderSortArrow(FSortedColumn, True);
    end;
  end;
end;
于 2022-01-05T17:32:54.240 回答
0

我找到了解决问题的解决方法：

procedure PALockWinControl(const WC: Vcl.Controls.TWinControl; ALock: Boolean);
begin
  if (not Assigned(WC)) or (WC.Handle = 0) then EXIT;

  if ALock then
    WC.Perform(WM_SETREDRAW, 0, 0)
  else
  begin
    WC.Perform(WM_SETREDRAW, 1, 0);
    RedrawWindow(WC.Handle, nil, 0, RDW_ERASE or RDW_FRAME or RDW_INVALIDATE or RDW_ALLCHILDREN);
  end;
end;

procedure MyRedrawWorkaround;
begin
  with formMain do
  begin
    PALockWinControl(ListView1, True);
    try
      ListView1.Align := alNone;
      ListView1.Width := lvMRUProjects.Width - 1;
      ListView1.Align := alClient;
    finally
      PALockWinControl(ListView1, False);
    end;
  end;
end;

procedure TformMain.ListView1ColumnClick(Sender: TObject; Column: TListColumn);
begin
  FSortedColumn := Column.Index;
  case FSortedColumn of
    0: FColumn0SortedUp := not FColumn0SortedUp;
    1: FColumn1SortedUp := not FColumn1SortedUp;
  end;
  SetListHeaderSortArrow(FSortedColumn);

  MyRedrawWorkaround;
end;
于 2022-01-05T17:27:29.637 回答