Commit ae65b072 authored by paul's avatar paul
Browse files

lcl, win32, carbon: initial implementation of virtual TListView by Dmitry (issue #7749)

git-svn-id: trunk@21524 -
parent 7a4efc12
......@@ -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 FCaption write SetCaption;
property Caption : String read GetCaption 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 FImageIndex write SetImageIndex default -1;
property ImageIndex: Integer read GetImageIndex 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;
......
......@@ -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;
......
......@@ -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;
......@@ -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);
......
......@@ -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;
......
......@@ -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
......
......@@ -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
......
......@@ -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: (
......