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

名前

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

本文

真琴：「こう変えれば良くなるンじゃない？」
広海：「ン？ マコト、こんなのオマエが一人で？」
真琴：「そぅ、アタシだって、やればこれくらいのコトは…」
広海：「なぁんて、冗談は顔だけ…、前にカイトから教えてもらったンだろぅ？」
真琴：「なによ、バァ〜ッカ、…でもぉ、ジツはそうナンだけど^^;;」

type
  TGradientDirection = (gdHorizontal, gdVertical);
  TListView = class(ComCtrls.TListView)
  private
    procedure CreateWnd; override;
    procedure WmPaint(var Msg: TWMPaint); message WM_PAINT;
    procedure CNNotify(var Msg: TWMNotify); message CN_NOTIFY;
    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
    procedure WMEraseBkgnd(var Msg: TWMEraseBkGnd); message WM_ERASEBKGND;
  public
    CanvasDC: HDC;
    Header_Handle: HWND;
    procedure DrawColumns;
  end;
type
  TForm1 = class(TForm)
    ListView1: TListView;
    .....
var
  Form1: TForm1;

ButtonPosX: Integer;
  HeaderChanging: Boolean;
  FOldHeaderWndProc: TFNWndProc;
  function NewHeaderWndProc(hW: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT; stdcall;

implementation

type
  TTriVertex = packed record
    x: Longint;
    y: Longint;
    Red: WORD;
    Green: WORD;
    Blue: WORD;
    Alpha: WORD;
  end;
  function GradientFill(DC: HDC; Tvx: Pointer; NumTvx: DWORD;
    Meshes: Pointer; NumMeshes: DWORD; Mode: DWORD): DWORD; stdcall;
  external 'MSImg32.dll' name 'GradientFill';

procedure DrawAlfaGradient(Canvas: TCanvas; CBgn, CEnd: TColor; aRect: TRect; GrDirection: TGradientDirection);
var
  cr: Cardinal;
  Tvx: array[0..1] of TTriVertex;
  GradientRect: TGradientRect;
begin
  Tvx[0].x := aRect.Left;
  Tvx[0].y := aRect.Top;
  cr := CBgn;
  Tvx[0].Red   := (cr and $FF) shl 8;
  Tvx[0].Green := (cr and $FF00);
  Tvx[0].Blue  := (cr and $FF0000) shr 8;
  Tvx[0].Alpha := 0;
  Tvx[1].x := aRect.Right;
  Tvx[1].y := aRect.Bottom;
  cr := CEnd;
  Tvx[1].Red   := (cr and $FF) shl 8;
  Tvx[1].Green := (cr and $FF00);
  Tvx[1].Blue  := (cr and $FF0000) shr 8;
  Tvx[1].Alpha := 0;
  GradientRect.UpperLeft := 0;
  GradientRect.LowerRight := 1;
  GradientFill(Canvas.Handle, @Tvx[0], 2, @GradientRect, 1, DWORD(GrDirection));
end;

procedure TListView.DrawColumns;
var
  Header_Rect, Column_Rect, OutofColumns_Rect: TRect;
  i, X, W1, W2, CW: Integer;
  aCanvas: TCanvas;
  Column: TListColumn;
  dwFormat: DWORD;
begin
  if Header_Handle = 0 then Exit;
  Windows.GetClientRect(Header_Handle, Header_Rect);
  W1 := GetSystemMetrics(SM_CXBORDER);
  W2 := GetSystemMetrics(SM_CXFIXEDFRAME) - W1;
  aCanvas := TCanvas.Create;
  try
   aCanvas.Handle := GetDC(Header_Handle);
   X := 0;
   for i:=0 to Columns.Count-1 do begin
    Column := Columns[i];
    CW := Columns[i].Width;
    if CW < 5 then begin inc(X, CW); Continue; end;
    Column_Rect := Rect(X+W1, W1, X+CW-W2, Header_Rect.Bottom-W2);
    if (ButtonPosX > X)and(ButtonPosX < X+CW-W2) then OffsetRect(Column_Rect, 1, 1);
    DrawAlfaGradient(aCanvas, $AAFFEE, $55CC88, Column_Rect, gdVertical);
    SetBkMode(aCanvas.Handle, TRANSPARENT);
    OffsetRect(Column_Rect, 1, 1);
    aCanvas.Font.Color := clBlack;
    dwFormat := DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS;
    case Column.Alignment of
     taLeftJustify : dwFormat := dwFormat or DT_LEFT;
     taRightJustify: dwFormat := dwFormat or DT_RIGHT;
     taCenter      : dwFormat := dwFormat or DT_CENTER;
    end;
    InflateRect(Column_Rect, -4, 0);
    DrawText(aCanvas.Handle, PChar(Column.Caption), -1, Column_Rect, dwFormat);
    inc(X, CW);
   end;
   OutofColumns_Rect := Rect(X+W1, W1, Header_Rect.Right, Header_Rect.Bottom-W2);
   DrawAlfaGradient(aCanvas, clWhite, $CCBBAA, OutofColumns_Rect, gdVertical);
  finally
   ReleaseDC(Header_Handle, aCanvas.Handle);
   aCanvas.Free;
  end;
end;

procedure TListView.CreateWnd;
begin
  Inherited;
  Header_Handle := ListView_GetHeader(Handle);
  FOldHeaderWndProc := TFNWndProc(SetWindowLong(Header_Handle, GWL_WNDPROC, Longint(@NewHeaderWndProc)));
  HeaderChanging := False;
  CanvasDC := GetDC(Handle);
end;

function NewHeaderWndProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM): LRESULT;
begin
  Result := CallWindowProc(FOldHeaderWndProc, hWnd, Msg, WParam, LParam);
  case Msg of
    WM_PAINT: Form1.ListView1.DrawColumns;
    WM_LBUTTONDOWN: ButtonPosX := LOWORD(LParam);
    WM_LBUTTONUP: ButtonPosX := -1;
  end;
