Delphi: заголовок заголовка одного столбца ListView (vsReport) с пользовательским цветом шрифта?

в ListView с Vsreport ViewStyle, как я могу настроить цвет шрифта только любого заголовка заголовка одного столбца? Например (заголовок заголовка второго столбца имеет красный цвет шрифта): enter image description here

8
columnheader delphi delphi-xe2 listview windows

2 ответов

Я бы 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.

весь проект вы можете скачать здесь. Вот результат приведенного выше примера:

enter image description here

13

вы можете получить собственный элемент управления заголовком Из listview, а затем пометить конкретный элемент столбца как нарисованный владелец. Вам нужно только изменить цвет текста (если вы не удалите строка флаг), когда элемент заголовка запрашивает рисование. Сообщение чертежа будет отправлено родителю заголовка-listview, поэтому вам нужно обработать сообщение там. См.здесь для рук нарисованы управления заголовка.

пример кода:

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;
6