View Issue Details

IDProjectCategoryView StatusLast Update
0035362LazarusLCLpublic2020-04-24 20:00
ReporterBrett Assigned ToMartin Friebe  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformWindows 
Target Version2.2Fixed in Version2.2 
Summary0035362: ListView with MultiSelect incorrectly deselects items on MouseDown
DescriptionWhen using a ListView with MultiSelect=true, clicking the mouse button down on the selected list items to start a drag operation deselects all but the item being clicked on.

I believe this is caused by the fix for https://bugs.freepascal.org/view.php?id=33330, where ListViewProc() in win32wscustomlistview.inc is creating an LM_LBUTTONUP message. The problem is that this causes the list items to be deselected on MouseDown when you try to drag them, rather than on MouseUp.

I've attached a sample project to demonstrate, but it's not really necessary.
Steps To Reproduce1) Create TListView with some items and MultiSelect=true
2) Select some items with shift+click or ctrl+click
3) Mouse down on the selection to initiate a drag-drop operation
4) Watch all items except the current one get deselected
Additional InformationProblem is new in Lazarus 2.0, does not occur in 1.8.4.
TagsNo tags attached.
Fixed in Revision63012,63013
LazTarget2.2
WidgetsetGTK 2, Win32/Win64
Attached Files

Relationships

related to 0033330 closedMichl Packages Mouse events do not fire properly when MultiSelect = True on TListView of win32/64 
related to 0033811 resolvedMartin Friebe Lazarus Listview: DragMode dmAutomatic does not function with Multiselect enabled 
related to 0030234 closedOndrej Pokorny Lazarus TListView: pressed keys are not reflected in Shift variable inside OnMouseUp event 
related to 0035917 resolvedMartin Friebe Lazarus MSWindows: TListView.OnContextPopup is called twice 

Activities

Brett

2019-04-11 07:24

reporter  

ListViewBug.zip (3,753 bytes)

Brett

2019-04-11 07:34

reporter   ~0115417

Apologies, this should have gone under Packages rather than FPC.

Cyrax

2019-04-11 07:53

reporter   ~0115418

Does this bug occur in the trunk or the fixes version?

Brett

2019-04-11 09:46

reporter   ~0115420

Yes, occurs in both Trunk and Fixes.

Juha Manninen

2019-04-12 13:09

developer   ~0115439

Last edited: 2019-04-12 13:11

View 2 revisions

TListView with GTK2 bindings has the same problem. It always had it, or at least since 2015.
QT works.

If this is a regression on Windows, I guess it should be fixed before the next dot release.
Brett, please make sure the bug is caused by r57906 from the related issue. Then we can reopen it.

Zeljan Rikalo

2019-04-12 14:14

developer   ~0115442

In that case both Windows and gtk2 must be fixed.

Brett

2019-04-12 14:27

reporter   ~0115443

Actually, the bug appears to only be present from r58092 (on Windows).

Serge Anvarov

2019-08-11 19:16

reporter   ~0117644

In 0033330 issue last change by Michl.
In win32wscustomlistview.inc in procedure ListViewProc code is:
[code]
...
        // for multiselected listbox the message has to be send after current
        // message or the list item selecting does not work, also see issue 0033330
        if not Assigned(ListItem) and ListView.MultiSelect then
        begin
          Result := WindowProc(Window, Msg, WParam, LParam);
          if not (Msg = WM_LBUTTONDBLCLK) and ((Msg = WM_LBUTTONDOWN) or not Assigned(ListView.PopupMenu)) then
            PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY));
          Exit;
        end;
...
[/code]
I don't understand the purpose of the piece "not Assigned(ListItem)". If remove it, the bug is not reproduced.

Rolf Wetjen

2020-03-08 19:03

reporter   ~0121466

Hello Lazarus team,
I'm surprised that this issue is low level as a multiselect ListView object is nearly useless for drag&drop operations by now.
Anyway, here's a path for Lazarus SVN 62701:62715M.
The creation of the missing mouse up messages (LM_LBUTTONUP and LM_RBUTTONUP) is moved from ListViewProc to ListViewParentMsgHandler as is was in 1.8.4. No need to subclass the ListView window with ListViewProc any more.
Rolf
win32wscustomlistview.inc.patch (4,238 bytes)   
Index: interfaces/win32/win32wscustomlistview.inc
===================================================================
--- interfaces/win32/win32wscustomlistview.inc	(revision 62715)
+++ interfaces/win32/win32wscustomlistview.inc	(working copy)
@@ -231,6 +231,21 @@
     end;
   end;
 
+// #35362
+  function OwnMouseUpNeeded(ALV: TCustomListViewAccess): Boolean;
+  var
+    LVInfo: PWin32WindowInfo;
+    ListItem: TListItem;
+  begin
+    LVInfo:= GetWin32WindowInfo(ALV.Handle);
+    ListItem := ALV.GetItemAt(LVInfo^.MouseX, LVInfo^.MouseY);
+    Result := Assigned(ListItem);
+  end;
+
+// #35362
+var
+  Pos: TSmallPoint;
+
 begin
   Result := False;
   case Msg of
@@ -237,6 +252,26 @@
     WM_NOTIFY:
     begin
       case PNMHdr(LParam)^.code of
+// #35362: NM_CLICK, NM_RCLICK taken from Lazarus 1.8.4 
+        NM_CLICK, NM_RCLICK:
+          if OwnMouseUpNeeded(TCustomListViewAccess(AWinControl)) then
+          begin
+            // A listview doesn't get a WM_LBUTTONUP, WM_RBUTTONUP message,
+            // because it keeps the message in its own event loop,
+            // see msdn article about "Default List-View Message Processing"
+            // therefore we take this notification and create a
+            // LM_LBUTTONUP, LM_RBUTTONUP message out of it
+            WinProcess := False;
+            if PNMHdr(LParam)^.code = NM_CLICK then
+              Msg := LM_LBUTTONUP
+            else
+              Msg := LM_RBUTTONUP;
+            Pos := GetClientCursorPos(PNMHdr(LParam)^.hwndFrom);
+            // to make correct event sequence in LCL we should postpone this message
+            // since we are here after call of CallDefaultWindowProc
+            PostMessage(PNMHdr(LParam)^.hwndFrom, Msg, 0, MakeLParam(Pos.x, Pos.y));
+            Result := True;
+          end;
         LVN_GETDISPINFOA, LVN_GETDISPINFOW:
           HandleListViewOwnerData(TCustomListViewAccess(AWinControl));
         NM_CUSTOMDRAW:
@@ -757,48 +792,6 @@
   ItemMsg := CN_DRAWITEM;
 end;
 
-function ListViewProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
-    LParam: Windows.LParam): LResult; stdcall;
-var
-  WindowInfo: PWin32WindowInfo;
-  ListItem: TListItem;
-  ListView: TCustomListView;
-  AMsg: UINT;
-begin
-  case Msg of
-    WM_LBUTTONDOWN, WM_RBUTTONDOWN:
-      begin
-        // A ListView doesn't get a WM_LBUTTONUP, WM_RBUTTONUP message,
-        // because it keeps the message in its own event loop,
-        // see msdn article about "Default List-View Message Processing"
-        // therefore we take this notification and create a
-        // LM_LBUTTONUP, LM_RBUTTONUP message out of it
-
-        WindowInfo := GetWin32WindowInfo(Window);
-        ListView := TListView(WindowInfo^.WinControl);
-        ListItem := ListView.GetItemAt(WindowInfo^.MouseX, WindowInfo^.MouseY);
-
-        if Msg = WM_LBUTTONDOWN
-        then AMsg := LM_LBUTTONUP
-        else AMsg := LM_RBUTTONUP;
-
-        // for multiselected listbox the message has to be send after current
-        // message or the list item selecting does not work, also see issue #33330
-        if not Assigned(ListItem) and ListView.MultiSelect then
-        begin
-          Result := WindowProc(Window, Msg, WParam, LParam);
-          if not (Msg = WM_LBUTTONDBLCLK) and ((Msg = WM_LBUTTONDOWN) or not Assigned(ListView.PopupMenu)) then
-            PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY));
-          Exit;
-        end;
-
-        if Assigned(ListItem) then
-          PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY));
-      end;
-  end;
-  Result := WindowProc(Window, Msg, WParam, LParam);
-end;
-
 class function TWin32WSCustomListView.CreateHandle(const AWinControl: TWinControl;
   const AParams: TCreateParams): HWND;
 const
@@ -813,7 +806,8 @@
   with Params do
   begin
     pClassName := WC_LISTVIEW;
-    SubClassWndProc := @ListViewProc;
+// #35362: Funtionality of ListViewProc moved to ListViewParentMsgHandler (NM_CLICK, NM_RCLICK)
+//  SubClassWndProc := @ListViewProc;
     WindowTitle := StrCaption;
     Flags := Flags or LISTVIEWSTYLES[TListView(AWinControl).ViewStyle] or
       LVS_SINGLESEL or LVS_SHAREIMAGELISTS or

Juha Manninen

2020-03-16 14:32

developer   ~0121621

Rolf, did you also test DragMode dmAutomatic? See related issue 0033811.
I personally don't have Windows right now to test.

Rolf Wetjen

2020-03-22 19:13

reporter   ~0121685

Hi Juha,
yes, working. I've attached a small test project if someone else want to test to.
Regards
Rolf
selection.zip (67,151 bytes)

Martin Friebe

2020-04-04 03:11

manager   ~0121880

@RolfW

I am doing some testing.

Not important, but curious: Why this comment? It implies wrong message order, but the order seems fine. (The msg should go to the end of the queue).
+ // to make correct event sequence in LCL we should postpone this message
+ // since we are here after call of CallDefaultWindowProc

The more serious issue:
With the patch, for some reason the MouseDown event is hold back.
All 3 events (down, click, up) occur when the mouse is released.

Mouse down should occur as soon as the button is pressed. That worked before the patch.

Martin Friebe

2020-04-04 16:00

manager   ~0121900

Unfortunately changing the order (LCL first) will kill dragging completely / https://github.com/User4martin/lazarus/tree/f-test-listview-event-order-drag

Martin Friebe

2020-04-04 17:29

manager   ~0121903

I have updated the changes published on github.

This *appears* to work.
But it needs serious testing.

To Anyone who wants to test: Please apply it. And leave feedback.
Ensure, that
 - OnMouseDown
 - OnClick (except, when dragging)
 - OnMouseUp
are always called, and always in this order.

---
This is NOT a candidate for merging to fixes branch.
But if successful in tests, then it can make it for 2.2

Before merging to trunk, debugln needs to be removed

Martin Friebe

2020-04-04 17:56

manager   ~0121904

There is another issue, but that existed before the patch too: While over the listview the mouse cursor flickers between 2 states (also happens if drag would be accepted)

nanobit

2020-04-06 10:46

reporter   ~0121955

I tested and the longstanding issue with onMouseDown seems to be solved:),
but (additional) onMouseUp should not happen in this case:
(multiselect = false) and (mouseDown on empty area).

Rolf Wetjen

2020-04-06 13:06

reporter   ~0121960

Martin, nanobit,

I've attached my current version of my win32wscustomlistview.inc with a very small change. The part in question is changed to
        if Assigned(ListItem) then
          if (ListView.SelCount<=1) or (Msg=WM_RBUTTONDOWN) then
            PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY))
        else
