ListViewのヘッダに色を付けるには？ (ID:30884)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

Delphi5では、ListViewのヘッダ項目に色を付けるコード(某掲示板で見つけた）を下記方法で実現できていたのですが、Delphi2007では色が付きません。Delphi2007でListViewのヘッダ項目に色を付ける方法をご存知の方、教えてください。宜しくお願いいたします。

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
    OriginalWndProc:TWndMethod;
    procedure SubclassProc(var Msg:TMessage);
    procedure HeaderDrawItem(Msg:TWMDrawItem);
    procedure MakeOwnerDraw(Section:integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses Commctrl;

//ヘッダーのセクションの描画
procedure TForm1.HeaderDrawItem(Msg: TWMDrawItem);
var
  DIS:TDrawItemStruct;
  r:TRect;
  s:string;
  hBr: HBRUSH;
begin
  DIS := Msg.DrawItemStruct^;
  if DIs.CtlType <> ODT_HEADER then exit;
  hBr := 0;
  case DIS.itemID of
    0:hBr := CreateSolidBrush(ColorToRGB(clYellow));
    1:hBr := CreateSolidBrush(ColorToRGB(clLime));
  end;
  r := DIS.rcItem;
  Windows.FillRect(DIS.hDC,r,hBr);
  DeleteObject(hBr);
  s := ListView1.Columns[DIS.itemID].Caption;
  SetBkMode(DIS.hDC,TRANSPARENT);
  Windows.TextOut(DIS.hDC,r.Left+5,r.Top+2,PChar(s),Length(s));
end;

//サブクラスプローシージャ
procedure TForm1.SubclassProc(var Msg: TMessage);
var
  pNMH:PNMHdr;
begin
  OriginalWndProc(Msg);
  case Msg.Msg of
    WM_DRAWITEM:HeaderDrawItem(TWMDrawItem(Msg));
    WM_NOTIFY:begin
      pNMH := PNMHdr(Msg.LParam);
      if pNMH.code = HDN_ENDTRACK then begin
        MakeOwnerDraw(0);
        MakeOwnerDraw(1);
      end;
    end;
  end;
end;

//ヘッダーの各セクションのオーナードローの設定
procedure TForm1.MakeOwnerDraw(Section: integer);
var
  hHeader:HWND;
  Item:THDItem;
begin
  hHeader := GetWindow(ListView1.Handle,GW_CHILD);
  if hHeader = 0 then exit;
  Item.Mask := HDI_FORMAT;
  Item.fmt := HDF_OWNERDRAW;
  Header_SetItem(hHeader,Section,Item);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  OriginalWndProc := ListView1.WindowProc;
  ListView1.WindowProc := SubclassProc;
  MakeOwnerDraw(0);
  MakeOwnerDraw(1);
end;

←解決時は質問者本人がここをチェックしてください。

戻る