0

在 Delphi 11 Alexandria 的 Windows 10 中的 32 位 VCL 应用程序中，我在 OwnerDrawn TListView.OnDrawItem 事件处理程序中选择了一个 ListItem，并且我希望选择 ENTIRE UNINTERRUPTED 行。不幸的是，不是整行被选中，而是只有行的标题文本部分被选中：

在此处输入图像描述

这是我需要实现的：

在此处输入图像描述

这是表单单元的代码：

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Edit1: TEdit;
    procedure ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

//uses
  //CodeSiteLogging,
  //Generics.Collections,
  //System.StrUtils,
  //Vcl.Themes;

{$R *.dfm}

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem; Rect: TRect; State: TOwnerDrawState);
const
  Alignments: array[TAlignment] of TTextFormats = (tfLeft, tfRight, tfCenter);

  procedure SetCanvasColors(const aBrushColor, aFontColor: TColor);
  begin
    (Sender as TListView).Canvas.Brush.Color := aBrushColor;
    (Sender as TListView).Canvas.Font.Color := aFontColor;
  end;
begin
  if not Assigned(Item) then EXIT;
  var SelectionColor := clYellow;

  if Edit1.Text = '' then
  begin
    /// Draw normal Item Columns:
    var LV := Sender as TListView;
    LV.Canvas.Brush.Style := bsSolid;
    LV.Canvas.FillRect(Rect);

    var x1 := 0;
    var x2 := 0;
    var RR := Rect;
    var SS: string;
    LV.Canvas.Brush.Style := bsClear;

    for var i := 0 to 1 do
    begin
      Inc(x2, LV.Columns[i].Width);
      RR.Left := x1;
      RR.Right := x2;
      if i = 0 then
        SS := Item.Caption
      else
      begin
        SS := Item.SubItems[i - 1];
      end;
      SS := #32 + SS;

      if ([odSelected, odHotLight] * State <> []) then
        SetCanvasColors(SelectionColor, clWindowText)
      else
        SetCanvasColors(clWindow, clWindowText);

      LV.Canvas.TextRect(RR, SS, [tfSingleLine, Alignments[LV.Columns[i].Alignment], tfVerticalCenter]);

      x1 := x2;
    end;
  end;
  // code removed that is not relevant for this question...
end;

end.

这是表单 DFM 文件的代码：

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'Form1'
  ClientHeight = 191
  ClientWidth = 545
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -13
  Font.Name = 'Segoe UI'
  Font.Style = []
  Position = poScreenCenter
  PixelsPerInch = 96
  TextHeight = 17
  object ListView1: TListView
    Tag = -1
    Left = 0
    Top = 25
    Width = 545
    Height = 166
    Align = alClient
    Columns = <
      item
        AutoSize = True
      end
      item
        Width = 100
      end>
    Items.ItemData = {
      05CA0100000400000000000000FFFFFFFFFFFFFFFF01000000FFFFFFFF000000
      001654006F006D00200068006100720076006500730074006500640020003300
      20006100700070006C00650073000566007200750069007400E09FD791000000
      00FFFFFFFFFFFFFFFF01000000FFFFFFFF00000000194A006500720072007900
      200069006E0068006500720069007400650064002000350020006F0072006100
      6E006700650073000566007200750069007400D0BFD79100000000FFFFFFFFFF
      FFFFFF01000000FFFFFFFF000000002454006800650020006200610062007900
      2000680061007300200065006100740065006E00200073006F006D0065002000
      7300740072006100770062006500720072006900650073000566007200750069
      00740068D2D79100000000FFFFFFFFFFFFFFFF01000000FFFFFFFF000000003D
      530061006C006C0079002000770061006E0074007300200074006F0020006200
      61006B006500200061002000630061006B006500200077006900740068002000
      660069007600650020006100700070006C0065007300200061006E0064002000
      7400680072006500650020006F00720061006E0067006500730004630061006B
      00650060F0D791FFFFFFFFFFFFFFFF}
    OwnerDraw = True
    ReadOnly = True
    RowSelect = True
    TabOrder = 0
    ViewStyle = vsReport
    OnDrawItem = ListView1DrawItem
  end
  object Edit1: TEdit
    AlignWithMargins = True
    Left = 33
    Top = 0
    Width = 479
    Height = 25
    Margins.Left = 33
    Margins.Top = 0
    Margins.Right = 33
    Margins.Bottom = 0
    Align = alTop
    TabOrder = 1
    Visible = False
  end
end
4

1 回答 1

1

问题似乎是您部分考虑了声明式编程，而实际上 Delphi 完全是命令式的。

如果您希望背景是单个蓝色矩形，则必须编写一个绘制单个蓝色矩形的 line 代码。

由于您希望这是背景，因此应在其上打印文本，因此您需要将此行放在文本绘图命令之前。

这是一个简单的例子：

创建一个新的 VCL 应用程序并将一个添加TListView到主窗体。与往常一样，设置DoubleBuffered为True. 在这种情况下，我设置Align = alClient了，在这种情况下，你也必须设置Border = bsNone。

添加列和数据。

然后，要使其所有者绘制，请设置OwnerDraw = True.

然后添加以下OnDrawItem处理程序：

procedure TForm1.ListView1DrawItem(Sender: TCustomListView; Item: TListItem;
  Rect: TRect; State: TOwnerDrawState);
begin

  if Sender <> ListView1 then
    Exit;

  // Draw the background

  if odSelected in State then
  begin
    ListView1.Canvas.Brush.Color := clHighlight;
    ListView1.Canvas.Font.Color := clHighlightText;
  end
  else
  begin
    ListView1.Canvas.Brush.Color := clWindow;
    ListView1.Canvas.Font.Color := clWindowtext;
  end;

  ListView1.Canvas.FillRect(Rect);

  // Draw each column

  var x := 0;
  for var i := 0 to ListView1.Columns.Count - 1 do
  begin
    var S := '';
    if i = 0 then
      S := Item.Caption
    else
      S := Item.SubItems[i - 1];
    S := #32 + S; // padding happens to equal width of a single space
    var W := ListView1.Columns[i].Width;
    var R := TRect.Create(x, Rect.Top, x + W, Rect.Bottom);
    ListView1.Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfEndEllipsis]);
    Inc(x, W);
  end;

end;

结果：

录屏

请注意，这个简单的例子有一个严重的错误，因为它不支持水平滚动条的非零位置。这可以很容易地修复，几乎是微不足道的。（如何？）

此外，在实际场景中，您还需要实现焦点矩形和鼠标悬停效果。

于 2022-01-27T17:50:21.057 回答