unit LV; 
 
interface 
 
uses 
  Windows, Forms, Messages, Classes, CommCtrl, Graphics, Controls, ComCtrls; 
 
type 
  adjustment = (ciaLeft, ciaRight); 
  TLV = class(TListView) 
  private 
    h: HWND; 
    dc: HDC; 
    pt: TPoint; 
    c: TCanvas; 
    ad: adjustment; 
    fs: TFontStyles; 
    AltProz: Pointer; 
    sl, fsl: TStringlist; 
    colors, fontcolors: string; 
    rand, unten: integer; 
  protected 
    procedure NeuProz(var M: TMessage); 
    procedure setfontcolors(s: string); 
    procedure setfs(f: TFontStyles); 
    procedure setcolors(s: string); 
    procedure setad(a: adjustment); 
    procedure CreateWnd; override; 
    procedure paintbuttons; 
    procedure Pnt; 
  public 
    constructor Create(AOwner: TComponent); override; 
    destructor Destroy; override; 
  published 
    property ColumnFontColors: string read fontcolors write setfontcolors; 
    property ColumnImageAlignment: adjustment read ad write setad; 
    property ColumnColors: string read colors write setcolors; 
    property ColumnFontStyle: TFontStyles read fs write setfs; 
  end; 
 
procedure Register; 
 
implementation 
 
procedure Register; 
begin 
  RegisterComponents('DBR', [TLV]); 
end; 
 
constructor TLV.Create(AOwner: TComponent); 
begin 
  inherited Create(AOwner); 
  sl := TStringlist.create; 
  fsl := TStringlist.create; 
  c := TCanvas.create; 
  rand := 4; 
end; 
 
destructor TLV.Destroy; 
begin 
  c.free; 
  fsl.free; 
  sl.free; 
  releasedc(h, dc); 
  inherited Destroy; 
end; 
 
procedure TLV.NeuProz(var M: TMessage); 
begin 
  if assigned(AltProz) then begin 
    M.Result := CallWindowProc(AltProz, h, M.Msg, M.WParam, M.LParam); 
    if ColumnClick then begin 
      if (M.Msg = WM_LBUTTONDOWN) 
        then begin 
        pt := point(M.LParamLo, M.LparamHi); 
        unten := 1; 
      end else if (M.Msg = WM_LBUTTONUP) 
        then begin 
        unten := 0; 
        pnt; 
      end; 
    end; 
    if M.Msg = WM_PAINT then pnt; 
  end; 
end; 
 
procedure TLV.CreateWnd; 
begin 
  inherited; 
  h := Listview_Getheader(handle); 
  SetWindowlong(h, gwl_style, GetWindowlong(h, gwl_style) 
    and not HDS_FULLDRAG); 
  dc := GetDC(h); 
  c.handle := dc; 
  AltProz := Pointer(GetWindowlong(h, GWL_WNDPROC)); 
  SetWindowlong(h, GWL_WNDPROC, Integer(MakeObjectInstance(NeuProz))); 
end; 
 
procedure TLV.Pnt; 
var x, y: integer; 
begin 
  if smallImages <> nil then begin 
    y := smallImages.width + 2 * (rand + 2); 
    for x := 0 to Columns.Count - 1 do 
      if (Columns[x].ImageIndex >= 0) and 
        (ListView_GetColumnWidth(handle, x) < y) then begin 
        ListView_SetColumnWidth(handle, x, y); 
        columns[x].width := y; 
      end; 
  end; 
  PaintButtons; 
end; 
 
procedure TLV.setad(a: adjustment); 
begin 
  if a = ad then exit; 
  ad := a; 
  refresh; 
end; 
 
procedure TLV.setfs(f: TFontStyles); 
begin 
  if f = fs then exit; 
  fs := f; 
  refresh; 
end; 
 
procedure TLV.setcolors(s: string); 
begin 
  colors := s; 
  sl.commatext := colors; 
  refresh; 
end; 
 
procedure TLV.setfontcolors(s: string); 
begin 
  fontcolors := s; 
  fsl.commatext := fontcolors; 
  refresh; 
end; 
 
procedure TLV.PaintButtons; 
var 
  m, x, y: integer; 
  r, re: TRect; 
begin 
  if (not ShowColumnHeaders) or (ViewStyle <> vsReport) then exit; 
  windows.GetClientRect(h, r); 
  y := 0; 
  c.font.size := font.size; 
  c.font.style := fs; 
  for x := 0 to Columns.Count - 1 do begin 
    re := Rect(y + 1, 1, y + ListView_GetColumnWidth(handle, x) 
      - 1, r.bottom - 2); 
    if ptinrect(re, pt) then offsetrect(re, unten, unten); 
    try 
      c.brush.color := stringtocolor(sl[x]); 
    except c.brush.color := clBtnFace; 
    end; 
    try 
      c.font.color := stringtocolor(fsl[x]); 
    except c.font.color := clWindowText; 
    end; 
    c.FillRect(re); 
    inc(re.left, rand); 
    dec(re.right, 2); 
    if smallImages <> nil then begin 
      if Columns[x].ImageIndex >= 0 then begin 
        m := 1 + (re.bottom - smallImages.height) div 2; 
        if ad = ciaLeft then begin 
          smallImages.draw(c, re.left, m, Columns[x].ImageIndex); 
          inc(re.left, smallImages.width + rand); 
        end else begin 
          smallImages.draw(c, re.right - smallImages.width, m, 
            Columns[x].ImageIndex); 
          dec(re.right, smallImages.width + rand); 
        end; 
      end; 
    end; 
    drawtext(c.handle, pchar(Columns[x].Caption), -1, re, dt_left); 
    y := y + ListView_GetColumnWidth(handle, x); 
  end; 
  try 
    c.brush.color := stringtocolor(sl[Columns.Count]); 
  except c.brush.color := clbtnface; 
  end; 
  c.FillRect(Rect(y + 1, 1, r.Right, r.Bottom - 2)); 
end; 
 
end. 
 
 
 
//--------------------------------------------------------- 
 
// Beispielaufruf 
procedure TForm1.Button1Click(Sender: TObject); 
var x: integer; 
begin 
  lv1.items.beginupdate; 
  for x := 0 to 2 do begin 
    if lv1.columns.count = x then lv1.Columns.add; 
    lv1.column[x].caption := 'Spalte ' + inttostr(x + 1); 
    lv1.column[x].width := 70; 
  end; 
  lv1.smallImages := ImageList1; 
  lv1.Column[0].ImageIndex := 0; 
  lv1.ColumnImageAlignment := ciaRight; 
  lv1.ColumnFontStyle := [fsitalic, fsbold]; 
  lv1.ColumnColors := 'clred $FF6633 clyellow clblack'; 
  lv1.ColumnFontColors := 'clwhite $00CCFF $FF6600'; 
  lv1.items.endupdate; 
end;