{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvListView.PAS, released on 2001-02-28.

The Initial Developer of the Original Code is Sébastien Buysse [sbuysse att buypin dott com]
Portions created by Sébastien Buysse are Copyright (C) 2001 Sébastien Buysse.
All Rights Reserved.

Contributor(s): Michael Beck [mbeck att bigfoot dott com].
                dejoy
                Olivier Sannier [obones att altern dott org]

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.delphi-jedi.org

Known Issues:
  Mantis 3932: In the OnCustomDrawItem, if you change the canvas font directly,
               then your changes will be ignored and the items be drawn bold if
               the item brush is not used for the given list view style
               (report for instance). As a workaround, always change the item's
               properties, never the canvas' directly.
-----------------------------------------------------------------------------}
// $Id: JvListView.pas 130 2009-08-09 17:59:21Z obones $

unit JvListView;

{$I jvcl.inc}
{$I vclonly.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Windows, Messages, SysUtils, Classes, Graphics,dialogs, Controls, Forms,
  ComCtrls, CommCtrl, Menus, ImgList, Clipbrd,
  JvJCLUtils, JvJVCLUtils, JvTypes, JvExComCtrls, JvAppStorage;

type
  TJvViewStyle = (vsIcon, vsSmallIcon, vsList, vsReport, vsTile);
  TJvHeaderImagePosition = (hipLeft, hipRight);

const
  WM_AUTOSELECT = WM_USER + 1;
  ALL_VIEW_STYLES = [vsIcon, vsSmallIcon, vsList, vsReport, vsTile];

type
  TJvListView = class;
  TJvListViewGroup = class;
  EJvListViewError = EJVCLException;

  // Mantis 980: new type for Groups
  TLVGROUP = record
    cbSize: UINT;
    mask: UINT;
    pszHeader: LPWSTR;
    cchHeader: Integer;
    pszFooter: LPWSTR;
    cchFooter: Integer;
    iGroupId: Integer;
    stateMask: UINT;
    state: UINT;
    uAlign: UINT;
  end;

  //  TJvSortMethod = (smAutomatic, smAlphabetic, smNonCaseSensitive, smNumeric, smDate, smTime, smDateTime, smCurrency);
  TJvOnProgress = procedure(Sender: TObject; Progression, Total: Integer) of object;
  TJvListViewCompareGroupEvent = procedure(Sender: TObject; Group1, Group2: TJvListViewGroup; var Compare: Integer) of object;

  TJvListItems = class(TListItems, IJvAppStorageHandler, IJvAppStoragePublishedProps)
  private
    FOwnerInterface: IInterface;
  protected
    { IInterface }
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;
    { IJvAppStorageHandler }
    procedure ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
    procedure WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);

    { List item reader used in the call to ReadList. }
    procedure ReadListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const Index: Integer; const ItemName: string);
    { List item writer used in the call to WriteList. }
    procedure WriteListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const Index: Integer; const ItemName: string);
    { List item deleter used in the call to WriteList. }
    procedure DeleteListItem(Sender: TJvCustomAppStorage; const Path: string;
      const List: TObject; const First, Last: Integer; const ItemName: string);
  public
    function QueryInterface(const IID: TGUID; out Obj): HRESULT; virtual; stdcall;
    procedure AfterConstruction; override;
  end;

  TJvListItem = class(TListItem)
  private
    FPopupMenu: TPopupMenu;
    FBold: Boolean;
    FFont: TFont;
    FBrush: TBrush;
    FGroupId: Integer;
    FTileColumns: TIntegerList;
    procedure SetBrush(const Value: TBrush);
    procedure SetGroupId(const Value: Integer);
    procedure SetTileColumns(const Value: TIntegerList);

    procedure ReadTileColumns(Reader: TReader);
    procedure WriteTileColumns(Writer: TWriter);
    procedure TileColumnsChange(Sender: TObject; Item: Integer; Action: TListNotification);
  protected
    procedure SetPopupMenu(const Value: TPopupMenu);
    procedure SetFont(const Value: TFont);
    procedure UpdateTileColumns;
  public
    constructor CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
    destructor Destroy; override;

    procedure DefineProperties(Filer: TFiler); override;

    property PopupMenu: TPopupMenu read FPopupMenu write SetPopupMenu;
    property TileColumns: TIntegerList read FTileColumns write SetTileColumns;
  published
    property Font: TFont read FFont write SetFont;
    property Brush: TBrush read FBrush write SetBrush;
    property GroupId: Integer read FGroupId write SetGroupId default -1;
    // Published now for the usage of AppStorage.Read/WritePersistent
    property Caption;
    property Checked;
    property Selected;
    property SubItems;
  end;

  TJvListExtendedColumn = class(TCollectionItem)
  private
    FSortMethod: TJvSortMethod;
    FUseParentSortMethod: Boolean;
    FHeaderImagePosition: TJvHeaderImagePosition;
    FUseParentHeaderImagePosition: Boolean;
    function GetSortMethod: TJvSortMethod;
    procedure SetSortMethod(const Value: TJvSortMethod);
    function GetHeaderImagePosition: TJvHeaderImagePosition;
    procedure SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
    procedure SetUseParentHeaderImagePosition(const Value: Boolean);
  public
    constructor Create(Collection: Classes.TCollection); override;

    procedure Assign(AValue: TPersistent); override;
  published
    property SortMethod: TJvSortMethod read GetSortMethod write SetSortMethod default smAutomatic;
    property UseParentSortMethod : Boolean read FUseParentSortMethod write FUseParentSortMethod default True;
    property HeaderImagePosition: TJvHeaderImagePosition read GetHeaderImagePosition write SetHeaderImagePosition default hipLeft;
    property UseParentHeaderImagePosition : Boolean read FUseParentHeaderImagePosition write SetUseParentHeaderImagePosition default True;
  end;

  TJvListExtendedColumns = class(TOwnedCollection)
  private
    function GetItem(Index: Integer): TJvListExtendedColumn;
    procedure SetItem(Index: Integer; const Value: TJvListExtendedColumn);

    function Owner : TPersistent;
  public
    constructor Create(AOwner: TPersistent);
    property Items[Index: Integer] : TJvListExtendedColumn read GetItem write SetItem; default;
  end;

  TJvListViewGroup = class(TCollectionItem)
  private
    FHeader: WideString;
    FGroupId: Integer;
    FHeaderAlignment: TAlignment;
    procedure SetHeader(const Value: WideString);
    procedure SetHeaderAlignment(const Value: TAlignment);
    procedure SetGroupId(const Value: Integer);

    procedure UpdateGroupProperties(const NewGroupId: Integer = -1);
  public
    constructor Create(Collection: Classes.TCollection); override;
    destructor Destroy; override;
    procedure Assign(AValue: TPersistent); override;
    procedure SetLVGROUP(var GroupInfo: TLVGROUP);
  published
    property GroupId: Integer read FGroupId write SetGroupId default -1;
    property Header: WideString read FHeader write SetHeader;
    property HeaderAlignment: TAlignment read FHeaderAlignment write SetHeaderAlignment default taLeftJustify;
  end;

  TJvListViewGroups = class(TOwnedCollection)
  private
    FSorted: Boolean;
    function GetItem(Index: Integer): TJvListViewGroup;
    procedure SetItem(Index: Integer; const Value: TJvListViewGroup);

    function ParentList: TJvListView;
    procedure InsertGroupIntoList(group: TJvListViewGroup);
    procedure RemoveGroupFromList(group: TJvListViewGroup);

    function Compare(Id1, Id2: Integer): Integer;
    function GetItemById(GroupId: Integer): TJvListViewGroup;
    procedure SetSorted(const Value: Boolean);
  protected
    procedure Notify(Item: TCollectionItem; Action: TCollectionNotification); override;
  public
    constructor Create(AOwner: TPersistent);
    procedure Sort;

    property Items[Index: Integer] : TJvListViewGroup read GetItem write SetItem; default;
    property ItemsById[GroupId: Integer]: TJvListViewGroup read GetItemById;
  published
    property Sorted: Boolean read FSorted write SetSorted default False;
  end;

  TJvGroupsPropertiesBorderRect = class(TJvRect)
  public
    constructor Create;
  published
    property Top default 12;
  end;

  TJvGroupsPropertiesBorderColors = class(TPersistent)
  private
    FRight: TColor;
    FBottom: TColor;
    FTop: TColor;
    FLeft: TColor;
    FOnChange: TNotifyEvent;
    procedure SetBottom(const Value: TColor);
    procedure SetLeft(const Value: TColor);
    procedure SetRight(const Value: TColor);
    procedure SetTop(const Value: TColor);
  protected
    procedure DoChange;
  public
    constructor Create;

    procedure Assign(Source: TPersistent); override;

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Top: TColor read FTop write SetTop default $C8D0D4;
    property Left: TColor read FLeft write SetLeft default clWhite;
    property Bottom: TColor read FBottom write SetBottom default clWhite;
    property Right: TColor read FRight write SetRight default clWhite;
  end;

  TJvGroupsProperties = class(TPersistent)
  private
    FBorderSize: TJvGroupsPropertiesBorderRect;
    FBorderColor: TJvGroupsPropertiesBorderColors;
    FHeaderColor: TColor;

    FOnChange: TNotifyEvent;
    FLoading: Boolean;
    procedure SetBorderSize(const Value: TJvGroupsPropertiesBorderRect);
    procedure SetBorderColor(const Value: TJvGroupsPropertiesBorderColors);

    procedure BorderSizeChange(Sender: TObject);
    procedure BorderColorChange(Sender: TObject);
    procedure SetHeaderColor(const Value: TColor);
  protected
    procedure DoChange;
  public
    constructor Create;
    destructor Destroy; override;

    procedure LoadFromList(List: TCustomListView);

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property BorderSize: TJvGroupsPropertiesBorderRect read FBorderSize write SetBorderSize;
    property HeaderColor: TColor read FHeaderColor write SetHeaderColor default clBlack;

    // Note that BorderColor is currently ignored by the Win32 API
    property BorderColor: TJvGroupsPropertiesBorderColors read FBorderColor write SetBorderColor;
  end;

  TJvViewStyles = set of TJvViewStyle;

  TJvTileSizeKind = (tskAutoSize, tskFixedWidth, tskFixedHeight, tskFixedSize);

  TJvTileViewProperties = class(TPersistent)
  private
    FLabelMargin: TJvRect;
    FTileSize: TJvSize;
    FSubLinesCount: Integer;
    FTileSizeKind: TJvTileSizeKind;
    FOnChange: TNotifyEvent;
    FLoading: Boolean;
    procedure SetLabelMargin(const Value: TJvRect);
    procedure SetSubLinesCount(const Value: Integer);
    procedure SetTileSize(const Value: TJvSize);
    procedure SetTileSizeKind(const Value: TJvTileSizeKind);

    procedure LabelMarginChange(Sender: TObject);
    procedure TileSizeChange(Sender: TObject);
  protected
    procedure DoChange;
  public
    constructor Create;
    destructor Destroy; override;

    procedure LoadFromList(List: TCustomListView);

    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property TileSizeKind: TJvTileSizeKind read FTileSizeKind write SetTileSizeKind default tskAutoSize;
    property TileSize: TJvSize read FTileSize write SetTileSize;
    property SubLinesCount: Integer read FSubLinesCount write SetSubLinesCount default 1;
    property LabelMargin: TJvRect read FLabelMargin write SetLabelMargin;
  end;

  TJvInsertMarkPosition = (impBefore, impAfter);

  TJvListView = class(TJvExListView)
  private
    FAutoClipboardCopy: Boolean;
    FSortOnClick: Boolean;
    FLast: Integer;
    FOnSaveProgress: TJvOnProgress;
    FOnLoadProgress: TJvOnProgress;
    FOnAutoSort: TJvListViewColumnSortEvent;
    FSortMethod: TJvSortMethod;
    FOnHorizontalScroll: TNotifyEvent;
    FOnVerticalScroll: TNotifyEvent;
    FImageChangeLink: TChangeLink;
    FHeaderImagePosition: TJvHeaderImagePosition;
    FHeaderImages: TCustomImageList;
    FAutoSelect: Boolean;
    FPicture: TPicture;
    FExtendedColumns: TJvListExtendedColumns;
    FSavedExtendedColumns: TJvListExtendedColumns;
    FViewStylesItemBrush: TJvViewStyles;  // use for Create/DestroyWnd process
    FGroupView: Boolean;
    FGroups: TJvListViewGroups;
    FGroupsProperties: TJvGroupsProperties;
    FOnCompareGroups: TJvListViewCompareGroupEvent;
    FViewStyle: TJvViewStyle;
    FTileViewProperties: TJvTileViewProperties;
    FInsertMarkColor: TColor;
    FSettingJvViewStyle: Boolean;
    FSettingHeaderImagePosition: Boolean;
    procedure DoPictureChange(Sender: TObject);
    procedure SetPicture(const Value: TPicture);
    procedure SetGroupView(const Value: Boolean);
    procedure SetGroups(const Value: TJvListViewGroups);
    procedure SetGroupsProperties(const Value: TJvGroupsProperties);
    procedure SetTileViewProperties(const Value: TJvTileViewProperties);
    procedure SetInsertMarkColor(const Value: TColor);
    procedure SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
    procedure SetHeaderImages(const Value: TCustomImageList);
    procedure UpdateHeaderImages(HeaderHandle: Integer);
    procedure WMAutoSelect(var Msg: TMessage); message WM_AUTOSELECT;
    procedure SetExtendedColumns(const Value: TJvListExtendedColumns);
    procedure SetViewStylesItemBrush(const Value: TJvViewStyles);
    function DoCompareGroups(Group1, Group2: TJvListViewGroup): Integer;
    procedure TileViewPropertiesChange(Sender: TObject);
    procedure GroupsPropertiesChange(Sender: TObject);
    procedure LoadTileViewProperties;
    procedure LoadGroupsProperties;
  protected
    function CreateListItem: TListItem; override;
    function CreateListItems: TListItems; override;
    procedure WMHScroll(var Msg: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Msg: TWMVScroll); message WM_VSCROLL;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetColumnsOrder: string;
    procedure SetColumnsOrder(const Order: string);
    procedure SetItemPopup(Node: TListItem; Value: TPopupMenu);
    function GetItemPopup(Node: TListItem): TPopupMenu;
    procedure DoHeaderImagesChange(Sender: TObject);
    procedure Loaded; override;
    procedure SetViewStyle(Value: TViewStyle); override;
    procedure SetJvViewStyle(Value: TJvViewStyle); virtual;

    procedure CreateWnd; override;
    procedure DestroyWnd; override;

    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure LVMDeleteColumn(var Msg: TMessage); message LVM_DELETECOLUMN;
    procedure LVMInsertColumn(var Msg: TMessage); message LVM_INSERTCOLUMN;
    procedure LVMSetColumn(var Msg: TMessage); message LVM_SETCOLUMN;
    procedure CNNotify(var Message: TWMNotify); message CN_NOTIFY;

    procedure InsertItem(Item: TListItem); override;
    function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
    function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; override;
    function CustomDrawItem(Item: TListItem; State: TCustomDrawState;
      Stage: TCustomDrawStage): Boolean; override;
    function CustomDrawSubItem(Item: TListItem; SubItem: Integer;
      State: TCustomDrawState; Stage: TCustomDrawStage): Boolean; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ColClick(Column: TListColumn); override;
    procedure SaveToStrings(Strings: TStrings; Separator: Char);
    procedure LoadFromStrings(Strings: TStrings; Separator: Char);
    procedure SaveToFile(FileName: string; ForceOldStyle: Boolean = False);
    procedure LoadFromFile(FileName: string);
    procedure SaveToStream(Stream: TStream; ForceOldStyle: Boolean = False);
    procedure LoadFromStream(Stream: TStream);
    procedure SaveToCSV(FileName: string; Separator: Char = ';');
    procedure LoadFromCSV(FileName: string; Separator: Char = ';');
    procedure SetSmallImages(const Value: TCustomImageList);
    procedure UnselectAll;
    procedure InvertSelection;
    function MoveUp(Index: Integer; Focus: Boolean = True): Integer;
    function MoveDown(Index: Integer; Focus: Boolean = True): Integer;
    function SelectNextItem(Focus: Boolean = True): Integer;
    function SelectPrevItem(Focus: Boolean = True): Integer;

    function ShowInsertMark(ItemIndex: Integer; Position: TJvInsertMarkPosition): Boolean;
    function HideInsertMark: Boolean;
    function GetInsertMarkPosition(const X, Y: Integer; var ItemIndex: Integer; var Position: TJvInsertMarkPosition): Boolean;

    property ItemPopup[Item: TListItem]: TPopupMenu read GetItemPopup write SetItemPopup;
    procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer;
      AHeight: Integer); override;
    procedure SetFocus; override;
  published
    property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
    property ColumnsOrder: string read GetColumnsOrder write SetColumnsOrder;
    property HintColor;
    property Picture: TPicture read FPicture write SetPicture;
    property HeaderImagePosition: TJvHeaderImagePosition read FHeaderImagePosition write SetHeaderImagePosition default hipLeft;
    property HeaderImages: TCustomImageList read FHeaderImages write SetHeaderImages;
    property SortMethod: TJvSortMethod read FSortMethod write FSortMethod default smAutomatic;
    property SortOnClick: Boolean read FSortOnClick write FSortOnClick default True;
    property SmallImages write SetSmallImages;
    property AutoClipboardCopy: Boolean read FAutoClipboardCopy write FAutoClipboardCopy default True;
    property GroupView: Boolean read FGroupView write SetGroupView default False;
    property Groups: TJvListViewGroups read FGroups write SetGroups;
    property GroupsProperties: TJvGroupsProperties read FGroupsProperties write SetGroupsProperties;
    property TileViewProperties: TJvTileViewProperties read FTileViewProperties write SetTileViewProperties;
    property InsertMarkColor: TColor read FInsertMarkColor write SetInsertMarkColor default clBlack;

    property ViewStylesItemBrush : TJvViewStyles read FViewStylesItemBrush write SetViewStylesItemBrush default ALL_VIEW_STYLES;
    property ViewStyle: TJvViewStyle read FViewStyle write SetJvViewStyle default vsIcon;

    property OnAutoSort: TJvListViewColumnSortEvent read FOnAutoSort write FOnAutoSort;
    property OnHorizontalScroll: TNotifyEvent read FOnHorizontalScroll write FOnHorizontalScroll;
    property OnLoadProgress: TJvOnProgress read FOnLoadProgress write FOnLoadProgress;
    property OnSaveProgress: TJvOnProgress read FOnSaveProgress write FOnSaveProgress;
    property OnVerticalScroll: TNotifyEvent read FOnVerticalScroll write FOnVerticalScroll;
    property OnCompareGroups: TJvListViewCompareGroupEvent read FOnCompareGroups write FOnCompareGroups;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnParentColorChange;

    // This property contains a collection that allows to specify additional
    // properties for each columns (sort method for instance). It can not be
    // included in the Columns collection as the VCL does not offer a way
    // to specify which class to use for the items of the Columns collection.
    // Note that this one (ExtendedColumns) is populated automatically when
    // a column is added or deleted. But because the VCL code for add starts
    // by deleting all columns to reinsert them after, you should not change
    // the properties for any item of ExtendedColumns in a loop that contains
    // a call to the Add method of the Columns property.
    property ExtendedColumns : TJvListExtendedColumns read FExtendedColumns write SetExtendedColumns;
  end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$URL: https://jvcl.svn.sourceforge.net:443/svnroot/jvcl/trunk/jvcl/run/JvListView.pas $';
    Revision: '$Revision: 130 $';
    Date: '$Date: 2009-08-09 19:59:21 +0200 (dim., 09 août 2009) $';
    LogPath: 'JVCL\run'
    );
{$ENDIF UNITVERSIONING}

