Delphi: ListView (vsReport) single column header caption with custom font color?

Question

In a ListView with vsReport ViewStyle, how can I customize the font color of just any single column header caption? For example (the second column header caption has a red font color):

Answer 1

I would handle the NM_CUSTOMDRAW header notification code and respond to this notification message with the CDRF_NEWFONT return code at the CDDS_ITEMPREPAINT rendering stage. The following code shows how to extend list view controls to have the event for specifying header item font color:

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.

The whole project you can download from here. Here's the result of the above example:

Answer 2

You can get the native header control from the listview and then mark the specific item of your column as owner drawn. You only need to change the text color (if you don't remove the string flag) when the header item requests to be drawn. The drawing message will be sent to the header's parent - the listview, hence you need to handle the message there. See here for owner drawn header controls.

Example code:

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;