Delphi：带有自定义字体颜色的ListView（vsReport）单列标题标题？

Question

在带有 vsReport ViewStyle 的 ListView 中，如何自定义任何单个列标题标题的字体颜色？例如（第二列标题标题的字体颜色为红色）：

Answer 1

我将处理NM_CUSTOMDRAW 标头通知代码，并在CDDS_ITEMPREPAINT 呈现阶段使用CDRF_NEWFONT 返回代码响应此通知消息。以下代码显示了如何扩展列表视图控件以具有指定标题项字体颜色的事件：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, CommCtrl, StdCtrls;

type
  TGetHeaderItemFontColorEvent = procedure(Sender: TCustomListView;
    ItemIndex: Integer; var FontColor: TColor) of object;
  TListView = class(ComCtrls.TListView)
  private
    FHeaderHandle: HWND;
    FOnGetHeaderItemFontColor: TGetHeaderItemFontColorEvent;
    procedure WMNotify(var AMessage: TWMNotify); message WM_NOTIFY;
  protected
    procedure CreateWnd; override;
  published
    property OnGetHeaderItemFontColor: TGetHeaderItemFontColorEvent read
      FOnGetHeaderItemFontColor write FOnGetHeaderItemFontColor;
  end;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    procedure GetHeaderItemFontColor(Sender: TCustomListView;
      ItemIndex: Integer; var FontColor: TColor);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TListView }

procedure TListView.CreateWnd;
begin
  inherited;
  FHeaderHandle := ListView_GetHeader(Handle);
end;

procedure TListView.WMNotify(var AMessage: TWMNotify);
var
  FontColor: TColor;
  NMCustomDraw: TNMCustomDraw;
begin
  if (AMessage.NMHdr.hwndFrom = FHeaderHandle) and
    (AMessage.NMHdr.code = NM_CUSTOMDRAW) then
  begin
    NMCustomDraw := PNMCustomDraw(TMessage(AMessage).LParam)^;
    case NMCustomDraw.dwDrawStage of
      CDDS_PREPAINT:
        AMessage.Result := CDRF_NOTIFYITEMDRAW;
      CDDS_ITEMPREPAINT:
      begin
        FontColor := Font.Color;
        if Assigned(FOnGetHeaderItemFontColor) then
          FOnGetHeaderItemFontColor(Self, NMCustomDraw.dwItemSpec, FontColor);
        SetTextColor(NMCustomDraw.hdc, ColorToRGB(FontColor));
        AMessage.Result := CDRF_NEWFONT;
      end;
    else
      AMessage.Result := CDRF_DODEFAULT;
    end;
  end
  else
    inherited;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.OnGetHeaderItemFontColor := GetHeaderItemFontColor;
end;

procedure TForm1.GetHeaderItemFontColor(Sender: TCustomListView;
  ItemIndex: Integer; var FontColor: TColor);
begin
  case ItemIndex of
    0: FontColor := clRed;
    1: FontColor := clGreen;
    2: FontColor := clBlue;
  end;
end;

end.

整个项目你可以download from here。这是上面示例的结果：

Answer 2

您可以从列表视图中获取本机标题控件，然后将列的特定项目标记为所有者绘制。您只需要在请求绘制标题项时更改文本颜色（如果您不删除 string 标志）。绘图消息将被发送到标题的父级 - 列表视图，因此您需要在那里处理消息。有关所有者绘制的标题控件，请参阅 here。

示例代码：

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
     ...
  private
    FLVHeader: HWND;
    FSaveLVWndProc: TWndMethod;
    procedure LVWndProc(var Msg: TMessage);
    procedure SetHeaderItemStyle(Index: Integer);
  end;

..
uses commctrl;
..

procedure TForm1.FormCreate(Sender: TObject);
begin
  FLVHeader := ListView_GetHeader(ListView1.Handle);
  SetHeaderItemStyle(1);

  FSaveLVWndProc := ListView1.WindowProc;
  ListView1.WindowProc := LVWndProc;
end;

procedure TForm1.SetHeaderItemStyle(Index: Integer);
var
  HeaderItem: THDItem;
begin
  HeaderItem.Mask := HDI_FORMAT or HDI_TEXT or HDI_LPARAM;
  Header_GetItem(FLVHeader, 1, HeaderItem);
  HeaderItem.Mask := HDI_FORMAT;
  HeaderItem.fmt := HeaderItem.fmt or HDF_OWNERDRAW;
  Header_SetItem(FLVHeader, 1, HeaderItem);
end;

procedure TForm1.LVWndProc(var Msg: TMessage);
begin
  FSaveLVWndProc(Msg);    // thanks to @Kobik (cause SO if called later then WM_NOTIFY case on some (all other then mine?) machines)

  case Msg.Msg of
    WM_DRAWITEM:
      if (TWmDrawItem(Msg).DrawItemStruct.CtlType = ODT_HEADER) and
          (TWmDrawItem(Msg).DrawItemStruct.hwndItem = FLVHeader) and
          (TWmDrawItem(Msg).DrawItemStruct.itemID = 1) then
        SetTextColor(TWmDrawItem(Msg).DrawItemStruct.hDC, ColorToRGB(clRed));
    WM_NOTIFY:
      if (TWMNotify(Msg).NMHdr.hwndFrom = FLVHeader) and
          (TWMNotify(Msg).NMHdr.code = HDN_ITEMCHANGED) then
          // also try 'HDN_ENDTRACK' if it doesn't work as expected
        SetHeaderItemStyle(1);
    WM_DESTROY: ListView1.WindowProc := FSaveLVWndProc;
  end;
end;