implementation

uses
  {$IFDEF COMPILER10_UP}
  Types,
  {$ENDIF COMPILER10_UP}
  Math, Contnrs,
  VarUtils, Variants,
  JclWideStrings, 
  JvConsts, JvResources;

type
  // Mantis 980: New types for group/tile/insert mark handling
  tagLVITEMA = packed record
    mask: UINT;
    iItem: Integer;
    iSubItem: Integer;
    state: UINT;
    stateMask: UINT;
    pszText: PAnsiChar;
    cchTextMax: Integer;
    iImage: Integer;
    lParam: lParam;
    iIndent: Integer;
    iGroupId: Integer;
    cColumns: UINT;
    puColumns: PUINT;
  end;
  TLVITEMA = tagLVITEMA;

  TFNLVGROUPCOMPARE = function (Group1_ID: Integer; Group2_ID: Integer; pvData: Pointer): Integer; stdcall;
  PFNLVGROUPCOMPARE = ^TFNLVGROUPCOMPARE;

  tagLVINSERTGROUPSORTED = packed record
    pfnGroupCompare: PFNLVGROUPCOMPARE;
    pvData: Pointer;
    lvGroup: TLVGROUP;
  end;
  TLVINSERTGROUPSORTED = tagLVINSERTGROUPSORTED;
  PLVINSERTGROUPSORTED = ^TLVINSERTGROUPSORTED;

  tagLVTILEVIEWINFO = packed record
    cbSize: UINT;
    dwMask: DWORD;
    dwFlags: DWORD;
    sizeTile: TSize;
    cLines: Integer;
    rcLabelMargin: TRect;
  end;
  TLVTILEVIEWINFO = tagLVTILEVIEWINFO;
  PLVTILEVIEWINFO = ^TLVTILEVIEWINFO;

  tagLVTILEINFO = packed record
    cbSize: UINT;
    iItem: Integer;
    cColumns: UINT;
    puColumns: PUINT;
  end;
  TLVTILEINFO = tagLVTILEINFO;
  PLVTILEINFO = ^TLVTILEINFO;

  tagLVINSERTMARK = packed record
    cbSize: UINT;
    dwFlags: DWORD;
    iItem: Integer;
    dwReserved: DWORD;
  end;
  TLVINSERTMARK = tagLVINSERTMARK;
  PLVINSERTMARK = ^TLVINSERTMARK;

  tagLVGROUPMETRICS = packed record
    cbSize: UINT;
    mask: UINT;
    Left: UINT;
    Top: UINT;
    Right: UINT;
    Bottom: UINT;
    crLeft: COLORREF;
    crTop: COLORREF;
    crRight: COLORREF;
    crBottom: COLORREF;
    crHeader: COLORREF;
    crFooter: COLORREF;
  end;
  TLVGROUPMETRICS = tagLVGROUPMETRICS;
  PLVGROUPMETRICS = ^TLVGROUPMETRICS;

const
  // Mantis 980: New constants for group/tile/insert mark handling
  LVM_SETTILEWIDTH       = LVM_FIRST + 141;
  LVM_SETVIEW            = LVM_FIRST + 142;
  LVM_INSERTGROUP        = LVM_FIRST + 145;
  LVM_SETGROUPINFO       = LVM_FIRST + 147;
  LVM_REMOVEGROUP        = LVM_FIRST + 150;
  LVM_MOVEITEMTOGROUP    = LVM_FIRST + 154;
  LVM_SETGROUPMETRICS    = LVM_FIRST + 155;
  LVM_GETGROUPMETRICS    = LVM_FIRST + 156;
  LVM_ENABLEGROUPVIEW    = LVM_FIRST + 157;
  LVM_SORTGROUPS         = LVM_FIRST + 158;
  LVM_INSERTGROUPSORTED  = LVM_FIRST + 159;
  LVM_REMOVEALLGROUPS    = LVM_FIRST + 160;
  LVM_SETTILEVIEWINFO    = LVM_FIRST + 162;
  LVM_GETTILEVIEWINFO    = LVM_FIRST + 163;
  LVM_SETTILEINFO        = LVM_FIRST + 164;
  LVM_GETTILEINFO        = LVM_FIRST + 165;
  LVM_SETINSERTMARK      = LVM_FIRST + 166;
  LVM_INSERTMARKHITTEST  = LVM_FIRST + 168;
  LVM_GETINSERTMARKRECT  = LVM_FIRST + 169;
  LVM_SETINSERTMARKCOLOR = LVM_FIRST + 170;
  LVM_GETINSERTMARKCOLOR = LVM_FIRST + 171;

  // ListViewItemFlag
  LVIF_GROUPID = $0100;

  // ListViewGroupFlag
  LVGF_HEADER  = $00000001;
  LVGF_ALIGN   = $00000008;
  LVGF_GROUPID = $00000010;

  // group alignment
  LVGA_HEADER_LEFT   = $00000001;
  LVGA_HEADER_CENTER = $00000002;
  LVGA_HEADER_RIGHT  = $00000004;

  // view styles
  LV_VIEW_ICON = $00;
  LV_VIEW_DETAILS = $01;
  LV_VIEW_SMALLICON = $02;
  LV_VIEW_LIST = $03;
  LV_VIEW_TILE = $04;

  // LVTVIF (ListViewTileViewInfoFlag Constants)
  LVTVIF_AUTOSIZE    = 0;
  LVTVIF_FIXEDWIDTH  = 1;
  LVTVIF_FIXEDHEIGHT = 2;
  LVTVIF_FIXEDSIZE   = 3;

  // LVTVIM (ListViewTileViewInfoMask Constants)
  LVTVIM_TILESIZE    = 1;
  LVTVIM_COLUMNS     = 2;
  LVTVIM_LABELMARGIN = 4;

  // LVIM (ListViewInsertMark Constants)
  LVIM_AFTER = 1;

  // LVGMF (ListViewGroupMetricsFlag Constants)
  LVGMF_NONE        = $00000000;
  LVGMF_BORDERSIZE  = $00000001;
  LVGMF_BORDERCOLOR = $00000002;
  LVGMF_TEXTCOLOR   = $00000004;

  AlignmentToLVGA: array[TAlignment] of Integer = (LVGA_HEADER_LEFT, LVGA_HEADER_RIGHT, LVGA_HEADER_CENTER);
  TileSizeKindToLVTVIF: array[TJvTileSizeKind] of Integer = (LVTVIF_AUTOSIZE, LVTVIF_FIXEDWIDTH, LVTVIF_FIXEDHEIGHT, LVTVIF_FIXEDSIZE);
  InsertMarkPositionToLVIM: array[TJvInsertMarkPosition] of Integer = (0, LVIM_AFTER);

  // (rom) increased from 100
  cColumnsHandled = 1024;

//=== { TJvListItem } ========================================================

constructor TJvListItem.CreateEnh(AOwner: TListItems; const Popup: TPopupMenu);
begin
  inherited Create(AOwner);

  FBold := False;
  FPopupMenu := Popup; // (Salvatore) Get it from the JvListView
  FFont := TFont.Create;
  FBrush := TBrush.Create;
  FGroupId := -1;
  FTileColumns := TIntegerList.Create;

  FTileColumns.OnChange := TileColumnsChange;
  if AOwner.Owner is TJvListView then
    FFont.Assign((AOwner.Owner as TJvListView).Canvas.Font);
end;

procedure TJvListItem.DefineProperties(Filer: TFiler);
begin
  inherited DefineProperties(Filer);

  // Because a TList is not saved natively by Delphi, we do it ourselves.
  Filer.DefineProperty('TileColumns', ReadTileColumns, WriteTileColumns, True);
end;

destructor TJvListItem.Destroy;
begin
  FTileColumns.Free;
  FFont.Free;
  FBrush.Free;

  inherited Destroy;
end;

procedure TJvListItem.ReadTileColumns(Reader: TReader);
begin
  FTileColumns.ReadData(Reader);
  UpdateTileColumns;
end;

procedure TJvListItem.SetBrush(const Value: TBrush);
begin
  FBrush.Assign(Value);
end;

procedure TJvListItem.SetFont(const Value: TFont);
begin
  FFont.Assign(Value);
end;

procedure TJvListItem.SetGroupId(const Value: Integer);
var
  Infos: JvListView.TLVITEMA;
  List: TCustomListView;
begin
  if FGroupId <> Value then
  begin
    FGroupId := Value;

    List := Owner.Owner;
    if Assigned(List) then
    begin
      ZeroMemory(@Infos, sizeof(Infos));
      Infos.mask := LVIF_GROUPID;
      Infos.iItem := Index;
      Infos.iGroupId := FGroupId;

      SendMessage(List.Handle, LVM_SETITEM, 0, LPARAM(@Infos));
    end;
  end;
end;

procedure TJvListItem.SetPopupMenu(const Value: TPopupMenu);
begin
  FPopupMenu := Value;
end;

procedure TJvListItem.SetTileColumns(const Value: TIntegerList);
begin
  FTileColumns.Assign(Value);
end;

procedure TJvListItem.TileColumnsChange(Sender: TObject; Item: Integer;
  Action: TListNotification);
begin
  if not TileColumns.Loading then
    UpdateTileColumns;
end;

procedure TJvListItem.UpdateTileColumns;
type
  TCardinalArray = array [0..0] of Cardinal;
var
  List: TCustomListView;
  TileInfos: TLVTILEINFO;
  Cols: ^TCardinalArray;
  I: Integer;
begin
  List := Owner.Owner;
  if Assigned(List) then
  begin
    GetMem(Cols, FTileColumns.Count);
    try
      for I := 0 to FTileColumns.Count - 1 do
      begin
        Cols[I] := FTileColumns[I];
      end;

      ZeroMemory(@TileInfos, SizeOf(TileInfos));
      TileInfos.cbSize := SizeOf(TileInfos);
      TileInfos.iItem := Index;
      TileInfos.cColumns := FTileColumns.Count;
      TileInfos.puColumns := PUINT(Cols);
      SendMessage(List.Handle, LVM_SETTILEINFO, 0, LPARAM(@TileInfos));
    finally
      FreeMem(Cols);
    end;
  end;
end;

procedure TJvListItem.WriteTileColumns(Writer: TWriter);
begin
  FTileColumns.WriteData(Writer);
end;

//=== { TJvListItems } =======================================================

procedure TJvListItems.AfterConstruction;
begin
  inherited AfterConstruction;
  if GetOwner <> nil then
    GetOwner.GetInterface(IInterface, FOwnerInterface);
end;

function TJvListItems._AddRef: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._AddRef
  else
    Result := -1;
end;

function TJvListItems._Release: Integer;
begin
  if FOwnerInterface <> nil then
    Result := FOwnerInterface._Release
  else
    Result := -1;
end;

function TJvListItems.QueryInterface(const IID: TGUID; out Obj): HRESULT;
const
  E_NOINTERFACE = HRESULT($80004002);
begin
  if GetInterface(IID, Obj) then
    Result := 0
  else
    Result := E_NOINTERFACE;
end;

procedure TJvListItems.ReadFromAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
begin
  BeginUpdate;
  try
    Clear;
    AppStorage.ReadList(BasePath, Self, ReadListItem, cItem);
  finally
    EndUpdate;
  end;
end;

procedure TJvListItems.WriteToAppStorage(AppStorage: TJvCustomAppStorage; const BasePath: string);
begin
  AppStorage.WriteList(BasePath, Self, Count, WriteListItem, DeleteListItem, cItem);
end;

procedure TJvListItems.ReadListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
var
  NewItem: TPersistent;
  NewPath: string;
begin
  if List is TJvListItems then
    try
      NewPath := Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]);
      NewItem := TJvListItems(List).Add;
      Sender.ReadPersistent(NewPath, NewItem);
    except
    end;
end;

procedure TJvListItems.WriteListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const Index: Integer; const ItemName: string);
begin
  if List is TJvListItems then
    if Assigned(TJvListItems(List)[Index]) then
      Sender.WritePersistent(Sender.ConcatPaths([Path, ItemName + IntToStr(Index)]), TPersistent(TJvListItems(List)[Index]));
end;

procedure TJvListItems.DeleteListItem(Sender: TJvCustomAppStorage;
  const Path: string; const List: TObject; const First, Last: Integer; const ItemName: string);
var
  I: Integer;
begin
  if List is TJvListItems then
    for I := First to Last do
      Sender.DeleteValue(Sender.ConcatPaths([Path, ItemName + IntToStr(I)]));
end;

{ TJvListExtendedColumn }

procedure TJvListExtendedColumn.Assign(AValue: TPersistent);
begin
  if AValue is TJvListExtendedColumn then
  begin
    FSortMethod := TJvListExtendedColumn(AValue). SortMethod;
    FUseParentSortMethod := TJvListExtendedColumn(AValue).UseParentSortMethod;

    FHeaderImagePosition := TJvListExtendedColumn(AValue).HeaderImagePosition;
    FUseParentHeaderImagePosition := TJvListExtendedColumn(AValue).UseParentHeaderImagePosition;
  end
  else
    inherited Assign(AValue);
end;

constructor TJvListExtendedColumn.Create(Collection: Classes.TCollection);
begin
  inherited Create(Collection);

  FSortMethod := smAutomatic;
  FUseParentSortMethod := True;

  FHeaderImagePosition := hipLeft;
  FUseParentHeaderImagePosition := True;
end;

function TJvListExtendedColumn.GetHeaderImagePosition: TJvHeaderImagePosition;
begin
  if (TJvListExtendedColumns(Collection).Owner is TJvListView) and UseParentHeaderImagePosition then
    Result := TJvListView(TJvListExtendedColumns(Collection).Owner).HeaderImagePosition
  else
    Result := FHeaderImagePosition;
end;

function TJvListExtendedColumn.GetSortMethod: TJvSortMethod;
begin
  if (TJvListExtendedColumns(Collection).Owner is TJvListView) and UseParentSortMethod then
    Result := TJvListView(TJvListExtendedColumns(Collection).Owner).SortMethod
  else
    Result := FSortMethod;