--> if Assigned(ListView.OnMouseDown) then
--> ListView.OnMouseDown(ListView,mbLeft,KeyboardStateToShiftState,WindowInfo^.MouseX, WindowInfo^.MouseY);
It works fine but a small issue: I get two MouseDown events: One at the time of the click and another one at time of start drag. May be someone how to suppress the second one.
win32wscustomlistview.inc (48,116 bytes)   
{%MainUnit win32wscomctrls.pp}
{ $Id: win32wscustomlistview.inc 62567 2020-01-17 01:49:23Z dmitry $

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{ TWin32WSCustomListView }

type
  TLVStyleType = (lsStyle, lsInvert, lsExStyle);

const
  LV_STYLES: array[TListViewProperty] of record
    StyleType: TLVStyleType;
    Style: Integer;
  end = (
    (StyleType: lsStyle;   Style: LVS_AUTOARRANGE),        // lvpAutoArrange
    (StyleType: lsExStyle; Style: LVS_EX_CHECKBOXES),      // lvpCheckboxes
    (StyleType: lsInvert;  Style: LVS_NOSORTHEADER),       // lvpColumnClick
    (StyleType: lsExStyle; Style: LVS_EX_FLATSB),          // lvpFlatScrollBars
    (StyleType: lsExStyle; Style: LVS_EX_HEADERDRAGDROP),  // lvpFullDrag
    (StyleType: lsExStyle; Style: LVS_EX_GRIDLINES),       // lvpGridLines
    (StyleType: lsInvert;  Style: LVS_SHOWSELALWAYS),      // lvpHideSelection
    (StyleType: lsExStyle; Style: LVS_EX_TRACKSELECT),     // lvpHotTrack
    (StyleType: lsInvert;  Style: LVS_SINGLESEL),          // lvpMultiSelect
    (StyleType: lsStyle;   Style: LVS_OWNERDRAWFIXED),     // lvpOwnerDraw
    (StyleType: lsInvert;  Style: LVS_EDITLABELS),         // lvpReadOnly,
    (StyleType: lsExStyle; Style: LVS_EX_FULLROWSELECT),   // lvpRowSelect
    (StyleType: lsInvert;  Style: LVS_NOCOLUMNHEADER),     // lvpShowColumnHeaders
    (StyleType: lsExStyle; Style: LVS_EX_MULTIWORKAREAS),  // lvpShowWorkAreas
    (StyleType: lsInvert;  Style: LVS_NOLABELWRAP),        // lvpWrapText
    (StyleType: lsExStyle; Style: LVS_EX_LABELTIP)         // lvpToolTips
  );


type
  // TODO: add iImage and iOrder to exiting TLvColumn
  // this is a hack !!!
  TLvColumn_v4_7 = record
    lvc: TLvColumn;
    iImage: Integer;
    iOrder: Integer;
  end;


type
  TCustomListViewAccess = class(TCustomListView);
  TListColumnAccess = class(TListColumn);

////////////////////////////////////////////////////////////////////////////////
// Msg handlers
////////////////////////////////////////////////////////////////////////////////

function ListViewParentMsgHandler(const AWinControl: TWinControl; Window: HWnd;
      Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam;
      var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean;

type
  PNMLVOwnerData = PLVDISPINFO;
var
  NMHdr: PNMHdr absolute LParam; // used by WM_NOTIFY

  // Gets the cursor position relative to a given window
  function GetClientCursorPos(ClientWindow: HWND) : TSmallPoint;
  var
    P: TPoint;
  begin
    Windows.GetCursorPos(P);
    //if the mouse is not over the window is better to set to 0 to avoid weird behaviors
    if Windows.WindowFromPoint(P) = ClientWindow then
      Windows.ScreenToClient(ClientWindow, P)
    else
    begin
      P.X:=0;
      P.Y:=0;
    end;
    Result := Windows.PointToSmallPoint(P);
  end;

  procedure HandleListViewOwnerData(ALV: TCustomListViewAccess);
  var
    DataInfo: PNMLVOwnerData; // absolute NMHdr;
    txt: String;
    LVInfo: PWin32WindowInfo;
    idx: Integer;
    listitem: TListItem;
  begin
    LVInfo:= GetWin32WindowInfo(ALV.Handle);
    DataInfo := PNMLVOwnerData(NMHdr);
    if not Assigned(DataInfo) or (not ALV.OwnerData) then
      Exit;
    listitem := ALV.Items[DataInfo^.item.iItem];
    if not Assigned(listitem) then
      Exit;
    if (DataInfo^.item.mask and LVIF_TEXT) <> 0 then
    begin
      if DataInfo^.item.iSubItem = 0 then
        txt := listitem.Caption
      else
      begin
        idx := DataInfo^.item.iSubItem - 1;
        if idx < listitem.SubItems.Count then
          txt := listitem.SubItems[idx]
        else
          txt := '';
      end;
      if txt <> '' then
      begin
        if DataInfo^.hdr.code = UInt(LVN_GETDISPINFOA) then
        begin
          LVInfo^.DispInfoTextA[LVInfo^.DispInfoIndex]:=Utf8ToAnsi(txt);
          DataInfo^.item.pszText := @(LVInfo^.DispInfoTextA[LVInfo^.DispInfoIndex][1]);
        end
        else
        begin
          LVInfo^.DispInfoTextW[LVInfo^.DispInfoIndex]:=UTF8Decode(txt);
          DataInfo^.item.pszText := @(LVInfo^.DispInfoTextW[LVInfo^.DispInfoIndex][1]);
        end;
        inc(LVInfo^.DispInfoIndex);
        if LVInfo^.DispInfoIndex=LV_DISP_INFO_COUNT then LVInfo^.DispInfoIndex:=0;
      end
      else
        DataInfo^.item.pszText := nil;
    end;
    if (DataInfo^.item.mask and LVIF_IMAGE) <> 0 then
    begin
      if DataInfo^.item.iSubItem = 0 then
        DataInfo^.item.iImage := listitem.ImageIndex
      else
      begin
        idx := DataInfo^.item.iSubItem - 1;
        if idx < listitem.SubItems.Count then
          DataInfo^.item.iImage := listitem.SubItemImages[idx]
        else
          DataInfo^.item.iImage := -1;
      end;
      if Assigned(ALV.StateImages) then
      begin
        DataInfo^.item.state := IndexToStateImageMask(listitem.StateIndex + 1);
        DataInfo^.item.stateMask := $F000; // States start from 12 bit
        DataInfo^.item.mask := DataInfo^.item.mask or LVIF_STATE;
      end;
    end;
  end;

  procedure HandleListViewCustomDraw(ALV: TCustomListViewAccess);
    function ConvState(const State: uint): TCustomDrawState;
    begin
      Result := [];
      if state and CDIS_CHECKED <> 0 then Include(Result, cdsChecked);
      if state and CDIS_DEFAULT <> 0 then Include(Result, cdsDefault);
      if state and CDIS_DISABLED <> 0 then Include(Result, cdsDisabled);
      if state and CDIS_FOCUS <> 0 then Include(Result, cdsFocused);
      if state and CDIS_GRAYED <> 0 then Include(Result, cdsGrayed);
      if state and CDIS_HOT <> 0 then Include(Result, cdsHot);
      if state and CDIS_INDETERMINATE <> 0 then Include(Result, cdsIndeterminate);
      if state and CDIS_MARKED <> 0 then Include(Result, cdsMarked);
      if state and CDIS_SELECTED <> 0 then Include(Result, cdsSelected);
    end;

  const
    CDRFRESULT: array[TCustomDrawResultFlag] of Integer = (
      CDRF_SKIPDEFAULT,
      CDRF_NOTIFYPOSTPAINT,
      CDRF_NOTIFYITEMDRAW,
      CDRF_NOTIFYSUBITEMDRAW,
      CDRF_NOTIFYPOSTERASE,
      CDRF_NOTIFYITEMERASE
    );
  var
    DrawInfo: PNMLVCustomDraw absolute NMHdr;
    Stage: TCustomDrawStage;
    DrawResult: TCustomDrawResult;
    ResultFlag: TCustomDrawResultFlag;
    OldDC: HDC;
  begin
    MsgResult := CDRF_DODEFAULT;
    WinProcess := False;
    if not ALV.IsCustomDrawn(dtControl, cdPrePaint) then
      exit;

    case DrawInfo^.nmcd.dwDrawStage and $7 of //Get drawing state
      CDDS_PREPAINT:  Stage := cdPrePaint;
      CDDS_POSTPAINT: Stage := cdPostPaint;
      CDDS_PREERASE:  Stage := cdPreErase;
      CDDS_POSTERASE: Stage := cdPostErase;
    else
      Exit;
    end;

    OldDC := ALV.Canvas.Handle;
    ALV.Canvas.Handle := DrawInfo^.nmcd.hdc;
    ALV.Canvas.Font.Assign(ALV.Font);
    ALV.Canvas.Brush.Assign(ALV.Brush);

    if DrawInfo^.nmcd.dwDrawStage and CDDS_SUBITEM <> 0 then
    begin
      // subitem 0 is handled by dtItem
      if DrawInfo^.iSubItem = 0 then Exit;
      DrawResult := ALV.IntfCustomDraw(dtSubItem, Stage,
        DrawInfo^.nmcd.dwItemSpec, DrawInfo^.iSubItem,
        ConvState(DrawInfo^.nmcd.uItemState), nil);
    end
    else
    if DrawInfo^.nmcd.dwDrawStage and CDDS_ITEM <> 0 then
      DrawResult := ALV.IntfCustomDraw(dtItem, Stage, DrawInfo^.nmcd.dwItemSpec,
        -1, ConvState(DrawInfo^.nmcd.uItemState), nil)
    else
      DrawResult := ALV.IntfCustomDraw(dtControl, Stage, -1, -1, [], @DrawInfo^.nmcd.rc); //Whole control

    if DrawResult <> [] then
      MsgResult := 0;

    if not (cdrSkipDefault in DrawResult) and
       (DrawInfo^.nmcd.dwDrawStage and CDDS_ITEMPREPAINT = CDDS_ITEMPREPAINT) then
    begin
      DrawInfo^.clrText := ColorToRGB(ALV.Canvas.Font.Color);
      DrawInfo^.clrTextBk := ColorToRGB(ALV.Canvas.Brush.Color);
    end;
    ALV.Canvas.Handle := OldDC;

    for ResultFlag := Low(ResultFlag) to High(ResultFlag) do
    begin
      if ResultFlag in DrawResult then
        MsgResult := MsgResult or CDRFRESULT[ResultFlag];
    end;
  end;

begin
  Result := False;
  case Msg of
    WM_NOTIFY:
    begin
      case PNMHdr(LParam)^.code of
        LVN_GETDISPINFOA, LVN_GETDISPINFOW:
          HandleListViewOwnerData(TCustomListViewAccess(AWinControl));
        NM_CUSTOMDRAW:
          HandleListViewCustomDraw(TCustomListViewAccess(AWinControl));
      end;
    end;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
// Event code
////////////////////////////////////////////////////////////////////////////////


////////////////////////////////////////////////////////////////////////////////
// Column code
////////////////////////////////////////////////////////////////////////////////

class procedure TWin32WSCustomListView.ColumnDoAutosize(const ALV: TCustomListView; const AIndex: Integer);
var
  CaptionSize: TSize;
begin
  if (ALV.Items.Count > 0) then
    ListView_SetColumnWidth(ALV.Handle, AIndex, LVSCW_AUTOSIZE)
  else
  begin
    // normally, we have to use ListView_GetStringWidth, but it doesn't work with
    // Unicode, so we take a universal function to get the width of the caption
    if GetTextExtentPoint32W(ALV.Canvas.Handle,
                             PWideChar(UTF8ToUTF16(ALV.Column[AIndex].Caption)),
                             UTF8Length(ALV.Column[AIndex].Caption),
                             CaptionSize) then
    begin
      // to retrieve the column width that can contain the string without
      // truncating it, you must add padding to the returned string width
      // see msdn: ListView_GetStringWidth
      // there is no way to get the needed padding size for a list view caption
      // so we take the height of the current caption text, to be DPI aware
      ListView_SetColumnWidth(ALV.Handle, AIndex, CaptionSize.cx + CaptionSize.cy);
    end
    else
      ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(ALV.Column[AIndex]).GetStoredWidth);
  end;
end;

class procedure TWin32WSCustomListView.ColumnDelete(const ALV: TCustomListView; const AIndex: Integer);
var
  hHdr, hLV: THandle;
  Count: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnDelete')
  then Exit;

  hLV := ALV.Handle;
  hHdr := GetHeader(hLV);
  if hHdr = 0 then Exit; //???

  Count := Header_GetItemCount(hHdr);
  if Count <= Aindex then Exit;

  // Move column to the last, otherwise our items get shuffeled
  if AIndex <> Count - 1 then
    ColumnMove(ALV, AIndex, Count - 1, nil);
  ListView_DeleteColumn(hLV, Count - 1);
end;

class function TWin32WSCustomListView.ColumnGetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn): Integer;
var
  lvc: TLvColumn;
begin
  Result := -1;
  // this implementation uses columnwidht = 0 for invisible
  // so fallback to default (= AColumn.FWidth)
  // Don't return AColumn.Width, this will cause a loop
  if not AColumn.Visible then Exit;

  if not WSCheckHandleAllocated(ALV, 'ColumnGetWidth')
  then Exit;

  // do not use ListView_GetColumnWidth since we can not detect errors
  lvc.Mask := LVCF_WIDTH;
  if ListView_GetColumn(ALV.Handle, AIndex, lvc) <> 0
  then Result := lvc.cx;
end;

class procedure TWin32WSCustomListView.ColumnInsert(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn);
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnInsert')
  then Exit;

  lvc.Mask := LVCF_TEXT;

  lvc.pszText := PChar(PWideChar(UTF8ToUTF16(AColumn.Caption)));
  SendMessage(ALV.Handle, LVM_INSERTCOLUMNW, WPARAM(AIndex), LPARAM(@lvc));
end;

class procedure TWin32WSCustomListView.ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn);
var
  lvc, oldlvc: TLvColumn_v4_7;
  buf, oldbuf: array[0..1024] of Char;
  Count, idx: Integer;

begin
  if not WSCheckHandleAllocated(ALV, 'ColumnMove')
  then Exit;

  Count := AOldIndex - ANewIndex;

  // Fetch old column values
  oldlvc.lvc.Mask := LVCF_FMT or LVCF_IMAGE or LVCF_TEXT or LVCF_WIDTH;
  oldlvc.lvc.pszText := @oldbuf[0];
  oldlvc.lvc.cchTextMax := SizeOF(oldbuf);
  ListView_GetColumn(ALV.Handle, AOldIndex, oldlvc.lvc);

  idx := AOldIndex;
  while Count <> 0 do
  begin
    // get next index
    if Count < 0
    then Inc(idx)
    else Dec(idx);
    // and data
    lvc.lvc.Mask := LVCF_FMT or LVCF_IMAGE or LVCF_TEXT or LVCF_WIDTH;
    lvc.lvc.pszText := @buf[0];
    lvc.lvc.cchTextMax := SizeOF(buf);
    ListView_GetColumn(ALV.Handle, idx, lvc.lvc);
    // set data
    ListView_SetColumn(ALV.Handle, ANewIndex + Count, lvc.lvc);

    if Count < 0
    then Inc(Count)
    else Dec(Count);
  end;
  // finally copy original data to new column
  ListView_SetColumn(ALV.Handle, ANewIndex, oldlvc.lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAlignment: TAlignment);
const
  JUSTIFICATION: array[TAlignment] of Integer = (
    LVCFMT_LEFT,
    LVCFMT_RIGHT,
    LVCFMT_CENTER
  );
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetAlignment')
  then Exit;

  lvc.Mask := LVCF_FMT;
  ListView_GetColumn(ALV.Handle, AIndex, lvc);
  lvc.fmt := (lvc.fmt and not LVCFMT_JUSTIFYMASK) or JUSTIFICATION[AAlignment];
  ListView_SetColumn(ALV.Handle, AIndex, lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAutoSize: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetAutoSize')
  then Exit;

  if AAutoSize
  then ColumnDoAutosize(ALV, AIndex)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(AColumn).GetStoredWidth);
end;

class procedure TWin32WSCustomListView.ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const ACaption: String);
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetCaption')
  then Exit;

  lvc.Mask := LVCF_TEXT;

  lvc.pszText := PChar(PWideChar(UTF8ToUTF16(AColumn.Caption)));
  SendMessage(ALV.Handle, LVM_SETCOLUMNW, WPARAM(AIndex), LPARAM(@lvc));
end;

class procedure TWin32WSCustomListView.ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer);
var
  lvc: TLvColumn_v4_7;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetImage')
  then Exit;

  // forst get the old lvc, since we have to tell the bloody thing that this
  // column has an image otherwise we will have a crash on XP using comctl 6

  lvc.lvc.Mask := LVCF_FMT;
  ListView_GetColumn(ALV.Handle, AIndex, lvc.lvc);

  if AImageIndex = -1
  then begin
    lvc.lvc.Mask := LVCF_FMT;
    lvc.lvc.fmt := lvc.lvc.fmt and not (LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES);
  end
  else begin
    lvc.lvc.Mask := LVCF_IMAGE or LVCF_FMT;
    lvc.lvc.fmt := lvc.lvc.fmt or LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES;
    lvc.iImage := AImageIndex;
  end;

  ListView_SetColumn(ALV.Handle, AIndex, lvc.lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMaxWidth: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetMaxWidth')
  then Exit;

  // TODO: in messageHandler
end;

class procedure TWin32WSCustomListView.ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMinWidth: integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetMinWidth')
  then Exit;

  // TODO: in messageHandler
end;

class procedure TWin32WSCustomListView.ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AWidth: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetWidth')
  then Exit;

  if AColumn.AutoSize
  then ColumnDoAutosize(ALV, AIndex)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, AWidth)
end;

class procedure TWin32WSCustomListView.ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AVisible: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetVisible')
  then Exit;

  // TODO: implement with LV_COLUMN.subitem (associate different columns and insert/delete last.

  if AVisible
  then if AColumn.AutoSize
    then ColumnDoAutosize(ALV, AIndex)
    else ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(AColumn).GetStoredWidth)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, 0);
end;

class procedure TWin32WSCustomListView.ColumnSetSortIndicator(
  const ALV: TCustomListView; const AIndex: Integer;
  const AColumn: TListColumn; const AAndicator: TSortIndicator);
var
  Hdr: HWND;
  Itm: THDITEM;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetSortIndicator')
  then Exit;

  Hdr := ListView_GetHeader(ALV.Handle);
  FillChar(itm, sizeof(itm),0);
  itm.mask := HDI_FORMAT;
  Header_GetItem(Hdr, AIndex, Itm);
  case AAndicator of
    siNone:        itm.fmt := itm.fmt and (not (HDF_SORTDOWN or HDF_SORTUP));
    siAscending:   itm.fmt := (itm.fmt or HDF_SORTUP) and (not HDF_SORTDOWN);
    siDescending:  itm.fmt := (itm.fmt or HDF_SORTDOWN) and (not HDF_SORTUP);
  end;
  Header_SetItem(Hdr, AIndex, Itm);
end;

////////////////////////////////////////////////////////////////////////////////
// Item code
////////////////////////////////////////////////////////////////////////////////

class procedure TWin32WSCustomListView.ItemDelete(const ALV: TCustomListView; const AIndex: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemDelete')
  then Exit;

  ListView_DeleteItem(ALV.Handle, AIndex);
end;

class function TWin32WSCustomListView.ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; ACode: TDisplayCode):TRect; 
const 
  DISPLAYCODES: array[TDisplayCode] of DWORD=(LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL, LVIR_SELECTBOUNDS);
var
  mes: uint;
begin
  Result := Rect(0,0,0,0);
  if not WSCheckHandleAllocated(ALV, 'ItemDisplayRect')
  then Exit;                                          
  
  if ASubItem = 0 
  then mes:=LVM_GETITEMRECT
  else begin
    mes:=LVM_GETSUBITEMRECT;
    if ACode = drSelectBounds 
    then ACode := drBounds;
  end;
  Result.top := ASubItem;
  Result.left := DISPLAYCODES[ACode];
  SendMessage(ALV.Handle, mes, AIndex, lparam(@Result));
end;

class procedure TWin32WSCustomListView.LVItemAssign(const ALV: TCustomListView;
  AItem: TListItem; const AIndex: Integer);
var
  i: Integer;
  B: Boolean;
begin
  if ALV.CheckBoxes then
    B := AItem.Checked
  else
    B := False;

  // apply texts
  ItemSetText(ALV, AIndex, AItem, 0, AItem.Caption);
  for i := 0 to AItem.SubItems.Count - 1 do
    ItemSetText(ALV, AIndex, AItem, i + 1, AItem.SubItems[i]);
  // make sure no texts are left over
  for i := AItem.SubItems.Count to ALV.ColumnCount-1 do
    ItemSetText(ALV, AIndex, AItem, i + 1, '');

  // set state image
  ItemSetStateImage(ALV, AIndex,AItem,0, AItem.StateIndex);

  // set image
  ItemSetImage(ALV, AIndex, AItem, 0, AItem.ImageIndex);

  // apply checkbox state
  ItemSetChecked(ALV, AIndex, AItem, B);
end;

class procedure TWin32WSCustomListView.ItemExchange(const ALV: TCustomListView;
  AItem: TListItem; const AIndex1, AIndex2: Integer);
var
  AItem1, AItem2: TListItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemExchange') then
    exit;

  //We have to reassign TLvItem to AIndex1 and AIndex2
  //or use RecreateWnd() which is very expensive

  AItem1 := ALV.Items[AIndex2];
  AItem2 := ALV.Items[AIndex1];

  LVItemAssign(ALV, AItem1, AIndex2);
  LVItemAssign(ALV, AItem2, AIndex1);
end;

class procedure TWin32WSCustomListView.ItemMove(const ALV: TCustomListView;
  AItem: TListItem; const AFromIndex, AToIndex: Integer);
var
  i: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemMove') then
    exit;
  if AFromIndex = AToIndex then
    exit;
  if AFromIndex > AToIndex then
  begin
    for i := AToIndex to AFromIndex do
      LVItemAssign(ALV, ALV.Items[i], i);
  end else
    for i := AFromIndex to AToIndex do
      LVItemAssign(ALV, ALV.Items[i], i);