end;

procedure TListView.WMNotify(var Msg: TWMNotify);
var
  pHDN: PHDNOTIFY;
begin
  inherited;
  pHDN := PHDNOTIFY(Msg.NMHdr);
  case PNMHdr(Msg.NMHdr)^.Code of
   HDN_ITEMCHANGING:
   begin
    Columns[pHDN^.Item].Width := pHDN^.PItem.cxy;
    ButtonPosX := -1;
   end;
   HDN_BEGINTRACK, HDN_BEGINTRACKW: HeaderChanging := True;
   HDN_ENDTRACK, HDN_ENDTRACKW: begin HeaderChanging := False; Invalidate; end;
  end;
end;

procedure TListView.WMEraseBkgnd(var Msg: TWMEraseBkGnd);
begin
  if HeaderChanging then exit;
  inherited;
end;

procedure TListView.CNNotify(var Msg: TWMNotify);
var
  DefaultDraw: Boolean;
begin
  DefaultDraw := True;
  if (Msg.NMHdr^.Code = NM_CUSTOMDRAW) then begin
   with PNMCustomDraw(Msg.NMHdr)^ do begin
    Msg.Result := CDRF_DODEFAULT;
    if dwDrawStage = CDDS_PREPAINT then begin
     Msg.Result := Msg.Result or CDRF_NOTIFYITEMDRAW;
     exit;
    end else
    if (dwDrawStage and CDDS_ITEMPREPAINT) <> 0 then begin
     with PNMLVCustomDraw(Msg.NMHdr)^ do begin
      Canvas.Handle := CanvasDC;
      SelectObject(hdc, Canvas.Font.Handle);
      Canvas.Handle := 0;
     end;
     if (Items[dwItemSpec].Selected) then begin
      DefaultDraw := False;
      if (dwDrawStage and CDDS_SUBITEM) <> 0 then begin
       Msg.Result := Msg.Result or CDRF_SKIPDEFAULT;
      end else begin
       Msg.Result := Msg.Result or CDRF_SKIPDEFAULT;
      end;
     end;
    end;
   end;
  end;
  if DefaultDraw then inherited;
end;

procedure TListView.WMPaint(var Msg: TWMPaint);
var
  R: TRect;
  Item: TListItem;
  i: Integer;
  BgnCol, EndCol: TColor;
  dwFormat: DWORD;
  function GetFormat(Column: TListColumn): DWORD;
  begin
   result := DT_SINGLELINE or DT_VCENTER or DT_END_ELLIPSIS;
   case Column.Alignment of
    taLeftJustify : begin result := result or DT_LEFT; inc(R.Left, 6); end;
    taRightJustify: begin result := result or DT_RIGHT; InflateRect(R, -6, 0); end;
    taCenter      : result := result or DT_CENTER;
   end;
  end;
begin
  inherited;
  if (Selected = nil) then exit;
  if Focused then begin
   BgnCol := $FF7755;
   EndCol := $BB3311;
   Canvas.Font.Color := $66FFFF;
  end else begin
   BgnCol := $EEBBFF;
   EndCol := $BB66CC;
   Canvas.Font.Color := $DD3322;
  end;
  Canvas.Handle := CanvasDC;
  Item := Selected;
  repeat
   ListView_GetItemRect(Handle, Item.Index, R, LVIR_LABEL);
   if R.Top < 7 then begin
    Item := GetNextItem(Item, sdAll, [isSelected]);
    continue;
   end;
   DrawAlfaGradient(Canvas, BgnCol, EndCol, R, gdVertical);
   SetBkMode(CanvasDC, TRANSPARENT);
   OffsetRect(R, -2, 0);
   DrawText(CanvasDC, PChar(Item.Caption), -1, R, GetFormat(Columns[0]));
   for i:=0 to Item.SubItems.Count-1 do begin
    ListView_GetSubItemRect(Handle, Item.Index, i+1, LVIR_BOUNDS, @R);
    DrawAlfaGradient(Canvas, BgnCol, EndCol, R, gdVertical);
    DrawText(CanvasDC, PChar(Item.SubItems[i]), -1, R, GetFormat(Columns[i+1]));
   end;
   R.Left := R.Right; R.Right := Width;
   Canvas.FillRect(R);
   Item := GetNextItem(Item, sdAll, [isSelected]);
  until Item = nil;
end;

procedure TForm1.〜
begin
  ........

広海：「しっかし、ナンだ？ このヘッダと選択行の色は」
真琴：「カワイイでしょ？ アタシの趣味に合わせたグラデーション」
広海：「あっそ、ま、ヘッダも凹む…ドラッグもＯＫ、…わりとヨク出来てるじゃん」
真琴：「あ、雨も風もスゴク強くなってきた…、ハルコさん遅いよね、なんか心配…」
広海：「きっと…、いや、ぅう〜ん、こんなに遅くなるはずないか…」
真琴：「ね、もしもハルコさんにまでナニかあったらどうしよう、皆…アタシの傍から居なくなっちゃう」
広海：「マコト、お前この頃チョット弱気過ぎるんじゃないの〜？」
真琴：「でもぉ…」
勝爺：「…大丈夫だよ、オレだってココに居るじゃないか、マコト」
真琴：「エッ！！？その声は…、おじいちゃん？！」
広海：「まさか、あの…、社長の幽霊？ でも出るのは時期的にまだ早かったりして…」
勝爺：「バカやろう、ダレが幽霊だ、…ホラ、足だってコノ通りあるだろう」
広海：「マジ〜？ …あっ、イテッ！」
真琴：「痛かったら、これって夢じゃないよネ…」
広海：「ツネルなら自分のほっぺたにしろよ、マコト、…もう手加減もナシで〜」
勝爺：「ほっぺたくらい貸してやれ、じゃ、オレはチョット行ってくるからな」
真琴：「え？ おじいちゃん、ドコへ？」
勝爺：「この格好観りゃ分かるだろぅ、サーフィンだよ」
真琴：「あの、おじいちゃん、外は雨、それに風もスゴイし…」
勝爺：「風で大波が来るからイイんだよ、サーフィンするには」
真琴：「でも、でも、去年、台風の時サーフィンして、それで死んじゃったのよね？」
勝爺：「人間死ぬのは一度だけ、…だろ？だから、もうナニやってもダイジョウＶ」
広海：「あ、そりゃそうだＹ、なんちゃって」
真琴：「ないよ、そんな理屈って…、おじいちゃん、やめて…、おじいちゃん！…」
春子：「マコト、 …マ・コ・ト、もう起きなきゃ学校遅れるよ」
真琴：「…ン？ …あれっ？ あ〜…夢だったのかぁ〜」
勝爺：「珍しく朝寝坊だな、マコト、さっさと顔洗って、アサメシ食べろ」
真琴：「あ、おじいちゃん、オハヨウ、…エッ！？ …アタシ、まだ夢みてるの？」

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

戻る