end;

procedure TJvListExtendedColumn.SetHeaderImagePosition(
  const Value: TJvHeaderImagePosition);
begin
  FHeaderImagePosition := Value;
  UseParentHeaderImagePosition := False;

  if (TJvListExtendedColumns(Collection).Owner is TJvListView) then
  begin
    TJvListView(TJvListExtendedColumns(Collection).Owner).DoHeaderImagesChange(Self);
  end;
end;

procedure TJvListExtendedColumn.SetSortMethod(
  const Value: TJvSortMethod);
begin
  FSortMethod := Value;
  UseParentSortMethod := False;
end;

procedure TJvListExtendedColumn.SetUseParentHeaderImagePosition(
  const Value: Boolean);
begin
  if FUseParentHeaderImagePosition <> Value then
  begin
    FUseParentHeaderImagePosition := Value;
    if (TJvListExtendedColumns(Collection).Owner is TJvListView) then
    begin
      TJvListView(TJvListExtendedColumns(Collection).Owner).DoHeaderImagesChange(Self);
    end;
  end;
end;

{ TJvListExtendedColumns }

constructor TJvListExtendedColumns.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvListExtendedColumn);
end;

function TJvListExtendedColumns.GetItem(
  Index: Integer): TJvListExtendedColumn;
begin
  Result := TJvListExtendedColumn(inherited Items[Index]);
end;

function TJvListExtendedColumns.Owner: TPersistent;
begin
  Result := GetOwner;
end;

procedure TJvListExtendedColumns.SetItem(Index: Integer;
  const Value: TJvListExtendedColumn);
begin
  inherited Items[Index] := Value;
end;

//=== { TJvListView } ========================================================

const
  cLISTVIEW01 = 'LISTVIEW01'; // 10 chars

constructor TJvListView.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FSortOnClick := True;
  FSortMethod := smAutomatic;
  FLast := -1;
  FInsertMarkColor := clBlack;
  FAutoClipboardCopy := True;
  FHeaderImagePosition := hipLeft;
  FImageChangeLink := TChangeLink.Create;
  FImageChangeLink.OnChange := DoHeaderImagesChange;
  FAutoSelect := True;
  FPicture := TPicture.Create;
  FPicture.OnChange := DoPictureChange;

  FViewStylesItemBrush := ALL_VIEW_STYLES;
  FExtendedColumns := TJvListExtendedColumns.Create(Self);
  FSavedExtendedColumns := TJvListExtendedColumns.Create(Self);
  FGroups := TJvListViewGroups.Create(Self);
  FGroupsProperties := TJvGroupsProperties.Create;
  FTileViewProperties := TJvTileViewProperties.Create;

  FTileViewProperties.OnChange := TileViewPropertiesChange;
  FGroupsProperties.OnChange := GroupsPropertiesChange;
end;

destructor TJvListView.Destroy;
begin
  FGroupsProperties.Free;
  FTileViewProperties.Free;
  FGroups.Free;
  FExtendedColumns.Free;
  FSavedExtendedColumns.Free;

  FImageChangeLink.Free;
  FPicture.Free;
  inherited Destroy;
end;

procedure TJvListView.WMHScroll(var Msg: TWMHScroll);
begin
  inherited;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  if Assigned(FOnHorizontalScroll) then
    FOnHorizontalScroll(Self);
end;

procedure TJvListView.WMVScroll(var Msg: TWMVScroll);
begin
  inherited;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  if Assigned(FOnVerticalScroll) then
    FOnVerticalScroll(Self);
end;

procedure TJvListView.ColClick(Column: TListColumn);
type
  TParamSort = record
    Index: Integer;
    Sender: TObject;
  end;
var
  Parm: TParamSort;

  function CustomCompare1(Item1, Item2, ParamSort: Integer): Integer stdcall;
  var
    Parm: TParamSort;
    i1, i2: TListItem;
    S1, S2: string;
    I: Integer;
    SortKind: TJvSortMethod;

    function IsBigger(First, Second: string; SortType: TJvSortMethod): Boolean;
    var
      I, J: Double;
      d, e: TDateTime;
      a, b: Currency;
      l, m: Int64;
      st, st2: string;
      int1, int2: Integer;

      function FirstNonAlpha(Value: string): Integer;
      var
        Len: Integer;
        I, J: Integer;
        Comma: Boolean;
      begin
        Len := Length(Value);
        I := 1;
        J := 0;
        Comma := False;

        while I <= Len do
        begin
          case Value[I] of
            '0', '1', '2', '3', '4', '5', '6', '7', '8', '9':
              J := I;
            ',', '.':
              if not Comma then
                Comma := True
              else
              begin
                J := I - 1;
                I := Len;
              end;
          else
            begin
              J := I - 1;
              I := Len;
            end;
          end;
          Inc(I);
        end;

        Result := J;
      end;

    begin
      Result := False;
      if Trim(First) = '' then
        Result := False
      else
        if Trim(Second) = '' then
          Result := True
        else
        begin
          case SortType of
            smAlphabetic:
              Result := First > Second;
            smNonCaseSensitive:
              Result := UpperCase(First) > UpperCase(Second);
            smNumeric:
              begin
                try
                  VarR8FromStr(First, LOCALE_USER_DEFAULT, 0, I);
                  VarR8FromStr(Second, LOCALE_USER_DEFAULT, 0, J);
                  Result := I > J;
                except
                  try
                    l := StrToInt64(First);
                  except
                    l := 0;
                  end;
                  try
                    m := StrToInt64(Second);
                  except
                    m := 0;
                  end;
                  Result := l > m;
                end;
              end;
            smDate:
              begin
                d := StrToDate(First);
                e := StrToDate(Second);
                Result := d > e;
              end;
            smTime:
              begin
                d := StrToTime(First);
                e := StrToTime(Second);
                Result := d > e;
              end;
            smDateTime:
              begin
                d := StrToDateTime(First);
                e := StrToDateTime(Second);
                Result := d > e;
              end;
            smCurrency:
              begin
                VarCyFromStr(First, LOCALE_USER_DEFAULT, 0, a);
                VarCyFromStr(Second, LOCALE_USER_DEFAULT, 0, b);
                Result := a > b;
              end;
            smAutomatic:
              begin
                int1 := FirstNonAlpha(First);
                int2 := FirstNonAlpha(Second);
                if (int1 <> 0) and (int2 <> 0) then
                begin
                  st := Copy(First, 1, int1);
                  st2 := Copy(Second, 1, int2);
                  try
                    Result := StrToFloat(st) > StrToFloat(st2);
                  except
                    Result := First > Second;
                  end;
                end
                else
                  Result := First > Second;
              end;
          end;
        end;
    end;

  begin
    Parm := TParamSort(Pointer(ParamSort)^);
    i1 := TListItem(Item1);
    i2 := TListItem(Item2);
    I := Parm.Index;

    // (Salvatore)
    if Parm.Index < TJvListView(Parm.Sender).ExtendedColumns.Count  then
      SortKind := TJvListView(Parm.Sender).ExtendedColumns[Parm.Index].SortMethod
    else
      SortKind := TJvListView(Parm.Sender).SortMethod;

    if Assigned(TJvListView(Parm.Sender).OnAutoSort) then
      TJvListView(Parm.Sender).OnAutoSort(Parm.Sender, Parm.Index, SortKind);

    case I of
      {sort by caption}
      0:
        begin
          S1 := i1.Caption;
          S2 := i2.Caption;

          if IsBigger(S1, S2, SortKind) then
            Result := 1
          else
            if IsBigger(S2, S1, SortKind) then
              Result := -1
            else
              Result := 0;
        end;
    else
      {sort by Column}
      begin
        if I > i1.SubItems.Count then
        begin
          if I > i2.SubItems.Count then
            Result := 0
          else
            Result := -1;
        end
        else
          if I > i2.SubItems.Count then
            Result := 1
          else
          begin
            S1 := i1.SubItems[I - 1];
            S2 := i2.SubItems[I - 1];
            if IsBigger(S1, S2, SortKind) then
              Result := 1
            else
              if IsBigger(S2, S1, SortKind) then
                Result := -1
              else
                Result := 0;
          end;
      end;
    end;
  end;

  function CustomCompare2(Item1, Item2, ParamSort: Integer): Integer; stdcall;
  begin
    Result := -CustomCompare1(Item1, Item2, ParamSort);
  end;

begin
  inherited ColClick(Column);
  if FSortOnClick then
  begin
    Parm.Index := Column.Index;
    Parm.Sender := Self;
    if FLast = Column.Index then
    begin
      FLast := -1;
      CustomSort(TLVCompare(@CustomCompare2), Integer(@Parm));
    end
    else
    begin
      FLast := Column.Index;
      CustomSort(TLVCompare(@CustomCompare1), Integer(@Parm));
    end;
  end;
end;

function TJvListView.CreateListItem: TListItem;
begin
  Result := TJvListItem.CreateEnh(Items, Self.PopupMenu);
end;

function TJvListView.CreateListItems: TListItems;
begin
  Result := TJvListItems.Create(Self);
end;

function TJvListView.GetItemPopup(Node: TListItem): TPopupMenu;
begin
  Result := TJvListItem(Node).PopupMenu;
end;

procedure TJvListView.SetItemPopup(Node: TListItem; Value: TPopupMenu);
begin
  TJvListItem(Node).PopupMenu := Value;
end;

procedure TJvListView.LoadFromFile(FileName: string);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
  try
    LoadFromStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TJvListView.LoadFromStream(Stream: TStream);
var
  Start: Integer;

  procedure LoadOldStyle(Stream: TStream);
  var
    I, J, K: Integer;
    Buf: array [0..100] of Byte;
    st: AnsiString;
    ch1, checks: Boolean;
    t: TListItem;
  begin
    I := Stream.Position;
    t := nil;
    st := '';
    Items.Clear;
    if Assigned(FOnLoadProgress) then
      FOnLoadProgress(Self, 0, Stream.Size - Start);
    checks := False;
    ch1 := CheckBoxes;
    while I < Stream.Size do
    begin
      J := Stream.Read(Buf, SizeOf(Buf));
      if Assigned(FOnLoadProgress) then
        FOnLoadProgress(Self, J, Stream.Size - Start);
      I := I + J;
      K := 0;
      while K < J do
      begin
        while (K < J) and (Buf[K] <> 0) and (Buf[K] <> 1) do
        begin
          st := st + AnsiChar(Buf[K]);
          Inc(K);
        end;

        if K < J then
        begin
          if t <> nil then
            t.SubItems.Add(string(st))
          else
          begin
            t := Items.Add;
            checks := checks or (st[1] = 'T');
            t.Checked := st[1] = 'T';
            st := Copy(st, 2, Length(st));
            t.Caption := string(st);
          end;
          if Buf[K] = 1 then
            t := nil;
          st := '';
        end;
        Inc(K);
      end;
    end;
    if (not ch1) and (not checks) then
      CheckBoxes := False;
  end;

  procedure LoadNewStyle(Stream: TStream);
  const
    LV_HASCHECKBOXES = $80;
  var
    Count, I, J: SmallInt;
    Options: Byte;
    UTF8St: UTF8String;
    st: string;
    t: TListItem;
    Buf: array of AnsiChar;
  begin
    try
      Self.Items.BeginUpdate;
      Self.Items.Clear;
      Self.Items.EndUpdate;

      Stream.Read(Options, SizeOf(Options));
      CheckBoxes := (Options and LV_HASCHECKBOXES) = LV_HASCHECKBOXES;

      //Read all lines
      while Stream.Position < Stream.Size do
      begin

        Stream.Read(Count, SizeOf(Count));

        //statistics
        if Assigned(FOnLoadProgress) then
          FOnLoadProgress(Self, Stream.Position, Stream.Size - Start);

        //Read all columns
        t := Self.Items.Add;
        for I := 1 to Count do
        begin
          if I = 1 then
          begin
            Stream.Read(Options, SizeOf(Options));
            if CheckBoxes then
              t.Checked := Boolean(Options and Ord(True));
          end;

          Stream.Read(J, SizeOf(J));

          //Read the string
          if Length(Buf) < J then
            SetLength(Buf, J);
          if J > 0 then
          begin
           Stream.Read(Buf, J);
   SetString(UTF8St, PAnsiChar(Buf[0]), J);
            st := UTF8ToString(UTF8St);
          end
          else
            st := '';

          if I = 1 then
            t.Caption := st
          else
            t.SubItems.Add(st);
        end;
      end;
    except
    end;
  end;