end;

class function TWin32WSCustomListView.ItemGetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem): Boolean;
begin
  Result := False;
  if not WSCheckHandleAllocated(ALV, 'ItemGetChecked')
  then Exit;
  // shr 12 will give teh stateimage index, however a value of 
  // 0 means no image and 1 means unchecked. All other 14 are checked (?)
  // so shifting 13 will always result in something <> 0 when checked.
  Result := SendMessage(ALV.Handle, LVM_GETITEMSTATE, AIndex, LVIS_STATEIMAGEMASK) shr 13 <> 0;
end;

class function TWin32WSCustomListView.ItemGetPosition(
  const ALV: TCustomListView; const AIndex: Integer): TPoint;
begin
  Result := Point(0, 0);
  if WSCheckHandleAllocated(ALV, 'ItemGetPosition') then
    SendMessage(ALV.Handle, LVM_GETITEMPOSITION, AIndex, LPARAM(@Result));
end;

class function TWin32WSCustomListView.ItemGetState(const ALV: TCustomListView;
  const AIndex: Integer; const AItem: TListItem; const AState: TListItemState;
  out AIsSet: Boolean): Boolean;
const
  // lisCut, lisDropTarget, lisFocused, lisSelected
  FLAGS: array[TListItemState] of Integer = (LVIS_CUT, LVIS_DROPHILITED, LVIS_FOCUSED, LVIS_SELECTED);
begin
  Result := False;

  if not WSCheckHandleAllocated(ALV, 'ItemGetState')
  then Exit;

  AIsSet := 0 <> ListView_GetItemState(ALV.Handle, AIndex, FLAGS[AState]);
  Result := True;
end;

class procedure TWin32WSCustomListView.ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
var
  lvi: TLvItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemInsert')
  then Exit;

  lvi.Mask := LVIF_TEXT or LVIF_PARAM;
  lvi.iItem := AIndex;
  lvi.iSubItem := 0;
  lvi.lParam := LPARAM(AItem);

  lvi.pszText := PChar(PWideChar(UTF8ToUTF16(AItem.Caption)));
  SendMessage(ALV.Handle, LVM_INSERTITEMW, 0, LPARAM(@lvi));
end;

class procedure TWin32WSCustomListView.ItemSetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AChecked: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetChecked')
  then Exit;

  if AChecked then
    ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(2), LVIS_STATEIMAGEMASK)
  else
    ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(1), LVIS_STATEIMAGEMASK);
end;

class procedure TWin32WSCustomListView.ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer);
var
  lvi: TLvItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetImage')
  then Exit;

  lvi.Mask := LVIF_IMAGE;
  lvi.iItem := AIndex;
  lvi.iSubItem := ASubIndex;
  lvi.iImage := AImageIndex;

  ListView_SetItem(ALV.Handle, lvi);
end;

class function TWin32WSCustomListView.ItemSetPosition(const ALV: TCustomListView; const AIndex: Integer; const ANewPosition: TPoint): Boolean;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetPosition') then
    Result := False
  else
    Result := SendMessage(ALV.Handle, LVM_SETITEMPOSITION,
      AIndex, MAKELPARAM(ANewPosition.X, ANewPosition.Y)) <> 0;
end;

class procedure TWin32WSCustomListView.ItemSetStateImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AStateImageIndex: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetStateImage')
  then Exit;

  ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(AStateImageIndex + 1), LVIS_STATEIMAGEMASK);
end;

class procedure TWin32WSCustomListView.ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean);
const
  // lisCut, lisDropTarget, lisFocused, lisSelected
  FLAGS: array[TListItemState] of Integer = (LVIS_CUT, LVIS_DROPHILITED, LVIS_FOCUSED, LVIS_SELECTED);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetState')
  then Exit;
  {Don't change the state if it already has needed value}
  if ((ListView_GetItemState(ALV.Handle, AIndex, FLAGS[AState]) and FLAGS[AState]) = FLAGS[AState]) = AIsSet then exit;

  if AIsSet
  then ListView_SetItemState(ALV.Handle, AIndex, FLAGS[AState], FLAGS[AState])
  else ListView_SetItemState(ALV.Handle, AIndex, 0, FLAGS[AState]);
end;

class procedure TWin32WSCustomListView.ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex: Integer; const AText: String);
var
  _gnu_lvi : LV_ITEM;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetText')
  then Exit;

  _gnu_lvi.iSubItem := ASubIndex;
  _gnu_lvi.pszText := PChar(PWideChar(UTF8ToUTF16(AText)));

  SendMessage(ALV.Handle, LVM_SETITEMTEXTW, WPARAM(AIndex), LPARAM(@_gnu_lvi));
  // autosize is an *extreme* performance bottleneck, even if WM_SETREDRAW
  // was set to false it will ignore this and still redraw all columns.
  // We will therefore postpone all autosizing until EndUpdate where we do
  // it only once per column.

  if (ASubIndex >= 0) and (ASubIndex < ALV.ColumnCount) and ALV.Column[ASubIndex].AutoSize and (TCustomListViewAccess(ALV).GetUpdateCount = 0) then
    ColumnDoAutosize(ALV, ASubIndex);
end;

class procedure TWin32WSCustomListView.ItemShow(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const PartialOK: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemShow')
  then Exit;

  ListView_EnsureVisible(ALV.Handle, AIndex, Ord(PartialOK));
end;

////////////////////////////////////////////////////////////////////////////////
// LV code
////////////////////////////////////////////////////////////////////////////////

procedure ListViewDrawItem(const AWinControl: TWinControl; Window: HWnd;
  Msg: UInt; WParam: Windows.WParam; const DrawIS: TDrawItemStruct;
  var ItemMsg: Integer; var DrawListItem: Boolean);
begin
  DrawListItem := (AWinControl <> nil) and (AWinControl is TListView) and
      (TListView(AWinControl).ViewStyle = vsReport) and
      (DrawIS.ctlType = ODT_LISTVIEW) and
      (TListView(AWinControl).OwnerDraw);
  ItemMsg := CN_DRAWITEM;
end;

function ListViewProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
    LParam: Windows.LParam): LResult; stdcall;
var
  WindowInfo: PWin32WindowInfo;
  ListItem: TListItem;
  ListView: TListView;
  AMsg: UINT;
begin
  case Msg of
    WM_LBUTTONDOWN, WM_RBUTTONDOWN:
      begin
        // A ListView doesn't get a WM_LBUTTONUP, WM_RBUTTONUP message,
        // because it keeps the message in its own event loop,
        // see msdn article about "Default List-View Message Processing"
        // therefore we take this notification and create a
        // LM_LBUTTONUP, LM_RBUTTONUP message out of it

        WindowInfo := GetWin32WindowInfo(Window);
        ListView := TListView(WindowInfo^.WinControl);
        ListItem := ListView.GetItemAt(WindowInfo^.MouseX, WindowInfo^.MouseY);

        if Msg = WM_LBUTTONDOWN
        then AMsg := LM_LBUTTONUP
        else AMsg := LM_RBUTTONUP;

        // for multiselected listbox the message has to be send after current
        // message or the list item selecting does not work, also see issue #33330
        if not Assigned(ListItem) and (ListView.SelCount>1) then
        begin
          Result := WindowProc(Window, Msg, WParam, LParam);
          if not (Msg = WM_LBUTTONDBLCLK) and ((Msg = WM_LBUTTONDOWN) or not Assigned(ListView.PopupMenu)) then
            PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY));
          Exit;
        end;

        if Assigned(ListItem) then
          if (ListView.SelCount<=1) or (Msg=WM_RBUTTONDOWN) then
            PostMessage(Window, AMsg, 0, MakeLParam(WindowInfo^.MouseX, WindowInfo^.MouseY))
        else
          if Assigned(ListView.OnMouseDown) then
            ListView.OnMouseDown(ListView,mbLeft,KeyboardStateToShiftState,WindowInfo^.MouseX, WindowInfo^.MouseY);
      end;
  end;
  Result := WindowProc(Window, Msg, WParam, LParam);
end;

class function TWin32WSCustomListView.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): HWND;
const
  LISTVIEWSTYLES: array[TViewStyle] of DWORD = (LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT);
  Arrangement: array[TIconArrangement] of DWord = (LVS_ALIGNTOP, LVS_ALIGNLEFT);
var
  Params: TCreateWindowExParams;
begin
  // general initialization of Params
  PrepareCreateWindow(AWinControl, AParams, Params);
  // customization of Params
  with Params do
  begin
    pClassName := WC_LISTVIEW;
    SubClassWndProc := @ListViewProc;
    WindowTitle := StrCaption;
    Flags := Flags or LISTVIEWSTYLES[TListView(AWinControl).ViewStyle] or
      LVS_SINGLESEL or LVS_SHAREIMAGELISTS or
      Arrangement[TListView(AWinControl).IconOptions.Arrangement];
    if TCustomListView(AWinControl).OwnerData then 
      Flags := Flags or LVS_OWNERDATA;
    if TListView(AWinControl).OwnerDraw then
      Flags := Flags or LVS_OWNERDRAWFIXED;
    if TCustomListView(AWinControl).BorderStyle = bsSingle then
      FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
  end;
  // create window
  FinishCreateWindow(AWinControl, Params, false);
  Params.WindowInfo^.ParentMsgHandler := @ListViewParentMsgHandler;
  Params.WindowInfo^.needParentPaint := false;
  Params.WindowInfo^.DrawItemHandler := @ListViewDrawItem;
  Result := Params.Window;
  if TCustomListView(AWinControl).checkboxes
    then UpdateExStyle(result,lvs_ex_SubitemImages or lvs_Ex_Checkboxes,lvs_ex_SubitemImages or lvs_Ex_Checkboxes) else
  UpdateExStyle(Result, LVS_EX_SUBITEMIMAGES, LVS_EX_SUBITEMIMAGES);
end;

class procedure TWin32WSCustomListView.BeginUpdate(const ALV: TCustomListView);
begin
  if not WSCheckHandleAllocated(ALV, 'BeginUpdate')
  then Exit;

  SendMessage(ALV.Handle,WM_SETREDRAW,WPARAM(False),0);
end;

class procedure TWin32WSCustomListView.EndUpdate(const ALV: TCustomListView);
var
  ColIndex : Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'EndUpdate')
  then Exit;

  // we have skipped all column resizing in ItemSetText()
  // for performance reasons, so now we need to do it here.
  //
  // A further significant perfomance boost and reduced flickering
  // can be achieved by setting the widget to invisible during the
  // following operation (it ignores the state of WM_SETREDRAW for
  // column resizing, but this way we we can really enforce it).
  // ShowWindow() itself does not force an immediate redraw,
  // so it won't flicker at all.
  ShowWindow(ALV.Handle, SW_HIDE);
  for ColIndex := 0 to TCustomListViewAccess(ALV).Columns.Count - 1 do
    if ALV.Column[ColIndex].AutoSize
    then ColumnDoAutosize(ALV, ColIndex);

  SendMessage(ALV.Handle,WM_SETREDRAW,WPARAM(True),0);
  if ALV.Visible then
    ShowWindow(ALV.Handle, SW_SHOW);
end;

class function TWin32WSCustomListView.GetBoundingRect(const ALV: TCustomListView): TRect;
begin
  Result := Rect(0,0,0,0); 
  if not WSCheckHandleAllocated(ALV, 'GetBoundingRect')
  then Exit;

  ListView_GetViewRect(ALV.Handle, Result);
end;

class function TWin32WSCustomListView.GetDropTarget(const ALV: TCustomListView): Integer;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetDropTarget')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_DROPHILITED);
end;

class function TWin32WSCustomListView.GetFocused(const ALV: TCustomListView): Integer;
begin       
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetFocused')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_FOCUSED);
end;

class function TWin32WSCustomListView.GetHitTestInfoAt( const ALV: TCustomListView; X, Y: Integer ) : THitTests;
var
  HitInfo: LV_HITTESTINFO;

begin
  Result := [];
  if not WSCheckHandleAllocated(ALV, 'GetHitTestInfoAt')
  then Exit;

  with HitInfo do
  begin
    pt.X := X;
    pt.Y := Y;
    ListView_HitTest( ALV.Handle, HitInfo );

    if ((flags and LVHT_ABOVE) <> 0) and (Y < 0) then
      Include(Result, htAbove);

    if (flags and LVHT_BELOW) <> 0 then
      Include(Result, htBelow);

    if (flags and LVHT_NOWHERE) <> 0 then
      Include(Result, ComCtrls.htNowhere);

    if (flags and LVHT_ONITEM) = LVHT_ONITEM then
      Include(Result, htOnItem)

    else
      begin
      if (flags and LVHT_ONITEMICON) <> 0 then
        Include(Result, htOnIcon);

      if (flags and LVHT_ONITEMLABEL) <> 0 then
        Include(Result, htOnLabel);

      if (flags and LVHT_ONITEMSTATEICON) <> 0 then
        Include(Result, htOnStateIcon);

      end;

    if (flags and LVHT_TOLEFT) <> 0 then
      Include(Result, htToLeft);

    if (flags and LVHT_TORIGHT) <> 0 then
      Include(Result, htToRight);

  end;
end;

class function TWin32WSCustomListView.GetHoverTime(const ALV: TCustomListView): Integer;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetHoverTime')
  then Exit;

  Result := SendMessage(ALV.Handle, LVM_GETHOVERTIME, 0, 0);
end;

class function TWin32WSCustomListView.GetItemAt(const ALV: TCustomListView; x,
  y: Integer): Integer;
var 
  HitInfo: LV_HITTESTINFO;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetItemAt')
  then Exit;

  HitInfo.pt.x:=x;
  HitInfo.pt.y:=y;
  ListView_HitTest(alv.Handle,HitInfo);
  if HitInfo.flags <> LVHT_NOWHERE 
  then Result:=HitInfo.iItem;
end;

class function TWin32WSCustomListView.GetSelCount(const ALV: TCustomListView): Integer;
begin
  Result := 0;
  if not WSCheckHandleAllocated(ALV, 'GetSelCount')
  then Exit;

  Result := ListView_GetSelectedCount(ALV.Handle);
end;

class function TWin32WSCustomListView.GetSelection(const ALV: TCustomListView): Integer;
begin
  Result := -1;
  if not WSCheckHandleAllocated(ALV, 'GetSelection')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_SELECTED);
end;

class function TWin32WSCustomListView.GetTopItem(const ALV: TCustomListView): Integer;
begin
  Result := -1;
  if not WSCheckHandleAllocated(ALV, 'GetTopItem')
  then Exit;

  case GetWindowLong(ALV.Handle, GWL_STYLE) and LVS_TYPEMASK of
    LVS_LIST,
    LVS_REPORT: Result := ListView_GetTopIndex(ALV.Handle);
  else
    Result := -1;
  end;
end;

class function TWin32WSCustomListView.GetViewOrigin(const ALV: TCustomListView): TPoint;
begin
  if not WSCheckHandleAllocated(ALV, 'GetViewOrigin')
  then begin
    Result := Point(0, 0);
    Exit;
  end;

  ListView_GetOrigin(ALV.Handle, Result);
end;

class function TWin32WSCustomListView.GetVisibleRowCount(const ALV: TCustomListView): Integer;
begin
  Result := 0;
  if not WSCheckHandleAllocated(ALV, 'GetVisibleRowCount')
  then Exit;

  case GetWindowLong(ALV.Handle, GWL_STYLE) and LVS_TYPEMASK of
    LVS_LIST,
    LVS_REPORT: Result := ListView_GetCountPerPage(ALV.Handle);
  else
    Result := -1;
  end;
end;

class procedure TWin32WSCustomListView.SelectAll(const ALV: TCustomListView;
  const AIsSet: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'SelectAll') then
    exit;
  // Index param -1 means select all.
  if AIsSet then
    ListView_SetItemState(ALV.Handle, -1, LVIS_SELECTED, LVIS_SELECTED)
  else
    ListView_SetItemState(ALV.Handle, -1, 0, LVIS_SELECTED);
end;

class function TWin32WSCustomListView.GetHeader(const AHandle: THandle): THandle;
begin
  Result := THandle(SendMessage(AHandle, LVM_GETHEADER, 0, 0));
  if Result <> 0 then Exit;

  // probably old version, try the first child
  Result := GetWindow(AHandle, GW_CHILD);
end;

// MWE: original from MS knowledgebase KB137520
(********************************************************************
    PositionHeader

    Call this function when the ListView is created, resized, the
    view is changed, or a WM_SYSPARAMETERCHANGE message is received.

 ********************************************************************)
class procedure TWin32WSCustomListView.PositionHeader(const AHandle: THandle);
var
  hwndHeader: HWND;
  dwStyle: PtrInt;
  rc: TRect;
  hdLayout: THDLAYOUT;
  wpos: Windows.TWINDOWPOS;
