unit LV_HEader; 
 
interface 
 
uses 
  Windows, 
  Messages, 
  Classes, 
  Forms, 
  Controls, 
  Graphics, 
  ComCtrls, 
  CommCtrl; 
 
type 
  TForm1 = class(TForm) 
    ListView1: TListView; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
  private 
    { Private-Deklarationen} 
  public 
    dc: HDC; 
    pt: TPoint; 
    cnv: TCanvas; 
    unten: boolean; 
    AProz: Pointer; 
    Header: longint; 
    procedure zeichnen; 
    procedure NProz(var M: TMessage); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  farbe: array[0..4] of TColor = (clred, clbtnface, clgreen, clblack, clblue); 
  schrift: array[0..3] of TColor = (clyellow, clblack, clwhite, cllime); 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  unten := false; 
  header := ListView_GetHeader(Listview1.handle); 
  SetWindowlong(Header, GWL_STYLE, GetWindowlong(Header, GWL_STYLE) 
    and not HDS_FULLDRAG); 
  AProz := Pointer(GetWindowlong(Header, GWL_WNDPROC)); 
  SetWindowlong(Header, GWL_WNDPROC, Integer(MakeObjectInstance(NProz))); 
  dc := GetDC(Header); 
  cnv := TCanvas.create; 
  cnv.handle := dc; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  cnv.free; 
  releasedc(Header, dc); 
end; 
 
procedure TForm1.zeichnen; 
var 
  x, y, hf, hs: integer; 
  r, rec: TRect; 
begin 
  y := 0; 
  hf := high(farbe); 
  hs := high(schrift); 
  cnv.font := Listview1.font; 
  Windows.GetClientRect(Header, r); 
  for x := 0 to Listview1.columns.count - 1 do begin 
    with cnv do begin 
      rec := rect(y, 0, y + Listview1.columns[x].width, r.bottom); 
      if x <= hf then brush.color := farbe[x] 
      else brush.color := clbtnface; 
      pen.color := clbtnShadow; 
      if unten and ptinrect(rec, pt) then begin 
        rectangle(rec.left, rec.top, rec.right, rec.bottom); 
        offsetrect(rec, 1, 1); 
      end else begin 
        fillrect(rec); 
        moveto(y + Listview1.columns[x].width - 2, 0); 
        lineto(y + Listview1.columns[x].width - 2, r.bottom - 2); 
        lineto(y - 1, r.bottom - 2); 
        pen.color := clbtnHighLight; 
        if Listview1.ColumnClick then begin 
          moveto(y, r.bottom - 2); 
          lineto(y, 0); 
          lineto(y + Listview1.columns[x].width - 1, 0); 
          pen.color := cl3DDKShadow; 
        end; 
        moveto(y + Listview1.columns[x].width - 1, 0); 
        lineto(y + Listview1.columns[x].width - 1, r.bottom - 1); 
        lineto(y - 1, r.bottom - 1); 
      end; 
      inflaterect(rec, -2, -2); 
      inc(rec.left, 2); 
      if x <= hs then cnv.Font.color := schrift[x] 
      else cnv.Font.color := clWindowText; 
      drawtext(handle, pchar(Listview1.columns[x].caption), -1, 
        rec, DT_LEFT); 
    end; 
    y := y + Listview1.columns[x].width; 
  end; 
  if Listview1.columns.count <= hf then begin 
    cnv.brush.color := farbe[Listview1.columns.count]; 
    cnv.fillrect(rect(y + 1, r.top + 1, r.right, r.bottom - 2)); 
  end; 
end; 
 
procedure TForm1.NProz(var M: TMessage); 
begin 
  if assigned(AProz) then begin 
    M.Result := CallWindowProc(AProz, Header, M.Msg, M.WParam, M.LParam); 
    if Listview1.ColumnClick then begin 
      if (M.Msg = WM_LBUTTONDOWN) 
        then begin 
        pt := point(M.LParamLo, M.LParamHi); 
        unten := true; 
      end else if (M.Msg = WM_LBUTTONUP) 
        then begin 
        unten := false; 
        zeichnen; 
      end; 
    end; 
    if M.Msg = WM_PAINT then zeichnen; 
  end; 
end; 
 
end.