var
  Buf: array [0..10] of AnsiChar;
begin
  Start := Stream.Position;
  Stream.Read(Buf, 10);
  Buf[10] := #0;
  if Buf <> cLISTVIEW01 then
  begin
    Stream.Position := Start;
    LoadOldStyle(Stream);
  end
  else
    LoadNewStyle(Stream);
end;

procedure TJvListView.SaveToFile(FileName: string; ForceOldStyle: Boolean);
var
  Stream: TFileStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate or fmShareExclusive);
  try
    SaveToStream(Stream, ForceOldStyle);
  finally
    Stream.Free;
  end;
end;

procedure TJvListView.SaveToStream(Stream: TStream; ForceOldStyle: Boolean);

  procedure SaveOldStyle(Stream: TStream);
  var
    I, J, K: Integer;
    b, c, d, e: Byte;
    st: AnsiString;
    Buf: array [0..1000] of Byte;
  begin
    b := 0;
    c := 1;
    d := Ord('T'); //checked
    e := Ord('F'); //not checked
    if Assigned(FOnSaveProgress) then
      FOnSaveProgress(Self, 0, Self.Items.Count);
    for I := 0 to Self.Items.Count - 1 do
    begin
      if Assigned(FOnSaveProgress) then
        FOnSaveProgress(Self, I + 1, Self.Items.Count);
      st := AnsiString(Self.Items[I].Caption);
      for K := 1 to Length(st) do
        Buf[K - 1] := Byte(st[K]);
      K := Length(st);
      //write checked,not
      if Self.Items[I].Checked then
        Stream.Write(d, 1)
      else
        Stream.Write(e, 1);
      Stream.Write(Buf, K);
      if Self.Items[I].SubItems.Count = 0 then
        Stream.Write(c, 1)
      else
      begin
        Stream.Write(b, 1);
        for J := 0 to Self.Items[I].SubItems.Count - 2 do
        begin
          st := AnsiString(Self.Items[I].SubItems[J]);
          for K := 1 to Length(st) do
            Buf[K - 1] := Byte(st[K]);
          K := Length(st);
          Stream.Write(Buf, K);
          Stream.Write(b, 1);
        end;
        J := Self.Items[I].SubItems.Count - 1;
        st := AnsiString(Self.Items[I].SubItems[J]);
        for K := 1 to Length(st) do
          Buf[K - 1] := Byte(st[K]);
        K := Length(st);
        Stream.Write(Buf, K);
        Stream.Write(c, 1);
      end;
    end;
  end;

  procedure SaveNewStyle(Stream: TStream);
  const
    LV_HASCHECKBOXES = $80;

    procedure WriteString(const Txt: string);
    var
      I: Word;
      UTF8Txt: UTF8String;
    begin
      UTF8Txt := UTF8Encode(Txt);
      I := Length(UTF8Txt);
      Stream.Write(I, SizeOf(I));
      if I > 0 then
        Stream.Write(UTF8Txt[1], I);
    end;

  var
    Buf: array [0..100] of AnsiChar;
    I: Integer;
    J: SmallInt;
    Options, IsChecked: Byte;
  begin
    Buf := cLISTVIEW01;
    Stream.Write(Buf, 10);
    if CheckBoxes then
      Options := LV_HASCHECKBOXES
    else
      Options := 0;
    Stream.Write(Options, SizeOf(Options));
    for I := 0 to Items.Count - 1 do
      with Items[I] do
      begin
        J := SubItems.Count + 1;
        Stream.Write(J, SizeOf(J));
        IsChecked := Options or (Byte(Ord(Checked)));
        Stream.Write(IsChecked, SizeOf(IsChecked));
        WriteString(Items[I].Caption);
        for J := 0 to Items[I].SubItems.Count - 1 do
          WriteString(SubItems[J]);
      end;
  end;

begin
  if ForceOldStyle then
    SaveOldStyle(Stream)
  else
    SaveNewStyle(Stream);
end;

procedure TJvListView.SaveToStrings(Strings: TStrings; Separator: Char);
var
  I, J: Integer;
  TmpStr: string;
begin
  if Assigned(FOnSaveProgress) then
    FOnSaveProgress(Self, 0, Items.Count);
  for I := 0 to Items.Count - 1 do
  begin
    if Assigned(FOnSaveProgress) then
      FOnSaveProgress(Self, I + 1, Items.Count);
    TmpStr := AnsiQuotedStr(Items[I].Caption, '"');
    for J := 0 to Items[I].SubItems.Count - 1 do
      TmpStr := TmpStr + Separator + AnsiQuotedStr(Items[I].SubItems[J], '"');
    Strings.Add(TmpStr);
  end;
end;

procedure TJvListView.LoadFromStrings(Strings: TStrings; Separator: Char);
var
  I: Integer;
  Start, Stop, TmpStart: PChar;
  TmpStr: string;
  Li: TListItem;