begin
  dwStyle := GetWindowLong(AHandle, GWL_STYLE);

  if dwStyle and LVS_NOSCROLL = 0 then Exit; // nothing to do
  if dwStyle and LVS_REPORT = 0 then Exit;   // nothing to do

  hwndHeader := GetHeader(AHandle);
  if hwndHeader = 0 then Exit; // nothing to do

  Windows.GetClientRect(AHandle, rc);
  FillChar(hdLayout, SizeOf(hdLayout), 0);
  hdLayout.prc := @rc;
  hdLayout.pwpos := @wpos;
  Header_Layout(hwndHeader, hdLayout);

  Windows.SetWindowPos(hwndHeader,
                       wpos.hwndInsertAfter,
                       wpos.x,
                       wpos.y,
                       wpos.cx,
                       wpos.cy,
                       wpos.flags or SWP_SHOWWINDOW);

  ListView_EnsureVisible(AHandle, 0, 0);
end;

class procedure TWin32WSCustomListView.SetAllocBy(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetAllocBy')
  then Exit;

  ListView_SetItemCount(ALV.Handle, AValue);
end;

class procedure TWin32WSCustomListView.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
  if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetBorder') then
    Exit;
  // changing border style by changing EXSTYLE here does not work correctly
  RecreateWnd(AWinControl);
end;

class procedure TWin32WSCustomListView.SetColor(const AWinControl: TWinControl);
var
  Color: TColor;
begin
  if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetColor') then
    Exit;
  Color := AWinControl.Color;
  if Color = clDefault then
    Color := AWinControl.GetDefaultColor(dctBrush);
  Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color));
  Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end;

class procedure TWin32WSCustomListView.SetDefaultItemHeight(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetDefaultItemHeight')
  then Exit;

  // TODO ???
end;

class procedure TWin32WSCustomListView.SetFont(const AWinControl: TWinControl; const AFont: TFont);
var
  Color: TColor;
begin
  // call inherited SetFont; need to do it this way,
  // because the compile time ancestor class is TWSCustomListView
  TWSWinControlClass(ClassParent).SetFont(AWinControl, AFont);
  Color := AFont.Color;
  if Color = clDefault then
   Color := AWinControl.GetDefaultColor(dctFont);
  Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTCOLOR, 0, ColorToRGB(Color));
end;

class procedure TWin32WSCustomListView.SetHotTrackStyles(const ALV: TCustomListView; const AValue: TListHotTrackStyles);
const
  MASK = LVS_EX_ONECLICKACTIVATE or LVS_EX_TWOCLICKACTIVATE or LVS_EX_UNDERLINEHOT or LVS_EX_UNDERLINECOLD;
var
  Style: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'SetHotTrackStyles')
  then Exit;

  if htHandPoint in AValue
  then Style := LVS_EX_ONECLICKACTIVATE
  else if [htUnderlineHot, htUnderlineCold] * AValue <> []
  then Style := LVS_EX_TWOCLICKACTIVATE
  else Style := 0;

  if htUnderlineHot in AValue
  then Style := Style or LVS_EX_UNDERLINEHOT;

  if htUnderlineCold in AValue
  then Style := Style or LVS_EX_UNDERLINECOLD;

  UpdateExStyle(ALV.Handle, MASK, Style);
end;

class procedure TWin32WSCustomListView.SetHoverTime(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetHoverTime')
  then Exit;

  SendMessage(ALV.Handle, LVM_SETHOVERTIME, 0, AValue);
end;

class procedure TWin32WSCustomListView.SetIconArrangement(
  const ALV: TCustomListView; const AValue: TIconArrangement);
const
  ArrangementMap: array[TIconArrangement] of DWord = (
    { iaTop  } LVS_ALIGNTOP,
    { iaLeft } LVS_ALIGNLEFT
  );
begin
  if not WSCheckHandleAllocated(ALV, 'SetIconArrangement')
  then Exit;

  // LVM_ALIGN styles are not implemented in windows (according to w7 sdk) => change style
  UpdateStyle(ALV.Handle, LVS_ALIGNMASK, ArrangementMap[AValue]);
end;

class procedure TWin32WSCustomListView.SetImageList(const ALV: TCustomListView;
  const AList: TListViewImageList; const AValue: TCustomImageListResolution);
const
  LIST_MAP: array[TListViewImageList] of WPARAM = (
   {lvilSmall} LVSIL_SMALL,
   {lvilLarge} LVSIL_NORMAL,
   {lvilState} LVSIL_STATE
  );
begin
  if not WSCheckHandleAllocated(ALV, 'SetImageList')
  then Exit;

  if AValue <> nil then
    SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], AValue.Reference._Handle)
  else
    SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], 0);
end;

class procedure TWin32WSCustomListView.SetItemsCount(const ALV: TCustomListView; const AValue: Integer); 
begin
  if not WSCheckHandleAllocated(ALV, 'SetItemsCount')
  then Exit;
  SendMessage(ALV.Handle, LVM_SETITEMCOUNT, AValue, 0);
end;

class procedure TWin32WSCustomListView.SetOwnerData(const ALV: TCustomListView; const AValue: Boolean); 
begin
  if not WSCheckHandleAllocated(ALV, 'SetOwnerData')
  then Exit;
  RecreateWnd(ALV);
end;

class procedure TWin32WSCustomListView.SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'SetProperty')
  then Exit;

  case LV_STYLES[AProp].StyleType of
    lsStyle: begin
      if AIsSet
      then UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style)
      else UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0);
    end;
    lsInvert:
    begin
      // we are always using readonly on ws since ListView_GetEditControl
      // requires minimum windows 2000. Editing is implemented in LCL atm,
      // can be changed later to use ws for item editing.
      // http://msdn.microsoft.com/en-us/library/windows/desktop/bb761260%28v=vs.85%29.aspx
      if (AProp = lvpReadOnly) then
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0)
      else
      if AIsSet then
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0)
      else
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style);
    end;
    lsExStyle: begin
      if AIsSet
      then UpdateExStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style)
      else UpdateExStyle(ALV.Handle, LV_STYLES[AProp].Style, 0);
    end;
  end;
  if(aProp=lvpCheckboxes)and aIsSet
    then ReCreateWnd(ALV)
end;

class procedure TWin32WSCustomListView.SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties);
var
  Prop: TListViewProperty;
  Style, ExStyle, Mask, ExMask: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'SetProperties')
  then Exit;

  Style := 0;
  ExStyle := 0;
  Mask := 0;
  ExMask := 0;

  for Prop := Low(Prop) to High(Prop) do
  begin
    case LV_STYLES[Prop].StyleType of
      lsStyle,
      lsInvert:
      begin
        // we are always using readonly on ws since ListView_GetEditControl
        // requires minimum windows 2000. Editing is implemented in LCL atm,
        // can be changed later to use ws for item editing.
        // http://msdn.microsoft.com/en-us/library/windows/desktop/bb761260%28v=vs.85%29.aspx
        if Prop = lvpReadOnly then
          UpdateStyle(ALV.Handle, LVS_EDITLABELS, 0)
        else
        begin
          Mask := Mask or LV_STYLES[Prop].Style;
          if (LV_STYLES[Prop].StyleType = lsStyle) = (Prop in AProps)
          then Style := Style or LV_STYLES[Prop].Style
          else Style := Style and not LV_STYLES[Prop].Style;
        end;
      end;
      lsExStyle: begin
        ExMask := ExMask or LV_STYLES[Prop].Style;

        if Prop in AProps
        then ExStyle := ExStyle or LV_STYLES[Prop].Style
        else ExStyle := ExStyle and not LV_STYLES[Prop].Style;
      end;
    end;
  end;

  if Mask <> 0
  then UpdateStyle(ALV.Handle, Mask, Style);
  if ExMask <> 0
  then UpdateExStyle(ALV.Handle, ExMask, ExStyle);
end;

class procedure TWin32WSCustomListView.SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle);
begin
  if not WSCheckHandleAllocated(ALV, 'SetScrollBars')
  then Exit;

  // we only can hide all scrollbars.
  if AValue = ssNone
  then UpdateStyle(ALV.Handle, LVS_NOSCROLL, LVS_NOSCROLL)
  else UpdateStyle(ALV.Handle, LVS_NOSCROLL, 0);
end;

function ListCompare(lParam1, lParam2: LParam; lParamSort: LParam): Integer; stdcall;
var
  Item1: TListItem absolute lParam1;
  Item2: TListItem absolute lParam2;
begin
  Result := CompareValue(Item1.Index, Item2.Index);
end;

class procedure TWin32WSCustomListView.SetSort(const ALV: TCustomListView;
  const AType: TSortType; const AColumn: Integer; const ASortDirection: TSortDirection);
begin
  if not WSCheckHandleAllocated(ALV, 'SetSort')
  then Exit;
  ListView_SortItems(ALV.Handle, @ListCompare, Windows.MAKELPARAM(Ord(AType), AColumn));
end;

class procedure TWin32WSCustomListView.SetViewOrigin(const ALV: TCustomListView; const AValue: TPoint);
var
  dx, dy: Integer;
  Origin: TPoint;
begin
  if not WSCheckHandleAllocated(ALV, 'SetViewOrigin')
  then Exit;

  ListView_GetOrigin(ALV.Handle, Origin);

  dx := AValue.X - Origin.X;
  dy := AValue.Y - Origin.Y;
  if (dx <> 0) or (dy <> 0)
  then ListView_Scroll(ALV.Handle, dx, dy);
end;

class procedure TWin32WSCustomListView.SetViewStyle(const ALV: TCustomListView; const Avalue: TViewStyle);
const
  //vsIcon, vsSmallIcon, vsList, vsReport
  STYLES: array[TViewStyle] of DWORD = (LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT);
begin
  if not WSCheckHandleAllocated(ALV, 'SetViewStyle')
  then Exit;

  UpdateStyle(ALV.Handle, LVS_TYPEMASK, STYLES[AValue]);
end;

class procedure TWin32WSCustomListView.UpdateStyle(const AHandle: THandle; const AMask, AStyle: Integer);
var
  OldStyle, NewStyle: PtrInt;
begin
  OldStyle := GetWindowLong(AHandle, GWL_STYLE);

  NewStyle := (OldStyle and not AMask) or AStyle;

  if OldStyle = NewStyle then Exit;

  SetWindowLong(AHandle, GWL_STYLE, NewStyle);

  // fix header if needed
  if (NewStyle and LVS_NOSCROLL)<> 0 then begin
    if (OldStyle and LVS_NOSCROLL = 0)
    or (NewStyle and LVS_REPORT <> 0)
    then PositionHeader(AHandle);
  end;

  //Invalidate Listview, so that changes are made visible
  Windows.InvalidateRect(AHandle, nil, true);
end;

class procedure TWin32WSCustomListView.UpdateExStyle(const AHandle: THandle; const AMask, AStyle: Integer);
var
  OldStyle, NewStyle: Integer;
begin
  OldStyle := SendMessage(AHandle, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0);

  NewStyle := (OldStyle and not AMask) or AStyle;

  if OldStyle = NewStyle then Exit;

  SendMessage(AHandle, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, NewStyle);

 //Invalidate Listview, so that changes are made visible
  Windows.InvalidateRect(AHandle, nil, true);
end;


win32wscustomlistview.inc (48,116 bytes)   

Martin Friebe

2020-04-06 13:59

manager   ~0121962

@nanobit:
Why should mouse-up not happen for the empty area?

This complicates matters, as mouse-up releases the MouseCapture

nanobit

2020-04-06 14:32

reporter   ~0121964

When I tested, I saw two onMouseUps:
First one on mouse pressed (I meant this), and second one on mouse released (this is Ok).
I think, we should not generate WM_LBUTTONUP if mouseButton is down.
Earlier listview-versions used as up-state detection (probably determined by trial) this condition:
if assigned(ListItem) or ListView.MultiSelect then generate WM_LBUTTONUP

Martin Friebe

2020-04-06 15:24

manager   ~0121969

The problem is, that then it may not be possible to send the mousedown early (i.e. instead send it when the mouse is released.)
(you can test this, by omitting my last git commit)

If DragMode=auto ...
The LCL will set "MouseCapture=listview" during mousedown.
This needs to be unset. Otherwise all further mouse actions go to the listview, instead of to whatever the user attempts to click/interact.
MouseCapture is released in MouseUp.

It also gets released, if Windows itself changes it.... And that happens (with the early click) => so the code now restores the capture....

I am not sure, why capture did not go wrong in the old code (before the fix).... Something must have released it, or it was never set.
But that may just have been hiding bugs...

User-code may also set the mouse capture (instead of dragmanager). And such user code often also requires a mouse up.

---------------------------
If the mouse up is duplicated, then that needs to be addressed.

And that needs to be tested with diff versions of Windows too. (Hence it may be a while till this patch can be applied).
There needs to be a complete and concise list of tests, that can be easily performed. Or better automatically executed (MouseAndKeyInput to simulate)

The alternative is, to keep the mousedown deferred.

I have not tested, but it could be that current code defers the mousedown only in certain cases (autodrag=true), because it is deemend not needed otherwise.
But if that is the case (not tested), it may generate an immediate mouse up, even if the mouse is still down.
And would also interfere massively with usercode MouseCapture.

Martin Friebe

2020-04-06 15:32

manager   ~0121970

Last edited: 2020-04-06 15:34

View 2 revisions

The current code may need more checks.
It appears to work with dragmanages MouseCapture.
But user code mousecapture can follow different patterns.

Maybe we need to add a hook in the LCL MouseCapture property. So changes there can be detected, and handled different from the OS generated ones....

Martin Friebe

2020-04-06 16:27

manager   ~0121974

Also needs test for correct shift state on each event.

And maybe key up/down (shift/ctrl) message while button is down?

nanobit

2020-04-07 15:54

reporter   ~0122002

The wrong onMouseUp could be removed with
if Assigned(ListItem) or ListView.MultiSelect
then Result := WindowProcEx(Window, Msg, WParam, LParam, [wpfLclBeforeWin])
else Result := WindowProc(Window, Msg, WParam, LParam);

As far as I'm concerned (due to time reasons), deferred onMouseDown is ok too.
AFAIR, Delphi had similar delays with onMouseDown.

nanobit

2020-04-07 16:53

reporter   ~0122006

Noticed something in most versions: NM_SETFOCUS can occur instead of NM_CLICK:
if multiselect and dmAutomatic and unfocused and click_on_emptyArea.
Someone else found this too: [TListView Multiselect and dmAutomatic DragMode](https://forum.lazarus.freepascal.org/index.php?topic=37417.0)
Solution: Accept also NM_SETFOCUS for sending WM_LBUTTONUP

Rolf Wetjen

2020-04-09 10:06

reporter   ~0122041

nanobit, Martin
I remember and old bug report 0033313 where I created a patch to implement a workaround for a MS error in the implementation of the combobox control. What we have here is something similar: Is it a good idea to add workarounds for an "unlucky" MS implementation? I'm sure it's not as doing so will result in a dependency on the MS windows version. MS may change the implementation and any workaround this way must be tested again.
I see two possible ways:
1. Implement it as it is done in Delphi (I assume this is the Lazarus 1.8.4 implementation) . Delphi compatible and independent from MS windows version. Or
2. Try an implementation without any impact to the MS windows level of the control: At least no extra messages to the control to get something in the LCL working. Not Delphi compatible but independent from MS windows version.
Rolf

nanobit

2020-04-09 14:12

reporter   ~0122042

Rolf, I tried some lightweight solution (0035917).
Changed only two files: win32wscustomlistview.inc (ListViewProc(), ListViewParentMsgHandler()),
and win32proc.pp (TWin32WindowInfo.LastLVNMsg).
Tries not to use assumptions about listview undocumented specifics:
Does not query for multiselect or hit items, and does not need postmessage(),
So far I found only the deferred OnMouseDown issue, which is ok for me.
Not perfect, but I find this better than previous solutions.

Martin Friebe

2020-04-09 14:41

manager   ~0122043

I have not yet had time to fully test either solution. Fully tests means:
- Test with different version of Windows
- Test for event order, timing, shift-keys (never mind which timing is implemented in the end)
- Test dragging
- Test for left and right button
- Test mouse over item, or over empty space (either up/down or both) / test mouse up outside control, or outside form. (mousecapture)
- Test context menu (related issue)
- Test other related issues, not covered by above list.
- Test all of this with different settings, e.g. multi-select on/off - Autodrag - popup menu present/absent - ....

I know this is a lot to test. But since we already have so many issues, and some previous patches just created new issues .....
The solution will IMHO need an automated testcase. (Simulates mouse clicks, and checks results.

Unfortunately this is not something I can start on immediately.

Rolf Wetjen

2020-04-11 08:36

reporter   ~0122067

Last edited: 2020-04-11 08:48

View 2 revisions

Martin,
the amount of tests you mentioned shows that this is a large and complex change. Why isn't it possible to return to the Lazarus 1.8.4 implementation? This a an already tested implementation. Probably even without a deferred OnMouseDown (only in case of SelCount>1) and a few changes to the documentation. Or a direct call to the OnMouseDown event procedure before the modal loop starts. I think both is an easy change.
Rolf

I forgot to mention that the 1.8.4 implementation solves https://bugs.freepascal.org/view.php?id=35917 too.

nanobit

2020-04-11 09:36

reporter   ~0122068

Last edited: 2020-04-11 10:23

View 3 revisions

@Rolf: If you test the 1.8.4 implementation, it has the deferred OnMouseDown
like all versions with WindowProc(), plus some other issues.
And it has postmessage() which is indeterministic (other messages, mouse-states,
capture-states) could interfere before LCL handling of posted LM_ButtonUp)
I agree though that even 1.8.4 is better than current Listview release version.

@Martin: News: The wrong OnMouseUp with WindowProcEx() was only
in the complete test from github, but does not happen in my test (0035917).

Rolf Wetjen

2020-04-12 09:08

reporter   ~0122092

Martin, nanobit,
I suggest to modify the 1.8.4 implementation (and I would do if you agree to this way):
Use the WindowProc of the ListView to call ListView.OnMouseDown directly (without post message) before entering the modal message loop. So, the OnMouseDown is in time and has the right mouse states.
Rolf

Martin Friebe

2020-04-17 17:44

manager   ~0122201

Last edited: 2020-04-18 02:26

View 5 revisions

Just an update, while working on it.
Found a few issues with the patch:
- Doubleclick no longer works / 2nd click comes as normal click (right mouse misses shift=ssDouble)
  STRIKE OUT: dbl click was a timing issue in the test only.
- Click on the empty space below items: no longer reports OnClick, OnMouseUp (MultiSelect = True) (same for right mouse)
- A click (after mouse up) on multiselect empty-space (rubber band) starts a drag (with the mouse button up)

Still testing.

Testcase: https://github.com/User4martin/lazarus/compare/f-test-listview
https://github.com/User4martin/lazarus/compare/f-test-listview.diff

They try to reflect the current situation.
- The drag several selected item, needs to be enabled
- the present of an incorrect OnClick, during dragging needs to be adjusted (ideally fixed, but it is broken already / if need: separate issue)

Martin Friebe

2020-04-18 21:50

manager   ~0122233

Last edited: 2020-04-18 21:58

View 2 revisions

Please test with revision 63012.
Please if possible also run the testcase (test/runtestgui.lpi), only run the lcl/listview tests.
(Note: Do not move your mouse, once the test case runs)

This fix keeps the delayed OnMouseDown.

If any further issues exists, please also test with/without Manifest (project options)

This issue was set to platform "Windows". I did note that as widgetset win32 and GTK2 where selected. This issue is fixed for Windows. Should it exist on GTK, please file a separate report.

------------------------------
The following issues are known (and can be reported as separate issues)

1) Dragging an item and dropping it on itself will cause an OnClick event. Dragging should not do that.
This appears to be a general lcl issues, affecting many controls.

2) Because windows delays the mouse down, in such cases dragging is affected as follows:
- Mouse down on point x,y
- LCL sees message, when windows detects dragging (about 4 or 5 pixel)
- While the mouse down has (should have) the correct/original coordinates, the dragmanager detects the coordinates at 4 pixel moved.
- Listview does (intentional / Delphi compatible, according to our svn log) start dragging with a threshold.
- This threshold is calculated from the coordinates captured by dragmanager.
* This means that in Multiselect, with a default threshold of 5, the user must move 9 or 10 pixel to start dragging.


Furthermore the testcase runs fine on Win 10 and XP.
On Vista (in virtual machine), there are minor issues. But they may be a problem of the testcase. I have not followed this up (if anyone wants to, go ahead)
- Without manifest: the left click test, misses one double-click - this is instead reported as 2 single clicks
- With manifest, one of the clicks with ctrl key, received a spurious mouse move.

Rolf Wetjen

2020-04-24 20:00

reporter   ~0122389

Hi Martin, nanobit,
sorry, I was a little bit short on time the last days but I continued to look for an improved version of win32wscustomlistview.inc. Attached my result. It's basically the 1.8.4 implementation with very few additional changes. The ListViewParentMsgHandler and ListViewProc are changed, nothing else. It solves 0035362 (this one), 0035917 and 0033330. All OnMouseDown and OnMouseUp events are in time of the physical events. No duplicate events. The 1.8.4 message sequence is not changed (no additional Send/PostMessage calls, nothing deleted). So, if 1.8.4 works this implementation should work too.
There's one point where I'm in doubt: The MS implementation generates two WM_CONTEXTMENU messages if the ListView has MultiSelect=false and PopupMenu=nil and you right click outside of the items area. The first one is in immediate response to WM_RBUTTONDOWN and the modal message loop which ends at once and the second one is generated later (in time of the physical event) in response to WM_RBUTTONUP. I've suppressed the first one. This works fine but as I mentioned before it may be not a good idea to implement workarounds for MS issues. Anyway, it's easy to suppress this message or to allow it.
I'd like if you can have a look to the attached version of win32wscustomlistview.inc and any comment is very welcome.
I've also attached a small test project.
Rolf
win32wscustomlistview-2.inc (51,014 bytes)   
{%MainUnit win32wscomctrls.pp}
{ $Id: win32wscustomlistview.inc 62567 2020-01-17 01:49:23Z dmitry $

 *****************************************************************************
  This file is part of the Lazarus Component Library (LCL)

  See the file COPYING.modifiedLGPL.txt, included in this distribution,
  for details about the license.
 *****************************************************************************
}

{ TWin32WSCustomListView }

type
  TLVStyleType = (lsStyle, lsInvert, lsExStyle);

const
  LV_STYLES: array[TListViewProperty] of record
    StyleType: TLVStyleType;
    Style: Integer;
  end = (
    (StyleType: lsStyle;   Style: LVS_AUTOARRANGE),        // lvpAutoArrange
    (StyleType: lsExStyle; Style: LVS_EX_CHECKBOXES),      // lvpCheckboxes
    (StyleType: lsInvert;  Style: LVS_NOSORTHEADER),       // lvpColumnClick
    (StyleType: lsExStyle; Style: LVS_EX_FLATSB),          // lvpFlatScrollBars
    (StyleType: lsExStyle; Style: LVS_EX_HEADERDRAGDROP),  // lvpFullDrag
    (StyleType: lsExStyle; Style: LVS_EX_GRIDLINES),       // lvpGridLines
    (StyleType: lsInvert;  Style: LVS_SHOWSELALWAYS),      // lvpHideSelection
    (StyleType: lsExStyle; Style: LVS_EX_TRACKSELECT),     // lvpHotTrack
    (StyleType: lsInvert;  Style: LVS_SINGLESEL),          // lvpMultiSelect
    (StyleType: lsStyle;   Style: LVS_OWNERDRAWFIXED),     // lvpOwnerDraw
    (StyleType: lsInvert;  Style: LVS_EDITLABELS),         // lvpReadOnly,
    (StyleType: lsExStyle; Style: LVS_EX_FULLROWSELECT),   // lvpRowSelect
    (StyleType: lsInvert;  Style: LVS_NOCOLUMNHEADER),     // lvpShowColumnHeaders
    (StyleType: lsExStyle; Style: LVS_EX_MULTIWORKAREAS),  // lvpShowWorkAreas
    (StyleType: lsInvert;  Style: LVS_NOLABELWRAP),        // lvpWrapText
    (StyleType: lsExStyle; Style: LVS_EX_LABELTIP)         // lvpToolTips
  );


type
  // TODO: add iImage and iOrder to exiting TLvColumn
  // this is a hack !!!
  TLvColumn_v4_7 = record
    lvc: TLvColumn;
    iImage: Integer;
    iOrder: Integer;
  end;


type
  TCustomListViewAccess = class(TCustomListView);
  TListColumnAccess = class(TListColumn);

////////////////////////////////////////////////////////////////////////////////
// Msg handlers
////////////////////////////////////////////////////////////////////////////////

function ListViewParentMsgHandler(const AWinControl: TWinControl; Window: HWnd;
      Msg: UInt; WParam: Windows.WParam; LParam: Windows.LParam;
      var MsgResult: Windows.LResult; var WinProcess: Boolean): Boolean;

type
  PNMLVOwnerData = PLVDISPINFO;
var
  NMHdr: PNMHdr absolute LParam; // used by WM_NOTIFY

  // Gets the cursor position relative to a given window
  function GetClientCursorPos(ClientWindow: HWND) : TSmallPoint;
  var
    P: TPoint;
  begin
    Windows.GetCursorPos(P);
    //if the mouse is not over the window is better to set to 0 to avoid weird behaviors
    if Windows.WindowFromPoint(P) = ClientWindow then
      Windows.ScreenToClient(ClientWindow, P)
    else
    begin
      P.X:=0;
      P.Y:=0;
    end;
    Result := Windows.PointToSmallPoint(P);
  end;

  procedure HandleListViewOwnerData(ALV: TCustomListViewAccess);
  var
    DataInfo: PNMLVOwnerData; // absolute NMHdr;
    txt: String;
    LVInfo: PWin32WindowInfo;
    idx: Integer;
    listitem: TListItem;
  begin
    LVInfo:= GetWin32WindowInfo(ALV.Handle);
    DataInfo := PNMLVOwnerData(NMHdr);
    if not Assigned(DataInfo) or (not ALV.OwnerData) then
      Exit;
    listitem := ALV.Items[DataInfo^.item.iItem];
    if not Assigned(listitem) then
      Exit;
    if (DataInfo^.item.mask and LVIF_TEXT) <> 0 then
    begin
      if DataInfo^.item.iSubItem = 0 then
        txt := listitem.Caption
      else
      begin
        idx := DataInfo^.item.iSubItem - 1;
        if idx < listitem.SubItems.Count then
          txt := listitem.SubItems[idx]
        else
          txt := '';
      end;
      if txt <> '' then
      begin
        if DataInfo^.hdr.code = UInt(LVN_GETDISPINFOA) then
        begin
          LVInfo^.DispInfoTextA[LVInfo^.DispInfoIndex]:=Utf8ToAnsi(txt);
          DataInfo^.item.pszText := @(LVInfo^.DispInfoTextA[LVInfo^.DispInfoIndex][1]);
        end
        else
        begin
          LVInfo^.DispInfoTextW[LVInfo^.DispInfoIndex]:=UTF8Decode(txt);
          DataInfo^.item.pszText := @(LVInfo^.DispInfoTextW[LVInfo^.DispInfoIndex][1]);
        end;
        inc(LVInfo^.DispInfoIndex);
        if LVInfo^.DispInfoIndex=LV_DISP_INFO_COUNT then LVInfo^.DispInfoIndex:=0;
      end
      else
        DataInfo^.item.pszText := nil;
    end;
    if (DataInfo^.item.mask and LVIF_IMAGE) <> 0 then
    begin
      if DataInfo^.item.iSubItem = 0 then
        DataInfo^.item.iImage := listitem.ImageIndex
      else
      begin
        idx := DataInfo^.item.iSubItem - 1;
        if idx < listitem.SubItems.Count then
          DataInfo^.item.iImage := listitem.SubItemImages[idx]
        else
          DataInfo^.item.iImage := -1;
      end;
      if Assigned(ALV.StateImages) then
      begin
        DataInfo^.item.state := IndexToStateImageMask(listitem.StateIndex + 1);
        DataInfo^.item.stateMask := $F000; // States start from 12 bit
        DataInfo^.item.mask := DataInfo^.item.mask or LVIF_STATE;
      end;
    end;
  end;

  procedure HandleListViewCustomDraw(ALV: TCustomListViewAccess);
    function ConvState(const State: uint): TCustomDrawState;
    begin
      Result := [];
      if state and CDIS_CHECKED <> 0 then Include(Result, cdsChecked);
      if state and CDIS_DEFAULT <> 0 then Include(Result, cdsDefault);
      if state and CDIS_DISABLED <> 0 then Include(Result, cdsDisabled);
      if state and CDIS_FOCUS <> 0 then Include(Result, cdsFocused);
      if state and CDIS_GRAYED <> 0 then Include(Result, cdsGrayed);
      if state and CDIS_HOT <> 0 then Include(Result, cdsHot);
      if state and CDIS_INDETERMINATE <> 0 then Include(Result, cdsIndeterminate);
      if state and CDIS_MARKED <> 0 then Include(Result, cdsMarked);
      if state and CDIS_SELECTED <> 0 then Include(Result, cdsSelected);
    end;

  const
    CDRFRESULT: array[TCustomDrawResultFlag] of Integer = (
      CDRF_SKIPDEFAULT,
      CDRF_NOTIFYPOSTPAINT,
      CDRF_NOTIFYITEMDRAW,
      CDRF_NOTIFYSUBITEMDRAW,
      CDRF_NOTIFYPOSTERASE,
      CDRF_NOTIFYITEMERASE
    );
  var
    DrawInfo: PNMLVCustomDraw absolute NMHdr;
    Stage: TCustomDrawStage;
    DrawResult: TCustomDrawResult;
    ResultFlag: TCustomDrawResultFlag;
    OldDC: HDC;
  begin
    MsgResult := CDRF_DODEFAULT;
    WinProcess := False;
    if not ALV.IsCustomDrawn(dtControl, cdPrePaint) then
      exit;

    case DrawInfo^.nmcd.dwDrawStage and $7 of //Get drawing state
      CDDS_PREPAINT:  Stage := cdPrePaint;
      CDDS_POSTPAINT: Stage := cdPostPaint;
      CDDS_PREERASE:  Stage := cdPreErase;
      CDDS_POSTERASE: Stage := cdPostErase;
    else
      Exit;
    end;

    OldDC := ALV.Canvas.Handle;
    ALV.Canvas.Handle := DrawInfo^.nmcd.hdc;
    ALV.Canvas.Font.Assign(ALV.Font);
    ALV.Canvas.Brush.Assign(ALV.Brush);

    if DrawInfo^.nmcd.dwDrawStage and CDDS_SUBITEM <> 0 then
    begin
      // subitem 0 is handled by dtItem
      if DrawInfo^.iSubItem = 0 then Exit;
      DrawResult := ALV.IntfCustomDraw(dtSubItem, Stage,
        DrawInfo^.nmcd.dwItemSpec, DrawInfo^.iSubItem,
        ConvState(DrawInfo^.nmcd.uItemState), nil);
    end
    else
    if DrawInfo^.nmcd.dwDrawStage and CDDS_ITEM <> 0 then
      DrawResult := ALV.IntfCustomDraw(dtItem, Stage, DrawInfo^.nmcd.dwItemSpec,
        -1, ConvState(DrawInfo^.nmcd.uItemState), nil)
    else
      DrawResult := ALV.IntfCustomDraw(dtControl, Stage, -1, -1, [], @DrawInfo^.nmcd.rc); //Whole control

    if DrawResult <> [] then
      MsgResult := 0;

    if not (cdrSkipDefault in DrawResult) and
       (DrawInfo^.nmcd.dwDrawStage and CDDS_ITEMPREPAINT = CDDS_ITEMPREPAINT) then
    begin
      DrawInfo^.clrText := ColorToRGB(ALV.Canvas.Font.Color);
      DrawInfo^.clrTextBk := ColorToRGB(ALV.Canvas.Brush.Color);
    end;
    ALV.Canvas.Handle := OldDC;

    for ResultFlag := Low(ResultFlag) to High(ResultFlag) do
    begin
      if ResultFlag in DrawResult then
        MsgResult := MsgResult or CDRFRESULT[ResultFlag];
    end;
  end;

// #35362
var
  Pos: TSmallPoint;
  ListItem: TListItem;
