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

Question

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

Answer 1

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

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

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