begin
  for I := 0 to Strings.Count - 1 do
  begin
    Li := nil;
    Start := PChar(Strings[I]);
    Stop := Start + Length(Strings[I]);
    if (Start <> Stop) and (Start <> nil) and (Start^ <> #0) then
    begin
      if Start^ = '"' then
      begin
        Li := Items.Add;
        TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
        Li.Caption := TmpStr;
      end
      else
      begin
        TmpStart := Start;
        while Start^ <> Separator do
        begin
          if Start = Stop then
            Break;
          Inc(Start);
        end;
        SetString(TmpStr, TmpStart, Start - TmpStart);
        Li := Items.Add;
        Li.Caption := TmpStr;
      end;
    end;
    if Li <> nil then
    begin
      while (Start <> Stop) and (Start <> nil) and (Start^ <> #0) do
      begin
        while Start^ = Separator do
          Inc(Start);
        if Start^ = '"' then
        begin
          TmpStr := AnsiExtractQuotedStr(Start, '"'); // this moves the PChar pointer
          Li.SubItems.Add(TmpStr);
        end
        else
        begin
          TmpStart := Start;
          while Start^ <> Separator do
          begin
            if Start = Stop then
              Break;
            Inc(Start);
          end;
          SetString(TmpStr, TmpStart, Start - TmpStart);
          Li.SubItems.Add(TmpStr);
        end;
      end;
    end;
  end;
end;

procedure TJvListView.LoadFromCSV(FileName: string; Separator: Char);
var
  S: TStringList;
begin
  S := TStringList.Create;
  Items.BeginUpdate;
  try
    Items.Clear;
    S.LoadFromFile(FileName);
    LoadFromStrings(S, Separator);
  finally
    Items.EndUpdate;
    S.Free;
  end;
end;

procedure TJvListView.SaveToCSV(FileName: string; Separator: Char);
var
  S: TStringList;
begin
  S := TStringList.Create;
  Items.BeginUpdate;
  try
    SaveToStrings(S, Separator);
    S.SaveToFile(FileName);
  finally
    Items.EndUpdate;
    S.Free;
  end;
end;

procedure TJvListView.InvertSelection;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
    Items[I].Selected := not Items[I].Selected;
  Items.EndUpdate;
end;

procedure TJvListView.UnselectAll;
var
  I: Integer;
begin
  Items.BeginUpdate;
  for I := 0 to Items.Count - 1 do
    Items[I].Selected := False;
  Items.EndUpdate;
end;

procedure TJvListView.KeyUp(var Key: Word; Shift: TShiftState);
var
  st: string;
  I, J: Integer;
begin
  inherited KeyUp(Key, Shift);
  if AutoClipboardCopy then
    if (Key in [Ord('c'), Ord('C')]) and (ssCtrl in Shift) then
    begin
      for I := 0 to Columns.Count - 1 do
        st := st + Columns[I].Caption + Tab;
      if st <> '' then
        st := st + sLineBreak;
      for I := 0 to Items.Count - 1 do
        if (SelCount = 0) or Items[I].Selected then
        begin
          st := st + Items[I].Caption;
          for J := 0 to Items[I].SubItems.Count - 1 do
            st := st + Tab + Items[I].SubItems[J];
          st := st + sLineBreak;
        end;
      Clipboard.SetTextBuf(PChar(st));
    end;
end;

function TJvListView.GetColumnsOrder: string;
var
  Res: array [0..cColumnsHandled - 1] of Integer;
  I: Integer;
begin
  ListView_GetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
  Result := '';
  if Columns.Count > cColumnsHandled then
    raise EJvListViewError.CreateRes(@RsETooManyColumns);
  for I := 0 to Columns.Count - 1 do
  begin
    if Result <> '' then
      Result := Result + ',';
    Result := Result + IntToStr(Res[I]) + '=' + IntToStr(Columns[I].Width);
  end;
end;

procedure TJvListView.SetColumnsOrder(const Order: string);
var
  Res: array [0..cColumnsHandled - 1] of Integer;
  I, J: Integer;
  st: string;
begin
  FillChar(Res, SizeOf(Res), #0);
  with TStringList.Create do
  try
    CommaText := Order;
    I := 0;
    while Count > 0 do
    begin
      st := Strings[0];
      J := Pos('=', st);
      if (J <> 0) and (I < Columns.Count) then
      begin
        Columns[I].Width := StrToIntDef(Copy(st, J + 1, Length(st)), Columns[I].Width);
        st := Copy(st, 1, J - 1);
      end;
      Res[I] := StrToIntDef(st, 0);
      Delete(0);
      Inc(I);
    end;
    ListView_SetColumnOrderArray(Columns.Owner.Handle, Columns.Count, @Res[0]);
  finally
    Free;
  end;
end;

procedure TJvListView.SetHeaderImages(const Value: TCustomImageList);
begin
  if ReplaceImageListReference(Self, Value, FHeaderImages, FImageChangeLink) then
    UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.SetExtendedColumns(
  const Value: TJvListExtendedColumns);
begin
  FExtendedColumns.Assign(Value);
end;

procedure TJvListView.Notification(AComponent: TComponent;
  Operation: TOperation);
var
  I: Integer;
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if AComponent = HeaderImages then
      HeaderImages := nil
    else
      if not (csDestroying in ComponentState) and (AComponent is TPopupMenu) then
        for I := 0 to Items.Count - 1 do
          if TJvListItem(Items[I]).PopupMenu = AComponent then
            TJvListItem(Items[I]).PopupMenu := nil;
end;

procedure TJvListView.CreateWnd;
begin
  inherited CreateWnd;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  if FSavedExtendedColumns.Count > 0 then
    FExtendedColumns.Assign(FSavedExtendedColumns);

  // Get the values from the newly created list view
  LoadTileViewProperties;
  LoadGroupsProperties;
  FInsertMarkColor := SendMessage(Handle, LVM_GETINSERTMARKCOLOR, 0, 0);

  // Force a change from True to False so that InsertMarks work correctly.
  SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(not FGroupView), 0);
  SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(FGroupView), 0);
end;

procedure TJvListView.UpdateHeaderImages(HeaderHandle: Integer);
//var
//  WP: TWindowPlacement;
begin
  if (HeaderHandle <> 0) and (ViewStyle = vsReport) and ShowColumnHeaders then
  begin
//    WP.length := SizeOf(WP);
//    GetWindowPlacement(HeaderHandle, @WP);
    if HeaderImages <> nil then
    begin
      Header_SetImageList(HeaderHandle, HeaderImages.Handle);
//      WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + HeaderImages.Height + 3;
    end
    else
      if ComponentState * [csLoading, csDestroying] = [] then
      begin
        Header_SetImageList(HeaderHandle, 0);
//      WP.rcNormalPosition.Bottom := WP.rcNormalPosition.Top + 17;
      end;
    // the problem with resizing the header is that there doesn't seem to be an easy way of telling the listview about it...
//    SetWindowPlacement(HeaderHandle, @WP);
    UpdateColumns;
    Windows.InvalidateRect(HeaderHandle, nil, True)
  end;
end;

procedure TJvListView.DoHeaderImagesChange(Sender: TObject);
begin
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.SetSmallImages(const Value: TCustomImageList);
begin
  inherited SmallImages := Value;
  UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.Loaded;
begin
  inherited Loaded;
  UpdateHeaderImages(ListView_GetHeader(Handle));
  TileViewProperties.DoChange;
end;

procedure TJvListView.WMNCCalcSize(var Msg: TWMNCCalcSize);
//var
//  R: TRect;
begin
  inherited;
//  if Msg.CalcValidRects and Assigned(HeaderImages) and (ViewStyle = vsReport) and ShowColumnHeaders then
//    with Msg.CalcSize_Params^.rgrc[0] do
//      Top := Top + HeaderImages.Height + 3;
end;

procedure TJvListView.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
begin
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
  if HandleAllocated then
    UpdateHeaderImages(ListView_GetHeader(Handle));
end;

procedure TJvListView.InsertItem(Item: TListItem);
begin
  inherited InsertItem(Item);
  if AutoSelect and (Selected = nil) and (Items.Count < 2) then
    PostMessage(Handle, WM_AUTOSELECT, Integer(Item), 1);
end;

procedure TJvListView.WMAutoSelect(var Msg: TMessage);
var
  lv: TListItem;
begin
  with Msg do
  begin
    lv := TListItem(WParam);
    if Assigned(lv) and (Items.IndexOf(lv) >= 0) and (LParam = 1) then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
  end;
end;

function TJvListView.MoveDown(Index: Integer; Focus: Boolean = True): Integer;
var
  lv, lv2: TListItem;
  FOnInsert, FOnDeletion: TLVDeletedEvent;
  FOnCompare: TLVCompareEvent;
begin
  Result := Index;
  if (Index >= 0) and (Index < Items.Count) then
  begin
    lv2 := Items[Index];
    FOnInsert := OnInsert;
    FOnDeletion := OnDeletion;
    FOnCompare := OnCompare;
    try
      OnInsert := nil;
      OnDeletion := nil;
      OnCompare := nil;
      lv := Items.Insert(Index + 2);
      lv.Assign(lv2);
      lv2.Delete;
    finally
      OnInsert := FOnInsert;
      OnDeletion := FOnDeletion;
      OnCompare := FOnCompare;
    end;
    if Focus then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
    Result := lv.Index;
  end;
end;

function TJvListView.MoveUp(Index: Integer; Focus: Boolean = True): Integer;
var
  lv, lv2: TListItem;
  FOnInsert, FOnDeletion: TLVDeletedEvent;
  FOnCompare: TLVCompareEvent;
begin
  Result := Index;
  if (Index > 0) and (Index < Items.Count) then
  begin
    lv2 := Items[Index];
    FOnInsert := OnInsert;
    FOnDeletion := OnDeletion;
    FOnCompare := OnCompare;
    try
      OnInsert := nil;
      OnDeletion := nil;
      OnCompare := nil;
      lv := Items.Insert(Index - 1);
      lv.Assign(lv2);
      lv2.Delete;
    finally
      OnInsert := FOnInsert;
      OnDeletion := FOnDeletion;
      OnCompare := FOnCompare;
    end;
    if Focus then
    begin
      lv.Selected := True;
      lv.Focused := True;
    end;
    Result := lv.Index;
  end;
end;

function TJvListView.SelectNextItem(Focus: Boolean = True): Integer;
begin
  Result := ItemIndex + 1;
  if Result < Items.Count then
    ItemIndex := Result;
  Result := ItemIndex;
  if Focus and (Result >= 0) and (Result < Items.Count) then
  begin
    Items[Result].Selected := True;
    Items[Result].Focused := True;
  end;
end;

function TJvListView.SelectPrevItem(Focus: Boolean = True): Integer;
begin
  Result := ItemIndex - 1;
  if Result >= 0 then
    ItemIndex := Result;
  Result := ItemIndex;
  if Focus and (Result >= 0) and (Result < Items.Count) then
  begin
    Items[Result].Selected := True;
    Items[Result].Focused := True;
  end;
end;

procedure TJvListView.SetFocus;
var
  Index: Integer;
begin
  inherited SetFocus;

  Index := 0;
  if Assigned(ItemFocused) then
    Index := ItemIndex;

  if AutoSelect and (Selected = nil) and (Items.Count > 0) then
    PostMessage(Handle, WM_AUTOSELECT, Integer(Items[Index]), 1);
end;

function TJvListView.ShowInsertMark(ItemIndex: Integer; Position: TJvInsertMarkPosition): Boolean;
var
  Infos: TLVINSERTMARK;
begin
  ZeroMemory(@Infos, SizeOf(Infos));

  Infos.cbSize := SizeOf(Infos);
  Infos.dwFlags := InsertMarkPositionToLVIM[Position];
  Infos.iItem := ItemIndex;

  Result := Bool(SendMessage(Handle, LVM_SETINSERTMARK, 0, LPARAM(@Infos)));
end;

function TJvListView.HideInsertMark: Boolean;
begin
  Result := ShowInsertMark(-1, impBefore);
end;

function TJvListView.GetInsertMarkPosition(const X, Y: Integer;
  var ItemIndex: Integer; var Position: TJvInsertMarkPosition): Boolean;
var
  Infos: TLVINSERTMARK;
  Point: TPoint;
begin
  Point.X := X;
  Point.Y := Y;

  ZeroMemory(@Infos, SizeOf(Infos));

  Infos.cbSize := SizeOf(Infos);
  Result := Bool(SendMessage(Handle, LVM_INSERTMARKHITTEST, WPARAM(@Point), LPARAM(@Infos)));
  if Result then
  begin
    ItemIndex := Infos.iItem;
    if (Infos.dwFlags and LVIM_AFTER) = LVIM_AFTER then
      Position := impAfter
    else
      Position := impBefore;
  end;
end;

function TJvListView.IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean;
begin
  { We must custom draw both cdPrePaint and cdPostPaint because without the
    cdPostPaint the TListView creates GDI fonts without releasing them. }
  Result := inherited IsCustomDrawn(Target, Stage) or
    ((Stage in [cdPrePaint, cdPostPaint]) and (Picture.Graphic <> nil) and not Picture.Graphic.Empty) or
    ((Stage in [cdPrePaint, cdPostPaint]) and ((Target = dtItem) or (Target = dtSubItem)));
end;


function TJvListView.CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean;
var
  BmpXPos, BmpYPos: Integer; // X and Y position for bitmap
  ItemRect: TRect; // List item bounds rectangle
  TopOffset: Integer; // Y pos where bmp drawing starts
  Bmp: TBitmap;

  function GetHeaderHeight: Integer;
  var
    Header: HWND; // header window handle
    Pl: TWindowPlacement; // header window placement
  begin
    // Get header window
    Header := SendMessage(Handle, LVM_GETHEADER, 0, 0);
    // Get header window placement
    FillChar(Pl, SizeOf(Pl), 0);
    Pl.length := SizeOf(Pl);
    GetWindowPlacement(Header, @Pl);
    // Calculate header window height
    Result := Pl.rcNormalPosition.Bottom - Pl.rcNormalPosition.Top;
  end;

begin
  Result := inherited CustomDraw(ARect, Stage);
  if Result and (Stage = cdPrePaint) and (FPicture <> nil) and (FPicture.Graphic <> nil) and not
    FPicture.Graphic.Empty and (FPicture.Graphic.Width > 0) and (FPicture.Graphic.Height > 0) then
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.Width := ClientWidth;
      Bmp.Height := ClientHeight;
      Bmp.Canvas.Brush.Color := Self.Color;
      Bmp.Canvas.FillRect(ClientRect);

    // Get top offset where drawing starts
      if Items.Count > 0 then
      begin
        ListView_GetItemRect(Handle, 0, ItemRect, LVIR_BOUNDS);
        TopOffset := ListView_GetTopIndex(Handle) * (ItemRect.Bottom - ItemRect.Top);
      end
      else
        TopOffset := 0;
      if ViewStyle = vsReport then
        BmpYPos := ARect.Top - TopOffset + GetHeaderHeight
      else
        BmpYPos := 0;
      // Draw the image
      while BmpYPos < ARect.Bottom do
      begin
        // draw image across width of display
        BmpXPos := ARect.Left;
        while BmpXPos < ARect.Right do
        begin
//      DrawIconEx draws alpha-blended icons better (on XP) but gives problems with selecting in the listview
//      if Picture.Graphic is TIcon then
//        DrawIconEx(Canvas.Handle, BmpXPos, BmpYPos, Picture.Icon.Handle, 0, 0, 0, 0, DI_NORMAL)
//      else
          Bmp.Canvas.Draw(BmpXPos, BmpYPos, Picture.Graphic);
          Inc(BmpXPos, Picture.Graphic.Width);
        end;
        // move to next row
        Inc(BmpYPos, Picture.Graphic.Height);
      end;
      BitBlt(Canvas, 0, 0, ClientWidth, ClientHeight, Bmp.Canvas, 0, 0, SRCCOPY);
    // Ensure that the items are drawn transparently
      SetBkMode(Canvas.Handle, TRANSPARENT);
      ListView_SetTextBkColor(Handle, CLR_NONE);
      ListView_SetBKColor(Handle, CLR_NONE);
    finally
      Bmp.Free;
    end;
  end;
end;

function TJvListView.CustomDrawItem(Item: TListItem;
  State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
begin
  if (Stage = cdPrePaint) and Assigned(Item) then
  begin
    Canvas.Font := TJvListItem(Item).Font;
    if ViewStyle in ViewStylesItemBrush then
    begin
      if Win32MajorVersion >= 6 then
        SetBkMode(Canvas.Handle, TRANSPARENT);
      Canvas.Brush := TJvListItem(Item).Brush;
    end;
    Canvas.Handle;
  end;

  Result := inherited CustomDrawItem(Item, State, Stage);
end;


procedure TJvListView.CNNotify(var Message: TWMNotify);
begin
  with Message do
  begin
    if NMHdr^.code = NM_CUSTOMDRAW then
    begin
      with PNMCustomDraw(NMHdr)^ do
      begin
        if (dwDrawStage and CDDS_SUBITEM <> 0) and
           (PNMLVCustomDraw(NMHdr)^.iSubItem = 0) then
        begin
          // Mantis 3908: For some reason, the inherited handler will not call
          // the CustomDrawSubItem if iSubItem is equal to zero. But not calling
          // it has the consequence to trigger wrong rendering if the order of
          // columns is modified and the list item has a non standard font.
          // Calling it ourselves here is not enough as the inherited handler
          // does some very specific management with the canvas. So we must
          // trick it by changing the value to a recognizable value used
          // in our CustomDrawSubItem handler.
          PNMLVCustomDraw(NMHdr)^.iSubItem := -1;
          inherited;
          PNMLVCustomDraw(NMHdr)^.iSubItem := 0;
          Exit;
        end;
      end;
    end;
  end;

  inherited;
end;

function TJvListView.CustomDrawSubItem(Item: TListItem; SubItem: Integer;
  State: TCustomDrawState; Stage: TCustomDrawStage): Boolean;
begin
  if SubItem = -1 then      // See above
    SubItem := 0;

  if {(Stage = cdPrePaint) and} Assigned(Item) then
  begin
    Canvas.Font := TJvListItem(Item).Font;
    if ViewStyle in ViewStylesItemBrush then
      Canvas.Brush := TJvListItem(Item).Brush;
  end;

  Result := inherited CustomDrawSubItem(Item, SubItem, State, Stage);
end;

procedure TJvListView.SetPicture(const Value: TPicture);
begin
  FPicture.Assign(Value);
end;

procedure TJvListView.SetGroupView(const Value: Boolean);
begin
  if FGroupView <> Value then
  begin
    FGroupView := Value;

    SendMessage(Handle, LVM_ENABLEGROUPVIEW, Integer(FGroupView), 0);
  end;
end;

procedure TJvListView.SetGroups(const Value: TJvListViewGroups);
begin
  FGroups.Assign(Value);
end;

procedure TJvListView.SetGroupsProperties(const Value: TJvGroupsProperties);
begin
  FGroupsProperties.Assign(Value);
end;

procedure TJvListView.SetTileViewProperties(const Value: TJvTileViewProperties);
begin
  FTileViewProperties.Assign(Value);
end;

procedure TJvListView.SetInsertMarkColor(const Value: TColor);
begin
  if FInsertMarkColor <> Value then
  begin
    FInsertMarkColor := Value;

    SendMessage(Handle, LVM_SETINSERTMARKCOLOR, 0, ColorToRGB(FInsertMarkColor));
  end;
end;

procedure TJvListView.SetHeaderImagePosition(const Value: TJvHeaderImagePosition);
begin
  if FHeaderImagePosition <> Value then
  begin
    FHeaderImagePosition := Value;
    UpdateHeaderImages(ListView_GetHeader(Handle));
  end;
end;

procedure TJvListView.DoPictureChange(Sender: TObject);
begin
//  if (Picture.Graphic <> nil) and not Picture.Graphic.Empty then
//    Picture.Graphic.Transparent := true;
  Invalidate;
end;

procedure TJvListView.LVMDeleteColumn(var Msg: TMessage);
begin
  inherited;
  // This may happen at design time, especially when migrating
  // a project that uses an old version of TJvListView that did
  // not have the ExtendedColumns
  if Msg.WParam < FExtendedColumns.Count then
    FExtendedColumns.Delete(Msg.WParam);
end;

procedure TJvListView.LVMInsertColumn(var Msg: TMessage);
begin
  inherited;
  FExtendedColumns.Insert(Msg.WParam);
end;

procedure TJvListView.LVMSetColumn(var Msg: TMessage);
var
  i: Integer;
  Column: tagLVCOLUMN;
begin
  inherited;

  if not FSettingHeaderImagePosition then
  begin
    for i := 0 to ExtendedColumns.Count - 1 do
    begin
      if ExtendedColumns[i].GetHeaderImagePosition = hipRight then
      begin
        Column.mask := LVCF_FMT;
        ListView_GetColumn(Handle, i, Column);
        if Column.fmt and LVCFMT_IMAGE <> 0 then
        begin
          Column.fmt := Column.fmt or LVCFMT_BITMAP_ON_RIGHT;
          FSettingHeaderImagePosition := True;
          try
            ListView_SetColumn(Handle, i, Column);
          finally
            FSettingHeaderImagePosition := False;
          end;
        end;
      end;
    end;
  end;
end;

procedure TJvListView.DestroyWnd;
begin
  FSavedExtendedColumns.Assign(FExtendedColumns);
  inherited DestroyWnd;
end;

procedure TJvListView.SetViewStylesItemBrush(const Value: TJvViewStyles);
begin
  FViewStylesItemBrush := Value;
  Invalidate;
end;

procedure TJvListView.SetViewStyle(Value: TViewStyle);
begin
  // If someone is setting the view style via an ancestor class reference,
  // we force it to be set through our setter. But if it's set via our setter
  // then we inform the ancestor class' code so that display is updated.
  if not FSettingJvViewStyle then
    SetJvViewStyle(TJvViewStyle(Value))
  else
    inherited SetViewStyle(Value);
end;

procedure TJvListView.SetJvViewStyle(Value: TJvViewStyle);
begin
  if Value <> FViewStyle then
  begin
    FSettingJvViewStyle := True;
    try
      FViewStyle := Value;
      if Value = vsTile then
      begin
        if HandleAllocated then
        begin
          SendMessage(Handle, LVM_SETVIEW, LV_VIEW_TILE, 0);
        end;
      end
      else
      begin
        inherited ViewStyle := TViewStyle(Value);
      end;
    finally
      FSettingJvViewStyle := False;
    end;
  end;
end;

function TJvListView.DoCompareGroups(Group1, Group2: TJvListViewGroup): Integer;
begin
  if Assigned(OnCompareGroups) then
    OnCompareGroups(Self, Group1, Group2, Result)
  else
    Result := Group2.GroupId - Group1.GroupId;
end;

procedure TJvListView.TileViewPropertiesChange(Sender: TObject);
var
  Infos: TLVTILEVIEWINFO;
begin
  if not (csLoading in ComponentState) then
  begin
    Infos.cbSize := SizeOf(Infos);
    Infos.dwMask := LVTVIM_TILESIZE or LVTVIM_COLUMNS or LVTVIM_LABELMARGIN;
    Infos.dwFlags := TileSizeKindToLVTVIF[TileViewProperties.TileSizeKind];
    TileViewProperties.TileSize.CopyToSize(Infos.sizeTile);
    infos.cLines := TileViewProperties.SubLinesCount;
    TileViewProperties.LabelMargin.CopyToRect(infos.rcLabelMargin);

    SendMessage(Handle, LVM_SETTILEVIEWINFO, 0, LPARAM(@Infos));
  end;
end;

procedure TJvListView.GroupsPropertiesChange(Sender: TObject);
var
  Infos: TLVGROUPMETRICS;
begin
  if not (csLoading in ComponentState) then
  begin
    ZeroMemory(@Infos, SizeOf(Infos));

    Infos.cbSize := SizeOf(Infos);
    Infos.mask := LVGMF_BORDERSIZE or LVGMF_BORDERCOLOR or LVGMF_TEXTCOLOR;
    Infos.Top := GroupsProperties.BorderSize.Top;
    Infos.Left := GroupsProperties.BorderSize.Left;
    Infos.Bottom := GroupsProperties.BorderSize.Bottom;
    Infos.Right := GroupsProperties.BorderSize.Right;
    Infos.crTop := GroupsProperties.BorderColor.Top;
    Infos.crLeft := GroupsProperties.BorderColor.Left;
    Infos.crBottom := GroupsProperties.BorderColor.Bottom;
    Infos.crRight := GroupsProperties.BorderColor.Right;
    Infos.crHeader := GroupsProperties.HeaderColor;

    SendMessage(Handle, LVM_SETGROUPMETRICS, 0, LPARAM(@Infos));
  end;
end;

procedure TJvListView.LoadTileViewProperties;
begin
  TileViewProperties.LoadFromList(Self);
end;

procedure TJvListView.LoadGroupsProperties;
begin
  GroupsProperties.LoadFromList(Self);
end;

  { TJvListViewGroup }

procedure TJvListViewGroup.Assign(AValue: TPersistent);
var
  Source: TJvListViewGroup;
begin
  if AValue is TJvListViewGroup then
  begin
    Source := AValue as TJvListViewGroup;

    FHeader := Source.Header;
    FHeaderAlignment := Source.HeaderAlignment;
    FGroupId := Source.GroupId;
    UpdateGroupProperties;
  end;
end;

constructor TJvListViewGroup.Create(Collection: Classes.TCollection);
begin
  // Before inherited for Notify to acces it
  FGroupId := -1;
  FHeaderAlignment := taLeftJustify;
  FHeader := 'Group';

  inherited Create(Collection);
end;

destructor TJvListViewGroup.Destroy;
begin
  inherited Destroy;
end;

procedure TJvListViewGroup.SetHeader(const Value: WideString);
var
  SavedGroupId: Integer;
begin
  if FHeader <> Value then
  begin
    FHeader := Value;

    // Due to a undocumented bug/feature in the list view, one has to change
    // the GroupId as well when changing the caption or the modification is
    // not taken into account.
    SavedGroupId := GroupId;
    UpdateGroupProperties(MaxInt);
    FGroupId := MaxInt;
    UpdateGroupProperties(SavedGroupId);
    FGroupId := SavedGroupId;
  end;
end;

procedure TJvListViewGroup.SetHeaderAlignment(const Value: TAlignment);
begin
  if FHeaderAlignment <> Value then
  begin
    FHeaderAlignment := Value;
    UpdateGroupProperties;
  end;
end;

procedure TJvListViewGroup.SetLVGROUP(var GroupInfo: TLVGROUP);
begin
  ZeroMemory(@GroupInfo, sizeof(GroupInfo));

  GroupInfo.cbSize := sizeof(GroupInfo);
  GroupInfo.mask := LVGF_HEADER or LVGF_ALIGN or LVGF_GROUPID;
  GroupInfo.iGroupId := FGroupId;
  GroupInfo.pszHeader := PWideChar(FHeader);
  GroupInfo.cchHeader := Length(FHeader);
  GroupInfo.uAlign := AlignmentToLVGA[HeaderAlignment];
end;

procedure TJvListViewGroup.SetGroupId(const Value: Integer);
begin
  if FGroupId <> Value then
  begin
    UpdateGroupProperties(Value);
    FGroupId := Value;
  end;
end;

procedure TJvListViewGroup.UpdateGroupProperties(const NewGroupId: Integer = -1);
var
  GroupInfo: TLVGROUP;
  List: TJvListView;
begin
  List := (Collection as TJvListViewGroups).ParentList;
  if Assigned(List) then
  begin
    SetLVGROUP(GroupInfo);
    if NewGroupId <> -1 then
      GroupInfo.iGroupId := NewGroupId;
    SendMessage(List.Handle, LVM_SETGROUPINFO, FGroupId, LPARAM(@GroupInfo));
    List.Invalidate;
  end;
end;

{ TJvListViewGroups }

function TJvListViewGroups.Compare(Id1, Id2: Integer): Integer;
var
  List: TJvListView;
begin
  Result := Id2 - Id1;
  List := ParentList;
  if Assigned(List) then
  begin
    Result := List.DoCompareGroups(ItemsById[Id1], ItemsById[Id2]);
  end;
end;

constructor TJvListViewGroups.Create(AOwner: TPersistent);
begin
  inherited Create(AOwner, TJvListViewGroup);
end;

function TJvListViewGroups.GetItem(Index: Integer): TJvListViewGroup;
begin
  Result := inherited Items[Index] as TJvListViewGroup;
end;

function TJvListViewGroups.GetItemById(GroupId: Integer): TJvListViewGroup;
var
  I: Integer;
begin
  Result := nil;
  I := 0;
  while (I < Count) and not Assigned(Result) do
  begin
    if Items[I].GroupId = GroupId then
      Result := Items[I];
    Inc(I);
  end;
end;

function LVGroupCompare(Group1_ID: Integer; Group2_ID: Integer; pvData: Pointer): Integer; stdcall;
begin
  Result := TJvListViewGroups(pvData).Compare(Group1_ID, Group2_ID);
end;

procedure TJvListViewGroups.InsertGroupIntoList(group: TJvListViewGroup);
var
  List: TJvListView;
  GroupInfo: TLVGROUP;
  GroupSortedInfo: TLVINSERTGROUPSORTED;
begin
  List := ParentList;
  if Assigned(List) then
  begin
    if group.GroupId = -1 then
      group.FGroupId := Count;
    if Sorted then
    begin
      GroupSortedInfo.pfnGroupCompare := @LVGroupCompare;
      GroupSortedInfo.pvData := Self;
      group.SetLVGROUP(GroupSortedInfo.lvGroup);
      SendMessage(List.Handle, LVM_INSERTGROUPSORTED, WPARAM(@GroupSortedInfo), 0);
    end
    else
    begin
      group.SetLVGROUP(GroupInfo);
      SendMessage(List.Handle, LVM_INSERTGROUP, group.Index, LPARAM(@GroupInfo));
    end;
  end;
end;

procedure TJvListViewGroups.Notify(Item: TCollectionItem;
  Action: TCollectionNotification);
begin
  case Action of
    cnAdded:
      InsertGroupIntoList(Item as TJvListViewGroup);
    cnDeleting:
      RemoveGroupFromList(Item as TJvListViewGroup);
  end;
end;

function TJvListViewGroups.ParentList: TJvListView;
var
  Owner: TPersistent;
begin
  Result := nil;
  Owner := GetOwner;
  if Owner is TJvListView then
    Result := Owner as TJvListView;
end;

procedure TJvListViewGroups.RemoveGroupFromList(group: TJvListViewGroup);
var
  List: TJvListView;
begin
  List := ParentList;
  if Assigned(List) then
  begin
    SendMessage(List.Handle, LVM_REMOVEGROUP, group.GroupId, 0);
  end;
end;

procedure TJvListViewGroups.SetItem(Index: Integer;
  const Value: TJvListViewGroup);
begin
  inherited Items[Index] := Value;
end;

procedure TJvListViewGroups.SetSorted(const Value: Boolean);
begin
  if FSorted <> Value then
  begin
    FSorted := Value;
    if FSorted then
      Sort;
  end;
end;

procedure TJvListViewGroups.Sort;
var
  List: TJvListView;
begin
  List := ParentList;
  if Assigned(List) then
  begin
    SendMessage(List.Handle, LVM_SORTGROUPS, WPARAM(@LVGroupCompare), LPARAM(Self));
  end;
end;

  { TJvTileViewProperties }

constructor TJvTileViewProperties.Create;
begin
  inherited Create;

  FLabelMargin := TJvRect.Create;
  FTileSize := TJvSize.Create;

  FLabelMargin.OnChange := LabelMarginChange;
  FTileSize.OnChange := TileSizeChange;

  FSubLinesCount := 1;
  FTileSizeKind := tskAutoSize;
end;

destructor TJvTileViewProperties.Destroy;
begin
  FTileSize.Free;
  FLabelMargin.Free;

  inherited Destroy;
end;

procedure TJvTileViewProperties.DoChange;
begin
  if not FLoading and Assigned(OnChange) then
    OnChange(Self);
end;

procedure TJvTileViewProperties.LabelMarginChange(Sender: TObject);
begin
  DoChange;
end;

procedure TJvTileViewProperties.LoadFromList(List: TCustomListView);
var
  Infos: TLVTILEVIEWINFO;
begin
  if not (csDesigning in List.ComponentState) then
  begin
    Infos.cbSize := SizeOf(Infos);
    Infos.dwMask := LVTVIM_TILESIZE or LVTVIM_COLUMNS or LVTVIM_LABELMARGIN;

    SendMessage(List.Handle, LVM_GETTILEVIEWINFO, 0, LPARAM(@Infos));

    FLoading := True;
    try
      case Infos.dwFlags of
        LVTVIF_FIXEDHEIGHT:
          FTileSizeKind := tskFixedHeight;
        LVTVIF_FIXEDWIDTH:
          FTileSizeKind := tskFixedWidth;
        LVTVIF_FIXEDSIZE:
          FTileSizeKind := tskFixedSize;
        else
          FTileSizeKind := tskAutoSize;
      end;
      TileSize.Assign(Infos.sizeTile);
      FSubLinesCount := infos.cLines;
      LabelMargin.Assign(infos.rcLabelMargin);
    finally
      FLoading := False;
    end;
  end;
end;

procedure TJvTileViewProperties.SetLabelMargin(const Value: TJvRect);
begin
  FLabelMargin.Assign(Value);
end;

procedure TJvTileViewProperties.SetSubLinesCount(const Value: Integer);
begin
  FSubLinesCount := Value;
  DoChange;
end;

procedure TJvTileViewProperties.SetTileSize(const Value: TJvSize);
begin
  FTileSize.Assign(Value);
end;

procedure TJvTileViewProperties.SetTileSizeKind(const Value: TJvTileSizeKind);
begin
  FTileSizeKind := Value;
  DoChange;
end;

procedure TJvTileViewProperties.TileSizeChange(Sender: TObject);
begin
  DoChange;
end;

  { TJvGroupProperties }

procedure TJvGroupsProperties.BorderColorChange(Sender: TObject);
begin
  DoChange;
end;

procedure TJvGroupsProperties.BorderSizeChange(Sender: TObject);
begin
  DoChange;
end;

constructor TJvGroupsProperties.Create;
begin
  inherited Create;

  FBorderSize := TJvGroupsPropertiesBorderRect.Create;
  FBorderColor := TJvGroupsPropertiesBorderColors.Create;

  FBorderSize.OnChange := BorderSizeChange;
  FBorderColor.OnChange := BorderColorChange;
end;

destructor TJvGroupsProperties.Destroy;
begin
  FBorderSize.Free;
  FBorderColor.Free;

  inherited Destroy;
end;

procedure TJvGroupsProperties.DoChange;
begin
  if not FLoading and Assigned(OnChange) then
    OnChange(Self);
end;

procedure TJvGroupsProperties.LoadFromList(List: TCustomListView);
var
  Infos: TLVGROUPMETRICS;
begin
  if not (csDesigning in List.ComponentState) then
  begin
    ZeroMemory(@Infos, SizeOf(Infos));

    Infos.cbSize := SizeOf(Infos);
    Infos.mask := LVGMF_BORDERSIZE or LVGMF_BORDERCOLOR or LVGMF_TEXTCOLOR;
    SendMessage(List.Handle, LVM_GETGROUPMETRICS, 0, LPARAM(@Infos));

    FLoading := True;
    try
      BorderSize.Top := Infos.Top;
      BorderSize.Left := Infos.Left;
      BorderSize.Bottom := Infos.Bottom;
      BorderSize.Right := Infos.Right;
      BorderColor.Top := Infos.crTop and $00FFFFFF;
      BorderColor.Left := Infos.crLeft and $00FFFFFF;
      BorderColor.Bottom := Infos.crBottom and $00FFFFFF;
      BorderColor.Right := Infos.crRight and $00FFFFFF;
      HeaderColor := Infos.crHeader and $00FFFFFF;
    finally
      FLoading := False;
    end;
  end;
end;

procedure TJvGroupsProperties.SetBorderColor(const Value: TJvGroupsPropertiesBorderColors);
begin
  FBorderColor.Assign(Value);
end;

procedure TJvGroupsProperties.SetBorderSize(const Value: TJvGroupsPropertiesBorderRect);
begin
  FBorderSize.Assign(Value);
end;

procedure TJvGroupsProperties.SetHeaderColor(const Value: TColor);
begin
  if FHeaderColor <> Value then
  begin
    FHeaderColor := Value;
    DoChange;
  end;
end;

  { TJvGroupsPropertiesBorderRect }

constructor TJvGroupsPropertiesBorderRect.Create;
begin
  inherited Create;

  Top := 12;
end;

{ TJvGroupsPropertiesBorderColors }

procedure TJvGroupsPropertiesBorderColors.Assign(Source: TPersistent);
var
  SourceColors: TJvGroupsPropertiesBorderColors;
begin
  if Source is TJvGroupsPropertiesBorderColors then
  begin
    SourceColors := Source as TJvGroupsPropertiesBorderColors;
    FTop := SourceColors.Top;
    FLeft := SourceColors.Left;
    FBottom := SourceColors.Bottom;
    FRight := SourceColors.Right;
    DoChange;
  end
  else
  begin
    inherited Assign(Source);
  end;
end;

constructor TJvGroupsPropertiesBorderColors.Create;
begin
  inherited Create;

  Top := $C8D0D4;
  Left := clWhite;
  Bottom := clWhite;
  Right := clWhite;
end;

procedure TJvGroupsPropertiesBorderColors.DoChange;
begin
  if Assigned(OnChange) then
    OnChange(Self);
end;

procedure TJvGroupsPropertiesBorderColors.SetBottom(const Value: TColor);
begin
  if FBottom <> Value then
  begin
    FBottom := Value;
    DoChange;
  end;
end;

procedure TJvGroupsPropertiesBorderColors.SetLeft(const Value: TColor);
begin
  if FLeft <> Value then
  begin
    FLeft := Value;
    DoChange;
  end;
end;

procedure TJvGroupsPropertiesBorderColors.SetRight(const Value: TColor);
begin
  if FRight <> Value then
  begin
    FRight := Value;
    DoChange;
  end;
end;

procedure TJvGroupsPropertiesBorderColors.SetTop(const Value: TColor);
begin
  if FTop <> Value then
  begin
    FTop := Value;
    DoChange;
  end;
end;

{$IFDEF UNITVERSIONING}
initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.