Skip to content
GitLab
About GitLab
GitLab: the DevOps platform
Explore GitLab
Install GitLab
How GitLab compares
Get started
GitLab docs
GitLab Learn
Pricing
Talk to an expert
/
Help
What's new
2
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Projects
Groups
Snippets
Sign up now
Login
Sign in / Register
Toggle navigation
Menu
Open sidebar
FPC
Lazarus
Lazarus
Commits
fb64d6ef
Commit
fb64d6ef
authored
Apr 03, 2022
by
Werner Pamler
Browse files
LCL/ListView: Fix multi-selection in virtual mode. Issue
#39693
.
parent
fd20290c
Changes
5
Hide whitespace changes
Inline
Side-by-side
lcl/comctrls.pp
View file @
fb64d6ef
...
...
@@ -29,7 +29,7 @@ unit ComCtrls;
interface
uses
SysUtils
,
Types
,
Classes
,
Math
,
Laz_AVL_Tree
,
SysUtils
,
Types
,
Classes
,
Math
,
Laz_AVL_Tree
,
IntegerList
,
// LCL
LCLStrConsts
,
LResources
,
LCLIntf
,
LCLType
,
LCLProc
,
LMessages
,
WSLCLClasses
,
WSReferences
,
Graphics
,
ImgList
,
ActnList
,
Themes
,
Menus
,
...
...
@@ -1545,6 +1545,14 @@ type
function
DoOwnerDataHint
(
AStartIndex
,
AEndIndex
:
Integer
):
Boolean
;
virtual
;
function
DoOwnerDataStateChange
(
AStartIndex
,
AEndIndex
:
Integer
;
AOldState
,
ANewState
:
TListItemStates
):
Boolean
;
virtual
;
protected
// Multiselection
FMultiSelList
:
TIntegerList
;
function
GetFirstSelected
:
TListItem
;
procedure
InitMultiSelList
(
AEnable
:
Boolean
);
procedure
UpdateMultiSelList
(
AItem
:
TListItem
;
Add
:
Boolean
);
protected
procedure
DblClick
;
override
;
procedure
KeyDown
(
var
Key
:
Word
;
Shift
:
TShiftState
);
override
;
...
...
lcl/include/customlistview.inc
View file @
fb64d6ef
...
...
@@ -347,6 +347,9 @@ begin
if
(((
nm
^.
uOldState
and
LVIS_SELECTED
)
<>
(
nm
^.
uNewState
and
LVIS_SELECTED
)))
or
(
not
(
lffSelectedValid
in
FFlags
)
and
(
nm
^.
uNewState
and
LVIS_SELECTED
<>
0
))
then
begin
if
MultiSelect
and
OwnerData
then
UpdateMultiSelList
(
Item
,
nm
^.
uNewState
and
LVIS_SELECTED
<>
0
);
// select state changed
if
(
nm
^.
uNewState
and
LVIS_SELECTED
)
=
0
then
begin
...
...
@@ -1443,20 +1446,27 @@ begin
not
the
last
selected
one
see
issue
#16773 }
if
not
(
lffSelectedValid
in
FFlags
)
or
MultiSelect
then
begin
FSelected
:=
nil
;
if
(
not
FOwnerData
)
or
(
FSelectedIdx
>=
0
)
then
if
MultiSelect
and
OwnerData
then
begin
if
MultiSelect
and
FOwnerData
and
(
FSelectedIdx
>=
0
)
then
FSelected
:=
Items
[
FSelectedIdx
]
else
for
i
:=
0
to
Items
.
Count
-
1
do
begin
if
Items
[
i
]
.
Selected
then
FSelected
:=
GetFirstSelected
;
if
FSelected
<>
nil
then
FSelectedIdx
:=
FSelected
.
Index
else
FSelectedIdx
:=
-
1
;
end
else
begin
FSelected
:=
nil
;
if
(
not
FOwnerData
)
or
(
FSelectedIdx
>=
0
)
then
begin
if
MultiSelect
and
FOwnerData
and
(
FSelectedIdx
>=
0
)
then
FSelected
:=
Items
[
FSelectedIdx
]
else
for
i
:=
0
to
Items
.
Count
-
1
do
begin
FSelected
:=
Items
[
i
];
break
;
if
Items
[
i
]
.
Selected
then
begin
FSelected
:=
Items
[
i
];
break
;
end
;
end
;
end
;
end
;
end
;
Include
(
FFlags
,
lffSelectedValid
);
end
;
...
...
@@ -1826,3 +1836,19 @@ begin
if
not
HandleAllocated
then
exit
;
end
;
// Multi-selection
procedure
TCustomListView
.
InitMultiSelList
(
AEnable
:
Boolean
);
begin
TWSCustomListViewClass
(
WidgetSetClass
)
.
InitMultiSelList
(
Self
,
AEnable
);
end
;
procedure
TCustomListView
.
UpdateMultiSelList
(
AItem
:
TListItem
;
Add
:
Boolean
);
begin
TWSCustomListViewClass
(
WidgetSetClass
)
.
UpdateMultiSelList
(
Self
,
AItem
,
Add
);
end
;
function
TCustomListView
.
GetFirstSelected
:
TListItem
;
begin
Result
:=
TWSCustomListViewClass
(
WidgetSetClass
)
.
GetFirstSelected
(
Self
);
end
;
lcl/interfaces/win32/win32wscomctrls.pp
View file @
fb64d6ef
...
...
@@ -195,6 +195,11 @@ type
const
ASortDirection
:
TSortDirection
);
override
;
class
procedure
SetViewOrigin
(
const
ALV
:
TCustomListView
;
const
AValue
:
TPoint
);
override
;
class
procedure
SetViewStyle
(
const
ALV
:
TCustomListView
;
const
Avalue
:
TViewStyle
);
override
;
// Multi-selection
class
function
GetFirstSelected
(
const
ALV
:
TCustomListView
):
TListItem
;
override
;
class
procedure
InitMultiSelList
(
const
ALV
:
TCustomListView
;
AEnable
:
Boolean
);
override
;
class
procedure
UpdateMultiSelList
(
const
ALV
:
TCustomListView
;
AItem
:
TListItem
;
Add
:
Boolean
);
override
;
end
;
{ TWin32WSListView }
...
...
lcl/interfaces/win32/win32wscustomlistview.inc
View file @
fb64d6ef
...
...
@@ -1484,3 +1484,27 @@ begin
Index
:=
ListView_GetNextItem
(
ALV
.
Handle
,
Index
,
Flags
);
if
Index
<>
-
1
then
Result
:=
ALV
.
Items
[
Index
];
end
;
// Multi-selection in virtual mode
// Is handled by Windows. We don't need the MultiSelList.
class
function
TWin32WSCustomListView
.
GetFirstSelected
(
const
ALV
:
TCustomListView
)
:
TListItem
;
var
idx
:
Integer
;
begin
idx
:=
ListView_GetNextItem
(
ALV
.
Handle
,
-
1
,
LVNI_ALL
+
LVNI_SELECTED
);
if
idx
>
-
1
then
Result
:=
ALV
.
Items
[
idx
]
else
Result
:=
nil
;
end
;
class
procedure
TWin32WSCustomListView
.
InitMultiSelList
(
const
ALV
:
TCustomListView
;
AEnable
:
Boolean
);
begin
end
;
class
procedure
TWin32WSCustomListView
.
UpdateMultiSelList
(
const
ALV
:
TCustomListView
;
AItem
:
TListItem
;
Add
:
Boolean
);
begin
end
;
lcl/widgetset/wscomctrls.pp
View file @
fb64d6ef
...
...
@@ -39,7 +39,7 @@ uses
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Graphics
,
ImgList
,
Controls
,
StdCtrls
,
ComCtrls
,
Graphics
,
ImgList
,
Controls
,
StdCtrls
,
ComCtrls
,
IntegerList
,
////////////////////////////////////////////////////
WSLCLClasses
,
WSControls
,
WSExtCtrls
,
WSToolwin
,
WSFactory
;
...
...
@@ -178,6 +178,11 @@ type
// for every item previously checked. Only widgetsets that don't support native sort
// AND/OR that don't support native checkboxes should have this method return true
class
function
RestoreItemCheckedAfterSort
(
const
ALV
:
TCustomListView
):
Boolean
;
virtual
;
// Multi-selection
class
function
GetFirstSelected
(
const
ALV
:
TCustomListView
):
TListItem
;
virtual
;
class
procedure
InitMultiSelList
(
const
ALV
:
TCustomListView
;
AEnable
:
Boolean
);
virtual
;
class
procedure
UpdateMultiSelList
(
const
ALV
:
TCustomListView
;
AItem
:
TListItem
;
Add
:
Boolean
);
virtual
;
end
;
TWSCustomListViewClass
=
class
of
TWSCustomListView
;
...
...
@@ -484,6 +489,9 @@ end;
{ TWSCustomListView }
type
TCustomListViewAccess
=
class
(
TCustomListView
);
class
procedure
TWSCustomListView
.
ColumnDelete
(
const
ALV
:
TCustomListView
;
const
AIndex
:
Integer
);
begin
...
...
@@ -845,6 +853,56 @@ begin
end
;
end
;
class
function
TWSCustomListView
.
GetFirstSelected
(
const
ALV
:
TCustomListView
):
TListItem
;
var
idx
:
Integer
;
begin
Result
:=
nil
;
with
TCustomListViewAccess
(
ALV
)
do
begin
if
(
FMultiSelList
<>
nil
)
and
(
FMultiSelList
.
Count
>
0
)
then
begin
idx
:=
FMultiSelList
[
0
];
Result
:=
Items
[
idx
];
end
;
end
;
end
;
class
procedure
TWSCustomListView
.
InitMultiSelList
(
const
ALV
:
TCustomListView
;
AEnable
:
Boolean
);
begin
with
TCustomListViewAccess
(
ALV
)
do
begin
FMultiSelList
.
Free
;
FMultiSelList
:=
nil
;
if
AEnable
then
FMultiSelList
:=
TIntegerList
.
Create
;
end
;
end
;
class
procedure
TWSCustomListView
.
UpdateMultiSelList
(
const
ALV
:
TCustomListView
;
AItem
:
TListItem
;
Add
:
Boolean
);
var
idx
:
Integer
;
begin
with
TCustomListViewAccess
(
ALV
)
do
begin
if
FMultiSelList
=
nil
then
FMultiSelList
:=
TIntegerList
.
Create
;
idx
:=
FMultiSelList
.
IndexOf
(
AItem
.
Index
);
if
Add
then
begin
if
idx
=
-
1
then
begin
FMultiSelList
.
Add
(
AItem
.
Index
);
FMultiSelList
.
Sort
;
end
;
end
else
begin
if
idx
>
-
1
then
FMultiSelList
.
Delete
(
idx
);
end
;
end
;
end
;
{ TWSProgressBar }
class
procedure
TWSProgressBar
.
ApplyChanges
(
const
AProgressBar
:
TCustomProgressBar
);
...
...
Werner Pamler
@wpam
mentioned in issue
#39693 (closed)
·
Apr 04, 2022
mentioned in issue
#39693 (closed)
mentioned in issue #39693
Toggle commit list
Werner Pamler
@wpam
mentioned in commit
faed788b
·
Apr 04, 2022
mentioned in commit
faed788b
mentioned in commit faed788b23d608f804026c17b6c2afc88fbd74b4
Toggle commit list
Don Siders
@dsiders
mentioned in commit
c84616d6
·
Apr 05, 2022
mentioned in commit
c84616d6
mentioned in commit c84616d6e1922b6007c39d7bb88863d829cd9b58
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment