Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
What's new
4
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Switch to GitLab Next
Sign in / Register
Toggle navigation
Menu
Open sidebar
FPC
Lazarus
Lazarus
Commits
ae65b072
Commit
ae65b072
authored
Sep 01, 2009
by
paul
Browse files
lcl, win32, carbon: initial implementation of virtual TListView by Dmitry (issue
#7749
)
git-svn-id: trunk@21524 -
parent
7a4efc12
Changes
11
Hide whitespace changes
Inline
Side-by-side
lcl/comctrls.pp
View file @
ae65b072
...
...
@@ -667,15 +667,14 @@ type
FImageIndex
:
Integer
;
FStates
:
TListItemStates
;
FChecked
:
Boolean
;
function
GetCaption
:
String
;
virtual
;
function
GetChecked
:
Boolean
;
function
GetLeft
:
Integer
;
function
GetListView
:
TCustomListView
;
function
GetPosition
:
TPoint
;
function
GetState
(
const
ALisOrd
:
Integer
):
Boolean
;
function
GetIndex
:
Integer
;
function
GetSubItemImages
(
const
AIndex
:
Integer
):
Integer
;
function
GetSubItems
:
TStrings
;
function
GetTop
:
Integer
;
function
GetImageIndex
:
Integer
;
virtual
;
function
GetIndex
:
Integer
;
virtual
;
function
GetSubItemImages
(
const
AIndex
:
Integer
):
Integer
;
function
GetSubItems
:
TStrings
;
virtual
;
function
GetTop
:
Integer
;
function
WSUpdateAllowed
:
Boolean
;
procedure
WSUpdateText
;
procedure
WSUpdateImages
;
...
...
@@ -685,11 +684,8 @@ type
procedure
SetChecked
(
AValue
:
Boolean
);
procedure
SetState
(
const
ALisOrd
:
Integer
;
const
AIsSet
:
Boolean
);
procedure
SetData
(
const
AValue
:
Pointer
);
procedure
SetImageIndex
(
const
AValue
:
Integer
);
procedure
SetLeft
(
Value
:
Integer
);
procedure
SetCaption
(
const
AValue
:
String
);
procedure
SetPosition
(
const
AValue
:
TPoint
);
procedure
SetSubItemImages
(
const
AIndex
,
AValue
:
Integer
);
procedure
SetImageIndex
(
const
AValue
:
Integer
);
virtual
;
procedure
SetLeft
(
Value
:
Integer
);
procedure
SetCaption
(
const
AValue
:
String
);
virtual
;
procedure
SetPosition
(
const
AValue
:
TPoint
);
procedure
SetSubItemImages
(
const
AIndex
,
AValue
:
Integer
);
procedure
SetSubItems
(
const
AValue
:
TStrings
);
procedure
SetTop
(
Value
:
Integer
);
protected
...
...
@@ -705,14 +701,14 @@ type
function
DisplayRect
(
Code
:
TDisplayCode
):
TRect
;
function
DisplayRectSubItem
(
subItem
:
integer
;
Code
:
TDisplayCode
):
TRect
;
property
Caption
:
String
read
F
Caption
write
SetCaption
;
property
Caption
:
String
read
Get
Caption
write
SetCaption
;
property
Checked
:
Boolean
read
GetChecked
write
SetChecked
;
property
Cut
:
Boolean
index
Ord
(
lisCut
)
read
GetState
write
SetState
;
property
Data
:
Pointer
read
FData
write
SetData
;
property
DropTarget
:
Boolean
index
Ord
(
lisDropTarget
)
read
GetState
write
SetState
;
property
Focused
:
Boolean
index
Ord
(
lisFocused
)
read
GetState
write
SetState
;
property
Index
:
Integer
read
GetIndex
;
property
ImageIndex
:
Integer
read
F
ImageIndex
write
SetImageIndex
default
-
1
;
property
ImageIndex
:
Integer
read
Get
ImageIndex
write
SetImageIndex
default
-
1
;
property
Left
:
Integer
read
GetLeft
write
SetLeft
;
property
ListView
:
TCustomListView
read
GetListView
;
property
Owner
:
TListItems
read
FOwner
;
...
...
@@ -724,6 +720,24 @@ type
end
;
{
TOwnerDataListItem
}
TOwnerDataListItem
=
class
(
TListItem
)
private
FDataIndex
:
Integer
;
FCached
:
Boolean
;
function
GetCaption
:
String
;
override
;
function
GetIndex
:
Integer
;
override
;
function
GetImageIndex
:
Integer
;
override
;
procedure
SetCaption
(
const
AValue
:
String
);
override
;
procedure
SetImageIndex
(
const
AValue
:
Integer
);
override
;
function
GetSubItems
:
TStrings
;
override
;
procedure
DoCacheItem
;
public
procedure
SetDataIndex
(
ADataIndex
:
Integer
);
end
;
{
TListItems
}
{
Listitems
have
a
build
in
cache
of
the
last
accessed
item
.
...
...
@@ -741,6 +755,7 @@ type
procedure
WSCreateCacheItem
;
function
WSUpdateAllowed
:
Boolean
;
procedure
WSUpdateItem
(
const
AIndex
:
Integer
;
const
AValue
:
TListItem
);
procedure
WSSetItemsCount
(
const
ACount
:
Integer
);
procedure
ItemDestroying
(
const
AItem
:
TListItem
);
//
called
by
TListItem
when
freed
procedure
ReadData
(
Stream
:
TStream
);
//
read
data
in
a
Delphi
compatible
way
procedure
ReadLazData
(
Stream
:
TStream
);
//
read
data
in
a
64
bits
safe
way
...
...
@@ -748,6 +763,7 @@ type
protected
procedure
DefineProperties
(
Filer
:
TFiler
);
override
;
function
GetCount
:
Integer
;
procedure
SetCount
(
const
ACount
:
Integer
);
function
GetItem
(
const
AIndex
:
Integer
):
TListItem
;
procedure
WSCreateItems
;
procedure
SetItem
(
const
AIndex
:
Integer
;
const
AValue
:
TListItem
);
...
...
@@ -767,7 +783,7 @@ type
function
IndexOf
(
const
AItem
:
TListItem
):
Integer
;
function
Insert
(
const
AIndex
:
Integer
)
:
TListItem
;
procedure
InsertItem
(
AItem
:
TListItem
;
const
AIndex
:
Integer
);
property
Count
:
Integer
read
GetCount
;
property
Count
:
Integer
read
GetCount
write
SetCount
;
property
Item
[
const
AIndex
:
Integer
]:
TListItem
read
GetItem
write
SetItem
;
default
;
property
Owner
:
TCustomListView
read
FOwner
;
end
;
...
...
@@ -857,6 +873,7 @@ type
Data
:
Integer
;
var
Compare
:
Integer
)
of
object
;
TLVDeletedEvent
=
procedure
(
Sender
:
TObject
;
Item
:
TListItem
)
of
object
;
TLVInsertEvent
=
TLVDeletedEvent
;
TLVDataEvent
=
TLVDeletedEvent
;
TLVSelectItemEvent
=
procedure
(
Sender
:
TObject
;
Item
:
TListItem
;
Selected
:
Boolean
)
of
object
;
TLVCustomDrawEvent
=
procedure
(
Sender
:
TCustomListView
;
const
ARect
:
TRect
;
...
...
@@ -914,6 +931,7 @@ type
FDefaultItemHeight
:
integer
;
FHotTrackStyles
:
TListHotTrackStyles
;
FOwnerData
:
Boolean
;
FOwnerDataItem
:
TOwnerDataListItem
;
FListItems
:
TListItems
;
FColumns
:
TListColumns
;
FImages
:
array
[
TListViewImageList
]
of
TCustomImageList
;
...
...
@@ -935,6 +953,7 @@ type
FOnChange
:
TLVChangeEvent
;
FOnColumnClick
:
TLVColumnClickEvent
;
FOnCompare
:
TLVCompareEvent
;
FOnData
:
TLVDataEvent
;
FOnDeletion
:
TLVDeletedEvent
;
FOnInsert
:
TLVInsertEvent
;
FOnSelectItem
:
TLVSelectItemEvent
;
...
...
@@ -1008,6 +1027,8 @@ type
function
CustomDrawItem
(
AItem
:
TListItem
;
AState
:
TCustomDrawState
;
AStage
:
TCustomDrawStage
):
Boolean
;
virtual
;
//
function
CustomDrawSubItem
(
AItem
:
TListItem
;
ASubItem
:
Integer
;
AState
:
TCustomDrawState
;
AStage
:
TCustomDrawStage
):
Boolean
;
virtual
;
//
function
IntfCustomDraw
(
ATarget
:
TCustomDrawTarget
;
AStage
:
TCustomDrawStage
;
AItem
,
ASubItem
:
Integer
;
AState
:
TCustomDrawState
;
const
ARect
:
PRect
):
TCustomDrawResult
;
procedure
DoGetOwnerData
(
Item
:
TListItem
);
virtual
;
protected
property
AllocBy
:
Integer
read
FAllocBy
write
SetAllocBy
default
0
;
property
ColumnClick
:
Boolean
index
Ord
(
lvpColumnClick
)
read
GetProperty
write
SetProperty
default
True
;
...
...
@@ -1016,7 +1037,6 @@ type
property
HideSelection
:
Boolean
index
Ord
(
lvpHideSelection
)
read
GetProperty
write
SetProperty
default
True
;
property
HoverTime
:
Integer
read
GetHoverTime
write
SetHoverTime
default
-
1
;
property
LargeImages
:
TCustomImageList
index
Ord
(
lvilLarge
)
read
GetImageList
write
SetImageList
;
property
OwnerData
:
Boolean
read
FOwnerData
write
SetOwnerData
default
False
;
property
OwnerDraw
:
Boolean
index
Ord
(
lvpOwnerDraw
)
read
GetProperty
write
SetProperty
default
False
;
property
ScrollBars
:
TScrollStyle
read
FScrollBars
write
SetScrollBars
default
ssBoth
;
property
ShowColumnHeaders
:
Boolean
index
Ord
(
lvpShowColumnHeaders
)
read
GetProperty
write
SetProperty
default
True
;
...
...
@@ -1030,6 +1050,7 @@ type
property
OnChange
:
TLVChangeEvent
read
FOnChange
write
FOnChange
;
property
OnColumnClick
:
TLVColumnClickEvent
read
FOnColumnClick
write
FOnColumnClick
;
property
OnCompare
:
TLVCompareEvent
read
FOnCompare
write
FOnCompare
;
property
OnData
:
TLVDataEvent
read
FOnData
write
FOnData
;
property
OnDeletion
:
TLVDeletedEvent
read
FOnDeletion
write
FOnDeletion
;
property
OnInsert
:
TLVInsertEvent
read
FOnInsert
write
FOnInsert
;
property
OnSelectItem
:
TLVSelectItemEvent
read
FOnSelectItem
write
FOnSelectItem
;
...
...
@@ -1064,6 +1085,7 @@ type
// needs to access this property and it cannot cast to TListItem, because we have
// other classes descending from TCustomListItem which need to work too
property MultiSelect: Boolean index Ord(lvpMultiselect) read GetProperty write SetProperty default False;
property OwnerData: Boolean read FOwnerData write SetOwnerData default False;
property ReadOnly: Boolean index Ord(lvpReadOnly) read GetProperty write SetProperty default False;
property RowSelect: Boolean index Ord(lvpRowSelect) read GetProperty write SetProperty default False;
property SelCount: Integer read GetSelCount;
...
...
@@ -1105,7 +1127,7 @@ type
property Items;
property LargeImages;
property MultiSelect;
//
property OwnerData;
property OwnerData;
// property OwnerDraw;
property ParentColor default False;
property ParentFont;
...
...
@@ -1137,6 +1159,7 @@ type
property OnCustomDraw;
property OnCustomDrawItem;
property OnCustomDrawSubItem;
property OnData;
property OnDblClick;
property OnDeletion;
property OnDragDrop;
...
...
lcl/include/customlistview.inc
View file @
ae65b072
...
...
@@ -43,6 +43,8 @@ begin
FCanvas
:=
TControlCanvas
.
Create
;
TControlCanvas
(
FCanvas
)
.
Control
:=
Self
;
FProperties
:=
[
lvpColumnClick
,
lvpHideSelection
,
lvpShowColumnHeaders
,
lvpToolTips
];
FOwnerDataItem
:=
TOwnerDataListItem
.
Create
(
FListItems
);
end
;
{
------------------------------------------------------------------------------
...
...
@@ -167,6 +169,7 @@ begin
//Check
end
;
LVN_ITEMCHANGED
:
begin
if
OwnerData
then
Exit
;
Item
:=
Items
[
nm
^.
iItem
];
//DebugLn('TCustomListView.CNNotify Count=',dbgs(Items.Count),' nm^.iItem=',dbgs(nm^.iItem),' destroying=',dbgs(lifDestroying in Item.FFlags));
if
(
lifDestroying
in
Item
.
FFlags
)
then
begin
...
...
@@ -282,10 +285,18 @@ begin
LVC
.
SetSort
(
Self
,
FSortType
,
FSortColumn
);
// add items
FListItems
.
WSCreateItems
;
if
not
OwnerData
then
begin
FListItems
.
WSCreateItems
;
// set other properties
LVC
.
SetAllocBy
(
Self
,
FAllocBy
);
end
else
begin
LVC
.
SetOwnerData
(
Self
,
True
);
LVC
.
SetItemsCount
(
Self
,
FListItems
.
Count
);
end
;
// set other properties
LVC
.
SetAllocBy
(
Self
,
FAllocBy
);
LVC
.
SetDefaultItemHeight
(
Self
,
FDefaultItemHeight
);
LVC
.
SetHotTrackStyles
(
Self
,
FHotTrackStyles
);
LVC
.
SetHoverTime
(
Self
,
FHoverTime
);
...
...
@@ -435,6 +446,11 @@ begin
then
Result
:=
[
cdrSkipDefault
];
end
;
procedure
TCustomListView
.
DoGetOwnerData
(
Item
:
TListItem
);
begin
if
Assigned
(
OnData
)
then
OnData
(
Self
,
Item
);
end
;
{
------------------------------------------------------------------------------
}
{
TCustomListView
SetColumns
}
{
------------------------------------------------------------------------------
}
...
...
@@ -860,6 +876,8 @@ procedure TCustomListView.SetOwnerData(const AValue: Boolean);
begin
if
FOwnerData
=
AValue
then
exit
;
FOwnerData
:=
AValue
;
if
HandleAllocated
then
TWSCustomListViewClass
(
WidgetSetClass
)
.
SetOwnerData
(
Self
,
AValue
);
end
;
procedure
TCustomListView
.
SetProperty
(
const
ALvpOrd
:
Integer
;
...
...
lcl/include/listitem.inc
View file @
ae65b072
...
...
@@ -602,6 +602,14 @@ begin
then
TWSCustomListViewClass
(
LV
.
WidgetSetClass
)
.
ItemSetText
(
LV
,
GetIndex
,
Self
,
0
,
FCaption
);
end
;
{
------------------------------------------------------------------------------
}
{
TListItem
GetCaption
}
{
------------------------------------------------------------------------------
}
function
TListItem
.
GetCaption
:
String
;
begin
Result
:=
FCaption
;
end
;
{
------------------------------------------------------------------------------
}
{
TListItem
SetChecked
}
{
------------------------------------------------------------------------------
}
...
...
@@ -637,6 +645,14 @@ begin
then
TWSCustomListViewClass
(
FOwner
.
FOwner
.
WidgetSetClass
)
.
ItemSetImage
(
FOwner
.
FOwner
,
GetIndex
,
Self
,
0
,
FImageIndex
);
end
;
{
------------------------------------------------------------------------------
}
{
TListItem
GetImageIndex
}
{
------------------------------------------------------------------------------
}
function
TListItem
.
GetImageIndex
:
Integer
;
begin
Result
:=
FImageIndex
;
end
;
procedure
TListItem
.
SetLeft
(
Value
:
Integer
);
begin
Position
:=
Point
(
Value
,
Top
);
...
...
@@ -685,4 +701,67 @@ begin
Position
:=
Point
(
Left
,
Value
);
end
;
{
TOwnerDataListItem
}
{
------------------------------------------------------------------------------
}
{
TOwnerDataListItem
GetIndex
}
{
------------------------------------------------------------------------------
}
function
TOwnerDataListItem
.
GetIndex
:
Integer
;
begin
Result
:=
FDataIndex
;
end
;
{
------------------------------------------------------------------------------
}
{
TOwnerDataListItem
GetIndex
}
{
------------------------------------------------------------------------------
}
procedure
TOwnerDataListItem
.
SetCaption
(
const
AValue
:
String
);
begin
FCaption
:=
AValue
;
end
;
function
TOwnerDataListItem
.
GetCaption
:
String
;
begin
if
not
FCached
then
DoCacheItem
;
Result
:=
inherited
GetCaption
;
end
;
function
TOwnerDataListItem
.
GetImageIndex
:
Integer
;
begin
if
not
FCached
then
DoCacheItem
;
Result
:=
inherited
GetImageIndex
;
end
;
procedure
TOwnerDataListItem
.
SetImageIndex
(
const
AValue
:
Integer
);
begin
FImageIndex
:=
AValue
;
end
;
{
------------------------------------------------------------------------------
}
{
TOwnerDataListItem
SetDataIndex
}
{
------------------------------------------------------------------------------
}
procedure
TOwnerDataListItem
.
SetDataIndex
(
ADataIndex
:
Integer
);
begin
if
FDataIndex
<>
ADataIndex
then
begin
FDataIndex
:=
ADataIndex
;
FCached
:=
False
;
if
Assigned
(
FSubItems
)
then
FSubItems
.
Clear
;
end
;
end
;
function
TOwnerDataListItem
.
GetSubItems
:
TStrings
;
begin
if
not
FCached
then
DoCacheItem
;
Result
:=
inherited
GetSubItems
;
end
;
procedure
TOwnerDataListItem
.
DoCacheItem
;
begin
FCached
:=
True
;
FOwner
.
FOwner
.
DoGetOwnerData
(
Self
);
end
;
lcl/include/listitems.inc
View file @
ae65b072
...
...
@@ -34,23 +34,44 @@ begin
Result
:=
FItems
.
Count
;
end
;
procedure
TListItems
.
SetCount
(
const
ACount
:
Integer
);
begin
if
not
FOwner
.
OwnerData
then
Exit
;
FItems
.
Count
:=
ACount
;
if
WSUpdateAllowed
then
WSSetItemsCount
(
FItems
.
Count
);
end
;
{
------------------------------------------------------------------------------
}
{
TListItems
GetItem
}
{
------------------------------------------------------------------------------
}
function
TListItems
.
GetItem
(
const
AIndex
:
Integer
)
:
TListItem
;
begin
if
(
FCacheIndex
<>
-
1
)
and
(
FCacheIndex
=
AIndex
)
then
begin
Result
:=
FCacheItem
;
Exit
;
end
;
if
FItems
.
Count
-
1
<
AIndex
then
Result
:=
nil
else
begin
Result
:=
TListItem
(
FItems
.
Items
[
AIndex
]);
FCacheItem
:=
Result
;
FCacheIndex
:=
AIndex
;
if
not
FOwner
.
OwnerData
then
begin
if
(
FCacheIndex
<>
-
1
)
and
(
FCacheIndex
=
AIndex
)
then
begin
Result
:=
FCacheItem
;
Exit
;
end
;
if
FItems
.
Count
-
1
<
AIndex
then
Result
:=
nil
else
begin
Result
:=
TListItem
(
FItems
.
Items
[
AIndex
]);
FCacheItem
:=
Result
;
FCacheIndex
:=
AIndex
;
end
;
end
else
begin
if
(
AIndex
<
0
)
or
(
AIndex
>=
FItems
.
Count
)
then
begin
Result
:=
nil
;
Exit
;
end
;
FOwner
.
FOwnerDataItem
.
SetDataIndex
(
AIndex
);
Result
:=
FOwner
.
FOwnerDataItem
;
end
;
end
;
...
...
@@ -116,8 +137,20 @@ end;
TListItems
Clear
------------------------------------------------------------------------------
}
procedure
TListItems
.
Clear
;
var
i
:
Integer
;
begin
while
Count
>
0
do
Delete
(
Count
-
1
);
if
not
Owner
.
OwnerData
then
while
Count
>
0
do
Delete
(
Count
-
1
)
else
begin
for
i
:=
0
to
FItems
.
Count
-
1
do
begin
TListItem
(
FItems
[
i
])
.
Free
;
FItems
[
i
]
:=
nil
;
end
;
Count
:=
0
;
end
;
end
;
{
------------------------------------------------------------------------------
}
...
...
@@ -177,6 +210,11 @@ begin
TWSCustomListViewClass
(
FOwner
.
WidgetSetClass
)
.
ItemUpdate
(
FOwner
,
AIndex
,
AValue
);
end
;
procedure
TListItems
.
WSSetItemsCount
(
const
ACount
:
Integer
);
begin
TWSCustomListViewClass
(
FOwner
.
WidgetSetClass
)
.
SetItemsCount
(
FOwner
,
ACount
);
end
;
{
------------------------------------------------------------------------------
}
{
TListItems
ItemDeleted
}
{
------------------------------------------------------------------------------
}
...
...
@@ -260,11 +298,15 @@ end;
{
------------------------------------------------------------------------------
}
destructor
TListItems
.
Destroy
;
begin
FCacheIndex
:=
0
;
while
FItems
.
Count
>
0
do
if
not
FOwner
.
FOwnerData
then
begin
FCacheItem
:=
TListItem
(
FItems
[
0
]);
FCacheItem
.
Free
;
// to call Self.Clear instead?
FCacheIndex
:=
0
;
while
FItems
.
Count
>
0
do
begin
FCacheItem
:=
TListItem
(
FItems
[
0
]);
FCacheItem
.
Free
;
end
;
end
;
FCacheIndex
:=
-
1
;
FreeAndNil
(
FItems
);
...
...
lcl/interfaces/carbon/carbonlistviews.pp
View file @
ae65b072
...
...
@@ -222,6 +222,7 @@ type
private
FIcons
:
TFPList
;
FStyle
:
TViewStyle
;
FOwnerData
:
Boolean
;
FDestroying
:
Boolean
;
protected
procedure
CreateWidget
(
const
AParams
:
TCreateParams
);
override
;
...
...
@@ -250,7 +251,9 @@ type
procedure
SetViewStyle
(
AStyle
:
TViewStyle
);
procedure
DoColumnClicked
(
MouseX
,
MouseY
:
Integer
);
procedure
SetItemsCount
(
ACount
:
Integer
);
function
NeedDeliverMouseEvent
(
Msg
:
Integer
;
const
AMessage
):
Boolean
;
override
;
property
OwnerData
:
Boolean
read
FOwnerData
write
FOwnerData
;
end
;
{
TCarbonListBox
}
...
...
@@ -1734,6 +1737,17 @@ begin
end;
end;
procedure TCarbonListView.SetItemsCount(ACount: Integer);
begin
if not FOwnerData then Exit;
RemoveDataBrowserItems(Widget, kDataBrowserNoItem, 0, nil, kDataBrowserItemNoProperty);
OSError(
AddDataBrowserItems( Widget, kDataBrowserNoItem, ACount, nil, kDataBrowserItemNoProperty),
Self, '
SetItemsCount
', '
AddDataBrowserItems
');
UpdateDataBrowserItems( Widget, kDataBrowserNoItem, ACount, nil, kDataBrowserItemNoProperty, kDataBrowserNoItem);
end;
function TCarbonListView.NeedDeliverMouseEvent(Msg: Integer; const AMessage): Boolean;
type
PLMMouse = ^TLMMouse;
...
...
@@ -1910,10 +1924,15 @@ var
CFString: CFStringRef;
ItemIcon: IconRef;
SubIndex: Integer;
ItemsCnt : integer;
begin
with View do begin
if (ID < 1) or (ID > DataBrowserItemId(GetItemsCount)) then
if FOwnerData
then ItemsCnt := TListView(View.LCLObject).Items.Count+1
else ItemsCnt := GetItemsCount + 1;
if (ID < 1) or (ID > ItemsCnt) then
begin
Result := errDataBrowserItemNotFound;
Exit;
...
...
lcl/interfaces/carbon/carbonwscomctrls.pp
View file @
ae65b072
...
...
@@ -117,6 +117,8 @@ type
//
class
procedure
SetHotTrackStyles
(
const
ALV
:
TCustomListView
;
const
AValue
:
TListHotTrackStyles
);
override
;
//
class
procedure
SetHoverTime
(
const
ALV
:
TCustomListView
;
const
AValue
:
Integer
);
override
;
class
procedure
SetImageList
(
const
ALV
:
TCustomListView
;
const
AList
:
TListViewImageList
;
const
AValue
:
TCustomImageList
);
override
;
class
procedure
SetItemsCount
(
const
ALV
:
TCustomListView
;
const
Avalue
:
Integer
);
override
;
class
procedure
SetOwnerData
(
const
ALV
:
TCustomListView
;
const
AValue
:
Boolean
);
override
;
class
procedure
SetProperty
(
const
ALV
:
TCustomListView
;
const
AProp
:
TListViewProperty
;
const
AIsSet
:
Boolean
);
override
;
class
procedure
SetProperties
(
const
ALV
:
TCustomListView
;
const
AProps
:
TListViewProperties
);
override
;
class
procedure
SetScrollBars
(
const
ALV
:
TCustomListView
;
const
AValue
:
TScrollStyle
);
override
;
...
...
@@ -526,6 +528,18 @@ begin
TCarbonListView
(
ALV
.
Handle
)
.
UpdateColumnView
;
end
;
class
procedure
TCarbonWSCustomListView
.
SetItemsCount
(
const
ALV
:
TCustomListView
;
const
Avalue
:
Integer
);
begin
if
not
CheckHandle
(
ALV
,
Self
,
'SetOwnerData'
)
then
Exit
;
TCarbonListView
(
ALV
.
Handle
)
.
SetItemsCount
(
Avalue
);
end
;
class
procedure
TCarbonWSCustomListView
.
SetOwnerData
(
const
ALV
:
TCustomListView
;
const
AValue
:
Boolean
);
begin
if
not
CheckHandle
(
ALV
,
Self
,
'SetOwnerData'
)
then
Exit
;
TCarbonListView
(
ALV
.
Handle
)
.
OwnerData
:
=
true
;
end
;
class
procedure
TCarbonWSCustomListView
.
SetProperty
(
const
ALV
:
TCustomListView
;
const
AProp
:
TListViewProperty
;
const
AIsSet
:
Boolean
);
begin
...
...
lcl/interfaces/win32/win32callback.inc
View file @
ae65b072
...
...
@@ -966,6 +966,58 @@ var
end
;
end
;
type
PNMLVOwnerData
=
PLVDISPINFO
;
procedure
HandleListViewOwnerData
(
ALV
:
TCustomListViewAccess
);
var
DataInfo
:
PNMLVOwnerData
;
// absolute NMHdr;
txt
:
String
;
LVInfo
:
PWin32WindowInfo
;
idx
:
Integer
;
listitem
:
TListItem
;
begin
LVInfo
:=
GetWin32WindowInfo
(
ALV
.
Handle
);
if
not
Assigned
(
LVInfo
)
then
Exit
;
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
.
iSubItem
=
0
then
begin
txt
:=
listitem
.
Caption
;
DataInfo
^.
item
.
mask
:=
DataInfo
^.
item
.
mask
or
LVIF_IMAGE
;
DataInfo
^.
item
.
iImage
:=
listitem
.
ImageIndex
;
end
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
]
:=
UTF8Decode
(
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
;
procedure
HandleListViewCustomDraw
(
ALV
:
TCustomListViewAccess
);
function
ConvState
(
const
State
:
uint
):
TCustomDrawState
;
begin
...
...
@@ -2119,6 +2171,12 @@ begin
case
code
of
TCN_SELCHANGE
:
idFrom
:=
ShowHideTabPage
(
HWndFrom
,
True
);
LVN_GETDISPINFOA
,
LVN_GETDISPINFOW
:
begin
if
WindowInfo
^.
WinControl
is
TCustomListView
then
HandleListViewOwnerData
(
TCustomListViewAccess
(
WindowInfo
^.
WinControl
))
//WinProcess := false;
end
;
NM_CUSTOMDRAW
:
begin
if
WindowInfo
^.
WinControl
is
TCustomListView
then
...
...
lcl/interfaces/win32/win32proc.pp
View file @
ae65b072
...
...
@@ -31,6 +31,9 @@ uses
Windows
,
Win32Extra
,
Classes
,
SysUtils
,
LMessages
,
LCLType
,
LCLProc
,
LCLMessageGlue
,
Controls
,
Forms
,
Menus
,
GraphType
,
IntfGraphics
;
const
LV_DISP_INFO_COUNT
=
2
;
Type
TEventType
=
(
etNotify
,
etKey
,
etKeyPress
,
etMouseWheel
,
etMouseUpDown
);
...
...
@@ -57,6 +60,9 @@ Type
DrawItemIndex
:
integer
;
//
in
case
of
listbox
,
when
handling
WM_DRAWITEM
DrawItemSelected
:
boolean
;
//
whether
this
item
is
selected
LB_GETSEL
not
uptodate
yet
MouseX
,
MouseY
:
smallint
;
//
noticing
spurious
WM_MOUSEMOVE
messages
DispInfoTextA
:
array
[
0
..
LV_DISP_INFO_COUNT
-
1
]
of
AnsiString
;
//
buffer
for
ListView
LVN_GETDISPINFO
notification
DispInfoTextW
:
array
[
0
..
LV_DISP_INFO_COUNT
-
1
]
of
WideString
;
//
it
's recommended to keep buffer unchanged
DispInfoIndex: Integer; // between 2 calls of LVN_GETDISPINFO
case integer of
0: (spinValue: Double);
1: (
...
...
lcl/interfaces/win32/win32wscomctrls.pp
View file @
ae65b072
...
...
@@ -138,6 +138,8 @@ type
<