changing the font and color of a listview's column caption

raypollard
raypollard used Ask the Experts™
on
there seems to be no readily available way to do this.
i am wanting to change the font and pen color of the column captions of a listview.
(i want them to display in blue underlined because they will be used for drilldown hotlinks)
it looks like one of the customdraw event handlers  should be able to do it, but i have been unable to make them do so.
anyone know how to control the font and color for the listview column captions?

-ray

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
something like this?

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    procedure NewListProc(var Msg: TMessage);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  CommCtrl;

{$R *.DFM}

var
  OldListProc: TWndMethod;

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
  ASortColumn: Integer;
  hDlg: THandle;
  hItem: THDItem;
begin
  hDlg := GetDlgItem(ListView1.Handle, 0);
  for i := 0 to ListView1.Columns.Count - 1 do
  begin
    hItem.Mask := HDI_FORMAT;
    Header_GetItem(hDlg, i, hItem);
    hItem.Mask := HDI_FORMAT;
    hItem.fmt := HDF_OWNERDRAW;
    Header_SetItem(hDlg, i, hItem);
  end;
  OldListProc := ListView1.WindowProc;
  ListView1.WindowProc := NewListProc;
end;

procedure TForm1.NewListProc(var Msg: TMessage);
var
  ItemStruct: TDrawItemStruct;
  HeaderDC: HDC;
  ColumnRect: TRect;
  HeaderFont: TFont;
  HeaderBrush: TBrush;
  xOffset, yOffset, textOffset: Integer;
  CaptionToDraw: string;
  CustomDraw: TNMCustomDraw;
  ColumnIndex: Integer;
  ColumnState: Cardinal;
begin
  if Msg.Msg = WM_NOTIFY then
  begin
    CustomDraw := PNMCustomDraw(Msg.lParam)^;
    if (CustomDraw.hdr.code = NM_CUSTOMDRAW) and
      (CustomDraw.hdr.hwndFrom = GetDlgItem(ListView1.Handle, 0)) then
    begin
      case CustomDraw.dwDrawStage of
        CDDS_PREPAINT:
          Msg.Result := CDRF_NOTIFYITEMDRAW;
        CDDS_ITEMPREPAINT:
          begin
            HeaderDC := CustomDraw.hdc;
            ColumnRect := CustomDraw.rc;
            ColumnIndex := CustomDraw.dwItemSpec;
            ColumnState := CustomDraw.uItemState;

            HeaderFont := TFont.Create;
            HeaderBrush := TBrush.Create;
            HeaderFont.Style := [fsUnderline];
            HeaderBrush.Color := clBtnFace;

            SelectObject(HeaderDC, HeaderFont.Handle);
            FillRect(HeaderDC, ColumnRect, HeaderBrush.Handle);
            SetTextColor(HeaderDC, clNavy);
            SetBkMode(HeaderDC, TRANSPARENT);

            xOffset := 2;
            yOffset := 1;
            textOffset := 5;

            if (ItemStruct.itemState and ODS_SELECTED) = ODS_SELECTED then
            begin
              Inc(xOffset);
              Inc(yOffset);
              Inc(textOffset);
            end;

            Inc(ColumnRect.Left, textOffset);
            Inc(ColumnRect.Top, yOffset);
            CaptionToDraw := ListView1.Columns.Items[ItemStruct.itemID].Caption;

            DrawText(HeaderDC, PChar(CaptionToDraw), Length(CaptionToDraw),
              ColumnRect, DT_LEFT);

            Msg.Result := 1;
          end;
      end;
    end;
  end else

  if Msg.Msg = WM_DRAWITEM then
  begin
    ItemStruct := PDrawItemStruct(Msg.LParam)^;
    HeaderDC := ItemStruct.hDC;
    ColumnRect := ItemStruct.rcItem;

    HeaderFont := TFont.Create;
    HeaderBrush := TBrush.Create;
    HeaderFont.Style := [fsUnderline];
    HeaderBrush.Color := clBtnFace;

    SelectObject(HeaderDC, HeaderFont.Handle);
    FillRect(HeaderDC, ColumnRect, HeaderBrush.Handle);
    SetTextColor(HeaderDC, clNavy);
    SetBkMode(HeaderDC, TRANSPARENT);

    xOffset := 2;
    yOffset := 1;
    textOffset := 5;

    if (ItemStruct.itemState and ODS_SELECTED) = ODS_SELECTED then
    begin
      Inc(xOffset);
      Inc(yOffset);
      Inc(textOffset);
    end;

    Inc(ColumnRect.Left, textOffset);
    Inc(ColumnRect.Top, yOffset);
    CaptionToDraw := ListView1.Columns.Items[ItemStruct.itemID].Caption;

    DrawText(HeaderDC, PChar(CaptionToDraw), Length(CaptionToDraw),
      ColumnRect, DT_LEFT);

    Msg.Result := 1;
  end else
  OldListProc(Msg);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ListView1.WindowProc := OldListProc;
end;

end.


ok, the code above is not properly optimised, i repeated a lot of stuff... but it should work :)

Author

Commented:
got it to display correctly, but the column captions wont respond to click events now.
(column clicks works without this code)
i tried runtime reassignment, but that didnt work.
how do i get the column click event handler to work?

Author

Commented:
figured it out.
was able to still attach to the columnclick event handler by calling the OldProc when
  NOT ((CustomDraw.hdr.code = NM_CUSTOMDRAW) and (CustomDraw.hdr.hwndFrom = GetDlgItem(ListView1.Handle, 0)))

kudos, dragonslayer. appreciate your work.
no probs :)

happy programming!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial