{*------------------------------------------------------------------------------
  Listview enhancement offering XP Style (common controls 6.0) grouping

  @Author    Patrick M. Kolla
  @Version   2007-06-29   Patrick M. Kolla	Initial revision                                       
-------------------------------------------------------------------------------}
// *****************************************************************************
// Copyright: 2007 Safer Networking Ltd. All rights reserved.
// File:      snlListView.pas
// License:   LGPL 2.1
// Compiler:  Borland Delphi 2006, FPC
// Purpose:   Listview enhancement offering XP Style (common controls 6.0) grouping
// Authors:   Patrick M. Kolla (pk)
// *****************************************************************************
//  This library is free software; you can redistribute it and/or
//  modify it under the terms of the GNU Lesser General Public
//  License as published by the Free Software Foundation; either
//  version 2.1 of the License, or (at your option) any later version.
//
//  This library is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
//  Lesser General Public License for more details.
//
//  You should have received a copy of the GNU Lesser General Public
//  License along with this library; if not, write to the Free Software
//  Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
// *****************************************************************************
// Dependencies:
// CommCtrl_Fragment  - Definitions of new stuff
// *****************************************************************************
// Changelog (new entries first):
// ---------------------------------------
// 2007-06-29  pk   30m  Created class helpers for modern Delphi
// *****************************************************************************
// * This will NOT work when there is no manifest included in the executable!
// * On Windows older than XP, new functions will not work
// * Full credits go to Matthias Simmack and his posts @ Delphi-PRAXiS:
//   http://www.delphipraxis.net/topic3568_tilemodus+und+gruppierung+von+listviewitems+winxp.html
// *****************************************************************************
unit snlListView;

{$DEFINE UseClassHelpers}

interface

uses
   Windows,
   Classes,
   ComCtrls,
   CommCtrl,
   CommCtrl_Fragment;

type
  TXPListView = class(TComponent)
  private
     function GetDontForget: string;
  published
     property DontForget: string read GetDontForget stored false;
  end;

type
   {$IFDEF UseClassHelpers}
   TViewStyleEx = (vsIcon, vsSmallIcon, vsList, vsReport, vsTile);

   { TListViewGroupingHelper }

   TListViewGroupingHelper = class helper for TListView
   private
      function GetGroupViewEnabled: boolean;
      procedure SetGroupViewEnabled(const Value: boolean);
      function GetViewStyleEx: TViewStyleEx;
      procedure SetViewStyleEx(const Value: TViewStyleEx);
      procedure SetTileViewLines(const Value: integer);
   public
      procedure AddGroup(const Header: widestring; const GroupId: integer);
      property GroupViewEnabled: boolean read GetGroupViewEnabled write SetGroupViewEnabled;
      property TileViewLines: integer write SetTileViewLines;
      property ViewStyleEx: TViewStyleEx read GetViewStyleEx write SetViewStyleEx;
   end;

   { TListItemGroupingHelper }

   TListItemGroupingHelper = class helper for TListItem
   private
      function GetGroupId: integer;
      procedure SetGroupId(const Value: integer);
   public
      procedure SetMinimumSubItemCount(const Count: integer; const EmptyFiller: string = '');
      procedure SetTileViewColumns(const ColumnCount: integer; const Columns: array of integer);
      property GroupId: integer read GetGroupId write SetGroupId;
   end;
   {$ENDIF UseClassHelpers}

function ListViewGetGroupViewEnabled(const ListView: TListView): boolean; inline;
procedure ListViewSetGroupViewEnabled(const ListView: TListView; Enabled: boolean); inline;
procedure ListViewAddGroup(const ListView: TListView; const Header: widestring; const GroupId: integer); inline;
procedure ListViewSetTileInfo(const ListView: TListView; const LineCount: integer); inline;

function ListItemGetGroupId(const ListItem: TListItem): integer; inline;
procedure ListItemSetGroupId(const ListItem: TListItem; const GroupId: integer); inline;
procedure ListItemSetMinimumSubItemCount(const ListItem: TListItem; const Count: integer; const EmptyFiller: string = ''); inline;
procedure ListItemTileViewColumns(const ListItem: TListItem; const ColumnCount: integer; const Columns: array of integer);

procedure Register;

implementation

function ListViewGetGroupViewEnabled(const ListView: TListView): boolean; inline;
begin
   Result := ListView_IsGroupViewEnabled(ListView.Handle);
end;

procedure ListViewSetGroupViewEnabled(const ListView: TListView; Enabled: boolean); inline;
begin
   ListView_EnableGroupView(ListView.Handle, Enabled);
end;

procedure ListViewAddGroup(const ListView: TListView; const Header: widestring; const GroupId: integer); inline;
var g: TLVGroup;
begin
   g.cbSize := SizeOf(TLVGroup);
   g.mask := LVGF_HEADER or LVGF_GROUPID;
   g.pszHeader := PWideChar(Header);
   g.cchHeader := lstrlenW(g.pszHeader);
   g.iGroupId := GroupId;
   ListView_InsertGroup(ListView.Handle, -1, g);
end;