begin
  Result := False;
  case Msg of
    WM_NOTIFY:
    begin
      case NMHdr^.code of
        NM_RCLICK:
          // This notification comes up in response to MouseUp
          // after the ListView modal message loop ended.
          // Call ListView.OnMouseUp
          begin
            WinProcess := False;
            Pos := GetClientCursorPos(NMHdr^.hwndFrom);
            ListItem := TListView(AWinControl).GetItemAt(Pos.x,Pos.y);
            if Assigned(TListView(AWinControl).OnMouseUp) and
            // Avoid a duplicate OnMouseDown event in case of
            // MultiSelect=false and PopupMenu=nil and ListItem=nil.
               (TListView(AWinControl).MultiSelect or
                Assigned(TListView(AWinControl).PopupMenu) or
                Assigned(ListItem)) then
              TListView(AWinControl).OnMouseUp(AWinControl,mbRight,KeyboardStateToShiftState+[ssRight],Pos.x,Pos.y);
            Result := True;
          end;
        NM_CLICK:
          // #35362: NM_CLICK taken from Lazarus 1.8.4.
          //         ShiftState added.
          // #35917: NM_RCLICK excluded to avoid duplicate OnContextPopup events.
          begin
            // A listview doesn't get a WM_LBUTTONUP (or WM_RBUTTONUP) message,
            // because it keeps the message in its own event loop,
            // see msdn article about "Default List-View Message Processing"
            // therefore we take this notification and create a
            // LM_LBUTTONUP message out of it
            WinProcess := False;
            Pos := GetClientCursorPos(NMHdr^.hwndFrom);
            // to make correct event sequence in LCL we should postpone this message
            // since we are here after call of CallDefaultWindowProc
            PostMessage(NMHdr^.hwndFrom,
                        LM_LBUTTONUP,
                        ShiftStateToKeys(KeyboardStateToShiftState + [ssLeft]),
                        MakeLParam(Pos.x, Pos.y));
            Result := True;
          end;
        LVN_GETDISPINFOA, LVN_GETDISPINFOW:
          HandleListViewOwnerData(TCustomListViewAccess(AWinControl));
        NM_CUSTOMDRAW:
          HandleListViewCustomDraw(TCustomListViewAccess(AWinControl));
      end;
    end;
  end;
end;
////////////////////////////////////////////////////////////////////////////////
// Event code
////////////////////////////////////////////////////////////////////////////////


////////////////////////////////////////////////////////////////////////////////
// Column code
////////////////////////////////////////////////////////////////////////////////

class procedure TWin32WSCustomListView.ColumnDoAutosize(const ALV: TCustomListView; const AIndex: Integer);
var
  CaptionSize: TSize;
begin
  if (ALV.Items.Count > 0) then
    ListView_SetColumnWidth(ALV.Handle, AIndex, LVSCW_AUTOSIZE)
  else
  begin
    // normally, we have to use ListView_GetStringWidth, but it doesn't work with
    // Unicode, so we take a universal function to get the width of the caption
    if GetTextExtentPoint32W(ALV.Canvas.Handle,
                             PWideChar(UTF8ToUTF16(ALV.Column[AIndex].Caption)),
                             UTF8Length(ALV.Column[AIndex].Caption),
                             CaptionSize) then
    begin
      // to retrieve the column width that can contain the string without
      // truncating it, you must add padding to the returned string width
      // see msdn: ListView_GetStringWidth
      // there is no way to get the needed padding size for a list view caption
      // so we take the height of the current caption text, to be DPI aware
      ListView_SetColumnWidth(ALV.Handle, AIndex, CaptionSize.cx + CaptionSize.cy);
    end
    else
      ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(ALV.Column[AIndex]).GetStoredWidth);
  end;
end;

class procedure TWin32WSCustomListView.ColumnDelete(const ALV: TCustomListView; const AIndex: Integer);
var
  hHdr, hLV: THandle;
  Count: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnDelete')
  then Exit;

  hLV := ALV.Handle;
  hHdr := GetHeader(hLV);
  if hHdr = 0 then Exit; //???

  Count := Header_GetItemCount(hHdr);
  if Count <= Aindex then Exit;

  // Move column to the last, otherwise our items get shuffeled
  if AIndex <> Count - 1 then
    ColumnMove(ALV, AIndex, Count - 1, nil);
  ListView_DeleteColumn(hLV, Count - 1);
end;

class function TWin32WSCustomListView.ColumnGetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn): Integer;
var
  lvc: TLvColumn;
begin
  Result := -1;
  // this implementation uses columnwidht = 0 for invisible
  // so fallback to default (= AColumn.FWidth)
  // Don't return AColumn.Width, this will cause a loop
  if not AColumn.Visible then Exit;

  if not WSCheckHandleAllocated(ALV, 'ColumnGetWidth')
  then Exit;

  // do not use ListView_GetColumnWidth since we can not detect errors
  lvc.Mask := LVCF_WIDTH;
  if ListView_GetColumn(ALV.Handle, AIndex, lvc) <> 0
  then Result := lvc.cx;
end;

class procedure TWin32WSCustomListView.ColumnInsert(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn);
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnInsert')
  then Exit;

  lvc.Mask := LVCF_TEXT;

  lvc.pszText := PChar(PWideChar(UTF8ToUTF16(AColumn.Caption)));
  SendMessage(ALV.Handle, LVM_INSERTCOLUMNW, WPARAM(AIndex), LPARAM(@lvc));
end;

class procedure TWin32WSCustomListView.ColumnMove(const ALV: TCustomListView; const AOldIndex, ANewIndex: Integer; const AColumn: TListColumn);
var
  lvc, oldlvc: TLvColumn_v4_7;
  buf, oldbuf: array[0..1024] of Char;
  Count, idx: Integer;

begin
  if not WSCheckHandleAllocated(ALV, 'ColumnMove')
  then Exit;

  Count := AOldIndex - ANewIndex;

  // Fetch old column values
  oldlvc.lvc.Mask := LVCF_FMT or LVCF_IMAGE or LVCF_TEXT or LVCF_WIDTH;
  oldlvc.lvc.pszText := @oldbuf[0];
  oldlvc.lvc.cchTextMax := SizeOF(oldbuf);
  ListView_GetColumn(ALV.Handle, AOldIndex, oldlvc.lvc);

  idx := AOldIndex;
  while Count <> 0 do
  begin
    // get next index
    if Count < 0
    then Inc(idx)
    else Dec(idx);
    // and data
    lvc.lvc.Mask := LVCF_FMT or LVCF_IMAGE or LVCF_TEXT or LVCF_WIDTH;
    lvc.lvc.pszText := @buf[0];
    lvc.lvc.cchTextMax := SizeOF(buf);
    ListView_GetColumn(ALV.Handle, idx, lvc.lvc);
    // set data
    ListView_SetColumn(ALV.Handle, ANewIndex + Count, lvc.lvc);

    if Count < 0
    then Inc(Count)
    else Dec(Count);
  end;
  // finally copy original data to new column
  ListView_SetColumn(ALV.Handle, ANewIndex, oldlvc.lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetAlignment(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAlignment: TAlignment);
const
  JUSTIFICATION: array[TAlignment] of Integer = (
    LVCFMT_LEFT,
    LVCFMT_RIGHT,
    LVCFMT_CENTER
  );
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetAlignment')
  then Exit;

  lvc.Mask := LVCF_FMT;
  ListView_GetColumn(ALV.Handle, AIndex, lvc);
  lvc.fmt := (lvc.fmt and not LVCFMT_JUSTIFYMASK) or JUSTIFICATION[AAlignment];
  ListView_SetColumn(ALV.Handle, AIndex, lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetAutoSize(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AAutoSize: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetAutoSize')
  then Exit;

  if AAutoSize
  then ColumnDoAutosize(ALV, AIndex)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(AColumn).GetStoredWidth);
end;

class procedure TWin32WSCustomListView.ColumnSetCaption(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const ACaption: String);
var
  lvc: TLvColumn;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetCaption')
  then Exit;

  lvc.Mask := LVCF_TEXT;

  lvc.pszText := PChar(PWideChar(UTF8ToUTF16(AColumn.Caption)));
  SendMessage(ALV.Handle, LVM_SETCOLUMNW, WPARAM(AIndex), LPARAM(@lvc));
end;

class procedure TWin32WSCustomListView.ColumnSetImage(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AImageIndex: Integer);
var
  lvc: TLvColumn_v4_7;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetImage')
  then Exit;

  // forst get the old lvc, since we have to tell the bloody thing that this
  // column has an image otherwise we will have a crash on XP using comctl 6

  lvc.lvc.Mask := LVCF_FMT;
  ListView_GetColumn(ALV.Handle, AIndex, lvc.lvc);

  if AImageIndex = -1
  then begin
    lvc.lvc.Mask := LVCF_FMT;
    lvc.lvc.fmt := lvc.lvc.fmt and not (LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES);
  end
  else begin
    lvc.lvc.Mask := LVCF_IMAGE or LVCF_FMT;
    lvc.lvc.fmt := lvc.lvc.fmt or LVCFMT_IMAGE or LVCFMT_COL_HAS_IMAGES;
    lvc.iImage := AImageIndex;
  end;

  ListView_SetColumn(ALV.Handle, AIndex, lvc.lvc);
end;

class procedure TWin32WSCustomListView.ColumnSetMaxWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMaxWidth: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetMaxWidth')
  then Exit;

  // TODO: in messageHandler
end;

class procedure TWin32WSCustomListView.ColumnSetMinWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AMinWidth: integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetMinWidth')
  then Exit;

  // TODO: in messageHandler
end;

class procedure TWin32WSCustomListView.ColumnSetWidth(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AWidth: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetWidth')
  then Exit;

  if AColumn.AutoSize
  then ColumnDoAutosize(ALV, AIndex)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, AWidth)
end;

class procedure TWin32WSCustomListView.ColumnSetVisible(const ALV: TCustomListView; const AIndex: Integer; const AColumn: TListColumn; const AVisible: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetVisible')
  then Exit;

  // TODO: implement with LV_COLUMN.subitem (associate different columns and insert/delete last.

  if AVisible
  then if AColumn.AutoSize
    then ColumnDoAutosize(ALV, AIndex)
    else ListView_SetColumnWidth(ALV.Handle, AIndex, TListColumnAccess(AColumn).GetStoredWidth)
  else ListView_SetColumnWidth(ALV.Handle, AIndex, 0);
end;

class procedure TWin32WSCustomListView.ColumnSetSortIndicator(
  const ALV: TCustomListView; const AIndex: Integer;
  const AColumn: TListColumn; const AAndicator: TSortIndicator);
var
  Hdr: HWND;
  Itm: THDITEM;
begin
  if not WSCheckHandleAllocated(ALV, 'ColumnSetSortIndicator')
  then Exit;

  Hdr := ListView_GetHeader(ALV.Handle);
  FillChar(itm, sizeof(itm),0);
  itm.mask := HDI_FORMAT;
  Header_GetItem(Hdr, AIndex, Itm);
  case AAndicator of
    siNone:        itm.fmt := itm.fmt and (not (HDF_SORTDOWN or HDF_SORTUP));
    siAscending:   itm.fmt := (itm.fmt or HDF_SORTUP) and (not HDF_SORTDOWN);
    siDescending:  itm.fmt := (itm.fmt or HDF_SORTDOWN) and (not HDF_SORTUP);
  end;
  Header_SetItem(Hdr, AIndex, Itm);
end;

////////////////////////////////////////////////////////////////////////////////
// Item code
////////////////////////////////////////////////////////////////////////////////

class procedure TWin32WSCustomListView.ItemDelete(const ALV: TCustomListView; const AIndex: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemDelete')
  then Exit;

  ListView_DeleteItem(ALV.Handle, AIndex);
end;

class function TWin32WSCustomListView.ItemDisplayRect(const ALV: TCustomListView; const AIndex, ASubItem: Integer; ACode: TDisplayCode):TRect; 
const 
  DISPLAYCODES: array[TDisplayCode] of DWORD=(LVIR_BOUNDS, LVIR_ICON, LVIR_LABEL, LVIR_SELECTBOUNDS);
var
  mes: uint;
begin
  Result := Rect(0,0,0,0);
  if not WSCheckHandleAllocated(ALV, 'ItemDisplayRect')
  then Exit;                                          
  
  if ASubItem = 0 
  then mes:=LVM_GETITEMRECT
  else begin
    mes:=LVM_GETSUBITEMRECT;
    if ACode = drSelectBounds 
    then ACode := drBounds;
  end;
  Result.top := ASubItem;
  Result.left := DISPLAYCODES[ACode];
  SendMessage(ALV.Handle, mes, AIndex, lparam(@Result));
end;

class procedure TWin32WSCustomListView.LVItemAssign(const ALV: TCustomListView;
  AItem: TListItem; const AIndex: Integer);
var
  i: Integer;
  B: Boolean;
begin
  if ALV.CheckBoxes then
    B := AItem.Checked
  else
    B := False;

  // apply texts
  ItemSetText(ALV, AIndex, AItem, 0, AItem.Caption);
  for i := 0 to AItem.SubItems.Count - 1 do
    ItemSetText(ALV, AIndex, AItem, i + 1, AItem.SubItems[i]);
  // make sure no texts are left over
  for i := AItem.SubItems.Count to ALV.ColumnCount-1 do
    ItemSetText(ALV, AIndex, AItem, i + 1, '');

  // set state image
  ItemSetStateImage(ALV, AIndex,AItem,0, AItem.StateIndex);

  // set image
  ItemSetImage(ALV, AIndex, AItem, 0, AItem.ImageIndex);

  // apply checkbox state
  ItemSetChecked(ALV, AIndex, AItem, B);
end;

class procedure TWin32WSCustomListView.ItemExchange(const ALV: TCustomListView;
  AItem: TListItem; const AIndex1, AIndex2: Integer);
var
  AItem1, AItem2: TListItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemExchange') then
    exit;

  //We have to reassign TLvItem to AIndex1 and AIndex2
  //or use RecreateWnd() which is very expensive

  AItem1 := ALV.Items[AIndex2];
  AItem2 := ALV.Items[AIndex1];

  LVItemAssign(ALV, AItem1, AIndex2);
  LVItemAssign(ALV, AItem2, AIndex1);
end;

class procedure TWin32WSCustomListView.ItemMove(const ALV: TCustomListView;
  AItem: TListItem; const AFromIndex, AToIndex: Integer);
var
  i: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemMove') then
    exit;
  if AFromIndex = AToIndex then
    exit;
  if AFromIndex > AToIndex then
  begin
    for i := AToIndex to AFromIndex do
      LVItemAssign(ALV, ALV.Items[i], i);
  end else
    for i := AFromIndex to AToIndex do
      LVItemAssign(ALV, ALV.Items[i], i);
end;

class function TWin32WSCustomListView.ItemGetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem): Boolean;
begin
  Result := False;
  if not WSCheckHandleAllocated(ALV, 'ItemGetChecked')
  then Exit;
  // shr 12 will give teh stateimage index, however a value of 
  // 0 means no image and 1 means unchecked. All other 14 are checked (?)
  // so shifting 13 will always result in something <> 0 when checked.
  Result := SendMessage(ALV.Handle, LVM_GETITEMSTATE, AIndex, LVIS_STATEIMAGEMASK) shr 13 <> 0;
end;

class function TWin32WSCustomListView.ItemGetPosition(
  const ALV: TCustomListView; const AIndex: Integer): TPoint;
begin
  Result := Point(0, 0);
  if WSCheckHandleAllocated(ALV, 'ItemGetPosition') then
    SendMessage(ALV.Handle, LVM_GETITEMPOSITION, AIndex, LPARAM(@Result));
end;

class function TWin32WSCustomListView.ItemGetState(const ALV: TCustomListView;
  const AIndex: Integer; const AItem: TListItem; const AState: TListItemState;
  out AIsSet: Boolean): Boolean;
const
  // lisCut, lisDropTarget, lisFocused, lisSelected
  FLAGS: array[TListItemState] of Integer = (LVIS_CUT, LVIS_DROPHILITED, LVIS_FOCUSED, LVIS_SELECTED);
begin
  Result := False;

  if not WSCheckHandleAllocated(ALV, 'ItemGetState')
  then Exit;

  AIsSet := 0 <> ListView_GetItemState(ALV.Handle, AIndex, FLAGS[AState]);
  Result := True;
end;

class procedure TWin32WSCustomListView.ItemInsert(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem);
var
  lvi: TLvItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemInsert')
  then Exit;

  lvi.Mask := LVIF_TEXT or LVIF_PARAM;
  lvi.iItem := AIndex;
  lvi.iSubItem := 0;
  lvi.lParam := LPARAM(AItem);

  lvi.pszText := PChar(PWideChar(UTF8ToUTF16(AItem.Caption)));
  SendMessage(ALV.Handle, LVM_INSERTITEMW, 0, LPARAM(@lvi));
end;

class procedure TWin32WSCustomListView.ItemSetChecked(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AChecked: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetChecked')
  then Exit;

  if AChecked then
    ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(2), LVIS_STATEIMAGEMASK)
  else
    ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(1), LVIS_STATEIMAGEMASK);
end;

class procedure TWin32WSCustomListView.ItemSetImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AImageIndex: Integer);
var
  lvi: TLvItem;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetImage')
  then Exit;

  lvi.Mask := LVIF_IMAGE;
  lvi.iItem := AIndex;
  lvi.iSubItem := ASubIndex;
  lvi.iImage := AImageIndex;

  ListView_SetItem(ALV.Handle, lvi);
end;

class function TWin32WSCustomListView.ItemSetPosition(const ALV: TCustomListView; const AIndex: Integer; const ANewPosition: TPoint): Boolean;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetPosition') then
    Result := False
  else
    Result := SendMessage(ALV.Handle, LVM_SETITEMPOSITION,
      AIndex, MAKELPARAM(ANewPosition.X, ANewPosition.Y)) <> 0;
end;

class procedure TWin32WSCustomListView.ItemSetStateImage(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex, AStateImageIndex: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetStateImage')
  then Exit;

  ListView_SetItemState(ALV.Handle, AIndex, IndexToStateImageMask(AStateImageIndex + 1), LVIS_STATEIMAGEMASK);
end;

class procedure TWin32WSCustomListView.ItemSetState(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const AState: TListItemState; const AIsSet: Boolean);
const
  // lisCut, lisDropTarget, lisFocused, lisSelected
  FLAGS: array[TListItemState] of Integer = (LVIS_CUT, LVIS_DROPHILITED, LVIS_FOCUSED, LVIS_SELECTED);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetState')
  then Exit;
  {Don't change the state if it already has needed value}
  if ((ListView_GetItemState(ALV.Handle, AIndex, FLAGS[AState]) and FLAGS[AState]) = FLAGS[AState]) = AIsSet then exit;

  if AIsSet
  then ListView_SetItemState(ALV.Handle, AIndex, FLAGS[AState], FLAGS[AState])
  else ListView_SetItemState(ALV.Handle, AIndex, 0, FLAGS[AState]);
end;

class procedure TWin32WSCustomListView.ItemSetText(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const ASubIndex: Integer; const AText: String);
var
  _gnu_lvi : LV_ITEM;
begin
  if not WSCheckHandleAllocated(ALV, 'ItemSetText')
  then Exit;

  _gnu_lvi.iSubItem := ASubIndex;
  _gnu_lvi.pszText := PChar(PWideChar(UTF8ToUTF16(AText)));

  SendMessage(ALV.Handle, LVM_SETITEMTEXTW, WPARAM(AIndex), LPARAM(@_gnu_lvi));
  // autosize is an *extreme* performance bottleneck, even if WM_SETREDRAW
  // was set to false it will ignore this and still redraw all columns.
  // We will therefore postpone all autosizing until EndUpdate where we do
  // it only once per column.

  if (ASubIndex >= 0) and (ASubIndex < ALV.ColumnCount) and ALV.Column[ASubIndex].AutoSize and (TCustomListViewAccess(ALV).GetUpdateCount = 0) then
    ColumnDoAutosize(ALV, ASubIndex);
end;

class procedure TWin32WSCustomListView.ItemShow(const ALV: TCustomListView; const AIndex: Integer; const AItem: TListItem; const PartialOK: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'ItemShow')
  then Exit;

  ListView_EnsureVisible(ALV.Handle, AIndex, Ord(PartialOK));
end;

////////////////////////////////////////////////////////////////////////////////
// LV code
////////////////////////////////////////////////////////////////////////////////

procedure ListViewDrawItem(const AWinControl: TWinControl; Window: HWnd;
  Msg: UInt; WParam: Windows.WParam; const DrawIS: TDrawItemStruct;
  var ItemMsg: Integer; var DrawListItem: Boolean);
begin
  DrawListItem := (AWinControl <> nil) and (AWinControl is TListView) and
      (TListView(AWinControl).ViewStyle = vsReport) and
      (DrawIS.ctlType = ODT_LISTVIEW) and
      (TListView(AWinControl).OwnerDraw);
  ItemMsg := CN_DRAWITEM;
end;

function ListViewProc(Window: HWnd; Msg: UInt; WParam: Windows.WParam;
    LParam: Windows.LParam): LResult; stdcall;
// #35917
const
  bSuppress_WM_CONTEXTMENU: boolean = true;
var
  WindowInfo: PWin32WindowInfo;
  ListItem: TListItem;
  ListView: TCustomListView;
  MouseEvt: TMouseEvent;
begin
  case Msg of
    WM_LBUTTONDOWN, WM_RBUTTONDOWN:
      begin
        // See msdn article about "Default List-View Message Processing":
        // A ListView will enter its own modal message loop on WM_xBUTTONDOWN to
        // determine whether a click or drag operation is being initiated until
        // either the button is released or the mouse is moved.
        WindowInfo := GetWin32WindowInfo(Window);
        ListView := TListView(WindowInfo^.WinControl);
        if Assigned(TListView(ListView).OnMouseDown) then
        begin
          // Call OnMouseDown before the modal message loop takes control
          if Msg = WM_LBUTTONDOWN then
            TListView(ListView).OnMouseDown(ListView,mbLeft,KeysToShiftState(WParam or MK_LBUTTON),WindowInfo^.MouseX, WindowInfo^.MouseY)
          else
            TListView(ListView).OnMouseDown(ListView,mbRight,KeysToShiftState(WParam or MK_RBUTTON),WindowInfo^.MouseX, WindowInfo^.MouseY);
          // Suppress a 2nd OnMouseDown event during LCL message processing after
          // the modal message loop ended.
          MouseEvt := TListView(ListView).OnMouseDown;
          TListView(ListView).OnMouseDown := nil;
          Result := WindowProc(Window, Msg, WParam, LParam);
          TListView(ListView).OnMouseDown := MouseEvt;
        end
        else
          Result := WindowProc(Window, Msg, WParam, LParam);
        exit;
      end;
    // #35917
    WM_CONTEXTMENU:
      // There is a duplicate WM_CONTEXTMENU message in case of
      // a right click outside of list items and MultiSelect=false and PopupMenu=nil.
      // The first message appears at time of the WM_NOTIFY message to the
      // parent window (-> ListViewParentMsgHandler).
      // A second one is triggered from the "real" mouse button up event.
      if LParam <> -1 then
      begin
        // It's a mouse event
        WindowInfo := GetWin32WindowInfo(Window);
        ListView := TListView(WindowInfo^.WinControl);
        ListItem := ListView.GetItemAt(WindowInfo^.MouseX, WindowInfo^.MouseY);
        if (not ListView.MultiSelect) and (not Assigned(ListView.PopupMenu)) and
           (not Assigned(ListItem)) then
          if bSuppress_WM_CONTEXTMENU then
          begin
            bSuppress_WM_CONTEXTMENU := false;
            Result := -1;
            exit;
          end
          else
            bSuppress_WM_CONTEXTMENU := true;
      end;
  end;
  Result := WindowProc(Window, Msg, WParam, LParam);
end;

class function TWin32WSCustomListView.CreateHandle(const AWinControl: TWinControl;
  const AParams: TCreateParams): HWND;
const
  LISTVIEWSTYLES: array[TViewStyle] of DWORD = (LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT);
  Arrangement: array[TIconArrangement] of DWord = (LVS_ALIGNTOP, LVS_ALIGNLEFT);
var
  Params: TCreateWindowExParams;
begin
  // general initialization of Params
  PrepareCreateWindow(AWinControl, AParams, Params);
  // customization of Params
  with Params do
  begin
    pClassName := WC_LISTVIEW;
    SubClassWndProc := @ListViewProc;
    WindowTitle := StrCaption;
    Flags := Flags or LISTVIEWSTYLES[TListView(AWinControl).ViewStyle] or
      LVS_SINGLESEL or LVS_SHAREIMAGELISTS or
      Arrangement[TListView(AWinControl).IconOptions.Arrangement];
    if TCustomListView(AWinControl).OwnerData then 
      Flags := Flags or LVS_OWNERDATA;
    if TListView(AWinControl).OwnerDraw then
      Flags := Flags or LVS_OWNERDRAWFIXED;
    if TCustomListView(AWinControl).BorderStyle = bsSingle then
      FlagsEx := FlagsEx or WS_EX_CLIENTEDGE;
  end;
  // create window
  FinishCreateWindow(AWinControl, Params, false);
  Params.WindowInfo^.ParentMsgHandler := @ListViewParentMsgHandler;
  Params.WindowInfo^.needParentPaint := false;
  Params.WindowInfo^.DrawItemHandler := @ListViewDrawItem;
  Result := Params.Window;
  if TCustomListView(AWinControl).checkboxes
    then UpdateExStyle(result,lvs_ex_SubitemImages or lvs_Ex_Checkboxes,lvs_ex_SubitemImages or lvs_Ex_Checkboxes) else
  UpdateExStyle(Result, LVS_EX_SUBITEMIMAGES, LVS_EX_SUBITEMIMAGES);
end;

class procedure TWin32WSCustomListView.BeginUpdate(const ALV: TCustomListView);
begin
  if not WSCheckHandleAllocated(ALV, 'BeginUpdate')
  then Exit;

  SendMessage(ALV.Handle,WM_SETREDRAW,WPARAM(False),0);
end;

class procedure TWin32WSCustomListView.EndUpdate(const ALV: TCustomListView);
var
  ColIndex : Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'EndUpdate')
  then Exit;

  // we have skipped all column resizing in ItemSetText()
  // for performance reasons, so now we need to do it here.
  //
  // A further significant perfomance boost and reduced flickering
  // can be achieved by setting the widget to invisible during the
  // following operation (it ignores the state of WM_SETREDRAW for
  // column resizing, but this way we we can really enforce it).
  // ShowWindow() itself does not force an immediate redraw,
  // so it won't flicker at all.
  ShowWindow(ALV.Handle, SW_HIDE);
  for ColIndex := 0 to TCustomListViewAccess(ALV).Columns.Count - 1 do
    if ALV.Column[ColIndex].AutoSize
    then ColumnDoAutosize(ALV, ColIndex);

  SendMessage(ALV.Handle,WM_SETREDRAW,WPARAM(True),0);
  if ALV.Visible then
    ShowWindow(ALV.Handle, SW_SHOW);
end;

class function TWin32WSCustomListView.GetBoundingRect(const ALV: TCustomListView): TRect;
begin
  Result := Rect(0,0,0,0); 
  if not WSCheckHandleAllocated(ALV, 'GetBoundingRect')
  then Exit;

  ListView_GetViewRect(ALV.Handle, Result);
end;

class function TWin32WSCustomListView.GetDropTarget(const ALV: TCustomListView): Integer;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetDropTarget')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_DROPHILITED);
end;

class function TWin32WSCustomListView.GetFocused(const ALV: TCustomListView): Integer;
begin       
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetFocused')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_FOCUSED);
end;

class function TWin32WSCustomListView.GetHitTestInfoAt( const ALV: TCustomListView; X, Y: Integer ) : THitTests;
var
  HitInfo: LV_HITTESTINFO;

begin
  Result := [];
  if not WSCheckHandleAllocated(ALV, 'GetHitTestInfoAt')
  then Exit;

  with HitInfo do
  begin
    pt.X := X;
    pt.Y := Y;
    ListView_HitTest( ALV.Handle, HitInfo );

    if ((flags and LVHT_ABOVE) <> 0) and (Y < 0) then
      Include(Result, htAbove);

    if (flags and LVHT_BELOW) <> 0 then
      Include(Result, htBelow);

    if (flags and LVHT_NOWHERE) <> 0 then
      Include(Result, ComCtrls.htNowhere);

    if (flags and LVHT_ONITEM) = LVHT_ONITEM then
      Include(Result, htOnItem)

    else
      begin
      if (flags and LVHT_ONITEMICON) <> 0 then
        Include(Result, htOnIcon);

      if (flags and LVHT_ONITEMLABEL) <> 0 then
        Include(Result, htOnLabel);

      if (flags and LVHT_ONITEMSTATEICON) <> 0 then
        Include(Result, htOnStateIcon);

      end;

    if (flags and LVHT_TOLEFT) <> 0 then
      Include(Result, htToLeft);

    if (flags and LVHT_TORIGHT) <> 0 then
      Include(Result, htToRight);

  end;
end;

class function TWin32WSCustomListView.GetHoverTime(const ALV: TCustomListView): Integer;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetHoverTime')
  then Exit;

  Result := SendMessage(ALV.Handle, LVM_GETHOVERTIME, 0, 0);
end;

class function TWin32WSCustomListView.GetItemAt(const ALV: TCustomListView; x,
  y: Integer): Integer;
var 
  HitInfo: LV_HITTESTINFO;
begin
  Result := -1; 
  if not WSCheckHandleAllocated(ALV, 'GetItemAt')
  then Exit;

  HitInfo.pt.x:=x;
  HitInfo.pt.y:=y;
  ListView_HitTest(alv.Handle,HitInfo);
  if HitInfo.flags <> LVHT_NOWHERE 
  then Result:=HitInfo.iItem;
end;

class function TWin32WSCustomListView.GetSelCount(const ALV: TCustomListView): Integer;
begin
  Result := 0;
  if not WSCheckHandleAllocated(ALV, 'GetSelCount')
  then Exit;

  Result := ListView_GetSelectedCount(ALV.Handle);
end;

class function TWin32WSCustomListView.GetSelection(const ALV: TCustomListView): Integer;
begin
  Result := -1;
  if not WSCheckHandleAllocated(ALV, 'GetSelection')
  then Exit;

  Result := ListView_GetNextItem(ALV.Handle, -1, LVNI_ALL or LVNI_SELECTED);
end;

class function TWin32WSCustomListView.GetTopItem(const ALV: TCustomListView): Integer;
begin
  Result := -1;
  if not WSCheckHandleAllocated(ALV, 'GetTopItem')
  then Exit;

  case GetWindowLong(ALV.Handle, GWL_STYLE) and LVS_TYPEMASK of
    LVS_LIST,
    LVS_REPORT: Result := ListView_GetTopIndex(ALV.Handle);
  else
    Result := -1;
  end;
end;

class function TWin32WSCustomListView.GetViewOrigin(const ALV: TCustomListView): TPoint;
begin
  if not WSCheckHandleAllocated(ALV, 'GetViewOrigin')
  then begin
    Result := Point(0, 0);
    Exit;
  end;

  ListView_GetOrigin(ALV.Handle, Result);
end;

class function TWin32WSCustomListView.GetVisibleRowCount(const ALV: TCustomListView): Integer;
begin
  Result := 0;
  if not WSCheckHandleAllocated(ALV, 'GetVisibleRowCount')
  then Exit;

  case GetWindowLong(ALV.Handle, GWL_STYLE) and LVS_TYPEMASK of
    LVS_LIST,
    LVS_REPORT: Result := ListView_GetCountPerPage(ALV.Handle);
  else
    Result := -1;
  end;
end;

class procedure TWin32WSCustomListView.SelectAll(const ALV: TCustomListView;
  const AIsSet: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'SelectAll') then
    exit;
  // Index param -1 means select all.
  if AIsSet then
    ListView_SetItemState(ALV.Handle, -1, LVIS_SELECTED, LVIS_SELECTED)
  else
    ListView_SetItemState(ALV.Handle, -1, 0, LVIS_SELECTED);
end;

class function TWin32WSCustomListView.GetHeader(const AHandle: THandle): THandle;
begin
  Result := THandle(SendMessage(AHandle, LVM_GETHEADER, 0, 0));
  if Result <> 0 then Exit;

  // probably old version, try the first child
  Result := GetWindow(AHandle, GW_CHILD);
end;

// MWE: original from MS knowledgebase KB137520
(********************************************************************
    PositionHeader

    Call this function when the ListView is created, resized, the
    view is changed, or a WM_SYSPARAMETERCHANGE message is received.

 ********************************************************************)
class procedure TWin32WSCustomListView.PositionHeader(const AHandle: THandle);
var
  hwndHeader: HWND;
  dwStyle: PtrInt;
  rc: TRect;
  hdLayout: THDLAYOUT;
  wpos: Windows.TWINDOWPOS;
begin
  dwStyle := GetWindowLong(AHandle, GWL_STYLE);

  if dwStyle and LVS_NOSCROLL = 0 then Exit; // nothing to do
  if dwStyle and LVS_REPORT = 0 then Exit;   // nothing to do

  hwndHeader := GetHeader(AHandle);
  if hwndHeader = 0 then Exit; // nothing to do

  Windows.GetClientRect(AHandle, rc);
  FillChar(hdLayout, SizeOf(hdLayout), 0);
  hdLayout.prc := @rc;
  hdLayout.pwpos := @wpos;
  Header_Layout(hwndHeader, hdLayout);

  Windows.SetWindowPos(hwndHeader,
                       wpos.hwndInsertAfter,
                       wpos.x,
                       wpos.y,
                       wpos.cx,
                       wpos.cy,
                       wpos.flags or SWP_SHOWWINDOW);

  ListView_EnsureVisible(AHandle, 0, 0);
end;

class procedure TWin32WSCustomListView.SetAllocBy(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetAllocBy')
  then Exit;

  ListView_SetItemCount(ALV.Handle, AValue);
end;

class procedure TWin32WSCustomListView.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
begin
  if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetBorder') then
    Exit;
  // changing border style by changing EXSTYLE here does not work correctly
  RecreateWnd(AWinControl);
end;

class procedure TWin32WSCustomListView.SetColor(const AWinControl: TWinControl);
var
  Color: TColor;
begin
  if not WSCheckHandleAllocated(AWinControl, 'TWin32WSCustomListView.SetColor') then
    Exit;
  Color := AWinControl.Color;
  if Color = clDefault then
    Color := AWinControl.GetDefaultColor(dctBrush);
  Windows.SendMessage(AWinControl.Handle, LVM_SETBKCOLOR, 0, ColorToRGB(Color));
  Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTBKCOLOR, 0, ColorToRGB(Color));
end;

class procedure TWin32WSCustomListView.SetDefaultItemHeight(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetDefaultItemHeight')
  then Exit;

  // TODO ???
end;

class procedure TWin32WSCustomListView.SetFont(const AWinControl: TWinControl; const AFont: TFont);
var
  Color: TColor;
begin
  // call inherited SetFont; need to do it this way,
  // because the compile time ancestor class is TWSCustomListView
  TWSWinControlClass(ClassParent).SetFont(AWinControl, AFont);
  Color := AFont.Color;
  if Color = clDefault then
   Color := AWinControl.GetDefaultColor(dctFont);
  Windows.SendMessage(AWinControl.Handle, LVM_SETTEXTCOLOR, 0, ColorToRGB(Color));
end;

class procedure TWin32WSCustomListView.SetHotTrackStyles(const ALV: TCustomListView; const AValue: TListHotTrackStyles);
const
  MASK = LVS_EX_ONECLICKACTIVATE or LVS_EX_TWOCLICKACTIVATE or LVS_EX_UNDERLINEHOT or LVS_EX_UNDERLINECOLD;
var
  Style: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'SetHotTrackStyles')
  then Exit;

  if htHandPoint in AValue
  then Style := LVS_EX_ONECLICKACTIVATE
  else if [htUnderlineHot, htUnderlineCold] * AValue <> []
  then Style := LVS_EX_TWOCLICKACTIVATE
  else Style := 0;

  if htUnderlineHot in AValue
  then Style := Style or LVS_EX_UNDERLINEHOT;

  if htUnderlineCold in AValue
  then Style := Style or LVS_EX_UNDERLINECOLD;

  UpdateExStyle(ALV.Handle, MASK, Style);
end;

class procedure TWin32WSCustomListView.SetHoverTime(const ALV: TCustomListView; const AValue: Integer);
begin
  if not WSCheckHandleAllocated(ALV, 'SetHoverTime')
  then Exit;

  SendMessage(ALV.Handle, LVM_SETHOVERTIME, 0, AValue);
end;

class procedure TWin32WSCustomListView.SetIconArrangement(
  const ALV: TCustomListView; const AValue: TIconArrangement);
const
  ArrangementMap: array[TIconArrangement] of DWord = (
    { iaTop  } LVS_ALIGNTOP,
    { iaLeft } LVS_ALIGNLEFT
  );
begin
  if not WSCheckHandleAllocated(ALV, 'SetIconArrangement')
  then Exit;

  // LVM_ALIGN styles are not implemented in windows (according to w7 sdk) => change style
  UpdateStyle(ALV.Handle, LVS_ALIGNMASK, ArrangementMap[AValue]);
end;

class procedure TWin32WSCustomListView.SetImageList(const ALV: TCustomListView;
  const AList: TListViewImageList; const AValue: TCustomImageListResolution);
const
  LIST_MAP: array[TListViewImageList] of WPARAM = (
   {lvilSmall} LVSIL_SMALL,
   {lvilLarge} LVSIL_NORMAL,
   {lvilState} LVSIL_STATE
  );
begin
  if not WSCheckHandleAllocated(ALV, 'SetImageList')
  then Exit;

  if AValue <> nil then
    SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], AValue.Reference._Handle)
  else
    SendMessage(ALV.Handle, LVM_SETIMAGELIST, LIST_MAP[AList], 0);
