Tipy a triky v Delphi, díl 71.

Minule jsme vylepšovali komponentu Edit, dnes zase naučíme pár užitečných vlastností ListView.
Komponenta ListView by jistě snesla řadu vylepšení a to jak funkčních, tak vizuálních. My se dnes zaměříme na jeden malý detail, který v základní podobě této komponenty chybí.

Přepneme-li styl zobrazení Listview na vsReport, zobrazí se nám v prvním "řádku" komponenty hlavička a my můžeme definovat jednotlivé sloupce. Tento styl je velmi často používaný a jistě jej dobře znáte. Jednou z vlastností tohoto zobrazení je to, že uživatel si může sám myší nastavit velikost (šířku) jednotlivých sloupců, aby si například zvětšil právě ten sloupec, který ho zajímá nejvíce. A to už se dostáváme k dnešnímu tématu. V událostech komponenty ListView naleznete událost OnResize. Ta je, zjednodušeně řečeno, volána v situaci, kdy se nějakým způsobem změní velikost ListView. Není však vyvolána v případě, kdy uživatel změní velikost jednotlivých sloupců (pokud tedy tato změna nezpůsobí změnu celého ListView např. přidáním posuvníku). Právě o možnost detekovat navíc i změnu rozměrů jednotlivých sloupců si rozšíříme vlastnost komponenty ListView.

Asi vás již nepřekvapí, že k tomu tradičně použijeme zprávy Windows a základní skupinu událostí si rozšíříme o tři nové události OnColumnResize, OnBeginColumnResize a OnEndColumnResize, jejichž názvy dostatečně popisují jejich funkci. Stejně jako v minulém dílu si náš příklad uděláme přímo jako novou komponentu pro jednodušší použití.

unit ListviewEx;

interface

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

type
  TLVColumnResizeEvent = procedure(Sender: TCustomListview; columnindex: Integer; columnwidth: Integer) of object;
  TListviewEx = class(TListview)
  private
    FBeginColumnResizeEvent: TLVColumnResizeEvent;
    FEndColumnResizeEvent: TLVColumnResizeEvent;
    FColumnResizeEvent: TLVColumnResizeEvent;

  protected
    procedure DoBeginColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure DoEndColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure DoColumnResize(columnindex, columnwidth: Integer); virtual;
    procedure WMNotify(var Msg: TWMNotify); message WM_NOTIFY;
    function FindColumnIndex(pHeader: pNMHdr): Integer;
    function FindColumnWidth(pHeader: pNMHdr): Integer;
    procedure CreateWnd; override;
  published
    property OnBeginColumnResize: TLVColumnResizeEvent read FBeginColumnResizeEvent write FBeginColumnResizeEvent;
    property OnEndColumnResize: TLVColumnResizeEvent read FEndColumnResizeEvent write FEndColumnResizeEvent;
    property OnColumnResize: TLVColumnResizeEvent read FColumnResizeEvent write FColumnResizeEvent;
  end;

procedure Register;

implementation

uses CommCtrl;

procedure TListviewEx.DoBeginColumnResize(columnindex, columnwidth: Integer);
begin
  if Assigned(FBeginColumnResizeEvent) then FBeginColumnResizeEvent(Self, columnindex, columnwidth);
end;

procedure TListviewEx.DoEndColumnResize(columnindex, columnwidth: Integer);
begin
  if Assigned(FEndColumnResizeEvent) then FEndColumnResizeEvent(Self, columnindex, columnwidth);
end;

procedure TListviewEx.DoColumnResize(columnindex, columnwidth: Integer);
begin
  if Assigned(FColumnResizeEvent) then FColumnResizeEvent(Self, columnindex, columnwidth);
end;

function TListviewEx.FindColumnIndex(pHeader: pNMHdr): Integer;
var
  hwndHeader: HWND;
  iteminfo: THdItem;
  ItemIndex: Integer;
  buf: array [0..128] of Char;
begin
  Result := -1;
  hwndHeader := pHeader^.hwndFrom;
  ItemIndex := pHDNotify(pHeader)^.Item;
  FillChar(iteminfo, SizeOf(iteminfo), 0);
  iteminfo.Mask := HDI_TEXT;
  iteminfo.pszText := buf;
  iteminfo.cchTextMax := SizeOf(buf) - 1;
  Header_GetItem(hwndHeader, ItemIndex, iteminfo);
  if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then Result := ItemIndex
  else
  begin
    for ItemIndex := 0 to Columns.Count - 1 do
      if CompareStr(Columns[ItemIndex].Caption, iteminfo.pszText) = 0 then
      begin
        Result := ItemIndex;
        Break;
      end;
  end;
end;

procedure TListviewEx.WMNotify(var Msg: TWMNotify);
begin
  inherited;
  case Msg.NMHdr^.code of
    HDN_ENDTRACK: DoEndColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
    HDN_BEGINTRACK: DoBeginColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
    HDN_TRACK: DoColumnResize(FindColumnIndex(Msg.NMHdr), FindColumnWidth(Msg.NMHdr));
  end;
end;

procedure TListviewEx.CreateWnd;
var
  wnd: HWND;
begin
  inherited;
  wnd := GetWindow(Handle, GW_CHILD);
  SetWindowLong(wnd, GWL_STYLE, GetWindowLong(wnd, GWL_STYLE) and not HDS_FULLDRAG);
end;

function TListviewEx.FindColumnWidth(pHeader: pNMHdr): Integer;
begin
  Result := -1;
  if Assigned(PHDNotify(pHeader)^.pItem) and ((PHDNotify(pHeader)^.pItem^.mask and HDI_WIDTH) <> 0) then Result := PHDNotify(pHeader)^.pItem^.cxy;
end;

procedure Register;
begin
  RegisterComponents(`Samples`, [TListviewEx]);
end;

end.

Instalace probíhá stejně jako v minulém dílu běžným způsobem a nainstalovanou komponentu opět najdete na záložce Samples.

Diskuze (1) Další článek: HDD od Maxtoru se Serial ATA

Témata článku: Software, Windows, Programování, Malý detail, Read, Trik, Self, Sloupec, Díl, Jednotlivé komponenty, HDI, Jednotlivý díl


Určitě si přečtěte

Porno insider: Jak Greg Lansky mění internet pro dospělé

Porno insider: Jak Greg Lansky mění internet pro dospělé

** Erotický obsah generoval ohromné peníze, pak ale přišel internet... ** Pornografie dostupná všude a zdarma uvedla tvůrce do krize ** Někteří ale dokázali potenciál internetu využít i v tomto oboru

Jan Dudek | 12

Vylaďte si Wi-Fi: Podívejte se, jaká pásma máte doma volná a kam signál nedosáhne

Vylaďte si Wi-Fi: Podívejte se, jaká pásma máte doma volná a kam signál nedosáhne

** Prozkoumejte, jaké pásmo je pro vaši síť nejlepší ** Díky heat mapě snadno poznáte, kde to bude se signálem horší ** Vše zvládnete i z mobilního telefonu

Vladislav Kluska | 27

Nový iPhone a další novinky Applu: sledujte, na co se zase budou stát fronty

Nový iPhone a další novinky Applu: sledujte, na co se zase budou stát fronty

** Apple dnes představuje nové produkty v čele s novými iPhony ** Nemusí zůstat jen u telefonů, čekají se i další novinky ** Úvodní přednáška začíná v 19:00 našeho času

David Polesný | 57


Aktuální číslo časopisu Computer

Jak vytvořit a spravovat vlastní web

Velký test herních klávesnic a DVB-T2 tunerů

Vše o formátu RAW

Vybíráme nejlepší základní desku