procedure ListViewSetTileInfo(const ListView: TListView; const LineCount: integer); inline;
var tv: TLVTileViewInfo;
begin
   tv.cbSize := SizeOf(TLVTileViewInfo);
   tv.dwMask := LVTVIM_COLUMNS;
   tv.dwFlags := LVTVIF_AUTOSIZE;
   tv.cLines := LineCount;
   ListView_SetTileViewInfo(ListView.Handle, tv);
end;

function ListItemGetGroupId(const ListItem: TListItem): integer; inline;
var lv: TLVItem60;
begin
   ZeroMemory(@lv, SizeOf(TLVItem60));
   lv.mask := LVIF_GROUPID;
   lv.iItem := ListItem.Index;
   SendMessage(ListItem.ListView.Handle, LVM_GETITEM, 0, LPARAM(@lv));
   Result := lv.iGroupId;
end;

procedure ListItemSetGroupId(const ListItem: TListItem; const GroupId: integer); inline;
var lv: TLVItem60;
begin
   ZeroMemory(@lv, SizeOf(TLVItem60));
   lv.mask := LVIF_GROUPID;
   lv.iItem := ListItem.Index;
   lv.iGroupId := GroupId;
   SendMessage(ListItem.ListView.Handle, LVM_SETITEM, 0, LPARAM(@lv));
end;

procedure ListItemSetMinimumSubItemCount(const ListItem: TListItem; const Count: integer; const EmptyFiller: string = ''); inline;
begin
   while ListItem.SubItems.Count<Count
    do ListItem.SubItems.Add(EmptyFiller);
end;

procedure ListItemTileViewColumns(const ListItem: TListItem; const ColumnCount: integer; const Columns: array of integer);
var ti: TLVTileInfo;
begin
   ti.cbSize := SizeOf(TLVTileInfo);
   ti.iItem := ListItem.Index;
   ti.cColumns := ColumnCount;
   ti.puColumns := @Columns[0];
   ListView_SetTileInfo(ListItem.ListView.Handle, ti);
end;

{$IFDEF UseClassHelpers}

{ TListViewGroupingHelper }

procedure TListViewGroupingHelper.AddGroup(const Header: widestring; const GroupId: integer);
begin
   ListViewAddGroup(Self, Header, GroupId);
end;

function TListViewGroupingHelper.GetGroupViewEnabled: boolean;
begin
   Result := ListViewGetGroupViewEnabled(Self);
end;

function TListViewGroupingHelper.GetViewStyleEx: TViewStyleEx;
begin
   case ListView_GetView(Self.Handle) of
      LV_VIEW_ICON: Result := vsIcon;
      LV_VIEW_SMALLICON: Result := vsSmallIcon;
      LV_VIEW_LIST: Result := vsList;
      LV_VIEW_DETAILS: Result := vsReport;
      LV_VIEW_TILE: Result := vsTile;
      else Result := vsIcon; // just to please the compiler and future features
   end;
end;

procedure TListViewGroupingHelper.SetGroupViewEnabled(const Value: boolean);
begin
   ListViewSetGroupViewEnabled(Self, Value);
end;

procedure TListViewGroupingHelper.SetTileViewLines(const Value: integer);
begin
   ListViewSetTileInfo(Self, Value);
end;

procedure TListViewGroupingHelper.SetViewStyleEx(const Value: TViewStyleEx);
begin
   // Double actions for the standard 4 styles is needed since we need
   // Self.ViewStyle for older OS, but the VCL wouldn't know that it needs
   // to switch back on XP or newer.
   case Value of
      vsIcon: begin
         ListView_SetView(Self.Handle, LV_VIEW_ICON);
         Self.ViewStyle := ComCtrls.vsIcon;
      end;
      vsSmallIcon: begin
         ListView_SetView(Self.Handle, LV_VIEW_SMALLICON);
         Self.ViewStyle := ComCtrls.vsSmallIcon;
      end;
      vsList: begin
         ListView_SetView(Self.Handle, LV_VIEW_LIST);
         Self.ViewStyle := ComCtrls.vsList;
      end;
      vsReport: begin
         ListView_SetView(Self.Handle, LV_VIEW_DETAILS);
         Self.ViewStyle := ComCtrls.vsReport;
      end;
      vsTile: begin
         ListView_SetView(Self.Handle, LV_VIEW_TILE);
      end;
   end;
end;

{ TListItemGroupingHelper }

function TListItemGroupingHelper.GetGroupId: integer;
begin
   Result := ListItemGetGroupId(Self);
end;

procedure TListItemGroupingHelper.SetGroupId(const Value: integer);
begin
   ListItemSetGroupId(Self, Value);
end;

procedure TListItemGroupingHelper.SetMinimumSubItemCount(const Count: integer; const EmptyFiller: string);
begin
   ListItemSetMinimumSubItemCount(Self, Count, EmptyFiller);
end;

procedure TListItemGroupingHelper.SetTileViewColumns(const ColumnCount: integer;
  const Columns: array of integer);
begin
   ListItemTileViewColumns(Self, ColumnCount, Columns);
end;

{$ENDIF UseClassHelpers}

{ TXPListView }

function TXPListView.GetDontForget: string;
begin
   Result := '... a XP manifest';
end;

procedure Register;
begin
   RegisterComponents('Win32', [TXPListView]);
end;

end.