end;

class procedure TWin32WSCustomListView.SetItemsCount(const ALV: TCustomListView; const AValue: Integer); 
begin
  if not WSCheckHandleAllocated(ALV, 'SetItemsCount')
  then Exit;
  SendMessage(ALV.Handle, LVM_SETITEMCOUNT, AValue, 0);
end;

class procedure TWin32WSCustomListView.SetOwnerData(const ALV: TCustomListView; const AValue: Boolean); 
begin
  if not WSCheckHandleAllocated(ALV, 'SetOwnerData')
  then Exit;
  RecreateWnd(ALV);
end;

class procedure TWin32WSCustomListView.SetProperty(const ALV: TCustomListView; const AProp: TListViewProperty; const AIsSet: Boolean);
begin
  if not WSCheckHandleAllocated(ALV, 'SetProperty')
  then Exit;

  case LV_STYLES[AProp].StyleType of
    lsStyle: begin
      if AIsSet
      then UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style)
      else UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0);
    end;
    lsInvert:
    begin
      // we are always using readonly on ws since ListView_GetEditControl
      // requires minimum windows 2000. Editing is implemented in LCL atm,
      // can be changed later to use ws for item editing.
      // http://msdn.microsoft.com/en-us/library/windows/desktop/bb761260%28v=vs.85%29.aspx
      if (AProp = lvpReadOnly) then
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0)
      else
      if AIsSet then
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, 0)
      else
        UpdateStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style);
    end;
    lsExStyle: begin
      if AIsSet
      then UpdateExStyle(ALV.Handle, LV_STYLES[AProp].Style, LV_STYLES[AProp].Style)
      else UpdateExStyle(ALV.Handle, LV_STYLES[AProp].Style, 0);
    end;
  end;
  if(aProp=lvpCheckboxes)and aIsSet
    then ReCreateWnd(ALV)
end;

class procedure TWin32WSCustomListView.SetProperties(const ALV: TCustomListView; const AProps: TListViewProperties);
var
  Prop: TListViewProperty;
  Style, ExStyle, Mask, ExMask: Integer;
begin
  if not WSCheckHandleAllocated(ALV, 'SetProperties')
  then Exit;

  Style := 0;
  ExStyle := 0;
  Mask := 0;
  ExMask := 0;

  for Prop := Low(Prop) to High(Prop) do
  begin
    case LV_STYLES[Prop].StyleType of
      lsStyle,
      lsInvert:
      begin
        // we are always using readonly on ws since ListView_GetEditControl
        // requires minimum windows 2000. Editing is implemented in LCL atm,
        // can be changed later to use ws for item editing.
        // http://msdn.microsoft.com/en-us/library/windows/desktop/bb761260%28v=vs.85%29.aspx
        if Prop = lvpReadOnly then
          UpdateStyle(ALV.Handle, LVS_EDITLABELS, 0)
        else
        begin
          Mask := Mask or LV_STYLES[Prop].Style;
          if (LV_STYLES[Prop].StyleType = lsStyle) = (Prop in AProps)
          then Style := Style or LV_STYLES[Prop].Style
          else Style := Style and not LV_STYLES[Prop].Style;
        end;
      end;
      lsExStyle: begin
        ExMask := ExMask or LV_STYLES[Prop].Style;

        if Prop in AProps
        then ExStyle := ExStyle or LV_STYLES[Prop].Style
        else ExStyle := ExStyle and not LV_STYLES[Prop].Style;
      end;
    end;
  end;

  if Mask <> 0
  then UpdateStyle(ALV.Handle, Mask, Style);
  if ExMask <> 0
  then UpdateExStyle(ALV.Handle, ExMask, ExStyle);
end;

class procedure TWin32WSCustomListView.SetScrollBars(const ALV: TCustomListView; const AValue: TScrollStyle);
begin
  if not WSCheckHandleAllocated(ALV, 'SetScrollBars')
  then Exit;

  // we only can hide all scrollbars.
  if AValue = ssNone
  then UpdateStyle(ALV.Handle, LVS_NOSCROLL, LVS_NOSCROLL)
  else UpdateStyle(ALV.Handle, LVS_NOSCROLL, 0);
end;

function ListCompare(lParam1, lParam2: LParam; lParamSort: LParam): Integer; stdcall;
var
  Item1: TListItem absolute lParam1;
  Item2: TListItem absolute lParam2;
begin
  Result := CompareValue(Item1.Index, Item2.Index);
end;

class procedure TWin32WSCustomListView.SetSort(const ALV: TCustomListView;
  const AType: TSortType; const AColumn: Integer; const ASortDirection: TSortDirection);
begin
  if not WSCheckHandleAllocated(ALV, 'SetSort')
  then Exit;
  ListView_SortItems(ALV.Handle, @ListCompare, Windows.MAKELPARAM(Ord(AType), AColumn));
end;

class procedure TWin32WSCustomListView.SetViewOrigin(const ALV: TCustomListView; const AValue: TPoint);
var
  dx, dy: Integer;
  Origin: TPoint;
begin
  if not WSCheckHandleAllocated(ALV, 'SetViewOrigin')
  then Exit;

  ListView_GetOrigin(ALV.Handle, Origin);

  dx := AValue.X - Origin.X;
  dy := AValue.Y - Origin.Y;
  if (dx <> 0) or (dy <> 0)
  then ListView_Scroll(ALV.Handle, dx, dy);
end;

class procedure TWin32WSCustomListView.SetViewStyle(const ALV: TCustomListView; const Avalue: TViewStyle);
const
  //vsIcon, vsSmallIcon, vsList, vsReport
  STYLES: array[TViewStyle] of DWORD = (LVS_ICON, LVS_SMALLICON, LVS_LIST, LVS_REPORT);
begin
  if not WSCheckHandleAllocated(ALV, 'SetViewStyle')
  then Exit;

  UpdateStyle(ALV.Handle, LVS_TYPEMASK, STYLES[AValue]);
end;

class procedure TWin32WSCustomListView.UpdateStyle(const AHandle: THandle; const AMask, AStyle: Integer);
var
  OldStyle, NewStyle: PtrInt;
begin
  OldStyle := GetWindowLong(AHandle, GWL_STYLE);

  NewStyle := (OldStyle and not AMask) or AStyle;

  if OldStyle = NewStyle then Exit;

  SetWindowLong(AHandle, GWL_STYLE, NewStyle);

  // fix header if needed
  if (NewStyle and LVS_NOSCROLL)<> 0 then begin
    if (OldStyle and LVS_NOSCROLL = 0)
    or (NewStyle and LVS_REPORT <> 0)
    then PositionHeader(AHandle);
  end;

  //Invalidate Listview, so that changes are made visible
  Windows.InvalidateRect(AHandle, nil, true);
end;

class procedure TWin32WSCustomListView.UpdateExStyle(const AHandle: THandle; const AMask, AStyle: Integer);
var
  OldStyle, NewStyle: Integer;
begin
  OldStyle := SendMessage(AHandle, LVM_GETEXTENDEDLISTVIEWSTYLE, 0, 0);

  NewStyle := (OldStyle and not AMask) or AStyle;

  if OldStyle = NewStyle then Exit;

  SendMessage(AHandle, LVM_SETEXTENDEDLISTVIEWSTYLE, 0, NewStyle);

 //Invalidate Listview, so that changes are made visible
  Windows.InvalidateRect(AHandle, nil, true);
end;


win32wscustomlistview-2.inc (51,014 bytes)   
Selection.zip (260,493 bytes)

Issue History

Date Modified Username Field Change
2019-04-11 07:24 Brett New Issue
2019-04-11 07:24 Brett File Added: ListViewBug.zip
2019-04-11 07:34 Brett Note Added: 0115417
2019-04-11 07:53 Cyrax Note Added: 0115418
2019-04-11 08:50 Jonas Maebe Project FPC => Lazarus
2019-04-11 09:46 Brett Note Added: 0115420
2019-04-12 10:10 Juha Manninen Relationship added related to 0033330
2019-04-12 13:09 Juha Manninen Note Added: 0115439
2019-04-12 13:11 Juha Manninen Note Edited: 0115439 View Revisions
2019-04-12 14:14 Zeljan Rikalo Note Added: 0115442
2019-04-12 14:27 Brett Note Added: 0115443
2019-04-12 14:54 Juha Manninen LazTarget => -
2019-04-12 14:54 Juha Manninen Widgetset => GTK 2, Win32/Win64
2019-04-12 14:54 Juha Manninen Product Version 3.0.4 =>
2019-04-12 14:56 Juha Manninen Relationship added related to 0033811
2019-08-11 11:41 Juha Manninen Relationship added related to 0035917
2019-08-11 19:16 Serge Anvarov Note Added: 0117644
2019-08-11 21:16 Juha Manninen Assigned To => Michl
2019-08-11 21:16 Juha Manninen Status new => assigned
2020-03-08 19:03 Rolf Wetjen File Added: win32wscustomlistview.inc.patch
2020-03-08 19:03 Rolf Wetjen Note Added: 0121466
2020-03-16 09:09 Juha Manninen Target Version => 2.2
2020-03-16 09:09 Juha Manninen Widgetset GTK 2, Win32/Win64 => GTK 2, Win32/Win64
2020-03-16 14:32 Juha Manninen Note Added: 0121621
2020-03-22 19:13 Rolf Wetjen File Added: selection.zip
2020-03-22 19:13 Rolf Wetjen Note Added: 0121685
2020-04-03 10:55 Juha Manninen Assigned To Michl => Martin Friebe
2020-04-04 03:11 Martin Friebe Note Added: 0121880
2020-04-04 16:00 Martin Friebe Note Added: 0121900
2020-04-04 16:01 Martin Friebe Assigned To Martin Friebe =>
2020-04-04 16:01 Martin Friebe Status assigned => acknowledged
2020-04-04 17:29 Martin Friebe Note Added: 0121903
2020-04-04 17:56 Martin Friebe Note Added: 0121904
2020-04-06 10:46 nanobit Note Added: 0121955
2020-04-06 13:06 Rolf Wetjen File Added: win32wscustomlistview.inc
2020-04-06 13:06 Rolf Wetjen Note Added: 0121960
2020-04-06 13:56 Martin Friebe Assigned To => Martin Friebe
2020-04-06 13:56 Martin Friebe Status acknowledged => assigned
2020-04-06 13:59 Martin Friebe Note Added: 0121962
2020-04-06 14:32 nanobit Note Added: 0121964
2020-04-06 15:24 Martin Friebe Note Added: 0121969
2020-04-06 15:32 Martin Friebe Note Added: 0121970
2020-04-06 15:34 Martin Friebe Note Edited: 0121970 View Revisions
2020-04-06 16:27 Martin Friebe Note Added: 0121974
2020-04-07 15:54 nanobit Note Added: 0122002
2020-04-07 16:53 nanobit Note Added: 0122006
2020-04-09 10:06 Rolf Wetjen Note Added: 0122041
2020-04-09 14:12 nanobit Note Added: 0122042
2020-04-09 14:41 Martin Friebe Note Added: 0122043
2020-04-09 18:32 Ondrej Pokorny Relationship added related to 0030234
2020-04-11 08:36 Rolf Wetjen Note Added: 0122067
2020-04-11 08:48 Rolf Wetjen Note Edited: 0122067 View Revisions
2020-04-11 09:36 nanobit Note Added: 0122068
2020-04-11 09:40 nanobit Note Edited: 0122068 View Revisions
2020-04-11 10:23 nanobit Note Edited: 0122068 View Revisions
2020-04-12 09:08 Rolf Wetjen Note Added: 0122092
2020-04-17 17:44 Martin Friebe Note Added: 0122201
2020-04-17 18:09 Martin Friebe Note Edited: 0122201 View Revisions
2020-04-17 18:12 Martin Friebe Note Edited: 0122201 View Revisions
2020-04-17 18:16 Martin Friebe Note Edited: 0122201 View Revisions
2020-04-18 02:26 Martin Friebe Note Edited: 0122201 View Revisions
2020-04-18 21:50 Martin Friebe Status assigned => resolved
2020-04-18 21:50 Martin Friebe Resolution open => fixed
2020-04-18 21:50 Martin Friebe Fixed in Revision => 63012,63013
2020-04-18 21:50 Martin Friebe LazTarget - => 2.2
2020-04-18 21:50 Martin Friebe Widgetset GTK 2, Win32/Win64 => GTK 2, Win32/Win64
2020-04-18 21:50 Martin Friebe Note Added: 0122233
2020-04-18 21:55 Martin Friebe Fixed in Version => 2.2
2020-04-18 21:55 Martin Friebe Widgetset GTK 2, Win32/Win64 => GTK 2, Win32/Win64
2020-04-18 21:58 Martin Friebe Note Edited: 0122233 View Revisions
2020-04-24 20:00 Rolf Wetjen Note Added: 0122389
2020-04-24 20:00 Rolf Wetjen File Added: win32wscustomlistview-2.inc
2020-04-24 20:00 Rolf Wetjen File Added: Selection.zip